飞艳小屋

程序--人生--哲学___________________欢迎艳儿的加入
BlogJava 首页 新随笔 联系 聚合 管理
  52 Posts :: 175 Stories :: 107 Comments :: 0 Trackbacks
江湖自动补血外挂源码.


现在看VB感觉越来越亲热了...毕竟按键类的已经明确定义了不是外挂...呵呵.

-----------------------------------------------------
江湖自动补血外挂.

窗体部分.
Dim SetHp As Integer
Dim SetMp As Integer
Dim SetTl As Integer
Dim DiZhi As Long
Dim ShiJian As Long
Dim shi As Integer
Dim yue  As Integer
Dim ri As Integer
Dim vx As Integer
Dim vy As Integer
Dim cx As Integer
Dim cy As Integer
Dim cPoint As POINTAPI
Dim keyPoint(1 To 10) As POINTAPI
Dim curWindow As Long
Private Const VK_HP = &H31
Private Const VK_MP = &H32
Private Const VK_TL = &H33
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd 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 WriteProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
Private Function ncnr(lpADDress As Long) As Integer
' 声明一些需要的变量
Dim hwnd As Long ' 储存 FindWindow 函数返回的句柄
Dim pid As Long ' 储存进程标识符( Process Id )
Dim pHandle As Long ' 储存进程句柄
hwnd = FindWindow(vbNullString, "YB_OnlineClient")
' 取得进程标识符
GetWindowThreadProcessId hwnd, pid
' 使用进程标识符取得进程句柄
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
' 在内存地址中读取数据
ReadProcessMemory pHandle, lpADDress, ByVal VarPtr(ncnr), 4, 0&
' 关闭进程句柄
CloseHandle hProcess
End Function
Private Function xr(lpADDress As Long, Zhi As Integer) As Integer
' 声明一些需要的变量
Dim hwnd As Long ' 储存 FindWindow 函数返回的句柄
Dim pid As Long ' 储存进程标识符( Process Id )
Dim pHandle As Long ' 储存进程句柄
hwnd = FindWindow(vbNullString, "YB_OnlineClient")
' 取得进程标识符
GetWindowThreadProcessId hwnd, pid
' 使用进程标识符取得进程句柄
pHandle = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
WriteProcessMemory pHandle, lpADDress, Zhi, 1, 0&
' 关闭进程句柄
CloseHandle hProcess
End Function
Private Sub Check1_Click()
If Check1.value = Checked Then
Timer3.Interval = CInt(txtdelay.Text) * 1000
Timer3.Enabled = True
Else
Timer3.Enabled = False
End If
End Sub
Private Sub Check2_Click()
If Check2.value = Checked Then
SetMp = CInt(Text2.Text)
Timer4.Interval = CInt(txtdelay.Text) * 1000
Timer4.Enabled = True
Else
Timer4.Enabled = False
End If
End Sub
Private Sub Check3_Click()
If Check3.value = Checked Then
SetTl = Text3.Text
Timer5.Interval = 10000
Timer5.Enabled = True
Else
Timer5.Enabled = False
End If
End Sub
Private Sub Check4_Click()
If Check4.value = Checked Then
yue = ncnr(ShiJian)
ri = ncnr(ShiJian + 4)
shi = ncnr(ShiJian + 8)
Timer6.Enabled = True
Else
Timer6.Enabled = False
End If
End Sub
Private Sub Check5_Click()
If Check5.value = Checked Then
Timer7.Enabled = True
Else
Timer7.Enabled = False
End If
End Sub
Private Sub cmdGotoGame_Click()
AppActivate "YB_OnlineClient"
End Sub
Private Sub Command1_Click()
xr ShiJian, Int(Text5.Text)
xr ShiJian + 4, Int(Text6.Text)
xr ShiJian + 8, Int(Text4.Text)
End Sub
Private Sub Form_Load()
vx = Int(65535 / 1024)
vy = Int(65535 / 768)
Dim i As Integer
Dim ky As Integer
Dim kx As Integer
kx = 635
ky = 745
For i = 1 To 10
    keyPoint(i).x = kx
    keyPoint(i).y = ky
    kx = kx + 40
Next i
ShiJian = &H8C0FE4
DiZhi = &H852702
Timer1.Enabled = True
Timer2.Enabled = True
Timer3.Enabled = False
Timer4.Enabled = False
Timer5.Enabled = False
Timer6.Enabled = False
Timer7.Enabled = False
Check1.value = 1
Timer3.Interval = 3000
Timer3.Enabled = True
Check2.value = 1
Timer4.Interval = 3000
Timer4.Enabled = True
End Sub
Private Sub regHotkey()
    Dim lretVal As Long
    preWinProc = GetWindowLong(frmMain.hwnd, GWL_WNDPROC)
    lretVal = SetWindowLong(frmMain.hwnd, GWL_WNDPROC, AddressOf wndproc)
    idHotKey = 5
    Modifiers = MOD_CONTROL
    uVirtKey = vbKeyG
    lretVal = RegisterHotKey(frmMain.hwnd, idHotKey, Modifiers, uVirtKey)
End Sub
Private Sub unReghotkey()
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If MsgBox("确认退出吗?", vbQuestion + vbYesNo, "确认") = vbYes Then
    Unload Me
    End
Else
Cancel = True
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnhookWindowsHookEx pid
End Sub
Private Sub Timer1_Timer()
Dim hwnd As Long
hwnd = FindWindow(vbNullString, "YB_OnlineClient")
If hwnd = 0 Then
Label11.Caption = "游戏未加载"
Label21.Caption = ""
Timer1.Enabled = True
Timer2.Enabled = False
Timer3.Enabled = False
Timer4.Enabled = False
Timer5.Enabled = False
Timer6.Enabled = False
Timer7.Enabled = False
Command1.Enabled = False
Exit Sub
End If
If hwnd <> 0 Then
Label11.Caption = "游戏已加载"
GameWindow = hwnd
Command1.Enabled = True
Timer2.Enabled = True
Timer2.Enabled = True
End If
End Sub
Private Sub Timer2_Timer()
Dim Nowhp As Integer
Dim HighHP As Integer
Dim Nowmp As Integer
Dim HighMp As Integer
Dim Nowtl As Integer
Dim HighTl As Integer
DiZhi = &H13AE838
Nowhp = ncnr(DiZhi)
DiZhi = &H13AE844
HighHP = ncnr(DiZhi)
DiZhi = &H13AE83C
Nowmp = ncnr(DiZhi)
DiZhi = &H13AE848
HighMp = ncnr(DiZhi)
DiZhi = &H13AE9DE
Nowtl = ncnr(DiZhi)
HighTl = ncnr(DiZhi)
'Label8.Caption = Str(Nowhp) + "/" + Str(HighHP)
'Label6.Caption = Str(Nowmp) + "/" + Str(HighMp)
'Label7.Caption = Str(Nowtl) + "/" + Str(HighTl)
Label8.Caption = Str(Nowhp) & "/" & Str(HighHP)
Label6.Caption = Str(Nowmp) & "/" & Str(HighMp)
Label7.Caption = Str(Nowtl)
Label22.Caption = Str(ncnr(ShiJian)) + "月" + Str(ncnr(ShiJian + 4)) + "日" + Str(ncnr(ShiJian + 8)) + "时"
End Sub
Private Sub Timer3_Timer()
Timer3.Enabled = False
Dim Nowhp As Integer
Dim hwnd As Long ' 储存 FindWindow 函数返回的句柄
Dim pid As Long ' 储存进程标识符( Process Id )
DiZhi = &H13AE838
SetHp = Val(Text1.Text)
Nowhp = ncnr(DiZhi)
hwnd = FindWindow(vbNullString, "YB_OnlineClient")
Me.Caption = "游戏已启动 窗口句柄:" & CStr(hwnd)
If Nowhp < SetHp Then
GetCursorPos cPoint
If chkdr.value = 1 Then
SetCursorPos 97, 10
Mouse_lClick
End If
SetCursorPos keyPoint(10).x, keyPoint(10).y
Sleep 500
Mouse_rClick
SetCursorPos cPoint.x, cPoint.y
End If
Timer3.Interval = CInt(txtdelay.Text) * 1000
Timer3.Enabled = True
End Sub
Private Sub Timer4_Timer()
Timer4.Enabled = False
Dim Nowmp As Integer
Dim hwnd As Long ' 储存 FindWindow 函数返回的句柄
Dim pid As Long ' 储存进程标识符( Process Id )
DiZhi = &H13AE83C
Nowmp = ncnr(DiZhi)
SetMp = CInt(Text2.Text)
hwnd = FindWindow(vbNullString, "YB_OnlineClient")
If Nowmp < SetMp Then
GetCursorPos cPoint
SetCursorPos keyPoint(9).x, keyPoint(9).y
Mouse_rClick
Sleep 500
SetCursorPos cPoint.x, cPoint.y
End If
Timer4.Interval = CInt(txtdelay.Text) * 1000
Timer4.Enabled = True
End Sub
Private Sub Timer5_Timer()
Timer5.Enabled = False
Dim Nowtlp As Integer
Dim hwnd As Long ' 储存 FindWindow 函数返回的句柄
Dim pid As Long ' 储存进程标识符( Process Id )
Nowmp = ncnr(DiZhi)
hwnd = FindWindow(vbNullString, "YB_OnlineClient")
If Nowtlp < SetTl And Check3.value = 1 Then
  SendKeys "我没有蓝药了,谁可以给我点?{ENTER}"
End If
Timer5.Interval = 5000
Timer5.Enabled = True
End Sub
Private Sub Timer6_Timer()
xr ShiJian, yue
xr ShiJian + 4, ri
xr ShiJian + 8, shi
End Sub
Private Sub Timer7_Timer()
xr &H8C0FEC, &HC
End Sub
Function Http(Web)
HyperJump = ShellExecute(0&, "OPEN", Web, vbNullString, vbNullString, vbNormalFocus)
End Function

 注册: 2005-10    状态: Offline1   Top
事业不成功只用小灵通
Exp:748

中士
 发表于: 2006-3-9 18:36:00

博客 | 档案 | 主页 | 短信 | 树状 | 收藏 | 编辑 | 删除 | 引用   

Re:发几个代码.VB写的!

---------------------------------
模块部分

Attribute VB_Name = "Module1"
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
Declare Function SetActiveWindow Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetActiveWindow Lib "user32" () As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'窗口总在最前端 retvalue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 300, 300, SWP_SHOWWINDOW)
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
 '具体可以使用的常量及其用法
Public Const LWA_ALPHA = &H2   '表示把窗体设置成半透明样式
Public Const LWA_COLORKEY = &H1   '表示不显示窗体中的透明色
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)

Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1

Public Const HWND_TOPMOST = -1
Public Const SWP_SHOWWINDOW = &H40

Public Const WM_CLOSE = &H10                    'Closing window
Public Const SW_SHOW = 5                        'showing window
Public Const WM_SETTEXT = &HC                   'Setting text of child window
Public Const WM_GETTEXT = &HD                   'Getting text of child window
Public Const WM_GETTEXTLENGTH = &HE
Public Const EM_GETPASSWORDCHAR = &HD2          'Checking if its a password field or not
Public Const BM_CLICK = &HF5                    'Clicking a button
Public Const SW_MAXIMIZE = 3
Public Const SW_MINIMIZE = 6
Public Const SW_HIDE = 0
Public Const SW_RESTORE = 9
Public Const WM_MDICASCADE = &H227              'Cascading windows
Public Const MDITILE_HORIZONTAL = &H1
Public Const MDITILE_SKIPDISABLED = &H2
Public Const WM_MDITILE = &H226

'窗口半透明
'rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE)    '取的窗口原先的样式
'rtn = rtn Or WS_EX_LAYERED     '使窗体添加上新的样式WS_EX_LAYERED
'SetWindowLong Me.hwnd, GWL_EXSTYLE, rtn    '把新的样式赋给窗体
'SetLayeredWindowAttributes Me.hwnd, 0, 192, LWA_ALPHA
'把窗体设置成半透明样式,第二个参数表示透明程度
'取值范围0--255,为0时就是一个全透明的窗体了
Public Type POINTAPI
x As Long
y As Long
End Type

Attribute VB_Name = "Module2"
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function RegisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long, ByVal fsModifiers As Long, ByVal vk As Long) As Long
Declare Function UnregisterHotKey Lib "user32" (ByVal hwnd As Long, ByVal id As Long) As Long

Public Const WM_HOTKEY = &H312  '消息标志常量 代表热键激活消息
Public Const MOD_ALT = &H1  'ALT标志
Public Const MOD_CONTROL = &H2 'Ctrl标志
Public Const MOD_SHIFT = &H4  'Shift标志
Public Const GWL_WNDPROC = (-4)  '窗体函数地址标志

Public preWinProc As Long  '原来的窗体函数地址
Public Modifiers As Long, uVirtKey As Long, idHotKey As Long
'      功能键状态         热键

Public GameWindow As Long

Private Type taLong  '定义类型
   ll As Long
End Type
Private Type t2Int
   lWord As Integer
   hword As Integer
End Type

 Public Function wndproc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
 
 
 
 
 If Msg = WM_HOTKEY Then        '如果是热键激活消息
    If wParam = idHotKey Then   '是指定的热键ID
       Dim lp As taLong, i2 As t2Int
       lp.ll = lParam   '取参数消息
       LSet i2 = lp
       If (i2.lWord = Modifiers) And i2.hword = uVirtKey Then '是所定义的热键被激活
       
   
                   
            If GameWindow > 0 Then
            If IsWindowVisible(frmMain.hwnd) Then
                frmMain.Show
                Else
                frmMain.Show
                'SetWindowPos GameWindow, 0, 0, 0, Int(frmGame.Width / 15), Int(frmGame.Height / 15), &H20
            End If
                ShowWindow frmMain.hwnd, SW_MINIMIZE
                frmMain.Show
            End If
          
          'Shell "notepad", vbNormalFocus
       End If
   End If
 Else
 '将之送往原来的Window Procedure
 wndproc = CallWindowProc(preWinProc, hwnd, Msg, wParam, lParam) '不是本热键激活消息就送回到原窗口函数处理
 End If
 End Function
 




 注册: 2005-10    状态: Offline2   Top
事业不成功只用小灵通
Exp:748

中士
 发表于: 2006-3-9 18:38:00

博客 | 档案 | 主页 | 短信 | 树状 | 收藏 | 编辑 | 删除 | 引用   

Re:发几个代码.VB写的!

--------------------------------
自动发言

Dim tmrDelay As Long
Dim sndMsg As String
Private Sub Command1_Click()
tmrDelay = 0
 tMr.Interval = 1000
  tMr.Enabled = True
End Sub
Private Sub cmdSend_Click()
If cmdSend.Caption = "发  言" Then
tmrDelay = 0
 tMr.Interval = 1000
  tMr.Enabled = True
 cmdSend.Caption = "停  止"
 Else
 tMr.Enabled = False
 cmdSend.Caption = "发  言"
  End If
End Sub
Private Sub tMr_Timer()
tMr.Enabled = False
tmrDelay = tmrDelay + 1
If tmrDelay < CInt(txtDelay.Text) Then
Else
SendKeys txtMsg.Text & "{ENTER}"
tmrDelay = 0
End If
tMr.Enabled = True
End Sub


 注册: 2005-10    状态: Offline3   Top
事业不成功只用小灵通
Exp:748

中士
 发表于: 2006-3-9 18:39:00

博客 | 档案 | 主页 | 短信 | 树状 | 收藏 | 编辑 | 删除 | 引用   

Re:发几个代码.VB写的!

-----------------------------------
窗口化


Private Sub Form_Load()

Me.Caption = ""
Shell App.Path & "\Launcher.exe"
tmr.Interval = 1000
tmr.Enabled = True

End Sub

Private Sub tmr_Timer()
tmr.Enabled = False
GameWindow = FindWindow(vbNullString, "YB_OnlineClient")
If GameWindow > 0 Then
Me.Caption = "YB_OnlineClient"
SetParent GameWindow, Me.hwnd
Else
tmr.Enabled = True
End If

End Sub

-------------------------------
模块部分

Attribute VB_Name = "Module1"
Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long) As Long
Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Declare Function GetWindowDC Lib "user32" (ByVal hwnd As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
Declare Function ReleaseCapture Lib "user32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As Long) As Long
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
'窗口总在最前端 retvalue = SetWindowPos(Me.hwnd, HWND_TOPMOST, Me.CurrentX, Me.CurrentY, 300, 300, SWP_SHOWWINDOW)
Public Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hwnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
 '具体可以使用的常量及其用法
Public Const LWA_ALPHA = &H2   '表示把窗体设置成半透明样式
Public Const LWA_COLORKEY = &H1   '表示不显示窗体中的透明色
Public Const WS_EX_LAYERED = &H80000
Public Const GWL_EXSTYLE = (-20)

Public Const WM_SYSCOMMAND = &H112
Public Const SC_MOVE = &HF010
Public Const HTCAPTION = 2
Public Const WM_NCLBUTTONDOWN = &HA1

Public Const HWND_TOPMOST = -1
Public Const SWP_SHOWWINDOW = &H40

Public Const WM_CLOSE = &H10                    'Closing window
Public Const SW_SHOW = 5                        'showing window
Public Const WM_SETTEXT = &HC                   'Setting text of child window
Public Const WM_GETTEXT = &HD                   'Getting text of child window
Public Const WM_GETTEXTLENGTH = &HE
Public Const EM_GETPASSWORDCHAR = &HD2          'Checking if its a password field or not
Public Const BM_CLICK = &HF5                    'Clicking a button
Public Const SW_MAXIMIZE = 3
Public Const SW_MINIMIZE = 6
Public Const SW_HIDE = 0
Public Const SW_RESTORE = 9
Public Const WM_MDICASCADE = &H227              'Cascading windows
Public Const MDITILE_HORIZONTAL = &H1
Public Const MDITILE_SKIPDISABLED = &H2
Public Const WM_MDITILE = &H226

'窗口半透明
'rtn = GetWindowLong(Me.hwnd, GWL_EXSTYLE)    '取的窗口原先的样式
'rtn = rtn Or WS_EX_LAYERED     '使窗体添加上新的样式WS_EX_LAYERED
'SetWindowLong Me.hwnd, GWL_EXSTYLE, rtn    '把新的样式赋给窗体
'SetLayeredWindowAttributes Me.hwnd, 0, 192, LWA_ALPHA
'把窗体设置成半透明样式,第二个参数表示透明程度
'取值范围0--255,为0时就是一个全透明的窗体了
Public Type POINTAPI
X As Long
Y As Long
End Type


Public GameWindow As Long

posted on 2006-06-29 14:48 天外飞仙 阅读(1080) 评论(0)  编辑  收藏 所属分类: 其它

只有注册用户登录后才能发表评论。
网站导航: