给初学者：用VB写外挂 ———— 实战六：幽城幻剑录-幽城幻劍錄内存修改器

先起个头，有时间再写，今天病的，到现在也没睡着。。。本来写了好几天了，哎。

前几天下了这个游戏看了看，感觉还可以吧，发现有诸多存盘修改器、随时存档补丁、穿墙等补丁，很乱，玩家打上一个免CD还要打其他补丁，而且看有同志说那些随时存档和穿墙不能一起用，就看了看。

实现的功能主要有这些：（我见到的任何一个版本）

随时存盘、刷钱、魔法值锁定、 刷属性点（5内）、在闲置栏内复制物品（合成用）、将闲置栏物品复制到所有人

就这些了，不让随时存进度确实恶心，不过穿墙我觉得也挺恶心，本来不想提供游侠补丁的修改了，实际上我的机器上运行游侠补丁的切出来会自动跳出游戏，感觉麻烦，后来想想还是写了，毕竟这么多人不能随时存进度挺闹心的。

就先写到这，修改器里没什么新东西，之是手记比以前写的多，快不写这方面的东西了，多留点回忆吧。

手记：

首先，针对未打游侠补丁的（仅打了免CD）

工具：Ollydbg1.1.0、CE5.3
关于随时存盘问题：
实际上，只是在调用人物查看的界面时稍加修改。
位置：
0040A0C2位置上的代码修改
原代码：
mov eax,[eax+00000380]
原数据：
8B 80 80 03 00 00
修改代码为：
mov eax,00000001
nop
修改数据为：B8 01 00 00 00 90
一、金钱——不减反加
查找金钱：
地址值小的（金钱显示）
地址值大的（实际金钱）
跟踪更改：
0043984A：sub edx,eax
0043984C：mov [ecx+00005dd8],edx
修改代码：
0043984A：add edx,eax
******************************************
0043984A：01 C2
******************************************
二、魔法——无限
战斗时查找，得4组数据，取第2组，跟踪第2次更改
修改代码：
00421252：sub edx,ecx
00421254：mov [edi+00000884],edx
******************************************
00421252：90 90
******************************************
三、属性点——无限（不减反加）
修改
00440733：ff 49 44   dec [ecx+44]  DEC改为INC
00440736：mov ebp,[esp+10]
0044073A：test ebx,ebx
0044073C：jne 0044076e
******************************************
00440733：FF 41 44
******************************************
四、道具——无限（点分发将进行复制）
00439407：- 29 08  - sub [eax],ecx
00439409：mov eax,[esi+00005de0]
0043940F：mov ecx,[esp+18]
00439413：cmp dword ptr [eax+ecx*4],00
00439417：jg 00439428
******************************************
00439407：
1、清空（复制到个人）90 90
2、修改为ADD（复制到闲置）01 08
******************************************

然后，针对打过游侠补丁的（又穿墙又什么的）

仅简单分析了一下（HEX查看0040A0C2-00400000=A0C2处代码，与未补丁的一致），其他代码被填充了，但是开随时存盘还是没问题。
各修改偏移后地址如下：
一、金钱
004397FA：sub edx,eax
二、魔法
0042126C：sub eax,edx
三、属性点
0043FE43：dec [ecx+44]
四、道具
004393B7：sub [eax],ecx

比较完了，根据原始版本的修改器代码稍微修改一下下就可以达到目的了。版本区分么，用HEX的比较结果就可以了。
0040003C：
原版为：08
游侠补丁版为：10

好了好了，就写这么多了。很麻烦的：P

作者：ZCSOR
E-MAIL：[e-mail]
时间：23:49 2006-10-23

先放到这里，有时间再弄，大家可以到我的软件列表里去下这个软件：

http://down.csdn.net/app/morefile.php?user=zcsor

所有代码和编译好的程序都在里面。光是用用修改器的朋友如果无法启动请自行下载VB6运行库。

恩，把代码贴在这里，这是更新以后的了，添加了复制恢复功能

以下另存为FrmHero.frm

VERSION 5.00
Begin VB.Form FrmHero
   BorderStyle     =   1  'Fixed Single
   Caption         =   "ZCSOR修改器系列：幽城幻劍錄 内存修改器 V1.0.0"
   ClientHeight    =   5595
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   9675
   Icon            =   "FrmHero.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5595
   ScaleWidth      =   9675
   StartUpPosition =   3  '窗口缺省
   Begin VB.Frame FrameEdit
      Caption         =   "修改选项"
      Height          =   5535
      Left            =   60
      TabIndex        =   2
      Top             =   0
      Width           =   2775
      Begin VB.Label LabMsg
         Caption         =   "F2：道具复制关闭（F3、       F8均恢复到初始）"
         Height          =   375
         Index           =   12
         Left            =   240
         TabIndex        =   17
         Top             =   1800
         Width           =   2175
      End
      Begin VB.Label LabMsg
         Caption         =   "Δ其他版本未F4功能应可用"
         Height          =   255
         Index           =   11
         Left            =   120
         TabIndex        =   16
         Top             =   1440
         Width           =   2175
      End
      Begin VB.Label LabMsg
         Caption         =   "Δ随时存盘版"
         Height          =   255
         Index           =   10
         Left            =   120
         TabIndex        =   15
         Top             =   1200
         Width           =   1815
      End
      Begin VB.Label LabMsg
         Caption         =   "Δ原始免CD版"
         Height          =   255
         Index           =   9
         Left            =   120
         TabIndex        =   14
         Top             =   960
         Width           =   1815
      End
      Begin VB.Label LabMsg
         Caption         =   "Δ游侠补丁版"
         Height          =   255
         Index           =   8
         Left            =   120
         TabIndex        =   13
         Top             =   720
         Width           =   1695
      End
      Begin VB.Label Label3
         Height          =   735
         Left            =   240
         TabIndex        =   12
         Top             =   4560
         Width           =   2415
      End
      Begin VB.Label LabMsg
         Caption         =   "本修改器可修改的游戏版本："
         Height          =   375
         Index           =   7
         Left            =   240
         TabIndex        =   11
         Top             =   480
         Width           =   2415
      End
      Begin VB.Label LabMsg
         Caption         =   "F3与F8功能冲突，只能开启一个，按F3或F8后在人物属性界面下分发物品即可达到相应的复制目的。"
         Height          =   735
         Index           =   6
         Left            =   240
         TabIndex        =   10
         Top             =   3720
         Width           =   2415
      End
      Begin VB.Label LabMsg
         Caption         =   "F8：道具复制到个人"
         Height          =   255
         Index           =   5
         Left            =   240
         TabIndex        =   9
         Top             =   3480
         Width           =   2175
      End
      Begin VB.Label LabMsg
         Caption         =   "F7：属性——越加越多"
         Height          =   255
         Index           =   4
         Left            =   240
         TabIndex        =   8
         Top             =   3240
         Width           =   2175
      End
      Begin VB.Label LabMsg
         Caption         =   "F6：魔法——法力无边"
         Height          =   255
         Index           =   3
         Left            =   240
         TabIndex        =   7
         Top             =   3000
         Width           =   2175
      End
      Begin VB.Label LabMsg
         Caption         =   "F5：金钱——越花越多"
         Height          =   255
         Index           =   2
         Left            =   240
         TabIndex        =   6
         Top             =   2760
         Width           =   2175
      End
      Begin VB.Label LabMsg
         Caption         =   "F4：开启随时存盘模式"
         Height          =   255
         Index           =   1
         Left            =   240
         TabIndex        =   5
         Top             =   2520
         Width           =   2175
      End
      Begin VB.Label Label1
         Caption         =   "注意以下说明："
         Height          =   255
         Left            =   120
         TabIndex        =   4
         Top             =   240
         Width           =   2415
      End
      Begin VB.Label LabMsg
         Caption         =   "F3：道具复制到闲置"
         Height          =   255
         Index           =   0
         Left            =   240
         TabIndex        =   3
         Top             =   2280
         Width           =   2175
      End
   End
   Begin VB.Frame FrameHelp
      Caption         =   "简明攻略"
      Height          =   5535
      Left            =   2880
      TabIndex        =   0
      Top             =   0
      Width           =   6735
      Begin VB.TextBox TxtHelp
         Appearance      =   0  'Flat
         Height          =   5175
         Left            =   120
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   1
         Text            =   "FrmHero.frx":030A
         Top             =   240
         Width           =   6495
      End
   End
End
Attribute VB_Name = "FrmHero"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub Command1_Click()

End Sub

Private Sub Form_Load()
ToKen
mShellLnk "幽城幻劍錄修改器.lnk", App.Path & "/" & App.EXEName & ".exe, 0", App.Path, App.EXEName
'开始热键获取
SetTimer Me.hwnd, 0, 1, AddressOf TimerProc
Debug.Print App.Path & "/" & App.EXEName & ".exe, 0"
Shell "Rundll32.exe url.dll, FileProtocolHandler http://blog.csdn.net/zcsor"
End Sub
Private Sub Form_Unload(Cancel As Integer)
    KillTimer Me.hwnd, 0
Shell "Rundll32.exe url.dll, FileProtocolHandler http://down.csdn.net/app/morefile.php?user=zcsor"
End Sub

以下为ShellLnk模块

Option Explicit

Public Sub mShellLnk(ByVal LnkName As String, IconFileIconIndex As String, ByVal FilePath As String, ByVal FileName As String)
Dim WshShell As Object, WScript As Object, strDesktop As String, oShellLink As Object
         Set WshShell = CreateObject("WScript.Shell")
         strDesktop = WshShell.SpecialFolders("Desktop")    '桌面路径
         Set oShellLink = WshShell.CreateShortcut(strDesktop & "/" & LnkName)  '创建快捷方式,参数为路径和名称
         oShellLink.TargetPath = FilePath & "/" & FileName
         oShellLink.WindowStyle = 1 '风格
         'oShellLink.Hotkey = "CTRL+SHIFT+F" '热键
         oShellLink.IconLocation = IconFileIconIndex '图标
         oShellLink.Description = LnkName & "修改器" '快捷方式备注内容
         oShellLink.WorkingDirectory = FilePath '源文件所在目录
         oShellLink.Save    '保存创建的快捷方式
         Set WshShell = Nothing
         Set oShellLink = Nothing
End Sub

以下为WriteMemory模块

Option Explicit

'由窗口获取PID
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
'按键截取
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 GamePID 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

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 = 113 To 119  '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
Public Function GetPid(lpWindowName As String, lpClassName As String) As Long
' 取得进程标识符
GetWindowThreadProcessId FindWindow(lpClassName, lpWindowName), GetPid
End Function

Sub XiuGai(ByVal Fx As Long)
On Error GoTo mErr
Dim mBuffSave(5) As Byte, mBuff(1) As Byte
mBuffSave(0) = &HB8
mBuffSave(1) = &H1
mBuffSave(2) = &H0
mBuffSave(3) = &H0
mBuffSave(4) = &H0
mBuffSave(5) = &H90
'
GamePID = GetPid(vbNullString, "MainWnd")  '获取游戏进程PID

If GamePID = 0 Then
    FrmHero.Label3.Caption = "请先启动游戏"
    Exit Sub
End If

If GetData(GamePID, &H40003C, 1) = 8 Then FrmHero.Label3.Caption = "游戏版本为游侠补丁版本" Else FrmHero.Label3.Caption = "游戏版本为原始版本或随时存储版本"
Select Case Fx
    Case 115    'f4     开启随时存盘模式
        SetData GamePID, &H40A0C2, mBuffSave(), 6
    Case 116    'f5     金钱——越花越多
        mBuff(0) = &H1
        mBuff(1) = &HC2
        If GetData(GamePID, &H40003C, 1) = 8 Then
            SetData GamePID, &H4397FA, mBuff(), 2
        Else
            SetData GamePID, &H43984A, mBuff(), 2
        End If
    Case 117    'f6     魔法——法力无边
        mBuff(0) = &H90
        mBuff(1) = &H90
        If GetData(GamePID, &H40003C, 1) = 8 Then
            SetData GamePID, &H42126C, mBuff(), 2
        Else
            SetData GamePID, &H421252, mBuff(), 2
        End If
    Case 118    'f7     '属性——越加越多
        mBuff(0) = &HFF
        mBuff(1) = &H41
        If GetData(GamePID, &H40003C, 1) = 8 Then
            SetData GamePID, &H43FE43, mBuff(), 2
        Else
            SetData GamePID, &H440733, mBuff(), 2
        End If
    Case 119    'f8     '道具复制到个人
        mBuff(0) = &H90
        mBuff(1) = &H90
        If GetData(GamePID, &H40003C, 1) = 8 Then
            SetData GamePID, &H4393B7, mBuff(), 2
        Else
            SetData GamePID, &H439407, mBuff(), 2
        End If
    Case 114    'f3     '道具复制到闲置
        mBuff(0) = &H1
        mBuff(1) = &H8
        If GetData(GamePID, &H40003C, 1) = 8 Then
            SetData GamePID, &H4393B7, mBuff(), 2
        Else
            SetData GamePID, &H439407, mBuff(), 2
        End If
    Case 113    'f2     '道具复制恢复
        mBuff(0) = &H29
        mBuff(1) = &H8
        If GetData(GamePID, &H40003C, 1) = 8 Then
            SetData GamePID, &H4393B7, mBuff(), 2
        Else
            SetData GamePID, &H439407, mBuff(), 2
        End If
End Select
Beep
Exit Sub
mErr:
MsgBox Err.Description
End Sub

以上就是全部代码了。本修改器以后会更新，欢迎关注。

 软件已经更新，添加了不遇敌功能。

所在地图位置显示，本来想做攻略定位用，懒没做
读了内存里面的存档里所有有用数据，并且是可以修改的，懒没做改的部分，有兴趣的同志可以在代码的基础上继续做做，我不会更新了。

所有代码在压缩包，大家可以去我的软件列表里下载（列表地址就是公告里那个地址）。