Jan 04

GroupModifyManager.vbs

Posted on January 4, 2013 by admin

'=========================================================================
' GroupModifyManager.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/4/2013
' COMMENTS: This will set the manager for a group and optionally allow them
' to update group membership. Set the manager by specificying the LDAP path
' or DN of the user you want to set. Set the group to modify by specifying
' the LDAP path or DN of a specific group; you can also set this to an OU
' to make bulk changes. Last, specify whether the manager can update the
' group membership by setting the True/False value.
' EXAMPLE: Modify a Specific Group's Manager and Allow Them to Update Membership
'          Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com"
'          Dim strGroupPath: strGroupPath = "LDAP://CN=Testgroup,OU=Groups,DC=domain,DC=com"
'          Dim blnUpdateMembership: blnUpdateMembership = True
' EXAMPLE: Modify a Specific Group's Manager and Do Not Allow Them to Update Membership
'          Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com"
'          Dim strGroupPath: strGroupPath = "LDAP://CN=Testgroup,OU=Groups,DC=domain,DC=com"
'          Dim blnUpdateMembership: blnUpdateMembership = False
' EXAMPLE: Bulk Modify All Group's Managers in an OU and Allow Them to Update Membership
'          Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com"
'          Dim strGroupPath: strGroupPath = "LDAP://OU=Groups,DC=domain,DC=com"
'          Dim blnUpdateMembership: blnUpdateMembership = True
'=========================================================================
Option Explicit
' ------ START CONFIGURATION ------
Dim strManager: strManager = "LDAP://CN=John Doe,OU=User,DC=domain,DC=com"
Dim strGroupPath: strGroupPath = "LDAP://OU=Groups,DC=domain,DC=com"
Dim blnUpdateMembership: blnUpdateMembership = True
' ------ END CONFIGURATION ------

Dim strLogName: strLogName = Replace(WScript.ScriptName,".vbs",".txt")
Call Logger(strLogName, "", True)
Call ModifyManger(strGroupPath, strManager, blnUpdateMembership, strLogName)
Wscript.Echo "Finished"

Private Sub ModifyManger(groupPath, groupManager, groupUpdateMembership, groupLogName)

    On Error Resume Next

    'Ensure DN not ADS Path
    groupPath = Replace(groupPath,"LDAP://","",1,1,1)
    groupManager = Replace(groupManager,"LDAP://","",1,1,1)

    'Constants/Variables to Set Manager Update List Access
    Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5
    Const ADS_RIGHT_DS_WRITE_PROP = &H20
    Const ADS_ACEFLAG_INHERIT_ACE = &H00002 'Not Needed but Kept it here for Reference
    Const ADS_ACEFLAG_DONT_INHERIT_ACE = &H0
    Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H01
    Const ADS_OBJECT_WRITE_MEMBERS = "{BF9679C0-0DE6-11D0-A285-00AA003049E2}"
    Dim objSecurityDescriptor, objDACL, objUser, objACE

    'Connect to AD
    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
    If Not objRecordSet.RecordCount > 0 Then
        Call Logger(groupLogName, "Error No Groups Found Quitting Script!", False)
        Exit Sub
    End If
    objRecordSet.MoveFirst
    Dim objGroup
    Do Until objRecordSet.EOF
        Call Logger(groupLogName, objRecordSet.Fields("ADsPath").Value & vbCrLf & "**********************************************", False)
        Set objGroup = GetObject(objRecordSet.Fields("ADsPath").Value)
        objGroup.Put "managedBy", groupManager
        objGroup.SetInfo
        If Err.Number <> 0 Then
            Err.Clear
            Call Logger(groupLogName, "Error Updating Manager to: " & groupManager, False)
        Else
            Call Logger(groupLogName, "Success Updating Manager to: " & groupManager, False)
            If groupUpdateMembership = True Then
                'Allow Manager to Update Member List
                Call Logger(groupLogName, "Allow Manager to Update Member List: True", False)
                Set objSecurityDescriptor = objGroup.Get("ntSecurityDescriptor")
                Set objDACL = objSecurityDescriptor.DiscretionaryACL
                Set objUser = GetObject("LDAP://" & objGroup.Get("managedBy"))
                Set objACE = CreateObject("AccessControlEntry")
                objACE.Trustee = "snapretail\" & objUser.Get("sAMAccountName")
                objACE.AccessMask = ADS_RIGHT_DS_WRITE_PROP
                objACE.AceFlags = ADS_ACEFLAG_DONT_INHERIT_ACE
                objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
                objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT
                objACE.objectType = ADS_OBJECT_WRITE_MEMBERS
                objDACL.AddAce(objACE)
                objSecurityDescriptor.DiscretionaryACL = objDACL
                objGroup.Put "ntSecurityDescriptor", Array(objSecurityDescriptor)
                objGroup.SetInfo
                If Err.Number <> 0 Then
                    Err.Clear
                    Call Logger(groupLogName, "Error Allowing Manager to Update Member List", False)
                Else
                    Call Logger(groupLogName, "Success Allowing Manager to Update Member List", False)
                End If
            End If
        End If

        Call Logger(groupLogName, "" & vbCrLf, False)

        objRecordSet.MoveNext

    Loop

    On Error Goto 0

End Sub

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

Jan 01

GroupBackupRestore.vbs

Posted on January 1, 2011 by admin

'=========================================================================
' GroupBackupRestore.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: This Script Will Bulk Backup Groups to a Text File and Can Also
' Restore the Groups After a Backup.  It is Useful to Restore Accidentally
' Deleted Groups, Migrating Groups Across Domains, and For Quickly Restoring
' Settings For Temporary Modifications Such as Removing and Restoring Message
' Restrictions. Parts of this Script Require Exchange DLL's like CDOEXM.DLL,
' So It's Recommended to Run on a Computer with Exchange Tools Installed.
'
' To Backup Groups, Pass the ADsPath or Dinstinguised Name of the
' Container/Organizational Unit to the RunBackup Function. The Results are
' Output to backup_<Date>.txt in the Current Directory by Default. I Recommend
' Keeping the Default To Prevent Accidentally Overwriting the Backup File.
'
' To Restore Groups, Pass the Name of the Backup File to the RunRestore Function.
' By Default, the Backup File is backup_Date.txt in the Current Directory.
'
' EXAMPLE: Call RunBackup("LDAP://CN=Users,DC=domain,DC=com")
'
' EXAMPLE: Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
'          Call RunRestore(scriptPath & "backup.txt")
'=========================================================================
Option Explicit
' ------ BACKUP CONFIGURATION ------
Call RunBackup("LDAP://CN=Users,DC=domain,DC=com")
' ------ END CONFIGURATION ------

' ------ RESTORE CONFIGURATION ------
'Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
'Call RunRestore(scriptPath & "backup.txt")
' ------ END CONFIGURATION ------

Wscript.Echo "Finished"

'**************************************************************************************************
'Sub RunBackup - Specify Root Search OU to Enumerate All Groups to Backup
'**************************************************************************************************
Private Sub RunBackup(strOU)

    On Error Resume Next

    strOU = Replace(strOU,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Const ADS_SCOPE_SUBTREE = 2
    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
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE    'Include Sub OU's
    objCommand.CommandText = "SELECT distinguishedname FROM 'LDAP://" & strOU & "' WHERE objectClass='group'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    If Err.Number <> 0 Then
        Wscript.Echo "!~ERROR~! Running Backup!" & vbCrLf & "Invalid OU: " & strOU & vbCrLf & vbCrLf & "Quitting Script"
        Err.Clear
        Wscript.Quit
    End If
    Dim strDate: strDate = Day(Now) & Month(Now) & Year(Now) & Hour(Now) & Minute(Now) & Second(Now)
    Call Logger("backup_" & strDate & ".txt","", True)
    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        'Backup Groups
        Call Logger("backup_" & strDate & ".txt",BackupGroup(objRecordSet.Fields("distinguishedname").Value), False)
        objRecordSet.MoveNext
    Loop

    On Error Goto 0

End Sub

'**************************************************************************************************
'Function BackupGroup - Specify the Group Distinguished Name and Backs Up to backup.txt
'**************************************************************************************************
Private Function BackupGroup(groupDN)

    On Error Resume Next

    Dim strResult: strResult = "[group]" & vbCrLf & "group|" & groupDN
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    strResult = strResult & vbCrLf & "name|" & objGroup.CN
    strResult = strResult & vbCrLf & "samaccountname|" & objGroup.sAMAccountName

    Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h2
    Const ADS_GROUP_TYPE_LOCAL_GROUP = &h4
    Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h8
    Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000
    Dim intgroupType: intgroupType = objGroup.groupType
    If intGroupType AND ADS_GROUP_TYPE_LOCAL_GROUP Then
        strResult = strResult & vbCrLf & "scope|Domain Local"
    ElseIf intGroupType AND ADS_GROUP_TYPE_GLOBAL_GROUP Then
        strResult = strResult & vbCrLf & "scope|Global"
    ElseIf intGroupType AND ADS_GROUP_TYPE_UNIVERSAL_GROUP Then
        strResult = strResult & vbCrLf & "scope|Universal"
    Else
        strResult = strResult & vbCrLf & "scope|Unknown"
    End If
    If intGroupType AND ADS_GROUP_TYPE_SECURITY_ENABLED Then
        strResult = strResult & vbCrLf & "type|Security"
    Else
        strResult = strResult & vbCrLf & "type|Distribution"
    End If

    strResult = strResult & vbCrLf & "mail|" & objGroup.mail
    strResult = strResult & vbCrLf & "displayname|" & objGroup.displayName

    Dim strManagedBy: strManagedBy = objGroup.Get("managedBy")
    If Err.Number <> 0 Then
        strResult = strResult & vbCrLf & "manager|None"
        Err.Clear
    Else
        strResult = strResult & vbCrLf & "manager|" & strManagedBy
    End If

    Dim objMember
    For Each objMember in objGroup.Members
        strResult = strResult & vbCrLf & "member|" & objMember.distinguishedName
    Next

    Const cdoexmAccept = 0
    Const cdoexmReject = 1
    Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D
    If Not objGroup.Mail = "" Then
        If objGroup.msExchRequireAuthToSendTo = True Then
            strResult = strResult & vbCrLf & "authentication|True"
        Else
            strResult = strResult & vbCrLf & "authentication|False"
        End If
        If IsNull(objGroup.RestrictedAddressList) OR UBound(objGroup.RestrictedAddressList) < 0 Then
            strResult = strResult & vbCrLf & "Restriction|from everyone"
        Else
            If objGroup.RestrictedAddresses = cdoexmAccept Then
                strResult = strResult & vbCrLf & "festriction|only from"
            Else
                strResult = strResult & vbCrLf & "restriction|from everyone except"
            End If
            For Each objMember in objGroup.RestrictedAddressList
                strResult = strResult & vbCrLf & "restrict|" & objMember
            Next
        End If
    End If

    If Err.Number <> 0 Then
        strResult = "[group]" & vbCrLf & "group|" & groupDN & vbCrLf & "!~ERROR~!"
        Err.Clear
    End If
    BackupGroup = strResult & vbCrLf & "[end]" & vbCrLf

    On Error Goto 0

End Function

'**************************************************************************************************
'Sub Run Restore - Restores Groups From the Specified Backup File
'**************************************************************************************************
Private Sub RunRestore(backupFile)

    On Error Resume Next

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Const ForReading = 1
    If Not objFSO.FileExists(backupFile) Then
        Wscript.Echo "!~ERROR~! Running Restore!" & vbCrLf & "Backup File: " & backupFile & vbCrLf & vbCrLf & "Quitting Script"
        Wscript.Quit
    End If
    Call Logger("restore.txt", "", True)
    Dim objTextFile: Set objTextFile = objFSO.OpenTextFile(backupFile, ForReading)
    Dim strLine
    Dim strGroup, strName, strSamaccountname, strScope, strType, strMail, strDisplayName, strManager, i
    Dim strAuth, strRestriction, j
    Dim arrMember(), arrRestrict()
    Do Until objTextFile.AtEndOfStream
        strLine = objTextFile.Readline
        If StrComp(Mid(strLine,1,7),"[group]",1) = 0 Then
            'Reset Variables
            strGroup = ""
            strName = ""
            strSamaccountname = ""
            strScope = ""
            strType = ""
            strMail = ""
            strDisplayName = ""        
            strManager = ""
            i = 0
            strAuth = ""
            strRestriction = ""
            j = 0
            Erase arrMember
            Erase arrRestrict
            Call Logger("restore.txt", "[group]", False)   
        Elseif StrComp(Mid(strLine,1,6),"group|",1) = 0 Then
            strGroup = Mid(strLine,7,Len(strLine)-6)           
        Elseif StrComp(Mid(strLine,1,5),"name|",1) = 0 Then
            strName = Mid(strLine,6,Len(strLine)-5)
        Elseif StrComp(Mid(strLine,1,15),"samaccountname|",1) = 0 Then
            strSamaccountname = Mid(strLine,16,Len(strLine)-15)
        Elseif StrComp(Mid(strLine,1,6),"scope|",1) = 0 Then
            strScope = Mid(strLine,7,Len(strLine)-6)
        Elseif StrComp(Mid(strLine,1,5),"type|",1) = 0 Then
            strType = Mid(strLine,6,Len(strLine)-5)
        Elseif StrComp(Mid(strLine,1,5),"mail|",1) = 0 Then
            strMail = Mid(strLine,6,Len(strLine)-5)    
        Elseif StrComp(Mid(strLine,1,12),"displayname|",1) = 0 Then
            strDisplayName = Mid(strLine,13,Len(strLine)-12)
        Elseif StrComp(Mid(strLine,1,8),"manager|",1) = 0 Then
            strManager = Mid(strLine,9,Len(strLine)-8)
        Elseif StrComp(Mid(strLine,1,7),"member|",1) = 0 Then
            'blnUsers = True           
            ReDim Preserve arrMember(i)
            arrMember(i) = Mid(strLine,8,Len(strLine)-7)
            i = i + 1
        Elseif StrComp(Mid(strLine,1,15),"authentication|",1) = 0 Then
            If StrComp(Trim(Mid(strLine,16,Len(strLine)-15)),"true",1) = 0 Then
                strAuth = True
            Else
                strAuth = False
            End If
        Elseif StrComp(Mid(strLine,1,12),"restriction|",1) = 0 Then
            strRestriction = Mid(strLine,13,Len(strLine)-12)
        Elseif StrComp(Mid(strLine,1,9),"restrict|",1) = 0 Then
            ReDim Preserve arrRestrict(j)
            arrRestrict(j) = Mid(strLine,10,Len(strLine)-9)
            j = j + 1
        Elseif StrComp(Mid(strLine,1,5),"[end]",1) = 0 Then
            'Ensure Group Exists
            If CheckObjExist(strGroup) Then
                Call Logger("restore.txt", "Exists" & vbTab & "group|" & strGroup, False)
            Else
                If CreateGroup(strGroup, strSamaccountname, strScope & " " & strType, strMail, strDisplayname) = True Then
                    Call Logger("restore.txt", "Added" & vbTab & "group|" & strGroup, False)
                Else
                    Call Logger("restore.txt", "!~ERROR~!" & vbTab & "group|" & strGroup, False)
                End If
            End If

            'Ensure Manager is Set
            If strComp(strManager,"None",1) = 0 Then
                Call Logger("restore.txt", "Skip" & vbTab & "manager|" & strManager, False)
            Else
                If CheckGroupManager(strGroup,strManager) = True Then
                    Call Logger("restore.txt", "Exists" & vbTab & "manager|" & strManager, False)
                Else
                    If ModifyGroupManager(strGroup,strManager) = True Then
                        Call Logger("restore.txt", "Modified" & vbTab & "manager|" & strManager, False)
                    Else
                        Call Logger("restore.txt", "!~ERROR~!" & vbTab & "manager|" & strManager, False)
                    End If
                End If             
            End If

            'Ensure all Members are a member
            For i = LBound(arrMember) to UBound(arrMember)
                If Err.Number <> 0 Then
                    Err.Clear
                    Call Logger("restore.txt", "SKIP" & vbTab & "member|none", False)
                Else
                    'Ensure User Exists
                    If CheckObjExist(arrMember(i)) Then
                        'Check if User is A member of The Group
                        If CheckUserInGroup(arrMember(i),strGroup) = True Then
                            Call Logger("restore.txt", "Exists" & vbTab & "member|" & arrMember(i), False)
                        Else
                            'User Not a Member, Try to Add User to Group
                            If AddUserToGroup(arrMember(i),strGroup) = True Then
                                Call Logger("restore.txt", "Added" & vbTab & "member|" & arrMember(i), False)
                            Else
                                Call Logger("restore.txt", "!~ERROR~!" & vbTab & "member|" & arrMember(i), False)
                            End If
                        End If
                    Else
                        Call Logger("restore.txt", "!~ERROR~!" & vbTab & "member|" & arrMember(i), False)
                    End If
                End If
            Next

            'Ensure Restrictions Are Set
            If Not strRestriction = "" Then
                'Set Authentication
                If RestoreAuthentication(strGroup, strAuth) = True Then
                    Call Logger("restore.txt", "Modified" & vbTab & "authentication|" & strAuth, False)
                Else
                    Call Logger("restore.txt", "!~ERROR~!" & vbTab & "authentication|" & strAuth, False)
                End If
                'Restore Restriction Type and List
                If RestoreRestrictions(strGroup, strRestriction, arrRestrict) = True Then
                    Call Logger("restore.txt", "Modified" & vbTab & "restriction|" & strRestriction, False)
                    For j = LBound(arrRestrict) to UBound(arrRestrict)
                        Call Logger("restore.txt", "Added" & vbTab & "restrict|" & arrRestrict(j), False)
                    Next
                Else
                    Call Logger("restore.txt", "!~ERROR~!" & vbTab & "restriction|" & strRestriction, False)
                    For j = LBound(arrRestrict) to UBound(arrRestrict)
                        Call Logger("restore.txt", "!~ERROR~!" & vbTab & "restrict|" & arrRestrict(j), False)
                    Next
                End If
            End If
        Else
            'Ignore All other lines
        End If

    Loop

    On Error Goto 0

End Sub

'**************************************************************************************************
'Function CheckObjExist - Checks If An Object Exists in AD by Trying to Bind to It
'**************************************************************************************************
Private Function CheckObjExist(objDN)

    On Error Resume Next

    Dim adObject: Set adObject = GetObject("LDAP://" & objDN)
    If Err.Number <> 0 Then
        CheckObjExist = FALSE
        Err.Clear
    Else
        CheckObjExist = TRUE
    End If

    On Error Goto 0

End Function

'**************************************************************************************************
'Function CreateGroup - Creates Group Based on Passed in Parameters -MUST BE RUN ON EXCHANGE SERVER!
'**************************************************************************************************
Private Function CreateGroup(groupDN, strSamAccountName, scopeType, strMail, strDisplayname)

    On Error Resume Next

    'Create Group
    Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h2
    Const ADS_GROUP_TYPE_LOCAL_GROUP = &h4
    Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h8
    Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000
    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objOU: Set objOU = GetObject("LDAP://" & Right(groupDN,Len(groupDN)-InStr(1,groupDN,",",1)))
    Dim objGroup: Set objGroup = objOU.Create("Group", Left(groupDN,InStr(1,groupDN,",",1)-1))
    objGroup.Put "sAMAccountName", strSamAccountName
    Select Case scopeType
        Case "Domain Local Distribution"
            objGroup.Put "groupType", ADS_GROUP_TYPE_LOCAL_GROUP
        Case "Global Security"
            objGroup.Put "groupType", ADS_GROUP_TYPE_GLOBAL_GROUP Or ADS_GROUP_TYPE_SECURITY_ENABLED
        Case "Universal Distribution"
            objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP
        Case "Universal Security"
            objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP Or ADS_GROUP_TYPE_SECURITY_ENABLED        
    End Select
    objGroup.SetInfo

    'Email Enable
    If Not Trim(strMail) = "" Then
        objGroup.Put "mail", strMail
        objGroup.Put "displayname", strDisplayname
        objGroup.MailEnable
        objGroup.SetInfo
    End If

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

    On Error Goto 0

End Function

'**************************************************************************************************
'Function CheckGroupManager - Checks If the Specified User Is Set As The Manager On the Specified Group
'**************************************************************************************************
Private Function CheckGroupManager(groupDN,managerDN)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    Dim strManagedBy: strManagedBy = objGroup.Get("managedBy")
    Dim strResult: strResult = FALSE
    If Err.Number <> 0 Then
        Err.Clear
    Else
        If strComp(strManagedBy,managerDN,1) = 0 Then
            strResult = TRUE
        End If
    End If
    CheckGroupManager = strResult

    On Error Goto 0

End Function

'**************************************************************************************************
'Function ModifyGroupManager - Sets Specified User As Group Manager On The Specified Group
'**************************************************************************************************
Private Function ModifyGroupManager(groupDN,managerDN)

    On Error Resume Next

    'Set Group Manager
    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    managerDN = Replace(managerDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    objGroup.Put "managedBy", managerDN
    objGroup.SetInfo

    'Allow Manager to Update Member List
    Const ADS_ACETYPE_ACCESS_ALLOWED_OBJECT = &H5
    Const ADS_FLAG_OBJECT_TYPE_PRESENT = &H01
    Const ADS_RIGHT_DS_WRITE_PROP = &H20
    Const ADS_OBJECT_WRITE_MEMBERS = "{BF9679C0-0DE6-11D0-A285-00AA003049E2}"
    Const ADS_ACEFLAG_INHERIT_ACE = &H00002
    Const ADS_ACEFLAG_DONT_INHERIT_ACE = &H0
    Dim objRootDSE: Set objRootDSE = GetObject("LDAP://rootDSE")
    Dim strDomain: strDomain = "LDAP://" & objRootDSE.Get("defaultNamingContext")
    Dim objDomain: Set objDomain = GetObject(strDomain)
    Dim objUser: Set objUser = GetObject("LDAP://" & objGroup.Get("managedBy"))
    Dim objSecurityDescriptor: Set objSecurityDescriptor = objGroup.Get("ntSecurityDescriptor")
    Dim objDACL: Set objDACL = objSecurityDescriptor.DiscretionaryACL
    Dim objACE: Set objACE = CreateObject("AccessControlEntry")
    objACE.Trustee = Replace(objDomain.Name,"DC=","",1,1,1) & "\" & objUser.Get("sAMAccountName")
    objACE.AccessMask = ADS_RIGHT_DS_WRITE_PROP
    objACE.AceFlags = ADS_ACEFLAG_DONT_INHERIT_ACE
    objACE.AceType = ADS_ACETYPE_ACCESS_ALLOWED_OBJECT
    objACE.Flags = ADS_FLAG_OBJECT_TYPE_PRESENT
    objACE.objectType = ADS_OBJECT_WRITE_MEMBERS
    objDACL.AddAce(objACE)
    objSecurityDescriptor.DiscretionaryACL = objDACL
    objGroup.Put "ntSecurityDescriptor", Array(objSecurityDescriptor)
    objGroup.SetInfo

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

    On Error Goto 0

End Function

'**************************************************************************************************
'Function CheckUserInGroup - Checks If Specified User Is a Member of The Specified Group
'**************************************************************************************************
Private Function CheckUserInGroup(userDN,groupDN)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    userDN = Replace(userDN,"LDAP://","",1,1,1) 'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    Dim objMember
    Dim strResult: strResult = FALSE
    For Each objMember in objGroup.Members
        If strComp(objMember.distinguishedName, userDN,1) = 0 Then
            strResult = TRUE
        End If
    Next

    CheckUserInGroup = strResult

    On Error GoTo 0

End Function

'**************************************************************************************************
'Function AddUserToGroup - Adds Specified User to Specified Group
'**************************************************************************************************
Private Function AddUserToGroup(userDN,groupDN)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    userDN = Replace(userDN,"LDAP://","",1,1,1) 'Ensure DN not ADS Path
    Dim objUser: Set objUser = GetObject("LDAP://" & userDN)
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    objGroup.Add(objUser.ADsPath)
    If Err.Number <> 0 Then
        AddUserToGroup = FALSE
    Else
        AddUserToGroup = TRUE
    End If

    On Error GoTo 0

End Function

'**************************************************************************************************
'Function RestoreAuthentication - Enable/Disable Accept Messages From Authenticated Users Only On
'                                 an Email Enabled Group
'**************************************************************************************************
Private Function RestoreAuthentication(groupDN, blnAuth)

    On Error Resume Next

    groupDN = Replace(groupDN,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Dim objGroup: Set objGroup = GetObject("LDAP://" & groupDN)
    objGroup.msExchRequireAuthToSendTo = blnAuth
    objGroup.SetInfo

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

    On Error GoTo 0

End Function

'**************************************************************************************************
'Function RestoreRestrictions - Sets Restriction Type and Restriction Lists On Email Enabled Groups
'**************************************************************************************************
Private Function RestoreRestrictions(groupDN, 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.RestrictedAddressList = arrMembers
    objGroup.SetInfo

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

    On Error GoTo 0

End Function

'**************************************************************************************************
'Sub Logger - Specify Log Name, Message, and If It Should Make a New Log or Append an Existing Log
'**************************************************************************************************
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

Jan 01

GroupModifyMessageRestrictions.vbs

Posted on January 1, 2011 by admin

'=========================================================================
' GroupModifyMessageRestrictions.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://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 jdoe@domain.com 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","jdoe@domain.com")
' 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","jdoe@domain.com")
' ------ 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

Jan 01

GroupModifyType.vbs

Posted on January 1, 2011 by admin

'=========================================================================
' GroupModifyType.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass the ADsPath or Dinstinguished Name of the Group, the Group
' Type (Global, Local, Universal), and Whether It Should Be Security Enabled
' and the Function Will Modify the Group Type. To Bulk Modify Groups, Pass
' the ADsPath or Distinguished name of the Container/Organization Unit to
' the Function Instead of a Group ADsPath or Distinguished Name.
' EXAMPLE: Modify a Group To Universal Security Group
'          Dim strGroupPath: strGroupPath = "LDAP://CN=Testgroup,CN=Users,DC=domain,DC=com"
'          Dim strGroupType: strGroupType = "Universal"
'          Dim blnSecurityEnabled: blnSecurityEnabled = True
' EXAMPLE: Bulk Modify Groups to Global Distribution Groups
'          Dim strGroupPath: strGroupPath = "LDAP://CN=Users,DC=domain,DC=com"
'          Dim strGroupType: strGroupType = "Global"
'          Dim blnSecurityEnabled: blnSecurityEnabled = False
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strGroupPath: strGroupPath = "LDAP://CN=Users,DC=domain,DC=com"
Dim strGroupType: strGroupType = "Universal"
Dim blnSecurityEnabled: blnSecurityEnabled = False
' ------ END CONFIGURATION ------

Call Logger("GroupModifyType.txt","",True)
Call Logger("GroupModifyType.txt", GroupModifyType(strGroupPath,strGroupType,blnSecurityEnabled) & "|" & strGroupPath, False)
Wscript.Echo "Finished"

Private Function GroupModifyType(groupPath, groupType, blnSecurity)

    On Error Resume Next

    groupPath = Replace(groupPath,"LDAP://","",1,1,1)   'Ensure DN not ADS Path
    Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h2
    Const ADS_GROUP_TYPE_LOCAL_GROUP = &h4
    Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h8
    Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000
    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://" & groupPath & "' WHERE objectClass='group'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim objGroup, blnErr, strResult: strResult = ""
    Do Until objRecordSet.EOF
        blnErr = False
        Set objGroup = GetObject(objRecordSet.Fields("AdsPath").Value)     
        If StrComp(groupType,"global",1) = 0 Then
            If blnSecurity = True Then
                objGroup.Put "groupType", ADS_GROUP_TYPE_GLOBAL_GROUP + ADS_GROUP_TYPE_SECURITY_ENABLED
            Elseif blnSecurity = False Then
                objGroup.Put "groupType", ADS_GROUP_TYPE_GLOBAL_GROUP
            Else
                blnErr = True
            End If
        Elseif StrComp(groupType,"local",1) = 0 Then
            If blnSecurity = True Then
                objGroup.Put "groupType", ADS_GROUP_TYPE_LOCAL_GROUP + ADS_GROUP_TYPE_SECURITY_ENABLED
            Elseif blnSecurity = False Then
                objGroup.Put "groupType", ADS_GROUP_TYPE_LOCAL_GROUP
            Else
                blnErr = True
            End If
        Elseif StrComp(groupType,"universal",1) = 0 Then
            If blnSecurity = True Then
                objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP + ADS_GROUP_TYPE_SECURITY_ENABLED
            Elseif blnSecurity = False Then
                objGroup.Put "groupType", ADS_GROUP_TYPE_UNIVERSAL_GROUP
            Else
                blnErr = True
            End If
        Else
                blnErr = True
        End If   
        objGroup.SetInfo       
        If Err.Number <> 0 Then
            Err.Clear
            blnErr = True
        End If     
        If blnErr = True Then
            strResult = strResult &  "!~ERROR~!|" & objRecordSet.Fields("AdsPath").Value
        Else
            strResult = strResult &  "SUCCESS|" & objRecordSet.Fields("AdsPath").Value
        End If
        objRecordSet.MoveNext
    Loop

    GroupModifyType = strResult

    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

Sigkill IT

Code and IT Knowledge

Tag Archives: AD Groups

GroupModifyManager.vbs

GroupBackupRestore.vbs

GroupModifyMessageRestrictions.vbs

GroupModifyType.vbs