?? 做個外掛能用到的東西.txt

?? VB做外掛
?? TXT
字號:
                                   做外掛能用到的東西 

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
?? 文件大小 4 K
?? 上傳用戶 angela5683
?? 所屬分類其他書籍
?? 快捷鍵說明

復制代碼 Ctrl + C
搜索代碼 Ctrl + F
全屏模式 F11
切換主題 Ctrl + Shift + D
顯示快捷鍵 ?
增大字號 Ctrl + =
減小字號 Ctrl + -
亚洲欧美第一页_禁久久精品乱码_粉嫩av一区二区三区免费野_久草精品视频

?? 做個外掛能用到的東西.txt

?? 快捷鍵說明
