2.我们要做一个小程序，用于显示地面上的所有物品。添加一个List控件、一个Time控件，如下图所示。
3.下面添加代码！
3.1.模块：
Option Explicit
'---------------声明函数-----------------------
'得到窗体句柄的函数,FindWindow函数用来返回符合指定的类名( ClassName )和窗口名( WindowTitle )的窗口句柄
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'得到窗体控件句柄的函数
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
'得到进程标识符的函数
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
'得到目标进程句柄的函数
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
'关闭句柄的函数
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'读取进程内存的函数
Public Declare Function ReadProcessMemory Lib "kernel32.dll" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long
'参数决定了对进程的存储权限，使用完全控制
Public Const PROCESS_ALL_ACCESS = &H1F0FFF
3.2.Form_Load:
Option Explicit
Dim hwd As Long
Dim pid As Long
Dim hProcess As Long '存放进程句柄
Private Sub Form_Load()
hwd = FindWindow("QElementClient Window", "Element Client")
If hwd = 0 Then
MsgBox "未启动游戏", vbOKOnly, "提示"
Unload Form1
End If
GetWindowThreadProcessId hwd, pid '获取进程标识符
'将进程标识符做为参数，返回目标进程PID的句柄，得到此句柄后
'即可对目标进行读写操,PROCESS_ALL_ACCESS表示完全控制,权限最大
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, pid)
If hProcess = 0 Then
MsgBox "不能打开进程", vbOKOnly, "提示"
Unload Form1
End If
End Sub[/code]
3.3.Timer_Timer:
'Timer.interval=1000，利用1秒的延迟显示列表
Private Sub Timer1_Timer() '显示地面物品名称列表
Dim base As Long '存储地址
Dim mecxi As Long '存储地址
Dim pn As Integer '循环变量
Dim WpName(65) As Byte '存储物品名称
List1.Clear '用于刷新物品列表
If hProcess Then
ReadProcessMemory hProcess, ByVal &H8C9E54, mecxi, 4, 0
ReadProcessMemory hProcess, ByVal mecxi + &H8, mecxi, 4, 0
ReadProcessMemory hProcess, ByVal mecxi + &H24, mecxi, 4, 0 '得到物品数量
If mecxi <> 0 Then
For pn = 0 To 768 '循环用来判断那个值内存在物品
ReadProcessMemory hProcess, ByVal mecxi + &H18, base, 4, 0
ReadProcessMemory hProcess, ByVal base + pn * 4, base, 4, 0 '从列表中选出地面上物品的地址
If base > 0 Then '判断是否存在物品
ReadProcessMemory hProcess, ByVal base + 4, base, 4, 0
ReadProcessMemory hProcess, ByVal base + &H164, base, 4, 0
ReadProcessMemory hProcess, ByVal base, WpName(0), 64, 0 '得到物品名称
List1.AddItem WpName '添加到List控件
End If
Next pn
End If
End If
End Sub
3.4.Form_Unload：
Private Sub Form_Unload(Cancel As Integer)
CloseHandle hProcess
End Sub
OK了~收工！
接下来我们就能让可恶的配方从此在背包中消失
2.首先看看图片，我要用到那些控件
主要控件：
List1 /用于显示地面物品
List2 /用于显示需要过滤的物品名称
Timer1 /用于刷新地面物品
Timer2 /用于过滤地面物品
Combo1 /用于添加或保存过滤物品名称
Command1 /添加按钮
Command2 /删除按钮
模块添加：
'存储进程内存的函数
Public Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
3.我们来看看过滤物品的核心代码，以下为Timer2_Timer代码：
Private Sub Timer2_Timer()
Dim base As Long '存储地址
Dim mecxi As Long '存储地址
Dim WpNameT As Long '存储地址
Dim pn As Integer '循环变量
Dim WpName(65) As Byte '存储物品名称
Dim x As Integer
If hProcess Then
ReadProcessMemory hProcess, ByVal &H8C9E54, mecxi, 4, 0
ReadProcessMemory hProcess, ByVal mecxi + &H8, mecxi, 4, 0
ReadProcessMemory hProcess, ByVal mecxi + &H24, mecxi, 4, 0 '得到物品数量
If mecxi <> 0 Then
For pn = 0 To 768 '循环用来判断那个值内存在物品
ReadProcessMemory hProcess, ByVal mecxi + &H18, base, 4, 0
ReadProcessMemory hProcess, ByVal base + pn * 4, base, 4, 0 '从列表中选出地面上物品的地址
If base > 0 Then '判断是否存在物品
ReadProcessMemory hProcess, ByVal base + 4, base, 4, 0
ReadProcessMemory hProcess, ByVal base + &H164, WpNameT, 4, 0
ReadProcessMemory hProcess, ByVal WpNameT, WpName(0), 64, 0 '得到物品名称
For x = 0 To List2.ListCount - 1 '用循环查找是否是过滤表内要过滤的物品
If InStr(WpName, List2.List(x)) > 0 Then '用InSet()进行对比，存在过滤表内容则过滤
WriteProcessMemory hProcess, ByVal base + &H110, 0, 4, 0 '变ID为0，有捡物品动作但背包内无此物品
Label1.Caption = "已过滤：" & CStr(WpName) '过滤提示，观察用
End If
Next x
End If
Next pn
End If
End If
End Sub
3.1.地面上的物品得用一个0 to 768循环来判断哪个值内存在物品，比如说地面上有四个物品，则0 to 768里面就会有4个值是存在着物品，也就说游戏最多能显示769件地面物品。
3.2.首先判断地面上是否存在物品，如果存在则循环769次查找物品，当找到0 to 768中的一个物品时，程序得到物品的名称，接下来用一个循环来对比物品名称与过滤表做对比，如果为要过滤的物品则改变当前物品在内存的ID，游戏程序再执行捡取动作就会实现过滤功能，物品检起来了，但是并不在背包内，也没有捡到物品的提示。
4.最后就是过滤表的制作了，这个很简单，只要有添加项目和删除项目的功能就可以。这里我用到Combo控件作为输入框，因为可以记录一些可能会用到的物品名称。
Private Sub Command1_Click() '添加物品名称
If Combo1.Text <> "" Then List2.AddItem Combo1.Text
End Sub
Private Sub Command2_Click() '删除物品名称
If List2.ListIndex <> -1 Then List2.RemoveItem (List2.ListIndex) '当选中某项则删除某项
End Sub
上一页 [1] [2] [3] [4] [5] 下一页
[组图]零基础制作《武林外传》外挂 (VB)
您现在的位置：