Suffering from a lack of inspiration I decided to rework a previous script.
I had a request on my previous messagerestriction script.
Added to the script is the option to enter the smtp address of
the user or group object for which the messagerestrictions are set.
I have done that by re-using code from this script.
Another question was the option to output to a file,
this can be done easily by running the script like this:

cscript enumeratesendtorights.vbs > thefilenameofyourchoice.txt.

Follow the next steps to run the script (no admin rights needed):

* find the distinguished name of the nested group (adsiedit.msc)
* open your favorite text editor
* copy and paste the script into the editor
* change the distinguished name
* save the script (for example c:tempenumeratesendtorights.vbs)
* open a command prompt
* go to “c:temp”
* give “cscript enumeratesendtorights.vbs” (without quotes) and enter

The script:

' Name : enumeratesendtorights.vbs
' Description : script to enumerate the message restrictions (send to rights) of a distributionlist
' Author : dirk adamsky - deludi bv
' Version : 2.00 added smtp input option based on input from M (see comments on previous script)
' Date : 20-08-2010 (v.1.00 date 08-02-2010)
' Level: advanced

strObject = InputBox("Please enter the smtp address")
Set objSource = GetObject("LDAP://" & GetDN(strObject))
If TypeName(objSource.authOrig) = "String" Then
	GetSendToRights ("LDAP://" & objSource.authOrig)
Else
	For Each User In objSource.authOrig
		GetSendToRights ("LDAP://" & User)
	Next
End If
If TypeName(objSource.dLMemSubmitPerms) = "String" Then
	EnumNestedgroup objSource.dLMemSubmitPerms
Else
	For Each Group in objSource.dLMemSubmitPerms
		EnumNestedgroup Group
	Next
End If
Set objSource = Nothing

Function GetDN(strMail)
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"

	' Filter on user objects.
	strFilter = "(mail=" &  strMail & ")"

	' Comma delimited list of attribute values to retrieve.
	strAttributes = "distinguishedName"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False
	Set adoRecordset = adoCommand.Execute
	wscript.echo adoRecordset.Fields("distinguishedName").Value
	GetDN = adoRecordset.Fields("distinguishedName").Value
	adoRecordset.Close
	adoConnection.Close

	Set adoRecordset = Nothing
	Set objRootDSE = Nothing
	Set adoConnection = Nothing
	Set adoCommand = Nothing

End Function

Function GetSendToRights(strUserDN)
	On Error Resume Next
	Set objAccount = GetObject(strUserDN)
	Wscript.Echo objAccount.Mail & " ; " & objAccount.DisplayName & " ; direct send to rights"
	Set objSecurityDescriptor = objAccount.Get("ntSecurityDescriptor")
	Set objDacl = objSecurityDescriptor.DiscretionaryAcl
	Set objAce = CreateObject("AccessControlEntry")
	For Each objAce In objDacl
		If objAce.ObjectType = "{AB721A54-1E2F-11D0-9819-00AA0040529B}" Then
			If (Left(objAce.Trustee,3) <> "S-1" And objAce.Trustee <> "NT AUTHORITYSELF") Then
				GetUserDetails Mid(objAce.Trustee,9)
			End If
		End If
	Next
End Function

Function GetUserDetails(strPreW2K)
	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

	' Search entire Active Directory domain.
	Set objRootDSE = GetObject("LDAP://RootDSE")
	strDNSDomain = objRootDSE.Get("defaultNamingContext")
	strBase = "<LDAP://" & strDNSDomain & ">"

	' Filter on user objects.
	strFilter = "(&(objectCategory=person)(objectClass=user)(sAMAccountName=" &  strPreW2K & "))"

	' Comma delimited list of attribute values to retrieve.
	strAttributes = "mail, displayname"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute
	Wscript.Echo adoRecordset.Fields("mail").Value & " ; " & adoRecordset.Fields("displayname").Value & " ; indirect send to rights"
	' Clean up.
	adoRecordset.Close
	adoConnection.Close

	Set adoRecordset = Nothing
	Set objRootDSE = Nothing
	Set adoConnection = Nothing
	Set adoCommand = Nothing
End Function	

Sub EnumNestedgroup(strGroupDN)
	Set objGroup = GetObject("LDAP://" & strGroupDN)
	For Each objMember in objGroup.Members
		If (LCase(objMember.Class) = "group") Then
			Call EnumNestedgroup(objMember.AdsPath)
		Else
			GetSendToRights objMember.AdsPath
		End If
	Next
	Set objGroup = Nothing
End Sub

When you have problems/questions with the script please post a reply.

Happy scripting.

Best regards,

Dirk Adamsky

This script enables oma (outlook mobile access) based on a list of smtp addresses in an excel sheet.

What the script does:

• get the users smtp address from the excel sheet (c:\tempoma.xls)
• the function FindDN finds the corresponding distinguished name of the user object
• the function EnableOma enables oma for the user
• the function LogPrint creates logging for all actions

Follow the next steps to run the script (admin rights needed):

• create an excel sheet with a list of smtp addresses to be oma enabled
• save the sheet as c:tempoma.xls
• copy and paste the script in your favorite text editor
• save the script (for example c:tempenableoma.vbs)
• open a command prompt
• go to “c:temp”
• give “cscript enableoma.vbs” (without quotes) and enter

The script:

' Name : enableoma.vbs
' Description : script to enable oma (outlook mobile access) from an excel sheet
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 06-04-2010

Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("C:\tempoma.xls")
intRow = 2
Do Until objExcel.Cells(intRow,1).Value = ""
    strSmtpAddress = objExcel.Cells(intRow, 1).Value
    If strSmtpAddress <> "" Then
		strDN = FindDN(strSmtpAddress)
		EnableOma strDN
		Logprint "outlook mobile access is enabled for ; " & strSmtpAddress
	End If
	intRow = intRow + 1
Loop
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing

Function EnableOma(strAccount)
	Set objUser = GetObject ("LDAP://" & strAccount)
	objUser.Put "msExchOmaAdminWirelessEnable", "0"
	objUser.setinfo
	Set objUser = Nothing
End Function

Function LogPrint(Message)
Const ForAppending = 8
strDate = Replace(Date,"/","-")
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set objTextFile = ObjFSO.OpenTextFile(strDate & "-OmaEnabledAgain.csv", ForAppending, True)
    objTextFile.WriteLine Message
    objTextFile.Close
Set objTextFile = Nothing
Set ObjFSO = Nothing
End Function

Function FindDN(strSmtp)

	Set adoCommand = CreateObject("ADODB.Command")
	Set adoConnection = CreateObject("ADODB.Connection")
	adoConnection.Provider = "ADsDSOObject"
	adoConnection.Open "Active Directory Provider"
	adoCommand.ActiveConnection = adoConnection

	Set objRootDSE = GetObject("LDAP://RootDSE")
	strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"

	' Filter on user objects.
	strFilter = "(mail=" & strSmtp & ")"

	' Comma delimited list of attribute values to retrieve.
	strAttributes = "distinguishedName"

	' Construct the LDAP syntax query.
	strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
	adoCommand.CommandText = strQuery
	adoCommand.Properties("Page Size") = 100
	adoCommand.Properties("Timeout") = 30
	adoCommand.Properties("Cache Results") = False

	' Run the query.
	Set adoRecordset = adoCommand.Execute
	FindDN = adoRecordset.Fields("distinguishedName").Value

	' Clean up.
	adoRecordset.Close
	adoConnection.Close

	Set objRootDSE = Nothing
	Set adoConnection = Nothing
	Set adoCommand = Nothing
End Function

When you have problems/questions please post a reply, you can also rate the script.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

For most system administrators cleaning up Active Directory is not their favorite thing.
This script helps you by enumerating all empty groups, so you can remove them (manually).

Follow the next steps to run the script (no admin rights needed):

* open your favorite text editor
* copy and paste the script into the editor
* save the script (for example c:\temp\emptygroups.vbs)
* open a command prompt
* go to “c:\temp”
* give “cscript emptygroups.vbs” (without quotes) and enter

The script:

' Name : emptygroups.vbs
' Description : script to enumerate all empty groups
' Author : dirk adamsky - deludi bv
' Version : 1.00
' Date : 18-03-2010
' Level : intermediate

Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
strBase = "<LDAP://" & objRootDSE.Get("defaultNamingContext") & ">"
Set objRootDSE = Nothing

strFilter = "(&(objectCategory=group)(!member=*))"
strAttributes = "name"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute
Do Until objRecordSet.EOF
	Wscript.Echo objRecordSet.Fields("name").Value
	objRecordSet.MoveNext
Loop

objRecordSet.Close
objConnection.Close

Set objRecordSet = Nothing
Set objConnection = Nothing
Set objCommand = Nothing

When you have problems/questions please post a reply, you can also rate the script.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

The script for today is a monitoring script.
Basically it is a concatenation of previous scripts/functions.
The script can be run as a scheduled task (for example every half hour).

What the script does:

• run an ado query to get all servers from Active Directory
• the function CheckStatus does the wmi ping to the servers and returns true or false
• the servers that do not respond are put into a variable
• the content of the variable is mailed to a given smtp address

Follow the next steps to run the script (no admin rights needed):

• copy and paste the script in your favorite text editor
• save the script (for example c:tempserveralive.vbs)
• open a command prompt
• go to “c:temp”
• give “cscript serveralive.vbs” (without quotes) and enter

The script:

' Name : serveralive.vbs
' Description : script to monitor all servers in Active Directory
' Author : dirk adamsky - deludi bv
' Version : 1.10 changed ado filter
' Date : 17-03-2010

' Setup ADO objects.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
adoCommand.ActiveConnection = adoConnection

' Search entire Active Directory domain.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
strBase = "<LDAP://" & strDNSDomain & ">"

' Filter on user objects.
strFilter = "(&(objectCategory=computer)(operatingSystem=*server*))"

' Comma delimited list of attribute values to retrieve.
strAttributes = "name"

' Construct the LDAP syntax query.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Run the query.
Set adoRecordset = adoCommand.Execute

' Enumerate the resulting recordset.
Do Until adoRecordset.EOF
	'On Error Resume Next
	strHostname = adoRecordset.Fields("name").Value
	If CheckStatus(strHostname) = False Then
		strNoReply = strNoReply & " ; " & strHostname
	End If
	'Move to the next record in the recordset.
    adoRecordset.MoveNext
Loop
Sendmail "monitoring@monitoring.org", strNoReply & " are not responding!" 'change the smtp address to your monitoring mailbox or distributionlist
' Clean up.
adoRecordset.Close
adoConnection.Close

Set adoRecordset = Nothing
Set objRootDSE = Nothing
Set adoConnection = Nothing
Set adoCommand = Nothing

Function CheckStatus(strAddress)
	Dim objPing, objRetStatus
	Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery _
      ("select * from Win32_PingStatus where address = '" & strAddress & "'")
	For Each objRetStatus In objPing
        If IsNull(objRetStatus.StatusCode) Or objRetStatus.StatusCode <> 0 Then
			CheckStatus = False
        Else
			CheckStatus = True
        End If
    Next
	Set objPing = Nothing
End Function 

Function SendMail(strRecipient, strHeader)
	Set objMessage = CreateObject("CDO.Message")
	objMessage.Subject = strHeader
	objMessage.From = "guman002@utrecht.nl"
	objMessage.To = strRecipient
	objMessage.TextBody = "This is an automated message do not repond (or else you will be punished)."
	objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.test.org" 'change to your smtp server
	objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objMessage.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 60
	objMessage.Configuration.Fields.Update
	objMessage.Send
	Set objMessage = Nothing
End Function

When you have problems/questions please post a reply or give a ‘star’ rating.

Happy scripting.

Best regards,

Dirk Adamsky – Deludi BV

[adrotate group="2" banner="4"]