estoy haciendo un code para buscar datos en la memoria de un proceso uso el readprocessmemory:
Option Explicit
Dim hProcess As Long
Private Sub cmdBusqueda_Click()
Dim Data As String, Buffer As String, Target As Long
Dim TmpByte As Byte, TmpInteger As Integer, TmpLong As Long, TmpString As String
Dim Pos As Long, Address As Long, FirstByte As String
Dim Fin As Boolean, BytesLeidos As Long, BytesRead As Long
Dim TotalBytes As Long
Fin = False
Address = 0
If optByte.Value = True Then
TmpByte = Val(txtData.Text)
Data = Space(1)
Call CopyMemory(ByVal Data, TmpByte, 1)
ElseIf optInteger.Value = True Then
TmpInteger = Val(txtData.Text)
Data = Space(2)
Call CopyMemory(ByVal Data, TmpInteger, 2)
ElseIf optLong.Value = True Then
TmpLong = Val(txtData.Text)
Data = Space(4)
Call CopyMemory(ByVal Data, TmpLong, 4)
Else 'String
Data = txtData.Text
If optStringUnicode.Value = True Then
Data = Unicode(Data)
End If
End If
Dim Tmp As String, X As Integer, PID As Long
X = lstProcesos.ListIndex
If X = -1 Then Exit Sub
Tmp = lstProcesos.List(X)
Pos = InStr(1, Tmp, "*")
If Pos > 0 Then Tmp = Mid(Tmp, Pos + 1)
PID = Val(Tmp)
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
If hProcess = 0 Then
MsgBox "No se pudo abrir el proceso", vbCritical, ""
Exit Sub
End If
lstDirecciones.Clear
FirstByte = Mid(Data, 1, 1)
While (Fin = False)
Buffer = Space(5000)
Call ReadProcessMemory(hProcess, Address, Buffer, Len(Buffer), BytesLeidos)
DoEvents
If BytesLeidos > 0 Then
Buffer = Left(Buffer, BytesLeidos)
Pos = InStr(1, Buffer, FirstByte)
If Pos > 0 Then
Call ReadProcessMemory(hProcess, Address + Pos - 1, Buffer, Len(Buffer), BytesRead)
If BytesRead > 0 Then Buffer = Left(Buffer, BytesRead)
If Buffer = Data Then
Target = Target + Pos - 1 'dato encontrado
lstDirecciones.AddItem Target
Address = Target + Len(Data)
Else
Address = Address + 1
End If
Else
Address = Address + BytesLeidos
End If
End If
TotalBytes = TotalBytes + BytesLeidos
If TotalBytes >= 150000000 Then Fin = True
If BytesLeidos < 5000 Then Fin = True
Wend
Call CloseHandle(hProcess)
Me.Caption = TotalBytes
End Sub
Private Sub cmdRefrescar_Click()
Dim Proceso As String, pShot As PROCESSENTRY32
Dim ProcessID As Long, P As Long
Dim R32Next As Long, hHelp32 As Long
lstProcesos.Clear
hHelp32 = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
pShot.dwSize = Len(pShot)
R32Next = Process32First(hHelp32, pShot)
While (R32Next <> 0)
Proceso = pShot.szExeFile
P = InStr(1, Proceso, Chr(0))
If P > 0 Then Proceso = Left(Proceso, P - 1)
ProcessID = pShot.th32ProcessID
lstProcesos.AddItem Proceso & Space(5) & "*" & ProcessID
R32Next = Process32Next(hHelp32, pShot)
Wend
Call CloseHandle(hHelp32)
End Sub
Private Sub Form_Load()
Call cmdRefrescar_Click
End Sub
el codigo abre el proceso seleccionado normalmente pero al ejecutar el readprocessmemory , este no lee nada de memoria, al final del cmdBusqueda_Click agregue "me.caption = TotalBytes" (total de bytes leidos) para ver cuantos bytes lee pero siempre me da "0", intente usar el string buffer con byval y sin byval pero igual no lee:
Call ReadProcessMemory(hProcess, Address, ByVal Buffer, Len(Buffer), BytesLeidos)
Call ReadProcessMemory(hProcess, Address, Buffer, Len(Buffer), BytesLeidos)
en google encontre esta declaracion del api:
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
tambien encontre otra casi igual excepto que el parametro lpBuffer no tiene byval, he intentado con ambas formas pero no da resultado.
El buffer debe ser tipo byte ya que un string es en medida el doble que un byte... por otro lado no le entiendo a tu código esta muiy enredado, Separa-lo por funciones por que asi no se que es que.
Declara las variables siempre debajo de la declaración del proceso, no las declaras a la mitad del proceso, no se entiende o cuesta entenderlo.
cambie el string buffer a array de bytes, este code mas chico y mas entendible:
'Form1.frm
Option Explicit
Private Sub Command1_Click()
Dim PID As Long, Buffer(1 To 5000) As Byte, BytesLeidos As Long
Dim hProcess As Long, Address As Long
PID = Val(txtPID.Text)
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
If hProcess = 0 Then
MsgBox "No se pudo abrir el proceso", vbCritical, ""
Exit Sub
End If
Address = 10
Call ReadProcessMemory(hProcess, Address, Buffer(1), 5000, BytesLeidos)
Call CloseHandle(hProcess)
Me.Caption = BytesLeidos
End Sub
y las apis:
'module1.bas
Option Explicit
Declare Function OpenProcess Lib "Kernel32.dll" (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
pero es extraño lo he chequeado una y otra ves y no anda, no lee.Lo he ejecutadoo en mi pc y en mi maquina virt. y nada. ¿que podra ser?
Incluso intente cambiando la declaracion del parametro "lpBuffer as any" a typo Byte pero tampoco.
.
yo lo haria asi:
Nesesitas un Boton y pegar lo siguiente en un form.
Nunca me a gustado declarar las apis como as Any asi que lo modifico para que trabaje con punteros en lugar de referencias.
Option Explicit
Private Const PROCESS_ALL_ACCESS As Long = &H1F0FFF
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, ByVal lpBaseAddress As Long, lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesRead As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Memoria(0 To 100) As Long
Private Sub Command1_Click()
Dim i As Long
Dim bToFind() As Byte
For i = 20 To 35
Memoria(i) = (i + 4658984)
Next
bToFind() = LongToByte(4658984 + 20)
' // tiene que dar la dirrecion en memoria del indice de varptr(Memoria(20))
MsgBox VarPtr(Memoria(20)) = FindInMemory(Me.hWnd, bToFind, VarPtr(Memoria(0)), (VarPtr(Memoria(100))) + LenB(Memoria(100)))
End Sub
Public Function FindInMemory(ByVal hWnd As Long, _
ByRef bToFind() As Byte, _
ByVal lptrIni As Long, _
ByVal lptrend As Long) As Long
' No termine bien la funcion solo es un pequeño Esbozo para el tema.
Dim hproc As Long
Dim babuff() As Byte
Dim llnbuff As Long
Dim llnread As Long
Dim lret As Long
Dim lptradd As Long
Dim pId As Long
Dim q As Long
Dim c As Long
FindInMemory = 0
llnbuff = ArrayCount(bToFind())
If Not ((lptrIni = 0) And (hWnd = 0) And (llnbuff = 0) And (lptrend = 0)) And (llnbuff <= (lptrend - lptrIni)) Then
GetWindowThreadProcessId hWnd, pId
hproc = OpenProcess(PROCESS_ALL_ACCESS, False, pId)
If Not (hproc = 0) Then
ReDim babuff(0 To (llnbuff - 1))
lptradd = 0
Do ' // Se puede optimizar bastante...
ReadProcessMemory hproc, ByVal (lptrIni + lptradd), ByVal VarPtr(babuff(0)), llnbuff, llnread
lret = InByteArray(0, bToFind, babuff)
If (lret >= 0) Then
FindInMemory = ((lptrIni + lptradd) + lret)
Exit Do
End If
lptradd = (lptradd + 1)
DoEvents
Loop Until ((lptrIni + lptradd) = (lptrend - llnbuff))
CloseHandle hproc
End If
End If
End Function
en un modulo:
Option Explicit
Public Declare Function VarPtrA Lib "msvbvm60.dll" Alias "VarPtr" (ByRef Ptr() As Any) As Long
Public Declare Sub lCopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByVal Destination As Long, ByVal Source As Long, ByVal Length As Long)
Public Const InvalidValueArray = -1
Public Function InByteArray(ByVal lStart As Long, ByRef bArray1() As Byte, ByRef bArray2() As Byte) As Long
Dim llna1 As Long
Dim llna2 As Long
Dim llimt As Long
Dim q As Long
Dim c As Long
InByteArray = (-1)
If (lStart >= 0) Then
llna1 = ArrayCount(bArray1())
llna2 = ArrayCount(bArray2())
If Not ((llna1 = 0) And (llna2 = 0)) Then
llimt = (llna1 - llna2)
If (llimt >= 0) Then
q = lStart
Do While (q <= llimt)
Do While (bArray1(q + c) = bArray2(c))
c = (c + 1)
If (c = llna2) Then
InByteArray = q
GoTo ExitFunc
End If
Loop
q = ((q + c) + 1)
c = 0
Loop
End If
End If
End If
ExitFunc:
End Function
Public Function LongToByte(ByVal lVal As Long) As Byte()
Dim bRet(0 To 3) As Byte
bRet(3) = (lVal And &HFF000000) \ &H1000000
bRet(2) = (lVal And &HFF0000) \ &H10000
bRet(1) = (lVal And &HFF00&) \ &H100
bRet(0) = (lVal And &HFF)
LongToByte = bRet
End Function
Public Function ArrayCount(ByRef vArray() As Byte)
If Itsarrayini(VarPtrA(vArray)) Then
If LBound(vArray) = 0 Then
ArrayCount = 1
End If
ArrayCount = ArrayCount + UBound(vArray)
Else
ArrayCount = 0
End If
End Function
Public Function Itsarrayini(ByVal lngPtr As Long, Optional LnBytes As Long = 4) As Boolean
Dim lng_PtrSA As Long
If lngPtr <> 0 And LnBytes > 0 Then
Call lCopyMemory(ByVal VarPtr(lng_PtrSA), ByVal lngPtr, LnBytes)
Itsarrayini = Not lng_PtrSA = 0
End If
End Function
Temibles Lunas!¡.
eso debe ser el fallo. ;-) thanks