Michael's meanderings...

Exchange Disk Space, version 2.1

It was pointed out to me, by a party that shall remain nameless, that I depended in today's earlier post Finding Disk Space Used By Exchange Version 2, that I ASSumed that msExchCurrentServerRoles would never be higher than 64 and that that was a bad assumption on my part, for reasons that shall also remain nameless.

So, here is a "fixed" version of just the ShowServerInfo() subroutine. Just rip the old one out, and add the new one in:

Const Exch_Role_Edge         = 64   ' 0x40
Const Exch_Role_Hub          = 32   ' 0x20
Const Exch_Role_UM           = 16   ' 0x10
Const Exch_Role_ClientAccess = 4    ' 0x04
Const Exch_Role_Mailbox      = 2    ' 0x02

Sub ShowServerInfo (ByVal spaces, ByVal strServer)
	Dim objServer, obj
	Dim str, i, msExchCurrentRoles

	On Error Resume Next
	Err.Clear

	Set objServer = GetObject ("LDAP://" & strServer)
	If Err = 0 Then
		msExchCurrentRoles = objServer.Get ("msExchCurrentServerRoles")
		If Err = 0 Then
			i = msExchCurrentRoles
			str = ""
			'' got a exchange 2007 or higher box
			If (msExchCurrentRoles and Exch_Role_Mailbox) = Exch_Role_Mailbox Then
				str = str & "Mailbox "
				i = i - Exch_Role_Mailbox
			End If

			If (msExchCurrentRoles and Exch_Role_ClientAccess) = Exch_Role_ClientAccess Then
				str = str & "ClientAccess "
				i = i - Exch_Role_ClientAccess
			End If

			If (msExchCurrentRoles and Exch_Role_UM) = Exch_Role_UM Then
				str = str & "UnifiedMessaging "
				i = i - Exch_Role_UM
			End If

			If (msExchCurrentRoles and Exch_Role_Hub) = Exch_Role_Hub Then
				str = str & "HubTransport "
				i = i - Exch_Role_Hub
			End If

			If (msExchCurrentRoles and Exch_Role_Edge) = Exch_Role_Edge Then
				str = str & "EdgeTransport "
				i = i - Exch_Role_Edge
			End If

			If i <> 0 Then
				str = str & vbCRLF & Space (spaces) & _
					"Unknown bits set in msExchCurrentRoles = 0x" & Hex(i)
			End If

			e Space (spaces) & "Exchange roles installed: " & str
		Else
			i = objServer.Get ("serverRole")
			If i = 1 Then
				e Space (spaces) & "Exchange role: Front-end server"
			Else
				e Space (spaces) & "Exchange role: Back-end server"
			End If
		End If
		Err.Clear

		obj = objServer.Get ("serialNumber")
		If Err = 0 Then
			If IsNull (obj) Then
				e Space (spaces) & "No version found"
			ElseIf IsEmpty (obj) Then
				e Space (spaces) & "Version string is empty"
			ElseIf IsArray (obj) Then
				For Each str in obj
					e Space (spaces) & str
				Next
			Else
				e Space (spaces) & obj
			End If
		End If
		Err.Clear

	End If
	e " "
	Set objServer = Nothing

	On Error Goto 0
End Sub

Until next time...

As always, if there are items you would like me to talk about, please drop me a line and let me know!