VB禁止Ctrl+Alt+Del的源码

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's threads
 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_READWRITE   As Long = 4
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 Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
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 Const HC_ACTION = 0
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101
Private Const WM_SYSKEYDOWN = &H104
Private Const WM_SYSKEYUP = &H105
Private Const VK_TAB = &H9
Private Const VK_CONTROL = &H11
Private Const VK_ESCAPE = &H1B

Private Const WH_KEYBOARD_LL = 13
Private Const LLKHF_ALTDOWN = &H20

Private Type KBDLLHOOKSTRUCT
 vkCode As Long
 scanCode As Long
 flags As Long
 time As Long
 dwExtraInfo As Long
End Type

Dim p As KBDLLHOOKSTRUCT

 
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
 Dim fEatKeystroke As Boolean
 
 If (nCode = HC_ACTION) Then
   If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
     CopyMemory p, ByVal lParam, Len(p)
     fEatKeystroke = _
       ((p.vkCode = VK_TAB) And ((p.flags And LLKHF_ALTDOWN) <> 0)) Or _
       ((p.vkCode = VK_ESCAPE) And ((p.flags And LLKHF_ALTDOWN) <> 0)) Or _
       ((p.vkCode = VK_ESCAPE) And ((GetKeyState(VK_CONTROL) And &H8000) <> 0)) Or _
       ((p.vkCode = 91) Or (p.vkCode = 92) Or (p.vkCode = 93) Or (p.vkCode = 95) Or (p.vkCode = 255))
       '左右Win 和徽标键
       End If
 End If
 
 If fEatKeystroke Then
   LowLevelKeyboardProc = 1
 Else
   LowLevelKeyboardProc = CallNextHookEx(0, nCode, wParam, ByVal lParam)
 End If
 
'   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 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
 
 '------------------------------------
 '打开winlogon进程
 '------------------------------------
 hProcess = OpenProcess(PROCESS_ALL_ACCESS, 0, hPId)
 Debug.Assert hProcess
 
 If hProcess Then
   '------------------------------------
   '初始注入代码
   '------------------------------------
   Call InitShellCode
   
   '------------------------------------
   '远端进程分配内存
   '------------------------------------
   lRemoteAddr = VirtualAllocEx(hProcess, 0, SHELL_CODE_LENGTH, MEM_COMMIT, PAGE_READWRITE)
   Debug.Assert lRemoteAddr
   
   '------------------------------------
   '写入 shell 代码
   '------------------------------------
   If lRemoteAddr Then
       InsertAsmCode = WriteProcessMemory(hProcess, lRemoteAddr, mlShellCode(0), SHELL_CODE_LENGTH, 0)
   Else
       Exit Function
   End If
   
   '------------------------------------
   '创建远程线程
   '------------------------------------
   Call CreateRemoteThread(hProcess, 0, 0, lRemoteAddr + SHELL_FUNCOFFSET, 0, 0, hRemoteThread)
   Debug.Assert hRemoteThread
   If hRemoteThread Then Call CloseHandle(hRemoteThread)
   
   '------------------------------------
   '等待远程线程执行完毕并取回结果信息
   '------------------------------------
   Do
       If ReadProcessMemory(hProcess, lRemoteAddr, lDbResult(0), 8, lResult) = 1 Then
         If lDbResult(0) = 0 Then
           InsertAsmCode = lDbResult(1)
           Exit Do
         End If
       Else
         Debug.Assert False
       End If
   Loop
   
   '------------------------------------
   '释放远端进程内存
   '------------------------------------
   Call VirtualFreeEx(hProcess, lRemoteAddr, SHELL_CODE_LENGTH, MEM_DECOMMIT)
 End If
End Function

'============================================
' 初始线程代码
'============================================
Private Function InitShellCode() As Long
 Const kernel32 As String = "kernel32.dll"
 
 Dim hDll   As Long
 '------------------------------------
 '提取注入代码所需的API函数
 '------------------------------------
 hDll = LoadLibrary(StrPtr(kernel32)):           Debug.Assert hDll
 mlShellCode(0) = GetProcAddress(hDll, "LoadLibraryW")
 mlShellCode(1) = GetProcAddress(hDll, "GetProcAddress")
 Call FreeLibrary(hDll)
 
 '---------------------------
 ' 以下代码由 MASM32 产生
 mlShellCode(2) = &H690057
 mlShellCode(3) = &H6C006E
 mlShellCode(4) = &H67006F
 mlShellCode(5) = &H6E006F
 mlShellCode(6) = &H0&
 mlShellCode(7) = &H0&
 mlShellCode(8) = &H0&
 mlShellCode(9) = &HE8530000
 mlShellCode(10) = &H0&
 mlShellCode(11) = &H3CEB815B
 mlShellCode(12) = &HE8004010
 mlShellCode(13) = &H278&
 mlShellCode(14) = &H1018938D
 mlShellCode(15) = &HFF520040
 mlShellCode(16) = &H40103293
 mlShellCode(17) = &H75C00B00
 mlShellCode(18) = &H682C&
 mlShellCode(19) = &H6A0200
 mlShellCode(20) = &H938D006A
 mlShellCode(21) = &H401018
 mlShellCode(22) = &H2A93FF52
 mlShellCode(23) = &HB004010
 mlShellCode(24) = &H6A1A74C0
 mlShellCode(25) = &H42938D00
 mlShellCode(26) = &H52004011
 mlShellCode(27) = &H2E93FF50
 mlShellCode(28) = &HEB004010
 mlShellCode(29) = &H89C03308
 mlShellCode(30) = &H40101483
 mlShellCode(31) = &H89C03300
 mlShellCode(32) = &H40101083
 mlShellCode(33) = &HC35B00
 mlShellCode(34) = &H0&
 mlShellCode(35) = &H0&
 mlShellCode(36) = &H0&
 mlShellCode(37) = &H48000000
 mlShellCode(38) = &H6F006F00
 mlShellCode(39) = &H53006B00
 mlShellCode(40) = &H73007900
 mlShellCode(41) = &H65004B00
 mlShellCode(42) = &H7900&
 mlShellCode(43) = &HEC8B5500
 mlShellCode(44) = &HE853&
 mlShellCode(45) = &H815B0000
 mlShellCode(46) = &H4010C6EB
 mlShellCode(47) = &HC7D8100
 mlShellCode(48) = &H312&
 mlShellCode(49) = &H838D1975
 mlShellCode(50) = &H4010A7
 mlShellCode(51) = &HA393FF50
 mlShellCode(52) = &HB004010
 mlShellCode(53) = &H330874C0
 mlShellCode(54) = &HC95B40C0
 mlShellCode(55) = &HFF0010C2
 mlShellCode(56) = &H75FF1475
 mlShellCode(57) = &HC75FF10
 mlShellCode(58) = &HFF0875FF
 mlShellCode(59) = &H401097B3
 mlShellCode(60) = &H9F93FF00
 mlShellCode(61) = &H5B004010
 mlShellCode(62) = &H10C2C9
 mlShellCode(63) = &H0&
 mlShellCode(64) = &H0&
 mlShellCode(65) = &H0&
 mlShellCode(66) = &H0&
 mlShellCode(67) = &H0&
 mlShellCode(68) = &H0&
 mlShellCode(69) = &H0&
 mlShellCode(70) = &H0&
 mlShellCode(71) = &H410053
 mlShellCode(72) = &H200053
 mlShellCode(73) = &H690077
 mlShellCode(74) = &H64006E
 mlShellCode(75) = &H77006F
 mlShellCode(76) = &H8B550000
 mlShellCode(77) = &HF8C481EC
 mlShellCode(78) = &H53FFFFFD
 mlShellCode(79) = &HE857&
 mlShellCode(80) = &H815B0000
 mlShellCode(81) = &H401152EB
 mlShellCode(82) = &H1046800
 mlShellCode(83) = &H858D0000
 mlShellCode(84) = &HFFFFFDF8
 mlShellCode(85) = &H875FF50
 mlShellCode(86) = &H111893FF
 mlShellCode(87) = &H858D0040
 mlShellCode(88) = &HFFFFFDF8
 mlShellCode(89) = &H2C938D50
 mlShellCode(90) = &H52004011
 mlShellCode(91) = &H111493FF
 mlShellCode(92) = &HC00B0040
 mlShellCode(93) = &H75686275
 mlShellCode(94) = &H6A000000
 mlShellCode(95) = &H2893FF00
 mlShellCode(96) = &HB004011
 mlShellCode(97) = &H8B4374C0
 mlShellCode(98) = &H75B960F8
 mlShellCode(99) = &H8D000000
 mlShellCode(100) = &H401097B3
 mlShellCode(101) = &H61A4F300
 mlShellCode(102) = &H75FFFC6A
 mlShellCode(103) = &H1C93FF08
 mlShellCode(104) = &H89004011
 mlShellCode(105) = &H18938D07
 mlShellCode(106) = &H52004010
 mlShellCode(107) = &H111093FF
 mlShellCode(108) = &HD78B0040
 mlShellCode(109) = &H26C281
 mlShellCode(110) = &H6A520000
 mlShellCode(111) = &H875FFFC
 mlShellCode(112) = &H112093FF
 mlShellCode(113) = &HC0330040
 mlShellCode(114) = &H93FF06EB
 mlShellCode(115) = &H401124
 mlShellCode(116) = &H10148389
 mlShellCode(117) = &H3EB0040
 mlShellCode(118) = &H5F40C033
 mlShellCode(119) = &H8C2C95B
 mlShellCode(120) = &H65006B00
 mlShellCode(121) = &H6E007200
 mlShellCode(122) = &H6C006500
 mlShellCode(123) = &H32003300
 mlShellCode(124) = &H64002E00
 mlShellCode(125) = &H6C006C00
 mlShellCode(126) = &H75000000
 mlShellCode(127) = &H65007300
 mlShellCode(128) = &H33007200
 mlShellCode(129) = &H2E003200
 mlShellCode(130) = &H6C006400
 mlShellCode(131) = &H6C00&
 mlShellCode(132) = &H6F6C4700
 mlShellCode(133) = &H466C6162
 mlShellCode(134) = &H41646E69
 mlShellCode(135) = &H576D6F74
 mlShellCode(136) = &H6F6C4700
 mlShellCode(137) = &H416C6162
 mlShellCode(138) = &H74416464
 mlShellCode(139) = &H576D6F
 mlShellCode(140) = &H7274736C
 mlShellCode(141) = &H69706D63
 mlShellCode(142) = &H6C470057
 mlShellCode(143) = &H6C61626F
 mlShellCode(144) = &H6F6C6C41
 mlShellCode(145) = &H65470063
 mlShellCode(146) = &H73614C74
 mlShellCode(147) = &H72724574
 mlShellCode(148) = &H4F00726F
 mlShellCode(149) = &H446E6570
 mlShellCode(150) = &H746B7365
 mlShellCode(151) = &H57706F
 mlShellCode(152) = &H6D756E45
 mlShellCode(153) = &H6B736544
 mlShellCode(154) = &H57706F74
 mlShellCode(155) = &H6F646E69
 mlShellCode(156) = &H47007377
 mlShellCode(157) = &H69577465
 mlShellCode(158) = &H776F646E
 mlShellCode(159) = &H74786554
 mlShellCode(160) = &H65470057
 mlShellCode(161) = &H6E695774
 mlShellCode(162) = &H4C776F64
 mlShellCode(163) = &H57676E6F
 mlShellCode(164) = &H74655300
 mlShellCode(165) = &H646E6957
 mlShellCode(166) = &H6F4C776F
 mlShellCode(167) = &H57676E
 mlShellCode(168) = &H6C6C6143
 mlShellCode(169) = &H646E6957
 mlShellCode(170) = &H7250776F
 mlShellCode(171) = &H57636F
 mlShellCode(172) = &HE860&
 mlShellCode(173) = &H815B0000
 mlShellCode(174) = &H4012C6EB
 mlShellCode(175) = &HF1838D00
 mlShellCode(176) = &H50004011
 mlShellCode(177) = &H101093FF
 mlShellCode(178) = &HF88B0040
 mlShellCode(179) = &H124A838D
 mlShellCode(180) = &H57500040
 mlShellCode(181) = &H101493FF
 mlShellCode(182) = &H83890040
 mlShellCode(183) = &H401128
 mlShellCode(184) = &H1256838D
 mlShellCode(185) = &H57500040
 mlShellCode(186) = &H101493FF
 mlShellCode(187) = &H83890040
 mlShellCode(188) = &H401124
 mlShellCode(189) = &H1231838D
 mlShellCode(190) = &H57500040
 mlShellCode(191) = &H101493FF
 mlShellCode(192) = &H83890040
 mlShellCode(193) = &H401110
 mlShellCode(194) = &H1221838D
 mlShellCode(195) = &H57500040
 mlShellCode(196) = &H101493FF
 mlShellCode(197) = &H83890040
 mlShellCode(198) = &H4010A3
 mlShellCode(199) = &H10328389
 mlShellCode(200) = &H838D0040
 mlShellCode(201) = &H401240
 mlShellCode(202) = &H93FF5750
 mlShellCode(203) = &H401014
 mlShellCode(204) = &H11148389
 mlShellCode(205) = &H838D0040
 mlShellCode(206) = &H40120B
 mlShellCode(207) = &H1093FF50
 mlShellCode(208) = &H8B004010
 mlShellCode(209) = &H63838DF8
 mlShellCode(210) = &H50004012
 mlShellCode(211) = &H1493FF57
 mlShellCode(212) = &H89004010
 mlShellCode(213) = &H40102A83
 mlShellCode(214) = &H70838D00
 mlShellCode(215) = &H50004012
 mlShellCode(216) = &H1493FF57
 mlShellCode(217) = &H89004010
 mlShellCode(218) = &H40102E83
 mlShellCode(219) = &H83838D00
 mlShellCode(220) = &H50004012
 mlShellCode(221) = &H1493FF57
 mlShellCode(222) = &H89004010
 mlShellCode(223) = &H40111883
 mlShellCode(224) = &H92838D00
 mlShellCode(225) = &H50004012
 mlShellCode(226) = &H1493FF57
 mlShellCode(227) = &H89004010
 mlShellCode(228) = &H40111C83
 mlShellCode(229) = &HA1838D00
 mlShellCode(230) = &H50004012
 mlShellCode(231) = &H1493FF57
 mlShellCode(232) = &H89004010
 mlShellCode(233) = &H40112083
 mlShellCode(234) = &HB0838D00
 mlShellCode(235) = &H50004012
 mlShellCode(236) = &H1493FF57
 mlShellCode(237) = &H89004010
 mlShellCode(238) = &H40109F83
 mlShellCode(239) = &H90C36100
End Function

'-------------------------------------------
' 根据可执行文件的名称取回进程ID
' 参数：可执行文件名(含扩展名)
' 返回：进程ID。0表示无
'-------------------------------------------
Private Function GetProcessIdFromName(ByVal sName As String) As Long
 Dim hSnapshot   As Long
 Dim lpPE     As PROCESSENTRY32W
 Dim lpWinlogon As Long
 
 hSnapshot = CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0)
 Debug.Assert hSnapshot
 lpPE.dwSize = Len(lpPE)
 If Process32First(hSnapshot, lpPE) Then
   lpWinlogon = StrPtr(sName)
   Do
       If Process32Next(hSnapshot, lpPE) = 0 Then Exit Do
       If lstrcmpi(lpPE.szExeFile(1), lpWinlogon) = 0 Then
         GetProcessIdFromName = lpPE.h32ProcessID
         Exit Do
       End If
   Loop
 End If
 Call CloseHandle(hSnapshot)
End Function