Function IsValidObject(ByVal oObject)
IsValidObject = False
If IsObject(oObject) Then
If Not oObject Is Nothing Then
IsValidObject = True
End If
End If
End Function
Sub RunCommand (ByVal sCommand, ByRef iErrCode, ByRef sOutput, ByRef sError)
Dim oShell, oFSO, oOut
Set oShell = MomCreateObject("WScript.Shell")
Set oFSO = MomCreateObject("Scripting.FileSystemObject")
sError = ""
sOutput = ""
Dim sOutputFileName
sOutputFileName = GenerateGUID() & ".out"
Dim sErrorFileName
sErrorFileName = GenerateGUID() & ".err"
Dim sFullCommand
sFullCommand = "cmd /c " & sCommand & " > " & sOutputFileName & " 2> " & sErrorFileName
iErrCode = oShell.run(sFullCommand, 2, true)
On Error Resume Next
Set oOut = oFSO.OpenTextFile(sOutputFileName)
On Error Goto 0
If IsValidObject(oOut) Then
On Error Resume Next
sOutput = oOut.ReadAll()
On Error Goto 0
oOut.Close
Else
ThrowScriptError "Could not write to the folder [" & oFSO.GetAbsolutePathName(".") & "]. Make sure the action account has " & _
"write access to this folder.", _
Err
End If
On Error Resume Next
oFSO.DeleteFile sOutputFileName
On Error Goto 0
If iErrCode <> 0 Then
Dim oErrorFile
On Error Resume Next
Set oErrorFile = oFSO.OpenTextFile(sErrorFileName)
On Error Goto 0
If IsValidObject(oErrorFile) Then
On Error Resume Next
sError = oErrorFile.ReadAll()
On Error Goto 0
oErrorFile.Close
End If
If sError = "" Then sError = sOutput
End If
On Error Resume Next
oFSO.DeleteFile sErrorFileName
On Error Goto 0
End Sub
Sub ParseForRoots (ByVal sDFSUtilOutput, ByRef oRootNames)
' Gets a string of the output from a successful run (error code = 0)
' of the DFS Util, parse out the list of roots and return the roots.
Dim rExp, sSearch, oMatches
Set rExp = new regexp
rExp.Global = True
rExp.IgnoreCase = True
' Match anything that starts with a tab and anything that's
' not a new line character. (till the end of the line)
rExp.Pattern = "\t[^(\n)]+"
' Parse for the roots...
Set oRootNames = rExp.Execute(sDFSUtilOutput)
End Sub
Function GenerateGUID()
Dim oTypeLib
Set oTypeLib = MomCreateObject("Scriptlet.TypeLib")
Dim sNewGUID
sNewGUID = oTypeLib.Guid
GenerateGUID = Left(sNewGUID, Len(sNewGUID)-2)
End Function
Function ThrowScriptErrorNoAbort(ByVal sMessage, ByVal oErr)
'
' ThrowScriptError :: Creates an event and sends it back to the mom server
'
'
Dim sErrDescription, sErrNumber
sErrDescription = oErr.Description
sErrNumber = oErr.Number
On Error Resume Next
Dim oScriptErrorEvent
Set oScriptErrorEvent = ScriptContext.CreateEvent()
With oScriptErrorEvent
.EventNumber = 40000
.EventType = EVENT_TYPE_ERROR
.Message = sMessage
.SetEventParameter """Microsoft Windows Distributed File Systems"""
.SetEventParameter sMessage
.SetEventParameter sErrDescription
.SetEventParameter sErrNumber
End With
ScriptContext.Submit oScriptErrorEvent
ScriptContext.Echo "ThrowScriptError('" & sMessage & "')"
End Function
Function ThrowScriptError(Byval sMessage, ByVal oErr)
'
' ThrowScriptError :: Creates an event and sends it back to the mom server
'
'
On Error Resume Next
ThrowScriptErrorNoAbort sMessage, oErr
ScriptContext.Quit()
End Function
Function MomCreateObject(ByVal sProgramId)
Dim oError
Set oError = New Error
On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
oError.Save
On Error Goto 0
If oError.Number <> 0 Then ThrowScriptError "Unable to create automation object '" & sProgramId & "'", oError
End Function
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Public Sub Save()
m_lNumber = Err.number
m_sSource = Err.Source
m_sDescription = Err.Description
m_sHelpContext = Err.HelpContext
m_sHelpFile = Err.helpfile
End Sub
Public Sub Raise()
Err.Raise m_lNumber, m_sSource, m_sDescription, m_sHelpFile, m_sHelpContext
End Sub
Public Sub Clear()
m_lNumber = 0
m_sSource = ""
m_sDescription = ""
m_sHelpContext = ""
m_sHelpFile = ""
End Sub
Public Default Property Get Number()
Number = m_lNumber
End Property
Public Property Get Source()
Source = m_sSource
End Property
Public Property Get Description()
Description = m_sDescription
End Property
Public Property Get HelpContext()
HelpContext = m_sHelpContext
End Property
Public Property Get HelpFile()
HelpFile = m_sHelpFile
End Property
End Class
Function PingFileShare(ByVal sUNCPath)
Dim oFSO
Set oFSO = MomCreateObject("Scripting.FileSystemObject")
Dim e
Set e = New Error
Dim oFolder
On Error Resume Next
Set oFolder = oFSO.GetFolder(sUNCPath)
e.Save
On Error Goto 0
PingFileShare = (e.Number = 0)
End Function
Class DFS
Private m_sDFSUtilPath
Public Property Get DFSUtilPath
DFSUtilPath = m_sDFSUtilPath
End Property
Public Property Let DFSUtilPath(ByVal sPath)
Dim oShell
Set oShell = MomCreateObject("WScript.Shell")
m_sDFSUtilPath = oShell.ExpandEnvironmentStrings(sPath)
End Property
Public Property Get Roots
Dim sDFSCommand
sDFSCommand = """""" & m_sDFSUtilPath & """ /Server:" & ScriptContext.TargetNetbiosComputer & " /view"""
Dim iErrorCode
Dim sOutput
Dim sError
RunCommand sDFSCommand, iErrorCode, sOutput, sError
Dim aRoots()
If iErrorCode <> 0 Then
If iErrorCode = 259 Then
Roots = aRoots
Exit Property
ElseIf iErrorCode = 1 Then
ThrowScriptError "The tool DFSUTIL.EXE could not be found on the managed node. To resolve this " & _
"issue please install the Windows 2003 Support Tools and then verify the script " & _
"parameter ""DFSUtilLocation"" has the correct directory location listed for " & _
"DFSUTIL.EXE." & vbCrLf & _
"Details:" & vbCrLf & _
sError, _
Err
ElseIf iErrorCode = 87 Then
ThrowScriptError "You may have the wrong version of DFSUTIL.EXE installed. Version 4.0 is required." & vbCrLf & _
"Details:" & vbCrLf & _
sError, _
Err
Else
ThrowScriptError "Error occurred while obtaining all DFS Roots on " & ScriptContext.TargetNetbiosComputer & "." & vbCrLf & _
"Error Details:" & vbCrLf & _
sError, _
Err
End If
End If
Dim oRootNames
ParseForRoots sOutput, oRootNames
Dim sRootName
Dim sRootType
ReDim aRoots(oRootNames.Count - 1)
Dim i
For i = 0 To oRootNames.Count - 1
sRootName = "\" & Replace(oRootNames(i), vbTab, "")
' If the RootName starts with the domain name
If Instr(sRootName, "\\" & ScriptContext.TargetNetbiosDomain) = 1 Then
sRootType = "Domain"
Else
sRootType = "Stand Alone"
End If
Set aRoots(i) = New DFSRoot
aRoots(i).Initialize sRootName, sRootType, m_sDFSUtilPath
Next
Roots = aRoots
End Property
End Class
Class DFSRoot
Private m_oXMLElement
Private m_sName
Private m_sType
Private m_sXMLFileLocation
Private Sub Class_Terminate()
DeleteXMLFile
End Sub
Private Sub DeleteXMLFile()
SetXMLElement Nothing
If m_sXMLFileLocation <> "" Then
Dim oFSO
Set oFSO = MomCreateObject("Scripting.FileSystemObject")
oFSO.DeleteFile m_sXMLFileLocation
End If
End Sub
Public Sub Initialize(ByVal sName, ByVal sType, ByVal sDFSUtilPath)
m_sName = sName
m_sType = sType
DeleteXMLFile
m_sXMLFileLocation = GenerateGUID() & ".xml"
Dim sDFSCommand
sDFSCommand = """""" & sDFSUtilPath & """ /root:""" & sName & """ /export:" & m_sXMLFileLocation & """"
Dim iErrorCode
Dim sOutput
Dim sError
RunCommand sDFSCommand, iErrorCode, sOutput, sError
If iErrorCode <> 0 Then
' Error occurred while running the dfsutil command
ThrowScriptError "Error occurred while exporting details for DFS Root [" & sName & "] to XML file. DFS Root not processed." & vbCrLf & _
"Error Details:" & vbCrLf & _
sError, _
Err
End If
Dim oXDFSResults
Set oXDFSResults = MomCreateObject("MSXML2.DOMDocument")
oXDFSResults.validateOnParse = True
' Load the dfsutil result xml file
oXDFSResults.load(m_sXMLFileLocation)
If oXDFSResults.ParseError.ErrorCode <> 0 Then
ThrowScriptError "Unable to open oXDFSResults file. DFS Root [" & sName & "] not processed." & vbCrLf & _
oXDFSResults.ParseError.Reason, _
Err
End If
SetXMLElement oXDFSResults.SelectSingleNode("/Root")
End Sub
Public Property Get IsAccessible
IsAccessible = PingFileShare(Name)
End Property
Public Property Get Name
Name = m_sName
End Property
Public Property Get RootType
RootType = m_sType
End Property
Public Property Get State
State = CInt(m_oXMLElement.SelectSingleNode("@State").Value)
End Property
Public Property Get Timeout
Timeout = m_oXMLElement.SelectSingleNode("@Timeout").Value
End Property
Public Property Get Comment
Dim oCommentAttribute
Set oCommentAttribute = m_oXMLElement.SelectSingleNode("@Comment")
If oCommentAttribute Is Nothing Then
Comment = ""
Else
Comment = oCommentAttribute.Value
End If
End Property
Public Property Get Targets
Dim oTargetXMLElements
Set oTargetXMLElements = m_oXMLElement.SelectNodes("Target")
ReDim aTargets(oTargetXMLElements.length - 1)
Dim i
For i = 0 To oTargetXMLElements.length - 1
Set aTargets(i) = New DFSRootTarget
aTargets(i).SetXMLElement oTargetXMLElements.item(i)
Next
Targets = aTargets
End Property
Public Property Get Links
Dim oLinkXMLElements
Set oLinkXMLElements = m_oXMLElement.SelectNodes("Link")
ReDim aLinks(oLinkXMLElements.length - 1)
Dim i
For i = 0 To oLinkXMLElements.length - 1
Set aLinks(i) = New DFSLink
aLinks(i).Initialize oLinkXMLElements.item(i), Name
Next
Links = aLinks
End Property
Public Sub SetXMLElement(ByVal oXMLElement)
Set m_oXMLElement = oXMLElement
End Sub
End Class
Class DFSRootTarget
Private m_oXMLElement
Public Property Get IsAccessible
IsAccessible = PingFileShare(Name)
End Property
Public Property Get Name
Name = "\\" & Server & "\" & Folder
End Property
Public Property Get State
State = CInt(m_oXMLElement.SelectSingleNode("@State").Value)
End Property
Public Property Get Server
Server = m_oXMLElement.SelectSingleNode("@Server").Value
End Property
Public Property Get Folder
Folder = m_oXMLElement.SelectSingleNode("@Folder").Value
End Property
Public Sub SetXMLElement(ByVal oXMLElement)
Set m_oXMLElement = oXMLElement
End Sub
End Class
Class DFSLink
Private m_oXMLElement
Private m_sRootName
Public Property Get IsAccessible
IsAccessible = PingFileShare(m_sRootName & "\" & Name)
End Property
Public Property Get Name
Name = m_oXMLElement.SelectSingleNode("@Name").Value
End Property
Public Property Get State
State = CInt(m_oXMLElement.SelectSingleNode("@State").Value)
End Property
Public Property Get Timeout
Timeout = m_oXMLElement.SelectSingleNode("@Timeout").Value
End Property
Public Property Get Comment
Dim oCommentAttribute
Set oCommentAttribute = m_oXMLElement.SelectSingleNode("@Comment")
If oCommentAttribute Is Nothing Then
Comment = ""
Else
Comment = oCommentAttribute.Value
End If
End Property
Public Property Get Targets
Dim oTargetXMLElements
Set oTargetXMLElements = m_oXMLElement.SelectNodes("Target")
ReDim aTargets(oTargetXMLElements.length - 1)
Dim i
For i = 0 To oTargetXMLElements.length - 1
Set aTargets(i) = New DFSLinkTarget
aTargets(i).SetXMLElement oTargetXMLElements.item(i)
Next
Targets = aTargets
End Property
Public Sub Initialize(ByVal oXMLElement, ByVal sRootName)
Set m_oXMLElement = oXMLElement
m_sRootName = sRootName
End Sub
End Class
Class DFSLinkTarget
Private m_oXMLElement
Public Property Get IsAccessible
IsAccessible = PingFileShare(Name)
End Property
Public Property Get Name
Name = "\\" & Server & "\" & Folder
End Property
Public Property Get State
State = CInt(m_oXMLElement.SelectSingleNode("@State").Value)
End Property
Public Property Get Server
Server = m_oXMLElement.SelectSingleNode("@Server").Value
End Property
Public Property Get Folder
Folder = m_oXMLElement.SelectSingleNode("@Folder").Value
End Property
Public Sub SetXMLElement(ByVal oXMLElement)
Set m_oXMLElement = oXMLElement
End Sub
End Class
Const COMPUTER_COMPUTER_NAME_ATTRIBUTE_ID = "ComputerName"
Const COMPUTER_TIME_ZONE_BIAS_ATTRIBUTE_ID = "Time Zone Bias"
Const COMPUTER_OPERATING_SYSTEM_VERSION_ATTRIBUTE_ID = "Operating System Version"
Const COMPUTER_IP_ADDRESS_ATTRIBUTE_ID = "IPAddress"
Const COMPUTER_FQDN_ATTRIBUTE_ID = "FQDN"
Const COMPUTER_VIRTUAL_SERVER_TYPE_ATTRIBUTE_ID = "Virtual Server Type"
Class DFSRootCollection
Private m_oCollection
Public Property Get InnerCollection()
Set InnerCollection = m_oCollection
End Property
Public Sub Initialize(ByVal oDisc)
Set m_oCollection = oDisc.CreateCollection()
With m_oCollection
.ClassID = DFS_ROOT_CLASS_ID
.AddScopeFilter COMPUTER_COMPUTER_NAME_ATTRIBUTE_ID, ScriptContext.TargetComputerIdentity
.AddScopeFilter DFS_NAME_ATTRIBUTE_ID, ScriptContext.TargetNetbiosComputer
.AddScopeProperty DFS_ROOT_ROOT_TIMEOUT_ATTRIBUTE_ID
.AddScopeProperty DFS_ROOT_ROOT_TYPE_ATTRIBUTE_ID
.AddScopeProperty DFS_ROOT_ROOT_COMMENT_ATTRIBUTE_ID
End With
End Sub
Public Sub Add(ByVal oRoot)
Dim oInstance
Set oInstance = m_oCollection.CreateInstance()
With oInstance
.AddKeyProperty DFS_ROOT_ROOT_NAME_ATTRIBUTE_ID, oRoot.Name
.AddProperty DFS_ROOT_ROOT_TIMEOUT_ATTRIBUTE_ID, oRoot.Timeout
.AddProperty DFS_ROOT_ROOT_COMMENT_ATTRIBUTE_ID, oRoot.Comment
.AddProperty DFS_ROOT_ROOT_TYPE_ATTRIBUTE_ID, oRoot.RootType
End With
m_oCollection.AddInstance oInstance
End Sub
End Class
Class DFSRootTargetCollection
Private m_oCollection
Public Property Get InnerCollection()
Set InnerCollection = m_oCollection
End Property
Public Sub Initialize(ByVal oDisc, ByVal oRoot)
Set m_oCollection = oDisc.CreateCollection()
With m_oCollection
.ClassID = DFS_ROOT_TARGET_CLASS_ID
.AddScopeFilter COMPUTER_COMPUTER_NAME_ATTRIBUTE_ID, ScriptContext.TargetComputerIdentity
.AddScopeFilter DFS_NAME_ATTRIBUTE_ID, ScriptContext.TargetNetbiosComputer
.AddScopeFilter DFS_ROOT_ROOT_NAME_ATTRIBUTE_ID, oRoot.Name
.AddScopeProperty DFS_ROOT_TARGET_ROOT_TARGET_SERVER_ATTRIBUTE_ID
.AddScopeProperty DFS_ROOT_TARGET_ROOT_TARGET_FOLDER_ATTRIBUTE_ID
End With
End Sub
Public Sub Add(ByVal oRootTarget)
Dim oInstance
Set oInstance = m_oCollection.CreateInstance()
With oInstance
.AddKeyProperty DFS_ROOT_TARGET_ROOT_TARGET_NAME_ATTRIBUTE_ID, oRootTarget.Name
.AddProperty DFS_ROOT_TARGET_ROOT_TARGET_SERVER_ATTRIBUTE_ID, oRootTarget.Server
.AddProperty DFS_ROOT_TARGET_ROOT_TARGET_FOLDER_ATTRIBUTE_ID, oRootTarget.Folder
End With
m_oCollection.AddInstance oInstance
End Sub
End Class
Class DFSLinkCollection
Private m_oCollection
Public Property Get InnerCollection()
Set InnerCollection = m_oCollection
End Property
Public Sub Initialize(ByVal oDisc, ByVal oRoot)
Set m_oCollection = oDisc.CreateCollection()
With m_oCollection
.ClassID = DFS_LINK_CLASS_ID
.AddScopeFilter COMPUTER_COMPUTER_NAME_ATTRIBUTE_ID, ScriptContext.TargetComputerIdentity
.AddScopeFilter DFS_NAME_ATTRIBUTE_ID, ScriptContext.TargetNetbiosComputer
.AddScopeFilter DFS_ROOT_ROOT_NAME_ATTRIBUTE_ID, oRoot.Name
.AddScopeProperty DFS_LINK_LINK_TIMEOUT_ATTRIBUTE_ID
.AddScopeProperty DFS_LINK_LINK_COMMENT_ATTRIBUTE_ID
End With
End Sub
Public Sub Add(ByVal oLink)
Dim oInstance
Set oInstance = m_oCollection.CreateInstance()
With oInstance
.AddKeyProperty DFS_LINK_LINK_NAME_ATTRIBUTE_ID, oLink.Name
.AddProperty DFS_LINK_LINK_TIMEOUT_ATTRIBUTE_ID, oLink.Timeout
.AddProperty DFS_LINK_LINK_COMMENT_ATTRIBUTE_ID, oLink.Comment
End With
m_oCollection.AddInstance oInstance
End Sub
End Class
Class DFSLinkTargetCollection
Private m_oCollection
Public Property Get InnerCollection()
Set InnerCollection = m_oCollection
End Property
Public Sub Initialize(ByVal oDisc, ByVal oRoot, ByVal oLink)
Set m_oCollection = oDisc.CreateCollection()
With m_oCollection
.ClassID = DFS_LINK_TARGET_CLASS_ID
.AddScopeFilter COMPUTER_COMPUTER_NAME_ATTRIBUTE_ID, ScriptContext.TargetComputerIdentity
.AddScopeFilter DFS_NAME_ATTRIBUTE_ID, ScriptContext.TargetNetbiosComputer
.AddScopeFilter DFS_ROOT_ROOT_NAME_ATTRIBUTE_ID, oRoot.Name
.AddScopeFilter DFS_LINK_LINK_NAME_ATTRIBUTE_ID, oLink.Name
.AddScopeProperty DFS_LINK_TARGET_LINK_TARGET_SERVER_ATTRIBUTE_ID
.AddScopeProperty DFS_LINK_TARGET_LINK_TARGET_FOLDER_ATTRIBUTE_ID
End With
End Sub
Public Sub Add(ByVal oLinkTarget)
Dim oInstance
Set oInstance = m_oCollection.CreateInstance()
With oInstance
.AddKeyProperty DFS_LINK_TARGET_LINK_TARGET_NAME_ATTRIBUTE_ID, oLinkTarget.Name
.AddProperty DFS_LINK_TARGET_LINK_TARGET_SERVER_ATTRIBUTE_ID, oLinkTarget.Server
.AddProperty DFS_LINK_TARGET_LINK_TARGET_FOLDER_ATTRIBUTE_ID, oLinkTarget.Folder
End With
m_oCollection.AddInstance oInstance
End Sub
End Class
Sub Main()
Dim oDiscData
Dim oRootColl, oRootInst, oRootTgtColl, oRootTgtInst
Dim oLinkColl, oLinkInst, oLinkTgtColl, oLinkTgtInst
Dim sDFSUtilPath
sDFSUtilPath = CStr(ScriptContext.Parameters.Get("DFSUtilLocation"))
Set oDiscData = ScriptContext.CreateDiscoveryData()
oDiscData.ScopeID = "{0A89FFE0-69A5-4587-97D0-FC341A903423}"
Set oRootColl = New DFSRootCollection
oRootColl.Initialize oDiscData
Dim oDFS
Set oDFS = New DFS
oDFS.DFSUtilPath = sDFSUtilPath
Dim oRoot
Dim fRootFound
fRootFound = false
For Each oRoot In oDFS.Roots
fRootFound = true
oRootColl.Add oRoot
ScriptContext.Echo "Root: " & oRoot.Name
Set oRootTgtColl = New DFSRootTargetCollection
oRootTgtColl.Initialize oDiscData, oRoot
Dim oRootTarget
For Each oRootTarget In oRoot.Targets
oRootTgtColl.Add oRootTarget
ScriptContext.Echo "Root Target: " & oRootTarget.Name
Next
Set oLinkColl = New DFSLinkCollection
oLinkColl.Initialize oDiscData, oRoot
Dim oLink
For Each oLink In oRoot.Links
oLinkColl.Add oLink
ScriptContext.Echo "Link: " & oLink.Name
Set oLinkTgtColl = New DFSLinkTargetCollection
oLinkTgtColl.Initialize oDiscData, oRoot, oLink
Dim oLinkTarget
For Each oLinkTarget In oLink.Targets
oLinkTgtColl.Add oLinkTarget
ScriptContext.Echo "Link Target: " & oLinkTarget.Name
Next
oDiscData.AddCollection oLinkTgtColl.InnerCollection
Next
oDiscData.AddCollection oLinkColl.InnerCollection
Next
oDiscData.AddCollection oRootColl.InnerCollection
' If there are any roots add the DFS class
If fRootFound Then
Dim oCollection
Set oCollection = oDiscData.CreateCollection()
With oCollection
.ClassID = DFS_CLASS_ID
.AddScopeFilter COMPUTER_COMPUTER_NAME_ATTRIBUTE_ID, ScriptContext.TargetComputerIdentity
.AddScopeFilter DFS_NAME_ATTRIBUTE_ID, ScriptContext.TargetNetbiosComputer
.AddInstance .CreateInstance()
End With
oDiscData.AddCollection oCollection
End If
ScriptContext.Submit oDiscData
End Sub</Script></Body>
<Language>VBScript</Language>
<Name>Microsoft Windows 2003 DFS Service Discovery</Name>
<Parameters>
<Parameter>
<Name>DFSUtilLocation</Name>
<Value>$Config/Parameters/DFSUtilLocation$</Value>
</Parameter>
</Parameters>
<ManagementPackId>[Microsoft.Windows.Server.DFS,,1.0.0.1]</ManagementPackId>
</WriteAction>
</MemberModules>
<Composition>
<Node ID="RunScriptAction"/>
</Composition>
</Composite>
</ModuleImplementation>
<InputType>SystemLibrary!System.BaseData</InputType>
</WriteActionModuleType>
Home
ENU 
Show References: