Attribute VB_Name = "Module1"
Option Explicit
'注意，以下所有双版本的API均声明成了 UNICODE 版。 并且许多地方与VB的API浏览器生成的代码有所不同。
Private Declare Function OpenProcess Lib "kernel32" (ByVal _
dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal _
dwProcessId As Long) As Long
Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal _
hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, _
ByVal nSize As Long, _
lpNumberOfBytesWritten As Long) As Long
Private Declare Function WriteProcessMemory Lib "kernel32" (ByVal _
hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, _
ByVal nSize As Long, _
lpNumberOfBytesWritten As Long) As Long
Private Declare Function GlobalAddAtom Lib "kernel32" Alias _
"GlobalAddAtomW" (ByVal lpString As Long) As Integer
Private Declare Function GlobalDeleteAtom Lib "kernel32" (ByVal _
nAtom As Integer) As Integer
Private Declare Function GlobalFindAtom Lib "kernel32" Alias _
"GlobalFindAtomW" (ByVal lpString As Long) As Integer
Private Const TH32CS_SNAPPROCESS = 2
Private Type PROCESSENTRY32W
      dwSize                As Long
      cntUsage              As Long
      h32ProcessID          As Long '      // this process
      th32DefaultHeapID     As Long '
      h32ModuleID           As Long '      // associated exe
      cntThreads            As Long '
      th32ParentProcessID As Long '      // this process's parent process
      pcPriClassBase        As Long '      // Base priority of process'sthreads
      dwFlags               As Long '
      szExeFile(1 To 260) As Integer ' // Path
End Type
Private Declare Function CreateToolhelp32Snapshot Lib "kernel32" (ByVal dwFlags As Long, ByVal th32ProcessID As Long) As Long
Private Declare Function Process32First Lib "kernel32" Alias "Process32FirstW" (ByVal hSnapshot As Long, lpPE As PROCESSENTRY32W) As Long
Private Declare Function Process32Next Lib "kernel32" Alias "Process32NextW" (ByVal hSnapshot As Long, lpPE As PROCESSENTRY32W) As Long
Private Declare Function lstrcmpi Lib "kernel32" Alias "lstrcmpiW" (lpString1 As Integer, ByVal lpString2 As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Private Type LUID
      lowpart       As Long
      highpart      As Long
End Type
Private Type LUID_AND_ATTRIBUTES
          pLuid         As LUID
          Attributes    As Long
End Type
Private Type TOKEN_PRIVILEGES
      PrivilegeCount    As Long
      Privileges        As LUID_AND_ATTRIBUTES
End Type
Private Const PROCESS_ALL_ACCESS          As Long = &H1F0FFF
Private Const TOKEN_QUERY                 As Long = &H8&
Private Const TOKEN_ADJUST_PRIVILEGES     As Long = &H20&
Private Const SE_PRIVILEGE_ENABLED        As Long = &H2
Private Const SE_DEBUG_NAME As String = "SeDebugPrivilege"
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "advapi32.dll" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function LookupPrivilegeValue Lib "advapi32.dll" Alias "LookupPrivilegeValueW" (ByVal lpSystemName As Long, ByVal lpName As Long, lpLuid As LUID) As Long
Private Declare Function AdjustTokenPrivileges Lib "advapi32.dll" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, _
ByVal BufferLength As Long, ByVal PrevState As Long, ByVal N As Long) As Long
Private Declare Function LoadLibrary Lib "kernel32" Alias _
"LoadLibraryW" (ByVal lpLibFileName As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal _
hModule As Long, ByVal lpProcName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal _
hLibModule As Long) As Long
Private Const MEM_COMMIT          As Long = &H1000
Private Const MEM_DECOMMIT        As Long = &H4000
Private Const PAGE_EXECUTE_READWRITE      As Long = &H40
Private Declare Function VirtualAllocEx Lib "kernel32" (ByVal _
ProcessHandle As Long, ByVal lpAddress As Long, ByVal dwSize As _
Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFreeEx Lib "kernel32" (ByVal _
ProcessHandle As Long, ByVal lpAddress As Long, ByVal dwSize As _
Long, ByVal dwFreeType As Long) As Long
Private Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As Long, ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, lpThreadId As Long) As Long
Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExW" (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 Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const ATOM_FLAG As String = "HookSysKey"
Private Const SHELL_FALG As String = "Winlogon"
Private Const SHELL_CODE_DWORDLEN = 240       '注入代码所占的双字数
Private Const SHELL_CODE_LENGTH = (SHELL_CODE_DWORDLEN * 4) '字节数
Private Const SHELL_FUNCOFFSET = &H26         '注入代码线程函数偏移量
Private mlShellCode(SHELL_CODE_DWORDLEN - 1) As Long
    
Private m_lHookID         As Long               '键盘钩子句柄
'============================================
' 锁定/解锁键盘
' 参数：布尔型，真表示锁定
' 返回：布尔型, 真表示成功
' 注意：非 Ctrl+Alt+Del 键使用普通钩子技术，因此
'         程序在退出时注意要卸载钩子。
'============================================
Public Function LockKeyboard(ByVal bLock As Boolean) As Boolean
      Dim lResult As Long
      Dim lStrPtr    As Long
      lStrPtr = StrPtr(SHELL_FALG)
      lResult = GlobalFindAtom(lStrPtr)
      If lResult = 0 Then
          lResult = InsertAsmCode
          Debug.Assert lResult = 0
          If lResult Then Exit Function
      End If
    
      lStrPtr = StrPtr(ATOM_FLAG)
      lResult = GlobalFindAtom(lStrPtr)
      If bLock Then
          m_lHookID = SetWindowsHookEx(13, AddressOf LowLevelKeyboardProc, App.hInstance, 0)
          If (lResult = 0 And m_lHookID <> 0) Then lResult = GlobalAddAtom(lStrPtr)
          LockKeyboard = (lResult <> 0 And m_lHookID <> 0)
          Debug.Assert LockKeyboard
      Else
          Call UnhookWindowsHookEx(m_lHookID)
          If lResult Then lResult = GlobalDeleteAtom(lResult)
          LockKeyboard = (lResult <> 0)
      End If
End Function
Public Function GetKeyboardState() As Boolean
      GetKeyboardState = GlobalFindAtom(StrPtr(ATOM_FLAG)) <> 0
End Function

Private Function LowLevelKeyboardProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
      If nCode >= 0 Then
          '在这里可以加入实际的过滤条件
          LowLevelKeyboardProc = 1
      Else
          LowLevelKeyboardProc = CallNextHookEx(m_lHookID, nCode, wParam, lParam)
      End If
End Function
'----------------------------------------------
' 远程线程插入函数
' 功能：向 Winlogon 进程插入远程线程代码，并执行
' 返回：0 表示成功，非 0 为标准的错误代号(此错误
'         代码为远程线程返回的错误)
'----------------------------------------------
Private Function InsertAsmCode() As Long
      Const WINLOGON As String = "Winlogon.exe"
      Dim hProcess As Long      '远端进程句柄
      Dim hPId      As Long       '远端进程ID
      Dim lResult As Long       '一般返回变量
      Dim pToken    As TOKEN_PRIVILEGES
      Dim hToken    As Long
      Dim hRemoteThread As Long
      Dim hRemoteThreadID As Long
      Dim lDbResult(1) As Long
      Dim lRemoteAddr As Long
    
      '------------------------------------
      '取winlogon进程ID
      '------------------------------------
      hPId = GetProcessIdFromName(WINLOGON)
      If hPId = 0 Then
          Debug.Assert False
          Exit Function
      End If
    
      '------------------------------------
      '提升本进程权限，以取得对winlogon进程操作的许可
      '------------------------------------
      lResult = OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY, hToken)
      Debug.Assert lResult
      lResult = LookupPrivilegeValue(0, StrPtr(SE_DEBUG_NAME), pToken.Privileges.pLuid)
      Debug.Assert lResult
      pToken.PrivilegeCount = 1
      pToken.Privileges.Attributes = SE_PRIVILEGE_ENABLED
      lResult = AdjustTokenPrivileges(hToken, False, pToken, Len(pToken), 0, 0)
      Debug.Assert lResult