首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > 开发语言 > VB >

高手一定要帮的有关问题,等

2012-02-28 
高手一定要帮的问题,急等下面是一个游戏外挂的实现代码,请问怎么实现这些代码,怎么样让这些代码变能一个程

高手一定要帮的问题,急等
下面是一个游戏外挂的实现代码,请问怎么实现这些代码,怎么样让这些代码变能一个程序启用。代码太长了我只把前面的一部分粘上了。


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的入門的書來看看吧。
[解决办法]
呵呵...

热点排行