高手一定要帮的问题,急等
下面是一个游戏外挂的实现代码,请问怎么实现这些代码,怎么样让这些代码变能一个程序启用。代码太长了我只把前面的一部分粘上了。
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
以下是CALL查找
[解决办法]
問對地方了!
怎麼做? 買一本VB的入門的書來看看吧。
[解决办法]
呵呵...