'========================================================================= ' GroupBackupRestore.vbs ' VERSION: 1.0 ' AUTHOR: Brian Steinmeyer ' EMAIL: [email protected] ' WEB: https://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
