This is the most important script I run, if a server is dead someone will tell me but if DFSR stops (and it does) the copies get out of sync very quick and then bad things happen.
I found I had to run the script from a scheduled task rather than from an entry in the bbwin config file, don't know why. The file backlog counting component is with all rights, thanks and attribs to Martin9700 at http://community.spiceworks.com/scripts/show/205-dfs-replication-monitor
Under Varaiable settings enter the path to write the test file and the path to where the file is replicated too. Don't use the DFS shares on the servers because even though you specifiy the servers if it's a DFS share AD can send you to either server.
There are 5 lines to enter the share paths but they are all contaminated and then the entries are split into pairs before processing
Regards
Graeme
option explicit
'Script to check DFS and DFS Replication
' Graeme Shea, Shea Technology Pty Ltd. 07/12/06
Dim oShell,oOutFile,oFSO,b64Bit, szLog, MFile, SFile, Status, ReplicationTime, YellowThreshold, strBacklogReport
Dim RedThreshold, ExtPath, szReportDetails, bCreateLog, aTestPaths, szTestPaths,szTestPaths1, c
Dim szTestPaths2, szTestPaths3, szTestPaths4, szTestPaths5, StartTime, FinishTime, strTemp, numBackLog, YellowBacklogThreshold, RedBacklogThreshold
Dim objExplorer, binFirstWindow, strFiles, strComputer, objWMIService, colRGroups, colRGConnections, oGroup, strResult, arrLines, arrResult
Dim colRGFolders, oFolder, strTRDomain, oConnection, binInbound, strPartner, strRGName, strRFName, strSendingComputer, strReceivingComputer
'**********************************************************************************************************
'Varaiable Settings
'The follow lines specify the paths (in pairs, on the same line). The script writes to the first location of the pair and reads
' from the second location of the pair. 5 lines are provided for conveance and all lines are concatinated
' before processing.
szTestPaths1 = "D:\apps, \\fs2\D$\apps"
szTestPaths2 = "D:\Home\students,\\fs2\D$\Home\students"
szTestPaths3 = "D:\Home\staff,\\fs2\D$\Home\staff"
szTestPaths4 = "D:\Home\staffCmn,\\fs2\D$\Home\staffCmn"
szTestPaths5 = ""
YellowThreshold = 20 'Seconds before yellow warning.
RedThreshold = 50 'Seconds before red warning, Max 60 seconds, Script only waits 60 Seconds.
YellowBacklogThreshold = 4 'Backlog file count before yellow warning.
RedBacklogThreshold = 20 'Backlog file count before red warning.
bCreateLog = False 'Create Log file for fault finding.
'**********************************************************************************************************
'Nothing to set below here.
' Graeme Shea, Shea Techology Pty Ltd. 22/03/07
'Ver 0.3 Changed 0 seconds to say less than 0.1 seconds
'Ver 0.9 Added check for replicated folder status using WMI
'Ver 0.9.1 Opens folder before writing file to fix inital unable to write test file issues
'Ver 0.9.2 Now BBWin compatable.
'Ver 0.9.3 Fixed incorrect time being reported.
'Ver 0.9.4 Adds backlog file counting.
'Ver 0.9.5 Adds replicated folder name to backlog table.
Const Version = "0.9.5 "
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Status = "green"
StartTime = Timer() 'Start Timer to make sure script does not run too long
Set oFSO= CreateObject("Scripting.FileSystemObject")
Set oShell = WScript.CreateObject("WScript.Shell")
strComputer = oShell.ExpandEnvironmentStrings( "%COMPUTERNAME%" )
WriteLog("Clear this log.")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\MicrosoftDFS")
'On Error Resume Next
ExtPath = GetBigBrotherPath()
On Error GoTo 0
'ExtPath = "C:" ' Used for testing if client not installed
WriteLog("Got BB Extpath as: " & ExtPath)
szTestPaths = szTestPaths1 & "," & szTestPaths2 & "," & szTestPaths3 & "," & szTestPaths4 & "," & szTestPaths5
szTestPaths = Replace(szTestPaths, ", ,", ",")
szTestPaths = Replace(szTestPaths, ",,", ",")
szTestPaths = Replace(szTestPaths, ",,", ",")
If (right(szTestPaths,1) = "," )Then szTestPaths = Left(szTestPaths, len(szTestPaths) -1)
aTestPaths = Split(szTestPaths, ",")
strBacklogReport = GetBacklogTable & vbCrLf 'Do this first so test files aren't counted in backlog.
GetFolderStatus() 'Get the status ( normal, error etc.) of replicated folders on this machine
For c = LBound(aTestPaths) To UBound(aTestPaths) Step 2
szReportDetails = szReportDetails & RunTest(aTestPaths(c), aTestPaths(c+ 1)) & vbCrLf
' Lets check how long the script has been running and stop it before BB start another instance.
FinishTime = Timer
'Lets make sure we are not running over midnight.
If FinishTime < StartTime Then
FinishTime = FinishTime + 86400
End If
If FinishTime - StartTime > 240 Then 'lets stop at 180 seconds.
szReportDetails = szReportDetails & VbCrLf & "&red Fatal Error, testing timed out."
If bCreateLog Then WriteLog( VbCrLf & "Fatal Error, testing timed out.")
Status = "red"
Exit For
End If
Next
szReportDetails = szReportDetails & VbCrLf & strBacklogReport
Set oOutFile = oFSO.CreateTextFile (ExtPath &"\DFS")
If bCreateLog Then WriteLog("Created Output file ")
oOutFile.WriteLine Status & " DFS replication check completed at "& Time
oOutFile.WriteBlankLines(1)
oOutFile.WriteLine szReportDetails
oOutFile.WriteLine "DFS File replication tester for Big Brother, BBDfsRep.vbs Version " & Version
oOutFile.Close
WriteLog("Finshed ")
WScript.quit
Function RunTest(Path1, Path2)
'************************************************************************************************
' runs the DFS repliciton test and returns results formated for BB output file
'************************************************************************************************
Dim ReplicationTime
If bCreateLog Then WriteLog("Testing replicaiton time for " & Path1 & " and " & Path2 )
ReplicationTime = TestReplication(Path1, Path2)
If bCreateLog Then WriteLog(" Got repliction time as " & ReplicationTime )
If IsNumeric(ReplicationTime) Then
If ReplicationTime < YellowThreshold Then
If ReplicationTime = 0 Then
RunTest = "&green Replication test from " & Path1 & " to " & Path2 & " took " & _
"Less than 0.1 seconds."
else
RunTest = "&green Replication test from " & Path1 & " to " & Path2 & " took " & _
ReplicationTime & " seconds."
end if
End If
If ReplicationTime => YellowThreshold Then
If ReplicationTime > 60 Then
Status = "red"
RunTest = "&red Replication test from " & Path1 & " to " & Path2 & " timed out at " & _
ReplicationTime & " seconds."
Else
If ReplicationTime > RedThreshold Then
Status = "red"
RunTest = "&red Replication test from " & Path1 & " to " & Path2 & " took " & _
ReplicationTime & " seconds."
Else
If Status <> "red" Then
Status = "yellow"
End If
RunTest = "&yellow Replication test from " & Path1 & " to " & Path2 & " took " & _
ReplicationTime & " seconds."
End If
End If
End If
Else
Status = "red"
RunTest = "&red Replication test from " & Path1 & " to " & Path2 & _
" Failed with the following error " & ReplicationTime
End If
End Function
Function TestReplication(szMaster, szSlave)
Dim testFile
Dim i
Dim FSO
Dim szFileName
Dim f
On Error Resume Next
Set FSO= CreateObject("Scripting.FileSystemObject")
'Need to create a random file name for avoide conflicts
szFileName = "\DFSTest" & round((rnd() * 10000000))& ".txt"
' Clean up the paths
szMaster = Trim(szMaster)
If Right(szMaster,1) = "\" Then
szMaster = Left(szMaster, Len(szMaster) - 1)
End If
szSlave = Trim(szSlave)
If Right(szSlave,1) = "\" Then
szSlave = Left(szSlave, Len(szSlave) - 1)
End If
If bCreateLog Then WriteLog("Testing replication from " & szMaster & " to " & szSlave)
i = 0
Set f = fso.GetFolder(szMaster)
Set f = fso.GetFolder(szSlave)
set f = Nothing
Set testFile = FSO.CreateTextFile (szMaster & szFileName, True)
If Err Then
TestReplication = "Error Unable to write " & szMaster & szFileName & ". Error number " & _
Err.Number & " Error description " & Err.Description
Err.Clear
Exit Function
End If
testFile.WriteLine ("File for automated DFS repliction testing. Created " & now)
testFile.Close
Do While Not oFSO.FileExists(szSlave & szFileName)
i = i + 1
If i > 600 Then
If bCreateLog Then WriteLog("Replicaion test timed out at " & i & " seconds")
Exit Do
End If
WScript.Sleep(100)
Loop
'i gives us the count of tenths of seconds it took for the file to be replicated.
if not i = 0 Then
i = i/10
End If
oFSO.DeleteFile szMaster & szFileName,True
TestReplication = i
End Function
Sub WriteLog(szText)
Dim oLogFile
If bCreateLog Then
If szText = "Clear this log." Then
Set oLogFile = oFSO.OpenTextFile (ExtPath &"\DFS.log", ForWriting, True)
'oLogFile.Close
'Exit Sub
szText = "Beginning "
Else
Set oLogFile = oFSO.OpenTextFile (ExtPath &"\DFS.log", ForAppending,True)
End If
oLogFile.WriteLine (szText & " at time " & time)
oLogFile.Close
'szLog = szLog & szText & vbCrLf
End If
End Sub
Sub GetFolderStatus()
'States
'Uninitialized = 0
'Initialized = 1
'InitialSync = 2
'AutoRecovery = 3
'Normal = 4
'InError = 5
'Dim objWMIService
Dim colItems
Dim objItem
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
'Set objWMIService = GetObject("winmgmts:\\" & "localhost" & "\root\MicrosoftDfs")
Set colItems = objWMIService.ExecQuery("SELECT * FROM DfsrReplicatedFolderInfo", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
Select Case objItem.State
Case 0
szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
& " in group " & objItem.ReplicationGroupName & " Reports it is not yet initialised" & VbCrLf
If Status <> "red" Then Status = "yellow"
Case 1
szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
& " in group " & objItem.ReplicationGroupName & " Reports it is Initialised" & VbCrLf
If Status <> "red" Then Status = "yellow"
Case 2
szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
& " in group " & objItem.ReplicationGroupName & " Reports it is in initial sync" & VbCrLf
If Status <> "red" Then Status = "yellow"
Case 3
szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
& " in group " & objItem.ReplicationGroupName & " Reports it is in Auto Recovery" & VbCrLf
szReportDetails = szReportDetails & "&yellow Last error code = " & objItem.LastErrorCode _
& " Last error msg id = " & objItem.LastErrorMessageId & VbCrLf
If Status <> "red" Then Status = "yellow"
Case 4
szReportDetails = szReportDetails & "&green Folder " & objItem.ReplicatedFolderName _
& " in group " & objItem.ReplicationGroupName & " Reports its status is normal " & VbCrLf
Case 5
szReportDetails = szReportDetails & "&red Folder " & objItem.ReplicatedFolderName _
& " in group " & objItem.ReplicationGroupName & " Reports it is in Error" & VbCrLf
szReportDetails = szReportDetails & "&red Last error code = " & objItem.LastErrorCode _
& " Last error msg id = " & objItem.LastErrorMessageId & VbCrLf
Status = "red"
Case Else
szReportDetails = szReportDetails & "&yellow Folder " & objItem.ReplicatedFolderName _
& " in group " & objItem.ReplicationGroupName & " Condition unknown" & VbCrLf
szReportDetails = szReportDetails & "&yellow Last error code = " & objItem.LastErrorCode _
& " Last error msg id = " & objItem.LastErrorMessageId & VbCrLf
If Status <> "red" Then Status = "yellow"
End Select
Next
szReportDetails = szReportDetails & VbCrLf
End Sub
' Get path to external log files (for BB 1.08d)
Function GetBigBrotherPath()
Dim ExtPath
On Error Resume Next
ExtPath = oShell.RegRead("HKLM\SOFTWARE\Quest Software\BigBrother\bbnt\ExternalPath\")
If IsEmpty(ExtPath) Then
ExtPath = oShell.RegRead("HKLM\SOFTWARE\BBWin\tmppath")
End If
If Not IsEmpty (ExtPath) Then 'If not empty then we have 32bit machine
b64Bit = False
End If
If IsEmpty(ExtPath) Then
ExtPath = oShell.RegRead("HKLM\SOFTWARE\Wow6432node\Quest Software\BigBrother\bbnt\ExternalPath\")
End If
If IsEmpty(ExtPath) Then
ExtPath = oShell.RegRead("HKLM\SOFTWARE\Wow6432node\BBWin\tmppath")
End If
If Not IsEmpty(ExtPath) And isEmpty(b64Bit) Then
b64Bit = True
err.clear
End If
If IsEmpty(ExtPath) Then
'Put exit stuff here
End If
on Error GoTo 0
GetBigBrotherPath = ExtPath
End Function
Function PadToLength(strText)
While Len(strText) < 25
strText = strText & " "
Wend
PadToLength = strText
End Function
'#--------------------------------------------------------------------------
'# FUNCTION.......: GetBacklogTable
'# PURPOSE........: Discovers DFS tree's and returns a table displaying backlog counts
'#
'# ARGUMENTS......:
'# EXAMPLE........:
'# NOTES..........: Most (but not all) of from here down is by and with all rights, thanks and attribs to Martin9700
'# at http://community.spiceworks.com/scripts/show/205-dfs-replication-monitor
'#--------------------------------------------------------------------------
Function GetBacklogTable()
WriteLog( VbCrLf & "Entered GetBacklogTable.")
Dim strHTML
strHTML = PadToLength("Replication Group") & PadToLength("Replicated Folder") & PadToLength("Sending Partner") & PadToLength("Receiving Partner") & "Backlog (Files)" & vbCrLf
'Set oWMIService = GetObject("winmgmts:\\" & strComputer & "\root\MicrosoftDFS")
Set colRGroups = objWMIService.ExecQuery("SELECT * FROM DfsrReplicationGroupConfig")
WriteLog( VbCrLf & "Got colRGroups.")
For Each oGroup in colRGroups
Set colRGFolders = objWMIService.ExecQuery("SELECT * FROM DfsrReplicatedFolderConfig WHERE ReplicationGroupGUID='" & oGroup.ReplicationGroupGUID & "'")
WriteLog( VbCrLf & "Got colRGFolders.")
For Each oFolder in colRGFolders
Set colRGConnections = objWMIService.ExecQuery("SELECT * FROM DfsrConnectionConfig WHERE ReplicationGroupGUID='" & oGroup.ReplicationGroupGUID & "'")
WriteLog( VbCrLf & "Got colRGConnections.")
strTRDomain = "d1"
For Each oConnection In colRGConnections
WriteLog( VbCrLf & "Got oConnection.")
binInbound = oConnection.Inbound
strPartner = oConnection.PartnerName
strRGName = oGroup.ReplicationGroupName
strRFName = oFolder.ReplicatedFolderName
If binInbound = True Then
strSendingComputer = strPartner
strReceivingComputer = strComputer
Else
strSendingComputer = strComputer
strReceivingComputer = strPartner
End If
If oConnection.Enabled = True Then
If strTRDomain = "d1" Then
strTRDomain = "d0"
Else
strTRDomain = "d1"
End If
WriteLog( VbCrLf & "Getting backlog, " & strSendingComputer & ", " & strReceivingComputer & ", " & strRGName & ", " & strRFName)
numBackLog = getBackLog(strSendingComputer, strReceivingComputer, strRGName, strRFName)
WriteLog( VbCrLf & "Backlog = " & numBackLog )
If CDbl(RedBacklogThreshold) < CDbl(numBackLog) Then
WriteLog("RedBacklogThreshold = " & RedBacklogThreshold)
WriteLog("numBackLog = " & numBackLog)
strHTML = strHTML & "&red"
Status = "red"
ElseIf CDbl(YellowBacklogThreshold) < CDbl(numBackLog) Then
strHTML = strHTML & "&yellow"
If Status = "green" Then Status = "yellow"
Else
strHTML = strHTML & "&green"
End If
If strSendingComputer = "." Then strSendingComputer = "LocalHost"
If strReceivingComputer = "." Then strReceivingComputer = "LocalHost"
strHTML = strHTML & PadToLength(strRGName) & PadToLength(strRFName) & PadToLength(strSendingComputer)
strHTML = strHTML & PadToLength(strReceivingComputer) & numBackLog & " Files." & vbCrLf 'strFiles & vbCrLf
End If
Next
Next
Next
strHTML = strHTML & vbCrLf & "List of Backlogged Files." & vbCrLf
strHTML = strHTML & vbCrLf & strFiles & vbCrLf
strHTML = strHTML & vbCrLf & "Last run on: " & date & ", " & Time & vbCrLf
'MsgBox(strHTML)
GetBacklogTable = strHTML
End Function
'#--------------------------------------------------------------------------
'# SUBROUTINE.....: showTable (Not used)
'# PURPOSE........: Displays HTML data in open window
'# ARGUMENTS......: strText: string variable of what to display, the
'# more HTML the better it looks!
'# EXAMPLE........:
'# NOTES..........:
'#--------------------------------------------------------------------------
Sub showTable(strText)
If binShowWindow = False Then
Exit Sub
End If
If binFirstWindow = False Then
binFirstWindow = True
Set objExplorer = WScript.CreateObject("InternetExplorer.Application")
With objExplorer
.Navigate "about:blank"
.ToolBar = 0
.StatusBar = 0
.Width = 750
.Height = 600
.Left = 0
.Top = 0
End With
Do While (objExplorer.Busy)
Wscript.Sleep 200
Loop
objExplorer.Visible = 1
End If
On Error Resume Next
objExplorer.Document.Body.InnerHTML = strText
If Err.Number <> 0 Then
Wscript.Quit
End If
On Error Goto 0
End Sub
'#--------------------------------------------------------------------------
'# FUNCTION.......: getBackLog
'# PURPOSE........: Retrieves the # of backlogged files, if any. If there
'# are it also enumerates what files
'# ARGUMENTS......: strSending: sending server name
'# strReceiving: receiving server name
'# strReplicationGroup: DFS replication group
'# strReplicatedFolder: DFS folder being replicated
'# EXAMPLE........:
'# NOTES..........:
'#--------------------------------------------------------------------------
Function getBackLog(strSending, strReceiving, strReplicationGroup, strReplicatedFolder)
Dim x, objExec, fso, file
WriteLog( VbCrLf & "Entered Getbacklog.")
Set oShell = CreateObject ("Wscript.shell")
WriteLog( VbCrLf & "Created oShell.")
'On Error Resume Next
WriteLog("Running...DFSRDiag Backlog /RGName:" & strReplicationGroup & " /RFName:" & strReplicatedFolder & " /SendingMember:" & strSending & " /ReceivingMember:" & strReceiving )
'objExec = oshell.run("dfsrdiag.exe Backlog /RGName:" & strReplicationGroup & " /RFName:" & strReplicatedFolder & " /SendingMember:" & strSending & " /ReceivingMember:" & strReceiving & " > c:\output.txt", 0, true)
Set objExec = oshell.Exec("dfsrdiag.exe Backlog /RGName:""" & strReplicationGroup & """ /RFName:""" & strReplicatedFolder & """ /SendingMember:" & strSending & " /ReceivingMember:" & strReceiving)
WriteLog("Finished running DFSRDiag.")
If Err.Number Then WriteLog Err.Description
strResult = ""
strTemp = ""
Do While Not objExec.StdOut.AtEndOfStream
strResult = strResult & objExec.StdOut.ReadLine() & "\\"
WriteLog( "Looping")
Loop
WriteLog( VbCrLf & "Finished loop.")
WriteLog( VbCrLf & "strResult = " & strResult)
If InStr(strResult, "No Backlog") > 0 or InStr(strResult, "[ERROR]") > 0 Then
getBackLog = 0
WriteLog("getBacklog = " & getBackLog)
Else
arrLines = Split(strResult, "\\")
WriteLog("Split strResult to arrLines.")
arrResult = Split(arrLines(1), ":")
WriteLog("Split arrLines to arrResult.")
getBackLog = arrResult(1)
WriteLog("getBacklog from arrResult = " & getBackLog)
If UBound(arrLines) > 1 Then
strTemp = ""
For x = 2 to UBound(arrLines)
If InStr(arrLines(x), "Succeeded") = 0 and arrLines(x) <> "" Then
strTemp = strTemp & arrLines(x) & vbCrLf
End If
Next
End If
End If
strFiles = strFiles & strTemp
End Function
-----Original Message-----
From: Xymon [mailto:xymon-bounces at xymon.com] On Behalf Of Colin Coe
Sent: Friday, 14 March 2014 10:06 AM
To: xymon at xymon.com
Subject: [Xymon] Monitoring DFS-R (2012)
Hi all
Just wondering if anyone is monitoring Windows Server 2012 DFS-R with
Xymon? If so, any chance of sharing?
Thanks
CC
--
RHCE#805007969328369
Important - This email and any attachments may be confidential. If received in error, please contact us and delete all copies. Before opening or using attachments check them for viruses and defects. Regardless of any loss, damage or consequence, whether caused by the negligence of the sender or not, resulting directly or indirectly from the use of any attached files our liability is limited to resupplying any affected attachments. Any representations or opinions expressed are those of the individual sender, and not necessarily those of the Department of Education and Early Childhood Development.