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
Post a Comment