Note
Access to this page requires authorization. You can try signing in or changing directories.
Access to this page requires authorization. You can try changing directories.
The following VBScript example shows how to use the DfsrConnectionConfig, DfsrIdRecordInfo, DfsrReplicatedFolderConfig, DfsrReplicatedFolderInfo, DfsrReplicationGroupConfig, and DfsrVolumeInfo classes to find the server that originated a file or folder update.
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="FindUpdateOrigin">
<runtime>
<description>
This script uses the DFSR WMI provider to attempt to find the server that
originated a file/folder update. Tracing can start with either the full file
path for the update to be traced or the UID of the update to be traced.
</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="DfsrConnectionConfig">DfsrConnectionConfig</resource>
<resource id="DfsrReplicatedFolderInfo">DfsrReplicatedFolderInfo</resource>
<resource id="DfsrIdRecordInfo">DfsrIdRecordInfo</resource>
<resource id="DfsrVolumeInfo">DfsrVolumeInfo</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.Dictionary"/>
<reference object="Scripting.FileSystemObject"/>
<reference object="WbemScripting.SWbemLocator"/>
<script language="VBScript">
<![CDATA[
Option Explicit
Dim objWbemDateTime
Set objWbemDateTime = CreateObject("WbemScripting.SWbemDateTime")
Dim objCreatorVolumeInfo, objUpdaterVolumeInfo
Dim strCreatorName, strUpdaterName
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
WScript.StdOut.WriteLine
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 GetGuidFromUidOrGvsn(strUidOrGvsn)
Dim uintPos
' Search for '}' from the end
uintPos = InStrRev(strUidOrGvsn, "}")
If ( uintPos <> 0 ) Then
' Get the position of the '}'
' The GUID is what's between the '{' and the '}'
Dim strReturn
strReturn = Left(strUidOrGvsn, uintPos-1)
strReturn = Right(strReturn, Len(strReturn)-1)
GetGuidFromUidOrGvsn = strReturn
Else
Err.Raise 6674,,"UID Or GVSN is not in the right format: " & strUidOrGvsn
End If
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)
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)
' 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.
' 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)
' Because only fully qualified file names are unique, you can have
' multiple matches for the above query. Even with a fully qualified
' file name, multiple ID records are possible due to name conflicts
blnFoundTombstoneMatch = False
For Each objDfsrIdRecordInfo In objObjectSet
On Error Resume Next
Dim strIdRecordFullFilePath
' For each ID record get the full file path
strIdRecordFullFilePath = _
GetFullFilePathFromIdRecord(objDfsrIdRecordInfo)
On Error Goto 0
' Root path quirk - append '\' to the root path
If ( Right(strIdRecordFullFilePath, 1) = "\" ) Then
strIdRecordFullFilePath = Left(strIdRecordFullFilePath, Len(strIdRecordFullFilePath)-1)
End If
If ( Err.Number = 0 ) Then
' If the fully qualified file name of the ID record matches the one given
If ( LCase(strIdRecordFullFilePath) = strLcFullFilePath ) Then
' If it is a tombstoned record, see if there is a live one that matches
' Save the tombstone match in case there isn't one
If ( IsTombstone(objDfsrIdRecordInfo) ) Then
Set objTombstoneIdRecordInfo = objDfsrIdRecordInfo
blnFoundTombstoneMatch = True
' If there is a live match, that's what we're interested in
Else
Set GetIdRecordFromFullPath = objDfsrIdRecordInfo
Exit Function
End If
End If
Else
Err.Clear
End If
Next
' If there was no live match, but a tombstone match was found
' return that instead
If ( blnFoundTombstoneMatch ) Then
Set GetIdRecordFromFullPath = objTombstoneIdRecordInfo
Exit Function
End If
Err.Raise 6672,,"No ID Record found for file path " & strFullFilePath
End Function
Sub FindUpdaterAndOrigin(objWmiConnector, _
strCreatorGuidQuery, _
strUpdaterGuidQuery, _
strConnectionQuery, _
objServersToProcessTable, _
objServersProcessedTable, _
blnCreatorFound, _
blnUpdaterFound, _
strServer _
)
Dim objObjectSet
Dim objVolumeInfo
If ( Not blnCreatorFound ) Then
On Error Resume Next
Set objObjectSet = objWmiConnector.ExecQuery(strCreatorGuidQuery, _
"WQL", _
(wbemFlagReturnImmediately Or _
wbemFlagForwardOnly))
If ( Err.Number = 0 And _
Not IsNull(objObjectSet) ) Then
For Each objVolumeInfo in objObjectSet
Set objCreatorVolumeInfo = objVolumeInfo
strCreatorName = objCreatorVolumeInfo.Path_.Server
blnCreatorFound = True
Exit For
Next
Else
WScript.Echo "Error Searching: " & strServer
If ( Err.Number <> 0 ) Then
WScript.Echo "Error Code: " & Err.Number & ", Message: " & Err.Description
Else
WScript.Echo "Query: " & strCreatorGuidQuery & vbCrLf
WScript.Echo "Did not find any matches"
End If
End If
On Error Goto 0
End If
If ( Not blnUpdaterFound ) Then
On Error Resume Next
Set objObjectSet = objWmiConnector.ExecQuery(strUpdaterGuidQuery, _
"WQL", _
(wbemFlagReturnImmediately Or _
wbemFlagForwardOnly))
If ( Err.Number = 0 And _
Not IsNull(objObjectSet) ) Then
For Each objVolumeInfo in objObjectSet
Set objUpdaterVolumeInfo = objVolumeInfo
strUpdaterName = objUpdaterVolumeInfo.Path_.Server
blnUpdaterFound = True
Exit For
Next
Else
WScript.Echo "Error Searching: " & strServer
If ( Err.Number <> 0 ) Then
WScript.Echo "Error Code: " & Err.Number & ", Message: " & Err.Description
Else
WScript.Echo "Query: " & strUpdaterGuidQuery & vbCrLf
WScript.Echo "Did not find any matches"
End If
End If
On Error Goto 0
End If
If ( Not blnCreatorFound Or _
Not blnUpdaterFound ) Then
On Error Resume Next
Set objObjectSet = objWmiConnector.ExecQuery(strConnectionQuery, _
"WQL", _
(wbemFlagReturnImmediately Or _
wbemFlagForwardOnly))
If ( Err.Number = 0 And _
Not IsNull(objObjectSet) ) Then
Dim objConnectionConfig
For Each objConnectionConfig in objObjectSet
Dim strTemp
strTemp = objConnectionConfig.PartnerName
If ( Not objServersProcessedTable.Exists(strTemp) And _
Not objServersToProcessTable.Exists(strTemp) ) Then
WScript.Echo "Adding " & strTemp & " to search list"
Call objServersToProcessTable.Add(strTemp, strTemp)
End If
Next
Else
WScript.Echo "Error Searching: " & strServer
If ( Err.Number <> 0 ) Then
WScript.Echo "Error Code: " & Err.Number & ", Message: " & Err.Description
Else
WScript.Echo "Query: " & strConnectionQuery & vbCrLf
WScript.Echo "Did not find any matches"
End If
End If
On Error Goto 0
End If
End Sub
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
WScript.Echo "Found the ID Record on Server: " & strServer
Call DisplayWmiObject(objIdRecord)
Dim strRgGuid
Dim objRfInfo
strObjPath = ConstructObjectPath(getResource("DfsrReplicatedFolderInfo"), _
"ReplicatedFolderGuid", _
objIdRecord.ReplicatedFolderGuid, _
wbemCimtypeString)
Set objRfInfo = objWmiService.Get(strObjPath)
strRgGuid = objRfInfo.ReplicationGroupGuid
Dim objServersBeingProcessedTable
Dim objServersToProcessTable
Dim objServersProcessedTable
Dim strServer
Dim strCreatorDbGuid, strUpdaterDbGuid
Dim blnMoreServersToSearch
Dim blnCreatorFound, blnModifierFound
Dim strCreatorQuery, strUpdaterQuery
Dim strConnectionQuery
strCreatorDbGuid = GetGuidFromUidOrGvsn(objIdRecord.Uid)
strUpdaterDbGuid = GetGuidFromUidOrGvsn(objIdRecord.Gvsn)
strCondition = "ReplicationGroupGuid = '" & _
EscapeString(strRgGuid) & _
"' And Inbound=True"
strConnectionQuery = _
ConstructQueryString(Array("PartnerName"), _
getResource("DfsrConnectionConfig"), _
strCondition)
strCondition = "DatabaseGuid = '" & _
EscapeString(strCreatorDbGuid) & _
"'"
strCreatorQuery = _
ConstructQueryString(Null, _
getResource("DfsrVolumeInfo"), _
strCondition)
strCondition = "DatabaseGuid = '" & _
EscapeString(strUpdaterDbGuid) & _
"'"
strUpdaterQuery = _
ConstructQueryString(Null, _
getResource("DfsrVolumeInfo"), _
strCondition)
Set objServersBeingProcessedTable = _
CreateObject("Scripting.Dictionary")
Set objServersToProcessTable = _
CreateObject("Scripting.Dictionary")
Set objServersProcessedTable = _
CreateObject("Scripting.Dictionary")
Call objServersBeingProcessedTable.Add(strComputer, strComputer)
blnMoreServersToSearch = True
blnCreatorFound = False
blnModifierFound = False
While ( blnMoreServersToSearch And _
(Not blnCreatorFound Or _
Not blnModifierFound) )
For Each strServer In objServersBeingProcessedTable.Keys
On Error Resume Next
' Connect to the server's DFSR WMI namespace
' \\server\root\microsoftdfs
Set objWmiService = _
GetObject("winmgmts:\\" & strServer & getResource("DfsrNamespace"))
On Error Goto 0
If ( Err.Number = 0 ) Then
WScript.Echo "Searching Server: " & strServer
Call FindUpdaterAndOrigin(objWmiService, _
strCreatorQuery, _
strUpdaterQuery, _
strConnectionQuery, _
objServersToProcessTable, _
objServersProcessedTable, _
blnCreatorFound, _
blnModifierFound, strServer)
If ( Err.Number <> 0 ) Then
WScript.Echo "Error searching Server: " & strServer
WScript.Echo "Error Code: " & Err.Number & ", Message: " & Err.Description
Err.Clear
End If
Else
WScript.Echo "Error connecting to Server: " & strServer
WScript.Echo "Error Code: " & Err.Number & ", Message: " & Err.Description
Err.Clear
End If
Call objServersProcessedTable.Add(strServer, strServer)
If ( blnCreatorFound And blnModifierFound ) Then
Exit For
End If
Next
Call objServersBeingProcessedTable.RemoveAll()
If ( Not blnCreatorFound Or _
Not blnModifierFound ) Then
If ( objServersToProcessTable.Count > 0 ) Then
blnMoreServersToSearch = True
For Each strServer In objServersToProcessTable.Keys
Call objServersBeingProcessedTable.Add(strServer, strServer)
Next
Call objServersToProcessTable.RemoveAll()
Else
blnMoreServersToSearch = False
End If
End If
Wend
WScript.StdOut.WriteLine
If ( blnCreatorFound ) Then
WScript.Echo "File: " & strFullPath & " was created by " & strCreatorName
Call DisplayWmiObject(objCreatorVolumeInfo)
Else
WScript.Echo "File: " & strFullPath & ", Couldn't find creator"
End If
If ( blnModifierFound ) Then
WScript.Echo "File: " & strFullPath & " was last modified by " & strUpdaterName
Call DisplayWmiObject(objUpdaterVolumeInfo)
Else
WScript.Echo "File: " & strFullPath & ", Couldn't find last modifier"
End If
End Sub
]]>
</script>
</job>