【VB6】最简多线程（线程函数内可使用API、Form、控件、MsgBox

0xAA55

帖子内容已更新：代码做了一些改进和调整，现在 Sub Main 不会被重复执行了（通过拷贝 VbHeader 结构体，修改其 lpSubMain 函数指针的指向来实现）

简易多线程（改进）.zip (2.61 KB, 下载次数: 8, 售价: 20 个宅币)

2022-7-11 09:33 上传

点击文件名下载附件

---

根据坛友“系统消息”的提示，VB6 的 ActiveX Dll 会调用 MSVBVM60.DLL 导出的“VBUserDllMain”和“VBUserDllGetClassObject”，在这两个调用都完成之后就可以安全进行多线程的对 Form、MsgBox 等 UI 相关的功能调用了。

那么根据推测，我们的 VB6 程序只需要假装自己是 ActiveX Dll 然后调用 MSVBVM60.DLL 的 Dll 相关初始化代码，就能完成 VB6 运行时环境的初始化，从而正常使用 VB6 的各种功能了。

然而我仔细观察了 MSVBVM60.DLL 的导出表，并没有发现“VBUserDllMain”这个函数。随后我创建了一个新的空的 ActiveX DLL 工程，生成 DLL，然后使用 IDA 打开看，发现这个 DLL 的入口函数 DllEntryPoint 会跳转到 MSVBVM60.DLL 导出的“UserDllMain”。并不是预想之中的“VBUserDllMain”。

使用 IDA 观察 UserDllMain 这个函数的行为，发现它需要五个参数，其中后三个参数是正常的 DLL 入口的 DllMain 的 HINSTANCE hInstDll、DWORD dwReason、LPVOID lpReserved，而前两个参数则比较奇妙，总结下来如下：

1、第一个参数大概是一个 HINSTANCE* 参数，后续代码里可以看到 dwReason 为 DLL_PROCESS_ATTACH 时，这个 HINSTANCE* 指向的地址被写入了 当前 hInstDll 值。
2、第二个参数从未被使用过。



按照这些内容，我把这个函数声明为如下：

Private Declare Function UserDllMain Lib "msvbvm60" (OutInstance As Long, ByVal Unused As Long, ByVal hInstDll As Long, ByVal dwReason As Long, ByVal lpReserved As Long) As Long

在这个阶段，我们的 VB6 程序已经能假装自己是个 Dll 了，但我们还需要再“装模做样”地像 ActiveX Dll 那样创建一个 COM 对象才能完整地把 VB6 环境初始化好。因此我们要想办法进行一次合法的 VBUserDllGetClassObject 的调用。

然而我仔细观察了 MSVBVM60.DLL 的导出表，并没有发现“VBUserDllGetClassObject”这个函数，但好在这个函数的名字是 VB 开头的，它其实是“VBDllGetClassObject”，而不是“VBUserDllGetClassObject”。不同于一般的 COM DLL 的类工厂 DllGetClassObject 只需要三个参数（CLSID，IID，void **ppObj），VBDllGetClassObject 需要六个参数，分别是：

1、第一个参数大概是一个 HINSTANCE* 参数。根据观察，它应当和 UserDllMain 的第一个参数相同。
2、第二个参数从未被使用过，但也应当和 UserDllMain 的第一个参数相同。
3、第三个参数是 VbHeader 结构体。这个结构体的地址要根据 PE 头的结构来找。
4、CLSID
5、IID
6、void** ppObj



按照这些内容，我把这个函数声明为如下：

Private Declare Function VBDllGetClassObject Lib "msvbvm60" (lpHInstDll As Long, ByVal Reserved As Long, lpVBHeader As Any, CLSID As Any, IID As Any, lpOutObject As IUnknown) As Long

为了调用这个函数，我们需要想办法获取到 VbHeader 结构体的地址，并且需要有个合理的 CLSID 和 IID 来让 VBDllGetClassObject 真正去生产一个类。经过一段时间的搜索后，我找到一段代码提示了我如何去获取 VbHeader 的地址：

Private Function GetVBHeader() As Long
    Dim Ptr As Long
    ' Get e_lfanew
    GetMem4 ByVal hInst + &H3C, Ptr
    ' Get AddressOfEntryPoint
    GetMem4 ByVal Ptr + &H28 + hInst, Ptr
    ' Get VBHeader
    GetMem4 ByVal Ptr + hInst + 1, GetVBHeader
End Function
复制代码

其中的 GetMem4 是 MSVBVM60.DLL 的导出函数，它可以像这样声明：

Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, Target As Any)

经过一些测试，我发现如果在 VB6 IDE 里面运行，获取的 VbHeader 的地址在很高的地方（地址最高位是 1），利用这一点可以判断代码是运行在 IDE 里面还是编译出来 EXE 运行。另外我还发现使用全零的 CLSID 和有一些改动的 IID 是可以成功进行这个函数的调用的，虽然会导致这个函数返回 0x80040111（CLASS_E_CLASSNOTAVAILABLE 解释为“该类不可用”）但它可以完成对 VB6 运行时环境的初始化。



根据测试，经过一系列初始化后，可以在线程函数里使用 API、Form、控件属性、MsgBox等。可以说是完美实现了 VB6 的多线程。

在 IDE 里面调试的话，似乎只能创建出一个线程。但这个线程是可以正常工作的。而且如果主线程先于这个线程退出，则会在这个线程退出后，直接造成 VB6 的 IDE 闪退。

代码全部整理下来，做到一个 BAS 里即可使用：

Option Explicit

Private Type VbHeader
    szVbMagic               As String * 4
    wRuntimeBuild           As Integer
    szLangDll               As String * 14
    szSecLangDll            As String * 14
    wRuntimeRevision        As Integer
    dwLCID                  As Long
    dwSecLCID               As Long
    lpSubMain               As Long
    lpProjectInfo           As Long
    fMdlIntCtls             As Long
    fMdlIntCtls2            As Long
    dwThreadFlags           As Long
    dwThreadCount           As Long
    wFormCount              As Integer
    wExternalCount          As Integer
    dwThunkCount            As Long
    lpGuiTable              As Long
    lpExternalCompTable     As Long
    lpComRegisterData       As Long
    bszProjectDescription   As Long
    bszProjectExeName       As Long
    bszProjectHelpFile      As Long
    bszProjectName          As Long
End Type

Private Type SECURITY_ATTRIBUTES
    nLength As Long
    lpSecurityDescriptor As Long
    bInheritHandle As Long
End Type

Private Declare Function CreateThread Lib "kernel32" (lpThreadAttributes As Any, dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function UserDllMain Lib "msvbvm60" (OutInstance As Long, ByVal Unused As Long, ByVal hInstDll As Long, ByVal dwReason As Long, ByVal lpReserved As Long) As Long
Private Declare Function CreateIExprSrvObj Lib "msvbvm60" (Optional ByVal Reserved As Long, Optional ByVal Size As Long = 4, Optional ByVal Fail As Boolean) As IUnknown
Private Declare Function VBDllGetClassObject Lib "msvbvm60" (lpHInstDll As Long, ByVal Reserved As Long, lpVBHeader As Any, CLSID As Any, IID As Any, lpOutObject As IUnknown) As Long
Private Declare Function FuncAddr Lib "msvbvm60" Alias "VarPtr" (ByVal AddressOfSomething As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, Target As Any)

Private MTInst As Long
Private hInst As Long
Private VBHPtr As Long, NewVBH As VbHeader
Private MT_CLSID(15) As Byte
Private MT_IID_IUnknown(15) As Byte
Public Const DLL_PROCESS_ATTACH As Long = 1
Public Const DLL_THREAD_ATTACH As Long = 2
Public Const DLL_THREAD_DETACH As Long = 3
Public Const DLL_PROCESS_DETACH As Long = 0

Sub Main()
MT_Init

Load Form1
Form1.Show
End Sub

Sub MT_Init()
hInst = App.hInstance
MT_IID_IUnknown(8) = &HC0
MT_IID_IUnknown(15) = &H46
VBHPtr = GetVBHeaderPtr
If VBHPtr > 0 Then
    CopyMemory NewVBH, ByVal VBHPtr, Len(NewVBH)
    NewVBH.lpSubMain = FuncAddr(AddressOf DummySubMain)
End If
End Sub

Sub StartNewThread(Optional ByVal ThreadParam As Long, Optional Out_ThreadId As Long)
CloseHandle CreateThread(ByVal 0, 0, AddressOf ThreadEntry, ThreadParam, 0, Out_ThreadId)
End Sub

Sub DummySubMain()
'空过程
End Sub

Private Function GetVBHeaderPtr() As Long
Dim Ptr As Long
' Get e_lfanew
GetMem4 ByVal hInst + &H3C, Ptr
' Get AddressOfEntryPoint
GetMem4 ByVal Ptr + &H28 + hInst, Ptr
' Get VBHeader
GetMem4 ByVal Ptr + hInst + 1, GetVBHeaderPtr
End Function

Private Function ThreadEntry(ByVal ThreadParam As Long) As Long
'初始化线程
Dim ESO As IUnknown, ClassObj As IUnknown
Set ESO = CreateIExprSrvObj()
UserDllMain MTInst, 0, hInst, DLL_THREAD_ATTACH, 0
If VBHPtr > 0 Then VBDllGetClassObject MTInst, 0, NewVBH, MT_CLSID(0), MT_IID_IUnknown(0), ClassObj

'在这里写你的多线程内容
Sleep 100
MsgBox "线程函数：测试" & ThreadParam, , "测试"

'线程退出
UserDllMain MTInst, 0, hInst, DLL_THREAD_DETACH, 0
End Function
复制代码

简易多线程.zip (2.28 KB, 下载次数: 3, 售价: 20 个宅币)

2022-7-6 20:35 上传

点击文件名下载附件

0xAA55

另外根据网上搜到的 VbHeader 结构体的声明：

Private Type VbHeader
    szVbMagic               As String * 4
    wRuntimeBuild           As Integer
    szLangDll               As String * 14
    szSecLangDll            As String * 14
    wRuntimeRevision        As Integer
    dwLCID                  As Long
    dwSecLCID               As Long
    lpSubMain               As Long
    lpProjectInfo           As Long
    fMdlIntCtls             As Long
    fMdlIntCtls2            As Long
    dwThreadFlags           As Long
    dwThreadCount           As Long
    wFormCount              As Integer
    wExternalCount          As Integer
    dwThunkCount            As Long
    lpGuiTable              As Long
    lpExternalCompTable     As Long
    lpComRegisterData       As Long
    bszProjectDescription   As Long
    bszProjectExeName       As Long
    bszProjectHelpFile      As Long
    bszProjectName          As Long
End Type
复制代码

我发现用 CopyMemory 根据取得的 VBHeader 地址复制到上述结构体内的数据用 MsgBox 显示出来后，内容是对的。

我依稀记得以前的 VB6 反编译工具也通过分析这个头文件可以获取到非常完整的 Form 窗口设计相关数据。

Golden Blonde

这看起来很厉害！

根据你上文引用的链接，我又找到了另外一个帖子，不知道对你是否有参考价值。

关于判断代码是否在IDE里运行，VBProFan在很多年前就发现了一个非常简单的方法：在IDE中，App.LogMode = 0；编译后，App.LogMode = 1。

最后，求VC调用OCX的例子。简而言之，就是怎么在某个HWND上创建控件，然后调用其方法和设置其属性。

系统消息

0xAA55 发表于 2022-7-6 20:44
另外根据网上搜到的 VbHeader 结构体的声明：[code]Private Type VbHeader
    szVbMagic   ...

对，就是这个VbHeader的lpSubMain，储存的Sub Main地址，每个线程第一次执行的 VBDllGetClassObject 的时候都会执行 Sub Main 函数，把它改掉就可以只主线程执行一次了。

系统消息

Golden Blonde 发表于 2022-7-7 00:46
这看起来很厉害！

根据你上文引用的链接，我又找到了另外一个帖子，不知道对你是否有参考价值。

VC调用OCX的例子网上有，以前我就跟着这个贴子学的：
http://www.cppblog.com/Streamlet/archive/2012/09/01/188962.html
http://www.cppblog.com/Streamlet/archive/2012/09/04/189470.html

tlwh163

老实说没看懂 请问现在完美到什么程度？ 有多线程VB6又可以屌很久了

0xAA55

tlwh163 发表于 2022-7-10 18:24
老实说没看懂 请问现在完美到什么程度？ 有多线程VB6又可以屌很久了

用了 CreateIExprSrvObj 然后用了 ActiveX Dll 的初始化函数。

只用 CreateIExprSrvObj 是无法使用 MsgBox 的，以及 Form 相关。

加了 ActiveX Dll 的初始化函数后，可以用 MsgBox 以及界面、控件相关的功能了。

缺点是每次创建线程都会导致 Sub Main 被执行一次。

tlwh163

谢谢！

线程的暂停 恢复啥的 该怎么弄呢

0xAA55

tlwh163 发表于 2022-7-11 07:30
谢谢！

线程的暂停 恢复啥的 该怎么弄呢

这个直接用 API 就好。

暂停线程：
Declare Function SuspendThread lib "kernel32" (ByVal hThread As Long) As Long

继续线程：
Declare Function ResumeThread lib "kernel32" (ByVal hThread As Long) As Long

https://docs.microsoft.com/en-us ... dsapi-suspendthread
https://docs.microsoft.com/en-us ... adsapi-resumethread

Golden Blonde

0xAA55 发表于 2022-7-10 19:12
用了 CreateIExprSrvObj 然后用了 ActiveX Dll 的初始化函数。

只用 CreateIExprSrvObj 是无法使用 MsgB ...

静态变量或全局变量有效么？如果有效的话，只需要在里面加一个bIsExecuted即可。

Ayala

折腾一堆，有逆向技术解决vb6线程安全的一般都没必要用vb写多线程了

0xAA55

Golden Blonde 发表于 2022-7-14 07:04
静态变量或全局变量有效么？如果有效的话，只需要在里面加一个bIsExecuted即可。 ...

我编辑了帖子，修改了代码（撅了一个指针），解决了 SubMain 重入的问题。

0xAA55

Ayala 发表于 2022-7-14 22:10
折腾一堆，有逆向技术解决vb6线程安全的一般都没必要用vb写多线程了

我其实很久没玩 VB 了，现在只用虚拟机 XP 跑 VB6。

xiawan

楼主大能，感谢感谢

搬砖工

看这个样例，好像并没有用到UserDLLMain这个API
https://github.com/thetrik/VbTrickThreading

0xAA55

搬砖工 发表于 2022-9-6 11:38
看这个样例，好像并没有用到UserDLLMain这个API
https://github.com/thetrik/VbTrickThreading ...

确实。你给的样例挺不错的。

W741

大佬又给vb6续命了

aguai2008

不错，看看好不好