Visual Basic Network Services

GetSecurityDescriptorOwner: Local or Remote File or Folder Owner
     
Posted:   Tuesday January 17, 2006
Updated:   Monday December 26, 2011
     
Applies to:   VB4-32, VB5, VB6
Developed with:   VB6, Windows XP
OS restrictions:   Windows NT4, Windows 2000, Windows XP or later
Author:   VBnet - Randy Birch
     

Related:  

NetFileEnum: Get Open File Info from a Specified Machine
     
 Prerequisites
One of the operating systems listed under OS Restrictions above.

GetFileSecurity, LookupAccountSid and GetSecurityDescriptorOwner can be combined to return the owner of a file or a folder on a local or remote machine.

The illustration shows the result of calling the code below passing my laptop name and a folder in the test user's My Documents folder on that machine.

Changing the code to add a filename to the passed path causes the routine to return the owner of the file. To test this I logged off test user and back on as my usual admin account, then I created a text file in the testuseraccount's My Documents folder. The code correctly returned my admin account as being the owner of the file; requesting the owner of the folder again returned the test user's account name.

Incidentally (at least on my workgroup setup), the code accurately returned the correct info for both files and folders when no users were logged on to the laptop (it was waiting at the "click name to begin" screen (fast user switching was not enabled).

 BAS Module Code
None.

 Form Code
To a form add a command button (Command1),a text box (Text1). The label is cosmetic. Add the following to the form:

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright 1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const OWNER_SECURITY_INFORMATION = &H1
Private Const ERROR_INSUFFICIENT_BUFFER = 122&

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 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 GetSecurityDescriptorOwner Lib "advapi32.dll" _
  (pSecurityDescriptor As Any, _
   pOwner As Long, _
   lpbOwnerDefaulted As Long) As Long

Private Declare Function lstrlenW Lib "kernel32" _
  (ByVal lpString As Long) As Long



Private Sub Form_Load()

   With Command1
      .Width = 2000
      .Height = 345
      .Caption = "Get Folder Owner"
   End With
   
   Text1.Text = ""
   
End Sub


Sub Command1_Click()

   Text1.Text = GetFolderOwner("vbnetvaio", "c$\Documents and Settings\testuseraccount\My Documents")
  'Text1.Text = GetFolderOwner("vbnetvaio", "c$\program files")
  'Text1.Text = GetFolderOwner("", "c:\my documents")
  'Text1.Text = GetFolderOwner("vbnetvaio", "c$\Documents and Settings\testuseraccount\My Documents\abc.txt")
   
End Sub


Private Function GetFolderOwner(ByVal sServer As String, ByVal sFolder As String) As String

    Dim bSuccess As Long
    Dim sizeSD As Long
    Dim pOwner As Long
    Dim sFolderOwner As String
    Dim cbFolderOwner As Long
    Dim sDomainName As String
    Dim cbDomainName As Long
    Dim sFullFolderName As String
    Dim sdBuf() As Byte
    Dim deUse As Long

  'TODO: GetFileSecurity requires the full path
  'to the folder.  If a server was passed, this
  'is included in the filename when the path
  'is a UNC path. When the specified folder
  'is a mapped drive the server is still
  'required for LookupAccountSID, but is not
  'required for GetFileSecurity. Tests for
  'different strings passed should be accounted 
  'for in a production version of this code.
  
  'To simplify the demo, we'll just do preliminary
  'work with the strings to ensure the
  'server name formatting is correct;
  'if no server specified assume local machine
   If Len(sServer) > 0 Then
      sServer = QualifyServer(sServer)
      sFullFolderName = QualifyPath(sServer) & sFolder
   Else
      sServer = vbNullString
      sFullFolderName = sFolder
   End If

  'step 1: call GetFileSecurity to get
  'the size of the buffer required
   bSuccess = GetFileSecurity(sFullFolderName, _
                              OWNER_SECURITY_INFORMATION, _
                              0, 0&, sizeSD)
    
   If (bSuccess = 0) And _
      (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then

     'step 2: create buffer of required
     'size and call again
      ReDim sdBuf(0 To sizeSD - 1) As Byte
    
      bSuccess = GetFileSecurity(sFullFolderName, _
                                 OWNER_SECURITY_INFORMATION, _
                                 sdBuf(0), _
                                 sizeSD, sizeSD)
    
      If (bSuccess <> 0) Then
    

        'step 3: obtain owner's SID from
        'the security descriptor
         If GetSecurityDescriptorOwner(sdBuf(0), pOwner, 0&) = 1 Then
                   
           'step 4: call LookupAccountSid twice to
           'get the name of the account and the
           'first domain on which this SID is found;
           'the first call gets the correct buffer size,
           'the second gets the data
            bSuccess = LookupAccountSid(sServer, _
                                        pOwner, _
                                        sFolderOwner, _
                                        cbFolderOwner, _
                                        sDomainName, _
                                        cbDomainName, _
                                        deUse)
                                        
            If (bSuccess = 0) And _
               (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
                 
              'fill buffers and call again
               sFolderOwner = Space$(cbFolderOwner)
               sDomainName = Space$(cbDomainName)

               If LookupAccountSid(sServer, _
                                   pOwner, _
                                   sFolderOwner, _
                                   cbFolderOwner, _
                                   sDomainName, _
                                   cbDomainName, _
                                   deUse) = 1 Then
       
                  GetFolderOwner = TrimNull(sFolderOwner)
                  
               End If  'LookupAccountSid
            End If  'bSuccess /3
         End If  'GetSecurityDescriptorOwner
      End If  'bSuccess /2
   End If  'bSuccess /1

End Function


Private Function QualifyServer(ByVal sServer As String) As String

  'if nullstring was passed, the
  'API does not expect slashes in
  'the server name
   If Len(sServer) > 0 Then
  
     'are already two slashes
     'preceding the server name?
      If Left$(sServer, 2) = "\\" Then
   
        'return the passed string
         QualifyServer = sServer
   
      Else
   
        'there aren't two, but is there one?
         If Left$(sServer, 1) = "\" Then
      
           'yes, so add one more
            QualifyServer = "\" & sServer
      
         Else
      
           'the string needs both
            QualifyServer = "\\" & sServer
      
         End If  'Left$(sServer, 1) <> "\"
      End If  'Left$(sServer, 2) = "\\"
   
   Else
   
     'empty string passed, so return it
      QualifyServer = sServer
      
   End If  'Len(sServer)
   
End Function


Private Function QualifyPath(sPath As String) As String
 
   If Len(sPath) > 0 Then
 
      If Right$(sPath, 1) <> "\" Then
         QualifyPath = sPath & "\"
      Else
         QualifyPath = sPath
      End If
   Else
      QualifyPath = ""
   End If
   
End Function


Private Function TrimNull(startstr As String) As String

   TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
   
End Function
 Comments

 
 

PayPal Link
Make payments with PayPal - it's fast, free and secure!

 
 
 
 

Copyright 1996-2011 VBnet and Randy Birch. All Rights Reserved.
Terms of Use  |  Your Privacy

 

Hit Counter