Option Explicit
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef lpvDest As Any, ByRef lpvSrc As Any, ByVal cbLen As Long)
Private Type FUNCTION_COPY
OldMemory() As Byte
Address As Long
Removed As Boolean
End Type
Private FunctionCopy() As FUNCTION_COPY
Public Function AddFunction(ByVal hWnd As Long, ByVal DestAddressOf As Long, ByVal SrcAddressOf As Long, ByVal SrcAfterAddressOf As Long) As Long
Dim lngNewIndex As Long, blnArrayInit As Boolean
Dim lngProcessID As Long, lngProcessHandle As Long, lngWritten As Long
GetWindowThreadProcessId hWnd, lngProcessID
lngProcessHandle = OpenProcess(&H1F0FFF, 0&, lngProcessID)
If lngProcessHandle = 0 Then AddFunction = -1: Exit Function
blnArrayInit = Not ((Not FunctionCopy) = -1&)
On Error Resume Next: Debug.Assert CLng(0.1): On Error GoTo 0
If blnArrayInit Then lngNewIndex = UBound(FunctionCopy) + 1
ReDim Preserve FunctionCopy(lngNewIndex)
With FunctionCopy(lngNewIndex)
.Address = DestAddressOf
ReDim .OldMemory(Abs(SrcAfterAddressOf - SrcAddressOf) - 1)
ReadProcessMemory lngProcessHandle, ByVal .Address, ByVal VarPtr(.OldMemory(0)), UBound(.OldMemory) + 1, lngWritten
WriteProcessMemory lngProcessHandle, ByVal .Address, ByVal SrcAddressOf, ByVal UBound(.OldMemory) + 1, lngWritten
CloseHandle lngProcessHandle
End With
AddFunction = lngNewIndex
End Function
Public Function RemoveFunction(ByVal hWnd As Long, ByVal Index As Long) As Boolean
Dim blnArrayInit As Boolean, lngA As Long
Dim lngProcessID As Long, lngProcessHandle As Long, lngWritten As Long
blnArrayInit = Not ((Not FunctionCopy) = -1&)
If Not blnArrayInit Then Exit Function
If Index < 0 Or Index > UBound(FunctionCopy) Then Exit Function
If FunctionCopy(Index).Removed Then Exit Function
GetWindowThreadProcessId hWnd, lngProcessID
lngProcessHandle = OpenProcess(&H1F0FFF, 0&, lngProcessID)
If lngProcessHandle = 0 Then Exit Function
With FunctionCopy(Index)
WriteProcessMemory lngProcessHandle, ByVal .Address, ByVal VarPtr(.OldMemory(0)), ByVal UBound(.OldMemory) + 1, lngWritten
CloseHandle lngProcessHandle
Erase .OldMemory
.Removed = True
End With
For lngA = 0 To UBound(FunctionCopy)
If Not FunctionCopy(lngA).Removed Then Exit For
Next lngA
If lngA > UBound(FunctionCopy) Then Erase FunctionCopy
RemoveFunction = True
End Function