7,785
社区成员




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
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
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
' 类代码:
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