VB6.0多线程实现

若要使得VB6运行多线程，需使用一个微软未公开的API函数VBDllGetClassObject初始化一下。该函数的声明如下：

Declare Function VBDllGetClassObject Lib “msvbvm60.dll” (a As Long, b As Long, ByVal c As Long, REFCLSID As Long, REFIID As mIID, ppv As Long) As Long

Public Function GETVBHeader() As Boolean ‘获取VB6数据头

Dim BaseAds As Long, GetOffSet As Long

Dim VBHdChar(3) As Byte, MemData(&H1FDA&) As Byte

IsIDEorEXE = App.LogMode

If IsIDEorEXE <> 0 Then

VBHdChar(0) = &H56 ‘V

VBHdChar(1) = &H42 ‘B

VBHdChar(2) = &H35 ‘5

VBHdChar(3) = &H21 ‘!

BaseAds = VBGetModuleHandle(ByVal 0&) + &H1024&

CopyMemory MemData(0), ByVal (BaseAds), &H1FDB&

GetOffSet = InStrB(1, MemData, VBHdChar, vbBinaryCompare)

If GetOffSet > 0 Then

VBHeader = GetOffSet + BaseAds – 1

GETVBHeader = True

Else

MessageBox ByVal 0&, StrPtr(“获取不到VB数据头！”), StrPtr(“VB数据头定位标志被篡改！”), vbExclamation

VBHeader = 0

GETVBHeader = False

End If

Else

VBHeader = 0

GETVBHeader = False

End If

End Function

Public Function InitVBdll() As Boolean ‘诱导VB6运行库其它部分完全初始化

Dim pIID As mIID, pDummy As Long

Dim u1 As Long, u2 As Long, u3 As Long

If VBHeader > 0 Then

pIID.data1 = &H1&

pIID.data4(0) = &HC0

pIID.data4(7) = &H46

u3 = VBGetModuleHandle(ByVal 0&)

UserDllMain u1, u2, u3, 1&, 0&

VBDllGetClassObject u1, u2, VBHeader, pDummy, pIID, pDummy

InitVBdll = True

Else

InitVBdll = False

End If

End Function

未运行多线程前线程数为1

运行多线程后线程数为3

来源：B软件工程师