2009年11月08日
神泣外挂 浑然一体终结版 VB源代码 BY 远志事情室
从上年至此刻好久没有玩神泣了，前日一看进级了N次了，看着那华美的界面，真想出山，谁知此刻是外挂泛滥，GM就懂患上挣钱缺少办理，抢怪真是不易，想的起来其时玩的时辰也没有那末多人、那末多挂、那末多乐瑟，此刻怎么成如许了呢？本想玩玩就拉到，谁懂患上那乐瑟抢怪的真多，索性我也编个挂——抢怪！
颠末3天的体例与调试，此刻大功告成，可以说浑然一体啊！功效有自己主动抢怪、自己主动挂机、自己主动生意、自己主动拉怪、自己主动加血、自己主动穿图、自己主动探路、自己主动存储、自己主动加快等等，本想自娱自乐，但是瞅见有人卖挂骗钱盗号等恶败举动，也履历过鼠标键盘的手动式操作，颇感操作累人，此刻都不知怎么玩了，预计是好久没有玩的缘故吧，此刻特把VB源代码呈献给各人，各人路程经过过程VB6编译后就能够施用了，有问题的接洽我！
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 ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByVal lpBuffer As Long, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
''窗体最前边
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
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 Function BitBlt Lib "Gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function MapVirtualKey Lib "user32" Alias "MapVirtualKeyA" (ByVal wCode As Long, ByVal wMapType As Long) As Long
Private Const VK_F1 As Long = &H70
Private Const VK_F2 As Long = &H71
Private Const VK_F3 As Long = &H72
Private Const VK_F4 As Long = &H73
Private Const VK_F5 As Long = &H74
Private Const VK_F6 As Long = &H75
Private Const VK_F7 As Long = &H76
Private Const VK_F8 As Long = &H77
Private Const VK_F9 As Long = &H78
Private Const VK_F10 As Long = &H79
Private Const VK_F11 As Long = &H7A
Private Const VK_F12 As Long = &H7B
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Const KEYEVENTF_KEYUP = &H2
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
''读取内存地址，归回值是逢十进位
Function ReadDiZhello(theDiZhello As Long) As Long
Dim hWnd As Long '' 存储 FindWindow 函数归回的句柄
Dim pid As Long '' 存储进程项标识符( Process Id )
Dim pHandle As Long '' 存储进程项句柄
hWnd = FindWindow(vbNullString, GameTitle)
'' 取患上进程项标识符
GetWindowThreadProcessId hWnd, pid
'' 施用进程项标识符取患上进程项句柄
pHandle = OpenProcess(PROCESS_ALL_ACCESS, 0, pid)
ReadProcessMemory pHandle, theDiZhello, ByVal VarPtr(ReadDiZhello), 4, 0&
CloseHandle pHandle
End Function
''判断游戏是不是正在运行
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 CheckDiZhello_Click()
If CheckDiZhello.Value = 1 Then
Text2.Enabled = False
Else
Text2.Enabled = True
End If
End Sub
Private Sub CheckGuaJi_Click()
If CheckGuaJi.Value = 1 Then
CheckHong.Value = 1
CheckLan.Value = 1
End If
End Sub
Private Sub CheckQunDao_Click()
If CheckQunDao.Value = 1 Then CheckSiDa.Value = 0
End Sub
Private Sub ComboHongBi_Click()
ComboHongBi.ToolTipText = HPMax * Int(Left(ComboHongBi.Text, 2)) / 100
End Sub
Private Sub Command1_Click()
MsgBox _
"本外挂为绿色彩不收费软体，可肆意流传，接待交流！" & vbCrLf & vbCrLf & _
"步伐热键：" & vbCrLf & vbCrLf & _
" F11 呼叫出本步伐 F12 竣事本步伐" & vbCrLf & vbCrLf & _
" Home 起头自己主动喊话 End 遏制自己主动喊话" & vbCrLf & vbCrLf & _
"PageUp 起头打手挂机 PageDown 遏制打手挂机" & vbCrLf & vbCrLf & _
""
End Sub
Private Sub Command2_Click()
If IsRun = False Then
MsgBox "游戏没有运行！", 16
Exit Sub
End If
''挂机时开启匡助动作
If CheckGuaJi.Value = 1 Then
Me.Visible = False
AppActivate GameTitle
TimerFuZhu.Enabled = True
TimerGuaJi.Enabled = True
Else
TimerGuaJi.Enabled = False
End If
End Sub
Private Sub Command3_Click()
If IsRun = False Then
MsgBox "游戏没有运行", 16
Exit Sub
End If
If CheckHanHua.Value = 1 Then
Me.Visible = False
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()
FormAbout.Show 1
End Sub
Private Sub Command6_Click()
If CheckDiZhello.Value = 0 Then
Exit Sub
End If
If Text2.Text = "" Or Len(Text2.Text) <> 10 Or _
UCase(Left(Text2.Text, 2)) <> "&H" Then
Exit Sub
End If
If IsRun = False Then
MsgBox "游戏没有运行！", 16
Exit Sub
End If
Me.WindowState = vbMinimized
Me.Visible = False
AppActivate GameTitle
TimerFuZhu.Enabled = True
End Sub
Private Sub Form_Load()
On Error Resume Next
SetKeyboardHook Me.hWnd, WM_USER
If Err.Number <> 0 Then
End
End If
On Error GoTo 0
prevWndProc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf WndProc
''*********************************************
If App.PrevInstance = True Then
MsgBox "本步伐已运行！", 48
End
End If
''起头
TimerHanHua.Enabled = False
TimerFuZhu.Enabled = False
TimerGuaJi.Enabled = False
For i = 1 To 9
ComboHong.AddItem "F" & i
ComboLan.AddItem "F" & i
ComboBackCity.AddItem "F" & i
ComboJiNeng.AddItem "F" & i
ComboQunYiJiNeng.AddItem "F" & i
ComboPingKan.AddItem "F" & i
ComboJianWu.AddItem "F" & i
ComboChelloTang.AddItem "F" & i
ComboHanHua.AddItem i
Next
For i = 10 To 80 Step 5
ComboHongBi.AddItem i & ""
ComboLanBi.AddItem i & ""
Next
''有红80=133 70=119 60==105 91 77 63 49 ===001CFF
''红yyy===5
''有lan 80=133 70=119 60==105 91 73 59 43 ===FF867B
''lan yyy===18
HongPoint(0) = 49
HongPoint⑴ = 63
HongPoint⑵ = 77
HongPoint⑶ = 91
HongPoint⑷ = 105
HongPoint⑸ = 119
HongPoint⑹ = 133
LanPoint(0) = 43
LanPoint⑴ = 59
LanPoint⑵ = 73
LanPoint⑶ = 91
LanPoint⑷ = 105
LanPoint⑸ = 119
LanPoint⑹ = 133
''F1 F2 ...F9
''xxx=439 476 512 550 586 624 661 698 735 yyy===578
FPoint⑴ = 439
FPoint⑵ = 476
FPoint⑶ = 512
FPoint⑷ = 550
FPoint⑸ = 586
FPoint⑹ = 624
FPoint⑺ = 661
FPoint⑻ = 698
FPoint⑼ = 735
''功效键内存地址
FState⑴ = &H14F2EAE
FState⑵ = &H14F2EB6
FState⑶ = &H14F2EBE
FState⑷ = &H14F2EC6
FState⑸ = &H14F2ECE
FState⑹ = &H14F2ED6
FState⑺ = &H14F2EDE
FState⑻ = &H14F2EE6
FState⑼ = &H14F2EEE
''****************************
On Error GoTo Wrg
Call GetData
Exit Sub
''****************************
Wrg:
ComboHongBi.Text = "70"
ComboLanBi.Text = "20
ComboHong.Text = "5"
ComboLan.Text = "2"
ComboHanHua.Text = "4"
CheckNoHongBack.Value = 1
End Sub
Private Sub Form_MouseMove(Button As Integer, Shelloft As Integer, X As Single, Y As Single)
Label1.ForeColor = vbBlue
Label1.FontUnderline = False
Label3.ForeColor = vbBlue
Label3.FontUnderline = False
Label4.ForeColor = vbBlue
Label4.FontUnderline = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim HD As Integer
''6是7否
''HD = MsgBox("确信退出吗？", vbYesNo vbDefaultButton2 vbQuestion)
''If HD = 6 Then
Call GameOver
''Else
''Cancel = -1
''End If
End Sub
''竣事本步伐
Sub GameOver()
Call SaveData ''生存数值
ReleaseKeyboardHook
SetWindowLong Me.hWnd, GWL_WNDPROC, prevWndProc
End
End Sub
Private Sub Label1_MouseMove(Button As Integer, Shelloft As Integer, X As Single, Y As Single)
Label1.ForeColor = vbRed
Label1.FontUnderline = True
End Sub
Private Sub Label3_Click()
pp = Shell("explorer.exe mailto:myz999@yahoo.com.cn")
End Sub
Private Sub Label3_MouseMove(Button As Integer, Shelloft As Integer, X As Single, Y As Single)
Label3.ForeColor = vbRed
Label3.FontUnderline = True
End Sub
Private Sub Label4_Click()
pp = Shell("explorer.exe http://blog.sina.com.cn/myz999")
End Sub
Private Sub Label4_MouseMove(Button As Integer, Shelloft As Integer, X As Single, Y As Single)
Label4.ForeColor = vbRed
Label4.FontUnderline = True
End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
KeyAscii = ValText(KeyAscii, "&H0123456789ABCDEF")
End Sub
Function ValText(KeyIn As Integer, vStr As String)
Dim KeyOut As Integer
vStr = UCase(vStr) & Chr⑻ ''加之BackSpace
If InStr(1, vStr, UCase(Chr(KeyIn)), 1) > 0 Then
KeyOut = KeyIn
Else
KeyOut = 0
Beep
End If
ValText = KeyOut
End Function
''匡助动作
Private Sub TimerFuZhu_Timer()
If IsRun = False Then Exit Sub
''补红补蓝
Call BuHongLan
End Sub
''自己主动挂机
Private Sub TimerGuaJi_Timer()
If IsRun = False Then Exit Sub
If CheckGuaJi.Value = 0 Then Exit Sub
''捡工具
If CheckJianWu.Value = 1 Then
PressF1_F9 ComboJianWu.Text
Sleep 100
End If
''*********************
Call DaGuai
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
Sub ShowInfo(InfoStr As String)
SendKeys InfoStr
SendKeys "{ENTER}"
End Sub ''生存数值
Sub SaveData()
WriteINI "SETTING", "ComboHongBi.Text", ComboHongBi.Text, "data.ini"
WriteINI "SETTING", "ComboLanBi.Text", ComboLanBi.Text, "data.ini"
WriteINI "SETTING", "ComboHong.Text", ComboHong.Text, "data.ini"
WriteINI "SETTING", "ComboLan.Text", ComboLan.Text, "data.ini"
WriteINI "SETTING", "ComboJiNeng.Text", ComboJiNeng.Text, "data.ini"
WriteINI "SETTING", "ComboQunYiJiNeng.Text", ComboQunYiJiNeng.Text, "data.ini"
WriteINI "SETTING", "ComboBackCity.Text", ComboBackCity.Text, "data.ini"
WriteINI "SETTING", "ComboPingKan.Text", ComboPingKan.Text, "data.ini"
WriteINI "SETTING", "ComboJianWu.Text", ComboJianWu.Text, "data.ini"
WriteINI "SETTING", "ComboChelloTang.Text", ComboChelloTang.Text, "data.ini"
WriteINI "SETTING", "ComboHanHua.Text", ComboHanHua.Text, "data.ini"
WriteINI "SETTING", "CheckNoHongBack.Value", CheckNoHongBack.Value, "data.ini"
WriteINI "SETTING", "CheckNoLanBack.Value", CheckNoLanBack.Value, "data.ini"
WriteINI "SETTING", "CheckQunDao.Value", CheckQunDao.Value, "data.ini"
WriteINI "SETTING", "CheckSiDa.Value", CheckSiDa.Value, "data.ini"
WriteINI "SETTING", "Text2.Text", Text2.Text, "data.ini"
End Sub
''读取数值
Sub GetData()
ComboHongBi.Text = ReadINI("SETTING", "ComboHongBi.Text", "data.ini")
ComboLanBi.Text = ReadINI("SETTING", "ComboLanBi.Text", "data.ini")
ComboHong.Text = ReadINI("SETTING", "ComboHong.Text", "data.ini")
ComboLan.Text = ReadINI("SETTING", "ComboLan.Text", "data.ini")
ComboJiNeng.Text = ReadINI("SETTING", "ComboJiNeng.Text", "data.ini")
ComboQunYiJiNeng.Text = ReadINI("SETTING", "ComboQunYiJiNeng.Text", "data.ini")
ComboBackCity.Text = ReadINI("SETTING", "ComboBackCity.Text", "data.ini")
ComboPingKan.Text = ReadINI("SETTING", "ComboPingKan.Text", "data.ini")
ComboJianWu.Text = ReadINI("SETTING", "ComboJianWu.Text", "data.ini")
ComboChelloTang.Text = ReadINI("SETTING", "ComboChelloTang.Text", "data.ini")
ComboHanHua.Text = ReadINI("SETTING", "ComboHanHua.Text", "data.ini")
CheckNoHongBack.Value = ReadINI("SETTING", "CheckNoHongBack.Value", "data.ini")
CheckNoLanBack.Value = ReadINI("SETTING", "CheckNoLanBack.Value", "data.ini")
CheckQunDao.Value = ReadINI("SETTING", "CheckQunDao.Value", "data.ini")
CheckSiDa.Value = ReadINI("SETTING", "CheckSiDa.Value", "data.ini")
Text2.Text = ReadINI("SETTING", "Text2.Text", "data.ini")
End Sub
加载中，请稍候......
品题加载中，请稍候...
发品题
以上彀友讲话只代表其小我私人不雅点，不代表新浪网的不雅点或者态度。