Was this page helpful?
Your feedback about this content is important. Let us know what you think.
Additional feedback?
1500 characters remaining
Export (0) Print
Expand All

Getting the ID Record for a File or Folder

The following VBScript example shows how to use the DfsrIdRecordInfo, DfsrReplicatedFolderConfig, DfsrReplicatedFolderInfo, and DfsrReplicationGroupConfig classes to get the ID record for a file or folder.

To run the script, which is in Windows Script Host (WSH) 2.0 XML file format, save the text in a file with a .wsf extension.


<?XML version="1.0" standalone="yes" ?>

<job id="FindIdRecord">
<runtime>
    <description>
        This script uses the DFSR WMI provider to get the ID record
        for a given file or folder.
    </description>
    <named 
        name="Server"
        helpstring="Server where the trace should start"
        type="string"
        required="true"
/>
    <named
        name="FilePath"
        helpstring="File Path for which the trace needs to be done"
        type="string"
        required="false"
/>
    <named
        name="FileUid"
        helpstring="File UID for which the trace needs to be done"
        type="string"
        required="false"
/>
    <named
        name="?"
        helpstring="Display help for this script"
        type="simple"
        required="false"
/>
</runtime>

<resource id="DfsrReplicationGroupConfig">DfsrReplicationGroupConfig</resource>
<resource id="DfsrReplicatedFolderConfig">DfsrReplicatedFolderConfig</resource>
<resource id="DfsrReplicatedFolderInfo">DfsrReplicatedFolderInfo</resource>
<resource id="DfsrIdRecordInfo">DfsrIdRecordInfo</resource>
<resource id="DfsrNamespace">\root\microsoftdfs</resource>

<resource id="ConfigError0">Success.</resource>
<resource id="ConfigError1">Registry key is not found.</resource> 
<resource id="ConfigError2">Registry key is not accessible.</resource>
<resource id="ConfigError3">Registry value is not found.</resource>
<resource id="ConfigError4">Registry value is not valid.</resource>
<resource id="ConfigError5">Generic registry error.</resource>
<resource id="ConfigError6">MSXML.dll Not installed.</resource>
<resource id="ConfigError7">Missing XML DOM.</resource>
<resource id="ConfigError8">XML DOM is not valid.</resource>
<resource id="ConfigError9">XML file not found.</resource>
<resource id="ConfigError10">XML file not accessible</resource>
<resource id="ConfigError11">Generic XML error.</resource>
<resource id="ConfigError12">Cannot connect to AD.</resource>
<resource id="ConfigError14">Generic AD error.</resource>
<resource id="ConfigError15">Bad XML\AD parameter.</resource>
<resource id="ConfigError16">Bad XML\AD parameter.</resource>
<resource id="ConfigError17">File path is not valid.</resource>
<resource id="ConfigError18">Volume not found.</resource>
<resource id="ConfigError19">Out of memory.</resource>
<resource id="ConfigError20">Configuration source mismatch.</resource>
<resource id="ConfigError21">Access denied.</resource>
<resource id="ConfigError22">Generic error.</resource>

<resource id="MonitorError0">Success.</resource>
<resource id="MonitorError1">Generic database error.</resource>
<resource id="MonitorError2">ID record not found.</resource>
<resource id="MonitorError3">Volume not found.</resource>
<resource id="MonitorError4">Access denied.</resource>
<resource id="MonitorError5">Generic error.</resource>

<reference object="Scripting.FileSystemObject"/>
<reference object="WbemScripting.SWbemLocator"/>

<script language="VBScript">
<![CDATA[
    Option Explicit
    
    Dim objWbemDateTime
    Set objWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")
    
    Call Main()
    
    Function WmiDateStringToDate(dtmDate)
        objWbemDateTime.Value = dtmDate
        WmiDateStringToDate = objWbemDateTime.GetVarDate
    End Function

    Sub DisplayWmiObject(objObjectToDisplay)
        Dim objPropValue, objProperty
        Dim strObjectClassName

        strObjectClassName = objObjectToDisplay.Path_.[Class]
        WScript.Echo objObjectToDisplay.Path_.Server & " " & strObjectClassName
        WScript.Echo _
            String(Len(objObjectToDisplay.Path_.Server) + _
                   Len(strObjectClassName) + 1, _
                   "-")
        For Each objProperty In objObjectToDisplay.Properties_
            objPropValue = objProperty.Value
            If ( objProperty.CIMType = wbemCimtypeDatetime ) Then
                objPropValue = WmiDateStringToDate(objPropValue)
            End If
            WScript.Echo objProperty.Name & _
                         Space(40-Len(objProperty.Name)) & _
                         " : " & _
                         objPropValue
        Next
    End Sub
    
    Function EscapeString(strStringToEscape)
        Dim strReturn
        
        strReturn = Replace(strStringToEscape, "\", "\\")
        strReturn = Replace(strReturn, "'", "\'")
        
        EscapeString = strReturn
    End Function
    
    Function ConstructQueryString(arrStrPropNames, _
                                  strClassName,    _
                                  strCondition)
        Dim strQuery
        Dim intIdx
        
        strQuery = "SELECT "
        If ( IsNull(arrStrPropNames) ) Then
            strQuery = strQuery & "*"
        Else
            strQuery = strQuery & arrStrPropNames(0)
            For intIdx = 1 To UBound(arrStrPropNames) - 1
                strQuery = strQuery & ", " & arrStrPropNames(intIdx)
            Next
        End If
        
        strQuery = strQuery & " FROM " & strClassName
        
        If ( NOT IsNull(strCondition) ) Then
            strQuery = strQuery & " WHERE " & strCondition
        End If

        ConstructQueryString = strQuery
    End Function
    
    Function GetQueryResult(objWmiConnector, _
                            arrStrPropNames, _
                            strClassName,    _
                            strCondition,    _
                            blnForwardOnly   _
                           )
        Dim objObjectSet
        Dim strQuery
        Dim intFlags
        
        strQuery = ConstructQueryString(arrStrPropNames, _
                                        strClassName, _
                                        strCondition)
        
        If ( blnForwardOnly ) Then
            intFlags = _
                wbemFlagReturnImmediately Or _
                wbemFlagForwardOnly
        Else
            intFlags = _
                wbemFlagReturnImmediately
        End If
        
        Set objObjectSet = objWmiConnector.ExecQuery(strQuery, _
                                                     "WQL", _
                                                     intFlags)
        
        If ( IsNull(objObjectSet) ) Then
            Dim strError
            
            strError = vbCrLf & "Query: " & strQuery & " Failed"
            strError = strError & vbCrLf
            strError = "Query returned no matches"
            Err.Raise 6670,,strError
        End If
        
        Set GetQueryResult = objObjectSet
    End Function
    
    Function GetSingleResultFromQuery(objWmiConnector, _
                                      arrStrPropNames, _
                                      strClassName,    _
                                      strCondition)                                      
        Dim objObjectSet, objObject
        
        Set objObjectSet = _
            GetQueryResult(objWmiConnector, _
                           arrStrPropNames, _
                           strClassName,    _
                           strCondition,    _
                           False)
                                      
        If ( objObjectSet.Count <> 1 ) Then
            Dim strError, strQuery
            strQuery = ConstructQueryString(arrStrPropNames, strClassName, strCondition)
            strError = vbCrLf & "Query: " & strQuery & " Failed"
            strError = strError & vbCrLf
            strError = strError & "Query Returned " _
                       & objObjectSet.Count & " matches"
            Err.Raise 6667,,strError
            Exit Function
        End If
        
        For Each objObject in objObjectSet
            Set GetSingleResultFromQuery = objObject
            Exit Function
        Next
    End Function
    
    Function ConstructObjectPath(strClassName, _
                                 strPropName,  _
                                 strPropValue, _
                                 intPropType)
        Dim strReturn
        
        strReturn = strClassName & "." & strPropName & "="
        
        Select Case intPropType
            Case wbemCimtypeChar16
                strReturn = strReturn & "'" & EscapeString(strPropValue) & "'"
            Case wbemCimtypeDateTime
                strReturn = strReturn & "'" & EscapeString(strPropValue) & "'"
            Case wbemCimtypeString
                strReturn = strReturn & "'" & EscapeString(strPropValue) & "'"
            Case Else
                strReturn = strReturn & strPropValue
        End Select
      
        ConstructObjectPath = strReturn
    End Function
    
    Function GetFileNameFromFullPath(strFullPath)
        Dim strTemp, strReturn
        Dim uintPos
        
        strTemp = Replace(strFullPath, "\\", "\")
        uintPos = InStrRev(strTemp, "\")
        If ( uintPos = Len(strTemp) ) Then
            uintPos = InStrRev(strTemp, "\", uintPos-1)
        End If
        
        strReturn = Right(strTemp, Len(strTemp)-uintPos)
        GetFileNameFromFullPath = strReturn        
    End Function
    
    Function IsTombstone(objIdRecordInfo)
        If ( (objIdRecordInfo.Flags And 1) = 1 ) Then
            IsTombstone = False
        Else
            IsTombstone = True
        End If
    End Function
    
    Function GetFullFilePathFromIdRecord(objIdRecordInfo)
        Dim uintRc
        Dim strFullFilePath
        
        uintRc = objIdRecordInfo.GetFullFilePath(strFullFilePath)
        
        If ( uintRc <> 0 ) Then
            Err.Raise 6673,,"GetFullFilePath failed.  Error: " & getResource("MonitorError" & uintRc)
            Exit Function
        End If
        
        GetFullFilePathFromIdRecord = strFullFilePath
    End Function
    
    Function GetIdRecordFromFullPath(objWmiConnector, _
                                     strFullFilePath)
        ' First find the replicated folder corresponding
        ' to this full file path.
        
        ' For this, get all configured replicated folders and
        ' search for a prefix match of the root folder against the
        ' given full file path. Because a proper configuration does not
        ' support root path overlap, you do not have to worry about
        ' longest prefix match.
        
        Dim objObjectSet
        Dim objDfsrRfConfig
        Dim objDfsrIdRecordInfo
        Dim objTombstoneIdRecordInfo
        Dim strRfFolderPath
        Dim strLcFullFilePath
        Dim strFilePathPrefix
        Dim strFileName
        Dim strCondition
        Dim blnRfFound
        Dim blnFoundTombstoneMatch
        
        strLcFullFilePath = LCase(strFullFilePath)
        
        ' Get all configured replicated folder root paths
        Set objObjectSet = _
            GetQueryResult(objWmiConnector, _
                           Array("RootPath", "ReplicatedFolderGuid"), _
                           getResource("DfsrReplicatedFolderConfig"),   _
                           Null, _
                           True)

        ' Find the replicated folder whose root path
        ' is a prefix of provided full file path
        blnRfFound = False
        For Each objDfsrRfConfig In objObjectSet
            strRfFolderPath = objDfsrRfConfig.RootPath
            If ( Len(strRfFolderPath) <= Len(strFullFilePath) ) Then
                strFilePathPrefix = Left(strLcFullFilePath, Len(strRfFolderPath))
                If ( strRfFolderPath = strFilePathPrefix ) Then
                    blnRfFound = True
                    Exit For
                End If
            End If
        Next

        If ( Not blnRfFound ) Then
            Err.Raise 6671,,"No Replicated Folder found for file path " & strFullFilePath
            Exit Function
        End If
        
        ' Extract the file name portion from supplied path
        strFileName = GetFileNameFromFullPath(strFullFilePath)
        
        ' Query: Select * From DfsrIdRecordInfo Where ReplicatedFolderGuid = '<value>' AND FileName = '<value>'
        strCondition = "ReplicatedFolderGuid = '" & _
                       EscapeString(objDfsrRfConfig.ReplicatedFolderGuid) & _
                       "' AND FileName = '" & _
                       EscapeString(strFileName) & _
                       "'"
        
        Set objObjectSet = _
            GetQueryResult(objWmiConnector, _
                           Null, _
                           getResource("DfsrIdRecordInfo"), _
                           strCondition, _
                           True)

        blnFoundTombstoneMatch = False
        For Each objDfsrIdRecordInfo In objObjectSet
            On Error Resume Next
            Dim strIdRecordFullFilePath
            strIdRecordFullFilePath = _
                GetFullFilePathFromIdRecord(objDfsrIdRecordInfo)
            On Error Goto 0
            If ( Right(strIdRecordFullFilePath, 1) = "\" ) Then
                strIdRecordFullFilePath = Left(strIdRecordFullFilePath, Len(strIdRecordFullFilePath)-1)
            End If
            If ( Err.Number = 0 ) Then
                If ( LCase(strIdRecordFullFilePath) = strLcFullFilePath ) Then
                    If ( IsTombstone(objDfsrIdRecordInfo) ) Then
                        Set objTombstoneIdRecordInfo = objDfsrIdRecordInfo
                        blnFoundTombstoneMatch = True
                    Else
                        Set GetIdRecordFromFullPath = objDfsrIdRecordInfo
                        Exit Function
                    End If
                End If
            Else
                Err.Clear
            End If
        Next
        
        If ( blnFoundTombstoneMatch ) Then
            Set GetIdRecordFromFullPath = objTombstoneIdRecordInfo
            Exit Function
        End If
        
        Err.Raise 6672,,"No ID Record found for file path " & strFullFilePath        
    End Function
    
    Sub Main
        Dim objNamedArgs
        Dim strComputer
        Dim objWmiService
        Dim objIdRecord
        Dim strObjPath, strCondition
        Dim strFullPath
    
        Set objNamedArgs   = WScript.Arguments.Named
    
        ' Display help if there are any unnamed arguments in the command line
        If ( WScript.Arguments.Unnamed.Length <> 0 ) Then
            WScript.Arguments.ShowUsage()
            WScript.Quit(1)
        End If
        
        ' Display help if there are not enough arguments, 
        ' help is requested or
        ' required arguments are not specified
        If ( objNamedArgs.Length < 1 Or _
             objNamedArgs.Exists("help") Or _
             objNamedArgs.Exists("?") Or _
             NOT objNamedArgs.Exists("Server") Or _
             (NOT objNamedArgs.Exists("FileUid") And _
              NOT objNamedArgs.Exists("FilePath")) ) Then
            WScript.Arguments.ShowUsage()
            WScript.Quit(1)
        End If
        
        strComputer = objNamedArgs("Server")
        
        ' Connect to the server's DFSR WMI namespace
        ' \\server\root\microsoftdfs
        Set objWmiService = _
            GetObject("winmgmts:\\" & strComputer & getResource("DfsrNamespace"))
        
        ' Get the ID record for the given file either using
        ' full file path or UID
        If ( objNamedArgs.Exists("FileUid") ) Then
            ' If UID was given, just get the record directly via WMI
            Dim strIdRecordPath
            strIdRecordPath = ConstructObjectPath(getResource("DfsrIdRecordInfo"), _
                                                  "Uid",                           _
                                                  objNamedArgs("FileUid"),         _
                                                  wbemCimtypeString)
            Set objIdRecord = objWmiService.Get(strIdRecordPath)
        Else
            ' If the full file path was given, get the record by
            ' issuing a query for it
            strFullPath = objNamedArgs("FilePath")
            Set objIdRecord = GetIdRecordFromFullPath(objWmiService, strFullPath)
        End If
        
        Call DisplayWmiObject(objIdRecord)
        If ( Not objNamedArgs.Exists("FilePath") ) Then
            strFullPath = GetFullFilePathFromIdRecord(objIdRecord)
            WScript.Echo "Full File Path: " & strFullPath
        End If
    
    End Sub
    
]]>
</script>

</job>

 

 

Show:
© 2015 Microsoft