Home > Uncategorized > DFS-R list backlogged file count and backlogged files

DFS-R list backlogged file count and backlogged files

Known limitation:
Although the below Windows Script File is likely okay for most needs, there is a known limitation in the file count returned by GetOutboundBacklogFileIdRecords(), which is 100. If you must obtain a full list, see a powershell script Get-DFSRBacklog.

The scripts and then the script:

I took two vbscripts (myehr and myehr) and smashed them into one for the purpose of obtaining backlogged file info, including a list of backlogged files.

This is useful to track pesky large files that are choking DFS-R on a receiving server.  It’s known that DFS-R will write (100% of the file size)+N, where N is the changed amount, to the receiving server per file (obviously the only thing written on the sending server is N).  So adding 1MB to 1024MB file will write 1MB to the sending server (program writes this), dfsr.exe writes 1025MB to the receiving server(s).

This means, do not use DFS-R to replicate large files that will be changed frequently or maybe ever; unless you have a ton of RAM and extremely low latency to your stable storage (HDDs) on your receiving server. Otherwise, replication “will take forever”.

Save this with WSF extension because it is Windows Script File.

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

<job id="GetBacklog">
<runtime>
    <description>
        This script uses the DFSR WMI provider to obtain 
        replication backlog information between two servers.
    </description>
    <named
        name="ReplicationGroupName"
        helpstring="Replication Group Name"
        type="string"
        required="true"
    />
    <named
        name="ReplicatedFolderName"
        helpstring="Replicated Folder Name"
        type="string"
        required="false"
    />
    <named 
        name="SendingServer"
        helpstring="The server sending files"
        type="string"
        required="true"
    />
    <named 
        name="ReceivingServer"
        helpstring="The server receiving files"
        type="string"
        required="true"
    />
    <named
        name="Twoway"
        helpstring="Get backlog both ways between given servers"
        type="simple"
        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="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 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

    Sub GetBacklog(objReceivingWmiConn, _
                   objSendingWmiConn,   _
                   objReceivingDfsrRfInfo)

        Dim strVv, strError
        Dim strObjPath
        Dim objSendingDfsrRfInfo
        Dim uintBacklogCount
        Dim uintRecordIdx
        Dim uintErr

        ' Get the version vector for receiving member
        uintErr = objReceivingDfsrRfInfo.GetVersionVector(strVv)

        If uintErr  0 Then
            Err.Raise 6668,,getResource("MonitorError" & CStr(uintErr))
            Exit Sub
        End If

        ' Get the relative object path to get the
        ' DfsrReplicatedFolderInfo instance from
        ' Serving side
        strObjPath = _
            objReceivingDfsrRfInfo.Path_.RelPath

        ' Get the DfsrReplicatedFolderInfo instance from
        ' Serving side
        On Error Resume Next
        Set objSendingDfsrRfInfo = _
            objSendingWmiConn.Get(strObjPath)

        If ( Err  0 ) Then
            WScript.Echo "Error Getting DfsrReplicatedFolderInfo instance " & _
                         "for Replicated Folder " &  _
                         objReceivingDfsrRfInfo.ReplicatedFolderName & _
                         " from Sending Server"
            WScript.Echo "Error Message: " & Err.Description & ", Code: " & Err.Number
            Exit Sub
        End If

        On Error Goto 0

        ' Get the backlogged file count from
        ' serving side given receiving side's 
        ' version vector
        uintErr = _
            objSendingDfsrRfInfo.GetOutboundBacklogFileCount( _
                strVv,            _
                uintBacklogCount, _
                uintRecordIdx)

        If uintErr  0 Then
            Err.Raise 6669,,getResource("MonitorError" & CStr(uintErr))
            Exit Sub
        End If

        'WScript.Echo objSendingDfsrRfInfo.Path_.Server &            _
        '             " -> " &                                       _
        '             objReceivingDfsrRfInfo.Path_.Server &          _
        '             ", Replicated Folder: " &                      _
        '             objReceivingDfsrRfInfo.ReplicatedFolderName &  _ 'State
        '             " is backlogged by: " &                        _
        '             uintBacklogCount &                             _
        '             " files"        

		wscript.echo "attempting to obtain list of dfsr backlogged files"

		dim arrDfsrIdRecordInfo() ' http://msdn.microsoft.com/en-us/library/bb540013(VS.85).aspx
		redim arrDfsrIdRecordInfo(uintBacklogCount)

		   uintErr = _
            objSendingDfsrRfInfo.GetOutboundBacklogFileIdRecords( _
                strVv,            _
                arrDfsrIdRecordInfo, _
                uintRecordIdx)

        If uintErr  0 Then
            Err.Raise 6669,,getResource("MonitorError" & CStr(uintErr))
            Exit Sub
        End If

		if uintBacklogCount 0 then 'if there are actually any backlogged files, get the info from their records
			' create a string of all the files to echo
			dim strListOfFilePaths, DfsrIdRecordInfo

			for each DfsrIdRecordInfo in arrDfsrIdRecordInfo
				strListOfFilePaths = strListOfFilePaths & vbnewline & GetFullFilePathFromIdRecord(DfsrIdRecordInfo)
			Next
		end if

		dim strReceivingDfsrRfState

		Select Case objReceivingDfsrRfInfo.State 'http://msdn.microsoft.com/en-us/library/windows/desktop/bb540019(v=vs.85).aspx#properties
		Case 0
			strReceivingDfsrRfState = "Uninitialized.  This isn't good!!!!!!!!"
		Case 1
			strReceivingDfsrRfState  = "Initialized.  This isn't good!!!!!!!!"
		Case 2
			strReceivingDfsrRfState = "Initial Sync.  This isn't the greatest thing."
		Case 3
			strReceivingDfsrRfState = "Auto recovery.  This isn't good!!!!!!!!"
		Case 4
			strReceivingDfsrRfState = "Normal"
		Case 5
			strReceivingDfsrRfState = "In Error.  This isn't good!!!!!!!!"
		End Select

        WScript.Echo objSendingDfsrRfInfo.Path_.Server &            _
                     " -> " &                                       _
                     objReceivingDfsrRfInfo.Path_.Server &          _
                     "Replicated Folder: " &                      _
                     objReceivingDfsrRfInfo.ReplicatedFolderName &  _
					 " Currently in a state of: " &				_
					 strReceivingDfsrRfState &						_
                     " Backlogged by: " &                        _
                     uintBacklogCount &                             _
                     " files (first 100): " &									_
					 vbnewline &									_
					 strListOfFilePaths

    End Sub

	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

    Sub Main
        Dim objNamedArgs
        Dim strSendingComputer, strReceivingComputer
        Dim objSendingWmiService, objReceivingWmiService
        Dim objClass
        Dim strObjPath, strCondition
        Dim objDfsrRgConfig
        Dim objDfsrRfInfo
        Dim objObjectSet
        Dim objTemp

        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("sendingserver") Or _
             NOT objNamedArgs.Exists("receivingserver") Or _
             NOT objNamedArgs.Exists("replicationgroupname") ) Then
            WScript.Arguments.ShowUsage()
            WScript.Quit(1)
        End If

        strReceivingComputer = objNamedArgs("ReceivingServer")
        strSendingComputer   = objNamedArgs("SendingServer")

        ' Connect to the receiving server's DFSR WMI namespace
        ' \\server\root\microsoftdfs
        Set objReceivingWmiService = _
            GetObject("winmgmts:\\" & strReceivingComputer & getResource("DfsrNamespace"))

        ' Connect to the sending server's DFSR WMI namespace
        ' \\server\root\microsoftdfs
        Set objSendingWmiService = _
            GetObject("winmgmts:\\" & strSendingComputer & getResource("DfsrNamespace"))

        ' Get the DfsrReplicationGroupConfig for given RG name
        ' from receiving server
        ' Query: Select ReplicationGroupGuid From DfsrReplicationGroupConfig Where ReplicationGroupName = ''
        strCondition = "ReplicationGroupName = '" & _
                       EscapeString(objNamedArgs("ReplicationGroupName")) & _
                       "'"
        Set objDfsrRgConfig = _
            GetSingleResultFromQuery(objReceivingWmiService, _
                                     Array("ReplicationGroupGuid"), _
                                     getResource("DfsrReplicationGroupConfig"), _
                                     strCondition)

        ' If a replicated folder name was specified
        ' Get backlog only for that folder
        If ( objNamedArgs.Exists("ReplicatedFolderName") ) Then
            ' Get DfsrReplicatedFolderInfo instance on receiving member
            ' Query: Select * From DfsrReplicatedFolderInfo Where ReplicationGroupGuid = '' AND ReplicatedFolderName = ''
            strCondition = "ReplicationGroupGuid = '" & _
                           objDfsrRgConfig.ReplicationGroupGuid & _
                           "' AND " & _
                           "ReplicatedFolderName = '" & _
                           EscapeString(objNamedArgs("ReplicatedFolderName")) & _
                           "'"
            Set objDfsrRfInfo = _
                GetSingleResultFromQuery(objReceivingWmiService, _
                                         Null, _
                                         getResource("DfsrReplicatedFolderInfo"), _
                                         strCondition)
            Call GetBacklog(objReceivingWmiService, _
                            objSendingWmiService,   _
                            objDfsrRfInfo)

            If ( Not objNamedArgs.Exists("Twoway") ) Then
                WScript.Quit(0)
            End If

            ' Swap sending and receiving sides
            Set objTemp = objSendingWmiService
            Set objSendingWmiService   = objReceivingWmiService
            Set objReceivingWmiService = objTemp

            ' Get the DfsrReplicatedFolderInfo instance on receiving member
            ' Query: Select * From DfsrReplicatedFolderInfo Where ReplicationGroupGuid = '' AND ReplicatedFolderName = ''
            Set objDfsrRfInfo = _
                GetSingleResultFromQuery(objReceivingWmiService, _
                                         Null, _
                                         getResource("DfsrReplicatedFolderInfo"), _
                                         strCondition)
            Call GetBacklog(objReceivingWmiService, _
                            objSendingWmiService,   _
                            objDfsrRfInfo)
        ' If no replicated folder name was specified
        ' Get backlog for all replicated folders in 
        ' specified replication group
        Else
            ' Get all DfsrReplicatedFolderInfo instances for
            ' given replication group
            strCondition = "ReplicationGroupGuid = '" & _
                           objDfsrRgConfig.ReplicationGroupGuid & _
                           "'"
            Set objObjectSet = _
                GetQueryResult(objReceivingWmiService, _
                               Null, _
                               getResource("DfsrReplicatedFolderInfo"), _
                               strCondition, _
                               True)

            Dim blnAtleastOneResult 
            blnAtleastOneResult = False

            For Each objDfsrRfInfo In objObjectSet
                blnAtleastOneResult = True
                Call GetBacklog(objReceivingWmiService, _
                                objSendingWmiService,   _
                                objDfsrRfInfo)
            Next

            If ( Not blnAtLeastOneResult ) Then
                WScript.Echo "Replication Group " & _
                             objNamedArgs("ReplicationGroupName") & _
                             " has no Replicated Folders"
                WScript.Quit(1)
            End If

            If ( Not objNamedArgs.Exists("Twoway") ) Then
                WScript.Quit(0)
            End If

            ' Swap sending and receiving sides
            Set objTemp = objSendingWmiService
            Set objSendingWmiService   = objReceivingWmiService
            Set objReceivingWmiService = objTemp

            ' Get all DfsrReplicatedFolderInfo instances for
            ' given replication group
            strCondition = "ReplicationGroupGuid = '" & _
                           objDfsrRgConfig.ReplicationGroupGuid & _
                           "'"
            Set objObjectSet = _
                GetQueryResult(objReceivingWmiService, _
                               Null, _
                               getResource("DfsrReplicatedFolderInfo"), _
                               strCondition, _
                               True)

            blnAtleastOneResult = False

            For Each objDfsrRfInfo In objObjectSet
                blnAtleastOneResult = True
                Call GetBacklog(objReceivingWmiService, _
                                objSendingWmiService,   _
                                objDfsrRfInfo)
            Next

            If ( Not blnAtLeastOneResult ) Then
                WScript.Echo "Replication Group " & _
                             objNamedArgs("ReplicationGroupName") & _
                             " has no Replicated Folders"
                WScript.Quit(1)
            End If
        End If

    End Sub
]]>
</script>

</job>
Advertisements
  1. HeyAdmin
    May 3, 2013 at 11:24 am

    I put this in vbsedit and I get an expected statement error on 1,1. What’s wrong?

  2. Franck
    July 9, 2013 at 10:18 am

    Hello,
    I have the same needs but no time to work on… So I was interested by your work.
    I have tested the script and I have found some miss (or error ?) :
    – the end of the script is missing : should finish by something like :
    end Sub
    ]]>

    – the test “If ( WScript.Arguments.Unnamed.Length = 0 ) Then” don’t works, I have replaced the “=” by “>”
    – the script finish already at the line 188 on error with a query result = 1 : I dont know why and the use of GetSingleResultFromQuery()…

    Regards,

    • July 9, 2013 at 12:24 pm

      That’s interesting and I have a copy of the script in production that I use daily… So I will take a look, compare and let you know.

    • July 15, 2013 at 11:07 am

      Hello again Franck,

      I have updated the script by closing the markup.

      Also note that I have copied these scripts from the Microsoft site, links indicated at the beginning of the article.

      As for your two bug reports:

      1) “wscript.arguments.unnamed.length = 0” has a totally different meaning than “wscript.arguments.unnamed.length > 0”. “wscript.arguments.unnamed.length = 0” should work, and is conditionally `true` when there are no named arguments (“names” are simply defined in this case as something like `/argumentName:value` )

      2) Line 188 is accessible only when an error is logged when querying. Are you sure you have spelled all the required arguments (ReplicationGroupName, ReplicatedFolderName, SendingServer, ReceivingServer, Twoway) and their parameters correctly, such as watching for case-sensitivity even [note I am not sure if that matters]?

      Thanks,

      Matt

  3. franck
    July 22, 2013 at 3:37 am

    Hello Matt,
    I just understand my main issues…. In the posted scipt, I don’t see some signs like “”
    line 181 :
    If ( objObjectSet.Count 1 ) Then
    correct value should be : If ( objObjectSet.Count 1 ) Then
    same in line 234, 251, 271, 296, 301, 348
    I’m modifying the scipt and forward the result soon…

    Thanks

    Franck

  4. franck
    July 22, 2013 at 4:29 am

    it works now.

  1. No trackbacks yet.

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: