使用VB修改游戏内存参数（完美世界）

使用 API 介绍

这里的代码提供的是使用 vb 修改游戏的内存数据，供大家参考
代码主要使用了

• 窗体查找函数（FindWindow）
• 进程获取函数 （GetWindowThreadProcessId）
• 进程打开函数 （OpenProcess）
• 读取进程内存 （ReadProcessMemory）
• 写进程内存 （WriteProcessMemory）

代码 demo

'--------------------------------定义------------------------------------------------------------
Dim hwd As Long ' 储存 FindWindow 函数返回的句柄
Dim pid As Long
Dim hProcess As Long '存放进程句柄
Dim base As Long '存放人物基地址
Dim name_temp As Long
Dim mz(31) As Byte '名字
Dim hp As Long '存储生命值
Dim hpmax As Long '存储生命最大值
Dim mp As Long '存储真气值
Dim mpmax As Long '存储真气最大值
Dim dengji As Long '等级
Dim xiuzhen As Long '修真
Dim money As Long '金钱
Dim exp As Double '经验
Dim yuanshen As Double '元神

'-------------------------配置--------------------------------
Dim ft As String _ 255, ft1 As String _ 255, ft2 As String _ 255
Dim yc As String _ 255, yc1 As String _ 255, yc2 As String _ 255
Dim cq As String _ 255, cq1 As String _ 255, cq2 As String _ 255
Dim sy As String _ 255, sy1 As String _ 255, sy2 As String _ 255
Dim zft As Long, zft1 As Long, zft2 As Long
Dim zyc As Long, zyc1 As Long, zyc2 As Long
Dim zcq As Long, zcq1 As Long, zcq2 As Long
Dim zsy As Long, zsy1 As Long, zsy2 As Long

'--------------------窗口代码------------------------------------------------------------------------------
Private Sub Timer1_Timer()
hwd = FindWindow("ElementClient Window", "Element Client") '获取窗口
GetWindowThreadProcessId hwd, pid '获取进程
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid)

ReadProcessMemory hProcess, ByVal &H92764C, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H20, base, 4, 0& '一级基址
ReadProcessMemory hProcess, ByVal base + &H5CC, name_temp, 4, 0& '得到角色名
ReadProcessMemory hProcess, ByVal name_temp, mz(0), 32, 0&
ReadProcessMemory hProcess, ByVal base + &H450, hp, 4, 0& '得到生命值
ReadProcessMemory hProcess, ByVal base + &H478, hpmax, 4, 0& '得到生命最大值
ReadProcessMemory hProcess, ByVal base + &H454, mp, 4, 0& '得到真气值
ReadProcessMemory hProcess, ByVal base + &H47C, mpmax, 4, 0& '得到真气最大值
ReadProcessMemory hProcess, ByVal base + &H448, dengji, 4, 0& '等级
ReadProcessMemory hProcess, ByVal base + &H270, xiuzhen, 4, 0& '修真
ReadProcessMemory hProcess, ByVal base + &H2D4, money, 4, 0& '金钱
ReadProcessMemory hProcess, ByVal base + &H458, exp, 4, 0& '经验
ReadProcessMemory hProcess, ByVal base + &H464, yuanshen, 4, 0& '元神

If hwd = 0 Then
Label15.Caption = "游戏未启动"
Else
Label15.Caption = "游戏启动成功"
End If
End Sub

Private Sub Form_Unload(Cancel As Integer) '退出 恢复
WriteProcessMemory hProcess, ByVal 4555473, -2033774220, 4, 0&
WriteProcessMemory hProcess, ByVal 4329880, 1155093371, 4, 0&
WriteProcessMemory hProcess, ByVal 4215305, 232311257, 4, 0&
WriteProcessMemory hProcess, ByVal 4216567, 1317602165, 4, 0&
WriteProcessMemory hProcess, ByVal 4593432, -125600140, 4, 0&

CloseHandle hProcess
End Sub

'---------------启动代码------------------------------------------------------------------------------

Private Sub Command1_Click() 'OPEN
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
End Sub

Private Sub Command2_Click()
If InStr(1, Text1.Text, "elementclient") <> 0 Then '目录比较
RPath = CommonDialog1.FileName
Shell RPath & " game:cpw", vbNormalFocus
Else
MsgBox "请选择路径！", vbInformation '错误后，窗口信息弹出
End If
End Sub

Private Sub Command3_Click() 'SET
Shell "notepad.exe set.ini", vbNormalFocus
End Sub

Private Sub Command4_Click() 'HELP
Shell "notepad.exe help.ini", vbNormalFocus
End Sub

Private Sub Check1_Click() '隐藏游戏窗口
If Check1.Value = 1 Then
i = ShowWindow(hwd, SW_HIDE)
Else
i = ShowWindow(hwd, SW_SHOW)
End If
End Sub

Private Sub Check2_Click() '隐藏辅助窗口
If Check2.Value = 1 Then
cSysTray1.InTray = True '隐藏到任务栏
Me.Visible = False '让程序界面不可见
End If
End Sub

Private Sub CsysTray1_MouseDown(Button As Integer, Id As Long)
Me.WindowState = 0 '程序回复到 Normal 状态
Me.Visible = True '从任务栏中清除图标
cSysTray1.InTray = False '令程序界面可见
Check2.Value = 0
End Sub

Private Sub Timer2_Timer()
Label14.Caption = StrConv(mz, vbFromUnicode)
Label2.Caption = hp & "/" & hpmax
Label4.Caption = mp & "/" & mpmax
Label6.Caption = yuanshen
Label10.Caption = dengji
Label11.Caption = money
Label20.Caption = exp
Label21.Caption = xiuzhen
End Sub

'--------------工具代码------------------------------------------------------------------------------

''''''''''''''''''''''''''''多开----------------------------
Private Sub Command5_Click()
TimesNow = Now()
SetWindowText hwd, "YY 完美" & TimesNow
End Sub

''''''''''''''''''''''''''''自动加点------------------------

'''''''''''''''''''''''''''彩色发言-------------------------

'''''''''''''''''''''''''''自动喊世界------------------------

'------------------挂机代码------------------------------------------------------------------------------

Private Sub Command6_Click()
Form2.Show
End Sub

'------------------技能代码------------------------------------------------------------------------------

'------------------BT 代码--------------------------------------------------------------------------------

Private Sub Check3_Click() '飞天
If Check3.Value = 1 Then
WriteProcessMemory hProcess, ByVal 4555473, -2033774217, 4, 0&
Else
WriteProcessMemory hProcess, ByVal 4555473, -2033774220, 4, 0&
End If
End Sub

Private Sub Check4_Click() '穿墙
If Check4.Value = 1 Then
WriteProcessMemory hProcess, ByVal 4215305, 232311258, 4, 0&
Else
WriteProcessMemory hProcess, ByVal 4215305, 232311257, 4, 0&
End If
End Sub

Private Sub Check5_Click() '隐藏
If Check5.Value = 1 Then
WriteProcessMemory hProcess, ByVal 4329880, 1155093483, 4, 0&
Else
WriteProcessMemory hProcess, ByVal 4329880, 1155093371, 4, 0&
End If
End Sub

Private Sub Check6_Click() '无限视野
If Check6.Value = 1 Then
WriteProcessMemory hProcess, ByVal 4216567, 1317602166, 4, 0&
Else
WriteProcessMemory hProcess, ByVal 4216567, 1317602165, 4, 0&
End If
End Sub

Private Sub Check7_Click() '空中漫步
If Check7.Value = 1 Then
WriteProcessMemory hProcess, ByVal 4593432, -125600137, 4, 0&
Else
WriteProcessMemory hProcess, ByVal 4593432, -125600140, 4, 0&
End If
End Sub

Private Sub Check8_Click() '无限跳跃

End Sub

Private Sub check9_click() '小号入仙魔

End Sub

'-------------------关于代码------------------------------------------------------------------------------

Private Sub Label16_Click()
url = "http://taosha126.ys168.com/"
Shell "explorer " & url, 0
End Sub
Private Sub Label16_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Label16.ForeColor = &H0&
End Sub

'-------------------菜单代码------------------------------------------------------------------------------
Private Sub 使用说明\_Click()
Shell "notepad.exe help.ini", vbNormalFocus
End Sub

Private Sub 退出\_Click()
Unload Form1
End Sub

Private Sub 打开\_Click()
CommonDialog1.ShowOpen
Text1.Text = CommonDialog1.FileName
If InStr(1, Text1.Text, "elementclient") <> 0 Then '目录比较
RPath = CommonDialog1.FileName
Shell RPath & " game:cpw", vbNormalFocus
End If
End Sub

Private Sub 关于\_Click()
frmAbout.Show
End Sub

Private Sub 配置\_Click()
Shell "notepad.exe set.ini", vbNormalFocus
End Sub