'##########################################################################
' Class: Error
' Description: Contains methods to Save Error details, Raise Error,
' Clear Error
' Assumptions: Util Object is created and available to use. It should be named
' as "sUtilObj"
'##########################################################################
Class Error
Private m_lNumber
Private m_sSource
Private m_sDescription
Private m_sHelpContext
Private m_sHelpFile
Private ERROR_FILE_NOT_FOUND
Public Sub Class_Initiaze()
ERROR_FILE_NOT_FOUND = 2
End Sub
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
Public Sub PrintError
WScript.Echo "Error writing to trace." & _
"Error: Number-" & Err.number & _
"; Description-" & Err.Description & _
"; Source-" & Err.Source
End Sub
'=============
' Method: GenerateMOMErrorEvent
' Description: Uses the "MOM Script API" object to log a script event. Appends the Error
' details to the message sent as parameter
' Parameters: strMessage - contains the custom text to write to the event
'=============
Public Function GenerateMOMErrorEvent(ByVal strMessage)
strMessage = strMessage & " Error - Number:" & m_lNumber & _
" Source:" & m_sSource & _
" Description:" & m_sDescription & _
" HelpContext:" & m_sHelpContext & _
" HelpFile:" & m_sHelpFile
On Error Resume Next
CreateScriptErrorEvent(strMessage)
sUtilObj.ThrowEmptyDiscoveryData
Quit()
End Function
'=============
' Method: CreateScriptErrorEvent
' Description: Generate a MOM event with script error message in the
' Operations Manager Log.
' Parameters: strMessage - Message to write to the event
'=============
Public Function CreateScriptErrorEvent(ByVal strMessage)
On Error Resume Next
sUtilObj.MOMApiObject.LogScriptEvent WScript.ScriptName, 4001, 1, strMessage
End Function
'=============
' Method: ErrorCheck
' Description: Checks if an error occurred and writes the error to Operations Manager
' event log.
'=============
Public Sub ErrorCheck()
If Err.number <> 0 Then
Save
GenerateMOMErrorEvent("")
End If
End Sub
Public Sub ErrorCheckMsg(ByVal msg)
If Err.number <> 0 Then
Save
GenerateMOMErrorEvent(msg)
End If
End Sub
End Class
'##########################################################################
' Class: Util
' Description: Contains methods for tracing, generating events,
' creating objects
'##########################################################################
Class Util
' Used to say to LogMessage when/how to print the message.
Public DBG_NONE
Public DBG_ERROR
Public DBG_WARNING
Public DBG_TRACE
Public HKEY_LOCAL_MACHINE
Public MOMApiObject
'Internal Debug Level
Private m_nDebugLevel
'Name of the logfile for tracing
Private m_logFileName
'Values used for creating discovery objects
Private m_SourceId
Private m_ManagedEntityId
Private m_TargetComputer
'---------------
' Properties
'---------------
Public Property Get LogFileName
LogFileName = m_logFileName
End Property
Public Property Let LogFileName(ByVal fileName)
If Not (IsEmpty(filename) OR IsNull(fileName)) Then
m_logFileName = fileName
Else
sErrObj.GenerateMOMErrorEvent("Log file name cannot be empty or null")
End If
End Property
Public Property Get SourceId
SourceId = m_SourceId
End Property
Public Property Let SourceId(ByVal sourceIdVal)
If Not (IsEmpty(sourceIdVal) OR IsNull(sourceIdVal)) Then
m_SourceId = sourceIdVal
Else
sErrObj.GenerateMOMErrorEvent("SourceID cannot be empty or null")
End If
End Property
Public Property Get ManagedEntityId
ManagedEntityId = m_ManagedEntityId
End Property
Public Property Let ManagedEntityId(ByVal managedEntityIdVal)
If Not (IsEmpty(managedEntityIdVal) OR IsNull(managedEntityIdVal)) Then
m_ManagedEntityId = managedEntityIdVal
Else
sErrObj.GenerateMOMErrorEvent("ManagedEntityID cannot be empty or null")
End If
End Property
Public Property Get TargetComputer
TargetComputer = m_TargetComputer
End Property
Public Property Let TargetComputer(ByVal targetComputerVal)
If Not (IsEmpty(targetComputerVal) OR IsNull(targetComputerVal)) Then
m_TargetComputer = targetComputerVal
Else
sErrObj.GenerateMOMErrorEvent("TargetComputer cannot be empty or null")
End If
End Property
'---------------
' Methods
'---------------
'=============
' Method: Class_Initialize
' Description: This is the constructor
'=============
Private Sub Class_Initialize()
' Initialize Debug level constants
DBG_TRACE = 1
DBG_WARNING = 2
DBG_ERROR = 3
DBG_NONE = 4
'by default only errors are logged
m_nDebugLevel = DBG_ERROR
'Create a MOM Script API object
Set MOMApiObject = MomCreateObject("MOM.ScriptAPI")
End Sub
'=============
' Method: Class_Terminate
' Description: This is the destructor
'=============
Private Sub Class_Terminate()
Set MOMApiObject = Nothing
End Sub
'=============
' Method: SetDebugLevel
' Description: To change the debugging output level of information
' generated by this utility.
' Parameters: nLevel - Level, either DBG_NONE, DBG_TRACE,
' DBG_WARNING or DBG_ERROR
'=============
Public Sub SetDebugLevel(ByVal nLevel)
m_nDebugLevel = nLevel
End Sub
'=============
' Method: WriteToTrace
' Description: Writes text to a trace file. For every run of the script,
' the trace file is recreated.
' Parameters: msg - Any text that needs to be written to the trace file.
'=============
Public Sub WriteToTrace (ByVal msg)
Dim fso, traceFileObj, objErr
Set objErr = new Error
If Not m_nDebugLevel = DBG_TRACE Then
Exit Sub
End If
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
If Err.number <> 0 Then objErr.PrintError
On Error Goto 0
'Checking whether the trace file is recreated in this run
If Not sBlnTraceRefreshed Then
On Error Resume Next
Set traceFileObj = fso.OpenTextFile(sUtilObj.LogFileName, conForWriting, True)
If Err.number <> 0 Then objErr.PrintError
On Error Goto 0
sBlnTraceRefreshed = True
Else
On Error Resume Next
Set traceFileObj = fso.OpenTextFile(sUtilObj.LogFileName, conForAppending, True)
If Err.number <> 0 Then objErr.PrintError
On Error Goto 0
End If
msg = FormatDateTime(Date(), vbShortDate) & " " & _
FormatDateTime(Time(), vbLongTime) & "[" & _
WScript.ScriptName & "]--> " & msg
On Error Resume Next
traceFileObj.WriteLine(msg)
If Err.number <> 0 Then objErr.PrintError
On Error Goto 0
traceFileObj.Close
Set traceFileObj = Nothing
Set fso = Nothing
End Sub
'=============
' Method: MomCreateObject
' Description: Creates an Object and includes neccessary error handling
' Parameters: sProgramId - The Program ID of the object type to be created.
' Returns: Returns the object that is created.
'=============
Public Function MomCreateObject(ByVal sProgramId)
Dim errMsg
On Error Resume Next
Set MomCreateObject = CreateObject(sProgramId)
If Err.number <> 0 Then
errMsg = "Unable to create automation object '" & sProgramID & "'" & "--" & _
"Error- Number: " & Err.number & " Description:" & Err.Description & _
" Source:" & Err.Source
If lcase(sProgramId) = lcase("MOM.ScriptAPI") Then
CreateOpsMgrEvent 312, WScript.ScriptName, "ERROR", errMsg
ThrowEmptyDiscoveryData()
Quit()
Else
sErrObj.GenerateMOMErrorEvent(errMsg)
End If
End If
End Function
'=============
' Method: CreateOpsMgrEvent
' Description: Create an event in the Operations Manager log
' Parameters: eventId - ID of the event to be created
' source - Source of this event
' eventType - String specifying the type of event (ERROR, INFORMATION, SUCCESS, WARNING)
' desc - Description of event.
' Returns: Returns the object that is created.
'=============
Public Sub CreateOpsMgrEvent(ByVal eventId, ByVal source, ByVal eventType, ByVal desc)
Dim strCommand, WshShell
On Error Resume Next
Set WshShell = WScript.CreateObject("WScript.Shell")
strCommand = "cmd /c eventcreate /ID " & eventID & _
" /SO " & """" & source & """" & _
" /T " & """" & eventType & """" & _
" /D " & """" & desc & """" & _
" /L " & """Operations Manager"""
WshShell.Run strCommand
If Err.number <> 0 Then WScript.Echo "Error in 'Util.CreateOpsMgrEvent()'"
End Sub
'=============
' Method: ThrowEmptyDiscoveryData
' Description: Returns an empty discovery data
'=============
Public Sub ThrowEmptyDiscoveryData()
Dim oAPI, oDiscoveryData, errMsg
On Error Resume Next
Set oAPI = MOMApiObject
set oDiscoveryData = oAPI.CreateDiscoveryData(0, SourceId, m_ManagedEntityId)
If Err.number <> 0 Then
errMsg = "Error while creating Empty Discovery Data." & " Error Number:" & _
Err.number & " Description:" & Err.Description & " Source" & Err.Source
sErrObj.CreateScriptErrorEvent(errMsg)
Quit()
End If
Call oAPI.Return(oDiscoveryData)
If Err.number <> 0 Then
errMsg = "Error while creating Empty Discovery Data." & " Error Number:" & _
Err.number & " Description:" & Err.Description & " Source" & Err.Source
sErrObj.CreateScriptErrorEvent(errMsg)
Quit()
End If
End Sub
End Class
'##########################################################################
' Class: Registry
' Description: Contains methods to work with registry entries.
'##########################################################################
Class Registry
Public HKEY_CLASSES_ROOT
Public HKEY_CURRENT_USER
Public HKEY_LOCAL_MACHINE
Public HKEY_USERS
Public HKEY_CURRENT_CONFIG
Public HKEY_DYN_DATA
Public ERROR_ACCESS_DENIED
Public ERROR_KEY_NOT_FOUND
Public ERROR_VALUE_NOT_FOUND
Public SUCCESS
Public Sub Connect(ByVal sHostName)
sUtilObj.WriteToTrace "Connecting to registry of Host: " & sHostName
Set m_oReg = GetObject("winmgmts://" & sHostName & "/root/default:StdRegProv")
End Sub
Public Property Get Hive()
Hive = m_lHive
End Property
Public Property Let Hive(ByVal lHive)
sUtilObj.WriteToTrace "Setting the Registry hive to:" & lHive
m_lHive = lHive
End Property
Public Function ReadDWORDValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim lValue
lResult = m_oReg.GetDWORDValue(m_lHive, sKeyPath, sValueName, lValue)
ReadDWORDValue = lValue
End Function
Public Function ReadStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim sValue
lResult = m_oReg.GetStringValue(m_lHive, sKeyPath, sValueName, sValue)
ReadStringValue = sValue
End Function
Public Function ReadMultiStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim aValues
lResult = m_oReg.GetMultiStringValue(m_lHive, sKeyPath, sValueName, aValues)
ReadMultiStringValue = aValues
End Function
'=============
' Method: EnumKeys
' Description: Returns an enumeration of the subkeys under registry path
' Parameters: sKeyPath - The registry path whose subkeys that are to be enumerated.
' lResult - The enumeration of the subkeys is returned in this reference
' parameter
'=============
Public Function EnumKeys(ByVal sKeyPath, ByRef lResult)
Dim aSubKeys
lResult = m_oReg.EnumKey(m_lHive, sKeyPath, aSubKeys)
EnumKeys = aSubKeys
End Function
Public Function CreateKey(ByVal sKeyPath)
CreateKey = m_oReg.CreateKey(m_lHive, sKeyPath)
End Function
Public Function WriteStringValue(ByVal sKeyPath, ByVal sValueName, ByVal sValue)
WriteStringValue = m_oReg.SetStringValue(m_lHive, sKeyPath, sValueName, sValue)
End Function
Public Function DeleteValue(ByVal sKeyPath, ByVal sValueName)
DeleteValue = m_oReg.DeleteValue(m_lHive, sKeyPath, sValueName)
End Function
Public Function ReadBinaryValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
Dim aData
lResult = m_oReg.GetBinaryValue(m_lHive, sKeyPath, sValueName, aData)
ReadBinaryValue = aData
End Function
End Class
'##########################################################################
' Class: SafeRegistry
' Description: Contains methods that provide functionality to work with
' registry, but with better error handling functionality than
' the Registry Class.
'##########################################################################
Class SafeRegistry
Private m_oRegistry
Private m_sHive
Private m_lSuppressionFlags
Private m_sHost
Public SUPPRESS_KEY_NOT_FOUND
Public SUPPRESS_VALUE_NOT_FOUND
Public SUPPRESS_ACCESS_DENIED
Public SUPPRESS_ALL
Public HKEY_CLASSES_ROOT
Public HKEY_CURRENT_USER
Public HKEY_LOCAL_MACHINE
Public HKEY_USERS
Public HKEY_CURRENT_CONFIG
Public HKEY_DYN_DATA
Public ERROR_ACCESS_DENIED
Public ERROR_KEY_NOT_FOUND
Public ERROR_VALUE_NOT_FOUND
Public SUCCESS
Private DEFAULT_VALUE_NAME
Private Sub Class_Initialize()
Set m_oRegistry = New Registry
m_lSuppressionFlags = 0
Hive = HKEY_LOCAL_MACHINE
End Sub
Public Function Connect(ByVal sHostName)
Connect = False
m_sHost = sHostName
On Error Resume Next
m_oRegistry.Connect sHostName
sErrObj.Save
On Error Goto 0
If sErrObj.Number <> 0 Then
sErrObj.GenerateMOMErrorEvent "Failed to connect to the WMI registry provider on " & sHostName
Else
Connect = True
End If
End Function
Public Property Get Hive()
Hive = m_oRegistry.Hive
End Property
Public Property Let Hive(ByVal lHive)
Select Case lHive
Case HKEY_CLASSES_ROOT
m_sHive = "HKCR"
Case HKEY_CURRENT_USER
m_sHive = "HKCU"
Case HKEY_LOCAL_MACHINE
m_sHive = "HKLM"
Case HKEY_USERS
m_sHive = "HKU"
Case HKEY_CURRENT_CONFIG
m_sHive = "HKCC"
Case HKEY_DYN_DATA
m_sHive = "HKDD"
Case Else
m_sHive = "Invalid"
End Select
m_oRegistry.Hive = lHive
End Property
Public Property Let SuppressionFlags(ByVal lValue)
m_lSuppressionFlags = lValue
End Property
Public Property Get SuppressionFlags()
SuppressionFlags = m_lSuppressionFlags
End Property
Public Function ReadDWORDValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadDWORDValue = Null
On Error Resume Next
ReadDWORDValue = m_oRegistry.ReadDWORDValue(sKeyPath, sValueName, lResult)
sErrObj.Save
On Error Goto 0
If sErrObj.Number <> 0 Then
sErrObj.GenerateMOMErrorEvent GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName)
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Public Function ReadStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadStringValue = Null
On Error Resume Next
ReadStringValue = m_oRegistry.ReadStringValue(sKeyPath, sValueName, lResult)
sErrObj.Save
On Error Goto 0
If sErrObj.Number <> 0 Then
sErrObj.GenerateMOMErrorEvent GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName)
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Public Function ReadMultiStringValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadMultiStringValue = Null
On Error Resume Next
ReadMultiStringValue = m_oRegistry.ReadMultiStringValue(sKeyPath, sValueName, lResult)
sErrObj.Save
On Error Goto 0
If sErrObj.Number <> 0 Then
sErrObj.GenerateMOMErrorEvent GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName)
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Public Function EnumKeys(ByVal sKeyPath, ByRef lResult)
EnumKeys = Null
On Error Resume Next
EnumKeys = m_oRegistry.EnumKeys(sKeyPath, lResult)
sErrObj.Save
On Error Goto 0
If sErrObj.Number <> 0 Then
sErrObj.GenerateMOMErrorEvent GET_ERROR_READING_KEY_MESSAGE(m_sHost, m_sHive, sKeyPath)
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, "", lResult
End Function
Public Function CreateKey(ByVal sKeyPath)
Dim lResult
On Error Resume next
lResult = m_oRegistry.CreateKey(sKeyPath)
sErrObj.Save
On Error Goto 0
If sErrObj.Number <> 0 Then
sErrObj.GenerateMOMErrorEvent GET_ERROR_CREATING_KEY_MESSAGE(m_sHost, m_sHive, sKeyPath)
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, "", lResult
CreateKey = lResult
End Function
Public Function WriteStringValue(ByVal sKeyPath, ByVal sValueName, ByVal sValue)
Dim lResult
On Error Resume Next
lResult = m_oRegistry.WriteStringValue(sKeyPath, sValueName, sValue)
sErrObj.Save
On Error Goto 0
If sErrObj.Number <> 0 Then
sErrObj.GenerateMOMErrorEvent GET_ERROR_WRITING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName)
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
WriteStringValue = lResult
End Function
Public Function DeleteValue(ByVal sKeyPath, ByVal sValueName)
Dim lResult
On Error Resume Next
lResult = m_oRegistry.DeleteValue(sKeyPath, sValueName)
sErrObj.Save
On Error Goto 0
If sErrObj.Number <> 0 Then
sErrObj.GenerateMOMErrorEvent GET_ERROR_DELETING_VALUE_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName)
Exit Function
End If
'#doc
'This method seems to return key not found even if it is the value that is not found.
'#end doc
If lResult = ERROR_KEY_NOT_FOUND Then lResult = ERROR_VALUE_NOT_FOUND
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
DeleteValue = lResult
End Function
Public Function ReadBinaryValue(ByVal sKeyPath, ByVal sValueName, ByRef lResult)
ReadBinaryValue = Null
On Error Resume Next
ReadBinaryValue = m_oRegistry.ReadBinaryValue(sKeyPath, sValueName, lResult)
sErrObj.Save
On Error Goto 0
If sErrObj.Number <> 0 Then
sErrObj.GenerateMOMErrorEvent GET_ERROR_READING_REGISTRY_MESSAGE(m_sHost, m_sHive, sKeyPath, sValueName)
Exit Function
End If
HandleResult m_sHost, m_sHive, sKeyPath, sValueName, lResult
End Function
Private Sub HandleResult(ByVal sHost, ByVal sHive, ByVal sKeyPath, ByVal sValueName, ByVal lResult)
sErrObj.Save
Select Case lResult
Case SUCCESS
Exit Sub
Case ERROR_ACCESS_DENIED
If (SuppressionFlags And SUPPRESS_ACCESS_DENIED) = 0 Then
sErrObj.GenerateMOMErrorEvent GET_REGISTRY_ACCESS_DENIED_MESSAGE(sHost, sHive, sKeyPath, sValueName)
Else
WScript.Echo GET_REGISTRY_ACCESS_DENIED_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
Case ERROR_VALUE_NOT_FOUND
If (SuppressionFlags And SUPPRESS_VALUE_NOT_FOUND) = 0 Then
sErrObj.GenerateMOMErrorEvent GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath, sValueName)
Else
WScript.Echo GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
Case ERROR_KEY_NOT_FOUND
If (SuppressionFlags And SUPPRESS_KEY_NOT_FOUND) = 0 Then
sErrObj.GenerateMOMErrorEvent GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath)
Else
WScript.Echo GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(sHost, sHive, sKeyPath)
End If
Case Else
If (SuppressionFlags And SUPPRESS_ALL) = 0 Then
sErrObj.GenerateMOMErrorEvent GET_ERROR_READING_REGISTRY_MESSAGE(sHost, sHive, sKeyPath, sValueName)
Else
WScript.Echo GET_ERROR_READING_REGISTRY_MESSAGE(sHost, sHive, sKeyPath, sValueName)
End If
End Select
End Sub
Private Function GET_REGISTRY_ACCESS_DENIED_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const REGISTRY_ACCESS_DENIED_MESSAGE = "Access denied while reading registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(REGISTRY_ACCESS_DENIED_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_ACCESS_DENIED_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const REGISTRY_VALUE_NOT_FOUND_MESSAGE = "Registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}] not found"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(REGISTRY_VALUE_NOT_FOUND_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_VALUE_NOT_FOUND_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_ERROR_READING_REGISTRY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_READING_REGISTRY_MESSAGE = "Error while reading registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_READING_REGISTRY_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_READING_REGISTRY_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_REGISTRY_KEY_NOT_FOUND_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const REGISTRY_KEY_NOT_FOUND_MESSAGE = "Registry key [\\{Host}\{Hive}\{RegKey}] not found"
Dim sResult
sResult = Replace(REGISTRY_KEY_NOT_FOUND_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_REGISTRY_KEY_NOT_FOUND_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function
Private Function GET_ERROR_READING_KEY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const ERROR_READING_KEY_MESSAGE = "Error while reading registry key [\\{Host}\{Hive}\{RegKey}]"
Dim sResult
sResult = Replace(ERROR_READING_KEY_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_READING_KEY_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function
Private Function GET_ERROR_CREATING_KEY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey)
Const ERROR_CREATING_KEY_MESSAGE = "Error while creating registry key [\\{Host}\{Hive}\{RegKey}]"
Dim sResult
sResult = Replace(ERROR_CREATING_KEY_MESSAGE, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_CREATING_KEY_MESSAGE = Replace(sResult, "{RegKey}", sRegKey)
End Function
Private Function GET_ERROR_WRITING_REGISTRY_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_WRITING_REGISTRY_MESSAGE = "Error while writing registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_WRITING_REGISTRY_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_WRITING_REGISTRY_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
Private Function GET_ERROR_DELETING_VALUE_MESSAGE(ByVal sHost, ByVal sHive, ByVal sRegKey, ByVal sRegValue)
Const ERROR_DELETING_VALUE_MESSAGE = "Error while deleting registry value [\\{Host}\{Hive}\{RegKey}\{RegValue}]"
If sRegValue = "" Then sRegValue = DEFAULT_VALUE_NAME
Dim sResult
sResult = Replace(ERROR_DELETING_VALUE_MESSAGE, "{RegKey}", sRegKey)
sResult = Replace(sResult, "{Hive}", sHive)
sResult = Replace(sResult, "{Host}", sHost)
GET_ERROR_DELETING_VALUE_MESSAGE = Replace(sResult, "{RegValue}", sRegValue)
End Function
'=============
' Method: KeyExists
' Description: Checks for the existence of a registry key
' Parameters: The path to the registry key.
' Returns: Boolean (True/False)
'=============
Public Function KeyExists (ByVal keyPath)
Dim lResult, subKeys, keyArray, subKey, keyName
sUtilObj.WriteToTrace "Start:" & vbTab & "Checking the existence of the key: " & keyPath
On Error Resume Next
KeyExists = False
'Reversing the registry key path. Then splitting it into 2 substrings
'with \ as the delimeter.This gives the key name reversed.
keyArray = Split(StrReverse(keyPath), "\", 2, 1)
'Reversing again to get the key name in proper order.
keyName = trim(StrReverse(keyArray(0)))
subKeys = EnumKeys(StrReverse(keyArray(1)), lResult)
If Not IsNull(subKeys) Then
For Each subKey In subKeys
If lcase(trim(subKey)) = lcase(keyName) Then
KeyExists = True
sUtilObj.WriteToTrace "End:" & vbTab & "Checking the existence of the key: " & _
keyPath & " KeyExists:" & KeyExists
Exit Function
End If
Next
End If
If Err.number <> 0 Then
sErrObj.Save
sErrObj.GenerateMOMErrorEvent "Error while finding the existence of the key:" & keyPath & ". "
End If
sUtilObj.WriteToTrace "End:" & vbTab & "Checking the existence of the key: " & keyPath & _
" KeyExists:" & KeyExists
End Function
End Class
'******************************************************************************
Function Quit()
WScript.Quit -1
End Function
'Copyright (c) Microsoft Corporation. All rights reserved.
'*************************************************************************
' $ScriptName: "TMGComponentDisc" $
'
' Purpose: Contains the definition of the TMGComponentDisc Class
'
' $File: TMGComponentDisc.vbs $
'*************************************************************************
'Include - Common.vbs
Class TMGFwTopologyDisc
Private m_SafeRegistry
Private m_blnConnectedToRegistry
Private m_IsaKeyRoot
'Common property used in almost all server Role discoveries
'to populate the DisplayName property of System.Entity
Private m_ServerName
'Firewall Server Role Properties
Private m_Version
Private m_Type
Private m_Description
Private m_DateCreated
Private m_InstallationDirectory
Private m_HostId
Private m_IntraArrayIP
Private m_RemoteCommunication
Private m_RemoteManagementComputers
Private m_ArrayMembershipName
Private m_ArrayMembershipPersistentName
Private m_ArrayConfigurationMode
Private m_EntrprName
Private m_CrssArrLinkTransState
Private m_CrssArrLinkTransParticipatingArr
Private m_CrssArrLinkTransPrefSrvr
'Constants for the TMG Edition
Private STANDARD_EDITION
Private ENTERPRISE_EDITION
Private STANDALONE_ARRAY
Private EMS_MANAGED_ARRAY
Private Sub Class_Initialize()
Set m_SafeRegistry = new SafeRegistry
Private Sub Class_Terminate()
Set m_SafeRegistry = Nothing
End Sub
Public Property Get ConnectedToRegistry
ConnectedToRegistry = m_blnConnectedToRegistry
End Property
Public Sub ConnectToRegistry (ByVal hostname)
m_blnConnectedToRegistry = false
m_blnConnectedToRegistry = m_SafeRegistry.Connect(hostName)
End Sub
Private Function GetAllRemoteManaged(ByVal oFPCComputerSet)
Dim strRemoteManaged, oLoopElem, arrAddressRanges, arrComputers, arrSubnets
If IsEmpty(oFPCComputerSet) Then Exit Function
strRemoteManaged = ""
On Error Resume Next
arrAddressRanges = oFPCComputerSet.AddressRanges
sErrObj.ErrorCheckStr "Error retrieving FPCAddressRanges."
On Error Goto 0
For Each oLoopElem in oFPCComputerSet.AddressRanges
strRemoteManaged = strRemoteManaged & " """ & oLoopElem.IP_From & " - " & _
oLoopElem.IP_To & """"
Next
On Error Resume Next
arrComputers = oFPCComputerSet.Computers
sErrObj.ErrorCheckStr "Error retrieving FPCComputers."
On Error Goto 0
For Each oLoopElem in oFPCComputerSet.Computers
strRemoteManaged = strRemoteManaged & _
" """ & oLoopElem.Name & "-" & _
oLoopElem.IPAddress & """"
Next
On Error Resume Next
arrSubnets = oFPCComputerSet.Subnets
sErrObj.ErrorCheckStr "Error retrieving FPCSubnets."
On Error Goto 0
For Each oLoopElem in oFPCComputerSet.Subnets
strRemoteManaged = strRemoteManaged & " ""IP: " & oLoopElem.IPAddress & " " & _
"Mask: " & oLoopElem.IPMask & """"
Next
GetAllRemoteManaged = strRemoteManaged
End Function
'=============
' Method: DiscoverFirewallRoleProperties.
' Description: Discovers the Firewall Enabled Server Role properties
'=============
Private Sub DiscoverFirewallRoleProperties
Dim oFPCRoot, oFPCServer, intIsaEdition, oFPCComputerSet, strRemoteManaged, oLoopElem
sUtilObj.WriteToTrace "Start:" & vbTab & "Discovering the properties of Firewall Server Role"
strRemoteManaged = ""
Set oFPCRoot = sUtilObj.MomCreateObject("FPC.Root")
Set oFPCServer = oFPCRoot.GetContainingServer()
'These properties only valid for TMG Enterprise Edition
If (intIsaEdition = ENTERPRISE_EDITION) Then
m_Type = "Enterprise Edition."
If (oFPCServer.UseManagementIpOrName) Then
m_RemoteCommunication = oFPCServer.ManagementIpOrName
Else
m_RemoteCommunication = oFPCServer.FQDN
End If
m_HostId = oFPCServer.HostID
m_IntraArrayIP = oFPCServer.IntraArrayAddress
End If
sUtilObj.WriteToTrace "End:" & vbTab & "Discovering the properties of Firewall Server Role"
End Sub
'=============
' Method: DiscoverFirewallServerRole.
' Description: Discovers the Firewall Enabled Server Role and defines its properties
' Parameters: Discovery object to which Firewall Server Role class is to be added.
'=============
Private Sub DiscoverFirewallServerRole(ByRef discDataObj, ByRef objFirewallServerRole)
sUtilObj.WriteToTrace "Start:" & vbTab & "Creating Firewall Server Role Discovery Object"
DiscoverFirewallRoleProperties
'Create the Firewall Server Role class instance
Set objFirewallServerRole = discDataObj.CreateClassInstance("$MPElement[Name='Microsoft.Forefront.TMG.Server']$")
'These properties only exist in the TMG Enterprise Edition.
If m_Type = "Enterprise Edition." Then
Call objFirewallServerRole.AddProperty("$MPElement[Name='Microsoft.Forefront.TMG.Server']/HostID$", m_HostId)
Call objFirewallServerRole.AddProperty("$MPElement[Name='Microsoft.Forefront.TMG.Server']/IntraArrayIP$", m_IntraArrayIP)
Call objFirewallServerRole.AddProperty("$MPElement[Name='Microsoft.Forefront.TMG.Server']/RemoteCommunication$", m_RemoteCommunication)
End If
sUtilObj.WriteToTrace "End:" & vbTab & "Creating Firewall Server Role Discovery Object"
End Sub
'=============
' Method: DiscoverArray.
' Description: Discovers the Array and defines its properties
' Parameters: Discovery object to which Array class is to be added.
'=============
Private Sub DiscoverArray(ByRef discDataObj, ByRef objArrayClass)
sUtilObj.WriteToTrace "Start:" & vbTab & "Discovering Forefront TMG Array"
If (m_ArrayConfigurationMode = STANDALONE_ARRAY) Then
Call objArrayClass.AddProperty("$MPElement[Name='Microsoft.Forefront.TMG.Array']/Type$", "Standalone")
Else
Call objArrayClass.AddProperty("$MPElement[Name='Microsoft.Forefront.TMG.Array']/Type$", "Enterprise Managed")
End If
On Error Resume Next
Set objPolicyAssignment = objArray.PolicyAssignment
sErrObj.ErrorCheckMsg "Error retrieving FPCPolicyAssignment object."
On Error Goto 0
If objArray.UseComputerAccountForIntraArrayAuthentication Then strIntArrCred = objArray.IntraArrayCredentials.UserName
Call objArrayClass.AddProperty("$MPElement[Name='Microsoft.Forefront.TMG.Array']/IntraArrayCredentials$", strIntArrCred)
On Error Resume Next
Set objConfigStrgSrvrConn = objArray.ConfigurationStorageServerConnection
sErrObj.ErrorCheckMsg "Error retrieving FPCConfigurationStorageServerConnection."
On Error Goto 0
Select Case objConfigStrgSrvrConn.ConfigurationStorageServerConnectionType
Case fpcConfigurationStorageServerConnectionLDAP
strCSSAuthType = "Windows Authentication"
Case fpcConfigurationStorageServerConnectionLDAPS
strCSSAuthType = "Authentication over SSL encrypted channel"
End Select
Call objArrayClass.AddProperty("$MPElement[Name='Microsoft.Forefront.TMG.Array']/CSSAuthenticationType$", strCSSAuthType)
If objConfigStrgSrvrConn.ConnectionOverVPNTunnel Then
strCSSAccessType = "Over a VPN site-to-site connection"
Else
strCSSAccessType = "Directly over the network"
End If
On Error Resume Next
Set objComputerSets = objArray.RuleElements.ComputerSets
sErrObj.ErrorCheckMsg "Error retrieving FPCComputerSets"
On Error Goto 0
For Each objComputerSet in objComputerSets
If(objComputerSet.Predefined And (objComputerSet.Name = "Remote Management Computers")) Then
strRemoteMngdComps = strRemoteMngdComps & GetAllRemoteManaged(objComputerSet)
End If
Next
On Error Resume Next
Set objArrays = objRoot.Arrays
sErrObj.ErrorCheckMsg "Error retrieving FPCArrays."
On Error Goto 0
For Each objArray in objArrays
On Error Resume Next
Set objPolicy = objArray.PolicyAssignment
sErrObj.ErrorCheckMsg "Error retrieving FPCPolicyAssignment"
On Error Goto 0
If objPolicy.CrossArraylinkTranslationEnabled Then
m_CrssArrLinkTransParticipatingArr = m_CrssArrLinkTransParticipatingArr & objArray.Name & "; "
End If
intPriorityVal = objPolicy.CrossArrayLinkTranslationPriority
If intHighestPriority >= intPriorityVal Then
intHighestPriority = intPriorityVal
m_CrssArrLinkTransPrefSrvr = m_CrssArrLinkTransPrefSrvr & objArray.Name & "; "
End If
Next
If len(m_CrssArrLinkTransParticipatingArr) > 2 Then
m_CrssArrLinkTransParticipatingArr = Left(m_CrssArrLinkTransParticipatingArr, len(m_CrssArrLinkTransParticipatingArr) - 2)
Else
m_CrssArrLinkTransParticipatingArr = m_CrssArrLinkTransParticipatingArr
End If
If len(m_CrssArrLinkTransPrefSrvr) > 2 Then
m_CrssArrLinkTransPrefSrvr = Left(m_CrssArrLinkTransPrefSrvr, len(m_CrssArrLinkTransPrefSrvr) - 2)
else
m_CrssArrLinkTransPrefSrvr = m_CrssArrLinkTransPrefSrvr
End If
On Error Resume Next
Set objComputerSets = objEnterprise.RuleElements.ComputerSets
sErrObj.ErrorCheckMsg "Error retrieving FPCComputerSets"
On Error Goto 0
For Each objComputerSet in objComputerSets
If(objComputerSet.Predefined And (objComputerSet.Name = "Enterprise Remote Management Computers")) Then
m_RemoteManagementComputers = m_RemoteManagementComputers & GetAllRemoteManaged(objComputerSet)
End If
Next
sUtilObj.WriteToTrace "End:" & vbTab & "Discovering Forefront TMG Enterprise Service Component properties"
End Sub
'=============
' Method: DiscoverEMSServerRole
' Description: Discover TMG Server Enterprise Class and define its properties
' Parameters: The discovery object to which the TMG Server Array Class instance is to be added
'=============
Public Sub DiscoverEMSServerRole (ByRef discDataObj, ByRef objEnterprise)
sUtilObj.WriteToTrace "Start:" & vbTab & "Discovering Forefront TMG Enterprise"
Set objEntContEMSRel = Nothing
Set objEMSServerRole = Nothing
sUtilObj.WriteToTrace "End:" & vbTab & "Discovering Forefront TMG Enterprise"
End Sub
'=============
' Method: DiscoverEnterpriseArrays.
' Description: Creates the Arrays and CSS Server Role classes and defines their properties
' Parameters: Discovery object to which classes are to be added.
'=============
Private Sub DiscoverEnterpriseArrays(ByRef discDataObj, ByRef objEnterprise)
sUtilObj.WriteToTrace "Start:" & vbTab & "Discovering Enterprise Arrays"
Dim objRoot, objArray, objArrays, objArrayClass, objEnterpriseContArray
Set objRoot = sUtilObj.MomCreateObject("FPC.Root")
On Error Resume Next
Set objArrays = objRoot.Arrays
sErrObj.ErrorCheckMsg "Error retrieving FPCArrays object."
On Error Goto 0
For Each objArray in objArrays
'Create the Array class instance
Set objArrayClass = discDataObj.CreateClassInstance("$MPElement[Name='Microsoft.Forefront.TMG.Array']$")
Call objArrayClass.AddProperty("$MPElement[Name='Microsoft.Forefront.TMG.Array']/PersistentName$", objArray.PersistentName)
Call discDataObj.AddInstance(objArrayClass)
'Create the relationship Enterprise Manages Array
Set objEnterpriseContArray = discDataObj.CreateRelationshipInstance("$MPElement[Name='Microsoft.Forefront.TMG.Enterprise.Contains.Array']$")
objEnterpriseContArray.Source = objEnterprise
objEnterpriseContArray.Target = objArrayClass
Call discDataObj.AddInstance(objEnterpriseContArray)
Next
Set objRoot = Nothing
Set objArrays = Nothing
Set objArray = Nothing
Set objArrayClass = Nothing
Set objEnterpriseContArray = Nothing
sUtilObj.WriteToTrace "End:" & vbTab & "Discovering Enterprise Arrays"
End Sub
'=============
' Method: DiscoverCSSServerRole.
' Description: Creates the CSS Server Role class and defines its properties
' Parameters: Discovery object to which CSS Server Role class is to be added.
'=============
Private Sub DiscoverCSSServerRole(ByRef discDataObj, ByRef objCSSServerRole)
sUtilObj.WriteToTrace "Start:" & vbTab & "Creating CSS Server Role Discovery Object"
Dim objRoot, objArray, objConfigurationStorageServerConnection
Set objRoot = sUtilObj.MomCreateObject("FPC.Root")
On Error Resume Next
Set objArray = objRoot.GetContainingArray()
sErrObj.ErrorCheckMsg "Error retrieving FPCArray object."
On Error Goto 0
On Error Resume Next
Set objConfigurationStorageServerConnection = objArray.ConfigurationStorageServerConnection
sErrObj.ErrorCheckMsg "Error retrieving ConfigurationStorageServerConnection object."
On Error Goto 0
'Create the CSS Server Role class instance
Set objCSSServerRole = discDataObj.CreateClassInstance("$MPElement[Name='Microsoft.Forefront.TMG.CSS.ServerRole']$")
Call objCSSServerRole.AddProperty("$MPElement[Name='Windows!Microsoft.Windows.Computer']/PrincipalName$", objConfigurationStorageServerConnection.PrimaryConfigurationStorageServer)
Call objCSSServerRole.AddProperty("$MPElement[Name='System!System.Entity']/DisplayName$", "CSS - " & objConfigurationStorageServerConnection.PrimaryConfigurationStorageServer)
Call discDataObj.AddInstance(objCSSServerRole)
Set objRoot = Nothing
Set objArray = Nothing
Set objConfigurationStorageServerConnection = Nothing
sUtilObj.WriteToTrace "End:" & vbTab & "Creating CSS Server Role Discovery Object"
End Sub
'=============
' Method: DiscoverFwTopology
' Description: This function in turn calls the specific class discovery routine.
'=============
Public Function DiscoverFwTopology()
Dim discDataObj, objArrayClass, objFirewallServerRole, objArrayContFw
sUtilObj.WriteToTrace "Start:" & vbTab & "Discovering Forefront TMG Topology (from the FW up)"
'Create the Discovery object
On Error Resume Next
Set discDataObj = sUtilObj.MOMApiObject.CreateDiscoveryData(0, sUtilObj.SourceId, sUtilObj.ManagedEntityId)
sErrObj.ErrorCheckMsg "Error creating Discovery Data Object"
On Error Goto 0
'Discover the FW properties
DiscoverFirewallServerRole discDataObj, objFirewallServerRole
'Discover the Array properties
DiscoverArray discDataObj, objArrayClass
'Create the Relationships between array and FW
Set objArrayContFw = discDataObj.CreateRelationshipInstance("$MPElement[Name='Microsoft.Forefront.TMG.Array.Contains.Firewall']$")
objArrayContFw.Source = objArrayClass
objArrayContFw.Target = objFirewallServerRole
Call discDataObj.AddInstance(objArrayContFw)
'Submit the discovery data
Call sUtilObj.MOMApiObject.Return(discDataObj)
Set discDataObj = Nothing
Set objArrayClass = Nothing
Set objArrayContFw = Nothing
Set objFirewallServerRole = Nothing
sUtilObj.WriteToTrace "End:" & vbTab & "Discovering Forefront TMG Topology"
End Function
'=============
' Method: DiscoverStandAloneCSSTopology
' Description: This function in turn calls the specific class discovery routine.
'=============
Public Function DiscoverCSSTopology()
Dim discDataObj, objArrayClass, objCSSServerRole, objArrayContCss, objRoot, objArray, objSecondaryCSSServerRole
sUtilObj.WriteToTrace "Start:" & vbTab & "Discovering Forefront TMG CSS Topology"
'Create the Discovery object
On Error Resume Next
Set discDataObj = sUtilObj.MOMApiObject.CreateDiscoveryData(0, sUtilObj.SourceId, sUtilObj.ManagedEntityId)
sErrObj.ErrorCheckMsg "Error creating Discovery Data Object"
On Error Goto 0
Set objRoot = sUtilObj.MomCreateObject("FPC.Root")
'If the Array is connected to an EMS, don't discover the CSS properties
If (objRoot.ConfigurationMode = EMS_MANAGED_ARRAY) Then
sUtilObj.WriteToTrace "Array is managed by enterprise, not discovering CSS for the array"
'Submit the empty discovery data
Call sUtilObj.MOMApiObject.Return(discDataObj)
Set discDataObj = Nothing
Set objRoot = Nothing
Exit function
End If
'Discover the CSS properties
DiscoverCSSServerRole discDataObj, objCSSServerRole
On Error Resume Next
Set objArray = objRoot.GetContainingArray()
sErrObj.ErrorCheckMsg "Error retrieving FPCArray object."
On Error Goto 0
'create the relationship array contains CSS
Set objArrayContCSS = discDataObj.CreateRelationshipInstance("$MPElement[Name='Microsoft.Forefront.TMG.Array.Contains.CSS']$")
Set objArrayClass = discDataObj.CreateClassInstance("$MPElement[Name='Microsoft.Forefront.TMG.Array']$")
Call objArrayClass.AddProperty("$MPElement[Name='Microsoft.Forefront.TMG.Array']/PersistentName$", objArray.PersistentName)
objArrayContCSS.Source = objArrayClass
objArrayContCSS.Target = objCSSServerRole
Call discDataObj.AddInstance(objArrayContCSS)
'Submit the discovery data
Call sUtilObj.MOMApiObject.Return(discDataObj)
Set discDataObj = Nothing
Set objCSSServerRole = Nothing
Set objArrayContCSS = Nothing
Set objSecondaryCSSServerRole = Nothing
Set objRoot = Nothing
Set objArrayClass = Nothing
sUtilObj.WriteToTrace "End:" & vbTab & "Discovering CSS Properties"
End Function
'=============
' Method: DiscoverEnterpriseTopology
' Description: This function in turn calls the specific class discovery routine.
'=============
Public Function DiscoverEnterpriseTopology()
Dim discDataObj, objCSSServerRole, objEnterpriseContCSS, objRoot, objEnterprise
sUtilObj.WriteToTrace "Start:" & vbTab & "Discovering Forefront TMG Enterprise Topology"
'Create the Discovery object
On Error Resume Next
Set discDataObj = sUtilObj.MOMApiObject.CreateDiscoveryData(0, sUtilObj.SourceId, sUtilObj.ManagedEntityId)
sErrObj.ErrorCheckMsg "Error creating Discovery Data Object"
On Error Goto 0
Set objRoot = sUtilObj.MomCreateObject("FPC.Root")
'If the Array is not connected to an EMS, this is not an enterprise
If (objRoot.ConfigurationMode <> EMS_MANAGED_ARRAY) Then
sUtilObj.WriteToTrace "Array is not managed by enterprise management server, not discovering enterprise topology"
Exit function
End If
'Discover the EMS and Enterprise properties
DiscoverEMSServerRole discDataObj, objEnterprise
'Discover all the Enterprise Arrays
DiscoverEnterpriseArrays discDataObj, objEnterprise
'Submit the discovery data
Call sUtilObj.MOMApiObject.Return(discDataObj)
Set discDataObj = Nothing
Set objCSSServerRole = Nothing
Set objEMSContCSS = Nothing
Set objRoot = Nothing
Set objEnterprise = Nothing
sUtilObj.WriteToTrace "End:" & vbTab & "Discovering Enterprise Topology Properties"
End Function
End Class
'Copyright (c) Microsoft Corporation. All rights reserved.
'*************************************************************************
' $ScriptName: "TopologyDiscovery.vbs" $
'
' Purpose: Discovers FW, Array and CSS topology
'*************************************************************************
' Include - Common.vbs
' Arg(0) - Source ID
' Arg(1) - Target ID
' Arg(2) - Computer ID
' Arg(3) - ScriptFileName - The name with which script file should be created
' in the MOM Installation temp folder
' Arg(4) - Discovery type - FW+Array (=1) or CSS (=2)
' Arg(5) - Trace flag
Sub Main()
Dim arrArgs, FW_ARRAY_DISCOVERY, CSS_DISCOVERY, DiscoveryType, TMGFwTopology, EMS_DISCOVERY
'Instantiate the global objects declared in the Common.vbs
Set sUtilObj = new Util
Set sErrObj = new Error
'Check if the number of arguments is correct
Set arrArgs = Wscript.Arguments
if arrArgs.Count < 6 Then
sErrObj.GenerateMOMErrorEvent("Invalid number of arguments passed to script.")
Quit()
End If
'Check if Trace is ON
If (lcase(trim(arrArgs(5))) = lcase(conTraceOn)) Then
'Set the debug level to Trace
sUtilObj.SetDebugLevel(sUtilObj.DBG_TRACE)
'Set the trace log file name
sUtilObj.LogFileName = arrArgs(3) & ".trace"
End If
sUtilObj.WriteToTrace "Reading the input arguments to script"
sUtilObj.SourceId = arrArgs(0)
sUtilObj.ManagedEntityId = arrArgs(1)
sUtilObj.TargetComputer = arrArgs(2)
sUtilObj.WriteToTrace "Source: " & sUtilObj.SourceId & " ManagedEntity: " & sUtilObj.ManagedEntityId & " Target: " & sUtilObj.TargetComputer
Set TMGFwTopology = New TMGFwTopologyDisc
DiscoveryType = Cint(arrArgs(4))
Select Case DiscoveryType
Case FW_ARRAY_DISCOVERY
TMGFwTopology.DiscoverFwTopology
Case CSS_DISCOVERY
TMGFwTopology.DiscoverCSSTopology
Case EMS_DISCOVERY
TMGFwTopology.DiscoverEnterpriseTopology
End Select
Set TMGFwTopology = Nothing
Set sUtilObj = Nothing
Set sErrObj = Nothing
End Sub
Home
Show References: