Tuesday, 1 December 2009

Who owns that file? Using WMI to identify the owner of a file

Every now and again, I have the job of archiving vast numbers of workbooks: a penance for failing to move the users on from using Excel for primary data storage and saving down each day's valuations in a separate sheet.

As you can imagine, this gets tedious, and it needs automating... Any fool can write a script to delete, zip or move files around, and many fools have done so: few were so damned by their actions in a past life as to be doomed to notify the file owners by email.

But who owns the file?

Every now and again, Windows shows that a simple question can be made to have an absurdly difficult answer, and finding the owner of a named file is one of the worst I've come across. The API calls have been analysed and explained by Emmet Gray:


You are welcome to read it and try out the code: it is a remarkable feat of analysis and simplification in the face of the wilfully illogical and obscure and, despite being pared down and superbly documented, it is a truly intimidating piece of API coding. You cannot extract the Security Descriptor of a file in less than a hundred lines of code and, when you've got it, you will rapidly realise that opening up and interrogating a file's Security Descriptor for the SID of the user only leads to an even deeper travail in extracting a human-readable user name. I do not believe that it can be done in less than a thousand lines of code and I would question whether it can be done reproducibly and reliably - let lone clearly - which is to say that it probably shouldn't be done in VBA.

But I've still got the job of digging out the user names for all the files I'm archiving. The code snippet below uses WMI - Windows Management Information - a truly horrible API released (but not documented) by Microsoft for systems administrators. If WMI is an improvement, I shudder to think what they had to do before it existed, and I am astonished that the haven't all turned into the BOFH (Look it up. But not at work). But it is at least short. All it is, is a 'Get Owner' function and a small Scripting wrapper that searches a folder and lists the files...

Private Function GetFileOwner(strFile As String, Optional WithDomainName As Boolean = False) As String

' Returns the owner of a file or folder, or a comma-delimited list if there are multiple owners.

' Usage:
'     Debug.Print GetFileOwner("H:\Personal\MyFile.txt")
'       heffernann
'     Debug.Print GetFileOwner("H:\Personal\MyFile.txt", TRUE)
'       OLYMPUS\heffernann
'     Debug.Print GetFileOwner("\\OLYMPUS\Users\heffernann\Personal\MyFile.txt", TRUE)
'       [returns nothing, see below]

' This works with local drives and mapped drives, but fully-qualified network paths do not work.
' According to the documentation, WMI will return an error when the file owner is a user who has
' been purged from the system. However, all that happens here is that we get an empty collection

' Author: Nigel Heffernan

' The underlying technology is WMI (Windows Management Information).
' The WMI documentation is very poor, even by the standards of MSDN.
' However, Microsoft's 'Hey! Scripting Guy!' site has usable information:

'   http://www.microsoft.com/technet/scriptcenter/resources/qanda/oct04/hey1007.mspx

Static objWMIService As Object      ' Persistent object: this is called repeatedly,
                                    ' so you may prefer to declare it at module level
                                    ' and instantiate/dismiss it explicitly

Dim colItems As Object
Dim objItem As Object

Dim strComputer As String
Dim strWMI_Query As String
Dim strOwner As String
Dim strOutput As String
Dim iCount As Integer

Const wbemFlagReturnImmediately As Long = 16
Const wbemFlagForwardOnly As Long = 32
Dim IFlags As Long

    IFlags = wbemFlagReturnImmediately + wbemFlagForwardOnly

    strComputer = "."   ' WMI notation for 'This machine'
                        ' WMI script sometimes works if remote machine names are specified
                        ' but you'll need to specify the local path when looking up files
    strWMI_Query = ""
    strWMI_Query = strWMI_Query & "ASSOCIATORS OF "
    strWMI_Query = strWMI_Query & "{Win32_LogicalFileSecuritySetting='" & strFile & "'}"
    strWMI_Query = strWMI_Query & " WHERE AssocClass=Win32_LogicalFileOwner ResultRole=Owner"

' WMI Association classes can be instantiated directly, but the syntax is arcane.
' Querying the WMI data service is simpler, if you can find a pre-existing query template

    If objWMIService Is Nothing Then
        Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    End If

    ' ExecQuery is relatively easy to do, but rather slow
    Set colItems = objWMIService.ExecQuery(strWMI_Query, , IFlags)
    ' AssociatorsOf is faster, and is documented here: http://msdn.microsoft.com/en-us/library/aa393858(VS.85).aspx
    'Set colItems = objWMIService.AssociatorsOf("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2", "Win32_LogicalFileOwner", "SWbemObjectEx", "Owner", , , , , , IFlags)

    strOutput = ""
    iCount = 0
    On Error Resume Next

        For Each objItem In colItems
            strOwner = ""
            If WithDomainName Then
                strOwner = objItem.ReferencedDomainName & "\" & objItem.AccountName
                strOwner = objItem.AccountName & ","
            End If
            strOutput = strOutput & strOwner
        Next objItem
'Trim trailing comma:

    strOutput = Trim(strOutput)
    If Len(strOutput) > 0 Then
        strOutput = Left(strOutput, Len(strOutput) - 1)
    End If
    GetFileOwner = strOutput
End Function

Public Sub RecurseFolder(strFolder As String, Optional RecursionLevel As Integer = 0, Optional minDateLastModified As Date = 0, Optional minSize As Double = 0)

' Recursive Subroutine to enumerate the contents of an NT folder.
' Writes the results to a log file

' Subfolders are enumerated by a recursive call
' For use in Excel VBA: can be converted to VBScript

' REQUIRES module-level declarations:

'       objLogStream (Scripting.TextStream)
'       objFSO (Scripting.FileSystemObject)
'       LogfileName  (string)

' REQUIRES Subroutines and Functions:

'       GetFileOwner
'       Logfile
'       CloseLogFile

' VBA Declarations:
Dim objFolder As Folder
Dim objSubFolder As Folder

Dim objFile     As File
Dim strFile     As String
Dim strMessage  As String
Dim strOwner    As String
Dim strSize     As String
Dim lngCountLog As Long

If objFSO Is Nothing Then
    Set objFSO = New FileSystemObject
End If

Set objFolder = objFSO.GetFolder(strFolder)

Application.StatusBar = "Searching folders: " & RecursionLevel & " layers: " & strFolder

' Use this if you're reporting progress on a worksheet (requires named range as shown):
ThisWorkbook.Names("CurrentFolder").RefersToRange.Value = strFolder

strOwner = GetFileOwner(objFolder.Path)

On Error Resume Next

strMessage = ""
strMessage = strMessage & "FOLDER" & vbTab & objFolder.name & vbTab & 0 & vbTab & objFolder.DateLastModified & vbTab & objFolder.DateLastAccessed & vbTab & strOwner & vbTab & objFolder.Path & vbTab & RecursionLevel
Logfile strMessage

    lngCountLog = 0

    For Each objFile In objFolder.Files
            strFile = objFile.Path
            If objFile.DateLastModified >= minDateLastModified Then
                If objFile.Size >= minSize Then
                    strOwner = ""
                    strOwner = GetFileOwner(objFile.Path)
                    strMessage = ""
                    strMessage = strMessage & "FILE" & vbTab & objFile.name & vbTab & objFile.Size & vbTab & objFile.DateLastModified & vbTab & objFile.DateLastAccessed & vbTab & strOwner & vbTab & objFolder.Path & vbTab & RecursionLevel
                    Logfile strMessage
                    lngCountLog = lngCountLog + 1
                End If  'objFile.Size > minSize Then
            End If ' objFile.DateLastModified > minDateLastModified
    Next objFile

    ' Use these f you're reporting progress on a worksheet (requires named ranges as shown):
    ThisWorkbook.Names("CurrentCount").RefersToRange.Value = ThisWorkbook.Names("CurrentCount").RefersToRange.Value + objFolder.Files.Count
    ThisWorkbook.Names("CurrentCountLogged").RefersToRange.Value = ThisWorkbook.Names("CurrentCountLogged").RefersToRange.Value + lngCountLog

    For Each objSubFolder In objFolder.SubFolders
        RecursionLevel = RecursionLevel + 1
        RecurseFolder objSubFolder.Path, RecursionLevel, minDateLastModified, minSize
        RecursionLevel = RecursionLevel - 1
    Next objSubFolder

End Sub

Public Sub Logfile(strMessage)

' Stream a message to a log file
' Opens the file if required.
' You are advised to close the file explicitly when your process has completed: use CloseLogFile for this

' REQUIRES module-level declarations:

'       objLogStream (Scripting.TextStream)
'       objFSO (Scripting.FileSystemObject)
'       LogfileName  (string)

Dim strHeader As String

If objLogStream Is Nothing Then
    Set objLogStream = objFSO.OpenTextFile(LogfileName, ForWriting, True)
    strHeader = "Type" & vbTab & "Filename" & vbTab & "Size" & vbTab & "DateLastModified" & vbTab & "DateLastAccessed" & vbTab & "Owner" & vbTab & "ParentFolder" & vbTab & "PathDepth"
    objLogStream.WriteLine strHeader
End If

objLogStream.WriteLine strMessage

End Sub

Public Sub CloseLogFile()

If objLogStream Is Nothing Then
    Exit Sub
End If

Set objLogStream = Nothing

End Sub

Feel free to try out the code - and do, please, feel free to tell me how you got on. Oh, and watch out for line breaks imposed by Blogger's atomatic formatting.

No comments:

Post a Comment