取进程用户

Option   Explicit

Private   Const   TOKEN_READ   As   Long   =   &H20008
Private   Const   SECURITY_BUILTIN_DOMAIN_RID   As   Long   =   &H20&
Private   Const   SECURITY_NT_AUTHORITY   As   Long   =   &H5
Private   Const   PROCESS_QUERY_INFORMATION   As   Long   =   1024
Private   Const   PROCESS_VM_READ   As   Long   =   16
Private   Const   DOMAIN_ALIAS_RID_USERS   =   &H221
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   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   CloseHandle   Lib   "kernel32"   (ByVal   hObject   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

Public   Function   GetProcessUserName(ByVal   ProcessID   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,   ProcessID)
        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)
                                        GetProcessUserName   =   Replace(Trim(sAcctName2),   Chr(0),   "")
                                End   If
                        End   If
                End   If
                If   hToken   Then   CloseHandle   hToken
                CloseHandle   hProcessID
        End   If
End   Function