VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 24308|回复: 30

[分享] 科普VB多线程:精简封装VB多线程代码,注入DLL显示窗口代码 (代码)

  [复制链接]
 楼主| 发表于 2011-10-26 20:42:01 | 显示全部楼层 |阅读模式
本帖最后由 菜鸟学飞 于 2011-10-27 18:42 编辑

这里的代码和原理来自于download和amicy 的多线程代码,VB完美的运行多线程已经有好长一段时间了,似乎感觉少有人用这个东西,本人闲来无事 整理了一下代码,在这里向VB多线程新手推广一下.
代码我已经整理成了两个函数
值得注意的是 如果你要使用多线程或者用VB写DLL 那么请将你的程序入口改为sub main(工程属性 > 启动对象 设置为 sub main)
  1. '============================================
  2. '| 函 数 名 | VBCreateThread
  3. '| 说    明 | 创建一个线程(Create a thread)
  4. '| 参    数 | lpStartAddress:   线程函数地址(thread function address )
  5. '| 参    数 | lpParam:          线程参数(thread param)
  6. '| 参    数 | lpThreadId:       线程ID(tid)
  7. '| 返 回 值 | 返回线程句柄(hThread)
  8. '============================================
  9. Public Function VBCreateThread(ByVal lpStartAddress As Long, ByVal lpParam As Long, Optional ByRef lpThreadId As Long = 0) As Long

  10. '======================================================
  11. '| 函 数 名 | InitVB
  12. '| 说    明 | 初始化VB运行库(Init vb runtime),仅仅使用在DllMain的开头,在你的线程代码里面不需要调用这个东西
  13. '| 参    数 | 无 (void)
  14. '| 返 回 值 | 无 (void)
  15. '注意!!!!!!!!!
  16. '为了防止错误 必须将程序入口设置为 sub main (工程属性 > 启动对象 设置为 sub main)
  17. '因为多线程时候会重复调用 sub main或者fromload
  18. '注意!!!!!!
  19. 'InitVB函数会对sub main做处理 InitVB会删除 sub main 的代码
  20. '所以 如果你要重复多次调用 sub main 请另写代码
  21. '如果程序是是DLL 请在dllmain的开头 初始化VB运行库(InitVB)
  22. '=======================================================
  23. Public Function InitVB() As Long
复制代码
如果你是在EXE中使用这个代码 创建多线程如下即可
(需要注意的是,在你的线程函数里面不需要你自己初始化线程环境等
VBCreateThread统统都给你处理好了,线程函数可以参考后面的线程代码)
  1. VBCreateThread AddressOf TestThread, 888
  2. '888是线程的参数
复制代码
如果你想用vb写DLL(包括在DLL中hook api,显示窗口等)那么请如下操作
  1. '注意 在DLL MAIN里面 需要初始化VB运行库(InitVB) 才能创建线程
  2. Public Function DllMain(ByVal hinstdll As Long, ByVal fdwReason As Long, ByVal lpvReserved As Long) As Long  'VB标准DLL入口函数
  3.         Const DLL_PROCESS_ATTACH    As Long = 1
  4.         Const DLL_THREAD_ATTACH     As Long = 2
  5.         Const DLL_PROCESS_DETACH    As Long = 0
  6.         Const DLL_THREAD_DETACH     As Long = 3
  7.         Select Case fdwReason
  8.                 Case DLL_PROCESS_ATTACH
  9.                         
  10.                         '初始化VB 运行库
  11.                         InitVB
  12.                         '创建线程
  13.                         VBCreateThread AddressOf TestThread, 888
  14.                                                 
  15.                 Case DLL_THREAD_ATTACH
  16.                 Case DLL_PROCESS_DETACH
  17.                 Case DLL_THREAD_DETACH
  18.         End Select
  19.         DllMain = 1
  20. End Function
复制代码
至于线程函数的代码可以参考下面(线程函数里面不需要InitVB或者做其他初始化VB多线程的事情)
  1. Public Function TestThread(ByVal lpParam As Long) As Long
  2.         'frmMain 是已经设计好的一个窗体
  3.         Dim a As New frmMain
  4.         MsgBox "收到的线程参数是:" & lpParam

  5.         '显示模式窗口 必须是模式否则窗口一闪(要想非模式窗口请自己处理消息循环)
  6.         a.Show 1
  7.         MsgBox "Thread exit"
  8.         Unload a
  9.         Set a = Nothing
  10. End Function
复制代码
所有的完整代码都在这里:注入VB写的DLL 显示窗口 用winsock控件进行 网络通信的

代码可以编译EXE 也可以编译成标准DLL

顺便广告:编译DLL需要下载本人的VB多功能编译插件
http://www.vbgood.com/thread-107527-1-1.html

关于VB dll注入其他进程HOOK API 顺便说几句:
如果你想HOOK一个API比如:OpenProcess,你的HOOK处理函数是:MyOpenProcess,那MyOpenProcess里面你要非常非常小心的写代码,因为目标程序有可能是多个线程调用OpenProcess,而这些线程都是宿主程序建立的线程,没有初始化VB(initVB),如果在MyOpenProcess里面没有处理好 那结果就是崩溃.
我一般的解决方法是:
1、去掉msvbvm60.__vbaSetSystemError ,往__vbaSetSystemError 入口写入ret指令 让其无效,这样调用API就不会出错
副作用就是整个进程里面都不能不能使用 Err.LastDllError,当然你可以自己调用GetLastError,或者不用.
Public Sub KillvbaSetSystemError()
        Dim DllFunAddr As Long
        DllFunAddr = GetProcAddress(LoadLibrary("msvbvm60"), "__vbaSetSystemError")
        WriteProcessMemory -1, ByVal DllFunAddr, &HC3C3C3C3, 4, ByVal 0
End Sub
2、hook处理函数里面(MyOpenProcess)里面不能使用字符串(数组也会经常出错),将所有参数类型定义为long,使用字符串API来处理字符串(如wcscpy)
3、如果hook处理函数里面(MyOpenProcess)里面会涉及非常复杂的操作那么可以将这个操作独立到另外的进程(或者其他已经初始化好的VB线程),使用SendMessage通信(或者其他方式通信),这时hook函数就会只涉及 复制少量参数,传递给主程序,主程序返回值判断,由于操作放到了主程序(或者其他已经初始化好的VB线程),处理代码就不会考虑VB多线程的问题.

CreateProcess例子
Public Function CreateProcessCallBack(ByVal a As Long, ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, ByVal lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDriectory As Long, ByVal lpStartupInfo As Long, ByVal lpProcessInformation As Long, ByVal b As Long) As Long
        Dim tmpp As Long
        Dim tmpProcessinf As PROCESS_INFORMATION
        '通过共享内存获取信息
        GetData ShareMem
        '判断主控程序的窗口句柄是否有效
        If IsWindow(ShareMem.AntiHwnd) <> 0 Then
                '将参数写入到共享内存里面 这里不是线程安全的 有可能会崩溃
                tmpp = pShareMem + 12
                Call wcscpy(ByVal tmpp, ByVal lpApplicationName)
                tmpp = pShareMem + 12 + 1000
                Call wcscpy(ByVal tmpp, ByVal lpCommandLine)
               
                If SendMessage(ShareMem.AntiHwnd, &H400, 0, ByVal 0) = 0 Then '发送消息
                        CreateProcessCallBack = 0   '拒绝启动
                Else
                        '允许启动
                        tmpp = dwCreationFlags
                        dwCreationFlags = dwCreationFlags Or CREATE_SUSPENDED '打上挂起标记
                        
                        CreateProcessCallBack = CreateProcessJmpBack(a, lpApplicationName, lpCommandLine, lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDriectory, lpStartupInfo, lpProcessInformation, b)
                        
                        CopyMemory tmpProcessinf, ByVal lpProcessInformation, LenB(tmpProcessinf)
                        InjectMyself tmpProcessinf.hProcess     '在挂起的进程中注入DLL
                        
                          
                        If (tmpp And CREATE_SUSPENDED) <> CREATE_SUSPENDED Then '如果有挂起标记则不恢复运行
                                ResumeThread tmpProcessinf.hThread  '恢复运行
                        End If
                End If

        Else
                CreateProcessCallBack = CreateProcessJmpBack(a, lpApplicationName, lpCommandLine, lpProcessAttributes, lpThreadAttributes, bInheritHandles, dwCreationFlags, lpEnvironment, lpCurrentDriectory, lpStartupInfo, lpProcessInformation, b)
        End If
End Function


补充内容 (2011-11-4 12:54):
注意
多线程都会调用VBDllGetClassObject 这个函数有个很严重的问题 会清空当前模块的所有全局变量
关于这个问题 暂无解决办法
问题详见http://www.vbgood.com/thread-107708-1-2.html

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?立即注册

x

评分

参与人数 10威望 +47 人气 +13 收起 理由
hyyly + 5 + 1 很给力!
qq275158045 + 1 + 1 win7 64位是不是创建线程有问题啊!
ghostelove + 1 很给力!
mfkfpb + 1 赞一个!
flash + 8 + 1 3好像是pjz的歪门斜道吧... :D
Inndy + 3 + 1 牛!
peace2008 + 2 + 1 赞一个!
dahual + 16 + 3 就是牛!
acme_pjz + 10 + 3 精品文章
junyuqin + 2 很给力!

查看全部评分

本帖被以下淘专辑推荐:

发表于 2011-10-26 20:42:02 | 显示全部楼层
O(∩_∩)O哈哈~,沙发是我的啦
acme_pjz 于 2011-10-26 21:50 使用 抢沙发 抢夺本帖沙发

点评

....  发表于 2011-10-27 12:29
回复 支持 反对

使用道具 举报

发表于 2011-10-26 20:46:43 | 显示全部楼层
沙花

感谢整理
回复 支持 反对

使用道具 举报

头像被屏蔽
发表于 2011-10-26 22:55:45 | 显示全部楼层
整理都整理的这么漂亮,牛X。

这里的代码和原理来自于download和amicy 的多线程代码,VB完美的运行多线程已经有好长一段时间了,

感谢大牛小牛们!!
说实在的,虽然我某些时候使用vb多线程,但到目前为止我还没有放心完美地运行过vb多线程。
这个确实已经很不错了,不过注入某个进程貌似只能生效一次。


补充内容 (2011-11-1 17:42):
俺的失误,一切正常。
回复 支持 反对

使用道具 举报

发表于 2011-10-27 00:00:04 | 显示全部楼层
本帖最后由 tgy 于 2011-10-27 00:01 编辑

文中虽然没有提及我写的GetFakeH函数,并且已经作了一些修改,但我还是要提醒一下:"VB5!"标志串如果刚好处在mdat()的尾或首,并被从中间分开到两次读出的mdat()中,那函数将找不到VB头(或找到不正确的VB头),所以我原来的函数是多加了10个字节的富余量来解决这个问题,不知楼主考虑过这个问题没有,你的函数中似乎没有看到如何解决这种情况的出现。
回复 支持 反对

使用道具 举报

发表于 2011-10-27 09:12:40 | 显示全部楼层
crash in ide

点评

呃 这个我似乎没有什么很好的办法.  发表于 2011-10-27 18:43
回复 支持 反对

使用道具 举报

 楼主| 发表于 2011-10-27 18:22:17 | 显示全部楼层
本帖最后由 菜鸟学飞 于 2011-10-27 18:44 编辑
tgy 发表于 2011-10-27 00:00
文中虽然没有提及我写的GetFakeH函数,并且已经作了一些修改,但我还是要提醒一下:"VB5!"标志串如果刚好处 ...


好吧~~ 我承认...用了你的代码忘了注明出处
关于查找"VB5!",根据我的观察 一般来说 VB5! 在模块句柄+4kb 到 8kb的范围
所以我感觉(仅仅是感觉) 我一次性在模块句柄+4kb处 读取4kb的内容 查找是可以查找出来 并且不会出现截取一半的情况


还有动态加载卸载的问题...似乎不好处理...
回复 支持 反对

使用道具 举报

发表于 2011-10-27 19:59:04 | 显示全部楼层
本帖最后由 tgy 于 2011-10-27 20:13 编辑

VB5! 的位置似乎和模块中的函数数量有关,包括声明的API函数。所以必须确保万无一失,用copymemory的话,如果找不到VB5!超出进程内存空间将会出现内存不能为读的错误。
我写的DLL,静态调用DLL时,退出进程时会有内存不能为读错误,至今都还没解决呢。而动态调用也不能正常释放。

点评

估计退出的时候也要调用一次VBxxxx之类的函数  发表于 2011-10-27 20:16
回复 支持 反对

使用道具 举报

发表于 2011-10-29 15:14:36 | 显示全部楼层
本帖最后由 sexfio 于 2011-10-29 15:14 编辑

可惜,看不懂啊,能否改写个简单的例子,别人把代码放进去就可以变多线程的?
回复 支持 反对

使用道具 举报

发表于 2011-10-31 02:41:53 | 显示全部楼层
有空测试一下~`
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2022-6-29 11:26

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表