Option Explicit
 
'---------------------------------------------------------------------------------------
' Module    : mPatchFunction
' Author    : Karcrack
' Date      : 27/11/2011
' Purpose   : Patch function with JMP to new addr
'---------------------------------------------------------------------------------------

'NTDLL
Private Declare Function NtWriteVirtualMemory Lib "NTDLL" (ByVal hProcess As Long, ByRef lpBaseAddress As Any, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
 
Private Const CURRENT_PROCESS = (-1)
 
Public Function PatchFunction(ByVal pFnc As Long, ByVal pNewFnc As Long, Optional ByVal hProc As Long = CURRENT_PROCESS) As Boolean
    Dim cCode   As Currency
 
    cCode = &HB8& * (0.0001@)                   'mov EAX, imm32
    cCode = cCode + (pNewFnc * 0.0256@)         'imm32
    cCode = cCode + (&HE0FF& * 109951162.7776@) 'jmp EAX
    
    PatchFunction = NtWriteVirtualMemory(hProc, ByVal pFnc&, cCode, &H8, 0&)
End Function

Sub Main()
    Dim pMessageBoxW    As Long
 
    pMessageBoxW = GetProcAddress(LoadLibrary("USER32"), "MessageBoxW")
 
    If PatchFunction(AddressOf MessageBoxW__, pMessageBoxW) Then
        If MessageBoxW__(0, "Did you like the function?", "Karcrack", vbYesNo) = vbYes Then
            Call MessageBoxW__(0, "Glad you liked it", "Karcrack", 0)
        Else
            Call MessageBoxW__(0, "F**k you bastard xD", "Karcrack", 0)
        End If
    End If
End Sub
 
Public Function MessageBoxW__(ByVal hwnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
    'JMP &MessageBoxW@USER32
End Function