找回密码
 立即注册→加入我们

QQ登录

只需一步,快速开始

搜索
热搜: 下载 VB C 实现 编写
查看: 2904|回复: 19

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

[复制链接]

1111

主题

1651

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24237 个
贡献
46222 次
宅之契约
0 份
在线时间
2297 小时
注册时间
2014-1-26
发表于 2022-7-6 19:48:37 | 显示全部楼层 |阅读模式

欢迎访问技术宅的结界,请注册或者登录吧。

您需要 登录 才可以下载或查看,没有账号?立即注册→加入我们

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

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



根据坛友“系统消息”的提示,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、第二个参数从未被使用过。

屏幕截图 2022-07-06 203714.png

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

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

屏幕截图 2022-07-06 203801.png

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

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 的地址:
  1. Private Function GetVBHeader() As Long
  2.     Dim Ptr As Long
  3.     ' Get e_lfanew
  4.     GetMem4 ByVal hInst + &H3C, Ptr
  5.     ' Get AddressOfEntryPoint
  6.     GetMem4 ByVal Ptr + &H28 + hInst, Ptr
  7.     ' Get VBHeader
  8.     GetMem4 ByVal Ptr + hInst + 1, GetVBHeader
  9. 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 运行时环境的初始化。

屏幕截图 2022-07-06 203336.png

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

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

代码全部整理下来,做到一个 BAS 里即可使用:
  1. Option Explicit

  2. Private Type VbHeader
  3.     szVbMagic               As String * 4
  4.     wRuntimeBuild           As Integer
  5.     szLangDll               As String * 14
  6.     szSecLangDll            As String * 14
  7.     wRuntimeRevision        As Integer
  8.     dwLCID                  As Long
  9.     dwSecLCID               As Long
  10.     lpSubMain               As Long
  11.     lpProjectInfo           As Long
  12.     fMdlIntCtls             As Long
  13.     fMdlIntCtls2            As Long
  14.     dwThreadFlags           As Long
  15.     dwThreadCount           As Long
  16.     wFormCount              As Integer
  17.     wExternalCount          As Integer
  18.     dwThunkCount            As Long
  19.     lpGuiTable              As Long
  20.     lpExternalCompTable     As Long
  21.     lpComRegisterData       As Long
  22.     bszProjectDescription   As Long
  23.     bszProjectExeName       As Long
  24.     bszProjectHelpFile      As Long
  25.     bszProjectName          As Long
  26. End Type

  27. Private Type SECURITY_ATTRIBUTES
  28.     nLength As Long
  29.     lpSecurityDescriptor As Long
  30.     bInheritHandle As Long
  31. End Type

  32. 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
  33. Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  34. 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
  35. Private Declare Function CreateIExprSrvObj Lib "msvbvm60" (Optional ByVal Reserved As Long, Optional ByVal Size As Long = 4, Optional ByVal Fail As Boolean) As IUnknown
  36. 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
  37. Private Declare Function FuncAddr Lib "msvbvm60" Alias "VarPtr" (ByVal AddressOfSomething As Long) As Long
  38. Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
  39. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  40. Private Declare Sub GetMem4 Lib "msvbvm60" (ByVal Addr As Long, Target As Any)

  41. Private MTInst As Long
  42. Private hInst As Long
  43. Private VBHPtr As Long, NewVBH As VbHeader
  44. Private MT_CLSID(15) As Byte
  45. Private MT_IID_IUnknown(15) As Byte
  46. Public Const DLL_PROCESS_ATTACH As Long = 1
  47. Public Const DLL_THREAD_ATTACH As Long = 2
  48. Public Const DLL_THREAD_DETACH As Long = 3
  49. Public Const DLL_PROCESS_DETACH As Long = 0

  50. Sub Main()
  51. MT_Init

  52. Load Form1
  53. Form1.Show
  54. End Sub

  55. Sub MT_Init()
  56. hInst = App.hInstance
  57. MT_IID_IUnknown(8) = &HC0
  58. MT_IID_IUnknown(15) = &H46
  59. VBHPtr = GetVBHeaderPtr
  60. If VBHPtr > 0 Then
  61.     CopyMemory NewVBH, ByVal VBHPtr, Len(NewVBH)
  62.     NewVBH.lpSubMain = FuncAddr(AddressOf DummySubMain)
  63. End If
  64. End Sub

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

  68. Sub DummySubMain()
  69. '空过程
  70. End Sub

  71. Private Function GetVBHeaderPtr() As Long
  72. Dim Ptr As Long
  73. ' Get e_lfanew
  74. GetMem4 ByVal hInst + &H3C, Ptr
  75. ' Get AddressOfEntryPoint
  76. GetMem4 ByVal Ptr + &H28 + hInst, Ptr
  77. ' Get VBHeader
  78. GetMem4 ByVal Ptr + hInst + 1, GetVBHeaderPtr
  79. End Function

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

  86. '在这里写你的多线程内容
  87. Sleep 100
  88. MsgBox "线程函数:测试" & ThreadParam, , "测试"

  89. '线程退出
  90. UserDllMain MTInst, 0, hInst, DLL_THREAD_DETACH, 0
  91. End Function
复制代码
简易多线程.zip (2.28 KB, 下载次数: 4, 售价: 20 个宅币)




本帖被以下淘专辑推荐:

回复

使用道具 举报

1111

主题

1651

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24237 个
贡献
46222 次
宅之契约
0 份
在线时间
2297 小时
注册时间
2014-1-26
 楼主| 发表于 2022-7-6 20:44:44 | 显示全部楼层
另外根据网上搜到的 VbHeader 结构体的声明:
  1. Private Type VbHeader
  2.     szVbMagic               As String * 4
  3.     wRuntimeBuild           As Integer
  4.     szLangDll               As String * 14
  5.     szSecLangDll            As String * 14
  6.     wRuntimeRevision        As Integer
  7.     dwLCID                  As Long
  8.     dwSecLCID               As Long
  9.     lpSubMain               As Long
  10.     lpProjectInfo           As Long
  11.     fMdlIntCtls             As Long
  12.     fMdlIntCtls2            As Long
  13.     dwThreadFlags           As Long
  14.     dwThreadCount           As Long
  15.     wFormCount              As Integer
  16.     wExternalCount          As Integer
  17.     dwThunkCount            As Long
  18.     lpGuiTable              As Long
  19.     lpExternalCompTable     As Long
  20.     lpComRegisterData       As Long
  21.     bszProjectDescription   As Long
  22.     bszProjectExeName       As Long
  23.     bszProjectHelpFile      As Long
  24.     bszProjectName          As Long
  25. End Type
复制代码
我发现用 CopyMemory 根据取得的 VBHeader 地址复制到上述结构体内的数据用 MsgBox 显示出来后,内容是对的。

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

使用道具 举报

55

主题

275

回帖

9352

积分

用户组: 管理员

UID
77
精华
16
威望
237 点
宅币
8217 个
贡献
251 次
宅之契约
0 份
在线时间
254 小时
注册时间
2014-2-22
发表于 2022-7-7 00:46:52 | 显示全部楼层
这看起来很厉害!

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

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

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

使用道具 举报

9

主题

176

回帖

1万

积分

用户组: 真·技术宅

UID
4293
精华
6
威望
441 点
宅币
8670 个
贡献
850 次
宅之契约
0 份
在线时间
338 小时
注册时间
2018-9-19
发表于 2022-7-7 23:07:18 | 显示全部楼层
0xAA55 发表于 2022-7-6 20:44
另外根据网上搜到的 VbHeader 结构体的声明:[code]Private Type VbHeader
    szVbMagic   ...

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

使用道具 举报

9

主题

176

回帖

1万

积分

用户组: 真·技术宅

UID
4293
精华
6
威望
441 点
宅币
8670 个
贡献
850 次
宅之契约
0 份
在线时间
338 小时
注册时间
2018-9-19
发表于 2022-7-7 23:11:54 | 显示全部楼层
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
回复 赞! 靠!

使用道具 举报

1

主题

42

回帖

979

积分

用户组: 大·技术宅

UID
7437
精华
0
威望
112 点
宅币
602 个
贡献
110 次
宅之契约
0 份
在线时间
131 小时
注册时间
2021-9-11
发表于 2022-7-10 18:24:46 | 显示全部楼层
老实说没看懂 请问现在完美到什么程度? 有多线程VB6又可以屌很久了
回复 赞! 靠!

使用道具 举报

1111

主题

1651

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24237 个
贡献
46222 次
宅之契约
0 份
在线时间
2297 小时
注册时间
2014-1-26
 楼主| 发表于 2022-7-10 19:12:22 | 显示全部楼层
tlwh163 发表于 2022-7-10 18:24
老实说没看懂 请问现在完美到什么程度? 有多线程VB6又可以屌很久了

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

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

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

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

使用道具 举报

1

主题

42

回帖

979

积分

用户组: 大·技术宅

UID
7437
精华
0
威望
112 点
宅币
602 个
贡献
110 次
宅之契约
0 份
在线时间
131 小时
注册时间
2021-9-11
发表于 2022-7-11 07:30:28 | 显示全部楼层
谢谢!

线程的暂停 恢复啥的 该怎么弄呢
回复 赞! 靠!

使用道具 举报

1111

主题

1651

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24237 个
贡献
46222 次
宅之契约
0 份
在线时间
2297 小时
注册时间
2014-1-26
 楼主| 发表于 2022-7-11 09:18:17 | 显示全部楼层
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
回复 赞! 靠!

使用道具 举报

55

主题

275

回帖

9352

积分

用户组: 管理员

UID
77
精华
16
威望
237 点
宅币
8217 个
贡献
251 次
宅之契约
0 份
在线时间
254 小时
注册时间
2014-2-22
发表于 2022-7-14 07:04:05 | 显示全部楼层
0xAA55 发表于 2022-7-10 19:12
用了 CreateIExprSrvObj 然后用了 ActiveX Dll 的初始化函数。

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

静态变量或全局变量有效么?如果有效的话,只需要在里面加一个bIsExecuted即可。
回复 赞! 靠!

使用道具 举报

30

主题

211

回帖

2782

积分

用户组: 版主

UID
1821
精华
7
威望
69 点
宅币
2162 个
贡献
206 次
宅之契约
0 份
在线时间
480 小时
注册时间
2016-7-12
发表于 2022-7-14 22:10:48 | 显示全部楼层
折腾一堆,有逆向技术解决vb6线程安全的一般都没必要用vb写多线程了
回复 赞! 靠!

使用道具 举报

1111

主题

1651

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24237 个
贡献
46222 次
宅之契约
0 份
在线时间
2297 小时
注册时间
2014-1-26
 楼主| 发表于 2022-7-15 10:22:35 | 显示全部楼层
Golden Blonde 发表于 2022-7-14 07:04
静态变量或全局变量有效么?如果有效的话,只需要在里面加一个bIsExecuted即可。 ...

我编辑了帖子,修改了代码(撅了一个指针),解决了 SubMain 重入的问题。
回复 赞! 靠!

使用道具 举报

1111

主题

1651

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24237 个
贡献
46222 次
宅之契约
0 份
在线时间
2297 小时
注册时间
2014-1-26
 楼主| 发表于 2022-7-15 10:23:22 | 显示全部楼层
Ayala 发表于 2022-7-14 22:10
折腾一堆,有逆向技术解决vb6线程安全的一般都没必要用vb写多线程了

我其实很久没玩 VB 了,现在只用虚拟机 XP 跑 VB6。
回复 赞! 靠!

使用道具 举报

1

主题

159

回帖

624

积分

用户组: 大·技术宅

UID
7535
精华
0
威望
0 点
宅币
464 个
贡献
0 次
宅之契约
0 份
在线时间
71 小时
注册时间
2021-10-16
发表于 2022-7-20 09:01:01 | 显示全部楼层

楼主大能,感谢感谢
回复 赞! 靠!

使用道具 举报

0

主题

41

回帖

89

积分

用户组: 小·技术宅

UID
1457
精华
0
威望
2 点
宅币
44 个
贡献
0 次
宅之契约
0 份
在线时间
8 小时
注册时间
2016-1-29
发表于 2022-9-6 11:38:25 | 显示全部楼层
看这个样例,好像并没有用到UserDLLMain这个API
https://github.com/thetrik/VbTrickThreading
回复 赞! 靠!

使用道具 举报

1111

主题

1651

回帖

7万

积分

用户组: 管理员

一只技术宅

UID
1
精华
244
威望
743 点
宅币
24237 个
贡献
46222 次
宅之契约
0 份
在线时间
2297 小时
注册时间
2014-1-26
 楼主| 发表于 2022-9-6 12:21:29 | 显示全部楼层
搬砖工 发表于 2022-9-6 11:38
看这个样例,好像并没有用到UserDLLMain这个API
https://github.com/thetrik/VbTrickThreading ...

确实。你给的样例挺不错的。
回复 赞! 靠!

使用道具 举报

0

主题

22

回帖

47

积分

用户组: 初·技术宅

UID
7859
精华
0
威望
2 点
宅币
21 个
贡献
0 次
宅之契约
0 份
在线时间
9 小时
注册时间
2022-5-24
发表于 2023-4-6 13:42:57 | 显示全部楼层
大佬又给vb6续命了
回复 赞! 靠!

使用道具 举报

0

主题

9

回帖

13

积分

用户组: 初·技术宅

UID
5120
精华
0
威望
2 点
宅币
0 个
贡献
0 次
宅之契约
0 份
在线时间
1 小时
注册时间
2019-7-9
发表于 2023-4-19 23:56:32 | 显示全部楼层
不错,看看好不好
回复 赞! 靠!

使用道具 举报

0

主题

27

回帖

59

积分

用户组: 小·技术宅

UID
8351
精华
0
威望
2 点
宅币
28 个
贡献
0 次
宅之契约
0 份
在线时间
5 小时
注册时间
2023-7-5
发表于 2023-7-5 19:03:36 | 显示全部楼层
大神,怎么下载啊,分不够呢
回复 赞! 靠!

使用道具 举报

0

主题

27

回帖

59

积分

用户组: 小·技术宅

UID
8351
精华
0
威望
2 点
宅币
28 个
贡献
0 次
宅之契约
0 份
在线时间
5 小时
注册时间
2023-7-5
发表于 2023-7-6 10:59:48 | 显示全部楼层
不好,会崩掉哦
回复 赞! 靠!

使用道具 举报

QQ|Archiver|小黑屋|技术宅的结界 ( 滇ICP备16008837号 )|网站地图

GMT+8, 2024-4-21 00:12 , Processed in 0.054985 second(s), 40 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表