Как обратиться к оперативной памяти, выделенной под указанный процесс?

Option Explicit
     
    Private Const PROCESS_VM_READ = &H10
    Private Const PROCESS_VM_WRITE = &H20
    Private Const PROCESS_VM_OPERATION = &H8
    Private Const PROCESS_VM = PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE
     
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    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, ByVal lpBuffer As Long, 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 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
     
Private Sub Command1_Click()
Dim hW As Long, PId As Long, hP As Long, buf As Long, address As Long, NewTimer As Integer
      
      'Необходимо зппустить Сапер и начать играть
      hW = FindWindow("Сапер", "Сапер") ' если игра английская, то корректировать!
      Call GetWindowThreadProcessId(hW, PId)
     
      hP = OpenProcess(PROCESS_VM, 0&, PId)
      address = &H100579C ' По этому адресу у сапера время тикает
      Call ReadProcessMemory(hP, address, VarPtr(buf), 2, 0&)  'Считываем значение времени
      MsgBox buf  'после нажатия на кнопку вы увидите время игры в секундах.
      NewTimer = 1
      'А тут сбрасываем время на 1 сек - и ты  чемпион!
      Call WriteProcessMemory(hP, ByVal address, NewTimer, LenB(NewTimer), 0&)
     
End Sub

Call ReadProcessMemory(hP, address, VarPtr(buf),[B] LenB(buf)[/B], 0&)  'Считываем значение времени

Option Explicit
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 FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_VM_READ = &H10
 
Dim MyBuffer() As Byte
 
Private Sub Command1_Click()
Text1.Text = ""
Dim WindowID As Long
Dim ThreadID As Long
Dim ProcessID As Long
Dim MemoryID As Long
Dim WBytes As Long
 
Dim basar As Long
Dim hndl As Long
Dim x As Long
Dim i As Integer
Dim sz As Long
     sz = 44000000
     ProcessID = 3804
     basar = &H200000
     ReDim MyBuffer(sz - 1)
     hndl = OpenProcess(PROCESS_VM_READ, True, ProcessID)
     MemoryID = ReadProcessMemory(hndl, ByVal basar, ByVal VarPtr(MyBuffer(0)), sz, WBytes)
     CloseHandle (hndl)
      Dim value As String
      Dim value1 As String
      Dim value2 As String
      Dim value3 As String
      Dim endvalue As String
     For x = 1 To 200000 - 3
 
          value1 = Hex(MyBuffer(x))
     value2 = Hex(MyBuffer(x + 1))
     value3 = Hex(MyBuffer(x + 2))
     value = value1 & value2 & value3
    endvalue = value
    End If
         If value = text2.text Then
       For i = 0 To len(text2.text)
              Text1.Text = Text1.Text & Chr(MyBuffer(x + i))
     Next i
     Exit Sub
     End If
     Next x
End Sub

'Add 3 labels, 3 textboxes and 1 commandbutton on form
 
Option Explicit
 
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
 
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
 
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (LpVersionInformation As OSVERSIONINFO) As Long
Private Declare Function VirtualQueryEx& Lib "kernel32" (ByVal hProcess As Long, lpAddress As Any, lpBuffer As MEMORY_BASIC_INFORMATION, ByVal dwLength As Long)
Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO)
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) 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 Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As Long, ByVal lpWindowName As Long) As Long
Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long
Const GW_HWNDNEXT = 2
 
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Const PROCESS_VM_READ = (&H10)
Const PROCESS_VM_WRITE = (&H20)
Const PROCESS_VM_OPERATION = (&H8)
Const PROCESS_QUERY_INFORMATION = (&H400)
Const PROCESS_READ_WRITE_QUERY = PROCESS_VM_READ + PROCESS_VM_WRITE + PROCESS_VM_OPERATION + PROCESS_QUERY_INFORMATION
 
Const MEM_PRIVATE& = &H20000
Const MEM_COMMIT& = &H1000
 
 
Private Sub Command1_Click()
    Dim pid As Long, hProcess As Long, hWin As Long
    Dim lpMem As Long, ret As Long, lLenMBI As Long
    Dim lWritten As Long, CalcAddress As Long, lPos As Long
    Dim sBuffer As String
    Dim sSearchString As String, sReplaceString As String
    Dim si As SYSTEM_INFO
    Dim mbi As MEMORY_BASIC_INFORMATION
    sSearchString = Text2
    sReplaceString = Text3 & Chr(0)
    If IsWindowsNT Then 'NT store strings in RAM in UNICODE
       sSearchString = StrConv(sSearchString, vbUnicode)
       sReplaceString = StrConv(sReplaceString, vbUnicode)
    End If
    pid = Shell(Text1) 'launch application (calc.exe in this sample)
    hWin = InstanceToWnd(pid) 'get handle of launched window - only to repaint it after changes
'Open process with required access
    hProcess = OpenProcess(PROCESS_READ_WRITE_QUERY, False, pid)
    lLenMBI = Len(mbi)
'Determine applications memory addresses range
    Call GetSystemInfo(si)
    lpMem = si.lpMinimumApplicationAddress
'Scan memory
    Do While lpMem < si.lpMaximumApplicationAddress
        mbi.RegionSize = 0
        ret = VirtualQueryEx(hProcess, ByVal lpMem, mbi, lLenMBI)
        If ret = lLenMBI Then
            If ((mbi.lType = MEM_PRIVATE) And (mbi.State = MEM_COMMIT)) Then ' this block is In use by this process
                If mbi.RegionSize > 0 Then
                   sBuffer = String(mbi.RegionSize, 0)
'Read region into string
                   ReadProcessMemory hProcess, ByVal mbi.BaseAddress, ByVal sBuffer, mbi.RegionSize, lWritten
'Check if region contain search string
                   lPos = InStr(1, sBuffer, sSearchString, vbTextCompare)
                   If lPos Then
                      CalcAddress = mbi.BaseAddress + lPos
                      Me.Show
                      ret = MsgBox("Search string was found at address " & CalcAddress & "." & vbCrLf & "Do you want to replace it?", vbInformation + vbYesNo, "VB-O-Matic")
                      If ret = vbYes Then
'Replace string in virtual memory
                         Call WriteProcessMemory(hProcess, ByVal CalcAddress - 1, ByVal sReplaceString, Len(sReplaceString), lWritten)
'Redraw window
                         InvalidateRect hWin, 0, 1
                      End If
                      Exit Do
                   End If
                End If
            End If
'Increase base address for next searching cicle. Last address may overhead max Long value (Windows use 2GB memory, which is near max long value), so add Error checking
            On Error GoTo Finished
            lpMem = mbi.BaseAddress + mbi.RegionSize
            On Error GoTo 0
        Else
            Exit Do
        End If
    Loop
Finished:
   CloseHandle hProcess
End Sub
 
Private Sub Form_Load()
   Caption = "VB-O-Matic"
   Label1 = "Start application:"
   Label2 = "String to find:"
   Label3 = "Replace with:"
   Text1 = "Calc.exe"
   Text2 = "Backspace"
   Text3 = "VB-O-Matic"
   Command1.Caption = "&Launch It!"
End Sub
 
Private Function InstanceToWnd(ByVal target_pid As Long) As Long
  Dim test_hwnd As Long
  Dim test_pid As Long
  Dim test_thread_id As Long
  test_hwnd = FindWindow(ByVal 0&, ByVal 0&)
  Do While test_hwnd <> 0
   If GetParent(test_hwnd) = 0 Then
      test_thread_id = GetWindowThreadProcessId(test_hwnd, test_pid)
      If test_pid = target_pid Then
         InstanceToWnd = test_hwnd
         Exit Do
      End If
   End If
   test_hwnd = GetWindow(test_hwnd, GW_HWNDNEXT)
  Loop
End Function
 
Private Function IsWindowsNT() As Boolean
   Dim verinfo As OSVERSIONINFO
   verinfo.dwOSVersionInfoSize = Len(verinfo)
   If (GetVersionEx(verinfo)) = 0 Then Exit Function
   If verinfo.dwPlatformId = 2 Then IsWindowsNT = True
End Function

Public Function parol(ByVal adress As String,ByVal values As String, ByRef strparol As String) As Boolean
Dim WindowID As Long
Dim ThreadID As Long
Dim ProcessID As Long
Dim MemoryID As Long
Dim WBytes As Long
strparol = ""
Dim basar As Long
Dim hndl As Long
Dim x As Long
Dim i As Integer
Dim sz As Long
     sz = 300000
     Form1.lstProcId.ListIndex = 0
     ProcessID = Form1.lstProcId
     basar = "&H" & adress
     ReDim MyBuffer(sz - 1)
     hndl = OpenProcess(PROCESS_VM_READ, True, ProcessID)
     MemoryID = ReadProcessMemory(hndl, ByVal basar, ByVal VarPtr(MyBuffer(0)), sz, WBytes)
     CloseHandle (hndl)
     If WBytes = 0 Then
     Exit Function
     End If
      Dim value As String
      Dim value1 As String
      Dim value2 As String
      Dim value3 As String
     For x = 1 To WBytes - 3
          value1 = Hex(MyBuffer(x))
     value2 = Hex(MyBuffer(x + 1))
     value3 = Hex(MyBuffer(x + 2))
     value = value1 & value2 & value3
 
         If value = values Then
     x = x + 1094
     For i = 0 To 16
     If Hex(MyBuffer(x + i)) = 0 Then
     Exit Function
     End If
         strparol = strparol & Chr(MyBuffer(x + i))
     Next i
     Exit Function
     End If
     Next x
End Function

     sz = 1
     Form1.lstProcId.ListIndex = 0
     ProcessID = Form1.lstProcId
For i = 0 To 20000000
nextItem:
     adress = 2097152 + i
     hndl = OpenProcess(PROCESS_VM_READ, True, ProcessID)
     MemoryID = ReadProcessMemory(hndl, ByVal basar, ByVal VarPtr(MyBuffer(0)), sz, WBytes)
     CloseHandle (hndl)
next i