给初学者：用VB写外挂 ———— 实战二：写一个简单而又完整的修改器—深海挣霸简体中文汉化版资源修改器

和以前的代码基本相似，深海这个游戏做修改器比较简单，看步骤：

一、打开Cheat Engine 5.2打开汉化版游戏，选择训练模式或其他模式，在CE中选择ST.EXE（游戏本身进程）。

二、查找当前某资源数，最终得到3个地址，绿的那个就是要修改的地址了，第2个是现在显示值，第3个和绿色的这个相同，第2个数值最终要达到的大小。

代码如下：（测试前加入2个LABEI命名为LABEL4， 另一个为LABMSG）

窗体：（直接复制即可，无须保存为*.FRM）

'请保留作者信息：
'ZCSOR于06-9-10开发
'E-MAIL:[email protected]

Option Explicit

Private Sub Form_Load()
MsgBox "    深海挣霸简体中文硬盘版(因是注入汉化,其他版本也应可用,但未测试)" & vbCrLf & "有问题请联系我:作者：ZCSOR   E-MAIL：[email protected]", vbOKOnly, "爱翔广宇揽东日之傲骨梅花 飞入梦境待晓时其清水芙蓉"
ToKen
'定义热键
Dim ret As Long

preWinProc = GetWindowLong(Me.hwnd, GWL_WNDPROC)
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf wndproc)

    uVirtKeyF5 = vbKeyF5   'F5
    uVirtKeyF6 = vbKeyF6   'F6
    uVirtKeyF7 = vbKeyF7   'F7

   
    idHotKey = idHotKey + 1: ret = RegisterHotKey(Me.hwnd, idHotKey, 0, uVirtKeyF5)
    idHotKey = idHotKey + 1: ret = RegisterHotKey(Me.hwnd, idHotKey, 0, uVirtKeyF6)
    idHotKey = idHotKey + 1: ret = RegisterHotKey(Me.hwnd, idHotKey, 0, uVirtKeyF7)

LabMSG.Caption = "深海挣霸简体中文版" & vbCrLf & _
                 "单机游戏    修改器" & vbCrLf & _
                 "F5:资源一+88888" & vbCrLf & _
                 "F6:资源二+88888" & vbCrLf & _
                 "F7:资源三+88888" & vbCrLf

End Sub

Private Sub Form_Unload(Cancel As Integer)
Dim ret As Long
'取消Message的截取，而使之又只送往原来的Window Procedure
ret = SetWindowLong(Me.hwnd, GWL_WNDPROC, preWinProc)
Call UnregisterHotKey(Me.hwnd, uVirtKeyF5)
Call UnregisterHotKey(Me.hwnd, uVirtKeyF6)
Call UnregisterHotKey(Me.hwnd, uVirtKeyF7)
End Sub

模块：（其中读数据未使用，相关API和函数可删去）

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

'热键
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Public Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long

Public Const WM_HOTKEY = &H312
Public Const GWL_WNDPROC = (-4)

Public preWinProc As Long

Public uVirtKeyF5 As Long
Public uVirtKeyF6 As Long
Public uVirtKeyF7 As Long
Public uVirtKeyF8 As Long
Public uVirtKeyF9 As Long

Public idHotKey As Long

 

' 储存进程标识符( Process Id )

Private 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

'获取内存内容,本函数返回值为当前该地址数值（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)

Dim addrEAX As Long
Dim mBuff(3) As Byte
On Error GoTo m_Err

GamePid = GetPid("STWindowClass", "Submarine Titans")

If GamePid = 0 Then
    Form1!Label4.Caption = "请先启动游戏！"
    Exit Sub
End If

'要写入的88888
mBuff(0) = &H38
mBuff(1) = &H5B
mBuff(2) = &H1
mBuff(3) = &H0

'以下修改分别对应:

'硅训练
'硅任务

'人训练
'人任务

'全部战役

Select Case Fx
    '*******************************************************
    'F5:
    '*******************************************************
    Case "F5"
        '硅资源1
        SetData GamePid, &H7F813E, mBuff()
        SetData GamePid, &H7F57B6, mBuff()
        '人资源1
        SetData GamePid, &H7F8229, mBuff()
        SetData GamePid, &H7F4E3F, mBuff()
        '资源1
        SetData GamePid, &H7F6D65, mBuff()
    '*******************************************************
    'F6
    '*******************************************************
    Case "F6"
        '硅资源2
        SetData GamePid, &H7F77CB, mBuff()
        SetData GamePid, &H7F4E43, mBuff()
        '人资源2
        SetData GamePid, &H7F822D, mBuff()
        SetData GamePid, &H7F58A5, mBuff()
        '资源2
        SetData GamePid, &H7F6D69, mBuff()
    '*******************************************************
    'F7
    '*******************************************************
    Case "F7"
        '硅资源3
        SetData GamePid, &H7F8146, mBuff()
        SetData GamePid, &H7F57BE, mBuff()
        '人资源3
        SetData GamePid, &H7F8231, mBuff()
        SetData GamePid, &H7F4E47, mBuff()
        '资源3
        SetData GamePid, &H7F6D6D, mBuff()
End Select

Form1!Label4.Caption = Fx & "修改成功！"

Exit Sub
m_Err:
Form1!Label4.Caption = "修改失败啦！"

End Sub

'热键

Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_HOTKEY Then
    If wParam <= idHotKey Then
        Select Case lParam
            Case 7602176
                Xiugai "F5"
            Case 7667712
                Xiugai "F6"
            Case 7733248
                Xiugai "F7"
        End Select
       
    End If
End If
'将之送往原来的Window Procedure
wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam)
End Function

没什么好说的了，到这里这个写外挂的基本教程应该已经结束了，以后会讲到其他方面。

代码可以在CSDN的下载→源码下载→GAME里面下载到，发布了，但是还没出来地址，代码和上面基本相同。

下载地址：http://down.csdn.net/html/2006-09/10/158834.html

提供另一个修改器的地址，它们的做法基本是相同的

http://down.csdn.net/html/2006-09/11/159242.html

这个版本代码中有些错误，写恶心了，更正了一下，也叫“魔幻精灵3-冰月华 修改器” 是1.1 版本，发布了，下载地址都在下载→源码下载→GAME。

最近写了一个泰坦之旅V1.08 十项属性修改器，放到下载区里了，可以在这里下http://down.csdn.net/app/morefile.php?user=zcsor

。有兴趣的同志可以交流一下~~~代码先不公开，等基本功能都实现了再公开在这里。