Monday, December 19, 2005

Auto RAI

 
 Posted by Picasa

Create Distribution list and add users to the list (VBscript)

The following script create a Distribution List and add mail enabled users to the list. This can be defined per OU, by changing the LDAP paths.

Good luck.

Questions? Feel free to send an email or comment the script.


'* ********************************************************************
'* ********************************************************************
'* CreateDL.vbs
'*
'* The script adds all mail enabled users to a Distribution List.
'*
'*
'* Jeroen Lanters
'* 14-10-2005
'*
'* ********************************************************************
'* ********************************************************************

Option Explicit

Const ADS_SCOPE_SUBTREE = 2
Const ADS_PROPERTY_CLEAR = 1

'Mail Enabled Distribution Group'
Const mailEnable = 2

Dim objConnection,objCommand,objRecordSet
Dim fs, strOutput,i
Dim strHomeserver, strUser
Dim strDn,StrOUdl,strDL, objGroup,strADsPath

'* *********************************** Set variables *****************
'Domain
strDN = "DC=,DC="

'OU to create DL
strOUdl = "OU="

'Name of DL
strDL = "dl_AllUsers"

'Set Counter
i=0

'Setup ADO connection
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

' Create outputfile
Set fs = CreateObject ("Scripting.FileSystemObject")
Set strOutput = fs.CreateTextFile ("result.txt")
Set objCommand.ActiveConnection = objConnection

' Search statement
objCommand.CommandText = "Select adspath,Name,mail,msExchHomeServerName from 'LDAP://"&strDN&"' "_
& "where msExchHomeServerName='*'"
objCommand.Properties("Page Size") = 10000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Timeout") = 300
objCommand.Properties("Cache Results") = False

'Execute search statement
set objRecordSet = objCommand.Execute
'Set pointer to first record.
objRecordSet.MoveFirst

' create DL or remove all members from existing DL.
makeDL
' Add users to DL group
AddUsers

'Cleanup
Set objRecordSet = Nothing
Set objGroup = Nothing

Function AddUsers()

' Get DL to add users
Set objGroup = GetObject("LDAP://cn=" & strDL & "," & strOUdl & "," & strDN)

'Remove all members from group
objGroup.PutEx ADS_PROPERTY_CLEAR, "member", 0
objGroup.SetInfo

'Step through the recordset
Do Until objRecordSet.EOF
strHomeserver = lcase(objRecordSet.Fields("msExchHomeServerName").Value)
struser = objRecordSet.Fields("name").Value
strADsPath = objRecordSet.Fields("adspath").Value
'WScript.Echo strUser & " ; " & strADsPath
strOutput.writeline struser & " : " & strHomeserver
objGroup.Add strADsPath
i = i + 1
objRecordSet.MoveNext
Loop
strOutput.writeline "Total users : " & i
End Function

Function makeDL
Dim objOU
Dim objGroup
On Error Resume Next
Set objOU = GetObject("LDAP://" & strOUdl & "," & strDN)
Set objGroup = objOU.Create("Group", "cn=" & (strDL))
objGroup.Put "groupType", mailEnable
objGroup.Put "sAMAccountName", (strDL)
objGroup.Put "mailNickName", (strDL)
objGroup.Put "description", "Distribution List for " & (strDL)
objGroup.setInfo
WScript.Echo("The following mail enabled distribution list was created: " & (strDL))

Set objOU = Nothing
Set objGroup = Nothing

End Function

Friday, December 16, 2005

Get Exchange Server information (VBScript)

Always want to have information from your Exchange server, this script will enumerate the following:
- All Exchange server(s) in you organisation with
- Storage Group(s)
- Mailstore (private and public)
- Size of databases

Copy the code and change the "cComputerName" value and go

Good luck

'**********************************************************************
'START OF SCRIPT
'**********************************************************************
' VBScript script listing all ExchangeServerState names and properties
' available with the WMI Exchange 2000 provider.
'

'Option Explicit

'On Error Resume next
Const cComputerName = "NAME OF A EXCHANGE SERVER IN YOUR ORGANISATION."
Const cWMINameSpace = "root/cimv2/applications/exchange"
Const cWMIInstance = "ExchangeServerState"

set wshell = wscript.createobject("wscript.shell")
Set objFSO = CreateObject ("Scripting.FileSystemObject")
Set fs = CreateObject ("Scripting.FileSystemObject")
Set strOutput = fs.CreateTextFile ("result.txt")
Set strOutput1 = fs.CreateTextFile ("pubresult.txt")

Dim strServerName
Dim ExchangeServerList
Dim ExchangeServer, i

' -----------------------------------------------------------------------------
' Getting the current default domain. (DN and FQDN)
Set objRoot = GetObject("LDAP://RootDSE")
strDefaultDomainNC = objRoot.Get("DefaultNamingContext")
Set objRoot = Nothing

' Bind to the root domain to get its canonical name for UPN.
Set objDefaultDomainNC = GetObject("LDAP://" & strDefaultDomainNC)

' Retrieve a constructed property.
' First do a GetInfoEx (for UPN construction).
objDefaultDomainNC.GetInfoEx Array("canonicalName"), 0
strCanonicalNameDefaultDomain = objDefaultDomainNC.Get("canonicalName")

Set objDefaultDomainNC = Nothing


If Not VerifyExchangeOrg ("First Organization") Then
Wscript.Echo "Organization name not found or " & _
"Exchange not installed in the Forest."
Wscript.Quit (1)
End If

Set ExchangeServerList = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & _
cComputerName & "/" & _
cWMINameSpace).InstancesOf(cWMIInstance)


'set objWMIExchangeServers = GetObject("winmgmts:{impersonationLevel=impersonate}!//" & _
' cComputerName & _
' cWMINameSpace).InstancesOf(cWMIInstance)

EnumExchangeServers ExchangeServerList

Private Function EnumExchangeServers (objWMIExchangeServers)

Dim objWMIExchangeServer
Dim objCDOEXMExchangeServer

Set objCDOEXMExchangeServer = CreateObject("CDOEXM.ExchangeServer")

For each objWMIExchangeServer in objWMIExchangeServers
' Switch to CDOEXM to get CDOEXM information
' by using the WMI server name.
if pinghost(objWMIExchangeServer.Name) = True then
objCDOEXMExchangeServer.DataSource.Open(objWMIExchangeServer.Name)

WScript.Echo "Reading Exchange server '" & objCDOEXMExchangeServer.Name
strServerName = objCDOEXMExchangeServer.Name
strOutput.writeline objCDOEXMExchangeServer.Name
EnumStorageGroups objCDOEXMExchangeServer
Else
strOutput.write objCDOEXMExchangeServer.Name & "; Turned OFF"
End if
Next

Set objCDOEXMExchangeServer = Nothing
End Function

' -----------------------------------------------------------------------------
Private Function EnumStorageGroups (objCDOEXMExchangeServer)

Dim objStorageGroup
Dim urlStorageGroup

Set objStorageGroup = CreateObject("CDOEXM.StorageGroup")

For Each urlStorageGroup In objCDOEXMExchangeServer.StorageGroups
' WScript.Echo "urlStorageGroup(CDOEXM)" & urlStorageGroup

objStorageGroup.DataSource.Open (urlStorageGroup)

wscript.echo "Storage Group Name(CDOEXM)" & objStorageGroup.Name

strOutput.writeline ";" & objStorageGroup.Name
' At this level of the object hierarchy, you can move the log
' and system files of the storage group to another location.
' objStorageGroup.MoveLogFiles
' objStorageGroup.MoveSystemFiles

' If cEnumFieldsCollection Then _
' EnumFieldsCollection objStorageGroup.Fields

EnumMailboxStoreDBs objStorageGroup
'Get PF info
EnumPublicStoreDBs objStorageGroup


' Next Storage Group
Next

WScript.DisconnectObject objStorageGroup
Set objStorageGroup = Nothing

End Function

' -----------------------------------------------------------------------------
Private Function EnumMailboxStoreDBs (objStorageGroup)

Dim objMailboxStoreDB
Dim urlMailboxStoreDB

Set objMailboxStoreDB = CreateObject("CDOEXM.MailBoxStoreDB")

For Each urlMailboxStoreDB In objStorageGroup.MailboxStoreDBs

objMailboxStoreDB.DataSource.Open (urlMailboxStoreDB)

WScript.Echo "Reading Mailbox Store DB" & objMailboxStoreDB.Name
' WScript.Echo "PublicStoreDB" & objMailboxStoreDB.PublicStoreDB
' WScript.Echo "Status" & objMailboxStoreDB.Status
' WScript.Echo "Enabled" & objMailboxStoreDB.Enabled
' WScript.Echo "StoreQuota" & objMailboxStoreDB.StoreQuota
' WScript.Echo "OverQuotaLimit" & objMailboxStoreDB.OverQuotaLimit
' WScript.Echo "HardLimit" & objMailboxStoreDB.HardLimit



' test = wshell.run("%comspec% /c dir \\" & strServerName & "\" & Replace(objMailboxStoreDB.DBPath,":\","$\") > c:\dir.txt", 0 , True)
test = wshell.run("%comspec% /c dir ""\\" & strServerName & "\" & Replace(objMailboxStoreDB.DBPath,":\","$\") & """ > c:\dir.txt", 0 , True)
wscript.sleep(1000)

set FMlist = objFSO.OpenTextFile("c:\dir.txt")

Do While Not FMList.AtEndOfStream
strData = FMList.ReadLine
If InStr(strData,"1 File(s)") > 1 Then
i = InStr(strData,"1 File(s)") + 9
j = Len(strData)
WScript.Echo Right(strData,j-i)
strOutput.writeline ";;" & objMailboxStoreDB.Name & ";" & Right(strData,j-i)
End If
Loop
FMList.close
objFSO.DeleteFile("C:\dir.txt")

' Next Mailbox Store
Next

WScript.DisconnectObject objMailboxStoreDB
Set objMailboxStoreDB = Nothing

End Function



' -----------------------------------------------------------------------------
Private Function EnumPublicStoreDBs(objStorageGroup)

Dim objPublicStoreDB
Dim urlPublicStoreDB

Set objPublicStoreDB = CreateObject("CDOEXM.PublicStoreDB")

For Each urlPublicStoreDB In objStorageGroup.PublicStoreDBs

objPublicStoreDB.DataSource.Open (urlPublicStoreDB)

WScript.Echo "Reading Public Store DB '" & objPublicStoreDB.Name

test = wshell.run("%comspec% /c dir ""\\" & strServerName & "\" & Replace(objPublicStoreDB.DBPath,":\","$\") & """ > c:\dir.txt", 0 , True)
wscript.sleep(1000)

set FMlist = objFSO.OpenTextFile("c:\dir.txt")

Do While Not FMList.AtEndOfStream
strData = FMList.ReadLine
If InStr(strData,"1 File(s)") > 1 Then
i = InStr(strData,"1 File(s)") + 9
j = Len(strData)
WScript.Echo Right(strData,j-i)
sizeoutput = Right(strData,j-i)
strOutput.writeline ";;" & objPublicStoreDB.Name & ";" & Right(strData,j-i)
End If
Loop
strOutput1.writeline strServerName & ";" & sizeoutput
FMList.close
objFSO.DeleteFile("C:\dir.txt")



' Next Public Store
Next

WScript.DisconnectObject objPublicStoreDB
Set objPublicStoreDB = Nothing

End Function
' ---------------------------------------------------------------------------------
Private Function VerifyExchangeOrg (strExchangeOrganization)

Dim objRoot
Dim strConfigNC
Dim objExchangeContainer
Dim objExchangeChild

Set ObjRoot = GetObject("LDAP://RootDSE")
strConfigNC = ObjRoot.Get("configurationNamingContext")
WScript.DisconnectObject ObjRoot
Set ObjRoot = Nothing

On Error Resume Next
Set objExchangeContainer = GetObject ("LDAP://CN=Microsoft Exchange,CN=Services," & _
strConfigNC)
If Err.Number Then
' If the Exchange container is not present in Services, Exchange 2000
' is not installed.
VerifyExchangeOrg = False
Exit Function
End If

For Each objExchangeChild In objExchangeContainer
If (objExchangeChild.Class = "msExchOrganizationContainer") then
' (objExchangeChild.Get ("cn") = strExchangeOrganization)
'Then
Wscript.Echo "Found Exchange Organization called '" & _
objExchangeChild.Get ("cn") & "'."
Wscript.Echo
VerifyExchangeOrg = True
Exit Function
End If
Next

VerifyExchangeOrg = False

End Function

Function CountMBX(pMBXStore,pStorerageGroup,pServer)

Const ADS_SCOPE_SUBTREE = 2
Const ADS_PROPERTY_CLEAR = 1
'Mail Enabled Distribution Group'
Const mailEnable = 2

Dim objConnection,objCommand,objRecordSet
Dim fs, strOutput,i
Dim strHomeserver, strUser
Dim strDn,StrOUdl,strDL, objGroup,strADsPath

'* *********************************** Set variables *****************
'Domain
strDN = "DC=d20,DC=intra"
'Set Counter
i=0

'Setup ADO connection
Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand.ActiveConnection = objConnection

' Search statement
objCommand.CommandText = "Select homeMDB from 'LDAP://"&strDN&"' "_
& "where msExchHomeServerName = '*" & pServer & "'"

wscript.echo objCommand.CommandText
objCommand.Properties("Page Size") = 10000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Timeout") = 300
objCommand.Properties("Cache Results") = False

'Execute search statement
set objRecordSet = objCommand.Execute
'Set pointer to first record.
objRecordSet.MoveFirst
'Step through the recordset
Do Until objRecordSet.EOF
strHomeserver = objRecordSet.Fields("homeMDB").Value
if strHomeserver <> "" And InStr(strHomeserver,pStorerageGroup)> 1 And InStr(strHomeserver,pMBXStore) > 1 Then
' struser = objRecordSet.Fields("name").Value
' strADsPath = objRecordSet.Fields("adspath").Value
' strOutput.writeline struser & " : " & strHomeserver
i = i + 1
end if
objRecordSet.MoveNext
Loop
CountMBX = i
End Function

Function PingHost(pServer)

Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec("ping -n 2 -w 1000 " & pServer)
strPingResults = LCase(objExec.StdOut.ReadAll)
If InStr(strPingResults, "reply from") Then
PingHost = True
Else
PingHost = False
End If

End Function