'=============
'Initialize MOM Scripting Variables
'=============
Dim oAPI
Set oAPI = CreateObject("Mom.ScriptAPI")
If Err <> 0 Then
Wscript.Quit -1
End If
'=============
'Helper methods
'=============
' Method: CreateEvent
' Description: Logs Event
' Parameters: source, eventId, eventtype(error/warning/info/success), errormsg
'=============
Sub CreateEvent(lngEventID, lngEventType, strMsg)
Call oAPI.LogScriptEvent(EVENT_SOURCE, lngEventID, lngEventType, strMsg)
End Sub
'=============
' Method: HResultToString
' Description: Returns hresult value in string format 0x00000000(0)
' Parameters: hresult
'=============
Function HResultToString(hresult)
HResultToString = "0x" & Hex(hresult) & "(" & hresult & ")"
End Function
'=============
' Method: RegRead
' Description: Returns registry location value
' Parameters: strKey
'=============
Function RegRead(strKey)
On Error Resume Next
RegRead = "..."
Dim objShell
Set objShell = CreateObject("WScript.Shell")
RegRead = objShell.RegRead(strKey)
Set objShell = Nothing
End Function
ConvertDateTime = FormatDateTime(objDate) & " " & FormatDateTime(objTime)
End Function
'=============
' Method: IsWMIRunning
' Description: Returns true/false
' Parameters: -
'=============
Function IsWMIRunning()
Dim objWMI
On Error Resume Next
Set objWMI = GetObject("winmgmts:root\cimv2")
If Err Then
IsWMIRunning = False
CreateEvent _
9013, _
EVENT_TYPE_ERROR, _
"The 'Windows Management Instrumentation' service (WinMgmt.exe) was not running when MOM tried to run a script that is dependent on this service. Check if the start up mode of this service is not set to 'disabled'."
Else
IsWMIRunning = True
End If
End Function
'=============
' Method: WMIExecQuery
' Description: Returns an object of type SWbemObjectSet
' Parameters:
' sNamespace - A WMI Namespace (ex. winmgmts:\\COMPUTERNAME\ROOT\cimv2).
' sQuery - A SQL Query (ex. SELECT * FROM Win32_OperatingSystem)
' iAlert - To echo/raise error
'=============
Function WMIExecQuery(sNamespace, sQuery, iAlert)
Dim oWMI, oQuery
Dim nErrNumber, sErrDescription
Dim nInstanceCount
On Error Resume Next
Set oWMI = GetObject(sNamespace)
On Error Goto 0
If IsEmpty(oWMI) And iAlert <> 0 Then
WScript.Echo "Unable to open WMI Namespace " & sNamespace
Err.Raise 9100, "Unable to open WMI Namespace " & sNamespace, "Check to see if the WMI service is enabled and running, and ensure this WMI namespace."
End If
On Error Resume Next
Set oQuery = oWMI.ExecQuery(sQuery)
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0
If (IsEmpty(oQuery) Or nErrNumber <> 0) And iAlert <> 0 Then
WScript.Echo "The Query '" & sQuery & "' returned an invalid result set. Error:" & nErrNumber & ", " & sErrDescription & "."
Err.Raise 9100, "The Query '" & sQuery & "' returned an invalid result set.", "Please check to see if this is a valid WMI Query. Error:" & nErrNumber & ", " & sErrDescription & "."
End If
'Determine if we queried a valid WMI class - Count will return 0 or empty
On Error Resume Next
nInstanceCount = oQuery.Count
nErrNumber = Err.Number
sErrDescription = Err.Description
On Error Goto 0
If nErrNumber <> 0 And iAlert <> 0 Then
WScript.Echo "The Query '" & sQuery & "' did not return any valid instances. Error:" & nErrNumber & ", " & sErrDescription & "."
Err.Raise 9100, "The Query '" & sQuery & "' did not return any valid instances.", "Please check to see if this is a valid WMI Query. Error:" & nErrNumber & ", " & sErrDescription & "."
End If
Set WMIExecQuery = oQuery
Set oQuery = Nothing
Set oWMI = Nothing
End Function
'=============
' Method: IsRunningAsSystem
' Description: Returns true/false
' Parameters: -
' Comments: If IsRunningAsSystem is False the caller should check if there is any error (If Err Then ...).
'=============
Function IsRunningAsSystem
Dim WshNetwork
Dim WMISystemAcct
IsRunningAsSystem = False
Set WshNetwork = CreateObject("WScript.Network")
' Use the well-known SID of the system account ("S-1-5-18") to get the correspondent object
Set WMISystemAcct = GetObject("WinMgmts:root/cimv2:Win32_SID='S-1-5-18'")
' WshNetwork.UserName gives the account running the current thread
' WMISystemAcct.AccountName gets the localized name of the system account
' No worries with string case in the comparsion below since, if the account is
' system, the name is extracted from the same location for both objects
If WshNetwork.UserName = WMISystemAcct.AccountName Then
IsRunningAsSystem = True
End If
End Function
'=============
'=============
'Exchange specific Helper methods
'=============
'=============
'=============
' Method: GetNamingContext
' Description: Returns propertyValue from rootDSE object
' Parameters: strPropertyName
'=============
Function GetNamingContext(strPropertyName)
GetNamingContext = ""
Dim IADsRootDSE
Set IADsRootDSE = GetObject("LDAP://rootDSE")
GetNamingContext = IADsRootDSE.Get(strPropertyName)
Set IADsRootDSE = Nothing
End Function
'=============
' Method: GetRootGC
' Description: Returns RootGC
' Parameters: -
'=============
Function GetRootGC()
Dim oGCCollection, oGC
Set oGCCollection = GetObject("GC:")
For each oGC in oGCCollection
Set GetRootGC = oGC
Next
End Function
'=============
' Method: GetCNValue
' Description: -
' Parameters: iOcurr, strData
'=============
Function GetCNValue(iOcurr, strData)
GetCNValue = GetTokValue(iOcurr, "CN=", ",", strData)
End Function
'=============
' Method: GetTokValue
' Description: -
' Parameters: iOcurr, strStartTok, strEndTok, strData
'=============
Function GetTokValue(iOcurr, strStartTok, strEndTok, strData)
Dim iIni, iEnd, iTokLen
iTokLen = Len(strStartTok)
iIni = 1
While iOcurr > 0 ' Skip to the desired occurence
iIni = InStr(iIni, strData, strStartTok, vbTextCompare) + iTokLen
iOcurr = iOcurr - 1
WEnd
iEnd = InStr(iIni, strData, strEndTok, vbTextCompare)
GetTokValue = Mid(strData, iIni, (iEnd - iIni))
End Function
'=============
' Format Constants
'=============
Dim REC_DELIM, INFO_DELIM, IDENT
REC_DELIM = vbCr
INFO_DELIM = vbCr & vbCr
IDENT = " "
'=============
' Method: OutputInfo
' Description: -
' Parameters: strValues, strProps, iPropsFrom, iLevel, blnHierarchical
' Remarks: Very similar to OutDiskInfo sub in Disk_Space_Problem.vbs
'=============
Function OutputInfo(strValues, strProps, iPropsFrom, iLevel, blnHierarchical)
Dim arrValues, arrProps, strLvl
Dim i
If strValues = "" Then Exit Function
On Error Resume Next
OutputInfo = ""
arrValues = Split(strValues, ";")
arrProps = Split(strProps, ",")
While iLevel > 0
strLvl = strLvl & IDENT
iLevel = iLevel - 1
WEnd
For i = iPropsFrom To UBound(arrProps)
OutputInfo = OutputInfo & strLvl & arrProps(i) & ": " & arrValues(i) & REC_DELIM
If i = iPropsFrom and blnHierarchical Then strLvl = strLvl & IDENT
Next
On Error GoTo 0
End Function
'Copyright (c) Microsoft Corporation. All rights reserved.
'*************************************************************************
' $ScriptName: "Common ADO stuff" $
'
' Purpose: To have one place for common stuff across various Exchange VBScripts:
' Disk_Space_Problem
' Verify_If_SSL_Should_Be_Required
' Collect_Public_Folder_Statistics
' Verify_Test_Mailboxes
' Collect_Number_Of_Mailboxes_Per_Server
' Collect_Server_Information
'
' $File: Common_ADO.vbs $
'*************************************************************************
Dim objADOConn, objADOComm
'=========================================================
Sub InitializeGlobalObjects()
' Create the ADO objects to run the query
Set objADOConn = CreateObject("ADODB.Connection")
objADOConn.Provider = "ADsDSOObject"
objADOConn.Open "AD Provider"
Set objADOComm = CreateObject("ADODB.Command")
Set objADOComm.ActiveConnection = objADOConn
objADOComm.Properties("Page Size") = 1000 ' The page size needs to be specified or the function NumberOfEntries will fail
objADOComm.Properties("Timeout") = 30 'seconds
objADOComm.Properties("Cache Results") = false 'do not cache the result set
End Sub
'=========================================================
Sub ReleaseGlobalObjects()
Set objADOConn = Nothing
Set objADOComm = Nothing
End Sub
'=========================================================
Sub GetADSIInfo(strProps, strLDAPQuery, strRes, strFieldDelim, strRecordDelim)
Dim objQueryResult, objIADs, strProp, Values, strValue
objADOComm.CommandText = strLDAPQuery
Set objQueryResult = objADOComm.Execute
While not objQueryResult.eof
Set objIADs = GetObject(objQueryResult.fields(0))
For each strProp in Split(strProps, ",")
On Error Resume Next
Values = objIADs.Get(strProp)
If Err = &h8000500D Then ' value not in the property cache
objIADs.GetInfoEx Array(strProp), 0
Values = objIADs.Get(strProp)
End If
On Error Goto 0
Select Case VarType(Values)
Case 9 ' Object
If Values Is Nothing Then
strValue = "<not set>"
Else
strValue = Values
End If
Case 8204 ' VT_ARRAY + VT_VARIANT
strValue = CStr(NumberOfEntries(objIADs.AdsPath, strProp))
Case Else
strValue = Values
End Select
strRes = strRes & strValue & strFieldDelim
Next
strRes = Left(strRes, Len(strRes) - 1) & strRecordDelim
objQueryResult.MoveNext
WEnd
End Sub
'=========================================================
Function NumberOfEntries(ldapPath, ldapProp)
Dim rs, iStart
NumberOfEntries = 0
iStart = 0
Do
objADOComm.CommandText = "SELECT '" & ldapProp & ";range=" & iStart & "-*' FROM '" & Replace(ldapPath, "'", "''") & "'"
Set rs = objADOComm.Execute()
If (Not rs.EOF) Then
rs.MoveFirst()
iStart = iStart + objADOComm.Properties("Page Size")
If 8204 = VarType(rs.Fields(0).Value) Then
NumberOfEntries = NumberOfEntries + UBound(rs.Fields(0).Value) - LBound(rs.Fields(0).Value) + 1
Else
NumberOfEntries = iStart
End If
End If
Loop While (NumberOFEntries = iStart) And (Not rs.EOF) And (objADOComm.Properties("Page Size") > 0)
End Function
'Copyright (c) Microsoft Corporation. All rights reserved.
'*******************************************************************************
' $ScriptName: "GetLongParameter" $
'
' Purpose: Common function used by Collect_Server_Information.vbs and Verify_Test_Mailboxes.vbs files
'
' $File: FindTestAccounts.vbs $
'*************************************************************************
Const FAILED_TO_FIND_TST_MB_ID = 9026
Const FAILED_TO_FIND_TST_MB_MSG = "Error while querying for the test mailboxes. Detailed information:"
Function FindTestAccounts(strServerName)
'
' What is returned? Semicolon ";" delimeted list of:
' 1. Account name
' 2. Mdb name
' 3. Storage Group Name
' 4. Server Name
'
Dim testServerMailbox_RegPath
Dim mdbMailboxNames_RegPath
Dim sRegValue, sAccountFromRegistry, arrAccounts, numberOfAccounts, index
Dim strMailboxes : strMailboxes = ""
Dim sCommand
Dim oConnect, command, rs, i
Dim objADsPathname
Dim strAccount, strMdb, strStorageGroup, strServer, strDisplayName
If strServerName = "" Or IsEmpty(strServerName) Or IsNull(strServerName) Then
FindTestAccounts = Empty
Exit Function
End If
testServerMailbox_RegPath = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Exchange MOM\Accounts\" & strServerName & "\TestServerMailbox"
mdbMailboxNames_RegPath = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Exchange MOM\Accounts\" & strServerName & "\MDBMailboxNames"
On Error Resume next
'Retrieve TestServerMailbox value
sRegValue = RegRead(testServerMailbox_RegPath)
If Err Then
If not (ERROR_FILE_NOT_FOUND = Err.Number) Then
On Error Goto 0
Err.Raise
Else
sRegValue = strServerName & "MOM"
Err.Clear
End If
End If
sRegValue = Trim(sRegValue)
'Deals with the case when the value was created but not touched
' in which RegRead will return the registry path or empty
If (sRegValue = testServerMailbox_RegPath) Or (sRegValue = "") Then
sRegValue = strServerName & "MOM"
End If
sAccountFromRegistry = sRegValue
'Retrieve mdbMailboxNames value
sRegValue = RegRead(mdbMailboxNames_RegPath)
If Err Then
If not (ERROR_FILE_NOT_FOUND = Err.Number) Then
On Error Goto 0
Err.Raise
Else
sRegValue = strServerName & "MOM*"
Err.Clear
End If
End If
sRegValue = Trim(sRegValue)
'Deals with the case when the value was created but not touched
' in which RegRead will return the registry path or empty
If (sRegValue = testServerMailbox_RegPath) Or (sRegValue = "") Then
sRegValue = strServerName & "MOM*"
End If
sAccountFromRegistry = sAccountFromRegistry & "," & sRegValue
For index = 0 to numberOfAccounts-1
arrAccounts(index) = Trim( arrAccounts(index))
Next
If Err Then
CreateEvent _
FAILED_TO_FIND_TST_MB_ID, _
EVENT_TYPE_ERROR, _
FAILED_TO_FIND_TST_MB_MSG & REC_DELIM & "Description: " & Err.Description & REC_DELIM & "Source: " & Err.Source & _
REC_DELIM & "Number: " & HResultToString(Err.Number)
Err.Clear
Exit Function
End If
'Form select statement to query AD to see if the user accounts exist and to get properties such users' homeMDB
sCommand = "SELECT homeMDB, AdsPath, cn, displayName FROM '" & GetRootGC().ADsPath & "' WHERE " & _
" samAccountName='" & arrAccounts(0) & "' AND objectclass='user' AND objectCategory='person' "
If numberOfAccounts > 0 Then
For index = 1 to numberOfAccounts-1
sCommand = sCommand & " OR samAccountName='" & arrAccounts(index) & "' AND objectclass='user' AND objectCategory='person' "
Next
End If
sCommand = sCommand & " ORDER BY samAccountName "
set oConnect = CreateObject("ADODB.Connection")
oConnect.Provider = "ADsDSOObject"
oConnect.Open()
set command = CreateObject("ADODB.Command")
command.ActiveConnection = oConnect
command.CommandText = sCommand
command.Properties("Page Size") = 100
command.Properties("Timeout") = 20 'seconds
command.Properties("searchscope") = 2 'ADS_SCOPE_SUBTREE
command.Properties("Chase referrals") = 96 ' 0x60 = 0x20 | 0x40 ADS_CHASE_REFERRALS_ALWAYS
command.Properties("Cache Results") = false 'do not cache the result set
set rs = command.Execute()
If Err Then
CreateEvent _
FAILED_TO_FIND_TST_MB_ID, _
EVENT_TYPE_ERROR, _
FAILED_TO_FIND_TST_MB_MSG & REC_DELIM & "Description: " & Err.Description & REC_DELIM & "Source: " & _
Err.Source & REC_DELIM & "Number: " & HResultToString(Err.Number)
Err.Clear
Exit Function
End If
set objADsPathname = CreateObject("Pathname")
If not rs.EOF then
rs.MoveFirst
While not rs.EOF
If Err Then
CreateEvent _
FAILED_TO_FIND_TST_MB_ID, _
EVENT_TYPE_ERROR, _
FAILED_TO_FIND_TST_MB_MSG & REC_DELIM & "Description: " & Err.Description & REC_DELIM & "Source: " & _
Err.Source & REC_DELIM & "Number: " & HResultToString(Err.Number)
Err.Clear
Exit Function
End If
For i = 0 to rs.Fields.Count-1
If rs.Fields(i).Name = "cn" Then
strAccount = rs.Fields(i).Value
End If
If rs.Fields(i).Name = "homeMDB" Then
If rs.Fields(i).Value <> "" Then
objADsPathname.Set rs.Fields(i).Value, 4
objADsPathname.EscapedMode = 4
strMdb = objADsPathname.GetElement(0)
If Len(strMdb) > 3 Then strMdb = Right(strMdb, Len(strMdb) - 3)
strStorageGroup = objADsPathname.GetElement(1)
If Len(strStorageGroup) > 3 Then strStorageGroup = Right(strStorageGroup, Len(strStorageGroup) - 3)
strServer = objADsPathname.GetElement(3)
If Len(strServer) > 3 Then strServer = Right(strServer, Len(strServer) - 3)
End If
End If
If rs.Fields(i).Name = "displayName" Then
strDisplayName = rs.Fields(i).Value
End If
Next
If strAccount <> "" Then
strMailboxes = strMailboxes _
& strAccount & ";" _
& strMdb & ";" _
& strStorageGroup & ";" _
& strServer & ";" _
& strDisplayName & ";"
End If
rs.MoveNext()
Wend
End If
FindTestAccounts = strMailboxes
End Function
'Copyright (c) Microsoft Corporation. All rights reserved.
'***********************************************************************************************
' $ScriptName: "Collect Server Information" $
'
' Purpose: Report the Exchange configuration including its storage groups and databases, these events are
' used by the configuration reports.
'
' $File: Collect_Server_Information.vbs $
'***********************************************************************************************
'Event ID Constants
Const EX2K_INFO_EVENT_ID = 9002
Const SG_INFO_EVENT_ID = 9003
REC_DELIM = vbCr
INFO_DELIM = vbCr & vbCr
' Global objects
Dim oArgs, TargetNetbiosComputer
Dim strOutput
Set oArgs = WScript.Arguments
if oArgs.Unnamed.Count < 1 Then
Call WScript.Quit(-1)
end if
TargetNetbiosComputer = oArgs(0)
strOutput = "Exchange Server Information" & REC_DELIM
GetEx2kInfoFromAD TargetNetbiosComputer, strOutput
' -- Subs -----------------------------------------------------------------------
Sub GetEx2kInfoFromAD(strComputer, strOutput)
Dim strScope, strDN, strSearchFilter, strQuery, strSrvProps, strSrvFriendlyProps, strSrvs, strSrv
Dim arrData, strExtraInfo, strExtraFriendlyProps
Dim strSMTPQueueProps, strSMTPQueueFriendlyProps, strSMTPQueues, strSMTPQueue
Dim strMTAProps, strMTAFriendlyProps, strMTAs, strMTA
Dim regEx, strMailboxes, strMailboxSplit, nMailboxes, i
Dim strMailboxArray, strTemp
Dim strSGProps, strSGFriendlyProps, strSGs, strSG, strStorageGroupName
Dim strMDBProps, strMDBFriendlyProps, strMDBs, strMDB, strMdbName, validTestMailbox, Matches
' Constants to access properties in the mailboxes array
Const ACCOUNT = 0
Const MDB = 1
Const STORAGE_GROUP = 2
Const SERVER = 3
Const DISPLAYNAME = 4
Const CHECKED = 5
Const NUM_OF_PROPERTIES = 6 ' ATTENTION: Include any new property above this item and update its value
InitializeGlobalObjects
' To do: get the list of servers that we should not generate alert about test mailboxes
strScope = "subTree"
strDN = "<LDAP://" & GetNamingContext("configurationNamingContext") & ">"
strSearchFilter = "(&(objectCategory=msExchExchangeServer)(cn=" & strComputer & "))"
strQuery = strDN & ";" & strSearchFilter & ";*;" & strScope
strSrvProps = "distinguishedName,canonicalName,msExchHomeRoutingGroup,name,serverRole,serialNumber,messageTrackingEnabled,msExchDataPath,msExchInstallPath,whenCreated"
strSrvFriendlyProps = "cn,canonicalName,msExchHomeRoutingGroup,Exchange Server,Server Role,Version,Message Tracking,Message Tracking Log Directory,Install path,Date of installation"
strSrvs = ""
For each strSrv in Split(strSrvs, REC_DELIM)
If strSrv = "" Then Exit For
' Get some extra information about the Exchange Server
arrData = Split(strSrv, ";")
GetADSIInfo "msExchRoutingMasterDN", "<LDAP://" & arrData(2) & ">;;*;subTree", strExtraInfo, ";", REC_DELIM
If strExtraInfo <> "" Then
strExtraInfo = arrData(3) & ";" & GetTokValue(1, "", "/", arrData(1))& ";" & GetCNValue(5, arrData(0)) & ";" & _
GetCNValue(3, arrData(0)) & ";" & GetCNValue(1, arrData(2)) & " (master connector: " & GetCNValue(1, strExtraInfo) & ");"
If arrData(4) = "1" Then
strExtraInfo = strExtraInfo & "Front-End"
ElseIf arrData(4) = "0" Then
strExtraInfo = strExtraInfo & "Back-End"
Else
strExtraInfo = strExtraInfo & "undefined"
End If
strExtraFriendlyProps = "Exchange Server,Domain,Organization,Administrative group,Routing group,Server role"
strOutput = strOutput & OutputInfo(strExtraInfo, strExtraFriendlyProps, 0, 0, True)
End If
strOutput = strOutput & OutputInfo(strSrv, strSrvFriendlyProps, 5, 1, False)
If Not IsEx2KServer() Then
strOutput = strOutput & OutputInfo(GetVirusScanState(), "Information Store virus scanning", 0, 1, False)
End If
' Get the Queue directories
strDN = "<LDAP://" & Left(strSrv,InStr(strSrv,";") - 1) & ">"
strSearchFilter = "(objectCategory=protocolCfgSMTPServer)"
strQuery = strDN & ";" & strSearchFilter & ";*;" & strScope
strSMTPQueueProps = "adminDisplayName,msExchAuthenticationFlags,msExchSmtpQueueDirectory,msExchSmtpBadMailDirectory,msExchSmtpPickupDirectory,msExchSmtpDropDirectory"
strSMTPQueueFriendlyProps = "SMTP Queue,Authentication (acceptable methods),Queue directory,Bad mail directory,Pickup directory,Drop directory"
strSMTPQueues = ""
GetADSIInfo strSMTPQueueProps, strQuery, strSMTPQueues, ";", REC_DELIM
For each strSMTPQueue in Split(strSMTPQueues, REC_DELIM)
If strSMTPQueue = "" Then Exit For
arrData = Split(strSMTPQueue, ";")
strOutput = strOutput & OutputInfo(strSMTPQueue, strSMTPQueueFriendlyProps, 0, 0, True)
Next ' each strSMTPQueue in Split(strSMTPQueues, REC_DELIM)
' Get the MTA info
strDN = "<LDAP://" & Left(strSrv,InStr(strSrv,";") - 1) & ">"
strSearchFilter = "(objectCategory=mTA)"
strQuery = strDN & ";" & strSearchFilter & ";*;" & strScope
strMTAProps = "adminDisplayName,msExchMTADatabasePath"
strMTAFriendlyProps = "MTA Server,Database path"
strMTAs = ""
GetADSIInfo strMTAProps, strQuery, strMTAs, ";", REC_DELIM
For each strMTA in Split(strMTAs, REC_DELIM)
If strMTA = "" Then Exit For
strOutput = strOutput & OutputInfo(strMTA, strMTAFriendlyProps, 0, 0, True)
Next ' each strMTA in Split(strMTAs, REC_DELIM)
' RegExp to be used to match test mailboxes
Set regEx = New RegExp
regEx.Pattern = "^" & strComputer & "MOM.*"
regEx.IgnoreCase = TRUE
regEx.Global = TRUE
' Collect info about the test mailboxe accounts
strMailboxes = FindTestAccounts(strComputer)
If strMailboxes <> "" Then
strMailboxSplit = Split (strMailboxes,";",-1,1)
nMailboxes = UBound(strMailboxSplit)/5 ' FindTestAccounts returns 5 props for each MDB
Redim strMailboxArray (nMailboxes,6) ' We store one property more in the array
For i = 0 to nMailboxes-1
strMailboxArray(i,ACCOUNT) = strMailboxSplit(5*i+ACCOUNT)
strMailboxArray(i,MDB) = strMailboxSplit(5*i+MDB)
strMailboxArray(i,STORAGE_GROUP) = strMailboxSplit(5*i+STORAGE_GROUP)
strMailboxArray(i,SERVER) = strMailboxSplit(5*i+SERVER)
strMailboxArray(i,DISPLAYNAME) = strMailboxSplit(5*i+DISPLAYNAME)
strMailboxArray(i,CHECKED) = False
Next ' i = 0 to nMailboxes-1
End If
' Get the Storage group info
strDN = "<LDAP://" & Left(strSrv,InStr(strSrv,";") - 1) & ">"
strSearchFilter = "(&(objectCategory=msExchStorageGroup)(|(!msExchRestore=*)(!msExchRestore=TRUE)))"
strQuery = strDN & ";" & strSearchFilter & ";*;" & strScope
strSGProps = "distinguishedName,name,msExchESEParamCircularLog,msExchESEParamLogFilePath,msExchESEParamSystemPath"
strSGFriendlyProps = "cn,Storage Group,Circular log enabled,Transaction log location,System path location"
strSGs = ""
For each strSG in Split(strSGs, REC_DELIM)
If strSG = "" Then Exit For
strOutput = "Storage Group Information" & INFO_DELIM
strOutput = strOutput & OutputInfo(strSG, strSGFriendlyProps, 1, 0, True)
strStorageGroupName = Split(strSG, ";")(1)
' Get the Private MDBs info
strDN = "<LDAP://" & Left(strSG,InStr(strSG,";") - 1) & ">"
strSearchFilter = "(objectCategory=msExchPrivateMDB)"
strQuery = strDN & ";" & strSearchFilter & ";*;" & strScope
validTestMailbox = 0
For i = 0 to nMailboxes-1
If (StrComp(strMailboxArray(i,SERVER),strComputer,vbTextCompare) = 0) and _
(StrComp(strMailboxArray(i,STORAGE_GROUP),strStorageGroupName,vbTextCompare) = 0) and _
(StrComp(strMailboxArray(i,MDB),strMdbName,vbTextCompare) = 0) Then
Set Matches = regEx.Execute(strMailboxArray(i,ACCOUNT))
If Matches.Count > 0 Then
strMailboxArray(i, CHECKED) = True
validTestMailbox = 1
strTemp = strMailboxArray(i,ACCOUNT) & " (Display Name: """ & strMailboxArray(i,DISPLAYNAME) & """)"
strOutput = strOutput & OutputInfo(strTemp, "MOM test mailbox", 0, 2, True)
End If
End If
Next ' i = 0 to nMailboxes-1
If (validTestMailbox = 0) Then
If IsEmpty(strMailboxes) Then
strTemp = "<FAILED TO QUERY TEST MAILBOXES>"
Else
strTemp = "<NO TEST MAILBOX FOR THIS MDB>"
End If
strOutput = strOutput & OutputInfo(strTemp, "MOM test mailbox", 0, 2, True)
End If
Next ' For each private MDB
' Get the public MDBs info
strDN = "<LDAP://" & Left(strSG,InStr(strSG,";") - 1) & ">"
strSearchFilter = "(objectCategory=msExchPublicMDB)"
strQuery = strDN & ";" & strSearchFilter & ";*;" & strScope
strMDBProps = "name,msExchEDBFile,msExchSLVFile"
strMDBFriendlyProps = "Public MDB,Exchange database,Exchange streaming database"
strMDBs = ""
For each strMDB in Split(strMDBs, REC_DELIM)
If strMDB = "" Then Exit For
strOutput = strOutput & OutputInfo(strMDB, strMDBFriendlyProps, 0, 1, True)
Next ' each strMDB in Split(strMDBs, REC_DELIM)
CreateEvent SG_INFO_EVENT_ID, EVENT_TYPE_INFORMATION, strOutput
strOutput = ""
Next ' For each Storage Group
Next
ReleaseGlobalObjects
End Sub
'-----------------------------------------------------------------
Function IsEx2KServer()
IsEx2KServer = False
Dim EX2K_VERSION_NUMBER
EX2K_VERSION_NUMBER = 4417
Dim version
version = RegRead("HKEY_LOCAL_MACHINE\Software\Microsoft\Exchange\Setup\newestbuild")
If version = EX2K_VERSION_NUMBER Then IsEx2KServer = True
End Function
'-----------------------------------------------------------------
Function TranslateSMTPAuthFlags(str)
Dim lngAuthFlag : lngAuthFlag = CLng(str)
Dim strRes : strRes = ""
If (lngAuthFlag And AUTH_FLAG_ANONYMOUS) <> 0 Then
strRes = "Anonymous access"
End If
If (lngAuthFlag And AUTH_FLAG_BASIC) <> 0 Then
If strRes <> "" Then strRes = strRes & ", "
strRes = strRes & "Basic authentication"
End If
If (lngAuthFlag And AUTH_FLAG_NTLM) <> 0 Then
If strRes <> "" Then strRes = strRes & ", "
strRes = strRes & "Integrated Windows Authentication"
End If
If strRes = "" Then strRes = "None"
TranslateSMTPAuthFlags = strRes
End Function
'-----------------------------------------------------------------
Dim CachedVSState : CachedVSState = ""
'-----------------------------------------------------------------
Function GetVirusScanState()
Dim Value
If CachedVSState <> "" Then
GetVirusScanState = CachedVSState
Exit Function
End If
On Error Resume Next
Value = RegRead("HKLM\SYSTEM\CurrentControlSet\Services\MSExchangeIS\VirusScan\Enabled")
If Err Then
CachedVSState = "Not installed"
Else
If VarType(Value) = vbLong Then
If Value = 0 Then
CachedVSState = "Disabled"
Else
CachedVSState = "Enabled"
End If
Else
CachedVSState = "Misconfigured"
End If
End If
Home
Show References: