次の方法で共有


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>