请教下有什么办法把下面bas模块中代码挪到类模块中?

无·法 2020-01-11 12:18:30


上述截图的工程打包下载: https://pan.baidu.com/s/1ZYMFQJ3fHXZiH75KM-JjSw 提取码: 5fc3

在发帖之前我已经多次在网上搜寻过方法了,得到的答案基本都是说AddressOf指向的函数要放在bas模块中,可我还是想放到类模块中,最终目的就是不要bas模块,消灭掉bas模块。有个帖子讲的是用子类化的办法取得函数地址,但是试了几次没有成功,相关帖子:https://bbs.csdn.net/topics/340178678,各位有经验的帮忙看看,另附上嗷嗷叫的老马整理的子类化范例:https://pan.baidu.com/s/1d4O6xnz3svRbgbb-ZnPSmg 提取码: k7if

截图的代码是我从之前的一个开源框架里分离出来的,就是想让这个框架的代码都放在一个cls中。有关这个框架的介绍:
https://github.com/sysdzw/clswindow
...全文
624 36 打赏 收藏 转发到动态 举报
AI 作业
写回复
用AI写文章
36 条回复
切换为时间正序
请发表友善的回复…
发表回复
舉杯邀明月 2020-02-27
  • 打赏
  • 举报
回复
引用 33 楼 版祖 的回复:
[quote=引用 31 楼 舉杯邀明月 的回复:]
[quote=引用 30 楼 版祖 的回复:]
谢谢楼上了,已经放弃使用这个办法了。

我感觉你在24楼说的那些系统,好像都是服务器的?
(并且,你是租用的“虚拟主机”服务器吧? )
是不是它的指令系统不一样呢?

难道你用标准模块回调的代码,在那些系统下就都能正常运行的?
[/quote]这个贴结应该能助你一朵小红花[/quote]
刚才看了一下,1月份475分,没花。

舉杯邀明月 2020-02-27
  • 打赏
  • 举报
回复
引用 33 楼 版祖 的回复:
[quote=引用 31 楼 舉杯邀明月 的回复:]
[quote=引用 30 楼 版祖 的回复:]
谢谢楼上了,已经放弃使用这个办法了。

我感觉你在24楼说的那些系统,好像都是服务器的?
(并且,你是租用的“虚拟主机”服务器吧? )
是不是它的指令系统不一样呢?

难道你用标准模块回调的代码,在那些系统下就都能正常运行的?
[/quote]这个贴结应该能助你一朵小红花[/quote]
这是元月结贴的吧,不够500分,是没花的。

不过,早已经不在意这些了,都是浮云…………
舉杯邀明月 2020-02-27
  • 打赏
  • 举报
回复
难道我记错了?
如果真是“前几天结贴”的,那么这个月就有小红花了。
无·法 2020-02-27
  • 打赏
  • 举报
回复
引用 34 楼 舉杯邀明月 的回复:
[quote=引用 33 楼 版祖 的回复:]
[quote=引用 31 楼 舉杯邀明月 的回复:]
[quote=引用 30 楼 版祖 的回复:]
谢谢楼上了,已经放弃使用这个办法了。

我感觉你在24楼说的那些系统,好像都是服务器的?
(并且,你是租用的“虚拟主机”服务器吧? )
是不是它的指令系统不一样呢?

难道你用标准模块回调的代码,在那些系统下就都能正常运行的?
[/quote]这个贴结应该能助你一朵小红花[/quote]
这是元月结贴的吧,不够500分,是没花的。

不过,早已经不在意这些了,都是浮云…………[/quote]
原来还要500分呢啊。。我是前两天结的帖子啊
无·法 2020-02-27
  • 打赏
  • 举报
回复
引用 31 楼 舉杯邀明月 的回复:
[quote=引用 30 楼 版祖 的回复:]
谢谢楼上了,已经放弃使用这个办法了。

我感觉你在24楼说的那些系统,好像都是服务器的?
(并且,你是租用的“虚拟主机”服务器吧? )
是不是它的指令系统不一样呢?

难道你用标准模块回调的代码,在那些系统下就都能正常运行的?
[/quote]这个贴结应该能助你一朵小红花
无·法 2020-02-27
  • 打赏
  • 举报
回复
引用 31 楼 舉杯邀明月 的回复:
[quote=引用 30 楼 版祖 的回复:]
谢谢楼上了,已经放弃使用这个办法了。

我感觉你在24楼说的那些系统,好像都是服务器的?
(并且,你是租用的“虚拟主机”服务器吧? )
是不是它的指令系统不一样呢?

难道你用标准模块回调的代码,在那些系统下就都能正常运行的?
[/quote]当然正常了。 几年前在这基础上做过一个qq机器人,放在服务器上运行,控制qq接收和回复消息的,挺稳定。
舉杯邀明月 2020-02-26
  • 打赏
  • 举报
回复
引用 30 楼 版祖 的回复:
谢谢楼上了,已经放弃使用这个办法了。

我感觉你在24楼说的那些系统,好像都是服务器的?
(并且,你是租用的“虚拟主机”服务器吧? )
是不是它的指令系统不一样呢?

难道你用标准模块回调的代码,在那些系统下就都能正常运行的?
无·法 2020-02-25
  • 打赏
  • 举报
回复
谢谢楼上了,已经放弃使用这个办法了。
PctGL 2020-02-05
  • 打赏
  • 举报
回复
杯具, 忘了说了, 这是一个类...

iEnumWindow.cls

添加修改代码, 依照 GetClassProcAddress 的 sincecount 参数解释调整调用 GetEnumWindowsProcAddress
PctGL 2020-02-05
  • 打赏
  • 举报
回复
实在闲得难受... 给你写了个 EnumWindows 专用的...
对于每个不同的回调我觉得还是要单写 LinkProc 函数, 因为内部涉及到一个调试安全性的问题

这个代码, 只在调试状态下简单试了试, 应该问题不大



Option Explicit

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, Optional ByVal Length As Long = 4)
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Any, ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcessHeap Lib "kernel32" () As Long
Private Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal lpMem As Long) As Long
Private Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Dim LinkProc() As Long

Private Sub EnumWindowsProc(Result As Long, ByVal hWnd As Long, ByVal lParam As Long)

Debug.Print hWnd, lParam, Timer


Result = hWnd
End Sub

Sub start()
'// 调用示例
EnumWindows GetEnumWindowsProcAddress(2), 999

End Sub


Private Function GetEnumWindowsProcAddress(ByVal SinceCount As Long) As Long
' 地址指针 = GetWndProcAddress( 取第 N 个公共函数(属性) =或= 所有公共函数个数 + 第 N 个私有函数的函数地址)

Dim PG_OldProtect As Long
Dim mePtr As Long
Dim jmpAddress As Long

mePtr = ObjPtr(Me)
CopyMemory jmpAddress, ByVal mePtr, 4
CopyMemory jmpAddress, ByVal jmpAddress + (SinceCount - 1) * 4 + &H1C, 4

If App.LogMode = 0 Then

ReDim LinkProc(12) As Long

LinkProc(0) = &H83EC8B55
LinkProc(1) = &H75FFFCC4
LinkProc(2) = &H875FF0C
LinkProc(3) = &H1000B9
LinkProc(4) = &H83D1FF00
LinkProc(5) = &H157501F8
LinkProc(6) = &H51FC4D8D
LinkProc(7) = &H200068
LinkProc(8) = &H3000B800
LinkProc(9) = &HD0FF0000
LinkProc(10) = &HEBFC458B
LinkProc(11) = &HC9C03302
LinkProc(12) = &H8C2

CopyMemory ByVal VarPtr(LinkProc(3)) + 1, GetProcAddress(GetModuleHandle("vba6.dll"), "EbMode"), 4& ' Label Sign: 0100000

CopyMemory ByVal VarPtr(LinkProc(7)) + 1, mePtr, 4& ' Label Sign: 0200000

CopyMemory ByVal VarPtr(LinkProc(8)) + 2, jmpAddress, 4& ' Label Sign: 0300000

VirtualProtect ByVal VarPtr(LinkProc(0)), ByVal 52&, ByVal &H40&, PG_OldProtect

Else

ReDim LinkProc(8) As Long

LinkProc(0) = &H83EC8B55
LinkProc(1) = &H75FFFCC4
LinkProc(2) = &H875FF0C
LinkProc(3) = &H50FC458D
LinkProc(4) = &H100068
LinkProc(5) = &H2000B800
LinkProc(6) = &HD0FF0000
LinkProc(7) = &HC9FC458B
LinkProc(8) = &H8C2

CopyMemory ByVal VarPtr(LinkProc(4)) + 1, mePtr, 4& ' Label Sign: 0100000

CopyMemory ByVal VarPtr(LinkProc(5)) + 2, jmpAddress, 4& ' Label Sign: 0200000

VirtualProtect ByVal VarPtr(LinkProc(0)), ByVal 36&, ByVal &H40&, PG_OldProtect

End If

GetEnumWindowsProcAddress = VarPtr(LinkProc(0))

End Function

'' ;// 在编译后, GetEnumWindowsProcAddress 释放以下内嵌汇编代码, 效率最大化
'' ComCallBack1 proc hWnd,lParam
''
'' LOCAL Result
''
'' push lParam
'' push hWnd
''
'' lea eax, Result
'' push eax ;//
''
'' push 1000h ;// objptr(me)
''
'' mov eax,2000h ;// sub: LinkProc
'' Call eax
''
'' mov eax,Result ;// Return Value
''
'' ret
'' ComCallBack1 endp
''
'' ;============================================================================================================================================

'' ;// 在 IDE 调试运行时, GetEnumWindowsProcAddress 释放以下内嵌汇编代码, 用以实现在调试时不崩溃
'' ComCallBack proc hWnd,lParam
''
'' LOCAL Result
''
'' push lParam
'' push hWnd
''
'' mov ecx,1000h
'' call ecx ;// call vba6.dll::EbMode
''
'' .if eax == 1
'' ;// 调试模式下正常运行
'' lea ecx, Result
'' push ecx ;// result
'' push 2000h ;// objptr(me)
'' mov eax,3000h ;// sub: LinkProc
'' Call eax
''
'' mov eax, Result
''
'' .else
'' ;// 调试模式下非正常运行, 中断 打断 断点 结束
'' xor eax,eax
'' .endif
''
'' ret
''
'' ComCallBack endp



threenewbee 2020-01-18
  • 打赏
  • 举报
回复
引用 25 楼 版祖 的回复:
不用再研究了,确定就用微软标准的方法了。。 辛苦了


这很正常,玩小技巧的肯定不能有兼容性。

上次我找了一盘当年火爆销售的《金山词霸III》,直接就把我系统搞挂,进入安全模式禁用了屏幕取词才救回来。

舉杯邀明月 2020-01-17
  • 打赏
  • 举报
回复
引用 24 楼 版祖 的回复:
谢谢楼上大神回复,经过测试发现在win7x64没毛病,但是在其他64位系统大多都报错,比如win2003x64、win2008x64、win2012x64


竟然有这种事情?
无·法 2020-01-17
  • 打赏
  • 举报
回复
不用再研究了,确定就用微软标准的方法了。。 辛苦了
无·法 2020-01-17
  • 打赏
  • 举报
回复
谢谢楼上大神回复,经过测试发现在win7x64没毛病,但是在其他64位系统大多都报错,比如win2003x64、win2008x64、win2012x64

舉杯邀明月 2020-01-15
  • 打赏
  • 举报
回复
类的初始化代码忘记更正了。

用下面这个:
Private Sub Class_Initialize()
lpFunAddr = VarPtr(arrCode(0&)) '
arrCode(0) = 232&
arrCode(1) = &HC2835A00
arrCode(2) = &H40028B2B
arrCode(3) = &H4A8B0289
arrCode(4) = &H7EC13B04
arrCode(5) = &HC2C03307
arrCode(6) = &H90900008
arrCode(7) = &H8B0CC283
arrCode(8) = &H402830A
arrCode(9) = &H424448B
arrCode(10) = &H1B00189
arrCode(11) = &HCC0008C2
End Sub
threenewbee 2020-01-15
  • 打赏
  • 举报
回复
引用 17 楼 舉杯邀明月 的回复:
类模块代码:
Option Explicit

Private Declare Function EnumWindows Lib "user32" (ByVal lpfn As Long, ByVal lParam As Long) As Long
Private arrCode(15) As Long
Private lpFunAddr As Long


Public Function getAllHwnd(ByVal lpBuff As Long, ByVal nCount As Long) As Long
' 入口参数: 缓冲区首址, 缓冲区大小(数据个数)
arrCode(12) = 0 ' 计数
arrCode(13) = nCount ' 缓冲区大小
arrCode(15) = lpBuff ' 传递缓冲区首址
Call EnumWindows(lpFunAddr, 0)
getAllHwnd = arrCode(12)
End Function

Private Sub Class_Initialize()
lpFunAddr = VarPtr(arrCode(0&)) '
arrCode(0) = 232&
arrCode(1) = &HC2835A00
arrCode(2) = &H40028B2B
arrCode(3) = &H3B044A8B
arrCode(4) = &H33057EC1
arrCode(5) = &H8C2C0
arrCode(6) = &HC2830289
arrCode(7) = &H830A8B0C
arrCode(8) = &H448B0402
arrCode(9) = &H1890424
arrCode(10) = &H8C201B0
arrCode(11) = &HCCCCCC00
End Sub


窗体代码(调用示例):
Option Explicit

Private c As New Class1

Private Sub Command1_Click()
Dim arrData(511&) As Long
Dim i As Long, u As Long

' 事先分配一个足够大的缓冲区(Long数组),动态数组或固定数组都可。
' 如果返回值比“给定大小”大,则说明缓冲区小了。
u = c.getAllHwnd(VarPtr(arrData(0&)), 500)
Me.Print "顶层窗口总数:"; u
For i = 0& To u - 1&
Me.Print i, arrData(i)
Next
End Sub

舉杯邀明月 2020-01-15
  • 打赏
  • 举报
回复
类模块代码:
Option Explicit

Private Declare Function EnumWindows Lib "user32" (ByVal lpfn As Long, ByVal lParam As Long) As Long
Private arrCode(15) As Long
Private lpFunAddr As Long


Public Function getAllHwnd(ByVal lpBuff As Long, ByVal nCount As Long) As Long
' 入口参数: 缓冲区首址, 缓冲区大小(数据个数)
arrCode(12) = 0 ' 计数
arrCode(13) = nCount ' 缓冲区大小
arrCode(15) = lpBuff ' 传递缓冲区首址
Call EnumWindows(lpFunAddr, 0)
getAllHwnd = arrCode(12)
End Function

Private Sub Class_Initialize()
lpFunAddr = VarPtr(arrCode(0&)) '
arrCode(0) = 232&
arrCode(1) = &HC2835A00
arrCode(2) = &H40028B2B
arrCode(3) = &H3B044A8B
arrCode(4) = &H33057EC1
arrCode(5) = &H8C2C0
arrCode(6) = &HC2830289
arrCode(7) = &H830A8B0C
arrCode(8) = &H448B0402
arrCode(9) = &H1890424
arrCode(10) = &H8C201B0
arrCode(11) = &HCCCCCC00
End Sub


窗体代码(调用示例):
Option Explicit

Private c As New Class1

Private Sub Command1_Click()
Dim arrData(511&) As Long
Dim i As Long, u As Long

' 事先分配一个足够大的缓冲区(Long数组),动态数组或固定数组都可。
' 如果返回值比“给定大小”大,则说明缓冲区小了。
u = c.getAllHwnd(VarPtr(arrData(0&)), 500)
Me.Print "顶层窗口总数:"; u
For i = 0& To u - 1&
Me.Print i, arrData(i)
Next
End Sub
舉杯邀明月 2020-01-15
  • 打赏
  • 举报
回复
传入的“缓冲区太小”的结果:
舉杯邀明月 2020-01-15
  • 打赏
  • 举报
回复
今天再次修改了一下 回调函数:
如果返回正数,则是枚举完成后顶层窗口句柄的数量;
 反之返回-1:表示“缓冲区大小”不够,
 并且通过“nCount”参数返回需求大小。


' 类代码:
Option Explicit

Private Declare Function EnumWindows Lib "user32" (ByVal lpfn As Long, ByVal lParam As Long) As Long

Private arrCode(15) As Long
Private lpFunAddr As Long


Public Function getAllHwnd(ByVal lpBuff As Long, ByRef nCount As Long) As Long
' 入口参数: 缓冲区首址, 大小
arrCode(13) = lpBuff ' 传递缓冲区首址
arrCode(14) = nCount ' 缓冲区大小
Call EnumWindows(lpFunAddr, 0&)
lpBuff = arrCode(15)
If (-1& = lpBuff) Then
nCount = arrCode(13)
End If
getAllHwnd = lpBuff
End Function

Private Sub Class_Initialize()
lpFunAddr = VarPtr(arrCode(0&)) '
arrCode( 0) = 232&
arrCode( 1) = &H428B5A00
arrCode( 2) = &H83CB8B33
arrCode( 3) = &H3B412FC2
arrCode( 4) = &H890B7CD8
arrCode( 5) = &H842C70A
arrCode( 6) = -1&
arrCode( 7) = &H4A890EEB
arrCode( 8) = &H83028B08
arrCode( 9) = &H4C8B0402
arrCode(10) = &H8890424
arrCode(11) = &H8C201B0
arrCode(12) = 0&
End Sub


窗体代码(应用示例):
Option Explicit

Private c As New Class1

Private Sub Command1_Click()
Dim arrData(511&) As Long
Dim i As Long, u As Long

' 事先分配一个足够大的缓冲区(Long数组)
u = 50
i = c.getAllHwnd(VarPtr(arrData(0)), u)
Call Me.Cls
If (-1& = i) Then
Me.Print "缓冲区需求数:" & u
Else
Me.Print "顶层窗口总数:"; i
For i = 0& To i - 1&
Me.Print i, Hex$(arrData(i))
Next
End If
End Sub
ypk9999 2020-01-15
  • 打赏
  • 举报
回复
针对一些深入的 Visual Basic 技巧有兴趣的人,可以去看底下两本书,都是 20年的书了,但对想练成 VB 神技的人还是很有参考价值,网路上应该找的到 Hardcore Visual Basic https://www.amazon.com/Hardcore-Visual-Basic-Bruce-McKinney/dp/1572314222 Subclassing and Hooking with Visual Basic: Harnessing the Full Power of VB/VB.NET https://www.amazon.com/Subclassing-Hooking-Visual-Basic-Harnessing/dp/0596001185
加载更多回复(16)

7,785

社区成员

发帖
与我相关
我的任务
社区描述
VB 基础类
社区管理员
  • VB基础类社区
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告
暂无公告

试试用AI创作助手写篇文章吧