GroupModifyMessageRestrictions.vbs

'=========================================================================
' GroupModifyMessageRestrictions.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: [email protected]
' WEB: https://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Modifies Messages Restrictions on Email Enabled Groups as Shown
' on the Exchange General Tab under the Properties. Set the Group Path,
' Whether to Only Accept Messages from Authenticated Users, the Restriction
' Type, and an Array of Groups/Users that Can Send to the List. The Array Can
' Contain the Distinguised Name or SMTP Email Address of the Group/User. To Bulk
' Modify Groups, Set the Group Path to an Organizational Unit or Container Path.
' EXAMPLE: Only Allow Joe Smith and [email protected] To Send to All Distribution Lists in OU
'          strGroupPath = "LDAP://OU=Distribution Lists,DC=domain,DC=com"
'          blnAuthenticate = False
'          strRestriction = "only from"
'          arrList = Array("CN=Joe Smith,CN=Users,DC=domain,DC=com","[email protected]")
' EXAMPLE: All Everyone to Send To a Distribution List Called Test
'          strGroupPath = "LDAP://CN=Test,CN=Users,DC=domain,DC=com"
'          blnAuthenticate = False
'          strRestriction = "only from"
'          (*Note: Remove the arrList Line For This to Work)
' EXAMPLE: Only Allow Autheniticated Users to Send to a Distribution List Called Test
'          strGroupPath = "LDAP://CN=Test,CN=Users,DC=domain,DC=com"
'          blnAuthenticate = True
'          strRestriction = "only from"
'          (*Note: Remove the arrList Line For This to Work)
'=========================================================================
Option Explicit
' ------ START CONFIGURATION ------
Dim strGroupPath, blnAuthenticate, strRestriction, arrList
          strGroupPath = "LDAP://OU=Distribution Lists,DC=domain,DC=com"
          blnAuthenticate = False
          strRestriction = "only from"
          arrList = Array("CN=Joe Smith,CN=Users,DC=domain,DC=com","[email protected]")
' ------ END CONFIGURATION ------

Call Logger("GroupModifySenderRestrictions.txt", "", True)
strGroupPath = Replace(strGroupPath,"LDAP://","",1,1,1) 'Ensure DN not ADS Path
Dim objConnection: Set objConnection = CreateObject("ADODB.Connection")
Dim objCommand: Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000   'Override the Return 1000 Results Default
Const ADS_SCOPE_SUBTREE = 2
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE    'Include Sub OU's
objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strGroupPath & "' WHERE objectClass='group'"
Dim objRecordSet: Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
Dim objGroup, blnErr, strResult: strResult = ""
Do Until objRecordSet.EOF
    If ModifyRestrictions(objRecordSet.Fields("AdsPath").Value, blnAuthenticate, strRestriction, arrList) = True Then
        Call Logger("GroupModifySenderRestrictions.txt", "Success" & vbTab &  objRecordSet.Fields("AdsPath").Value, False)
    Else
        Call Logger("GroupModifySenderRestrictions.txt", "!~ERROR~!" & vbTab &  objRecordSet.Fields("AdsPath").Value, False)
    End If
    objRecordSet.MoveNext
Loop
Wscript.Echo "Finished"

Private Function ModifyRestrictions(groupDN, blnAuth, restrictionType, arrMembers)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    Const cdoexmAccept = 0
    Const cdoexmReject = 1
    If StrComp(Trim(restrictionType),"from everyone",1) = 0 Then
        objGroup.RestrictedAddresses = cdoexmAccept
    Elseif StrComp(Trim(restrictionType),"only from",1) = 0 Then
        objGroup.RestrictedAddresses = cdoexmAccept
    Elseif StrComp(Trim(restrictionType),"from everyone except",1) Then
        objGroup.RestrictedAddresses = cdoexmReject
    End If
    objGroup.msExchRequireAuthToSendTo = blnAuth
    objGroup.RestrictedAddressList = arrMembers
    objGroup.SetInfo

    If Err.Number <> 0 Then
        ModifyRestrictions = FALSE
    Else
        ModifyRestrictions = TRUE
    End If

    On Error GoTo 0

End Function

Private Sub Logger(fileName, logMessage, blnNewLog)

    On Error Resume Next

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                        Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                        Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                    End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing

    On Error Goto 0

End Sub