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,

Ответить