这是一个API函数应用的实例程序,在vb6中新建一个工程,在Form1中建立两个command button,然后将下面的代码复制到Form1中,然后就请大家运行测试一下吧!

 

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 OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId 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 WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long

'得到窗体Rect
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
'刷新窗体Rect
Private Declare Function InvalidateRect& Lib "user32" (ByVal hwnd As Long, lpRect As RECT, ByVal bErase As Long)
' 关闭进程句柄
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Const PROCESS_ALL_ACCESS = &H1F0FFF  '最高权限

Private Const xAddr As Long = &H10056A8 '横坐标地址
Private Const yAddr As Long = &H10056AC '纵坐标地址
Private Const qiAddr As Long = &H8E '选中小棋标志
Private Const mapAddr As Long = &H1005361 '数据起始地址
'0x1005340+0x20+0x01

Private Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Private Sub Command1_Click()
     Call Shell("winmine.exe", vbNormalFocus)
End Sub

Private Sub Command2_Click()
    Dim hProcess As Long
    Dim wHwnd As Long
    Dim pid As Long
    wHwnd = FindWindow(vbNullString, "扫雷")  '获得窗体句柄
    Call GetWindowThreadProcessId(wHwnd, pid)       '取得进程标识符
    hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid)  ' 取得进程句柄 'PROCESS_ALL_ACCESS最高权限
    If hProcess = 0 Then
       MsgBox "未找到游戏!", vbOKOnly + vbInformation
       Exit Sub
    End If
    Dim mx As Long
    Dim my As Long
    Dim mn As Long
    Dim bytMap() As Byte
    Call ReadProcessMemory(hProcess, ByVal xAddr, my, 4, 0&)
    Call ReadProcessMemory(hProcess, ByVal yAddr, mx, 4, 0&)
    If my = 0 Or mx = 0 Then Exit Sub

    ReDim bytMap(my * 32 - 1) As Byte
    Call ReadProcessMemory(hProcess, ByVal mapAddr, bytMap(0), my * 32, 0&)
    Dim I As Long, J As Long
   
    For I = 0 To my - 1
        For J = 0 To mx - 1
            If bytMap(I * 32 + J) = &H8F Then
                '标出雷区
                Call WriteProcessMemory(hProcess, ByVal (mapAddr + I * 32 + J), ByVal VarPtr(CLng(qiAddr)), 1, 0&)
            Else
'                Print "0";
            End If
        Next
        Print
    Next
   
    Dim tR As RECT
    Call GetClientRect(wHwnd, tR)          '得到扫雷窗口
    Call InvalidateRect(wHwnd, tR, True)   '刷新扫雷窗口
    Call CloseHandle(hProcess)          ' 关闭进程句柄
End Sub