代码比较凌乱,整理了一下,麻烦楼上二位给看看
Public Module Mod_MultiThreads
Public Delegate Sub ProcessSub(ByVal pFile As Object, ByRef pWorker As Object) '这是最终处理函数
Public Delegate Sub MultiThreadsSub(ByVal pData As Object, ByVal pProcessFunc As ProcessSub) '这个委托是直接线程函数,其所关联方法应根据实际情况而写可参考本类中ServeForMultiThread方法而写
Public Delegate Sub MultiThreadsSub2(ByVal pData As Object) '这里pData可能传递的是数据集合,可能是单数据,注意判断。可以直接调用字典对象,传入多参数。这样也可以处理多参数问题
Public Dyn_Object As New Dynamic.ExpandoObject '动态对象,可以动态添加成员和方法
''' <summary>
''' '开启多线程函数,仅用于开启多个excel线程来处理文件
''' </summary>
''' <param name="pCollectObj">数据集合,</param>
''' <param name="pProcessSub">具体处理数据函数</param>
''' <param name="pGroupNum">每组成员数</param>
''' <param name="pThreadNum">一次开启线程数,不要过大(小于200),否则容易使程序崩溃</param>
''' <remarks>'此处注意,数据集合中所有数据类型将被转换为object,请在线程函数中进行类型转换</remarks>
Public Sub StartMultiThreadsOnlyForExcel(ByVal pCollectObj As Object, ByVal pProcessSub As ProcessSub, Optional ByVal pGroupNum As Integer = 30, Optional ByVal pThreadNum As Integer = 30)
Dim m_lList As New List(Of Object)
Dim m_lZList As New List(Of List(Of Object))
Try
If TypeOf pCollectObj Is OleDb.OleDbDataReader Then '增加此代码,解决不能传入过大数据集合问题。
Do While pCollectObj.read
m_lList.Add(pCollectObj.Item(0))
If m_lList.Count = pGroupNum Then
m_lZList.Add(m_lList)
m_lList = New List(Of Object)
End If
If m_lZList.Count = pThreadNum Then
'开启多线程 TODO
Parallel.ForEach(m_lZList, Sub(ITem) ServeForMultiThread(ITem, pProcessSub))
'处理list,减轻内存压力
For Each pList As List(Of Object) In m_lZList
pList.Clear()
pList = Nothing
Next
m_lZList.Clear()
End If
Loop
Else
For Each pMember As Object In pCollectObj
m_lList.Add(pMember)
If m_lList.Count = pGroupNum Then
m_lZList.Add(m_lList)
m_lList = New List(Of Object)
End If
If m_lZList.Count = pThreadNum Then
'开启多线程 TODO
Parallel.ForEach(m_lZList, Sub(ITem) ServeForMultiThread(ITem, pProcessSub))
'处理list,减轻内存压力
For Each pList As List(Of Object) In m_lZList
pList.Clear()
pList = Nothing
Next
m_lZList.Clear()
End If
Next
End If
If m_lZList.Count > 0 Then
'TODO
Parallel.ForEach(m_lZList, Sub(ITem) ServeForMultiThread(ITem, pProcessSub))
For Each pList As List(Of Object) In m_lZList
pList.Clear()
pList = Nothing
Next
End If
If m_lList.Count > 0 Then
'TODO
Parallel.ForEach(m_lList, Sub(ITem) ServeForMultiThread(ITem, pProcessSub))
m_lList.Clear()
m_lList = Nothing
End If
Catch ex As Exception
GYPublicInfo.PublicInfo.ErrCl(ex.ToString())
Finally
If Not m_lZList Is Nothing Then
m_lZList.Clear()
m_lZList = Nothing
End If
If Not m_lList Is Nothing Then
m_lList.Clear()
m_lList = Nothing
End If
End Try
End Sub
End Module
Private Function OutputDCB_MultiThread_HuNanSheng(ByVal ListBM As List(Of String)) As Boolean
Dim m_lDCB_Print As ProcessSub = AddressOf Single_OutputDCB
Dim m_lGroupNum As Integer = 30
Dim m_lThreadsNum As Integer = 30
StartMultiThreadsOnlyForExcel(ListBM, m_lDCB_Print, m_lGroupNum, m_lThreadsNum)
Return True
End Function
Private Function Single_OutputDCB(ByVal SingleCBFBM As String, ByRef pPutOutExcel As GY.gnp.CPutOutExcel) As Boolean
Dim ModulePath As String
Dim _OutputFullpath As String
Try
If _OutputFolderType.ToUpper = "CBF" Then
Dim locked1 As Boolean = False
Try
GYPublicInfo.PublicInfo.locker.Enter(locked1)
If System.IO.Directory.Exists(_OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\" & SingleCBFBM & "\") = False Then
System.IO.Directory.CreateDirectory(_OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\" & SingleCBFBM & "\")
End If
Catch ex As Exception
Finally
If locked1 Then GYPublicInfo.PublicInfo.locker.Exit()
End Try
_OutputFullpath = _OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\" & SingleCBFBM & "\" & SingleCBFBM & "调查表.xls"
ElseIf _OutputFolderType.ToUpper = "ZU" Then
Dim locked1 As Boolean = False
Try
GYPublicInfo.PublicInfo.locker.Enter(locked1)
If System.IO.Directory.Exists(_OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\") = False Then
System.IO.Directory.CreateDirectory(_OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\")
End If
Catch ex As Exception
Finally
If locked1 Then GYPublicInfo.PublicInfo.locker.Exit()
End Try
_OutputFullpath = _OutputFolder & "\" & SingleCBFBM.Substring(0, 14) & "\" & SingleCBFBM & "调查表.xls"
End If
ModulePath = System.Windows.Forms.Application.StartupPath & "\File\ExcelTemplate\调查表\湖南省\调查表.xls"
GYPublicInfo.PublicInfo.ErrCl(ModulePath)
FileCopy(ModulePath, _OutputFullpath)
pPutOutExcel.NewExcel.ObjExcelBook = pPutOutExcel.NewExcel.ObjExcel.Workbooks.Open(_OutputFullpath)
pPutOutExcel.NewExcel.SheetActivateIndex = 1
Dim pDTcbf As New DataTable
Dim pDTgyr As New DataTable
Dim pDT As New DataTable
Dim pData As New GDP.CData(PublicInfo.PublicInfo.Connection)
GYPublicInfo.PublicInfo.Sem.WaitOne()
pDTcbf = pData.DataTableResult("select * from cbkf where bm='" & SingleCBFBM & "'")
GYPublicInfo.PublicInfo.Sem.Release()
If pDTcbf.Rows.Count > 0 Then
pPutOutExcel.NewExcel.RangeValue(2, 3) = Microsoft.VisualBasic.Left(SingleCBFBM, 14)
pPutOutExcel.NewExcel.RangeValue(2, 9) = Microsoft.VisualBasic.Right(SingleCBFBM, 4)
Dim sZJLX_NAME As String
GYPublicInfo.PublicInfo.Sem.WaitOne()
sZJLX_NAME = pData.ExecuteScalarCstr("select mc from D_ZJLX where dm='" & pDTcbf.Rows(0)("ZJLX") & "" & "'")
GYPublicInfo.PublicInfo.Sem.Release()
pPutOutExcel.NewExcel.RangeValue(5, 3) = "R身份证"
pPutOutExcel.NewExcel.ExcelCharInvaild("C5", "F5", "R身份证")
pPutOutExcel.NewExcel.RangeValue(5, 8) = pDTcbf.Rows(0)("ZJHM") & ""
GYPublicInfo.PublicInfo.Sem.WaitOne()
pDT = pData.DataTableResult("select * from CBDJB where CBFBM='" & SingleCBFBM & "'")
GYPublicInfo.PublicInfo.Sem.Release()
End If
Return True
Catch ex As Exception
Dim lock2 As Boolean = False
Try
GYPublicInfo.PublicInfo.locker.Enter(lock2)
GYPublicInfo.PublicInfo.ErrCl(ex.ToString())
_StrB_OutputLog.AppendLine(ex.ToString())
Catch exp As Exception
Finally
If lock2 Then PublicInfo.PublicInfo.locker.Exit()
End Try
Return False
Finally
Try
here:
pPutOutExcel.NewExcel.ObjExcelBook.Save()
Catch ex As Exception
GoTo here
End Try
pPutOutExcel.NewExcel.ObjExcelBook.Close()
System.Runtime.InteropServices.Marshal.ReleaseComObject(pPutOutExcel.NewExcel.ObjExcelBook)
pPutOutExcel.NewExcel.ObjExcelBook = Nothing
End Try
End Function