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 String, ByVal lpWindowName As String) 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

'在窗体添加三个label三个textbox一个commandbutton

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)
              Command1.Caption = sSearchString
        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(&H1F0FFF, 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
                                     Me.Caption = ReadProcessMemory(hProcess, ByVal mbi.BaseAddress, ByVal sBuffer, mbi.RegionSize, lWritten)
'Check   if   region   contain   search   string
                                      lPos = InStr(1, sBuffer, sSearchString, vbTextCompare)‘为什么这里得到想要的结果呀
                                      List1.AddItem StrConv(sBuffer, vbUnicode)
                                      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

请大家帮我调试下