Rem Modul ProzessOwner
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_GROUPS
    GroupCount As Long
    Groups(500) As SID_AND_ATTRIBUTES
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 AllocateAndInitializeSid Lib "advapi32.dll" ( _
pIdentifierAuthority As SID_IDENTIFIER_AUTHORITY, ByVal nSubAuthorityCount As _
Byte, ByVal nSubAuthority0 As Long, ByVal nSubAuthority1 As Long, ByVal _
nSubAuthority2 As Long, ByVal nSubAuthority3 As Long, ByVal nSubAuthority4 As _
Long, ByVal nSubAuthority5 As Long, ByVal nSubAuthority6 As Long, ByVal _
nSubAuthority7 As Long, lpPSid 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 GetCurrentProcess Lib "kernel32" () As Long
Private Declare Sub FreeSid Lib "advapi32.dll" (pSid As Any)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As _
  Long
Public Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccessas _
As Long, ByVal bInheritHandle As Long, ByVal dwProcId As Long) As Long
Private Declare Sub CopyMem Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef _
Destination As Any, ByRef Source As Any, ByVal Length 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 'If res = 1 And ti.....
        End If 'If res = 0 And cb....
    End If 'If OpenProcessToken(hPr....)
    If hToken Then CloseHandle hToken
    CloseHandle hProcessID
End If 'If hProcessID <> 0 Then
Owner = GetProcessUserName
End Function