DFSR Backlog Checker - via WMI (Thnx stichl.at) - added IE to make interface cleaner.

strComputer = "localhost"
bConnectForeign = False
'''http://stichl.at/2012/11/quick-dfsr-backlog-count-with-vbscript/
Dim objIE, objShell, k, strIETitle, blnFlag

' Set IE display box title. Dashes ("-") are to move the Microsoft title
' appended to the title we specify out of view.
' blnFlag is set to False when the user closes the IE display box.
strIETitle = "Backlog" & String(40, "-")
blnFlag = True

Set objShell = CreateObject("WScript.Shell")

dim StrMsg
call Main

sub Main()

' Initialize display box with initial message
InitIE "Program Initializing"

    Set oWMIService = GetObject("winmgmts:\\" & strComputer & "\root\MicrosoftDFS")
    Set colRGroups = oWMIService.ExecQuery("SELECT * FROM DfsrReplicationGroupConfig")
    For Each oGroup in colRGroups
        AddMsg( "Replication Group: " & oGroup.ReplicationGroupName)
        Set colRGFolders = oWMIService.ExecQuery("SELECT * FROM DfsrReplicatedFolderConfig WHERE ReplicationGroupGUID='" & oGroup.ReplicationGroupGUID & "'")
        For Each oFolder in colRGFolders
            AddMsg( "  Folder: " & oFolder.ReplicatedFolderName)
            Set colRGConnections = oWMIService.ExecQuery("SELECT * FROM DfsrConnectionConfig WHERE ReplicationGroupGUID='" & oGroup.ReplicationGroupGUID & "'")
            For Each oConnection in colRGConnections
                If oConnection.Enabled = True Then
                    If oConnection.Inbound = True Then
                        if bConnectForeign then
                            numBackLog = getBackLogCount(oConnection.PartnerName, oConnection.ConnectionGUID)
                        else
                            numBackLog = getBackLogCount(strComputer, oConnection.ConnectionGUID)
                        end if
                        AddMsg( "    " & strComputer & " <-- span=""> & oConnection.PartnerName & " :: " & numBackLog   )                  
       Else                         
        numBackLog = getBackLogCount(strComputer, oConnection.ConnectionGUID)                         
        AddMsg( "    " & strComputer & " --> " & oConnection.PartnerName & " :: " & numBackLog)
                    End If
                End If
            Next
        Next
    Next
  MsgIE StrMsg
end Sub

Function getBackLogCount(strComputer, ConnectionGUID)
    Set oWMIService = GetObject("winmgmts:\\" & strComputer & "\root\MicrosoftDFS")
    Set oDfsIUI = oWMIService.ExecQuery("SELECT * FROM DfsrIdUpdateInfo WHERE ConnectionGuid = '" & ConnectionGUID & "'")
    numBacklog=0
    for each eDfsIUI in oDfsIUI
        numBackLog=numBackLog+1
    next
    getBackLogCount = numBackLog
End Function

Sub AddMsg(Message)
 strMsg=Strmsg & Message & VBCR
end sub

Sub MsgIE(ByVal strMsg)
    ' Subroutine to display message in IE box and detect when the
    ' box is closed by the program or the user.
    On Error Resume Next
    If (strMsg = "IE_Quit") Then
        blnFlag = False
        objIE.Quit
    Else
        objIE.Document.Body.InnerText = strMsg
        If (Err.Number <> 0) Then
            Err.Clear
            blnFlag = False
            Exit Sub
        End If
        objShell.AppActivate strIETitle
    End If
End Sub

Sub InitIE(ByVal strMsg)
    ' Subroutine to initialize the IE display box.
    Dim intWidth, intHeight, intWidthW, intHeightW
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.ToolBar = False
    objIE.StatusBar = False
    objIE.Resizable = False
    objIE.Navigate("about:blank")
    Do Until objIE.readyState = 4
        Wscript.Sleep 100
    Loop
    'intWidth = 400 ''objIE.document.ParentWindow.Screen.AvailWidth
    'intHeight = 600 ''objIE.document.ParentWindow.Screen.AvailHeight
    'intWidthW = objIE.document.ParentWindow.Screen.AvailWidth * .40
    'intHeightW = objIE.document.ParentWindow.Screen.AvailHeight * .05
    objIE.document.ParentWindow.resizeto 400, 600
    objIE.document.ParentWindow.moveto (intWidth - intWidthW)/2, (intHeight - intHeightW)/2
    objIE.document.Write " " & strMsg & " 
" 'objIE.document.ParentWindow.document.body.style.backgroundcolor = "LightBlue" 'objIE.document.ParentWindow.document.body.scroll="no" 'objIE.document.ParentWindow.document.body.style.Font = "10pt 'Courier New'" 'objIE.document.ParentWindow.document.body.style.borderStyle = "outset" 'objIE.document.ParentWindow.document.body.style.borderWidth = "4px" objIE.document.Title = strIETitle objIE.Visible = True Wscript.Sleep 100 objShell.AppActivate strIETitle End Sub

Comments

Popular posts from this blog

Revit area plans adding new types and references (Gross and rentable)

Powerpoint countdown and current time in slides VBA

Revit 2019 and up tab colorizer