Article ID: 176058
Article Last Modified on 3/11/2005
Private Sub Form_Load()
gHW = Me.hWnd
Hook
Me.Caption = "Target"
Me.Show
Label1.Caption = Hex$(gHW)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Unhook
End Sub
Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Public Const GWL_WNDPROC = (-4)
Public Const WM_COPYDATA = &H4A
Global lpPrevWndProc As Long
Global gHW As Long
'Copies a block of memory from one location to another.
Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
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
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As _
Long) As Long
Public Sub Hook()
lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, _
AddressOf WindowProc)
Debug.Print lpPrevWndProc
End Sub
Public Sub Unhook()
Dim temp As Long
temp = SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_COPYDATA Then
Call mySub(lParam)
End If
WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, _
lParam)
End Function
Sub mySub(lParam As Long)
Dim cds As COPYDATASTRUCT
Dim buf(1 To 255) As Byte
Call CopyMemory(cds, ByVal lParam, Len(cds))
Select Case cds.dwData
Case 1
Debug.Print "got a 1"
Case 2
Debug.Print "got a 2"
Case 3
Call CopyMemory(buf(1), ByVal cds.lpData, cds.cbData)
a$ = StrConv(buf, vbUnicode)
a$ = Left$(a$, InStr(1, a$, Chr$(0)) - 1)
Form1.Print a$
End Select
End Sub
Private Type COPYDATASTRUCT
dwData As Long
cbData As Long
lpData As Long
End Type
Private Const WM_COPYDATA = &H4A
Private Declare Function FindWindow Lib "user32" Alias _
"FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
As String) As Long
Private Declare Function SendMessage Lib "user32" Alias _
"SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal _
wParam As Long, lParam As Any) As Long
'Copies a block of memory from one location to another.
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
Private Sub Command1_Click()
Dim cds As COPYDATASTRUCT
Dim ThWnd As Long
Dim buf(1 To 255) As Byte
' Get the hWnd of the target application
ThWnd = FindWindow(vbNullString, "Target")
a$ = "It Works!"
' Copy the string into a byte array, converting it to ASCII
Call CopyMemory(buf(1), ByVal a$, Len(a$))
cds.dwData = 3
cds.cbData = Len(a$) + 1
cds.lpData = VarPtr(buf(1))
i = SendMessage(ThWnd, WM_COPYDATA, Me.hwnd, cds)
End Sub
Private Sub Form_Load()
' This gives you visibility that the target app is running
' and you are pointing to the correct hWnd
Me.Caption = Hex$(FindWindow(vbNullString, "Target"))
End Sub
168795 How To Hook Into a Window's Messages Using AddressOf
129947 INFO: Win32 Replacement for the hmemcpy Function
Keywords: kbhowto kbapi KB176058