首页
社区
课程
招聘
[旧帖] VB 热血江湖V外挂 全部 源码 0.00雪花
发表于: 2007-8-7 13:59 14910

[旧帖] VB 热血江湖V外挂 全部 源码 0.00雪花

2007-8-7 13:59
14910
悠哉游戏中国社区 Uzuc.cn
新开的权威外挂制作中心
地址:  http://bbs.uzuc.cn   点击进入查看更多内容



1.
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
'让程序拥有热键
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'窗体最前面
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
'RGB颜色获取
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
'模拟鼠标事件
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Const MOUSEEVENTF_LEFTDOWN = &H2
Const MOUSEEVENTF_LEFTUP = &H4
Const MOUSEEVENTF_MIDDLEDOWN = &H20
Const MOUSEEVENTF_MIDDLEUP = &H40
Const MOUSEEVENTF_MOVE = &H1 '移动鼠标
Const MOUSEEVENTF_ABSOLUTE = &H8000
Const MOUSEEVENTF_RIGHTDOWN = &H8
Const MOUSEEVENTF_RIGHTUP = &H10
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Const VK_F1 As Long = &H70
Const VK_F2 As Long = &H71
Const VK_F3 As Long = &H72
Const VK_F4 As Long = &H73
Const VK_F5 As Long = &H74
Const VK_F6 As Long = &H75
Const VK_F7 As Long = &H76
Const VK_F8 As Long = &H77
Const VK_F9 As Long = &H78
Const KEYEVENTF_KEYUP As Long = &H2
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Const GameTitle As String = "YB_OnlineClient"
'Const GameTitle As String = "新建 文本文档 - 记事本"
Dim SWD As String '喊话内容
Dim IsGuaJi As Boolean ' 挂机标志
Dim IsFuZhu As Boolean ' 补红蓝的辅助动作标志
Dim HongBiLv As Integer ' 补红比率
Dim LanBiLv As Integer ' 补蓝比率
Dim HongPoint(6) As Long ' 补红点的数组对应列表数值
Dim LanPoint(6) As Long ' 补蓝点的数组对应列表数值
Dim FPoint(1 To 9) As Long ' F1 F2...F9的数组对应列表数值

Dim i As Integer, j As Long, k As Long

'让程序拥有热键
Function HotKey(vKeyCode) As Boolean
HotKey = GetAsyncKeyState(vKeyCode) < 0
End Function
Sub AnJian(KStr As String)
DoEvents
Select Case KStr
Case "F1"
Call keybd_event(VK_F1, 0, 0, 0)
Delay 300
Call keybd_event(VK_F1, 0, KEYEVENTF_KEYUP, 0)
Case "F2"
Call keybd_event(VK_F2, 0, 0, 0)
Delay 300
Call keybd_event(VK_F2, 0, KEYEVENTF_KEYUP, 0)
Case "F3"
Call keybd_event(VK_F3, 0, 0, 0)
Delay 300
Call keybd_event(VK_F3, 0, KEYEVENTF_KEYUP, 0)
Case "F4"
Call keybd_event(VK_F4, 0, 0, 0)
Delay 300
Call keybd_event(VK_F4, 0, KEYEVENTF_KEYUP, 0)
Case "F5"
Call keybd_event(VK_F5, 0, 0, 0)
'Sleep 100
'Call keybd_event(vbKeyF5, 0, KEYEVENTF_KEYUP, 0)
SendKeys "补红"
SendKeys "{ENTER}"
Sleep 100
SendKeys "...."
SendKeys "{ENTER}"
Sleep 100

Case "F6"
Call keybd_event(VK_F6, 0, 0, 0)
Delay 300
Call keybd_event(VK_F6, 0, KEYEVENTF_KEYUP, 0)
Case "F7"
Call keybd_event(VK_F7, 0, 0, 0)
Delay 300
Call keybd_event(VK_F7, 0, KEYEVENTF_KEYUP, 0)
Case "F8"
Call keybd_event(VK_F8, 0, 0, 0)
Delay 300
Call keybd_event(VK_F8, 0, KEYEVENTF_KEYUP, 0)
Case "F9"
Call keybd_event(VK_F9, 0, 0, 0)
Delay 300
Call keybd_event(VK_F9, 0, KEYEVENTF_KEYUP, 0)
End Select
Delay 100
End Sub

[注意]传递专业知识、拓宽行业人脉——看雪讲师团队等你加入!

收藏
免费 0
支持
分享
最新回复 (7)
雪    币: 78
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
2
查找屏幕颜色,找到为TRUE
Function FindColor(ColorStr As String) As String ' As Boolean
'man==402 353
FindColor = "" ' = False
For j = 402 To 402
DoEvents
For k = 250 To 450
DoEvents
If GetYanSe(j, k) = UCase(ColorStr) Then
   FindColor = j & "++" & k ' True
   Exit For
End If
Next
Next
MsgBox "pppp"
End Function
'
Sub Delay(YanShi As Long)
Sleep YanShi
End Sub 

'判断游戏是否正在运行
Function IsRun() As Boolean
IsRun = False
Dim hwnd As Long ' 储存 FindWindow 函数返回的句柄
hwnd = FindWindow(vbNullString, GameTitle)
If hwnd = 0 Then
   IsRun = False
Else
   IsRun = True
End If
End Function
Private Sub Command1_Click()
Delay 3000
MsgBox "kljk"
End Sub
Private Sub Command2_Click()
If IsRun = False Then
MsgBox "游戏没有运行!", 16
Exit Sub
End If
If CheckFuZhu.value = 1 Then
  IsFuZhu = True
Else
  IsFuZhu = False
End If
If CheckGuaJi.value = 1 Then
  IsGuaJi = True
Else
  IsGuaJi = False
End If
Me.WindowState = 1
AppActivate GameTitle
End Sub
Private Sub Command3_Click()
If IsRun = False Then
MsgBox "游戏没有运行,让我怎么喊?", 16
Exit Sub
End If
If CheckHanHua.value = 1 Then
Me.WindowState = 1
AppActivate GameTitle
SWD = Text1.Text
TimerHanHua.Interval = Val(ComboHanHua.Text) * 1000
TimerHanHua.Enabled = True
Else
TimerHanHua.Enabled = False
End If
End Sub
Private Sub Command4_Click()
Dim qq As Long
Open App.Path & "\data.ini" For Output As #1
For qq = 0 To 150 Step 1
Print #1, qq & "*6==" & GetYanSe(qq, 6)
Next
Close #1
MsgBox "OK"
End Sub
Private Sub Command5_Click()
HongBiLv = ComboHongBi.ListIndex
MsgBox HongBiLv
End Sub
Private Sub Form_Load()
'屏幕分辨率
tw% = Screen.Width / Screen.TwipsPerPixelX
th% = Screen.Height / Screen.TwipsPerPixelY
If tw% <> 800 Then
MsgBox "当前屏幕分辨率是:" & tw% & "×" & th% & vbCrLf & "" & "本外挂只支持800×600分辨率!", 16
'End
End If
'开始
TimerHanHua.Enabled = False
For i = 1 To 9
ComboHong.AddItem "F" & i
ComboLan.AddItem "F" & i
ComboBackCity.AddItem "F" & i
ComboJiNeng.AddItem "F" & i
ComboPingKan.AddItem "F" & i
ComboJianWu.AddItem "F" & i
ComboChiTang.AddItem "F" & i
ComboHanHua.AddItem i
Next
For i = 20 To 80 Step 10
ComboHongBi.AddItem i & "%"
ComboLanBi.AddItem i & "%"
Next
ComboHongBi.Text = "50%"
ComboLanBi.Text = "50%"
ComboHong.Text = "F5"
ComboLan.Text = "F2"
ComboBackCity.Text = "F8"
ComboJiNeng.Text = "F3"
ComboPingKan.Text = "F6"
ComboJianWu.Text = "F7"
ComboChiTang.Text = "F4"
ComboHanHua.Text = "4"
'有红80%=133 70=119  60==105 91 77 63 49 ===0020FF
'红yyy===6
'有lan 80%=133 70=119  60==105 91 73 59 43 ===FF8273
'lan yyy===19
HongPoint(0) = 49
HongPoint(1) = 63
HongPoint(2) = 77
HongPoint(3) = 91
HongPoint(4) = 105
HongPoint(5) = 119
HongPoint(6) = 133
LanPoint(0) = 43
LanPoint(1) = 59
LanPoint(2) = 73
LanPoint(3) = 91
LanPoint(4) = 105
LanPoint(5) = 119
LanPoint(6) = 133
'F1  F2 ...F9
'xxx=439  476  512  550 586 624 661 698  735 yyy===578
For i = 1 To 9
FPoint(i) = 439 + i * 37
Next
  IsFuZhu = False
  IsGuaJi = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
End
End Sub
'时刻监测程序热键F12
Private Sub Timer1_Timer()
DoEvents
'F12调出窗口
If HotKey(vbKeyF12) = True Then
   SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, 3
   Me.WindowState = vbNormal
End If
'Control+1 开始挂机
If HotKey(vbKeyControl) = True And HotKey(vbKey1) = True Then
   IsGuaJi = True
End If
'Control+2 停止挂机
If HotKey(vbKeyControl) = True And HotKey(vbKey2) = True Then
   IsGuaJi = False
End If
End Sub
Function GetYanSe(zX As Long, zY As Long) As String
    Dim tPOS As POINTAPI
    Dim sTmp As String
    Dim lColor As Long
    Dim lDC As Long
    lDC = GetWindowDC(0)
    'Call GetCursorPos(tPOS)
    'lColor = GetPixel(lDC, tPOS.x, tPOS.y)
    lColor = GetPixel(lDC, zX, zY)
   
sTmp = Right$("000000" & Hex(lColor), 6)
GetYanSe = UCase(sTmp)
'Caption = "R:" & Right$(sTmp, 2) & " G:" & Mid$(sTmp, 3, 2) & " B:" & Left$(sTmp, 2)
End Function

Private Sub Timer2_Timer()
'Dim tPOS As POINTAPI
'Call GetCursorPos(tPOS)
'Me.Caption = tPOS.x & "**" & tPOS.y & "**" & GetYanSe(tPOS.x, tPOS.y)
End Sub
'辅助动作
Private Sub TimerFuZhu_Timer()
If IsFuZhu = False Then Exit Sub
'有红80%=133 70=119  60==105 91 77 63 49 ===0020FF
'红yyy===6
'有lan 80%=133 70=119  60==105 91 73 59 43 ===FF8273
'lan yyy===19
'补红
HongBiLv = ComboHongBi.ListIndex
If GetYanSe(HongPoint(HongBiLv), 6) <> "0020FF" Then
   Call AnJian(ComboHong.Text)
  
End If
'补蓝
LanBiLv = ComboLanBi.ListIndex
If GetYanSe(LanPoint(LanBiLv), 19) <> "FF8273" Then
   AnJian ComboLan.Text
End If
'无红回城
If CheckNoHongBack.value = 1 Then
If GetYanSe(FPoint(Right(ComboHong.Text, 1)), 578) = "B5FFE7" Then
   AnJian ComboBackCity.Text
End If
End If
'无蓝回城
If CheckNoLanBack.value = 1 Then
If GetYanSe(FPoint(Right(ComboLan.Text, 1)), 578) = "B5FFE7" Then
   AnJian ComboBackCity.Text
End If
End If
End Sub
'自动挂机
Private Sub TimerGuaJi_Timer()
If IsGuaJi = False Then Exit Sub
'吃糖五色
If CheckChiTang.value = 1 Then
   AnJian ComboChiTang.Text
   Delay 100
End If
'捡东西
If CheckJianWu.value = 1 Then
   AnJian ComboJianWu.Text
   Delay 100
End If
'*******************************
mouse_event MOUSEEVENTF_MOVE, -600, 0, 0, 0
'Dim tPOS As POINTAPI
'Call GetCursorPos(tPOS)
'SetCursorPos tPOS.x - 600, tPOS.y
Delay 350
SetCursorPos 402, 353
Delay 350
'鼠标左键按下和松开两个事件的组合即一次单击
mouse_event MOUSEEVENTF_LEFTDOWN Or MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

End Sub
Private Sub TimerHanHua_Timer()
If Right(SWD, 3) = "!!!" Then
   SWD = Text1.Text
Else
   SWD = Text1.Text & "!!!"
End If
SendKeys SWD
SendKeys "{ENTER}"
End Sub
2007-8-7 23:12
0
雪    币: 200
活跃值: (10)
能力值: ( LV2,RANK:10 )
在线值:
发帖
回帖
粉丝
3
VB的挂应该都被封杀 了...
感谢分享代码。
2007-8-8 11:42
0
雪    币: 0
能力值: (RANK:10 )
在线值:
发帖
回帖
粉丝
4
谢谢啊....
2007-8-8 12:11
0
雪    币: 0
能力值: (RANK:10 )
在线值:
发帖
回帖
粉丝
5
                  
2007-8-8 14:11
0
雪    币: 0
能力值: (RANK:10 )
在线值:
发帖
回帖
粉丝
6
顶起来哦...   支持
2007-8-11 21:59
0
雪    币: 0
能力值: (RANK:10 )
在线值:
发帖
回帖
粉丝
7
顶   支持
2007-8-12 13:27
0
雪    币: 0
能力值: (RANK:10 )
在线值:
发帖
回帖
粉丝
8
人工置顶....................
2007-8-12 18:15
0
游客
登录 | 注册 方可回帖
返回
//