ayuda, uso del ReadProcessMemory VB6.0

[AlxSpy]

estoy haciendo un code para buscar datos en la memoria de un proceso uso el readprocessmemory:

Código (vb) [Seleccionar] Expandir

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:

Código (vb) [Seleccionar] Expandir

Call ReadProcessMemory(hProcess, Address, ByVal Buffer, Len(Buffer), BytesLeidos)

Código (vb) [Seleccionar] Expandir

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.

[BlackZeroX]

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.

[AlxSpy]

cambie el string buffer a array de bytes, este code mas chico y mas entendible:

Código (vb) [Seleccionar] Expandir


'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:

Código (vb) [Seleccionar] Expandir


'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.

[BlackZeroX]

.
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.

Código (Vb) [Seleccionar] Expandir



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:

Código (Vb) [Seleccionar] Expandir



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!¡.

[AlxSpy]

eso debe ser el fallo.    thanks