前几天发布了泰坦之旅V1.08 十项属性修改器1.0.0版本，这里的代码将是1.1.0版本的代码。
首先，来说一下思路，我们要实现的是一些修改功能及其恢复，先复习一下前几次说到的函数：
我们利用下面这个函数来获取游戏进程指定地址（我们将要修改的地址）的数据，将其保存起来。
Public Function GetData(ByVal lppid As Long, ByVal lpAddress As Long, SaveData() As Byte, Optional ByVal dtLen As Long = 4)
Dim pHandle As Long ' 储存进程句柄
' 使用进程标识符取得进程句柄
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lppid)
' 在内存地址中读取数据
ReadProcessMemory pHandle, ByVal lpAddress, ByVal VarPtr(SaveData(0)), dtLen, 0&
' 关闭进程句柄
CloseHandle pHandle
End Function
我们利用下面这个函数，来修改游戏内存，我们要修改的和恢复的都是用这个写回去。
'将修改内存
Public Function SetData(ByVal lppid As Long, ByVal lpDestAddr As Long, lpSrcAddr() As Byte, Optional ByVal dtLen As Long = 4) As Boolean
On Error GoTo mErr
Dim lBytesReadWrite As Long
Dim pHandle As Long ' 储存进程句柄
' 使用进程标识符取得进程句柄
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lppid)
WriteProcessMemory pHandle, ByVal lpDestAddr, ByVal VarPtr(lpSrcAddr(0)), dtLen, 0&
' 关闭进程句柄
CloseHandle pHandle
SetData = True
mErr:
End Function
修改器的思路是这样的：一般的，比较容易实现的功能，我们使用直接修改代码的方法，例如在快速升级这里，我们直接将游戏里面MOVE [***]，EAX修改为MOVE [***]，ESP，这样，经验增加的就很多了，当然，这是通过搜索经验，然后锁定改变经验地址数据的代码来实现的。稍微复杂一些的，我们跟踪以后，将代码跳转到指定位置，在新位置调用我们的汇编代码，而后，返回到跳转前的位置继续执行；这里，有些修改，我们不是直接修改了改变数据的代码地址，而是跟踪到调用处去修改。这里说的新代码地址是直接用CE查看得到的可用地址，本来想讲一下为指定进程申请内存空间而后把代码跳转到新空间内运行的，但是想来没有必要，一般程序都有这个空地址的，这个技术会用一个新帖子给大家介绍，但用的主要技术并非我写的代码。
使用的工具：
CE5.3、SPY+++、TSPYXP、Ollydbg_fix
如果你没有这些软件，可以象我索取。
以下介绍一种热键技术，当写这个修改器的时候，可以发现我们以前介绍的“全局热键”不好用了，也就是说“红色警戒修改器”那里介绍的用RegisterHotKey定义的热键在该游戏界面下无响应，我在论坛里发帖子请教，有朋友介绍用GetKeyState试试，但是我写了代码没有成功（详细见http://community.csdn.net/Expert/topic/5033/5033124.xml?temp=.6968195），而后用eXeScope查看了一下下载游戏时带的那个5项属性修改器（Titan_edit_06_07_13）调用的API函数，发现它调用了USER32.DLL的GetAsyncKeyState函数，看见这个名字想必大家都意识到它和按键获取有关，查了一下API说明，有这样一句话引起了我的注意：微软的win32手册指出：倘若输入焦点从属于与调用函数的输入线程不同的另一个输入线程，则返回值为0（例如，一旦另一个程序拥有焦点，则它应返回零）。证据显示，函数实际是在整个系统的范围内工作的。接下来翻看了一下Swinapi，里面有一个完整代码，介绍了该函数的调用，直接把代码复制到VB编辑器，修改代码将得到的按键信息输出到DEBUG，运行，进入游戏，按下一个按键，切回来，发现按键被拦截了，但是只按了一下却出现了N个提示，稍做修改，就达到了要求，详细可以参看下面的代码。
以上就是所有问题的详细叙述了，没别的好说，把代码贴出来给大家共享一下：（注意代码前的说明）
本代码共1一个窗体（Form1）、3个模块（Module1、Module2、Module3）、一个资源文件（LOGO.RES）为调试时不会出现错误，我已经把LOAD函数内加载资源语句注释掉了。
以下请另存为工程1.VBP（复制并保存为文件）：
Type=Exe
Form=Form1.frm
Reference=*/G{00020430-0000-0000-C000-000000000046}#2.0#0#C:/WINDOWS/System32/stdole2.tlb#OLE Automation
Module=Module1; Module1.bas
Module=Module2; Module2.bas
Module=Module3; Module3.bas
ResFile32="LOGO.RES"
IconForm="Form1"
Startup="Form1"
HelpFile=""
Title="泰坦之旅V1.08 十项属性修改器"
ExeName32="泰坦之旅V1.08 十项属性修改器.exe"
Command32=""
Name="泰坦之旅修改器"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=1
RevisionVer=1
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="YY"
VersionProductName="泰坦之旅V1.08 十项属性修改器"
CompilationType=-1
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1
'以下请保存为（Form1.frm）
VERSION 5.00
Begin VB.Form Form1
AutoRedraw = -1 'True
BorderStyle = 3 'Fixed Dialog
Caption = "泰坦之旅v1.08十项属性修改器V1.1.0"
ClientHeight = 2760
ClientLeft = 45
ClientTop = 330
ClientWidth = 4560
LinkTopic = "泰坦之旅v1.08十项属性修改器"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 2760
ScaleWidth = 4560
ShowInTaskbar = 0 'False
StartUpPosition = 2 '屏幕中心
Begin VB.Frame Frame3
Height = 540
Left = 2890
TabIndex = 8
Top = -80
Width = 1680
Begin VB.PictureBox PicSoft
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Left = 30
MousePointer = 14 'Arrow and Question
Picture = "Form1.frx":0000
ScaleHeight = 375
ScaleWidth = 1605
TabIndex = 9
Top = 120
Width = 1605
End
End
Begin VB.Frame Frame2
Height = 540
Left = 0
TabIndex = 6
Top = -80
Width = 1680
Begin VB.PictureBox PicBBS
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Left = 30
MousePointer = 14 'Arrow and Question
Picture = "Form1.frx":2572
ScaleHeight = 375
ScaleWidth = 1605
TabIndex = 7
Top = 120
Width = 1605
End
End
Begin VB.Frame Frame6
Height = 540
Left = 1680
TabIndex = 4
Top = -80
Width = 1215
Begin VB.PictureBox LogoPic
Appearance = 0 'Flat
BorderStyle = 0 'None
ForeColor = &H80000008&
Height = 375
Left = 30
MouseIcon = "Form1.frx":47D4
MousePointer = 99 'Custom
ScaleHeight = 375
ScaleWidth = 1140
TabIndex = 5
Top = 120
Width = 1140
End
End
Begin VB.Frame Frame1
Height = 375
Left = 0
TabIndex = 1
Top = 2400
Width = 4575
Begin VB.Label Label4
Caption = "启动成功.注意:修改成功无提示;按下第2次撤消修改!"
Height = 195
Left = 120
TabIndex = 2
Top = 135
Width = 4305
End
End
Begin VB.Label LabF
ForeColor = &H00FF0000&
Height = 1815
Left = 100
TabIndex = 3
Top = 480
Width = 255
End
Begin VB.Label LabMSG
Height = 1935
Left = 480
TabIndex = 0
Top = 480
Width = 3975
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'请保留作者信息：
'ZCSOR于06-9-10开发
'E-MAIL:shaoyan5@163.com
'本代码主要演示当游戏界面下用RegisterHotKey定义的全局热键不能被接收时如何定义一种可接收的热键
Option Explicit
Private Sub Form_Load()
'SetLogo 101 加载资源文件
'初始化要写入的数据
Call SetAas: SetI: SetDi: SetNsr: SetIlu: SetIm: SetIap: SetIsk: SetIe: SetIh
'Debug.Print Aas(0), I(0), Di(0), Nsr(0), Ilu(0), Im(0), Iap(0), Isk(0), Ie(0), Ih(0)
ToKen
'开始热键获取
SetTimer Me.hwnd, 0, 1, AddressOf TimerProc
LabMSG.Caption = "F1 ：无限生命(INFINITE HEALTH)" & vbCrLf & _
"F2 ：无限魔法(INFINITE ENERGY)" & vbCrLf & _
"F3 ：无限技能(INFINITE SKILL POINTS)" & vbCrLf & _
"F4 ：无限属性(INFINITE ATTRIBUTE POINTS)" & vbCrLf & _
"F5 ：无限金钱(INFINITE GOLO)" & vbCrLf & _
"F6 ：开通所有技能(ACCESS ALL SKILLS)" & vbCrLf & _
"F7 ：无技能恢复等待(NO SKILL RECHARGE)" & vbCrLf & _
"F8 ：右键卖出物品不消失(DUPE ITEMS)" & vbCrLf & _
"F9 ：不建议-隐身,只能自己打(INVISIBILITY)" & vbCrLf & _
"F10：不建议-直接到25,以后要同级怪(LEVEL UP)"
SetMsg
PicBBS.ToolTipText = "http://www.3q2008.com/bbs/sml_class.asp?id=78"
PicSoft.ToolTipText = "http://down.csdn.net/app/morefile.php?user=zcsor"
LogoPic.ToolTipText = "按左键打开Blog，按右键打开软件列表"
End Sub
Private Sub Form_Unload(Cancel As Integer)
'停止热键获取
KillTimer Me.hwnd, 0
' "爱翔广宇揽东日之傲骨梅花 飞入梦境待晓时其清水芙蓉"
End Sub
Private Sub SetLogo(ByVal ResID As Long)
LogoPic.Picture = LoadResPicture(ResID, 0)
End Sub
Private Sub LogoPic_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Select Case Button
Case 1
Shell "Rundll32.exe url.dll, FileProtocolHandler http://blog.csdn.net/zcsor"
Case 2
Shell "Rundll32.exe url.dll, FileProtocolHandler http://down.csdn.net/app/morefile.php?user=zcsor"
Case Else
MsgBox "按左键打开Blog，按右键打开软件列表"
End Select
End Sub
Private Sub PicBBS_Click()
Shell "Rundll32.exe url.dll, FileProtocolHandler http://www.3q2008.com/bbs/sml_class.asp?id=78"
End Sub
Private Sub PicSoft_Click()
LogoPic_MouseUp 2, 0, 1, 1
End Sub
'以下保存为Module1.bas,或者复制到Module1编辑页都可以（Module2、Module3也可类似处理）
'负责权限,内存读写
Option Explicit
'查找窗体写内存等
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 OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal 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 CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const STANDARD_RIGHTS_REQUIRED = &HF0000
Private Const SYNCHRONIZE = &H100000
Private Const SPECIFIC_RIGHTS_ALL = &HFFFF
Private Const STANDARD_RIGHTS_ALL = &H1F0000
Private Const PROCESS_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED Or SYNCHRONIZE Or &HFFF
Private Const PROCESS_VM_OPERATION = &H8&
Private Const PROCESS_VM_READ = &H10&
Private Const PROCESS_VM_WRITE = &H20&
'权限提升
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Const TOKEN_ASSIGN_PRIMARY = &H1
Private Const TOKEN_DUPLICATE = (&H2)
Private Const TOKEN_IMPERSONATE = (&H4)
Private Const TOKEN_QUERY = (&H8)
Private Const TOKEN_QUERY_SOURCE = (&H10)
Private Const TOKEN_ADJUST_PRIVILEGES = (&H20)
Private Const TOKEN_ADJUST_GROUPS = (&H40)
Private Const TOKEN_ADJUST_DEFAULT = (&H80)
Private Const TOKEN_ALL_ACCESS = (STANDARD_RIGHTS_REQUIRED Or TOKEN_ASSIGN_PRIMARY Or _
TOKEN_DUPLICATE Or TOKEN_IMPERSONATE Or TOKEN_QUERY Or TOKEN_QUERY_SOURCE Or _
TOKEN_ADJUST_PRIVILEGES Or TOKEN_ADJUST_GROUPS Or TOKEN_ADJUST_DEFAULT)
Private Const SE_PRIVILEGE_ENABLED = &H2
Private Const ANYSIZE_ARRAY = 1
Private Type LUID
lowpart As Long
highpart As Long
End Type
Private Type LUID_AND_ATTRIBUTES
pLuid As LUID
Attributes As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long
Privileges(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private GamePid As Long ' 储存进程标识符( Process Id )
Private msgStr(1 To 10) As String
'提升权限为高
Public Function ToKen() As Boolean
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
Dim lp As Long
hdlProcessHandle = GetCurrentProcess()
lp = OpenProcessToken(hdlProcessHandle, TOKEN_ALL_ACCESS, hdlTokenHandle)
lp = LookupPrivilegeValue("", "SeDebugPrivilege", tmpLuid)
tkp.PrivilegeCount = 1
tkp.Privileges(0).pLuid = tmpLuid
tkp.Privileges(0).Attributes = SE_PRIVILEGE_ENABLED
lp = AdjustTokenPrivileges(hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded)
ToKen = lp
End Function
'获取内存内容,本函数返回值为当前该地址数值（10进制）
'Public Function GetData(ByVal lppid As Long, ByVal lpADDress As Long, Optional ByVal dtLen As Long = 4) As Long
'Dim pHandle As Long ' 储存进程句柄
' 使用进程标识符取得进程句柄
'pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lppid)
' 在内存地址中读取数据
'ReadProcessMemory pHandle, ByVal lpADDress, ByVal VarPtr(GetData), dtLen, 0&
' 关闭进程句柄
'CloseHandle pHandle
'End Function
'获取内存内容，该函数在调用时将SaveData()作为参数传入，函数无返回值，调用后SaveData()内容即为当前地址内容（BYTE数组）
Public Function GetData(ByVal lppid As Long, ByVal lpAddress As Long, SaveData() As Byte, Optional ByVal dtLen As Long = 4)
Dim pHandle As Long ' 储存进程句柄
' 使用进程标识符取得进程句柄
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lppid)
' 在内存地址中读取数据
ReadProcessMemory pHandle, ByVal lpAddress, ByVal VarPtr(SaveData(0)), dtLen, 0&
' 关闭进程句柄
CloseHandle pHandle
End Function
'将修改内存
Public Function SetData(ByVal lppid As Long, ByVal lpDestAddr As Long, lpSrcAddr() As Byte, Optional ByVal dtLen As Long = 4) As Boolean
On Error GoTo mErr
Dim lBytesReadWrite As Long
Dim pHandle As Long ' 储存进程句柄
' 使用进程标识符取得进程句柄
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, lppid)
WriteProcessMemory pHandle, ByVal lpDestAddr, ByVal VarPtr(lpSrcAddr(0)), dtLen, 0&
' 关闭进程句柄
CloseHandle pHandle
SetData = True
mErr:
End Function
Public Function GetPid(lpClassName As String, lpWindowName As String) As Long
' 取得进程标识符
GetWindowThreadProcessId FindWindow(lpClassName, lpWindowName), GetPid
End Function
Public Sub Xiugai(ByVal Fx As String)
On Error GoTo m_Err
Dim msgStr As String '临时字符,标志是修改还是恢复
GamePid = GetPid("Titan Quest", "Titan Quest") '获取游戏进程PID
If GamePid = 0 Then
Form1!Label4.Caption = "请先启动游戏！"
Exit Sub
End If
If mGetOver = False Then Get_B '若没有备份原来的内存数据则备份它
'根据参数进行相应的写内存操作
Select Case Fx
'*******************************************************
'F1:生命
'*******************************************************
Case "F1"
If mSetOver(1) Then
SetData GamePid, &H163F700, IhEx_B(), 30
SetData GamePid, &H1547A52, Ih_B(), 6
msgStr = "恢复"
Else
SetData GamePid, &H163F700, IhEx(), 30
SetData GamePid, &H1547A52, Ih(), 6
msgStr = "修改"
End If
mSetOver(1) = Not mSetOver(1)
'*******************************************************
'F2魔法
'*******************************************************
Case "F2"
If mSetOver(2) Then
SetData GamePid, &H163F750, IeEx_B(), 30
SetData GamePid, &H1547B5A, Ie_B(), 6
msgStr = "恢复"
Else
SetData GamePid, &H163F750, IeEx(), 30
SetData GamePid, &H1547B5A, Ie(), 6
msgStr = "修改"
End If
mSetOver(2) = Not mSetOver(2)
'*******************************************************
'F3技能
'*******************************************************
Case "F3"
If mSetOver(3) Then
SetData GamePid, &H1597368, Isk_B(), 1
msgStr = "恢复"
Else
SetData GamePid, &H1597368, Isk(), 1
msgStr = "修改"
End If
mSetOver(3) = Not mSetOver(3)
'*******************************************************
'F4属性
'*******************************************************
Case "F4"
If mSetOver(4) Then
SetData GamePid, &H15972A9, Iap_B(), 1
SetData GamePid, &H15972BB, Iap_B(), 1
SetData GamePid, &H15972CD, Iap_B(), 1
SetData GamePid, &H15972DF, Iap_B(), 1
SetData GamePid, &H15972F1, Iap_B(), 1
msgStr = "恢复"
Else
SetData GamePid, &H15972A9, Iap(), 1
SetData GamePid, &H15972BB, Iap(), 1
SetData GamePid, &H15972CD, Iap(), 1
SetData GamePid, &H15972DF, Iap(), 1
SetData GamePid, &H15972F1, Iap(), 1
msgStr = "修改"
End If
mSetOver(4) = Not mSetOver(4)
'*******************************************************
'F5金钱
'*******************************************************
Case "F5"
If mSetOver(5) Then
SetData GamePid, &H163F7A0, ImEx_B(), 21
SetData GamePid, &H1539439, Im_B(), 6
msgStr = "恢复"
Else
SetData GamePid, &H163F7A0, ImEx(), 21
SetData GamePid, &H1539439, Im(), 6
msgStr = "修改"
End If
mSetOver(5) = Not mSetOver(5)
'*******************************************************
'F10 立即升级
'*******************************************************
Case "F10"
If mSetOver(10) Then
SetData GamePid, &H1597492, Ilu_B(), 1
msgStr = "恢复"
Else
SetData GamePid, &H1597492, Ilu(), 1
msgStr = "修改"
End If
mSetOver(10) = Not mSetOver(10)
'*******************************************************
'F7 无技能冷却
'*******************************************************
Case "F7"
If mSetOver(7) Then
SetData GamePid, &H15F9E1A, Nsr_B(), 4
msgStr = "恢复"
Else
SetData GamePid, &H15F9E1A, Nsr(), 4
msgStr = "修改"
End If
mSetOver(7) = Not mSetOver(7)
'*******************************************************
'F8 道具复制 SetDi
'*******************************************************
Case "F8"
If mSetOver(8) Then
SetData GamePid, &H455011, Di_B(), 6
msgStr = "恢复"
Else
SetData GamePid, &H455011, Di(), 6
msgStr = "修改"
End If
mSetOver(8) = Not mSetOver(8)
'*******************************************************
'F9 隐身 SetI
'*******************************************************
Case "F9"
If mSetOver(9) Then
SetData GamePid, &H1563195, I_B(), 1
msgStr = "恢复"
Else
SetData GamePid, &H1563195, i(), 1
msgStr = "修改"
End If
mSetOver(9) = Not mSetOver(9)
'*******************************************************
'F6 开通所有技能
'*******************************************************
Case "F6"
If mSetOver(6) Then
SetData GamePid, &H474C5C, Aas_B(), 2
SetData GamePid, &H47328B, AasEx_B(), 1
SetData GamePid, &H473455, AasExEx_B(), 6
msgStr = "恢复"
Else
SetData GamePid, &H474C5C, Aas(), 2
SetData GamePid, &H47328B, AasEx(), 1
SetData GamePid, &H473455, AasExEx(), 6
msgStr = "修改"
End If
mSetOver(6) = Not mSetOver(6)
End Select
SetMsg
Form1!Label4.Caption = Fx & msgStr & "成功！" '显示修改/恢复项目是否成功
Exit Sub
m_Err:
Form1!Label4.Caption = Fx & "修改失败啦！"
MsgBox Err.Description
End Sub
'将游戏中将被修改的原始数据读回保存
Public Sub Get_B()
GetData GamePid, &H163F700, IhEx_B(), 30
GetData GamePid, &H1547A52, Ih_B(), 6
GetData GamePid, &H163F750, IeEx_B(), 30
GetData GamePid, &H1547B5A, Ie_B(), 6
GetData GamePid, &H1597368, Isk_B(), 1
GetData GamePid, &H15972A9, Iap_B(), 1
GetData GamePid, &H15972BB, Iap_B(), 1
GetData GamePid, &H15972CD, Iap_B(), 1
GetData GamePid, &H15972DF, Iap_B(), 1
GetData GamePid, &H15972F1, Iap_B(), 1
GetData GamePid, &H163F7A0, ImEx_B(), 21
GetData GamePid, &H1539439, Im_B(), 6
GetData GamePid, &H1597492, Ilu_B(), 1
GetData GamePid, &H15F9E1A, Nsr_B(), 4
GetData GamePid, &H455011, Di_B(), 6
GetData GamePid, &H1563195, I_B(), 1
GetData GamePid, &H474C5C, Aas_B(), 2
GetData GamePid, &H47328B, AasEx_B(), 1
GetData GamePid, &H473455, AasExEx_B(), 6
mGetOver = True '修改备份标志
End Sub
Public Sub SetMsg() '修改是否修改信息
Dim i As Long
Form1!LabF.Caption = ""
For i = 1 To 10
If mSetOver(i) Then msgStr(i) = "ON" & vbCrLf Else msgStr(i) = "OFF" & vbCrLf
Form1!LabF.Caption = Form1!LabF.Caption & msgStr(i)
Next i
End Sub
'以下为Module2
'负责热键的定义和获取,结束的函数在FORM1的UNLOAD过程
Option Explicit
Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Global Cnt As Long, Ret As Long
'获取按下的是哪个键
Function GetPressedKey() As Long
For Cnt = 112 To 121 '112-121 为 F1-F10
If GetAsyncKeyState(Cnt) <> 0 Then
GetPressedKey = Cnt
If Ret = Cnt Then Exit Function '如果按下的键重复,表示一次按键还没有结束,不重复进行修改
Select Case Cnt
Case 116
Xiugai "F5"
Case 117
Xiugai "F6"
Case 118
Xiugai "F7"
Case 119
Xiugai "F8"
Case 120
Xiugai "F9"
Case 112
Xiugai "F1"
Case 113
Xiugai "F2"
Case 114
Xiugai "F3"
Case 115
Xiugai "F4"
Case 121
Xiugai "F10"
Case Else
End Select
Exit For
End If
Next Cnt
End Function
'回调
Sub TimerProc(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
Ret = GetPressedKey
End Sub
'以下为Module3
'负责数据定义
Option Explicit
'写入数据,及备份原来数据
Public Ilu(0) As Byte '立即升级(instant level up),
Public Ilu_B(0) As Byte
Public Di(5) As Byte '道具复制(dupe items)
Public Di_B(5) As Byte
Public Nsr(3) As Byte '无技能冷却(no skill recharge)
Public Nsr_B(3) As Byte
Public Aas(1) As Byte '开通所有技能(access all skills)
Public AasEx(0) As Byte
Public AasExEx(5) As Byte
Public Aas_B(1) As Byte
Public AasEx_B(0) As Byte
Public AasExEx_B(5) As Byte
Public i(0) As Byte '永远不被敌人看见(invisibility)
Public I_B(0) As Byte
Public Ih(5) As Byte '无限生命
Public IhEx(29) As Byte
Public Ih_B(5) As Byte
Public IhEx_B(29) As Byte
Public Ie(5) As Byte '无限魔法
Public IeEx(29) As Byte
Public Ie_B(5) As Byte
Public IeEx_B(29) As Byte
Public Isk(0) As Byte '无限技能
Public Isk_B(0) As Byte
Public Iap(0) As Byte '无限属性
Public Iap_B(0) As Byte
Public Im(5) As Byte '无限金钱
Public ImEx(20) As Byte
Public Im_B(5) As Byte
Public ImEx_B(20) As Byte
Public mSetOver(1 To 10) As Boolean '是否经过修改
Public mGetOver As Boolean '是否已经备份数据
Public Sub SetIlu()
Ilu(0) = &H66
End Sub
Public Sub SetNsr()
Nsr(0) = &H33: Nsr(1) = &HC0: Nsr(2) = &H90: Nsr(3) = &H90
End Sub
Public Sub SetDi()
Di(0) = &HE9: Di(1) = &H1: Di(2) = &H1: Di(3) = &H0: Di(4) = &H0: Di(5) = &H0
End Sub
Public Sub SetAas()
Aas(0) = &H90: Aas(1) = &H90: AasEx(0) = &HEB
AasExEx(0) = &H90: AasExEx(1) = &H90: AasExEx(2) = &H90: AasExEx(3) = &H90: AasExEx(4) = &H90: AasExEx(5) = &H90
End Sub
Public Sub SetI()
i(0) = &HEB
End Sub
Public Sub SetIh()
IhEx(0) = &HD9: IhEx(6) = &H81: IhEx(7) = &HFD: IhEx(8) = &HA4: IhEx(9) = &HF9: IhEx(10) = &H22: IhEx(11) = &H0: IhEx(12) = &HF
IhEx(13) = &H85: IhEx(15) = &H83: IhEx(16) = &HF0: IhEx(17) = &HFF: IhEx(18) = &HC7: IhEx(19) = &H46: IhEx(21) = &H0: IhEx(22) = &H40
IhEx(23) = &H9C: IhEx(24) = &H45: IhEx(25) = &HE9: IhEx(27) = &H83: IhEx(28) = &HF0: IhEx(29) = &HFF
IhEx(1) = &H56: IhEx(2) = &H18: IhEx(3) = &HD8: IhEx(4) = &H65: IhEx(5) = &HEC: IhEx(14) = &H46: IhEx(20) = &H18: IhEx(26) = &H3A
Ih(0) = &HE9: Ih(4) = &H0: Ih(5) = &H90: Ih(1) = &HA9: Ih(2) = &H7C: Ih(3) = &HF
End Sub
Public Sub SetIe()
IeEx(0) = &HD9: IeEx(6) = &H81: IeEx(7) = &HFD: IeEx(8) = &HA4: IeEx(9) = &HF9: IeEx(10) = &H22: IeEx(11) = &H0: IeEx(12) = &HF
IeEx(13) = &H85: IeEx(15) = &H83: IeEx(16) = &HF0: IeEx(17) = &HFF: IeEx(18) = &HC7: IeEx(19) = &H46: IeEx(21) = &H0: IeEx(22) = &H40
IeEx(23) = &H9C: IeEx(24) = &H45: IeEx(25) = &HE9: IeEx(27) = &H83: IeEx(28) = &HF0: IeEx(29) = &HFF
IeEx(1) = &H5E: IeEx(2) = &H2C: IeEx(3) = &H83: IeEx(4) = &HC4: IeEx(5) = &HC: IeEx(14) = &HFE: IeEx(20) = &H2C: IeEx(26) = &HF2
Ie(0) = &HE9: Ie(4) = &H0: Ie(5) = &H90: Ie(1) = &HF1: Ie(2) = &H7B: Ie(3) = &HF
End Sub
Public Sub SetIsk()
Isk(0) = &H90
End Sub
Public Sub SetIap()
Iap(0) = &H90
End Sub
Public Sub SetIm()
ImEx(0) = &H8B: ImEx(1) = &H81: ImEx(2) = &H48: ImEx(3) = &H9: ImEx(4) = &H0: ImEx(5) = &H0: ImEx(6) = &HC7: ImEx(7) = &H81
ImEx(8) = &H48: ImEx(9) = &H9: ImEx(10) = &H0: ImEx(11) = &H0: ImEx(12) = &HFF: ImEx(13) = &HC9: ImEx(14) = &H9A: ImEx(15) = &H3B
ImEx(16) = &HE9: ImEx(17) = &H8A: ImEx(18) = &H9C: ImEx(19) = &HEF: ImEx(20) = &HFF
Im(1) = &H62: Im(2) = &H63: Im(3) = &H10: Im(0) = &HE9: Im(4) = &H0: Im(5) = &H90
End Sub
这就是全部代码了。
成品程序在下载区里面有，但是里面没有附加代码。程序比前一版本大不少，原因就是里面多了2个图片。
程序界面上面3个图片框可连接到相关讨论、我的博客、下载列表等。
1.1.0我发到下载区了，可是没发布，不知道为什么，可能是以为我发重了吧，大家去网上找找，应该在其他地方还有。