给初学者：用VB写外挂 ———— 实战五：虚拟人生2修改器

手记：

说明
所有数据为16进制，使用的游戏主程序是游侠网提供的（不知道什么版本，直接在BT上下的），大小为840Kb的那种。
工具
CE5.3、金山游侠

一、金钱
CE默认选项搜索未得到地址，用金山游侠搜索，得到地址003D7324（整型），将地址添加到CE地址栏，查找更改此地址代码。
a、交过路费：
地址0042C0E6 （走到对手栏里也相同）
代码mov [eax+00000114],ebx
上一行0042C0E4
代码sub ebx,edi
将SUB修改为ADD
即
0042C0E4处修改为01 fb
b、重金收买怪兽（走到对手栏里也相同）
同上
即
0042EB81处修改为01  c6
c、走到自己怪兽格投资
004301F6处修改为01 ca
d、研究新怪兽
00437932处修改为01 f8
Z、直接修改金钱，其他的就先放下吧，买装备和投资的钱自己想办法吧
以上过程的代码均为mov [eax+00000114],XXX找到EAX的地址即可直接修改金钱，建立新搜索查找EAX值003D7210，找到地址004CFB18直接读后+114就是金钱地址，然后修改即可。
004CF9B0处读EAX（4字节）后加16进制114
二、属性
先搜索第一个吧，道德。
用金山查找
得到的地址003D732C该地址。。与金钱的只差8字节，金钱地址+4得到地址数据为1300，不知道什么属性，向后依次+4得到：
钱 EAX+114+0*4
？ EAX+114+1*4
德 EAX+114+2*4
智 EAX+114+3*4
体 EAX+114+4*4
魅 EAX+114+5*4
攻 EAX+114+6*4 （无武器时攻击）
防 EAX+114+7*4 （无防具时防御）
后面的地址连续8字节0后是CD
其他的就先不改了，很过分哦。记得以前玩的时候，好象有个什么秘籍，翻看了一下：
首先在 Save 目录的 2 目录夹下，创建 vl2 文件（注意没有任何扩展名）

然后在 Save 目录的 4 目录夹下，创建 cheat 文件（注意没有任何扩展名）

这样以后在游戏进行中就可以使用如下密技键了：

按数字键 1-8 直接确定行走步数

在战斗时快速按 Z 键可加快蓄力

《虚拟人生2》补充秘籍
首先在save目录下的2中建立vl2文件，不加扩展名（可用0目录下的文件复制更名），再在4目录下用同样方法建立cheat文件，便开启了秘籍模式。
在游戏画面直接键入：
1-8 控制行走步数
p 升一级
m 得到10000元

就是这样了。简单的写一下就好，另外，很多朋友下载以后想安到其他磁盘却看见说明里面必须安装在某某目录，其实改一下注册表就可以了，这里提供一个REG文件，导入就可以。

代码计划：
1、修改器放在游戏目录下，简化代码。
2、在2目录下建立vl2、在4目录下建立cheat文件，开启秘籍模式
3、修改注册表修正目录属性使之可以运行，并直接用SHELL函数打开VL2000.EXE获取PID。
4、修改以下代码
0042C0E4处修改为01  '交过路费得到相应金钱

0042EB81处修改为01  '收买怪兽增加相应金钱

004301F6处修改为01  '投资加相应金钱

00437932处修改为01  '研究怪兽加相应金钱

5、读004CF9B0处4字节得到EAX
修改以下内存地址内容
钱 EAX+114+0*4
？ EAX+114+1*4
德 EAX+114+2*4
智 EAX+114+3*4
体 EAX+114+4*4
魅 EAX+114+5*4
攻 EAX+114+6*4 （无武器时攻击）
防 EAX+114+7*4 （无防具时防御）

FRMMAIN.FRM文件

VERSION 5.00
Begin VB.Form FrmMain
   BorderStyle     =   1  'Fixed Single
   Caption         =   "ZCSOR修改器系列：虚拟人生Ⅱ修改器 V1.0.0"
   ClientHeight    =   3165
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   6165
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   3165
   ScaleWidth      =   6165
   StartUpPosition =   3  '窗口缺省
   Begin VB.CommandButton CmdHidePr
      Caption         =   "提高属性"
      Height          =   495
      Left            =   4680
      TabIndex        =   3
      Top             =   2520
      Width           =   1215
   End
   Begin VB.CommandButton CmdEdit
      Caption         =   "过路、收买、投资、研究怪兽费用不扣反加"
      Height          =   495
      Left            =   1800
      TabIndex        =   2
      Top             =   2520
      Width           =   2535
   End
   Begin VB.CheckBox ChkEditREG
      Caption         =   "修复游戏注册目录（请在弹出添加注册表项目对话框中选择“是”）"
      Height          =   495
      Left            =   120
      TabIndex        =   1
      Top             =   0
      Width           =   5895
   End
   Begin VB.CommandButton CmdRun
      Caption         =   "开始游戏"
      Height          =   495
      Left            =   240
      TabIndex        =   0
      Top             =   2520
      Width           =   1215
   End
   Begin VB.Label LabMsg
      Caption         =   $"FrmMain.frx":0000
      Height          =   1695
      Left            =   120
      TabIndex        =   4
      Top             =   600
      Width           =   5895
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub CmdEdit_Click()
XiuGai 118
End Sub

Private Sub CmdHidePr_Click()
XiuGai 117
End Sub

Private Sub CmdRun_Click()
'修改注册表
If ChkEditREG.Value Then EditREG
VLPID = Shell(VLPath & "vl2000.exe")

End Sub

Private Sub Form_Load()
'提升权限
ToKen
'开始获取按键
SetTimer Me.hwnd, 0, 1, AddressOf TimerProc
'获取目录
VLPath = App.Path & "/"
'开启作弊模式
AddFile VLPath & "save/2/vl2"
AddFile VLPath & "save/4/cheat"
'Shell "Rundll32.exe url.dll, FileProtocolHandler http://down.csdn.net/app/morefile.php?user=zcsor"
End Sub

Private Sub AddFile(ByVal PathName As String)
Open PathName For Binary As #1
Close #1
End Sub

Private Sub EditREG()
On Error Resume Next
Kill VLPath & "注册游戏.Reg"
Open VLPath & "注册游戏.Reg" For Output As #1
    Print #1, "REGEDIT4"
    Print #1,
    Print #1, "[HKEY_LOCAL_MACHINE/SOFTWARE/Tomorrow Studio]"
    Print #1,
    Print #1, "[HKEY_LOCAL_MACHINE/SOFTWARE/Tomorrow Studio/VirtualLife2]"
    Print #1, """" & "Version" & """" & "=" & """" & "2.00" & """"
    Print #1, """" & "StageCount" & """" & "=dword:0000000a"
    Print #1, """" & "StateFinished" & """" & "=dword:00000001"
    Print #1, """" & "PicShow" & """" & "=dword:00000000"
    Print #1, """" & "ResultFlag" & """" & "=dword:00000000"
    Print #1, """" & "MonsterNumber" & """" & "=dword:00000011"
    Print #1, """" & "CDPATH" & """" & "=" & """" & Replace(VLPath, "/", "//") & """"
    Print #1, """" & "SetupPath" & """" & "=" & """" & Replace(VLPath, "/", "//") & """"
Close #1
'Shell "Rundll32.exe url.dll, FileProtocolHandler " & VLPath & "注册游戏.Reg", vbNormalFocus
Shell "cmd /c regedit " & VLPath & "注册游戏.Reg", vbHide
End Sub
Private Sub Form_Unload(Cancel As Integer)
'停止获取
    KillTimer Me.hwnd, 0
' "爱翔广宇揽东日之傲骨梅花 飞入梦境待晓时其清水芙蓉"
'Shell "Rundll32.exe url.dll, FileProtocolHandler http://blog.csdn.net/zcsor"
End Sub

模块：

Option Explicit

'内存 操作
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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
'权限提升
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
'按键截取
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

Public VLPath As String
Public VLPID As Long
Public VLEAX As Long
'提升权限为高
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
'将修改内存
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
'获取按下的是哪个键
Function GetPressedKey() As Long
    For Cnt = 116 To 118  '112-121 为 F1-F10
        If GetAsyncKeyState(Cnt) <> 0 Then
            GetPressedKey = Cnt
            If Ret = Cnt Then Exit For '如果按下的键重复,表示一次按键还没有结束,不重复进行修改
            XiuGai Cnt
        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

Sub XiuGai(ByVal Fx As Long)
On Error GoTo mErr
Dim mValue As Long, mIndex As Long, mBuff(3) As Byte, mBuffEx(1) As Byte
VLEAX = GetData(VLPID, &H4CFB18)
Debug.Print VLPID, VLEAX
'If VLPID = 0 Then Exit Sub
Select Case Fx
    Case 116    'f5
        mValue = GetData(VLPID, VLEAX + &H114)
        mDec2HexArr mValue + 888888, mBuff()
        If mValue < 88888888 Then SetData VLPID, VLEAX + &H114, mBuff()
    Case 117    'f6
        For mIndex = 8 To 28 Step 4
            mValue = GetData(VLPID, VLEAX + &H114 + mIndex)
            mDec2HexArr mValue + 888, mBuff()
            If mValue < 888888 Then SetData VLPID, VLEAX + &H114 + mIndex, mBuff(), 2
        Next
    Case 118    'f7
        mBuffEx(0) = &H1
        mBuffEx(1) = &HFB
        SetData VLPID, &H42C0E4, mBuffEx(), 2
        mBuffEx(1) = &HC6
        SetData VLPID, &H42EB81, mBuffEx(), 2
        mBuffEx(1) = &HCA
        SetData VLPID, &H4301F6, mBuffEx(), 2
        mBuffEx(1) = &HF8
        SetData VLPID, &H437932, mBuffEx(), 2
End Select
Exit Sub
mErr:
MsgBox Err.Description
End Sub
'10进制到16进制数组
Public Sub mDec2HexArr(ByVal Dec As Long, ByRef HexArray() As Byte)
CopyMemory ByVal VarPtr(HexArray(0)), Dec, 4
End Sub
 

手记里面写的已经非常清楚了。