做外挂能用到的东西
1、VB的小图标处理
2、后台鼠标的模拟移动和点击
3、从进程获得文件执行路径
4、打开文件夹的操作
5、比sleep好用的延时函数
Public Function Delayt(ByVal num As Long) '延时函数，不会假死，这个函数是论坛上的
Dim sTime As Long
sTime = 1
While sTime 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
"
'---------战斗刷新----------------------------------------
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
