诛仙飞天外挂。。源码公布VB

分享】诛仙飞天外挂。。源码公布 VB -------------------------------------------------------------------------------- Option Explicit Private Declare Function ReleaseCapture Lib quot;user32 quot; () As Long Private Declare Function SendMessage Lib quot;user32 quot; Alias quot;SendMessageA quot; (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function SetLayeredWindowAttributes Lib quot;user32 quot; (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Const WM_SYSCOMMAND = amp;H112 Private Const SC_MOVE = amp;HF010 amp; Private Const WM_NCLBUTTONDOWN = amp;HA1 Private Const HTCAPTION = 2 Const LWA_ALPHA = amp;H2 '注释：表示把窗体设置成半透明样式 Const LWA_COLORKEY = amp;H1 '注释：表示不显示窗体中的透明色 Dim base As Long Const WS_EX_LAYERED = amp;H80000 Const GWL_EXSTYLE = (-20) Private Declare Function GetWindowLong Lib quot;user32 quot; Alias quot;GetWindowLongA quot; (ByVal hWnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowLong Lib quot;user32 quot; Alias quot;SetWindowLongA quot; (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function SetWindowPos Lib quot;user32 quot; (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 '常量声明 Const SWP_NOMOVE = amp;H2 '保持当前位置（x 和 y 设定将被忽略） Const SWP_NOSIZE = amp;H1 '保持当前大小（cx 和 cy 会被忽略） Const HWND_TOPMOST = -1 Const Flags = SWP_NOMOVE Or SWP_NOSIZE Dim pid As Long Dim hProcess As Long Private Sub Form_Load() Dim rtn As Long 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, 170, LWA_ALPHA End Sub Private Sub Frame1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0 'SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0 amp; '上述两种方法都能实现该功能。 End Sub Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0 'SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0 amp; '上述两种方法都能实现该功能。 End Sub Function IsRun() As Boolean IsRun = False Dim gameupdatetitle As String Dim hwd As Long ' 储存 FindWindow 函数返回的句柄 hwd = FindWindow(vbNullString, quot;Element Client quot;) GetWindowThreadProcessId hwd, pid hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid) If hProcess = 0 Then IsRun = False Else IsRun = True End If CloseHandle hProcess End Function Private Sub a1_Timer() hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid) If hProcess Then WriteProcessMemory hProcess, ByVal amp;H403E33, 1099547353, 4, 0 amp; '写入内存1099547353 这个值实现穿墙功能。 End If CloseHandle hProcess End Sub Private Sub Command1_Click() If IsRun = True Then If Command1.Caption = quot;飞天(开) quot; Then Command1.Caption = quot; 飞天(关) quot; feitian.Enabled = True ElseIf Command1.Caption = quot;飞天(关) quot; Then Command1.Caption = quot;飞天(开) quot; feitian.Enabled = False End If Else MsgBox quot;游戏未开启 quot;, 16 Exit Sub End If End Sub Private Sub Command2_Click() If IsRun = True Then If Command2.Caption = quot;穿墙(开) quot; Then Command2.Caption = quot; 穿墙(关) quot; a1.Enabled = True ElseIf Command2.Caption = quot;穿墙(关) quot; Then Command2.Caption = quot;穿墙(开) quot; a1.Enabled = False End If Else MsgBox quot;游戏未开启 quot;, 16 Exit Sub End If End Sub Private Sub feitian_Timer() hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid) If hProcess Then WriteProcessMemory hProcess, ByVal amp;H45E019, -846528150, 4, 0 amp; '写入内存846528150 这个值实现飞天功能。 End If CloseHandle hProcess End Sub Private Sub Label1_Click() End End Sub Private Sub Label3_Click() Me.WindowState = 1 End Sub Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) ReleaseCapture SendMessage Me.hWnd, WM_SYSCOMMAND, SC_MOVE + HTCAPTION, 0 'SendMessage hwnd, WM_NCLBUTTONDOWN, HTCAPTION, 0 amp; '上述两种方法都能实现该功能。 End Sub [公告]请注意言行举止，不要让大家觉得不适！ 寒悠儿 查看公开信息 查找 寒悠儿 发表的更多帖子 查找 寒悠儿 发表的所有主题 寒悠儿 初级会员 资 料: 注册日期: Sep 2007 帖子: 12 精华: 0 现金: 200 Kx 致谢数: 0 获感谢文章数：0 获会员感谢数：0 2 2007-11-05, 16:42:31 -------------------------------------------------------------------------------- 引用: 最初由 寒悠儿发布 Option Explicit Private Declare Function ReleaseCapture Lib quot;user32 quot; () As Long Private Declare Function SendMessage Lib quot;user32 quot; Alias quot;SendMessage... 以下是 CALL 查找 Option Explicit '---------------声明函数----------------------- '得到窗体句柄的函数,FindWindow 函数用来返回符合指定的类名( ClassName )和窗口名( WindowTitle )的窗口句柄 Public Declare Function FindWindow Lib quot;user32 quot; Alias quot;FindWindowA quot; (ByVal lpClassName As String, ByVal lpWindowName As String) As Long '得到窗体控件句柄的函数 Public Declare Function FindWindowEx Lib quot;user32 quot; Alias quot;FindWindowExA quot; (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long '得到进程标识符的函数 Public Declare Function GetWindowThreadProcessId Lib quot;user32 quot; (ByVal hwnd As Long, lpdwProcessId As Long) As Long '得到目标进程句柄的函数 Public Declare Function OpenProcess Lib quot;kernel32 quot; (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long '关闭句柄的函数 Public Declare Function CloseHandle Lib quot;kernel32 quot; (ByVal hObject As Long) As Long '读取进程内存的函数 Public Declare Function ReadProcessMemory Lib quot;kernel32.dll quot; (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Any, ByVal nSize As Long, ByRef lpNumberOfBytesWritten As Long) As Long Public Declare Function WriteProcessMemory Lib quot;kernel32 quot; (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long '-----------发送信息的函数 Public Declare Function SendMessage Lib quot;user32 quot; Alias quot;SendMessageA quot; (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Declare Function PostMessage Lib quot;user32 quot; Alias quot;PostMessageA quot; (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Declare Sub keybd_event Lib quot;user32 quot; (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long) '延迟函数 Public Declare Sub Sleep Lib quot;kernel32 quot; (ByVal dwMilliseconds As Long) '读取配置文件的函数 Public Declare Function GetPrivateProfileString Lib quot;kernel32 quot; Alias quot;GetPrivateProfileStringA quot; (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long '隐藏游戏窗口用 Public Declare Function ShowWindow Lib quot;user32 quot; (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long Public Const PROCESS_ALL_ACCESS = amp;H1F0FFF Public Const SW_HIDE = 0 Public Const SW_SHOW = 5 'Public Const SW_SHOWDEFAULT = 10'--------------------------------------------分割线----------------------------------------------------------'以下是程序 FORM 源码 Dim hwd As Long ' 储存 FindWindow 函数返回的句柄 Dim pid As Long Dim hProcess As Long '存放进程句柄 Dim base As Long '存放人物基地址 Dim hp As Long '存储生命值 Dim hpmax As Long '存储生命最大值 Dim mp As Long '存储真气值 Dim mpmax As Long '存储真气最大值 Dim dengji As Long '等级 Dim jingli As Long '精力 Dim jlmax As Long '精力最大值--- Dim money As Long '钱包 Dim bank As Long '银行的钱 Dim exp As Double '经验 Dim expbk As Double '判断经验 Dim maxexp As Double 'MAX exp Dim map As Long '地图 Dim zhuangtai As Long '玩家状态 Dim job As Long '职业 Dim wpid As Long '物品 ID Dim wpxtid As Long '物品系统 ID '--------选取人物 NPC 怪的血等 Dim B(oc是什么意思？oc是指原创角色，original character的缩写。oc还有更多方面的意思。)HP As Long Dim BHPmax As Long Dim Bdj As Long Dim bx1 As Single Dim by1 As Single '------------ Dim MBid As Long '目标 ID Dim BB As Long ' 星星报警 Dim xuejn As Long '技能格 Dim x1 As Single 'X 坐标 Dim y1 As Single 'Y 坐标 Dim QQ As Long '调用 Private Declare Sub CopyMemory Lib quot;kernel32 quot; Alias quot;RtlMoveMemory quot; (Destination As Any, Source As Any, ByVal Length As Long) Private Declare Function SetWindowPos Lib quot;user32 quot; (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 Function Float2Int(Ans As Single) As Long '浮点转整形 CopyMemory Float2Int, Ans, 4 End Function Private Sub Command1_Click() '测试 'If hProcess Then ' ReadProcessMemory hProcess, ByVal amp;H9077CC, QQ, 4, 0 amp; 'ReadProcessMemory hProcess, ByVal QQ + amp;H28, QQ, 4, 0 amp; ' ReadProcessMemory hProcess, ByVal QQ + amp;H13C, QQ, 4, 0 amp; '写入内存-846528150 这个值实现飞天功能。 'WriteProcessMemory hProcess, ByVal QQ, 1, 4, 0 amp; 'ReadProcessMemory hProcess, ByVal QQ + amp;H140, QQ, 4, 0 amp; 'Me.Label26.Caption = QQ 'End If Call_jw End Sub Private Sub Command7_Click() If Command7.Caption = quot;隐藏游戏 quot; Then i = ShowWindow(hwd, SW_HIDE) Command7.Caption = quot;显示游戏 quot; ElseIf Command7.Caption = quot;显示游戏 quot; Then i = ShowWindow(hwd, SW_SHOW) Command7.Caption = quot;隐藏游戏 quot; End If End Sub Private Sub Form_Load() a = 0 hwd = FindWindow(vbNullString, quot;Element Client quot;) GetWindowThreadProcessId hwd, pid hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, pid) retValue = SetWindowPos(Me.hwnd, hwd, 750, 20, 265, 400, SWP_SHOWWINDOW) CloseHandle hProcess End Sub Private Sub Form_Unload(Cancel As Integer) CloseHandle hProcess End Sub Private Sub Timer1_Timer() Dim Name(31) As Byte '存储人物名称 Dim name_temp As Long Dim id As Long '------------ Dim bname(31) As Byte '存储选取人物名称 Dim bname_temp As Long Dim juli As Long hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, pid) If hProcess Then ReadProcessMemory hProcess, ByVal ...