做个外挂能用到的东西.txt

VB做外挂

                                   做外挂能用到的东西 

1、VB的小图标处理
2、后台鼠标的模拟移动和点击
3、从进程获得文件执行路径
4、打开文件夹的操作
5、比sleep好用的延时函数

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
"


'---------战斗刷新----------------------------------------
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