WinXp关机程序
'这个程序比较麻烦
变暗是采用以前的98模块，xp存在问题，按个窗口键或热键呼出QQ,变暗的效果就毁了。任务栏也会自己redraw
'所以处理了窗口更新,Hook处理了窗口键
'由于标签的热键是没效果的,只好窗体处理，但牺牲了部分
'窗体部分
Option Explicit
''''''''关机
Private Declare Function RtlAdjustPrivilege& Lib "ntdll" (ByVal Privilege&, ByVal Newvalue&, ByVal NewThread&, Oldvalue&)
Private Declare Function NtShutdownSystem& Lib "ntdll" (ByVal ShutdownAction&)
Private Const SE_SHUTDOWN_PRIVILEGE& = 19
Private Const SHUTDOWN& = 0
''''''''' Mouse
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'这个函数能为窗口指定一个新位置和状态。它也可改变窗口在内部窗口列表中的位置。
'该函数与DeferWindowPos函数相似，只是它的作用是立即表现出来的（在vb里使用：针对vb窗体，如它们在win32下屏蔽或最小化，则需重设最顶部状态。
'如有必要，请用一个子类处理模块来重设最顶部状态
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 Const HWND_TOPMOST = -1 '将窗口置于列表顶部，并位于任何最顶部窗口的前面
Private Const HWND_NOTOPMOST = -2 '将窗口置于列表顶部，并位于任何最顶部窗口的后面
Private Const SWP_NOSIZE = &H1 '保持当前大小（cx和cy被忽略）
Private Const SWP_NOMOVE = &H2 '保持当前位置（cx和cy被忽略）
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const GCL_HCURSOR = (-12)
Dim mhBaseCursor As Long
Dim mhAniCursor As Long
''''''''''''' 变黑
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Private bybits(1 To 16) As Byte
Private hBitmap As Long, hBrush As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Sub Form_Activate()
LockWindow
End Sub
Private Sub Form_Initialize()
Picture1(1).Picture = Me.Picture '备份背景，因为启动时候会变黑
Me.KeyPreview = True
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = vbAltMask And KeyCode = vbKeyL Then Image1_Click '为了这里的热键,牺牲了标签控件的下拉线
If Shift = vbAltMask And KeyCode = vbKeyU Then Image2_Click
If Shift = vbAltMask And KeyCode = vbKeyR Then Image3_Click
If KeyCode = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Paint()
OnTop = True
End Sub
Private Sub Image1_Click()
ExitWindow EWX_LOGOFF
End Sub
Private Sub Image2_Click()
'RtlAdjustPrivilege SE_SHUTDOWN_PRIVILEGE, 1, 0, 0
'NtShutdownSystem ShutDown
ExitWindow WE_POWEROFF
End Sub
Private Sub Image3_Click()
ExitWindow EWX_REBOOT
End Sub
Private Sub LockWindow()
Dim ClassName As String
Dim StartWindow As Long
Dim ary
Dim i As Long
Dim rop As Long, res As Long
Dim hdc5 As Long, width5 As Long, height5 As Long
ary = Array(&H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0)
For i = 1 To 16
bybits(i) = ary(i - 1)
Next i
hBitmap = CreateBitmap(8, 8, 1, 1, bybits(1))
hBrush = CreatePatternBrush(hBitmap)
Picture1(0).ForeColor = RGB(0, 0, 0)
Picture1(0).BackColor = RGB(255, 255, 255)
Picture1(0).ScaleMode = 3
'如果只要让Picture1有效果将底下三行unMark取代 hdc5, width5, height5三个值
'hdc5 = Picture1.hdc
'width5 = Picture1.ScaleWidth
'height5 = Picture1.ScaleHeight
'底下三行设定整个萤幕都暗下来
hdc5 = GetDC(0)
width5 = Screen.Width / Screen.TwipsPerPixelX
height5 = Screen.Height / Screen.TwipsPerPixelY
rop = &HA000C9 '与原图做and运算
Call SelectObject(hdc5, hBrush)
res = PatBlt(hdc5, 0, 0, width5, height5, rop)
Call DeleteObject(hBrush)
'如果只暗picture1则底下这一行要mark起来
res = ReleaseDC(0, hdc5)
Me.Picture = Picture1(1).Picture
Call SetCursorPos(425, 380) '设置鼠标坐标,参数由SpyTools提供
LockWindowUpdate GetDesktopWindow '避免任务栏更新
'钩子的安装与释放：
'使用API函数SetWindowsHookEx()把一个应用程序定义的钩子子程安装到钩子链表中。SetWindowsHookEx函数总是在Hook链的开头安装Hook子程。
'当指定类型的Hook监视的事件发生时，系统就调用与这个Hook关联的Hook链的开头的Hook子程。每一个Hook链中的Hook子程都决定是否把这个事件传递到下一个Hook子程。
'Hook子程传递事件到下一个Hook子程需要调用CallNextHookEx函数。
'HHOOK SetWindowsHookEx(
' int idHook, // 钩子的类型，即它处理的消息类型
' HOOKPROC lpfn, // 钩子子程的地址指针。如果dwThreadId参数为0
' // 或是一个由别的进程创建的线程的标识，
' // lpfn必须指向DLL中的钩子子程。
' // 除此以外，lpfn可以指向当前进程的一段钩子子程代码。
' // 钩子函数的入口地址，当钩子钩到任何消息后便调用这个函数。
' HINSTANCE hMod, // 应用程序实例的句柄。标识包含lpfn所指的子程的
'DLL?
' // 如果dwThreadId 标识当前进程创建的一个线程，
' // 而且子程代码位于当前进程，hMod必须为NULL。
' // 可以很简单的设定其为本应用程序的实例句柄。
' DWORD dwThreadId // 与安装的钩子子程相关联的线程的标识符。
' // 如果为0，钩子子程与所有的线程关联，即为全局钩子。
' );
'
' 函数成功则返回钩子子程的句柄，失败返回NULL。
' 以上所说的钩子子程与线程相关联是指在一钩子链表中发给该线程的消息同时发送给钩子子程，且被钩子子程先处理。
' idHook值为它处理的消息类型；lpfn值为钩子子程序的地址指针。如果dwThreadId参数为0或是一个由别的进程创建的线程的标识，
' lpfn必须指向DLL中的钩子子程。除此以外，lpfn可以指向当前进程的一段钩子子程代码。hMod值为应用程序的句柄，
' 标识包含lpfn所指的子程的DLL。如果dwThreadId标识当前进程创建的一个线程，而且子程代码位于当前进程，hMod必须为0。
' dwThreadId值为与安装的钩子子程相关联的线程的标识符，如果为0，钩子子程与所有的线程关联。钩子安装成功则返回钩子子程的句柄，失败返回0。
'当在 Visual Basic 开发环境中使用工程进行工作时，App.hInstance 属性返回 Visual Basic 实例的实例句柄。
hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0) '加载钩子
End Sub
Private Sub Timer2_Timer() '即时锁定窗体，避免Ctrl+Alt+Del
Dim lResult As Long, RT_FormArea As RECT
mhBaseCursor = GetClassLong((Me.hWnd), GCL_HCURSOR)
lResult = SetClassLong((Me.hWnd), GCL_HCURSOR, mhAniCursor)
lResult = GetWindowRect((Me.hWnd), RT_FormArea)
lResult = ClipCursor(RT_FormArea)
End Sub
Private Sub XPButton1_Click()
Dim aa As Long
'如果只暗picture1则底下这一行要unMark起来
'Picture1.Refresh
'如果只暗picture1则底下这一行要mark起来
aa = InvalidateRect(0, 0, 1)
Unload Me
End Sub
Property Let OnTop(Setting As Boolean) '总在最前
SetWindowPos Me.hWnd, IIf(Setting, HWND_TOPMOST, HWND_NOTOPMOST), 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Property
Private Sub UnlockWindow()
Dim pOld As Boolean
Dim lResult As Long
Dim RT_ScreenArea As RECT
With RT_ScreenArea
.Top = 0
.Left = 0
.Bottom = Screen.Height / Screen.TwipsPerPixelX
.Right = Screen.Width / Screen.TwipsPerPixelY
End With
lResult = ClipCursor(RT_ScreenArea)
lResult = SetClassLong((Me.hWnd), GCL_HCURSOR, mhBaseCursor) '解除鼠标范围限制
lResult = DestroyCursor(mhAniCursor)
InvalidateRect 0, 0, 1
If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd '卸载钩子
LockWindowUpdate 0 '释放桌面更新
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnlockWindow
Set frmMian = Nothing
End Sub
变暗是采用以前的98模块，xp存在问题，按个窗口键或热键呼出QQ,变暗的效果就毁了。任务栏也会自己redraw
'所以处理了窗口更新,Hook处理了窗口键
'由于标签的热键是没效果的,只好窗体处理，但牺牲了部分
'窗体部分
Option Explicit
''''''''关机
Private Declare Function RtlAdjustPrivilege& Lib "ntdll" (ByVal Privilege&, ByVal Newvalue&, ByVal NewThread&, Oldvalue&)
Private Declare Function NtShutdownSystem& Lib "ntdll" (ByVal ShutdownAction&)
Private Const SE_SHUTDOWN_PRIVILEGE& = 19
Private Const SHUTDOWN& = 0
''''''''' Mouse
Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
'这个函数能为窗口指定一个新位置和状态。它也可改变窗口在内部窗口列表中的位置。
'该函数与DeferWindowPos函数相似，只是它的作用是立即表现出来的（在vb里使用：针对vb窗体，如它们在win32下屏蔽或最小化，则需重设最顶部状态。
'如有必要，请用一个子类处理模块来重设最顶部状态
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 Const HWND_TOPMOST = -1 '将窗口置于列表顶部，并位于任何最顶部窗口的前面
Private Const HWND_NOTOPMOST = -2 '将窗口置于列表顶部，并位于任何最顶部窗口的后面
Private Const SWP_NOSIZE = &H1 '保持当前大小（cx和cy被忽略）
Private Const SWP_NOMOVE = &H2 '保持当前位置（cx和cy被忽略）
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Private Declare Function DestroyCursor Lib "user32" (ByVal hCursor As Long) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRect As RECT) As Long
Private Declare Function SetClassLong Lib "user32" Alias "SetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetClassLong Lib "user32" Alias "GetClassLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
Private Const GCL_HCURSOR = (-12)
Dim mhBaseCursor As Long
Dim mhAniCursor As Long
''''''''''''' 变黑
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As Long, ByVal hDC As Long) As Long
Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function CreateBitmap Lib "gdi32" (ByVal nWidth As Long, ByVal nHeight As Long, ByVal nPlanes As Long, ByVal nBitCount As Long, lpBits As Any) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function InvalidateRect Lib "user32" (ByVal hWnd As Long, ByVal lpRect As Long, ByVal bErase As Long) As Long
Private bybits(1 To 16) As Byte
Private hBitmap As Long, hBrush As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Sub Form_Activate()
LockWindow
End Sub
Private Sub Form_Initialize()
Picture1(1).Picture = Me.Picture '备份背景，因为启动时候会变黑
Me.KeyPreview = True
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift = vbAltMask And KeyCode = vbKeyL Then Image1_Click '为了这里的热键,牺牲了标签控件的下拉线
If Shift = vbAltMask And KeyCode = vbKeyU Then Image2_Click
If Shift = vbAltMask And KeyCode = vbKeyR Then Image3_Click
If KeyCode = vbKeyEscape Then Unload Me
End Sub
Private Sub Form_Paint()
OnTop = True
End Sub
Private Sub Image1_Click()
ExitWindow EWX_LOGOFF
End Sub
Private Sub Image2_Click()
'RtlAdjustPrivilege SE_SHUTDOWN_PRIVILEGE, 1, 0, 0
'NtShutdownSystem ShutDown
ExitWindow WE_POWEROFF
End Sub
Private Sub Image3_Click()
ExitWindow EWX_REBOOT
End Sub
Private Sub LockWindow()
Dim ClassName As String
Dim StartWindow As Long
Dim ary
Dim i As Long
Dim rop As Long, res As Long
Dim hdc5 As Long, width5 As Long, height5 As Long
ary = Array(&H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0, &H55, &H0, &HAA, &H0)
For i = 1 To 16
bybits(i) = ary(i - 1)
Next i
hBitmap = CreateBitmap(8, 8, 1, 1, bybits(1))
hBrush = CreatePatternBrush(hBitmap)
Picture1(0).ForeColor = RGB(0, 0, 0)
Picture1(0).BackColor = RGB(255, 255, 255)
Picture1(0).ScaleMode = 3
'如果只要让Picture1有效果将底下三行unMark取代 hdc5, width5, height5三个值
'hdc5 = Picture1.hdc
'width5 = Picture1.ScaleWidth
'height5 = Picture1.ScaleHeight
'底下三行设定整个萤幕都暗下来
hdc5 = GetDC(0)
width5 = Screen.Width / Screen.TwipsPerPixelX
height5 = Screen.Height / Screen.TwipsPerPixelY
rop = &HA000C9 '与原图做and运算
Call SelectObject(hdc5, hBrush)
res = PatBlt(hdc5, 0, 0, width5, height5, rop)
Call DeleteObject(hBrush)
'如果只暗picture1则底下这一行要mark起来
res = ReleaseDC(0, hdc5)
Me.Picture = Picture1(1).Picture
Call SetCursorPos(425, 380) '设置鼠标坐标,参数由SpyTools提供
LockWindowUpdate GetDesktopWindow '避免任务栏更新
'钩子的安装与释放：
'使用API函数SetWindowsHookEx()把一个应用程序定义的钩子子程安装到钩子链表中。SetWindowsHookEx函数总是在Hook链的开头安装Hook子程。
'当指定类型的Hook监视的事件发生时，系统就调用与这个Hook关联的Hook链的开头的Hook子程。每一个Hook链中的Hook子程都决定是否把这个事件传递到下一个Hook子程。
'Hook子程传递事件到下一个Hook子程需要调用CallNextHookEx函数。
'HHOOK SetWindowsHookEx(
' int idHook, // 钩子的类型，即它处理的消息类型
' HOOKPROC lpfn, // 钩子子程的地址指针。如果dwThreadId参数为0
' // 或是一个由别的进程创建的线程的标识，
' // lpfn必须指向DLL中的钩子子程。
' // 除此以外，lpfn可以指向当前进程的一段钩子子程代码。
' // 钩子函数的入口地址，当钩子钩到任何消息后便调用这个函数。
' HINSTANCE hMod, // 应用程序实例的句柄。标识包含lpfn所指的子程的
'DLL?
' // 如果dwThreadId 标识当前进程创建的一个线程，
' // 而且子程代码位于当前进程，hMod必须为NULL。
' // 可以很简单的设定其为本应用程序的实例句柄。
' DWORD dwThreadId // 与安装的钩子子程相关联的线程的标识符。
' // 如果为0，钩子子程与所有的线程关联，即为全局钩子。
' );
'
' 函数成功则返回钩子子程的句柄，失败返回NULL。
' 以上所说的钩子子程与线程相关联是指在一钩子链表中发给该线程的消息同时发送给钩子子程，且被钩子子程先处理。
' idHook值为它处理的消息类型；lpfn值为钩子子程序的地址指针。如果dwThreadId参数为0或是一个由别的进程创建的线程的标识，
' lpfn必须指向DLL中的钩子子程。除此以外，lpfn可以指向当前进程的一段钩子子程代码。hMod值为应用程序的句柄，
' 标识包含lpfn所指的子程的DLL。如果dwThreadId标识当前进程创建的一个线程，而且子程代码位于当前进程，hMod必须为0。
' dwThreadId值为与安装的钩子子程相关联的线程的标识符，如果为0，钩子子程与所有的线程关联。钩子安装成功则返回钩子子程的句柄，失败返回0。
'当在 Visual Basic 开发环境中使用工程进行工作时，App.hInstance 属性返回 Visual Basic 实例的实例句柄。
hhkLowLevelKybd = SetWindowsHookEx(WH_KEYBOARD_LL, AddressOf LowLevelKeyboardProc, App.hInstance, 0) '加载钩子
End Sub
Private Sub Timer2_Timer() '即时锁定窗体，避免Ctrl+Alt+Del
Dim lResult As Long, RT_FormArea As RECT
mhBaseCursor = GetClassLong((Me.hWnd), GCL_HCURSOR)
lResult = SetClassLong((Me.hWnd), GCL_HCURSOR, mhAniCursor)
lResult = GetWindowRect((Me.hWnd), RT_FormArea)
lResult = ClipCursor(RT_FormArea)
End Sub
Private Sub XPButton1_Click()
Dim aa As Long
'如果只暗picture1则底下这一行要unMark起来
'Picture1.Refresh
'如果只暗picture1则底下这一行要mark起来
aa = InvalidateRect(0, 0, 1)
Unload Me
End Sub
Property Let OnTop(Setting As Boolean) '总在最前
SetWindowPos Me.hWnd, IIf(Setting, HWND_TOPMOST, HWND_NOTOPMOST), 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE
End Property
Private Sub UnlockWindow()
Dim pOld As Boolean
Dim lResult As Long
Dim RT_ScreenArea As RECT
With RT_ScreenArea
.Top = 0
.Left = 0
.Bottom = Screen.Height / Screen.TwipsPerPixelX
.Right = Screen.Width / Screen.TwipsPerPixelY
End With
lResult = ClipCursor(RT_ScreenArea)
lResult = SetClassLong((Me.hWnd), GCL_HCURSOR, mhBaseCursor) '解除鼠标范围限制
lResult = DestroyCursor(mhAniCursor)
InvalidateRect 0, 0, 1
If hhkLowLevelKybd <> 0 Then UnhookWindowsHookEx hhkLowLevelKybd '卸载钩子
LockWindowUpdate 0 '释放桌面更新
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnlockWindow
Set frmMian = Nothing
End Sub
#####################################################################
'hook
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
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
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) 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 LLKHF_ALTDOWN = &H20
Public Const WH_KEYBOARD_LL = 13
Private Type KBDLLHOOKSTRUCT '这个是低级键盘钩子的索引值
vkCode As Long '虚拟按键码(1--254)
scanCode As Long '硬件按键扫描码
flags As Long '键按下：128 抬起：0
time As Long '消息时间戳间
dwExtraInfo As Long '额外信息
End Type
Public Enum VirtualKey
VK_LBUTTON = &H1
VK_RBUTTON = &H2
VK_CTRLBREAK = &H3
VK_MBUTTON = &H4
VK_BACKSPACE = &H8
VK_TAB = &H9
VK_ENTER = &HD
VK_SHIFT = &H10
VK_CONTROL = &H11
VK_ALT = &H12
VK_PAUSE = &H13
VK_CAPSLOCK = &H14
VK_ESCAPE = &H1B
VK_SPACE = &H20
VK_PAGEUP = &H21
VK_PAGEDOWN = &H22
VK_END = &H23
VK_HOME = &H24
VK_LEFT = &H25
VK_UP = &H26
VK_RIGHT = &H27
VK_DOWN = &H28
VK_PRINTSCREEN = &H2C
VK_INSERT = &H2D
VK_DELETE = &H2E
VK_0 = &H30
VK_1 = &H31
VK_2 = &H32
VK_3 = &H33
VK_4 = &H34
VK_5 = &H35
VK_6 = &H36
VK_7 = &H37
VK_8 = &H38
VK_9 = &H39
VK_A = &H41
VK_B = &H42
VK_C = &H43
VK_D = &H44
VK_E = &H45
VK_F = &H46
VK_G = &H47
VK_H = &H48
VK_I = &H49
VK_J = &H4A
VK_K = &H4B
VK_L = &H4C
VK_M = &H4D
vk_n = &H4E
VK_O = &H4F
VK_P = &H50
VK_Q = &H51
VK_R = &H52
VK_S = &H53
VK_T = &H54
VK_U = &H55
VK_V = &H56
VK_W = &H57
VK_X = &H58
VK_Y = &H59
VK_Z = &H5A
VK_LWINDOWS = &H5B
VK_RWINDOWS = &H5C
VK_APPSPOPUP = &H5D
VK_NUMPAD_0 = &H60
VK_NUMPAD_1 = &H61
VK_NUMPAD_2 = &H62
VK_NUMPAD_3 = &H63
VK_NUMPAD_4 = &H64
VK_NUMPAD_5 = &H65
VK_NUMPAD_6 = &H66
VK_NUMPAD_7 = &H67
VK_NUMPAD_8 = &H68
VK_NUMPAD_9 = &H69
VK_NUMPAD_MULTIPLY = &H6A
VK_NUMPAD_ADD = &H6B
VK_NUMPAD_PLUS = &H6B
VK_NUMPAD_SUBTRACT = &H6D
VK_NUMPAD_MINUS = &H6D
VK_NUMPAD_MOINS = &H6D
VK_NUMPAD_DECIMAL = &H6E
VK_NUMPAD_POINT = &H6E
VK_NUMPAD_DIVIDE = &H6F
VK_F1 = &H70
VK_F2 = &H71
VK_F3 = &H72
VK_F4 = &H73
VK_F5 = &H74
VK_F6 = &H75
VK_F7 = &H76
VK_F8 = &H77
VK_F9 = &H78
VK_F10 = &H79
VK_F11 = &H7A
VK_F12 = &H7B
VK_NUMLOCK = &H90
VK_SCROLL = &H91
VK_LSHIFT = &HA0
VK_RSHIFT = &HA1
VK_LCONTROL = &HA2
VK_RCONTROL = &HA3
VK_LALT = &HA4
VK_RALT = &HA5
VK_POINTVIRGULE = &HBA
VK_ADD = &HBB
VK_PLUS = &HBB
VK_EQUAL = &HBB
VK_VIRGULE = &HBC
VK_SUBTRACT = &HBD
VK_MINUS = &HBD
VK_MOINS = &HBD
VK_UNDERLINE = &HBD
VK_POINT = &HBE
VK_SLASH = &HBF
VK_TILDE = &HC0
VK_LEFTBRACKET = &HDB
VK_BACKSLASH = &HDC
VK_RIGHTBRACKET = &HDD
VK_QUOTE = &HDE
VK_APOSTROPHE = &HDE
End Enum
Dim KBDLLHOOKSTRUCT As KBDLLHOOKSTRUCT
Public hhkLowLevelKybd As Long '安装的钩子句柄
Public 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 'nCode值为HC_ACTION时表示WParam和LParam参数包涵了按键消息
'按下键会产生WM_KEYDOWN或WM_SYSKEYDOWN消息，然后会被放置在当前键盘聚焦的窗口所在线程的消息队列中。同样释放按键也会产生消息，这个消息将会是WM_KEYUP或者WM_SYSKEYUP。
'系统中系统按键与非系统按键是截然不同的，系统按键产生系统按键消息：WM_SYSKEYDOWN、WM_SYSKEYUP，而非系统按键产生非系统按键消息：WM_KEYDOWN与WM_KEYUP。
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
'CopyMemory的历史非常特殊，它的真名并非叫CopyMemory。看看CopyMemory的声明，它是定义在Kernel32.dll中的RtlMoveMemory这个API，
'32位C函数库中的memcpy就是这个API的封装，如MSDN文档中所言，它的功能是将从Source指针所指处开始的长度为Length的内存拷贝到Destination所指的内存处。
'它不会管我们的程序有没有读写该内存所应有的权限，一但它想读写被系统所保护的内存时，
'VOID CopyMemory(
' PVOID Destination, // pointer to address of copy destination
' CONST VOID *Source, // pointer to address of block to copy
' DWORD Length // size, in bytes, of block to copy
');
'Parameters
'Destination
'Pointer to the starting address of the copied block's destination.
'Source
'Pointer to the starting address of the block of memory to copy.
'Length
'Specifies the size, in bytes, of the block of memory to copy.
CopyMemory KBDLLHOOKSTRUCT, ByVal lParam, Len(KBDLLHOOKSTRUCT)
fEatKeystroke = _
(KBDLLHOOKSTRUCT.vkCode = VK_LWINDOWS) _
Or (KBDLLHOOKSTRUCT.vkCode = VK_RWINDOWS) Or (KBDLLHOOKSTRUCT.vkCode = VK_APPSPOPUP)
'TAB+ALT
'Esc+ALT
'Alt+Any(Alt+F4)
'Esc+Ctrl
'左右Win 和徽标键
End If
End If
If fEatKeystroke Then
LowLevelKeyboardProc = 1 '吃掉消息
Else
LowLevelKeyboardProc = CallNextHookEx(hhkLowLevelKybd, nCode, wParam, ByVal lParam) '如果消息要被处理，则传0或安装的钩子句柄
End If
End Function
Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long
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
Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) 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 LLKHF_ALTDOWN = &H20
Public Const WH_KEYBOARD_LL = 13
Private Type KBDLLHOOKSTRUCT '这个是低级键盘钩子的索引值
vkCode As Long '虚拟按键码(1--254)
scanCode As Long '硬件按键扫描码
flags As Long '键按下：128 抬起：0
time As Long '消息时间戳间
dwExtraInfo As Long '额外信息
End Type
Public Enum VirtualKey
VK_LBUTTON = &H1
VK_RBUTTON = &H2
VK_CTRLBREAK = &H3
VK_MBUTTON = &H4
VK_BACKSPACE = &H8
VK_TAB = &H9
VK_ENTER = &HD
VK_SHIFT = &H10
VK_CONTROL = &H11
VK_ALT = &H12
VK_PAUSE = &H13
VK_CAPSLOCK = &H14
VK_ESCAPE = &H1B
VK_SPACE = &H20
VK_PAGEUP = &H21
VK_PAGEDOWN = &H22
VK_END = &H23
VK_HOME = &H24
VK_LEFT = &H25
VK_UP = &H26
VK_RIGHT = &H27
VK_DOWN = &H28
VK_PRINTSCREEN = &H2C
VK_INSERT = &H2D
VK_DELETE = &H2E
VK_0 = &H30
VK_1 = &H31
VK_2 = &H32
VK_3 = &H33
VK_4 = &H34
VK_5 = &H35
VK_6 = &H36
VK_7 = &H37
VK_8 = &H38
VK_9 = &H39
VK_A = &H41
VK_B = &H42
VK_C = &H43
VK_D = &H44
VK_E = &H45
VK_F = &H46
VK_G = &H47
VK_H = &H48
VK_I = &H49
VK_J = &H4A
VK_K = &H4B
VK_L = &H4C
VK_M = &H4D
vk_n = &H4E
VK_O = &H4F
VK_P = &H50
VK_Q = &H51
VK_R = &H52
VK_S = &H53
VK_T = &H54
VK_U = &H55
VK_V = &H56
VK_W = &H57
VK_X = &H58
VK_Y = &H59
VK_Z = &H5A
VK_LWINDOWS = &H5B
VK_RWINDOWS = &H5C
VK_APPSPOPUP = &H5D
VK_NUMPAD_0 = &H60
VK_NUMPAD_1 = &H61
VK_NUMPAD_2 = &H62
VK_NUMPAD_3 = &H63
VK_NUMPAD_4 = &H64
VK_NUMPAD_5 = &H65
VK_NUMPAD_6 = &H66
VK_NUMPAD_7 = &H67
VK_NUMPAD_8 = &H68
VK_NUMPAD_9 = &H69
VK_NUMPAD_MULTIPLY = &H6A
VK_NUMPAD_ADD = &H6B
VK_NUMPAD_PLUS = &H6B
VK_NUMPAD_SUBTRACT = &H6D
VK_NUMPAD_MINUS = &H6D
VK_NUMPAD_MOINS = &H6D
VK_NUMPAD_DECIMAL = &H6E
VK_NUMPAD_POINT = &H6E
VK_NUMPAD_DIVIDE = &H6F
VK_F1 = &H70
VK_F2 = &H71
VK_F3 = &H72
VK_F4 = &H73
VK_F5 = &H74
VK_F6 = &H75
VK_F7 = &H76
VK_F8 = &H77
VK_F9 = &H78
VK_F10 = &H79
VK_F11 = &H7A
VK_F12 = &H7B
VK_NUMLOCK = &H90
VK_SCROLL = &H91
VK_LSHIFT = &HA0
VK_RSHIFT = &HA1
VK_LCONTROL = &HA2
VK_RCONTROL = &HA3
VK_LALT = &HA4
VK_RALT = &HA5
VK_POINTVIRGULE = &HBA
VK_ADD = &HBB
VK_PLUS = &HBB
VK_EQUAL = &HBB
VK_VIRGULE = &HBC
VK_SUBTRACT = &HBD
VK_MINUS = &HBD
VK_MOINS = &HBD
VK_UNDERLINE = &HBD
VK_POINT = &HBE
VK_SLASH = &HBF
VK_TILDE = &HC0
VK_LEFTBRACKET = &HDB
VK_BACKSLASH = &HDC
VK_RIGHTBRACKET = &HDD
VK_QUOTE = &HDE
VK_APOSTROPHE = &HDE
End Enum
Dim KBDLLHOOKSTRUCT As KBDLLHOOKSTRUCT
Public hhkLowLevelKybd As Long '安装的钩子句柄
Public 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 'nCode值为HC_ACTION时表示WParam和LParam参数包涵了按键消息
'按下键会产生WM_KEYDOWN或WM_SYSKEYDOWN消息，然后会被放置在当前键盘聚焦的窗口所在线程的消息队列中。同样释放按键也会产生消息，这个消息将会是WM_KEYUP或者WM_SYSKEYUP。
'系统中系统按键与非系统按键是截然不同的，系统按键产生系统按键消息：WM_SYSKEYDOWN、WM_SYSKEYUP，而非系统按键产生非系统按键消息：WM_KEYDOWN与WM_KEYUP。
If wParam = WM_KEYDOWN Or wParam = WM_SYSKEYDOWN Or wParam = WM_KEYUP Or wParam = WM_SYSKEYUP Then
'CopyMemory的历史非常特殊，它的真名并非叫CopyMemory。看看CopyMemory的声明，它是定义在Kernel32.dll中的RtlMoveMemory这个API，
'32位C函数库中的memcpy就是这个API的封装，如MSDN文档中所言，它的功能是将从Source指针所指处开始的长度为Length的内存拷贝到Destination所指的内存处。
'它不会管我们的程序有没有读写该内存所应有的权限，一但它想读写被系统所保护的内存时，
'VOID CopyMemory(
' PVOID Destination, // pointer to address of copy destination
' CONST VOID *Source, // pointer to address of block to copy
' DWORD Length // size, in bytes, of block to copy
');
'Parameters
'Destination
'Pointer to the starting address of the copied block's destination.
'Source
'Pointer to the starting address of the block of memory to copy.
'Length
'Specifies the size, in bytes, of the block of memory to copy.
CopyMemory KBDLLHOOKSTRUCT, ByVal lParam, Len(KBDLLHOOKSTRUCT)
fEatKeystroke = _
(KBDLLHOOKSTRUCT.vkCode = VK_LWINDOWS) _
Or (KBDLLHOOKSTRUCT.vkCode = VK_RWINDOWS) Or (KBDLLHOOKSTRUCT.vkCode = VK_APPSPOPUP)
'TAB+ALT
'Esc+ALT
'Alt+Any(Alt+F4)
'Esc+Ctrl
'左右Win 和徽标键
End If
End If
If fEatKeystroke Then
LowLevelKeyboardProc = 1 '吃掉消息
Else
LowLevelKeyboardProc = CallNextHookEx(hhkLowLevelKybd, nCode, wParam, ByVal lParam) '如果消息要被处理，则传0或安装的钩子句柄
End If
End Function
######################################################################
'shutdown
Option Explicit
'退出windows，并用特定的选项重新启动
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_FORCE = 4 '强迫中止没有响应的进程
Private Const EWX_FORCEIFHUNG = 16 '如果应用程序已挂起，强制关闭
Public Const EWX_LOGOFF = 0 '中止进程，然后注销
Public Const EWX_REBOOT = 2 '重新引导系统
Public Const EWX_SHUTDOWN = 1 '关闭系统
Public Const WE_POWEROFF = 8 '关掉系统ATX电源,未公开的参数
Public Const WE_Suspend = 1 '自定义休眠常量
'Hibernate带0是休眠、带1是暂停，ForceCritical带0会广播给所有的程式说要执行暂停或休眠、带1则强制执行，DisableWakeEvent带0。
Private Declare Function SetSuspendState Lib "Powrprof" (ByVal Hibernate As Long, ByVal ForceCritical As Long, ByVal DisableWakeEvent As Long) As Long
'GetCurrentProcess获取当前进程的一个伪句柄
'返回值Long，当前进程的伪句柄
'注解只要当前进程需要一个进程句柄，就可以使用这个伪句柄。该句柄可以复制，但不可继承。不必调用CloseHandle函数来关闭这个句柄
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
'TOKEN_ADJUST_DEFAULT 当呼叫SetTokenInformtion （简短地讨论）改变权限的特色时要求，例如预设的拥有者、主要的群组或是预设的DACL。
'TOKEN_ADJUST_GROUPS 在呼叫AdjustTokenGroups中要求?
'TOKEN_ADJUST_PRIVILEGES 在呼叫AdjustTokenPrivileges中要求?
'TOKEN_ADJUST_SESSIONID 要求调整权限的工作阶段ID以及SE_TCB_NAME权限?
'TOKEN_ASSIGN_PRIMARY 在呼叫CreateProcessAsUser中使用权限时要求?
'TOKEN_DUPLICATE 要求复製权限?
'TOKEN_EXECUTE 等於STANDARD_RIGHTS_EXECUTE。
'TOKEN_IMPERSONATE 要求与ImpersonateLoggedOnUser一起使用这个权限?
'TOKEN_QUERY 要求读取任何的权限资讯，除了使用GetTokenInformation读取它的来源外。
'TOKEN_QUERY_SOURCE 要求使用GetTokenInformation读取权限的来源?
'TOKEN_READ 结合STANDARD_RIGHTS_READ及TOKEN_QUERY。
'TOKEN_WRITE 结合STANDARD_RIGHTS_WRITE、TOKEN_ADJUST_ PRIVILEGES、TOKEN_ADJUST_GROUPS及TOKEN_ADJUST_DEFAULT。
'TOKEN_ALL_ACCESS 完整的存取权限，结合了所有的权利。
'ProcessHandle是要修改访问权限的进程句柄
'DesiredAccess参数指定你要进行的操作类型，如要修改令牌我们要指定第二个参数为TOKEN_ADJUST_PRIVILEGES（其它一些参数可参考Platform SDK）。
'TokenHandle就是返回的访问令牌指针
'通过这个函数我们就可以得到当前进程的访问令牌的句柄（指定函数的第一个参数为GetCurrentProcess()就可以了）
Private Declare Function OpenProcessToken Lib "advapi32" _
(ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
'lpSystemName是系统的名称，如果是本地系统只要指明为NULL就可以了
'lpName指明了权限的名称，如“SeDebugPrivilege”
'lpLuid返回LUID的指针
'查询进程的权限
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias _
"LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
'AdjustTokenPrivileges修改访问令牌
'TokenHandle访问令牌的句柄
'DisableAllPrivileges决定是进行权限修改还是除能（Disable）所有权限
'NewState指明要修改的权限,是一个指向TOKEN_PRIVILEGES结构的指针，该结构包含一个数组，数据组的每个项指明了权限的类型和要进行的操作;
'BufferLength是结构PreviousState的长度
'PreviousState是一个指向TOKEN_PRIVILEGES结构的指针，存放修改前的访问权限的信息，可空
'ReturnLength为实际PreviousState结构返回的大小
Private Declare Function AdjustTokenPrivileges Lib "advapi32" _
(ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long '数组原素的个数
TheLuid As LUID '一个LUID_AND_ATTRIBUTES类型的数组
Attributes As Long
End Type
Private Const TOKEN_ADJUST_PRIVILEGES = &H20 '能修改令牌
Private Const TOKEN_QUERY = &H8 '要求读取任何的权限资讯，除了使用GetTokenInformation读取它的来源外。
Private Const SE_PRIVILEGE_ENABLED = &H2 '要使能一个权限就指定Attributes为SE_PRIVILEGE_ENABLED。
'快速关机
'RtlAdjustPrivilege&获取关机权限
Private Declare Function RtlAdjustPrivilege& Lib "ntdll" (ByVal Privilege&, ByVal Newvalue&, ByVal NewThread&, Oldvalue&)
'NtShutdownSystem& 关机操作
Private Declare Function NtShutdownSystem& Lib "ntdll" (ByVal ShutdownAction&)
Private Const SE_SHUTDOWN_PRIVILEGE& = 19 '关机特权
Private Const SHUTDOWN& = 0 '关机
Private Const RESTART& = 1 '重启动
Private Const POWEROFF& = 2 '关闭电源
Public Function ExitWindow(lngExtFlag As Long)
AdjustToken '提升权限
Select Case lngExtFlag '选择关闭Windows
Case EWX_LOGOFF '注销
ExitWindowsEx (EWX_LOGOFF Or EWX_FORCE), &HFFFF
Case EWX_REBOOT '重启
ExitWindowsEx (EWX_REBOOT Or EWX_FORCE), &HFFFF
Case WE_POWEROFF '关机
ExitWindowsEx (WE_POWEROFF Or EWX_FORCE), &HFFFF
Case WE_Suspend
SetSuspendState 0, 0, 0 '挂起,休眠
End Select
End Function
Private Sub AdjustToken() '提升用户权限
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle '得到进程的令牌句柄
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid ' 查询进程的权限
tkp.PrivilegeCount = 1 '设置权限
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED
'修改访问令牌,使进程获得关机权限.
AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
End Sub
Public Sub TurboShutdown(OperateFlag As Long)
RtlAdjustPrivilege SE_SHUTDOWN_PRIVILEGE, 1, 0, 0
Select Case OperateFlag
Case 1
NtShutdownSystem SHUTDOWN '关机
Case 2
NtShutdownSystem RESTART '重启动
Case 3
NtShutdownSystem POWEROFF '关机
End Select
End Sub
Option Explicit
'退出windows，并用特定的选项重新启动
Private Declare Function ExitWindowsEx Lib "user32" (ByVal uFlags As Long, ByVal dwReserved As Long) As Long
Private Const EWX_FORCE = 4 '强迫中止没有响应的进程
Private Const EWX_FORCEIFHUNG = 16 '如果应用程序已挂起，强制关闭
Public Const EWX_LOGOFF = 0 '中止进程，然后注销
Public Const EWX_REBOOT = 2 '重新引导系统
Public Const EWX_SHUTDOWN = 1 '关闭系统
Public Const WE_POWEROFF = 8 '关掉系统ATX电源,未公开的参数
Public Const WE_Suspend = 1 '自定义休眠常量
'Hibernate带0是休眠、带1是暂停，ForceCritical带0会广播给所有的程式说要执行暂停或休眠、带1则强制执行，DisableWakeEvent带0。
Private Declare Function SetSuspendState Lib "Powrprof" (ByVal Hibernate As Long, ByVal ForceCritical As Long, ByVal DisableWakeEvent As Long) As Long
'GetCurrentProcess获取当前进程的一个伪句柄
'返回值Long，当前进程的伪句柄
'注解只要当前进程需要一个进程句柄，就可以使用这个伪句柄。该句柄可以复制，但不可继承。不必调用CloseHandle函数来关闭这个句柄
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
'TOKEN_ADJUST_DEFAULT 当呼叫SetTokenInformtion （简短地讨论）改变权限的特色时要求，例如预设的拥有者、主要的群组或是预设的DACL。
'TOKEN_ADJUST_GROUPS 在呼叫AdjustTokenGroups中要求?
'TOKEN_ADJUST_PRIVILEGES 在呼叫AdjustTokenPrivileges中要求?
'TOKEN_ADJUST_SESSIONID 要求调整权限的工作阶段ID以及SE_TCB_NAME权限?
'TOKEN_ASSIGN_PRIMARY 在呼叫CreateProcessAsUser中使用权限时要求?
'TOKEN_DUPLICATE 要求复製权限?
'TOKEN_EXECUTE 等於STANDARD_RIGHTS_EXECUTE。
'TOKEN_IMPERSONATE 要求与ImpersonateLoggedOnUser一起使用这个权限?
'TOKEN_QUERY 要求读取任何的权限资讯，除了使用GetTokenInformation读取它的来源外。
'TOKEN_QUERY_SOURCE 要求使用GetTokenInformation读取权限的来源?
'TOKEN_READ 结合STANDARD_RIGHTS_READ及TOKEN_QUERY。
'TOKEN_WRITE 结合STANDARD_RIGHTS_WRITE、TOKEN_ADJUST_ PRIVILEGES、TOKEN_ADJUST_GROUPS及TOKEN_ADJUST_DEFAULT。
'TOKEN_ALL_ACCESS 完整的存取权限，结合了所有的权利。
'ProcessHandle是要修改访问权限的进程句柄
'DesiredAccess参数指定你要进行的操作类型，如要修改令牌我们要指定第二个参数为TOKEN_ADJUST_PRIVILEGES（其它一些参数可参考Platform SDK）。
'TokenHandle就是返回的访问令牌指针
'通过这个函数我们就可以得到当前进程的访问令牌的句柄（指定函数的第一个参数为GetCurrentProcess()就可以了）
Private Declare Function OpenProcessToken Lib "advapi32" _
(ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
'lpSystemName是系统的名称，如果是本地系统只要指明为NULL就可以了
'lpName指明了权限的名称，如“SeDebugPrivilege”
'lpLuid返回LUID的指针
'查询进程的权限
Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias _
"LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
'AdjustTokenPrivileges修改访问令牌
'TokenHandle访问令牌的句柄
'DisableAllPrivileges决定是进行权限修改还是除能（Disable）所有权限
'NewState指明要修改的权限,是一个指向TOKEN_PRIVILEGES结构的指针，该结构包含一个数组，数据组的每个项指明了权限的类型和要进行的操作;
'BufferLength是结构PreviousState的长度
'PreviousState是一个指向TOKEN_PRIVILEGES结构的指针，存放修改前的访问权限的信息，可空
'ReturnLength为实际PreviousState结构返回的大小
Private Declare Function AdjustTokenPrivileges Lib "advapi32" _
(ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, _
NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
Private Type LUID
UsedPart As Long
IgnoredForNowHigh32BitPart As Long
End Type
Private Type TOKEN_PRIVILEGES
PrivilegeCount As Long '数组原素的个数
TheLuid As LUID '一个LUID_AND_ATTRIBUTES类型的数组
Attributes As Long
End Type
Private Const TOKEN_ADJUST_PRIVILEGES = &H20 '能修改令牌
Private Const TOKEN_QUERY = &H8 '要求读取任何的权限资讯，除了使用GetTokenInformation读取它的来源外。
Private Const SE_PRIVILEGE_ENABLED = &H2 '要使能一个权限就指定Attributes为SE_PRIVILEGE_ENABLED。
'快速关机
'RtlAdjustPrivilege&获取关机权限
Private Declare Function RtlAdjustPrivilege& Lib "ntdll" (ByVal Privilege&, ByVal Newvalue&, ByVal NewThread&, Oldvalue&)
'NtShutdownSystem& 关机操作
Private Declare Function NtShutdownSystem& Lib "ntdll" (ByVal ShutdownAction&)
Private Const SE_SHUTDOWN_PRIVILEGE& = 19 '关机特权
Private Const SHUTDOWN& = 0 '关机
Private Const RESTART& = 1 '重启动
Private Const POWEROFF& = 2 '关闭电源
Public Function ExitWindow(lngExtFlag As Long)
AdjustToken '提升权限
Select Case lngExtFlag '选择关闭Windows
Case EWX_LOGOFF '注销
ExitWindowsEx (EWX_LOGOFF Or EWX_FORCE), &HFFFF
Case EWX_REBOOT '重启
ExitWindowsEx (EWX_REBOOT Or EWX_FORCE), &HFFFF
Case WE_POWEROFF '关机
ExitWindowsEx (WE_POWEROFF Or EWX_FORCE), &HFFFF
Case WE_Suspend
SetSuspendState 0, 0, 0 '挂起,休眠
End Select
End Function
Private Sub AdjustToken() '提升用户权限
Dim hdlProcessHandle As Long
Dim hdlTokenHandle As Long
Dim tmpLuid As LUID
Dim tkp As TOKEN_PRIVILEGES
Dim tkpNewButIgnored As TOKEN_PRIVILEGES
Dim lBufferNeeded As Long
hdlProcessHandle = GetCurrentProcess()
OpenProcessToken hdlProcessHandle, (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle '得到进程的令牌句柄
LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid ' 查询进程的权限
tkp.PrivilegeCount = 1 '设置权限
tkp.TheLuid = tmpLuid
tkp.Attributes = SE_PRIVILEGE_ENABLED
'修改访问令牌,使进程获得关机权限.
AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
End Sub
Public Sub TurboShutdown(OperateFlag As Long)
RtlAdjustPrivilege SE_SHUTDOWN_PRIVILEGE, 1, 0, 0
Select Case OperateFlag
Case 1
NtShutdownSystem SHUTDOWN '关机
Case 2
NtShutdownSystem RESTART '重启动
Case 3
NtShutdownSystem POWEROFF '关机
End Select
End Sub