А хочется сделать - многоразовый.
В данном случае перехватывается чтение системного реестра функцией RegQueryValueEx.
Ошибка возникает в функции MyRegQueryValueEx если раскомментировать строку
' sAsm = StartSpy(pHandle, ApAdrFunction, MyAdrFunction)
- Код: Выделить всё
Option Explicit
' Перехват вызовов API функций
' Работает только в скомпиллированном виде!
Private Declare Sub CopyMemory _
Lib "kernel32" _
Alias "RtlMoveMemory" (lpDest As Any, _
lpSource As Any, _
ByVal cBytes As Long)
Private Declare Function GetModuleHandle _
Lib "kernel32" _
Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function GetProcAddressNum _
Lib "kernel32" _
Alias "GetProcAddress" (ByVal hModule As Long, _
ByVal lpProcName As Long) As Long
Private Declare Function GetProcAddress _
Lib "kernel32" (ByVal hModule As Long, _
ByVal lpProcName As String) As Long
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
Private Declare Function OpenProcess _
Lib "kernel32" (ByVal dwDesiredAccess As Long, _
ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetCurrentProcessId _
Lib "kernel32" () 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 sAsm As String 'буфер
Private MyAdrFunction As Long 'адрес замещающей функции
Private ApAdrFunction As Long 'адрес перехвытываемой функции
Private Declare Function CloseHandle _
Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function LoadLibrary _
Lib "kernel32" _
Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" ( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
lpData As Any, _
lpcbData As Long) As Long
Public Sub Main()
Dim inet As Object
Call mMain.CaptureLib
Set inet = CreateObject("InternetExplorer.Application")
inet.Visible = True
inet.Navigate "http://bbs.vbstreets.ru/"
End Sub
' вызов этой функции приводит к запуску перехвата
' вызова функции RegQueryValueExA
Public Sub CaptureLib()
Dim pId As Long
Dim pHandle As Long '
'получить идентификатор процесса
pId = GetCurrentProcessId
'получить описатель процесса
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pId)
'адрес замещающей функции
MyAdrFunction = GetAdres(AddressOf MyRegQueryValueEx)
'адрес перехватываемой функции
ApAdrFunction = IsFunctionExported("RegQueryValueExA", "advapi32.dll")
sAsm = StartSpy(pHandle, ApAdrFunction, MyAdrFunction)
CloseHandle pHandle
End Sub
'начать перехват
'pHandle - идентификатор процесса
'lApAdr - адрес перехватываемой функции
'lMyAdr - адрес замещающей функции
'возврашает строку содержащую первые 6 байт перехватываемой функции
Private Function StartSpy(pHandle As Long, _
lApAdr As Long, _
lMyAdr As Long) As String
Dim TmpStr As String * 6
Dim buf(0 To 5) As Byte 'буфер
Dim jmp(0 To 5) As Byte
Dim i As Long
jmp(0) = &H68 'здесь будет код инструкции push
CopyMemory jmp(1), lMyAdr, 4 'аргумент push
jmp(5) = &HC3 'здесь будет код инструкции ret
'Прочитаем и сохраним первые оригинальные 6 байт стандартной API функции
ReadProcessMemory pHandle, ByVal lApAdr, buf(0), 6, 0&
WriteProcessMemory pHandle, ByVal lApAdr, jmp(0), 6, 0&
'перевод массива в строку
For i = 0 To 5
Mid$(TmpStr, i + 1, 1) = Chr$(buf(i))
Next
StartSpy = TmpStr
End Function
'закончить перехват
'ProcessId - идентификатор процесса
'lApAdr - адрес перехватываемой функции
'OldCod - строка содержащая первые 6 байт перехватываемой функции
Private Sub StopSpy(pHandle As Long, _
lApAdr As Long, _
OldCod As String)
Dim buf(0 To 5) As Byte 'буфер
Dim i As Long
'перевод строки в массив
For i = 0 To 5
buf(i) = Asc(Mid$(OldCod, i + 1, 1))
Next
WriteProcessMemory pHandle, ByVal lApAdr, buf(0), 6, 0&
End Sub
Private Function GetAdres(Ptr As Long) As Long
GetAdres = Ptr
End Function
Private Function IsFunctionExported(ByVal sFunction As String, _
ByVal sModule As String) As Long
Dim hMod As Long
'описатель модуля
hMod = GetModuleHandle(sModule)
If hMod = 0 Then '
hMod = LoadLibrary(sModule)
End If
If hMod Then
If IsNumeric(sFunction) = True Then
Dim mNum As Long
mNum = MakeDWord(CInt(sFunction), 0)
IsFunctionExported = GetProcAddressNum(hMod, mNum)
Else
IsFunctionExported = GetProcAddress(hMod, sFunction)
End If
End If
End Function
Private Function MyRegQueryValueEx( _
ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByVal lpType As Long, _
ByVal lpData As Long, _
ByVal lpcbData As Long) As Long
Dim pId As Long
Dim pHandle As Long
pId = GetCurrentProcessId
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pId)
Call StopSpy(pHandle, ApAdrFunction, sAsm)
MsgBox StrConv(lpValueName, vbUnicode)
MyRegQueryValueEx = RegQueryValueEx(ByVal hKey, ByVal lpValueName, ByVal lpReserved, ByVal lpType, ByVal lpData, ByVal lpcbData)
' ошибка возникнет, если раскомментировать эту строку, чтобы перехватывать остальные вызовы
' sAsm = StartSpy(pHandle, ApAdrFunction, MyAdrFunction)
CloseHandle pHandle
End Function
Private Function MakeDWord(LoWord As Integer, _
HiWord As Integer) As Long
CopyMemory MakeDWord, LoWord, 2&
CopyMemory ByVal VarPtr(MakeDWord) + 2&, HiWord, 2&
End Function
