Option Explicit
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As Long, ByVal crKey As Long, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_MOVE = &HF010&
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2
Const LWA_ALPHA = &H2 '注释：表示把窗体设置成半透明样式
Const LWA_COLORKEY = &H1 '注释：表示不显示窗体中的透明色
Dim base As Long
Const WS_EX_LAYERED = &H80000
Const GWL_EXSTYLE = (-20)
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
'常量声明
Const SWP_NOMOVE = &H2 '保持当前位置（x和y设定将被忽略）
Const SWP_NOSIZE = &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&
'上述两种方法都能实现该功能。
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&
'上述两种方法都能实现该功能。
End Sub
Function IsRun() As Boolean
IsRun = False
Dim gameupdatetitle As String
Dim hwd As Long ' 储存 FindWindow 函数返回的句柄
hwd = FindWindow(vbNullString, "Element Client")
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 &H403E33, 1099547353, 4, 0& '写入内存1099547353这个值实现穿墙功能。
End If
CloseHandle hProcess
End Sub
Private Sub Command1_Click()
If IsRun = True Then
If Command1.Caption = "飞天(开)" Then
Command1.Caption = " 飞天(关)"
feitian.Enabled = True
ElseIf Command1.Caption = "飞天(关)" Then
Command1.Caption = "飞天(开)"
feitian.Enabled = False
End If
Else
MsgBox "游戏未开启", 16
Exit Sub
End If
End Sub
Private Sub Command2_Click()
If IsRun = True Then
If Command2.Caption = "穿墙(开)" Then
Command2.Caption = " 穿墙(关)"
a1.Enabled = True
ElseIf Command2.Caption = "穿墙(关)" Then
Command2.Caption = "穿墙(开)"
a1.Enabled = False
End If
Else
MsgBox "游戏未开启", 16
Exit Sub
End If
End Sub
Private Sub feitian_Timer()
hProcess = OpenProcess(PROCESS_ALL_ACCESS, False, pid)
If hProcess Then
WriteProcessMemory hProcess, ByVal &H45E019, -846528150, 4, 0& '写入内存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&
'上述两种方法都能实现该功能。
End Sub
Option Explicit '---------------声明函数-----------------------
'得到窗体句柄的函数,FindWindow函数用来返回符合指定的类名( ClassName )和窗口名( WindowTitle )的窗口句柄
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
'得到窗体控件句柄的函数
Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
'得到进程标识符的函数
Public Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long
'得到目标进程句柄的函数
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
'关闭句柄的函数
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
'读取进程内存的函数
Public Declare Function ReadProcessMemory Lib "kernel32.dll" (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 "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
'-----------发送信息的函数
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Sub keybd_event Lib "user32" (ByVal bVk As Byte, ByVal bScan As Byte, ByVal dwFlags As Long, ByVal dwExtraInfo As Long)
'延迟函数
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'读取配置文件的函数
Public Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (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 "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Const PROCESS_ALL_ACCESS = &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 BHP 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 "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
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
Function Float2Int(Ans As Single) As Long '浮点转整形
CopyMemory Float2Int, Ans, 4
End Function
Private Sub Command1_Click()
'测试
'If hProcess Then
' ReadProcessMemory hProcess, ByVal &H9077CC, QQ, 4, 0&
'ReadProcessMemory hProcess, ByVal QQ + &H28, QQ, 4, 0&
' ReadProcessMemory hProcess, ByVal QQ + &H13C, QQ, 4, 0& '写入内存-846528150这个值实现飞天功能。
'WriteProcessMemory hProcess, ByVal QQ, 1, 4, 0&
'ReadProcessMemory hProcess, ByVal QQ + &H140, QQ, 4, 0&
'Me.Label26.Caption = QQ
'End If
Call_jw
End Sub
Private Sub Command7_Click()
If Command7.Caption = "隐藏游戏" Then
i = ShowWindow(hwd, SW_HIDE)
Command7.Caption = "显示游戏"
ElseIf Command7.Caption = "显示游戏" Then
i = ShowWindow(hwd, SW_SHOW)
Command7.Caption = "隐藏游戏"
End If
End Sub
Private Sub Form_Load()
a = 0
hwd = FindWindow(vbNullString, "Element Client")
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)
End If
'---------地图
Select Case map
Case 1
Label28.Caption = "河阳城"
Case 2
Label28.Caption = "青云城"
Case 3
Label28.Caption = "天音城"
Case 4
Label28.Caption = "流波城"
End Select
'--------玩家状态
Select Case zhuangtai
Case 1
Label31.Caption = "在线"
Case 0
Label31.Caption = "离线"
End Select
'----------门派
Select Case job
Case 0
Me.Label32.Caption = "江湖少侠"
Case 1
Me.Label32.Caption = "青云门"
Case 2
Me.Label32.Caption = "天音寺"
Case 3
Me.Label32.Caption = "鬼王宗"
Case 4
Me.Label32.Caption = "合欢派"
End Select
'----答题报警
If BB = 1 Then
Beep
MsgBox "请手工回答问题！~", vbOKOnly, "答题警报"
'-----攻击打勾判断
expbk = exp
If Me.Check1.Value = 1 Then
Me.Timer6.Enabled = True
ElseIf Me.Check1.Value = 0 Then
Me.Timer6.Enabled = False
End If
'-------------试行CALL
CloseHandle hProcess
End Sub
Private Sub Timer10_Timer()
Call_dazuo
End Sub
Private Sub Timer5_Timer()
If hp = hpmax Then
Call_NOdazuo
Me.Timer6.Enabled = True
Me.Check1.Value = 1
Me.Timer5.Enabled = False
End If
End Sub
Private Sub Timer6_Timer()
Call_Attack
If MBid > -1 Then
a = 0
ElseIf MBid < 0 Then
a = 1
End If
Sleep 500 '延迟text2中的数值，用val()取数值
If hp < Me.Text1.Text & a = 0 Then
End If
If MBid > -1 Then
Call_TAB
Sleep 300 '延迟text2中的数值，用val()取数值
End If
End Sub
'------------------以下是CALL---------
Sub Call_Move(dx As Single, dy As Single, dz As Single, dm As Long)
Dim asm As New clsASM '自动寻路
With asm ' asm
.Pushad ' pushad
.Mov_EAX_DWORD_Ptr &H910F4C ' mov eax,[&H910F4C]
.Mov_EAX_DWORD_Ptr_EAX_Add &H8 ' mov eax,[eax+&H8]
.Mov_EAX_DWORD_Ptr_EAX_Add &H88 ' mov eax,[eax+&H88]
.Push dm ' mov eax,[base]
.Mov_EAX Float2Int(dx) ' mov eax, x
.Mov_DWORD_Ptr_EAX &H909BC8 ' mov [&H909BC8], eax
.Mov_EAX Float2Int(dz) ' mov eax, z
.Mov_DWORD_Ptr_EAX &H909BCC ' mov [&H909BCC], eax
.Mov_EAX Float2Int(dy) ' mov eax, y
.Mov_DWORD_Ptr_EAX &H909BD0 ' mov [&H909BD0], eax
.Mov_EAX_DWORD_Ptr &H90778C ' mov eax, dword ptr [&H90778C]
.Mov_EAX_DWORD_Ptr_EAX_Add &H28 ' mov eax, dword ptr [eax+&H28]
.Lea_EAX_DWORD_Ptr_EAX_Add &H3C ' lea eax, dword ptr [eax+&H3c]
.Push &H909BC8 ' push &H909BC8
.Push_EAX ' PUSH eax
.Mov_ECX &H90D43C ' mov ecx, &H903C30
.Mov_EBX &H42AA70 ' mov eax, &H42ABB0
.Call_EBX ' Call eax
.Popad ' popad
.Ret
End With ' end
asm.Run_ASM pid
End Sub
Sub Call_TAB()
Dim asm As New clsASM 'TAB
With asm ' asm
.Pushad ' pushad
.Mov_EAX_DWORD_Ptr &H90D43C ' mov eax,dword ptr ds:[&H90D43C]
.Mov_EAX_DWORD_Ptr_EAX_Add &H1C ' mov eax,dword ptr ds:[eax+&H1c]
.Mov_EAX_DWORD_Ptr_EAX_Add &H28 ' mov eax,dword ptr ds:[eax+&H28]
.Mov_ECX_EAX ' mov ecx, eax;
.Push 0 ' push 0
.Mov_EBX &H45F460 ' mov ebx,&H45F460
.Call_EBX ' call EBX
.Popad ' popad
.Ret
End With ' end
asm.Run_ASM pid
End Sub
Sub Call_Attack()
Dim asm As New clsASM '普通攻击
With asm ' asm
.Pushad ' pushad
.Mov_EAX &H5A4400 ' Mov EAX,&H5A3200
.Call_EAX ' call pointer(eax)
.Popad ' popad
.Ret
End With ' end
asm.Run_ASM pid
End Sub
Sub Call_UseItem(UseItemid As Long, UseItemnum As Long)
Dim asm As New clsASM '使用物品
With asm
.Pushad 'pushad
.Mov_EDX UseItemid 'mov edx,dwid
.Mov_EAX UseItemnum 'mov eax,dwwz
.Push 1 'push 1
.Push_EDX 'push edx
.Push_EAX 'push eda
.Push 0 'push 0
.Mov_ESI_DWORD_Ptr &H90D43C 'mov esi,dword ptr &H90D43C
.Lea_ECX_DWORD_Ptr_ESI_Add &HD4 'lea ecx,dword ptr (esi+&H4)
.Mov_EAX &H579DA0 'mov eax &H579410
.Call_EAX
.Popad
.Ret
End With
asm.Run_ASM pid
End Sub
Sub Call_huichen()
Dim asm As New clsASM '死亡回城
With asm ' asm
.Pushad ' pushad
.Mov_EAX &H5A4820 ' Mov EAX,&H5a3620
.Call_EAX ' call pointer(eax)
.Popad ' popad
.Ret
End With ' end
asm.Run_ASM pid
End Sub
Sub Call_dazuo()
Dim asm As New clsASM '打坐
With asm ' asm
.Pushad ' pushad
.Mov_EAX &H5A4A80 ' Mov EAX,&H5a3620
.Call_EAX ' call pointer(eax)
.Popad ' popad
.Ret
End With ' end
asm.Run_ASM pid
End Sub
Sub Call_NOdazuo()
Dim asm As New clsASM '停止打坐
With asm ' asm
.Pushad ' pushad
.Mov_EAX &H5A4A40 ' Mov EAX,&H5A4A40
.Call_EAX ' call pointer(eax)
.Popad ' popad
.Ret
End With ' end
asm.Run_ASM pid
End Sub
Sub Call_jw()
Dim asm As New clsASM '自动拣物
With asm
.Pushad
.Mov_ECX_DWORD_Ptr &H90D43C
.Mov_EDX_DWORD_Ptr_EDI_Add &H110
.Mov_EAX_DWORD_Ptr_ESI_Add &H20
.Push_EDX
.Mov_ECX_DWORD_Ptr_ECX_Add &H20
.Push_EAX
.Add_ECX &HD4
.Mov_EAX &H579F70
.Call_EAX
.Popad
.Ret
End With
asm.Run_ASM pid
End Sub
Sub Call_KJ()
Dim asm As New clsASM '快捷键
With asm
.Pushad
.Mov_EAX_DWORD_Ptr base '基址
.Mov_EAX_DWORD_Ptr_EAX_Add &H28
'.MOV_EAX_EAX_add &H8D8 '这里是数字键偏移，Fn键偏移是&H8CC？没测试
'.MOV_EAX_EAX_add &HC
'.MOV_EAX_EAX_add &H4 * id 'ID=将键位*4后写入地址 键1-9=值0-8
'.Mov_ECX , EAX
' .Mov_EDX , [ECX]
'.Mov_EAX_DWORD_Ptr_EDX_Add &H8
' Call_EAX
' .Popad
' .Ret
End With
