Scan Another Process for a Memory Value and Replace It

Category:

System/API

Type:

Snippets

Difficulty:

Advanced

Author:

Arkadiy Olovyannikov

Version Compatibility: Visual Basic 6, Visual Basic 5

More information:

VB clone of Cheat-o-matic (application for cheating games).

Instructions: Copy the declarations and code below and paste directly into your VB project.

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

Code:

'Add 3 labels, 3 textboxes and 1 commandbutton on form

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