|
前言 大家都知道,VB是不能进行内存动态搜索的,所以用VB就没有办法做具有搜索功能的游戏修改器,但是今天我们可以通过另一种方法实现内存的搜索. 首先我们来看一下原理,其实原理是很简单的,大家都知道VB中有ReadProcessMemory和WriteProcessMemory这两个API,它们是用来读和写进程的内存数据的.我们搜索的方法是通过第一次将ReadProcessMemory读取的内存数据保存下来,然后再一次进行搜索的时候通过这个临时文件来达到搜索的目的. 好了,下面我们就来制作一个带有搜索功能的游戏修改器. 窗体 我们打开VB6,全讯网,新建一个标准的EXE工程,将窗体名称设置为frmMain,调整到适当的大小. 添加6个Label控件,分别命名为lblProgram、lblSearch、lblPlan、lblResultNumber、lblResults、lblCheat 添加2个ComboBox控件,分别命名为cmbProgram、cmbSearch 添加6个Command控件,分别命名为cmdRefProgram、cmdStart、cmdNext、cmdFreeze、cmdPoke、cmdStop 添加1个TextBox控件,命名为txtSearch 添加1个ProgressBar控件,命名为pbrPlan 添加2个ListBox控件,分别命名为lstResults、lstCheat 添加1组10个Timer控件,命名为FreezeTimer API 然后我们添加一个模板,用来存放需要使用的API,然后写入如下代码: '申明API '查找指定窗体的API Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long '取得指定窗体的进程ID Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long '打开指定的进程 Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long '写进程内存,这个API在好多游戏编辑器中是非常常用的 Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, ByVal lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long '读进程内存,用来读取进程内存中的数据.也是游戏编辑器中常用的API之一 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 '关闭一个内核对象,在本程序中为关闭进程 Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long '对消息字符串进行格式化的API Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As Long '这个API大家并不常用,他的作用是在第一次遇到系统截图时返回关于进程的信息 Declare Function ProcessFirst Lib "kernel32" Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long '这个API大家并不常用,他的作用是再一次遇到反馈的系统截图时返回关于进程的信息 Declare Function ProcessNext Lib "kernel32" Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long '为进程、模块、堆栈或进程的线程创建一个截图,通常配合ProcessFirst和ProcessNext一起使用 Declare Function CreateToolhelpSnapshot Lib "kernel32" Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long '取得最后一次的错误信息 Declare Function GetLastError Lib "kernel32" () As Long '为格式化字符串的API声明常数 Public Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100 Public Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 '为系统截图API声明常数 Public Const TH32CS_SNAPPROCESS As Long = 2& '为系统截图API声明类型 Type PROCESSENTRY32 dwSize As Long cntUsage As Long th32ProcessID As Long th32DefaultHeapID As Long th32ModuleID As Long cntThreads As Long th32ParentProcessID As Long pcPriClassBase As Long dwFlags As Long szexeFile As String * 260 End Type 接下来,我们再添加一个模板,用来存放搜索内存的函数等程序. '定义变量 Public myHandle As Long '初始化需作弊的进程 Function InitProcessCheater(pid As Long) '通过OpenProcess打开需要使用的进程 pHandle = OpenProcess(&H1F0FFF, False, pid) If (pHandle = 0) Then InitProcessCheater = False myHandle = 0 Else InitProcessCheater = True myHandle = pHandle End If End Function '开始第一次搜索 Function DoFirstSearch(s As String) As Integer Dim c As Integer Dim addr As Long Dim buffer As String * 5000 Dim readlen As Long '判断搜索结果文件是否存在,如果存在,则清空它,然后继续开始写入搜索结果 Open App.Path & "\cheatdata.dat" For Output As #1: Close #1 Open App.Path & "\cheatdata.dat" For Random As #1 Len = Len(addr) '搜索结果的计数器 c = 0 '做一个循环的缓冲 For addr = 0 To 40000 '通过ReadProcessMemory读取进程的内存数据 Call ReadProcessMemory(myHandle, addr * 5000, buffer, 5000, readlen) '如果搜索正确,则开始显示搜索进度 If addr Mod 400 = 0 Then '更新状态 frmMain.cmdStart.Enabled = False frmMain.cmdNext.Enabled = False frmMain.pbrPlan.value = Int(addr / 400) frmMain.lblResultNumber.Caption = "搜索结果:搜索中..." DoEvents End If '如果读取成功 If readlen > 0 Then startpos = 1 '将所有的搜索数据保存在缓冲中 While InStr(startpos, buffer,全讯在线直播, Trim(s)) > 0 '放置字符串 p = (addr) * 5000 + InStr(startpos, buffer, s) - 1 '将搜索的结果存放在搜索结果的文件中,以便下一次搜索时使用 Put #1, , CLng(p) '增加计数器 c = c + 1 If c < 20 Then frmMain.lstResults.AddItem p '找到下一个放置点 startpos = InStr(startpos, buffer, Trim(s)) + 1 Wend End If Next addr '更新状态 frmMain.cmdStart.Enabled = True frmMain.cmdNext.Enabled = True frmMain.lblResultNumber = "搜索结果:以找到" & c & "个地址" '关闭文件 Close #1 DoFirstSearch = c End Function '进行下一次搜索 Function DoNextSearch(s As String) Dim sc As Integer Dim addr As Long Dim buffer As String Dim readlen As Long buffer = Space(Len(s)) '打开第一次搜索后的搜索数据文件 Open App.Path & "\cheatdata.dat" For Random As #1 Len = Len(addr) '清空记录 frmMain.lstResults.Clear fp = 0 '清空计数器 sc = 0 '做一个循环,直到文件读取结束 While Not EOF(1) '增加文件指示器 fp = fp + 1 '读内存数据 Get #1, fp, addr '如果内存没有被禁止 If addr <> 0 Then buffer = Space(Len(s)) Call ReadProcessMemory(myHandle, addr, buffer, Len(s), readlen) If buffer <> s Then '禁止地址 Put #1, fp, CLng(0) Else '添加搜索结果 sc = sc + 1 If sc < 20 Then frmMain.lstResults.AddItem addr frmMain.lblResultNumber.Caption = "搜索结果:以找到" & cs & "个地址" End If End If Wend Close #1 DoNextSearch = sc End Function 窗体代码 好了,下面我们双击窗体,添加如下代码: '定义锁定的值 Private freezevalues(100) As Double '定义锁定数据 Private freezecount As Integer '定义进程ID Private PIDs(1000) As Long '刷新进程列表,并将进程放到ComboBox控件中 Private Sub RefreshProcessList() Dim myProcess As PROCESSENTRY32 Dim mySnapshot As Long '清空ComboBox控件 cmbProgram.Clear myProcess.dwSize = Len(myProcess) '创建新的截图 mySnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&) '得到第一个进程 ProcessFirst mySnapshot, myProcess '添加进程文件名 cmbProgram.AddItem myProcess.szexeFile '查看进程ID PIDs(cmbProgram.ListCount - 1) = myProcess.th32ProcessID '做一个循环将所有进程读取出来 While ProcessNext(mySnapshot, myProcess) '添加进程文件名 cmbProgram.AddItem myProcess.szexeFile '查看进程ID PIDs(cmbProgram.ListCount - 1) = myProcess.th32ProcessID Wend End Sub '转换数字为字符串后进行内存搜索 Private Function ConvertNumberToString(number As Double) As String If number < 256 Then ConvertNumberToString = Chr(number) Exit Function End If If number < 65536 Then ConvertNumberToString = Chr(number And 255) & Chr((number And 65280) / 256) Exit Function End If b4 = number And 255: number = Int(number / 256) b3 = number And 255: number = Int(number / 256) b2 = number And 255: number = Int(number / 256) b1 = number And 255: number = Int(number / 256) ConvertNumberToString = Chr(b4) & Chr(b3) & Chr(b2) & Chr(b1) End Function Private Sub cmdFreeze_Click() If lstCheat.ListIndex > -1 Then strValue = InputBox("请输入一个需要锁定的值", "简易游戏修改器") If strValue = "" Then MsgBox "请输入需要锁定的值", vbCritical, "简易游戏修改器" Exit Sub End If If Not IsNumeric(strValue) Then MsgBox "请输入数字的值", vbCritical, "简易游戏修改器" Exit Sub End If X = Split(lstCheat.List(lstCheat.ListIndex), "::") FreezeTimer(lstCheat.ListIndex).Tag = Trim(X(0)) freezevalues(lstCheat.ListIndex) = Val(strValue) FreezeTimer(lstCheat.ListIndex).Enabled = True End If End Sub Private Sub cmdNext_Click() '进行下一次搜索 Dim sc As Integer Dim strSearch As String If cmbSearch.ListCount = 0 Then MsgBox "请先进行第一次搜索", vbCritical, "简易游戏修改器" Exit Sub End If '检测输入的是否为数字 If Not IsNumeric(txtSearch.Text) Then MsgBox "请输入数字", vbCritical, "简易游戏修改器" Exit Sub End If '判断输入的数字是否超出界限 If Val(txtSearch.Text) > 4294967295# Then MsgBox "请输入一个小一点的数字", vbCritical, "简易游戏修改器" Exit Sub End If '将数字转换为字符串 strSearch = ConvertNumberToString(Val(txtSearch.Text)) '将搜索结果添加到列表中 cmbSearch.AddItem txtSearch.Text '进行下一次搜索 sc = DoNextSearch(strSearch) If sc = 1 Then MsgBox "搜索到了一个地址,进行修改吧^_^", vbInformation, "简易游戏修改器" Exit Sub End If If sc = 0 Then MsgBox "很遗憾,没有找到一个内存你需要的内存数据", vbCritical, "简易游戏修改器" End If If sc > 20 Then MsgBox "找到" & Str(sc) & "个搜索结果,请继续搜索", vbInformation, "简易游戏修改器" End If If sc > 0 And sc < 21 Then MsgBox "以搜索到20个以内的数据,请选择一个进行修改", vbInformation, "简易游戏修改器" End If End Sub Private Sub cmdPoke_Click() If lstCheat.ListIndex > -1 Then Dim addr As Long Dim value As String strValue = InputBox("请输入需要修改的值", "简易游戏修改器") If strValue = "" Then MsgBox "请输入需要修改的值", vbCritical, "简易游戏修改器" Exit Sub End If If Not IsNumeric(strValue) Then MsgBox "请输入数字的值", vbCritical, "简易游戏修改器" Exit Sub End If X = Split(lstCheat.List(lstCheat.ListIndex), "::") addr = CLng(Val(Trim(X(0)))) value = ConvertNumberToString(Val(strValue)) Call WriteProcessMemory(myHandle,足球导航, addr,皇冠现金网开户, value, Len(value), l) End If End Sub Private Sub cmdRefProgram_Click() '刷新进程列表 RefreshProcessList End Sub Private Sub cmdStart_Click() '第一次进行搜索 Dim sc As Integer Dim strSearch As String '清空搜索记录 cmbSearch.Clear '检测输入的是否为数字 If Not IsNumeric(txtSearch.Text) Then MsgBox "请输入数字", vbCritical, "简易游戏修改器" Exit Sub End If '判断输入的数字是否超出界限 If Val(txtSearch.Text) > 4294967295# Then MsgBox "你输入的数字过大,请输入小一些的数字", vbCritical, "简易游戏修改器" Exit Sub End If '将数字转换为字符串 strSearch = ConvertNumberToString(Val(txtSearch.Text)) '检测是否选择了进程 If cmbProgram.ListIndex = -1 Then MsgBox "请选择一个需要修改的进程", vbCritical, "简易游戏修改器" Exit Sub End If '初始化进程 If Not InitProcessCheater(PIDs(cmbProgram.ListIndex)) Then MsgBox "不能打开进程", vbCritical, "简易游戏修改器" Exit Sub End If '进行第一次搜索 sc = DoFirstSearch(strSearch) '将结果添加到列表中 cmbSearch.AddItem txtSearch.Text If sc = 0 Then MsgBox "很遗憾,没有找到一个内存你需要的内存数据", vbCritical, "简易游戏修改器" End If If sc > 20 Then MsgBox "找到" & Str(sc) & "个搜索结果,请继续搜索", vbInformation, "简易游戏修改器" End If If sc > 0 And sc < 21 Then MsgBox "以搜索到20个以内的数据,请选择一个进行修改", vbInformation, "简易游戏修改器" End If End Sub Private Sub cmdStop_Click() If lstCheat.ListIndex > -1 Then FreezeTimer(lstCheat.ListIndex).Enabled = False End If End Sub Private Sub Form_Load() '刷新进程列表 RefreshProcessList End Sub Private Sub FreezeTimer_Timer(Index As Integer) Dim addr As Long Dim value As String * 1 addr = CLng(Val(FreezeTimer(Index).Tag)) value = ConvertNumberToString(freezevalues(Index)) Call WriteProcessMemory(myHandle, addr, value, Len(value), l) End Sub Private Sub lstResults_DblClick() If lstResults.ListIndex > -1 Then If lstCheat.ListCount > 10 Then MsgBox "你已经添加了10个需要修改的地址了,不能进行添加了", vbCritical, "简易游戏修改器" Exit Sub End If strname = InputBox("请为需要修改的地址填写一个名称", "简易游戏修改器") If strname = "" Then strn... (责任编辑：admin) |