几个代码VB

几个代码VB
2009年07月15日
　　现在看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 ShellExecute(0&, "OPEN", Web, vbNullString, vbNullString, vbNormalFocus)
　　End Function
　　---------------------------------
　　模块部分
　　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
　　--------------------------------
　　自动发言
　　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 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