VB6实现枚举进程所拥有的特权(增强版)

原帖：http://blog.csdn.net/Modest/archive/2008/03/10/2162170.aspx

本文在原文基础上增加了两个转换函数LookupPrivilegeName和LookupPrivilegeDisplayName，从而可以完美的输出权限的名称和权限的描述。

'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
' VB6实现枚举进程所拥有的特权(增强版)
' Programmed by 魏滔序
' WebSite: http://www.chenoe.com ' Blog: http://blog.csdn.net/Modest ':::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Option Explicit
Private Const ANYSIZE_ARRAY As Long = 100
Private Const TokenPrivileges = 3
Private Const TOKEN_QUERY = &H8
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(ANYSIZE_ARRAY) As LUID_AND_ATTRIBUTES
End Type
Private Type PRIVILEGE
lValue  As Long
sName   As String
sDisplay As String
End Type
Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
Private Declare Function OpenProcessToken Lib "Advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
Private Declare Function GetTokenInformation Lib "Advapi32" (ByVal TokenHandle As Long, TokenInformationClass As Integer, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function RtlMoveMemory Lib "kernel32" (Dest As Any, Source As Any, ByVal lSize As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function LookupPrivilegeName Lib "advapi32.dll" Alias "LookupPrivilegeNameA" (ByVal lpSystemName As String, ByRef lpLuid As LUID, ByVal lpName As String, ByRef cbName As Long) As Long
Private Declare Function LookupPrivilegeDisplayName Lib "advapi32.dll" Alias "LookupPrivilegeDisplayNameA" (ByVal lpSystemName As String, ByVal lpName As String, ByVal lpDisplayName As String, ByRef cbDisplayName As Long, ByRef lpLanguageID As Long) As Long
Private Function GetProcressPrivileges(ByVal hProcess As Long, Optional ByRef LanguageID As Long = 0) As PRIVILEGE()
Dim hToken As Long
Dim BufferSize As Long
Dim InfoBuffer() As Long
Dim i As Long, r() As PRIVILEGE, x As Long
Dim lResult As Long
Dim tpTokens As TOKEN_PRIVILEGES
Dim s As String

Call OpenProcessToken(hProcess, TOKEN_QUERY, hToken)
If hToken Then
Call GetTokenInformation(hToken, ByVal TokenPrivileges, 0, 0, BufferSize)
If BufferSize Then
ReDim InfoBuffer((BufferSize  4) - 1) As Long
lResult = GetTokenInformation(hToken, ByVal TokenPrivileges, InfoBuffer(0), BufferSize, BufferSize)
If lResult = 1 Then
Call RtlMoveMemory(tpTokens, InfoBuffer(0), LenB(tpTokens))
For i = 0 To tpTokens.PrivilegeCount - 1
If tpTokens.Privileges(i).Attributes <> 0 Then
s = String(256, 0)
LookupPrivilegeName vbNullString, tpTokens.Privileges(i).pLuid, s, Len(s)
ReDim Preserve r(x)
r(x).lValue = tpTokens.Privileges(i).pLuid.lowpart
r(x).sName = Replace(s, vbNullChar, vbNullString)
s = String(256, 0)
LookupPrivilegeDisplayName vbNullString, r(x).sName, s, Len(s), LanguageID
r(x).sDisplay = Replace(s, vbNullChar, vbNullString)
x = x + 1
End If
Next
End If
End If
Call CloseHandle(hToken)
End If
GetProcressPrivileges = r
End Function
'示例代码
Private Sub Form_Load()
Dim p() As PRIVILEGE, i As Long
p = GetProcressPrivileges(GetCurrentProcess)
For i = 0 To UBound(p)
Debug.Print p(i).lValue, p(i).sName, p(i).sDisplay
Next
End Sub

上述代码输出结果如下(会因权限不同而异)：
23 SeChangeNotifyPrivilege 跳过遍历检查
10 SeLoadDriverPrivilege 装载和卸载设备驱动程序
25 SeUndockPrivilege 从插接工作站中取出计算机
29 SeImpersonatePrivilege 身份验证后模拟客户端
30 SeCreateGlobalPrivilege 创建全局对象