Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0683: Besitzer einer Datei/eines Ordners auf einem NTFS Medium mittels API auslesen

VB 5/6-Tipp 0683: Besitzer einer Datei/eines Ordners auf einem NTFS Medium mittels API auslesen

 von Daniel Aue

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GetFileSecurityA (GetFileSecurity), GetSecurityDescriptorOwner, IsValidSid, LookupAccountSidA (LookupAccountSid)

Download: Download des Beispielprojektes [2,86 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Projekt1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Textfeld "Text1"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Beschriftungsfeld "Label1"

Option Explicit

Private Declare Function GetFileSecurity Lib "advapi32.dll" Alias _
        "GetFileSecurityA" (ByVal lpFileName As String, _
        ByVal RequestedInformation As Long, pSecurityDescriptor As _
        Any, 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 _
        lpSid As Long, ByVal Name As String, cbName As Long, ByVal _
        ReferencedDomainName As String, cbReferencedDomainName As _
        Long, peUse As Long) As Long

Private Declare Function IsValidSid Lib "advapi32.dll" (ByVal pSid _
        As Long) As Long

Private Const OWNER_SECURITY_INFORMATION As Long = 1

Public Function GetFileOwner(ByVal FullFileName As String) As String
    Dim lngSize As Long
    Dim bytSecurityDescr() As Byte
    Dim lpSid As Long
    Dim lngDummy As Long
    
    'Länge des Security Deskriptors ermitteln:
    Call GetFileSecurity(FullFileName, OWNER_SECURITY_INFORMATION, _
        ByVal 0, 0, lngSize)
    If lngSize <> 0 Then
        
        'Security Deskriptor lesen:
        ReDim bytSecurityDescr(lngSize - 1)
        If GetFileSecurity(FullFileName, OWNER_SECURITY_INFORMATION, _
            bytSecurityDescr(0), lngSize, lngSize) <> 0 Then
            
            'Owner SID ermitteln:
            Call GetSecurityDescriptorOwner(bytSecurityDescr(0), _
                lpSid, lngDummy)
            If lpSid <> 0 Then
                GetFileOwner = Sid2String(lpSid)
            Else
                Err.Raise 513, , "GetSecurityDescriptorOwner Error"
            End If
        
        Else
            Err.Raise 513, , "GetFileSecurity Error"
        End If
    
    Else
        Err.Raise 513, , "GetFileSecurity Error"
    End If
End Function

Private Function Sid2String(ByVal lpSid As Long, _
        Optional ComputerName As String = vbNullString) As String
'    Übersetzt den SID in einen Accountnamen
'    IN:  lpSid: Zeiger auf einen SID
'         ComputerName: Computername auf dem der SID (Konto ID)
'                        zum Kontonamen aufgelöst werden soll
'    OUT: Kontoname als String
    Dim cbAccountName As Long, cbDomainName As Long
    Dim strAccountName As String, strDomainName As String
    Dim peUse As Long
    Dim lngRet As Long

    If IsValidSid(lpSid) <> 0 Then
        lngRet = LookupAccountSid(ComputerName, lpSid, 0, cbAccountName, _
            0, cbDomainName, peUse)
        strAccountName = Space(cbAccountName + 1)
        strDomainName = Space(cbDomainName + 1)
        lngRet = LookupAccountSid(ComputerName, lpSid, strAccountName, _
            cbAccountName, strDomainName, cbDomainName, peUse)
        If lngRet <> 0 Then
            Sid2String = Left(strDomainName, cbDomainName) & "\" & _
                Left(strAccountName, cbAccountName)
        Else
            Sid2String = "<UNKNOWN SID>"
        End If
    Else
        Sid2String = "<INVALID SID>"
    End If
End Function

Private Sub Command1_Click()
    MsgBox GetFileOwner(Text1)
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Projekt1.vbp --------------