|
本帖最后由 ksp169 于 2010-7-10 11:43 编辑
模块代码:
Option Explicit
Public Const MAX_TOOLTIP As Integer = 64
Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4
Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const WM_MOUSEMOVE = &H200
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Public Const WM_RBUTTONDBLCLK = &H206
Public Const SW_RESTORE = 9
Public Const SW_HIDE = 0
Public nfIconData As NOTIFYICONDATA
Public Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * MAX_TOOLTIP
End Type
Public Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function Shell_NotifyIcon Lib "shell32.dll" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long
工程代码:
Option Explicit
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
Private Declare Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vkey As Long) As Integer
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, lpdwProcessId 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 Const PROCESS_ALL_ACCESS = &H1F0FFF '参数决定了对进程的存储权限,使用完全控制
Private 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
'延迟函数
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Const HWND_TOPMOST = -1
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const HWND_TOP = 0
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_SHOWWINDOW = &H40
'==========================================以上为隐藏代码===========
'-----------------------窗体中--------------------------
Dim WindowTop, WindowLeft
Dim hwd As Long ' 储存 FindWindow 函数返回的句柄
Dim pid As Long '存放进程ID
Dim hProcess As Long '存放进程句柄
Dim t As Long '时间
Dim t1 As Long '时间1
Dim hp As Long
Dim mp As Long
Dim hp1 As Long
Dim mp1 As Long
Dim s As Long
Private Const SW_HIDE = 0
Private Const SW_HOW = 1
Dim mz(16) As Byte
Private Sub Command1_Click()
If Command1.Caption = "隐藏游戏" Then
ShowWindow hwd, SW_HIDE
Command1.Caption = "显示游戏"
ElseIf Command1.Caption = "显示游戏" Then
ShowWindow hwd, SW_HOW
Command1.Caption = "隐藏游戏"
End If
End Sub
Private Sub Command2_Click()
Timer1.Enabled = False
End Sub
Private Sub Form_Load()
hwd = FindWindow(vbNullString, "sro_client") ' 取得进程标识符
If hWnd = 0 Then
Label1.Caption = "丝路未运行"
Else
Label1.Caption = "游戏已运行"
End If
GetWindowThreadProcessId hwd, pid '获取进程标识符
hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, pid) '将进程标识符做为参数,返回目标进程PID的句柄,得到此句柄后即可对目标进行读写操,PROCESS_ALL_ACCESS表示完全控制,权限最大
If hProcess = 0 Then
Label2.Caption = "使用工具失败"
Else
Label2.Caption = "可以使用工具"
SetWindowPos Me.hWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE
End If
End Sub
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyF11) Then Timer2.Enabled = True
If GetAsyncKeyState(vbKeyF12) Then Timer2.Enabled = False
End Sub
Function WindowStyle()
'以下把程序放入System Tray====================================System Tray Begin
With nfIconData
.hWnd = Me.hWnd
.uID = Me.Icon
.uFlags = NIF_ICON Or NIF_MESSAGE Or NIF_TIP
.uCallbackMessage = WM_MOUSEMOVE
.hIcon = Me.Icon.Handle
'定义鼠标移动到托盘上时显示的Tip
.szTip = "已最小化到托盘" & vbNullChar
.cbSize = Len(nfIconData)
End With
Call Shell_NotifyIcon(NIM_ADD, nfIconData)
'=============================================================System Tray End
Me.Hide
End Function
Private Sub Form_Resize()
WindowTop = Me.Top
WindowLeft = Me.Left
If Me.WindowState = 1 Then
WindowStyle
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lMsg As Single
lMsg = X / Screen.TwipsPerPixelX
Select Case lMsg
Case WM_LBUTTONDBLCLK '双击左键显示窗体,要改成其他的看模块里的定义
ShowWindow Me.hWnd, SW_RESTORE
Me.Top = WindowTop
Me.Left = WindowLeft
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
Me.SetFocus
Case WM_RBUTTONUP '在托盘图标上点右键显示菜单
PopupMenu f00 '菜单名称为F00,做菜单时你可以改成别的,这里也得改成相应的
End Select
End Sub
Private Sub F01_Click()
ShowWindow Me.hWnd, SW_RESTORE
Me.Top = WindowTop
Me.Left = WindowLeft
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
Private Sub F02_Click()
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
'退出程序时删除托盘图标
Call Shell_NotifyIcon(NIM_DELETE, nfIconData)
End Sub
Private Sub Timer2_Timer()
ReadProcessMemory hProcess, ByVal &HE6CC94, s, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H450, mp, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H454, hp, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H114, mz(0), 16, 0&
ReadProcessMemory hProcess, ByVal s + &H45C, hp1, 4, 0&
ReadProcessMemory hProcess, ByVal s + &H458, mp1, 4, 0&
Label4.Caption = hp & "/" & hp1
Label3.Caption = mp & "/" & mp1
Label5.Caption = StrConv(mz, vbUpperCase)
End Sub
Private Sub Timer3_Timer()
Dim p As POINTAPI
Dim f As RECT
GetCursorPos p '得到MOUSE位置
GetWindowRect Me.hWnd, f '得到窗体的位置
If Me.WindowState <> 1 Then
If p.X > f.Left And p.X < f.Right And p.Y > f.Top And p.Y < f.Bottom Then
'MOUSE 在窗体上
If Me.Top < 0 Then
Me.Top = -10
Me.Show
ElseIf Me.Left < 0 Then
Me.Left = -10
Me.Show
ElseIf Me.Left + Me.Width >= Screen.Width Then
Me.Left = Screen.Width - Me.Width + 10
Me.Show
End If
Else
If f.Top <= 4 Then
Me.Top = 40 - Me.Height
ElseIf f.Left <= 4 Then
Me.Left = 40 - Me.Width
ElseIf Me.Left + Me.Width >= Screen.Width - 4 Then
Me.Left = Screen.Width - 40
End If
End If
End If
End Sub |
|