Monthly Archives: January 2011

Jan 01

Reset Domain Administrator Password

Posted on by

The following method has been tested to work on both Server 2003 and Server 2008 Domain Controllers

  • Download SRVANY and INSTSRV, which are part of the Windows 2003 Resource Kit
  • Ensure you have the Directory Service Restore Mode Administrator password, restart the server in Directory Service Restore Mode, and log in as administrator
    • If you do not have have the Administrator Password, you can attempt to get it through one of these methods
  • Create the folder: C:\reset\
    • Copy srvany.exe, instsrv, and cmd.exe(Located in C:\system32) to the C:\reset\
  • Open a command prompt and enter the following commands
    • CD “C:\reset”
    • instsrv PassRecovery “C:\reset\srvany.exe”
  • Run regedit.exe and navigate to HKLM\System\CurrentControlSet\Services\PassRecovery
  • Create a subkey called: Parameters
    • Create a new string value (REG_SZ)
      1. Name: Application
      2. Value: C:\reset\cmd.exe
    • Create a new string value (REG_SZ) where <password> is the desired password (Must Meet Password Policy Requirements)
      1. Name: AppParameters
      2. Value: /k net user administrator <password> /domain
  • Open Services and Open the Properties for the PassRecovery Service
    • On the General tab, ensure the startup type is Automatic
    • On the Log On tab, ensure the option is checked to: Allow service to interact with desktop
  • Restart the server normally, and log in with the password you specified
  • Uninstall SRVANY by entering the following commands at a command prompt:
    • net stop PassRecovery
    • sc delete PassRecovery
  • Delete C:\reset\
Jan 01

Hacking Windows Passwords

Posted on by

If you’ve ever been in a situation where you didn’t know a password to login to a windows computer then there are several methods you can use. These methods require local access to a computer and work on workgroup as well as domain computers. However, it is possible to extend your access throughout a domain using these techniques. I’ll assume you already understand how windows security works, and just outline the methods. If you would like more details, you can email me.

Method 1 – Password Renew

This is my preferred method in which I personally had a lot of success with. You have the option to reset the passwords of any local user account, create a new local administrator, and set administrative rights to an existing user.

Warning! – Do not attempt these on methods on EFS or encrypted disks

  • Download Bart PE and Password Renew
  • Obtain a Windows XP or Windows 2003 Server Disk in order to build the boot disk
    • Add the Password renew as a plugin and build the disk
  • Boot the Bart PE Disk and Launch Password Renew
    • Select the windows directory (Default is C:\Windows)
    • Select to reset a password or install a new administrative account
    • Select Install, then reboot

Method 2 – Offline NT Password & Registry Editor

This is a less preferred method which has about a 70% success rate, and I would recommend backing up the SAM file before editing. However, there is no need to build anything because the downloads are already images.

Warning! – Do not attempt these on methods on EFS or encrypted disks

  • Download Offline NT Password & Registry Editor
  • Select the disk to mount containing the Windows system
  • Select the path and registry files (Typically WINDOWS/system32/config)
  • Select Option 1 for password edit
  • Select Option 1 to edit user data and passwords
  • Select the account you want to reset the password on
  • Select Option 1 to Clear (blank) user password (Blanking has a higher success rate)
  • Select Option q to quit and confirm writing the files back

Method 3 – Ophcrack (Cracking with Rainbow Tables)

This method takes a different approach by dumping the password hashes from the SAM file instead of editing it. It then attempts to crack the passwords using rainbow tables.

  • Download the Ophcrack live CD otherwise, you’ll need to be a local administrator to dump the password hashes
  • Burn the ISO to disk using any CD Burning Tool
  • Boot the Ophcrack CD, which will automatically launch Ophcrack, dump the SAM file, load the built in rainbow table, and crack the passwords
    • If the password you need does not crack, save the hashes, download the Ophcrack program and larger rainbow tables to run it against. If this does not work, try one of the other crack methods with the hashes

Method 4 – PWDump + John the Ripper or Cain (Cracking with Brute Force)

This approach is similar to Ophcrack by dumping hashes from the SAM file. However, it uses a brute force which can take significantly longer.

Warning, Some Antivirus programs might detect these as virus or hacking tools

  • Download PWDump6 or FGDump
    • Depending on your situation, you can run PWDump6 or FGDump across a network or on a local machine if you have administrative credentials. If not, you’ll need to dump the SAM file offline by putting them on a live CD (ie:Linux distro or BartPE), or adding the hard drive as a secondary drive on a workstation you have access to.
  • Once you obtained the hashes, download John the Ripper
    • You’ll need to run it from the command line and use any additional parameters you wish on the crack
  • Alternatively, once you obtained the hashes, download Cain & Abel
    • Open Cain
    • Click on the Cracker tab
    • Click the “+” to add hashes to the list
    • Select your list of hashes
    • Right-click the list and select a Brute Force Attack
    • Select your character set and click start

Method 5 – Cachedump (Cracking Cached Domain Passwords)

Taking things a step further, by default computers in a windows domain will cache the last 10 user’s password hashes. We can use Cachedump to extract the hashes and then import them into a program to crack.

Warning, Some Antivirus programs might detect these as virus or hacking tools

  • Download Cachedump 1.2
  • Open a command prompt and dump the cached password hashes, which requires local administrative access
    • cachedump.exe
  • Download John the Ripper with a Patch that supports M$ Cache Hash
  • Run John from the command line using any parameters you wish, but ensure you include the following parameter:
    • -format:mscash mydump.txt
Jan 01

Recovery Console XP Password Hack

Posted on by

The recovery console for Windows XP requires you to enter the the local administrator password in order to access it. However, if you do not know the password you will not be able to access the recovery console… That is unless you know this little trick.

  • Obtain a Windows 2000 installation or boot disk then boot from it
  • Select ‘R’ to Repair Windows
  • Select ‘C’ to launch the Recovery Console
  • Select the windows partition you want to access, and you WILL NOT be prompted for a password
Jan 01

EnumerateComputersByOU.vbs

Posted on by 
'=========================================================================
' EnumerateComputersByOU.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass the ADsPath or Dinstinguised Name of the Container/Organizational
' Unit to the Function, and it'll return all of the Computers Within.
' EXAMPLE: strCompPath = "LDAP://CN=Computers,DC=domain,DC=com"
'          strCompPath = "CN=Computers,DC=domain,DC=com"
'          strCompPath = "LDAP://OU=Computer,DC=domain,DC=com"
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strCompPath: strCompPath = "LDAP://CN=Computers,DC=domain,DC=com"
' ------ END CONFIGURATION ------

Call Logger("EnumerateComputersByOU.txt", EnumerateComputersByOU(strCompPath), True)
Wscript.Echo "Finished"

Private Function EnumerateComputersByOU(computerPath)

    On Error Resume Next

    computerPath = Replace(computerPath,"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://" & computerPath & "' WHERE objectCategory='computer'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim strResult: strResult = ""
    Do Until objRecordSet.EOF
        strResult = strResult & objRecordSet.Fields("AdsPath").Value & vbCrLf
        objRecordSet.MoveNext
    Loop

    EnumerateComputersByOU = 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

 

Jan 01

ListComputerOS.vbs

Posted on by 
'=========================================================================
' ListComputerOS.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass the ADsPath or Distinguished Name of the Computer Object or
' Container/Organizational Unit to the Function, and it'll return the Computer Name
' and Operating System as Listed In Active Directory.
' EXAMPLE: strUserPath = "LDAP://CN=Computers,DC=domain,DC=com"
'          strUserPath = "CN=Computers,DC=domain,DC=com"
'          strUserPath = "LDAP://OU=Computer,DC=domain,DC=com"
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strUserPath: strUserPath = "LDAP://CN=Computers,DC=domain,DC=com"
' ------ END CONFIGURATION ------

Call Logger("ListComputerOS.txt", ListComputerOS(strUserPath), True)
Wscript.Echo "Finished"

Private Function ListComputerOS(computerPath)

    On Error Resume Next

    computerPath = Replace(computerPath,"LDAP://","",1,1,1) 'Ensure DN not ADsPath
    Dim strResult: strResult = ""

    'Query Computers
    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, OperatingSystem FROM 'LDAP://" & computerPath & "' WHERE objectCategory='computer'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Do Until objRecordSet.EOF
        strResult = strResult & objRecordSet.Fields("ADsPath").Value & vbTab & objRecordSet.Fields("OperatingSystem").Value & vbCrLf
        objRecordSet.MoveNext
    Loop

    'Check For Errors
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "Computer:" & strComputer & vbTab & "Count:!~ERROR~!" & vbTab & "User:!~ERROR~!"
    End If

    'Return Result
    ListComputerOS = 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

 

Jan 01

EnumerateContactsByOU.vbs

Posted on by 
'=========================================================================
' EnumerateContactsByOU.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass the ADsPath or Dinstinguised Name of the Container/Organizational
' Unit to the Function, and it'll return all of the Contacts Within.
' EXAMPLE: strContactPath = "LDAP://CN=Users,DC=domain,DC=com"
'          strContactPath = "CN=Users,DC=domain,DC=com"
'          strContactPath = "LDAP://OU=Contacts,DC=domain,DC=com"
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strContactPath: strContactPath = "LDAP://CN=Users,DC=domain,DC=com"
' ------ END CONFIGURATION ------

Call Logger("EnumerateContactsByOU.txt", EnumerateContactsByOU(strContactPath), True)
Wscript.Echo "Finished"

Private Function EnumerateContactsByOU(contactPath)

    On Error Resume Next    'Start Error Handling

    contactPath = Replace(contactPath,"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://" & contactPath & "' WHERE objectCategory='person' AND objectClass='contact'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim strResult: strResult = ""
    Do Until objRecordSet.EOF
        strResult = strResult & objRecordSet.Fields("AdsPath").Value & vbCrLf
        objRecordSet.MoveNext
    Loop

    EnumerateContactsByOU = strResult

    On Error Goto 0 'End Error Handling

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

GroupBackupRestore.vbs

Posted on by 
'=========================================================================
' 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 by 
'=========================================================================
' 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 by 
'=========================================================================
' 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

 

Jan 01

EnumerateUsersByOU.vbs

Posted on by 
'=========================================================================
' EnumerateUsersByOU.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 Container/Organizational
' Unit to the Function, and it'll return all of the Users Within.
' EXAMPLE: strUserPath = "LDAP://CN=Users,DC=domain,DC=com"
'          strUserPath = "CN=Users,DC=domain,DC=com"
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strUserPath: strUserPath = "LDAP://CN=Users,DC=domain,DC=com"
' ------ END CONFIGURATION ------

Call Logger("EnumerateUsersByOU.txt", EnumerateUsersByOU(strUserPath), True)
Wscript.Echo "Finished"

Private Function EnumerateUsersByOU(userPath)

    On Error Resume Next

    userPath = Replace(userPath,"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://" & userPath & "' WHERE objectCategory='person' AND objectClass='user'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim strResult: strResult = ""
    Do Until objRecordSet.EOF
        strResult = strResult & objRecordSet.Fields("AdsPath").Value & vbCrLf
        objRecordSet.MoveNext
    Loop

    EnumerateUsersByOU = 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