Option Explicit
'-------------------------------------------------------
'CONSTANTES
'-------------------------------------------------------
'constantes d'accès à un processus (pour OpenProcess)
Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_REQUIRED As Long = &HF0000 'aussi pour d'autres accès que les processus
Private Const PROCESS_ALL_ACCESS As Long = (STANDARD_RIGHTS_REQUIRED Or _
SYNCHRONIZE Or &HFFF)
Private Const PROCESS_VM_READ As Long = 16
Private Const PROCESS_VM_WRITE As Long = &H20
Private Const PROCESS_VM_OPERATION As Long = &H8
Private Const PROCESS_QUERY_INFORMATION As Long = 1024
Private Const PROCESS_READ_WRITE_QUERY As Long = PROCESS_VM_READ + PROCESS_VM_WRITE + PROCESS_VM_OPERATION + PROCESS_QUERY_INFORMATION
'constantes utilisées pour déterminer le type de zone mémoire d'un processus
Private Const MEM_PRIVATE As Long = &H20000
Private Const MEM_COMMIT As Long = &H1000
Private Const INVALID_HANDLE_VALUE As Long = -1
'-------------------------------------------------------
'APIs
'-------------------------------------------------------
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function GetCurrentProcess Lib "kernel32.dll" () As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function VirtualQueryEx& Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, lpBuffer As MEMORY_BASIC_INFORMATION, ByVal dwLength As Long)
'-------------------------------------------------------
'TYPES ET ENUMS
'-------------------------------------------------------
Private Type MEMORY_BASIC_INFORMATION ' 28 bytes
BaseAddress As Long
AllocationBase As Long
AllocationProtect As Long
RegionSize As Long
State As Long
Protect As Long
lType As Long
End Type
Private Type SYSTEM_INFO ' 36 Bytes
dwOemID As Long
dwPageSize As Long
lpMinimumApplicationAddress As Long
lpMaximumApplicationAddress As Long
dwActiveProcessorMask As Long
dwNumberOrfProcessors As Long
dwProcessorType As Long
dwAllocationGranularity As Long
wProcessorLevel As Integer
wProcessorRevision As Integer
End Type
'-------------------------------------------------------
'FUNCTIONS AND PROCEDURES
'-------------------------------------------------------
'-------------------------------------------------------
'lit lSize bytes dans la zone virtuelle de la mémoire d'un processus
'demande un PID
'-------------------------------------------------------
Public Function ReadBytes(ByVal PID As Long, ByVal lngOffset As Long, ByVal lngSize As Long) As String
Dim sBuf As String
Dim lByte As Long
Dim lHandle As Long
'/!\ Un long suffit pour pouvoir parcourir l'ensemble des offsets possibles
'car la taille max de la zone virtuelle est 2Go
'créé un buffer
sBuf = String$(lngSize, 0)
'obtient le handle du processus
lHandle = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
'lit les bytes et stocke dans le buffer
ReadProcessMemory lHandle, lngOffset, sBuf, lngSize, lByte
'referme le handle
CloseHandle lHandle
ReadBytes = sBuf
End Function
'-------------------------------------------------------
'lit lSize bytes dans la zone virtuelle de la mémoire d'un processus
'demande un handle
'-------------------------------------------------------
Public Function ReadBytesH(ByVal lHandle As Long, ByVal lngOffset As Long, ByVal lngSize As Long) As String
Dim sBuf As String
Dim lByte As Long
Dim lRet As Long
'/!\ Un long suffit pour pouvoir parcourir l'ensemble des offsets possibles
'car la taille max de la zone virtuelle est 2Go
'créé un buffer
sBuf = String$(lngSize, 0)
'lit les bytes et stocke dans le buffer
lRet = ReadProcessMemory(lHandle, lngOffset, sBuf, lngSize, lByte)
ReadBytesH = sBuf
End Function
'-------------------------------------------------------
'écrit une string dans la mémoire virtuelle d'un processus
'-------------------------------------------------------
Public Function WriteBytes(ByVal PID As Long, ByVal lngOffset As Long, ByVal strStringToWrite As String) As Long
Dim lHandle As Long
'obtient le handle du processus
lHandle = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
WriteBytes = WriteProcessMemory(lHandle, lngOffset, ByVal strStringToWrite, Len(strStringToWrite), 0&)
'referme le handle
CloseHandle lHandle
End Function
'-------------------------------------------------------
'écrit une string dans la mémoire virtuelle d'un processus (à partir d'un handle)
'-------------------------------------------------------
Public Function WriteBytesH(ByVal lngHandle As Long, ByVal lngOffset As Long, ByVal strStringToWrite As String) As Long
'écrit en mémoire
WriteBytesH = WriteProcessMemory(lngHandle, lngOffset, ByVal strStringToWrite, Len(strStringToWrite), 0&)
End Function
'-------------------------------------------------------
'obtient les différentes zones mémoire d'un processus utilisées dans la zone virtuelle
'stocke de 1 à Ubound
'-------------------------------------------------------
Public Sub RetrieveMemRegions(ByVal PID As Long, ByRef lBaseAdress() As Long, ByRef lRegionSize() As Long)
Dim lHandle As Long
Dim lPosMem As Long
Dim lRet As Long
Dim lLenMBI As Long
Dim mbi As MEMORY_BASIC_INFORMATION
Dim si As SYSTEM_INFO
'initialise les tableaux
ReDim lBaseAdress(0)
ReDim lRegionSize(0)
'obtient le handle du processus
lHandle = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
lLenMBI = Len(mbi) 'taille de la structure
GetSystemInfo si 'obtient les infos sur les adresses de début et de fin de la plage mémoire maximum
lPosMem = si.lpMinimumApplicationAddress 'adresse la plus petite ==> part de là
Do While lPosMem < si.lpMaximumApplicationAddress 'tant que l'adresse est inférieure à l'adresse maximale
mbi.RegionSize = 0
'obtient les infos sur les régions mémoire du processus définit par son handle hProcess
lRet = VirtualQueryEx(lHandle, ByVal lPosMem, mbi, lLenMBI)
If lRet = lLenMBI Then
If (mbi.lType = MEM_PRIVATE) And (mbi.State = MEM_COMMIT) Then
'alors utilisé par le processus
If mbi.RegionSize > 0 Then
'région non nulle, alors on la stocke dans les tableaux résultats
'les redimensionne
ReDim Preserve lBaseAdress(UBound(lBaseAdress) + 1)
ReDim Preserve lRegionSize(UBound(lRegionSize) + 1)
'stocke à la fin
lRegionSize(UBound(lRegionSize)) = mbi.RegionSize
lBaseAdress(UBound(lBaseAdress)) = mbi.BaseAddress
End If
End If
'continue la recherche des régions (ajoute la taille de la région à l'adresse de départ ==> donne la prochaine adresse de départ)
On Error GoTo ErrCapacityGestion 'dépassement de capacité pour la dernière adresse+regiosize
lPosMem = mbi.BaseAddress + mbi.RegionSize 'fait l'ajout
Else
'recherche terminée
Exit Do
End If
Loop
ErrCapacityGestion:
CloseHandle lHandle 'ferme le handle du processus
End Sub
'-------------------------------------------------------
'fonction de recherche de string dans un processus
'de 1 à Ubound
'-------------------------------------------------------
Public Sub SearchForStringMemory(ByVal PID As Long, ByVal sMatch As String, ByVal bCasse As Boolean, ByRef tRes() As Long)
'Utilisation de l'API CreateFile et ReadFileEx pour une lecture rapide
Dim x As Long
Dim bytAsc As Byte
Dim strBufT As String
Dim i As Long
Dim lHandle As Long
Dim LB() As Long
Dim LS() As Long
On Error GoTo ErrGestion
'initialise le tableau
ReDim tRes(0)
'on obtient les différentes régions de la mémoire du processus
RetrieveMemRegions PID, LB(), LS()
'on obtient le handle depuis le PID
lHandle = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
If bCasse = False Then sMatch = LCase$(sMatch) 'ne cherche que les minuscules
For x = 1 To UBound(LS()) 'pour chaque zone mémoire
'obtient la string de la plage visualisée
strBufT = ReadBytesH(lHandle, LB(x), LS(x))
If bCasse = False Then strBufT = LCase$(strBufT) 'cherche que des minuscules (pas de casse respectée)
'tant que la string contient le match
While InStr(1, strBufT, sMatch, vbBinaryCompare) <> 0
'trouvé une string ==> l'ajoute
ReDim Preserve tRes(UBound(tRes) + 1)
tRes(UBound(tRes)) = LB(x) + InStr(1, strBufT, sMatch, vbBinaryCompare) + LS(x) - Len(strBufT) - 1
'raccourci le buffer
strBufT = Right$(strBufT, Len(strBufT) - InStr(1, strBufT, sMatch, vbBinaryCompare) - Len(sMatch) + 1)
Wend
DoEvents 'rend la main
Next x
Let strBufT = vbNullString
ErrGestion:
'referme le handle
CloseHandle lHandle
End Sub
Seul les admins et l'auteur du code lui même peuvent modifier ce code.