VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 6819|回复: 6

[转帖] vb写游戏外挂相关知识

[复制链接]
 楼主| 发表于 2008-12-1 19:03:27 | 显示全部楼层 |阅读模式
学习目的:
利用已知的地址,在VB中显示游戏中的相关数据。

内容:

1.建立一个新的标准EXE工程,我们就可以开始这次的学习了。

2.我们要建立一个模块,然后添加以下代码:

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.接下来Form中,我们要在程序启动时连接游戏窗口,以下是Form_Load的代码:
Dim hwd As Long ‘ 储存 FindWindow 函数返回的句柄
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
CloseHandle hProcess

4.我们在Form中添加一个Label控件和一个Timer控件,设置Timer的Interval属性为100,Timer1_Timer的代码如下:
Dim h As Long
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid)

If hProcess Then
    ReadProcessMemory hProcess, ByVal &H8C6A54, h, 4, 0& ‘这三条代码读取获得生命值
    ReadProcessMemory hProcess, ByVal h + &H24, h, 4, 0&
    ReadProcessMemory hProcess, ByVal h + &H254, h, 4, 0&

    CloseHandle hProcess
End If

Label1.Caption = h ‘输出生命值

5.好了,数据显示出来了。程序很简单,重点是大家要举一反三。

[ 本帖最后由 davyhe 于 2008-12-1 19:19 编辑 ]
 楼主| 发表于 2008-12-1 19:17:49 | 显示全部楼层

一段vb外挂源码,在网上找的,呵呵

Public Function Delayt(ByVal num As Long) '延时函数,不会假死,这个函数是论坛上的
Dim sTime As Long
sTime = 1
While sTime <= num
sTime = sTime + 1
DoEvents
Sleep 1
Wend
End Function

Private Sub Command1_Click()
Text9.Text = GetFolder(Me.hWnd, "请选择一个文件夹:")
End Sub
'-----------小图标处理函数-------------------
Private Sub Form_Resize()
If Me.WindowState = 1 Then
cSysTray1.InTray = True
Me.Visible = False
End If
End Sub
Private Sub cSysTray1_MouseUp(Button As Integer, Id As Long)
Me.WindowState = 0 '程序回复到Normal状态
Me.Visible = True '从任务栏中清除图标
cSysTray1.InTray = False '令程序界面可见

End Sub
'----------------根据进程获取程序路径
Function GetProcessPathByProcessID(PID As Long) As String
On Error GoTo Z
Dim cbNeeded As Long
Dim szBuf(1 To 250) As Long
Dim Ret As Long
Dim szPathName As String
Dim nSize As Long
Dim hProcess As Long
hProcess = OpenProcess(&H400 Or &H10, 0, PID)
If hProcess <> 0 Then
Ret = EnumProcessModules(hProcess, szBuf(1), 250, cbNeeded)
If Ret <> 0 Then
szPathName = Space(260)
nSize = 500
Ret = GetModuleFileNameExA(hProcess, szBuf(1), szPathName, nSize)
GetProcessPathByProcessID = Left(szPathName, Ret)
End If
End If
Ret = CloseHandle(hProcess)
If GetProcessPathByProcessID = "" Then
GetProcessPathByProcessID = "SYSTEM"
End If
Exit Function
Z:
End Function



'-----------------------这是一个打开游戏工作目录的函数---------------
Private Function GetFolder(ByVal hWnd As Long, Optional Title As String) As String
Dim bi As BROWSEINFO
Dim pidl As Long
Dim folder As String
folder = Space(255)
With bi
If IsNumeric(hWnd) Then .hOwner = hWnd
.pidlroot = 0
If Title <> "" Then
.lpszTitle = Title & Chr$(0)
Else
.lpszTitle = "选择目录" & Chr$(0)
End If
End With

pidl = SHBrowseForFolder(bi)
If SHGetPathFromIDlist(ByVal pidl, ByVal folder) Then
GetFolder = Left(folder, InStr(folder, Chr$(0)) - 1)
Else
GetFolder = ""
End If
End Function

'-----------------按键转换函数-----------------------------------
Private Function Key(Anjian As Long) As Long
Select Case Anjian
Case 0
Key = &H70
Case 1
Key = &H71 'F2
Case 2
Key = &H72 'F3
Case 3
Key = &H73 'F4
Case 4
Key = &H74
Case 5
Key = &H75
Case 6
Key = &H76
Case 7
Key = &H77
Case 8
Key = &H31 '1
Case 9
Key = &H32 '2
Case 10
Key = &H33 '3
Case 11
Key = &H34
Case 12
Key = &H35 '5
Case 13
Key = &H36
Case 14
Key = &H37
Case 15
Key = &H38
Case 16
Key = &H39 '9
Case 17
Key = &H30 '0
End Select
End Function
Private Sub Command4_Click()
'此处是作为运行游戏的语句的,但是目前还没有能够解决这个问题

End Sub

Private Sub Form_Load()
hwd = FindWindow("new3d_WCLASS", "Childhood 3d Client")
If hwd = 0 Then
Label17.Caption = " 游戏末运行,请先打开游戏"
End If
GetWindowThreadProcessId hwd, PID '获取进程标识符
'将进程标识符做为参数,返回目标进程PID的句柄,得到此句柄后
'即可对目标进行读写操,PROCESS_ALL_ACCESS表示完全控制,权限最大
If PID <> 0 Then
Text9.Text = GetProcessPathByProcessID(PID)
End If
b = 0
c = 0

test1 = 0
test2 = 0
End Sub


Private Sub Form_Unload(Cancel As Integer)
Timer1.Enabled = False
End Sub

Private Function MyHotKey(vKeyCode) As Boolean
MyHotKey = (GetAsyncKeyState(vKeyCode) < 0)
End Function
'-------------隐藏游戏-----------------------------
Private Sub hidegame_Click()
If hidegame.Caption = "隐藏游戏" Then
hidegame.Caption = "显示游戏"
ShowWindow hwd, SW_HIDE
c = 1
ElseIf hidegame.Caption = "显示游戏" Then
hidegame.Caption = "隐藏游戏"
ShowWindow hwd, SW_SHOW
c = 0
End If
End Sub
Private Sub Timer1_Timer() '信息
Dim name(15) As Byte '存储人物名称
Dim name_temp As String
Dim map_temp As String
Dim base2 As Long
Dim fight As Long
Dim moc As Long
Dim test(15) As Byte

Dim teststr As String
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, PID)
If hProcess Then
MoveWindow hwd, 0, 0, 800, 600, True
'===============这儿我在测试做一个txt文件测试用的,主要是记录工作信息================

ReadProcessMemory hProcess, ByVal &HAB4388 + &H8, test1, 4, 0&
If test1 <> test2 And test1 > 0 Then
ReadProcessMemory hProcess, ByVal &HAB4388 + &H8, test2, 4, 0&
ReadProcessMemory hProcess, ByVal test1 + &H30, test(0), 16, 0&
Text10.Text = "你打到了一只" & StrConv(test, vbUnicode)
List1.AddItem Text10.Text
End If
'Text10.Text = Text10.Text & "Text10.Text <br>"


'---------战斗刷新----------------------------------------
ReadProcessMemory hProcess, ByVal &HAB3738, fight, 4, 0&
ReadProcessMemory hProcess, ByVal &HAB3380, moc, 4, 0&
If fight > 0 Then
Label17.Caption = "经验:" & Exp & " 人物状态:战斗中"

'-----------检查宠物是否参加战斗--------------
If Check1(0).Value = 1 Then
SendMessage hwd, &H100, 32, 0&
SendMessage hwd, &H101, 32, 0&
Delayt 200
SendMessage hwd, &H100, 32, 0&
SendMessage hwd, &H101, 32, 0&
Else
SendMessage hwd, &H100, 32, 0&
SendMessage hwd, &H101, 32, 0&
End If
Else
Label17.Caption = "经验:" & Exp & " 人物状态:普通"
End If

'------------------------------------------------------
'********************信息刷新**************************
'----------这段代码写得很烦,这是因为他们的偏移量比较古怪-----
ReadProcessMemory hProcess, ByVal &HAB3534, base, 4, 0&
base = base + &HC4
ReadProcessMemory hProcess, ByVal base + &HC3, Exp, 4, 0&
ReadProcessMemory hProcess, ByVal &HAB3610, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &HDC, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H490, hp, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H48C, hpmax, 4, 0&
ReadProcessMemory hProcess, ByVal &HAB3610, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &HE0, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H490, mp, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H48C, mpmax, 4, 0&
ReadProcessMemory hProcess, ByVal &HAB3610, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &HEC, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H490, bbhp, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H48C, bbhpmax, 4, 0&
ReadProcessMemory hProcess, ByVal &HAB3610, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &HF0, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H490, bbmp, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H48C, bbmpmax, 4, 0&
'--------------魔血检查初始化---------------------
If b = 0 Then
Text1.Text = Str$(CInt(hpmax / 3 * 2))
Text3.Text = Str$(CInt(mpmax / 3 * 2))
Text5.Text = Str$(CInt(bbhpmax / 3 * 2))
Text6.Text = Str$(CInt(bbmpmax / 3 * 2))
Combo1(0).ListIndex = 17
Combo1(1).ListIndex = 16
Combo1(2).ListIndex = 17
Combo1(3).ListIndex = 16
b = 1
End If
'------------------上面这段是初始化赋值的-----------------
If Check1(1).Value = 1 Then
If hp < Val(Text1.Text) Then
SendMessage hwd, &H100, Key(Combo1(0).ListIndex), 0&
SendMessage hwd, &H101, Key(Combo1(0).ListIndex), 0&
ReadProcessMemory hProcess, ByVal &HAB3380, moc, 4, 0&
If moc = 27 Then
lp = 30
lp = lp * 65536 + 30
'SendMessage hwd, WM_MOUSEMOVE, 0, ByVal lp 需要后台移动的朋友,这句话就是
PostMessage hwd, WM_LBUTTONDOWN, MK_LBUTTON, lp '这是后台模拟点击的,这方面的资料偶找了好久啊..
PostMessage hwd, WM_LBUTTONUP, MK_LBUTTON, lp
Delayt Val(Text2.Text)
' Text9.Text = Text9.Text & "当前人物血量:" & hp & "/" & Text1.Text & " 加血"
End If
End If
If mp < Val(Text3.Text) Then
SendMessage hwd, &H100, Key(Combo1(1).ListIndex), 0&
SendMessage hwd, &H101, Key(Combo1(1).ListIndex), 0&
ReadProcessMemory hProcess, ByVal &HAB3380, moc, 4, 0&
If moc = 27 Then
lp = 30
lp = lp * 65536 + 30
'SendMessage hwd, WM_MOUSEMOVE, 0, ByVal lp
PostMessage hwd, WM_LBUTTONDOWN, MK_LBUTTON, lp
PostMessage hwd, WM_LBUTTONUP, MK_LBUTTON, lp
Delayt Val(Text4.Text)
'Text9.Text = Text9.Text & "当前人物魔法:" & mp & "/" & Text3.Text & " 加蓝"
End If
End If
If bbhp < Val(Text5.Text) Then
SendMessage hwd, &H100, Key(Combo1(2).ListIndex), 0&
SendMessage hwd, &H101, Key(Combo1(2).ListIndex), 0&
ReadProcessMemory hProcess, ByVal &HAB3380, moc, 4, 0&
If moc = 27 Then
lp = 94
lp = lp * 65536 + 13
'SendMessage hwd, WM_MOUSEMOVE, 0, ByVal lp
PostMessage hwd, WM_LBUTTONDOWN, MK_LBUTTON, lp
PostMessage hwd, WM_LBUTTONUP, MK_LBUTTON, lp
Delayt Val(Text7.Text)
'Text9.Text = Text9.Text & "当前宠物血量:" & bbhp & "/" & Text5.Text & " 加血"
End If
End If
If bbmp < Val(Text6.Text) Then
SendMessage hwd, &H100, Key(Combo1(3).ListIndex), 0&
SendMessage hwd, &H101, Key(Combo1(3).ListIndex), 0&
ReadProcessMemory hProcess, ByVal &HAB3380, moc, 4, 0&
If moc = 27 Then
lp = 94
lp = lp * 65536 + 13
'SendMessage hwd, WM_MOUSEMOVE, 0, ByVal lp
PostMessage hwd, WM_LBUTTONDOWN, MK_LBUTTON, lp
PostMessage hwd, WM_LBUTTONUP, MK_LBUTTON, lp
Delayt Val(Text8.Text)
'Text9.Text = Text9.Text & "当前宠物魔法:" & bbmp & "/" & Text6.Text & " 加蓝"
End If
End If
End If
base = &HAB2E34
ReadProcessMemory hProcess, ByVal base, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H18, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H174, mx, 4, 0&
ReadProcessMemory hProcess, ByVal base + &H178, my, 4, 0&
ReadProcessMemory hProcess, ByVal &HAB2E34, base, 4, 0&
ReadProcessMemory hProcess, ByVal base + &HD8, map(0), 15, 0&
map_temp = StrConv(map, vbUnicode)
'WriteProcessMemory hProcess, ByVal &H3162A80, mpmax, 4, 0&
End If
CloseHandle hProcess
'----------------这是热键隐藏游戏--------------------
If MyHotKey(vbKeyK) And vbKeyControl Then 'ctrl+A
If c = 1 Then
ShowWindow hwd, SW_SHOW
hidegame.Caption = "隐藏游戏"
c = 0
ElseIf c = 0 Then
ShowWindow hwd, SW_HIDE
hidegame.Caption = "显示游戏"
c = 1
End If
End If
Label9.Caption = "地图:" & map_temp
Label20.Caption = "坐标:" & mx & "," & my
Label2(0).Caption = "生命值:" & hp & "/" & hpmax
Label3.Caption = "魔法值:" & mp & "/" & mpmax
Label12.Caption = "宠物生命:" & bbhp & "/" & bbhpmax
Label13.Caption = "宠物魔法:" & bbmp & "/" & bbmpmax
End Sub
回复 支持 反对

使用道具 举报

发表于 2008-12-2 11:49:27 | 显示全部楼层
广海论坛有很多用VB编外挂的同仁。。。
回复 支持 反对

使用道具 举报

发表于 2008-12-2 13:39:42 | 显示全部楼层

hehe

回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-12-2 18:45:41 | 显示全部楼层
原帖由 261001126 于 2008-12-2 11:49 发表
广海论坛有很多用VB编外挂的同仁。。。

去看了下,呵呵,不错的网站。谢谢啦
回复 支持 反对

使用道具 举报

发表于 2008-12-3 18:49:01 | 显示全部楼层
写这些其实不难,难的是追踪地址.
回复 支持 反对

使用道具 举报

发表于 2010-6-16 15:43:42 | 显示全部楼层
楼主加我QQ 517491536  VB热爱者 但是小白一个 刚入门 希望能得到一丝指引走出迷茫
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2022-7-4 05:46

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表