挂机锁源码
Private Sub Form_Load()
Dim MyexePath As String
Dim MySoftware As String
On Error Resume Next 'Ã?ÓÐÑ?ÔñÎÄ?þµÄÊ?ºòÈÝ?í Me.Show
Form1.Height = Screen.Height
Form1.Width = Screen.Width
Text1.SetFocus
HooK
SetWindowPos Me.hwnd, HWND_TOPMOST Or HWND_TOP, 0, 0, 0, 0, SWP_NOMOVE
Or SWP_NOSIZE
MyexePath = "taskmgr.exe"
MySoftware = "debugger"
Call SetAutoRun(False, MyexePath, MySoftware) End Sub
'=====================================
Private Sub Command1_Click()
Dim Aks As String
If Text1.Text = "VB" Then
Aks = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\taskmgr.exe"
RegDeleteKey HKEY_LOCAL_MACHINE, Aks
UnHooK
End
End If
End Sub
2012-04-20 23:51?Ø???Ù?? |
QQ97000946
2Â?
Public 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
Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long)
As Long
Public Const HWND_TOPMOST = -1
Public Const WM_NCCALCSIZE = &H83
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOZORDER = &H4
Public Const HWND_TOP = 0
'*******************************************************************************************
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Public Const REG_SZ = 1
Public Const REG_DWORD = 4 ' 32-bit number
Public Const HKEY_LOCAL_MACHINE = &H80000002
'******************************************************************************************
Private Declare Function CallNextHookEx Lib "user32" _ (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SetWindowsHookEx Lib "user32" _ Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, _
ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, Source As Any, ByVal Length As Long) Private Type PKBDLLHOOKSTRUCT
vkCode As Long
scanCode As Long
flags As Long
time As Long
dwExtraInfo As Long
End Type
Private Const WM_KEYDOWN = &H100
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYUP = &H105
Private Const VK_LWIN = &H5B
Private Const VK_RWIN = &H5C
Private Const HC_ACTION = 0
Private Const WH_KEYBOARD_LL = 13
Private lngHook As Long
'******************************************************************************************
Public Sub SetAutoRun(ByVal Autorun As Boolean, MyexePath As String, MySoftware As String)
Dim KeyId As Long
Dim Regkey_1 As String
Dim Xm As String
Xm = "debugfile.exe"
Regkey_1 = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\" & MyexePath
Call RegCreateKey(HKEY_LOCAL_MACHINE, Regkey_1, KeyId) '??Á? RegSetValueEx KeyId, MySoftware, 0&, REG_SZ, ByVal Xm, LenB(Xm) RegCloseKey KeyId
End Sub
'Ê?Óõ×?ãKeyboardHookÀ??Ø???üÏûÏ?
Public Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam
As Long, ByVal lParam As Long) As Long
Dim blnHook As Boolean
Dim p As PKBDLLHOOKSTRUCT
If nCode = HC_ACTION Then
Select Case wParam
Case WM_KEYDOWN, WM_SYSKEYDOWN, WM_KEYUP, WM_SYSKEYUP Call CopyMemory(p, ByVal lParam, Len(p))
If p.vkCode = VK_LWIN Or p.vkCode = VK_RWIN Then '??ÏÂÁË×ó/ÓÒWin?ü blnHook = True
End If
Case Else
'do nothing
End Select
End If
If blnHook Then
LowLevelKeyboardProc = 1
Else
Call CallNextHookEx(WH_KEYBOARD_LL, nCode, wParam, lParam) End If
End Function
'==========================
Public Sub HooK()
lngHook = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf
LowLevelKeyboardProc, App.hInstance, 0) End Sub
'==========================
Public Sub UnHooK()
Call UnhookWindowsHookEx(lngHook) End Sub