请教下有什么办法把下面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
...全文
626 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）
Python中子类如何获取父类的类成员
@bwangel   大家好，今天在写代码的时候，遇到了这样一种情况。我有如下所示的几个类用来存放程序配置（其实当做命名空间来用，同时感觉能够继承方便一点）， import osclass Config: BASE_DIR = "/tmp"class TestConfig(Config): DATA_DIR = os.path.join(Config.BASE_DIR,
为什么同样的程序，排行榜上用2ms完成，我却要用更长的时间？
推免的时候一直看的话，当下看也觉得很有道理，无论如何，都要抱着做分母的心态，尽做分子的努力，现在睡个。宝子们，本科211网络工程专业，走进网络安全，头铁札进这潭深水沼泽，本以为国家扶持政策，现在找工作真。我真的服了，写了半天的简历，结果一不小心投错了岗位了。#实习# #暑期实习# #腾讯# #腾。工作职责1.参与大型游戏的运维架构设计和实现，并持续进行优化，实现高可用、易扩展等特性，包括但不限于。工作职责1、负责对接团队的资产标准梳理，根据业务发展需要、市场更新迭代研究和成本的考量，提出配置的最。
Qt高质量的开源项目合集
尊重作者，支持原创，如需转载，请附上原地址：开源项目推荐：Qt有关的GitHub/Gitee开源项目(★精品收藏★)_$firecat全宏的代码足迹$-CSDN博客_qt开源项目https://libaineu2004.blog.csdn.net/article/details/77369837 Q：想请教下Qt5 之后推出的qml与之前qt4的ui 开发方式，有冲突吗？我公司开发桌面程序，是两种方式兼用?还...
给初学者：用VB写外挂 ———— 实战三：泰坦之旅V1.08 十项属性修改器——另一种无输入焦点时响应按键的方法
前几天发布了泰坦之旅V1.08 十项属性修改器1.0.0版本，这里的代码将是1.1.0版本的代码。首先，来说一下思路，我们要实现的是一些修改功能及其恢复，先复习一下前几次说到的函数：我们利用下面这个函数来获取游戏进程指定地址（我们将要修改的地址）的数据，将其保存起来。Public Function GetData(ByVal lppid As Long, ByVal lpAddress
2021-11-02
尊重作者，支持原创，如需转载，请附上原地址：开源项目推荐：Qt有关的GitHub/Gitee开源项目(★精品收藏★)_$firecat全宏的代码足迹$-CSDN博客_qt开源项目https://libaineu2004.blog.csdn.net/article/details/77369837 Q：想请教下Qt5 之后推出的qml与之前qt4的ui 开发方式，有冲突吗？我公司开发桌面程序，是两种方式兼用?还...
VB基础类

7,785

社区成员

197,585

社区内容

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

加载中

查看更多榜单
社区公告
暂无公告

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

+ 用AI写文章