挂机锁源码

挂机锁源码 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