- Code: Select all
'----------------------------
'Hook Mdl
' by x4NG3L
'U Can use this in your aplication, more give-me the credits.
'----------------------------
Option Explicit
Private Declare Function VirtualProtect Lib "kernel32" ( _
lpAddress As Any, _
ByVal dwSize As Long, _
ByVal flNewProtect As Long, _
lpflOldProtect As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
pDest As Any, _
pSource As Any, _
ByVal dwLength 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 Const PAGE_EXECUTE_READWRITE As Long = &H40&
Private blnHooked As Boolean ' Função ta Hooked?
Private lpOldAddr As Long ' Address da funçao Hooked
Private btOldASM(4) As Byte ' Antigos 5 bytes da hooked
Private btReal(31) As Byte ' funçao hooked
' restore old hooked function
Public Function Unhook() As Boolean
If Not blnHooked Then Exit Function
' overwrite new with the old instruction
blnHooked = PutMem(lpOldAddr, VarPtr(btOldASM(0)), UBound(btOldASM) + 1)
Unhook = blnHooked
End Function
Public Function RemoteHook(ByVal module As String, ByVal fnc As String, _
ByVal NewAddr As Long, _
Optional ProxyAddr As Long) As Boolean
Dim hModule As Long
Dim hFnc As Long
'If blnHooked Then Exit Function
hModule = GetModuleHandle(module)
If hModule = 0 Then Exit Function
hFnc = GetProcAddress(hModule, fnc)
If hFnc = 0 Then Exit Function
lpOldAddr = hFnc
' save old instructions
If Not GetMem(hFnc, VarPtr(btOldASM(0)), UBound(btOldASM) + 1) Then
Exit Function
End If
' redirect ProxyAddr to target function
If ProxyAddr <> 0 Then
CopyMemory btReal(0), btOldASM(0), UBound(btOldASM) + 1
Redirect VarPtr(btReal(UBound(btOldASM) + 1)), lpOldAddr + UBound(btOldASM) + 1
Redirect ProxyAddr, VarPtr(btReal(0))
End If
' redirect the target function to the replacement function
blnHooked = Redirect(hFnc, NewAddr)
RemoteHook = blnHooked
End Function
' write a JMP near instruction to an address
Private Function Redirect(ByVal OldAddr As Long, ByVal NewAddr As Long) As Boolean
Dim btAsm(4) As Byte
Dim lngNewAddr As Long
' relative jump address
lngNewAddr = NewAddr - OldAddr - (UBound(btAsm) + 1)
btAsm(0) = &HE9 ' JMP near
CopyMemory btAsm(1), lngNewAddr, 4 ' rel. addr
Redirect = PutMem(OldAddr, VarPtr(btAsm(0)), UBound(btAsm) + 1)
End Function
Private Function GetMem(ByVal lpAddr As Long, ByVal pData As Long, ByVal dlen As Long) As Boolean
Dim lngOldProtect As Long
If 0 = VirtualProtect(ByVal lpAddr, dlen, PAGE_EXECUTE_READWRITE, lngOldProtect) Then
Exit Function
End If
CopyMemory ByVal pData, ByVal lpAddr, dlen
VirtualProtect ByVal lpAddr, dlen, lngOldProtect, lngOldProtect
GetMem = True
End Function
Private Function PutMem(ByVal lpAddr As Long, ByVal pData As Long, ByVal dlen As Long) As Boolean
Dim lngOldProtect As Long
If 0 = VirtualProtect(ByVal lpAddr, dlen, PAGE_EXECUTE_READWRITE, lngOldProtect) Then
Exit Function
End If
CopyMemory ByVal lpAddr, ByVal pData, dlen
VirtualProtect ByVal lpAddr, dlen, lngOldProtect, lngOldProtect
PutMem = True
End Function
Example of One Function to use with Hook:
- Code: Select all
Function NovaMsgBox() As Long
Call MsgBox("Hooked MessageBoxA", vbCritical, "hooked!")
End Function
Example of Use:
- Code: Select all
Call RemoteHook("user32.dll", "MessageBoxA", AddressOf NovaMsgBox)
Explaining:
For example, in this example, I are Hooking in the lib User32 the "MessageBoxA" function! (This Function is Called to Show MsgBoxes)
I'm redirecting to another function, called "NovaMsgBox"
Now, If I declare "MessageBoxA" API, ant Try to use this, My
Function Called "NovaMsgBox" aew Automaticaly Called ^^
U can Hook Any API Call in User-Mode with this code.
I'm my example, my function "NovaMsgBox" show a msg box Too.
This have the same effect of the original Function. more u can put
Any code or procedure call in this function.
Is possible to inject this code in another aplications Too, and hook what u need in user-mode ^^
Sorry for Bad English ^^
Edit: Improving spelling.