Obtain the Owner of a File on Windows NT/2000

Category:

Files and Directories

Type:

Snippets

Difficulty:

Advanced

Author: Waty

Version Compatibility:

More information:

See comments for details. You may want to check the OS version before running this code. There are multiple examples on this site that show you how to do this.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit Private Declare Function GetFileSecurity Lib "advapi32.dll" _ Alias "GetFileSecurityA" ( _ ByVal lpFileName As String, _ ByVal RequestedInformation As Long, _ pSecurityDescriptor As Byte, _ ByVal nLength As Long, _ lpnLengthNeeded As Long) As Long Private Declare Function GetSecurityDescriptorOwner Lib "advapi32.dll" _ (pSecurityDescriptor As Any, _ pOwner As Long, _ lpbOwnerDefaulted As Long) As Long 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 FormatMessage Lib "kernel32" Alias _ "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, _ ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _ ByVal lpBuffer As String, ByVal nSize As Long, _ Arguments As Long) As Long Private Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000 Private Const OWNER_SECURITY_INFORMATION = &H1 Private Const ERROR_INSUFFICIENT_BUFFER = 122& Private Const MAX_PATH = 255

Code:

Public Function FileOwner(ByVal FileName As String) As String
' #VBIDEUtils#****************************************************
' * Programmer Name  : Waty Thierry
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : waty.thierry@usa.net
' * Date             : 28/06/99
' * Time             : 12:58
' ************************************************************
' * Comments         : Returns the Owner of a File on Windows NT
' *
' * Requires obtaining the security descriptor, Then using
' * the descriptor to Get a pointer To the owner's
' * Security Identifier (SID). Finally, you use the owner's SID
' * to obtain the owner and domain name of the file.
' *
' ************************************************************
   
  Dim szfilename As String  ' File name to retrieve the owner for
  Dim bSuccess As Long      ' Status variable
  Dim sizeSD As Long        ' Buffer size to store Owner's SID
  Dim pOwner As Long        ' Pointer to the Owner's SID
  Dim Name As String        ' Name of the file owner
  Dim domain_name As String ' Name of the first domain for the 
'                             owner
  Dim name_len As Long      ' Required length for the owner name
  Dim domain_len As Long    ' Required length for the domain 
'                             name
  Dim sdBuf() As Byte       ' Buffer for Security Descriptor
  Dim deUse As Long         ' Pointer to a SID_NAME_USE 
'                             enumerated type indicating the 
'                             type of the account
  
  ' Initialize some required variables.
  
  bSuccess = 0
  Name = ""
  domain_name = ""
  name_len = 0
  domain_len = 0
  pOwner = 0
  
  If Dir(FileName) = "" Then
     Err.Raise 30000, , "File Does not Exist"
     Exit Function
  End If

szfilename = FileName
  
  ' Call GetFileSecurity the first time to obtain the size of the
  ' buffer required for the Security Descriptor.
  
  bSuccess = GetFileSecurity(szfilename, _
     OWNER_SECURITY_INFORMATION, 0, 0&, sizeSD)
  
  If (bSuccess = 0) And _
     (Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER) Then
     Err.Raise Err.LastDllError, , _
         APIErrorDescription(Err.LastDllError)
     Exit Function
  End If
  
'Create a buffer of the required size and call 
'GetFileSecurity again.
  
  ReDim sdBuf(0 To sizeSD - 1) As Byte

'Fill the buffer with the security descriptor of the object 
'specified by the szfilename parameter. The calling process must
'have the right to view the specified aspects of the object's 
'security status.
  
  bSuccess = GetFileSecurity(szfilename, _
    OWNER_SECURITY_INFORMATION, sdBuf(0), sizeSD, sizeSD)
  
  If (bSuccess <> 0) Then
     
     ' Obtain the owner's SID from the Security Descriptor.
     
     bSuccess = GetSecurityDescriptorOwner(sdBuf(0), pOwner, 0&)
     If (bSuccess = 0) Then
           Err.Raise Err.LastDllError, , _
               APIErrorDescription(Err.LastDllError)
           Exit Function
     End If
     
' Retrieve the name of the account and the name of the first
' domain on which this SID is found.  Passes in the Owner's SID
' obtained previously.  Call LookupAccountSid twice, the first 
' time to obtain the required size of the owner and domain names.
     
   bSuccess = LookupAccountSid(vbNullString, pOwner, Name, _
    name_len, domain_name, domain_len, deUse)
     If (bSuccess = 0) And _
        (Err.LastDllError <> ERROR_INSUFFICIENT_BUFFER) Then
           Err.Raise Err.LastDllError, , _
               APIErrorDescription(Err.LastDllError)
           Exit Function
     End If
     
'Allocate the required space in the name and domain_name string
'variables. Allocate 1 byte less to avoid the appended NULL 
'character.

Name = Space(name_len - 1)
     domain_name = Space(domain_len - 1)
     
'Call LookupAccountSid again to actually fill in the 
'name of the owner and the first domain.
     '
     bSuccess = LookupAccountSid(vbNullString, pOwner, Name, _
        name_len, domain_name, domain_len, deUse)
     If bSuccess = 0 Then
           Err.Raise Err.LastDllError, , _
              APIErrorDescription(Err.LastDllError)
           Exit Function
     End If
     
     FileOwner = Name
     
  End If
  
End Function

Private Function APIErrorDescription(ErrorCode As Long) As String

Dim sAns As String
Dim lRet As Long

'PURPOSE: Returns Human Readable Description of
'Error Code that occurs in API function

'PARAMETERS: ErrorCode: System Error Code

'Returns: Description of Error

sAns = Space(255)
lRet = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0, _
  ErrorCode, 0, sAns, 255, 0)

APIErrorDescription = StripNull(sAns)

End Function

Private Function StripNull(ByVal InString As String) As String

'Input: String containing null terminator (Chr(0))
'Returns: all character before the null terminator

Dim iNull As Integer
If Len(InString) > 0 Then
   iNull = InStr(InString, vbNullChar)
   Select Case iNull
   Case 0
       StripNull = Trim(InString)
   Case 1
       StripNull = ""
   Case Else
      StripNull = Left$(Trim(InString), iNull - 1)
  End Select
End If

End Function