|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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 |
|
|
|
|||||
|
|||||
|
|||||
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |