Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Option Explicit
- Private Declare Function IsBadWritePtr Lib "kernel32" _
- (ByVal lp As Long, ByVal ucb As Long) As Long
- Private Declare Function VirtualProtect Lib "kernel32" _
- (ByVal lpAddress As Long, ByVal dwSize As Long, _
- ByVal flNewProtect As Long, lpflOldProtect As Long) As Long
- Private Declare Function VirtualAlloc Lib "kernel32" _
- (ByVal lpAddress As Long, ByVal dwSize As Long, _
- ByVal flAllocationType As Long, _
- ByVal flProtect As Long) As Long
- Private Declare Function VirtualFree Lib "kernel32" _
- (ByVal lpAddress As Long, ByVal dwSize As Long, _
- ByVal dwFreeType As Long) As Long
- Const PAGE_EXECUTE_READWRITE = &H40
- Const MEM_COMMIT = &H1000
- Const MEM_RESERVE = &H2000
- Const MEM_RELEASE = &H8000&
- Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
- Private Declare Function FlushInstructionCache Lib "kernel32" _
- (ByVal hProcess As Long, lpBaseAddress As Any, _
- ByVal dwSize As Long) As Long
- Private Declare Sub CopyLong Lib "kernel32" Alias "RtlMoveMemory" _
- (Destination As Any, Source As Any, _
- Optional ByVal length As Long = 4)
- Const S_OK = &H0&
- Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr
- Private lngCodeLen As Long
- Private pProc As Long
- Private HookProc As Long
- Private tmp As Long
- Private proc As LongPtr
- Private Declare Sub OutputDebugString Lib "kernel32" Alias "OutputDebugStringW" (ByVal lpOutputString As Long)
- Private Declare PtrSafe Function SysAllocString Lib "OleAut32" (ByVal psz As LongPtr) As LongPtr
- Sub Main()
- 'mov eax, 0
- 'jmp eax
- Const CODE_T = "000000B890E0FF00"
- Dim Code() As Long
- Dim i As Long
- HookProc = VBA.Int(AddressOf MidStmtHook)
- ReDim Code(0 To (Len(CODE_T) - 1) \ 8)
- For i = 0 To UBound(Code)
- Code(i) = "&H" & Mid$(CODE_T, 1 + i * 8, 8)
- Next
- lngCodeLen = (UBound(Code) + 1) * 4
- pProc = VirtualAlloc(0, lngCodeLen, MEM_RESERVE Or MEM_COMMIT, _
- PAGE_EXECUTE_READWRITE)
- If pProc = 0 Then Err.Raise 7
- tmp = VirtualAlloc(0, lngCodeLen, MEM_RESERVE Or MEM_COMMIT, _
- PAGE_EXECUTE_READWRITE)
- If tmp = 0 Then Err.Raise 7
- CopyLong ByVal pProc, Code(0), lngCodeLen
- CopyLong ByVal pProc + 1, HookProc
- FlushInstructionCache GetCurrentProcess(), ByVal pProc, lngCodeLen
- proc = GetModuleHandle("vbe7.dll")
- If proc = 0 Then Exit Sub
- 'Debug.Print Hex$(proc)
- proc = proc + &H1FAF1D
- 'Debug.Print Hex$(proc)
- '退避
- CopyLong ByVal tmp, ByVal proc, lngCodeLen
- 'Hookスタート
- ForceCopyLong proc, pProc
- Dim buf As String
- buf = "かきくけこ"
- Mid(buf, 3) = "か"
- MsgBox buf
- EndHook
- Mid(buf, 3) = "か"
- MsgBox buf
- End Sub
- ' フック終了
- Sub EndHook()
- ForceCopyLong proc, tmp
- VirtualFree pProc, 0, MEM_RELEASE
- VirtualFree tmp, 0, MEM_RELEASE
- End Sub
- Private Function MidStmtHook(ByVal arg5&, ByVal arg4&, ByVal length&, ByVal start&, ByRef stringvar&) As Long
- Dim s$
- s = "あいうえお"
- ' CopyLong ByVal stringvar, ByVal StrPtr(s), LenB(s)
- stringvar = SysAllocString(StrPtr(s))
- End Function
- Private Function ForceCopyLong(ByVal Address As Long, _
- ByVal Value As Long) As Boolean
- Dim lngOld As Long
- If IsBadWritePtr(Address, lngCodeLen) Then
- If VirtualProtect(Address, lngCodeLen, _
- PAGE_EXECUTE_READWRITE, lngOld) = 0 Then
- Exit Function
- End If
- CopyLong ByVal Address, ByVal Value, lngCodeLen
- VirtualProtect Address, lngCodeLen, lngOld, lngOld
- Else
- CopyLong ByVal Address, ByVal Value, lngCodeLen
- End If
- ForceCopyLong = True
- End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement