獲取進程的````
Private Declare Function LookupAccountSid Lib “advapi32.dll“ Alias “LookupAccountSidA“ (ByVal lpSystemName As String, ByVal SID As Long, ByVal name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) 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 GetTokenInformation Lib “advapi32.dll“ (ByVal TokenHandle As Long, ByVal TokenInformationClass As Long, TokenInformation As Any, ByVal TokenInformationLength As Long, ReturnLength As Long) As Long
Private Declare Function OpenProcess Lib “kernel32.dll“ (ByVal dwDesiredAccessas As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Function CloseHandle Lib “kernel32“ (ByVal hObject As Long) As Long
Private Const PROCESS_QUERY_INFORMATION = 1024
Private Const PROCESS_VM_READ = 16
Private Const SECURITY_BUILTIN_DOMAIN_RID = &H20&
Private Const SECURITY_NT_AUTHORITY = &H5
Private Const DOMAIN_ALIAS_RID_USERS = &H221
Private Const TOKEN_READ = &H20008
Private Const TokenUser = 1
Private Type SID_IDENTIFIER_AUTHORITY
Value(6) As Byte
End Type
Private Type SID_AND_ATTRIBUTES
SID As Long
Attributes As Long
End Type
Private Type TOKEN_USER
User As SID_AND_ATTRIBUTES
SID(500) As Byte
End Type
Private Function GetPrcUserName(ByVal pID As Long) As String
Dim hProcessID As Long
Dim hToken As Long
Dim res As Long
Dim cbBuff As Long
Dim tiLen As Long
Dim TU As TOKEN_USER
Dim cnt As Long
Dim sAcctName2 As String
Dim cbAcctName As Long
Dim sDomainName As String
Dim cbDomainName As Long
Dim peUse As Long
Dim barr() As Byte
hProcessID = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, pID)
If hProcessID <> 0 Then
If OpenProcessToken(hProcessID, TOKEN_READ, hToken) = 1 Then ’这一步可能失败
res = GetTokenInformation(hToken, TokenUser, ByVal 0, tiLen, cbBuff)
If res = 0 And cbBuff > 0 Then
tiLen = cbBuff
If cbBuff > Len(TU) Then Exit Function
res = GetTokenInformation(hToken, TokenUser, TU, tiLen, cbBuff)
If res = 1 And tiLen > 0 Then
sAcctName2 = Space$(255)
sDomainName = Space$(255)
cbAcctName = 255
cbDomainName = 255
res = LookupAccountSid(vbNullString, TU.User.SID, sAcctName2, cbAcctName, sDomainName, cbDomainName, peUse)
GetPrcUserName = Replace(Trim(sAcctName2), Chr(0), ““)
End If
End If
Else
GetPrcUserName = “OpenProcessToken 失败“
End If
If hToken Then CloseHandle hToken
CloseHandle hProcessID
End If
End Function