[VFB]罪恶之都小助手

最近整理电脑找出了这个游戏,这个是最喜欢的单机游戏之一 哈哈 

制作工具:Visual Free Basic

制作环境:Win10

内存读写,多线程,热键,PostMessage

源码及程序下载:https://download.csdn.net/download/weixin_44300440/12721047

效果图:

模块代码:

#Include Once "win\tlhelp32.bi"
#Include Once "win\winnt.bi" 
#Include Once "win\winbase.bi"
#Include Once "win\winuser.bi"
Function GetPidOfName(ByVal ProcessName as LPCWSTR)As DWORD '进程名取进程ID
   Dim Snpst As HANDLE  
   Dim ProcessInFo As PROCESSENTRY32 
   Dim PFirst As Long      
   ZeroMemory (@ProcessInFo,SizeOf(ProcessInFo))
   Snpst = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
   If Snpst = 0 Then 
       MessageBox(0, "获取快照失败", "系统提示", 48)
       Function = 0
    EndIf 
   ProcessInFo.dwSize = SizeOf(PROCESSENTRY32)
   PFirst = Process32First(Snpst,@ ProcessInFo)
   While (PFirst <> 0)
       If StrCmpI(ProcessInFo.szExeFile, ProcessName) = 0 Then
           CloseHandle(Snpst)
           Function = ProcessInFo.th32ProcessID
       End If
       PFirst = Process32Next(Snpst,@ ProcessInFo)
  Wend
   CloseHandle Snpst
 End Function
Function GethProcss(ByVal Pid as DWord) as HANDLE
   Dim phandle as HANDLE 
   phandle = OpenProcess(&H1F0FFF, 0, Pid)
   If phandle  Then
       Function = phandle
        Exit Function
   EndIf
   Function = 0
   CloseHandle phandle
End Function

Function ReadMemory(ByVal hProcess As HANDLE, ByVal lpBaseAddress as UInteger, ByVal lpBuffer As  LPVOID, sLen as UInteger) As Integer  
    dim rtmp as Integer 
    rtmp =ReadProcessMemory(hProcess ,Cast(LPVOID,lpBaseAddress ),lpBuffer,sLen,0)
     If rtmp Then 
        Function = rtmp
        Exit Function
    EndIf
    Function = 0
End Function

Function WriteMemoryInt(ByVal hProcess As HANDLE, ByVal Addre as UInteger, ByVal intBuffer As  Integer) As Long 
    dim wtmp as Long  
    Dim tmpBuffer As LPCVOID
    tmpBuffer = @intBuffer
    wtmp = WriteProcessMemory(hProcess, Cast(LPVOID, Addre), tmpBuffer, SizeOf(Integer), 0)
    If wtmp Then 
        Function = wtmp
        Exit Function
    EndIf
    Function = 0
End Function

Function WriteMemoryFloat(ByVal hProcess As HANDLE, ByVal Addre as UInteger, ByVal floatBuffer As  Single) As Long 
    dim wtmp as Long  
    Dim tmpBuffer As LPCVOID
    tmpBuffer = @floatBuffer
    wtmp = WriteProcessMemory(hProcess, Cast(LPVOID, Addre), tmpBuffer, SizeOf(Single), 0)
    If wtmp Then 
        Function = wtmp
        Exit Function
    EndIf
    Function = 0
End Function

Function WriteMemoryByte(ByVal hProcess As HANDLE, ByVal Addre as UInteger, ByVal byteBuffer As Byte) As Long 
    dim wtmp as Long  
    Dim tmpBuffer As LPCVOID
    tmpBuffer = @byteBuffer
    wtmp = WriteProcessMemory(hProcess, Cast(LPVOID, Addre), tmpBuffer, 1, 0)
    If wtmp Then 
        Function = wtmp
        Exit Function
    EndIf
    Function = 0
End Function

Sub InpCode(ByVal hGame As HANDLE, ByVal Code As LPSTR ) 
    Dim tmp As UInteger
    For x As Short = 0 To (strlen(Code) - 1)
         tmp = Asc(Left(Code [x], 1),1)
        PostMessage(hGame, &H0100,tmp, 0)
        PostMessage(hGame,&h0101,tmp,0)
        Sleep 10
    Next
End Sub

窗体代码:

Type GTAPerson '定义一个游戏人物的数据类型
    As DWORD pid   '进程ID
    As HANDLE hProcess      '进程句柄
    As Integer Money '金币
    As Single Blood  '血液
    As Single Defense
    As Byte Star '犯罪星级
    As Byte Smoking '吸烟
    As Byte SeaWays '水上漂
    As Single zuobiao(3) '坐标
    As Byte Car
End Type

Dim Shared Person1 As GTAPerson 
Dim Shared As UInteger BaseAdd,StarAdd,XyZAdd
Dim Shared As BOOLEAN StartSwitch
Dim Shared hGame As HANDLE
Const USERMSG = WM_USER+100
Sub Form1_Command2_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击    
    If WriteMemoryInt(Person1.hProcess, 9743816, ValUInt(Text8.Text)) = 0 Then MessageBox(0, "金币写入失败", "错误", 48) EndIf
    If WriteMemoryFloat(Person1.hProcess, BaseAdd + 852, ValUInt(Text9.Text)) = 0 Then MessageBox(0, "血液写入失败", "错误", 48) EndIf
    If WriteMemoryFloat(Person1.hProcess, BaseAdd + 856,ValUInt(Text14.Text)) = 0 Then MessageBox(0, "防弹衣写入失败", "错误", 48) EndIf
    If WriteMemoryByte(Person1.hProcess, StarAdd + 32, ValUInt (Text10.Text)) = 0 Then MessageBox(0, "犯罪星级写入失败", "错误", 48) EndIf   
End Sub
Sub Form1_Check1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '水上漂开关
    If Check1.Value Then 
       WriteMemoryByte(Person1.hProcess,10554241,1)
       Check1.Value = True 
       Check1.Caption = "水上漂已开启"
    Else
        Check1.Value = False
        Check1.Caption = "水上漂已关闭"
        WriteMemoryByte(Person1.hProcess,10554241,0)
   EndIf
End Sub
Sub GetGameInfo()
    ReadMemory(Person1.hProcess,9743816,@Person1.Money,4)'游戏金币
    Text1.Text = Person1.Money
    
    ReadMemory(Person1.hProcess, 9743656, @BaseAdd, SizeOf(Single)) '获取血液基址
    ReadMemory(Person1.hProcess, BaseAdd + 852, @Person1.Blood, SizeOf(Single)) '加偏移获取正确血液基址 
    Text2.Text = Str(Person1.Blood)
    
    ReadMemory(Person1.hProcess, BaseAdd+ 856, @Person1.Defense, SizeOf(Single))
    Text7.Text = Str(Person1.Defense)
    
    ReadMemory(Person1.hProcess , 9743656, @StarAdd, 4) 
    ReadMemory(Person1.hProcess , StarAdd+ 1524, @StarAdd, 4)
    ReadMemory(Person1.hProcess , StarAdd + 32, @Person1.Star, 1)'获取犯罪星级
    Text3.Text = Str(Person1.Star)
    
    ReadMemory(Person1.hProcess, 8277684, @XyZAdd, 4) 
    ReadMemory(Person1.hProcess,XyZAdd, @Person1.zuobiao(0), SizeOf(Single))
    Text4.Text = Person1.zuobiao(0)
    ReadMemory(Person1.hProcess, XyZAdd+4, @Person1.zuobiao(1), SizeOf(Single))
    Text5.Text = Person1.zuobiao(1)
    ReadMemory(Person1.hProcess, XyZAdd+8, @Person1.zuobiao(2), SizeOf(Single))
    Text6.Text=Person1.zuobiao(2)
End Sub
Sub Form1_Command1_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
    hGame = FindWindow(0, "GTA: Vice City")
    GetGameInfo
    ReadMemory(Person1.hProcess, 10554241, @Person1.SeaWays, 1)
    ReadMemory(Person1.hProcess, 10554147, @Person1.Smoking, 1)
    ReadMemory(Person1.hProcess, 10554160, @Person1.Car , 1)
    If Person1.Car Then 
       Check3.Value = True 
       Check3.Caption = "汽车特效已开启"
    Else
        Check3.Value = False
        Check3.Caption = "汽车特效已关闭"
   EndIf
    If Person1.SeaWays Then
        Check1.Value = True
        Check1.Caption = "水上漂已开启"
    Else
        Check1.Value = False
        Check1.Caption = "水上漂已关闭"
    EndIf
    If Person1.Smoking Then
        Check2.Value = True
        Check2.Caption = "吸烟已开启"
    Else
        Check2.Value = False
        Check2.Caption = "吸烟已关闭"
    EndIf
    StartSwitch = True
    Threaddetach ThreadCreate(Cast(Any Ptr,@ReadPosition),0) 
End Sub

Sub ReadPosition(ByVal userdata As Any Ptr ) 
    While StartSwitch
        SendMessage(Me.hWnd,USERMSG,0,0)
        Sleep 100
    Wend
End Sub

Sub Form1_Shown(hWndForm As hWnd,UserData As Integer)  '窗口完全显示后。UserData 来自显示窗口最后1个参数。
    Person1.pid  = GetPidOfName("gta-vc.exe")
    if Person1.pid = 0 Then  
        MessageBox(0, "请检查游戏是否运行", "错误", 48)
        End 
    End If
    Person1.hProcess  = GethProcss(Person1.pid)
    If Person1.hProcess = 0 Then
         MessageBox(0, "请检查游戏是否运行", "错误", 48)
        End
    End If
    
    If RegisterHotKey(Me.hWnd, 100, 0, VK_F1) = 0 Then MessageBox(0, "热键注册失败", "错误", 48) End If
    If RegisterHotKey(Me.hWnd, 101, 0, VK_F2) = 0 Then MessageBox(0, "热键注册失败", "错误", 48) End If
    If RegisterHotKey(Me.hWnd, 102, 0, VK_F3) =0 Then MessageBox(0, "热键注册失败", "错误", 48) End If
 End Sub

Function Form1_WM_Close(hWndForm As hWnd) As LResult  '即将关闭窗口，返回非0可阻止关闭
    StartSwitch = False
    UnregisterHotKey(Me.hWnd, 100)
    UnregisterHotKey(Me.hWnd, 101)
    UnregisterHotKey(Me.hWnd, 102)
   Function = FALSE ' 如果想阻止窗口关闭，则应返回 TRUE 。
End Function

Sub Form1_Check2_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
    If Check2.Value Then 
       WriteMemoryByte(Person1.hProcess,10554147,1)
       Check2.Value = True 
       Check2.Caption = "吸烟已开启"
    Else
        Check2.Value = False
        Check2.Caption = "吸烟已关闭"
        WriteMemoryByte(Person1.hProcess,10554147,0)
   EndIf
End Sub

Function Form1_Custom(hWndForm As hWnd, wMsg As UInteger, wParam As wParam, lParam As lParam) As LResult  '自定义消息（全部消息），在其它事件处理后才轮到本事件。
    If wMsg = WM_HOTKEY And wParam = 100 Then InpCode(hGame, "PROFESSIONALTOOLS") End If
    If wMsg = WM_HOTKEY And wParam = 101 Then InpCode(hGame, "PANZER") End If
    If wMsg = WM_HOTKEY And wParam = 102 Then InpCode(hGame, "LEAVEMEALONE") End If
    if wMsg = USERMSG Then GetGameInfo EndIf 
   Function = FALSE ' 若不想系统继续处理此消息，则应返回 TRUE （俗称吃掉消息）。

End Function

Sub Form1_Check3_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
    If Check3.Value Then 
       WriteMemoryByte(Person1.hProcess,10554160,1)
       Check3.Value = True 
       Check3.Caption = "汽车特效已开启"
    Else
        Check3.Value = False
        Check3.Caption = "汽车特效已关闭"
        WriteMemoryByte(Person1.hProcess,10554160,0)
   EndIf
End Sub

Sub Form1_Command3_BN_Clicked(hWndForm As hWnd, hWndControl As hWnd)  '单击
    If  Text11.Text <> "" And text12.Text <> "" And text13.Text <> "" Then
        if WriteMemoryFloat(Person1.hProcess, XyZAdd, Val(Text11.Text)) Then 
            if WriteMemoryFloat(Person1.hProcess, XyZAdd+4, Val(Text11.Text)) Then 
                if WriteMemoryFloat(Person1.hProcess, XyZAdd+8, Val(Text11.Text)) Then EndIf
            End If
        End If
    EndIf
    
End Sub