Go语言视频零基础入门到精通

admin

前几天发布了泰坦之旅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我发到下载区了，可是没发布，不知道为什么，可能是以为我发重了吧，大家去网上找找，应该在其他地方还有。