Jan 01

GroupModifyMessageRestrictions.vbs

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

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

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

 

Jan 01

ListUserForwardTo.vbs

'=========================================================================
' ListUserForwardTo.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: In AD the altRecipient Attribute aka Forward To, is the Email
' Address a User's Email Forwards to.
' Pass the ADsPath or Dinstinguised Name of the User or
' Container/Organizational Unit to the Function, Which Will List the
' User's ADsPath, User's Email, altRecipient User/Contact ADsPath, and the
' altRecipient Email.
' 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("ListUserForwardTo.txt", "USER  USEREMAIL   ALTRECIPIENT    ALTRECIPIENTEMAIL   FWDCOPY", True)
Call Logger("ListUserForwardTo.txt", ListUserForwardTo(strUserPath), False)
Wscript.Echo "Finished"

Private Function ListUserForwardTo(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, mail, altRecipient, deliverAndRedirect FROM 'LDAP://" & userPath & "' WHERE objectCategory='person' AND objectClass='user'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim strResult: strResult = ""
    Dim objFwd
    Do Until objRecordSet.EOF
        If IsNull(objRecordSet.Fields("altRecipient").Value) Then
            strResult = strResult & objRecordSet.Fields("ADsPath").Value & vbTab & objRecordSet.Fields("mail").Value & vbTab & "N/A" & vbTab & "N/A" & vbCrLf
        Else
            Set objFwd = GetObject("LDAP://" & objRecordSet.Fields("altRecipient").Value)
            strResult = strResult & objRecordSet.Fields("ADsPath").Value & vbTab & objRecordSet.Fields("mail").Value & vbTab & "LDAP://" & objRecordSet.Fields("altRecipient").Value & vbTab & objFwd.mail & vbTab & "DeliverBoth:" & objRecordSet.Fields("deliverAndRedirect").Value & vbCrLf
            Set objFwd = Nothing
        End If
        objRecordSet.MoveNext
    Loop

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

ModifyUserForwardTo.vbs

'=========================================================================
' ModifyUserForwardTo.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: In AD the altRecipient Attribute aka Forward To, is the Email
' Address a User's Email Forwards to.
'
' strUserPath: ADsPath or distinguishedName of the User You Want to Modify the
' Email Forwarding On. This can Also Be an Organization Unit/Container If You
' Want to Bulk Modify Users to Have Their Email Forwarded to the Same User/Contact.
'
' strFwdPath: ADsPath or distinguishedName of the User/Contact You Want Emails
' to Forward To.
'
' blnFwdCopy: This Value Must be True/False. True Delivers a Copy to Both The
' Forwarding Address and Keeps a Copy in the Mailbox. False Just Forwards the
' Email.
'
' The Function Will Return the Result, Users ADsPath, Whether the Forward Was
' Set to Send a Copy to Both, The New ForwardTo ADsPath, and Whether the Copy is
' Sent to Both User's ADsPath, User's Email, altRecipient User/Contact ADsPath, and the
' altRecipient Email.
' EXAMPLE: Modify Jim Smith To Forward Their Email to John Doe
'          strUserPath = "LDAP://CN=Jim Smith,CN=Users,DC=domain,DC=com"
'          strFwdPath = "LDAP://CN=John Doe,Users,DC=domain,DC=com"
'          blnFwdCopy = False
' EXAMPLE: Modify Jim Smith To Forward Their Email to John Doe and Keep a Copy In Jim's Mailbox
'          strUserPath = "LDAP://CN=Jim Smith,CN=Users,DC=domain,DC=com"
'          strFwdPath = "LDAP://CN=John Doe,Users,DC=domain,DC=com"
'          blnFwdCopy = False
' EXAMPLE: Bulk Modify Users to Forward Their Email to John Doe
'          strUserPath = "LDAP://CN=Users,DC=domain,DC=com"
'          strFwdPath = "LDAP://CN=John Doe,Users,DC=domain,DC=com"
'          blnFwdCopy = False
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim strUserPath: strUserPath = "LDAP://CN=Jim Smith,CN=Users,DC=domain,DC=com"
Dim strFwdPath: strFwdPath = "LDAP://CN=John Doe,Users,DC=domain,DC=com"
Dim blnFwdCopy: blnFwdCopy = True
' ------ END CONFIGURATION ------

Call Logger("ModifyUserForwardTo.txt", "RESULT  USER    FWDTO   FWDCOPY NEWFWDTO    FWDCOPY", True)
Call Logger("ModifyUserForwardTo.txt", ModifyUserForwardTo(strUserPath,strFwdPath,blnFwdCopy), False)
Wscript.Echo "Finished It"

Private Function ModifyUserForwardTo(userPath, fwdPath, blnFwdCopy)

    On Error Resume Next

    userPath = Replace(userPath,"LDAP://","",1,1,1) 'Ensure DN not ADS Path
    fwdPath = Replace(fwdPath,"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, altRecipient, deliverAndRedirect FROM 'LDAP://" & userPath & "'WHERE objectCategory='person' AND objectClass='user'"
    Dim objRecordSet: Set objRecordSet = objCommand.Execute
    objRecordSet.MoveFirst
    Dim strResult: strResult = ""
    Dim objUser, strTemp
    Do Until objRecordSet.EOF
        ' Log Original altRecipient Values
        If IsNull(objRecordSet.Fields("altRecipient").Value) Then
            strTemp = objRecordSet.Fields("ADsPath").Value & vbTab & "N/A" & vbTab & "N/A"
        Else
            strTemp = objRecordSet.Fields("ADsPath").Value & vbTab & objRecordSet.Fields("altRecipient").Value & vbTab & objRecordSet.Fields("deliverAndRedirect").Value
        End If

        ' Modify altRecipient Values
        Set objUser = GetObject(objRecordSet.Fields("ADsPath").Value)
        objUser.altRecipient = fwdPath
        If blnFwdCopy = True Then
            objUser.deliverAndRedirect = True
        End If
        strTemp = strTemp & vbTab & fwdPath & vbTab & blnFwdCopy
        objUser.SetInfo

        ' Error Check
        If Err.Number <> 0 Then
            Err.Clear
            strTemp = "!~ERROR~!" & vbTab & strTemp & vbCrLf
        Else
            strTemp = "SUCCESS" & vbTab & strTemp & vbCrLf
        End If
        strResult = strTemp
        objRecordSet.MoveNext
    Loop

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

GetIPInfo.vbs

'=========================================================================
' GetIPInfo.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Input a Computer DNS/IP, which then Clears the Current Arp Cache,
' Gets the IP of the DNS/IP, and then gets the MAC address of the DNS/IP.
' EXAMPLE: Wscript.Echo GetIPInfo("Computer")
'=========================================================================
Option Explicit
Wscript.Echo GetIPInfo("Computer")

Private Function GetIPInfo(strComputerOrIP)

    On Error Resume Next

    Dim strResult: strResult = ""
    Call ClearARP()
    ' Get IP of Host Name
    Dim strIP: strIP = GetIP(strComputerOrIP)
    ' Get MAC of Host Name
    Dim strArp: strArp = GetMAC(strIP)

    GetIPInfo = strComputerOrIP & vbTab & strIP & vbTab & strArp

    On Error Goto 0

End Function

' **************************************************************************************************
' Sub ClearARP - Clears the ARP Cache
' **************************************************************************************************
Private Sub ClearARP()

        On Error Resume Next

        ' Clear ARP Cache
       Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
        objShell.Run("netsh interface ip delete arpcache")

        ' Kill Objects
        Set objShell = Nothing

        On Error Goto 0

End Sub

' **************************************************************************************************
' Function GetIP - Returns an IP From Passing an Host Name or IP Into the Function
' ********************************************************************
Private Function GetIP(strHost)

    On Error Resume Next

    ' Ping Host and Extract IP Address
    Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
    Dim objPing: Set objPing = objShell.Exec("%comspec% /c For /f " & chr(34) & "tokens=2 delims=[]" & chr(34) & " %A In ('Ping -a -n 1 " & strHost & "') Do %A")
    Dim strPingResults: strPingResults = objPing.StdOut.ReadAll

    ' Search For an IP Address from Results
    Dim RegEx: Set RegEx = New RegExp
    RegEx.IgnoreCase = True
    RegEx.Global = True
    RegEx.Pattern = "[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}"
    If Regex.Test(strPingResults) = True then
        Dim Matches: Set Matches = RegEx.Execute(strPingResults)
        Dim strMatch
        For Each strMatch in Matches
            ' Return Result
            GetIP = strMatch
        Next
    Else
        GetIP = "!~ERROR~!"
    End If

    ' Kill Objects
    Set objShell = Nothing

    On Error Goto 0

End Function

' **************************************************************************************************
' Function GetMAC - Returns a MAC Address From Passing an IP Into the Function
' ********************************************************************
Private Function GetMAC(strIP)

        On Error Resume Next

        ' Check ARP Table and Results
        Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
        Dim objArp: Set objArp = objShell.Exec("arp -a " & strIP)
        Dim strArpResult: strArpResult = objArp.StdOut.ReadAll

        ' Search For a MAC Address from Results
       Dim RegEx: Set RegEx = New RegExp
        RegEx.IgnoreCase = True
        RegEx.Global = True
        RegEx.Pattern = "[0-9A-F]{2}-[0-9A-F]{2}-[0-9A-F]{2}-[0-9A-F]{2}-[0-9A-F]{2}-[0-9A-F]{2}"
        If Regex.Test(strArpResult) = True then
                Dim Matches: Set Matches = RegEx.Execute(strArpResult)
                Dim strMatch
                For Each strMatch in Matches
                    GetMAC = strMatch
                Next
        Else
            GetMAC = "!~ERROR~!"
        End if

        ' Kill Objects
        Set objShell = Nothing

        On Error Goto 0

End Function

 

Jan 01

ListLoggedOnUsers.vbs

'=========================================================================
' ListLoggedOnUsers.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass a Computer Name or IP to the Function and it will return
' the name computer name, # logged on users, and username of the logged on
' users. This works for local, remote, and RDP sessions.
' EXAMPLE: Wscript.Echo ListCurrentLoggedOn("computer")
' Wscript.Echo ListCurrentLoggedOn("192.168.1.100")
'=========================================================================
Option Explicit
Wscript.Echo ListLoggedOnUsers("computer")

Private Function ListLoggedOnUsers(strComputer)

    On Error Resume Next

    ' Determine Logged On Users By Owner of Explorer.exe Process
    Dim objWMIService: Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Dim colProcess: Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name='explorer.exe'")
    Dim objProcess, colProperties, strUser, strDomain, strResult
    If colProcess.Count = 0 Then
        strResult = "Computer:" & strComputer & vbTab & "Count:" & colProcess.Count & vbTab & "User:N/A"
    Else
        Dim i: i = 1
        For Each objProcess in colProcess
            colProperties = objProcess.GetOwner(strUser,strDomain)
            strResult = strResult & "Computer:" & strComputer & vbTab & "Count:" & i & vbTab & "User:" & strDomain & "\" & strUser & vbCrLf
            i = i + 1
        Next
    End If

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

    'Cleanup
    Set objWMIService = Nothing
    Set colProcess = Nothing

    'Return Result
    ListLoggedOnUsers = strResult

    On Error Goto 0

End Function

 

Jan 01

NTBackup.vbs

'=========================================================================
' NTBackup.vbs
' VERSION: 2.2 - Modified backupDestination to auto include the backupTitle as the end directory
' 2.1 - Fixed potential error on blat attachments
' 2.0 - Complete rewrite
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 3/7/2013
' REQUIREMENTS:
' - NTBackup.exe 2000, XP, 2003
' - A .bks file of directories to back up (Note: Best to Selct in NTBackup and Save Selection)
' - blat.exe, blat.dll. blat.lib in the same directory as the script (http://www.blat.net)
' - Blat profile installed to email results
' - Recommended to use Stunnel to Encrypt Email Sessions, Especially If the Email Server
' is not on your subnet ex: Gmail
' COMMENTS:
' Version 2.0 is a complete rewrite and I suggest you switch to this if using an earlier
' version. It corrects some small issues, improves deployment, and simplifies usage.
' The script is designed to automate backups with the task schedular, and email
' results using blat. It is capable of backing up local or remote files as long as the
' account it is running under has the appropriate permissions. It is designed to retain
' backups using weekly retention schedules and I would suggest a minimum of 2 weeks
' which leaves you with a weeks worth of backups while the other overwrites.
' Assuming you use 2 weeks of backups starting on Friday January 7, 2011
' you would need the following copies of this script and scheduled tasks.
'
' EXAMPLE WEEK1: Server_Full1.vbs, Server_Inc01.vbs, Server_IncA1.vbs
' Fri - Server_Full1.vbs 9:00PM, run every other week, starting Jan 7, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Full" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 1 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
' Mon - Server_IncO1.vbs 9:00PM, run every other week, starting Jan 10, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Inc" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 1 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
' Tue, Wed, Thu - Server_IncA1.vbs 9:00PM, run every other week, starting Jan 11, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Inc" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = False 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 1 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
'
' EXAMPLE WEEK2: Server_Full2.vbs, Server_Inc02.vbs, Server_IncA2.vbs
' Fri - Server_Full2.vbs 9:00PM, run every other week, starting Jan 14, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Full" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 2 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
' Mon - Server_IncO2.vbs 9:00PM, run every other week, starting Jan 17, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Inc" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 2 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
' Tue, Wed, Thu - Server_IncA2.vbs 9:00PM, run every other week, starting Jan 18, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Inc" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = False 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 2 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
'
' EXAMPLE .BKS FILE: Server.bks
' D:\Shares\Users\
' \\server\share\
'=========================================================================
Option Explicit
On Error Resume Next

' ------ SCRIPT CONFIGURATION ------
Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
Dim backupType: backupType = "Full" 'Full, Inc
Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
Dim backupWeek: backupWeek = 1 'Modify to match the backup week (Ex: 1, 2...etc)
Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
' ------ END CONFIGURATION ------

'Create Log File
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "[ " & WScript.ScriptName & " ] " & vbCrLf & Now(), True)

' Create Objects
Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))

'Set NT Backup Global Variables
Dim ntBackupLogDir: ntBackupLogDir = objShell.ExpandEnvironmentStrings("%USERPROFILE%\Local Settings\Application Data\Microsoft\Windows NT\NTBackup\data\")
Dim bksFile: bksFile = scriptPath & backupTitle & ".bks"
Dim backupName: backupName = backupTitle & "_" & backupType & backupWeek
If Mid(backupDestination,Len(backupDestination),1) <> "\" Then
    backupDestination = backupDestination & "\"
End If
backupDestination = backupDestination & backupTitle
If Mid(backupDestination,Len(backupDestination),1) <> "\" Then
    backupDestination = backupDestination & "\"
End If
Dim bkfFile: bkfFile = backupDestination & backupName & ".bkf"
Dim ntBackupExe: ntBackupExe = objShell.ExpandEnvironmentStrings("%SYSTEMROOT%\system32\ntbackup.exe")

'Log Variables
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Variables ]", False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupTitle = " & backupTitle, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupType = " & backupType, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupOverwrite = " & backupOverwrite, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupWeek = " & backupWeek, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupDestination = " & backupDestination, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "emailProfile = " & emailProfile, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "emailRecipient = " & emailRecipient, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "ntBackupLogDir = " & ntBackupLogDir, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "bksFile = " & bksFile, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupName = " & backupName, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "bkfFile = " & bkfFile, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "ntBackupExe = " & ntBackupExe, False)

'Verify Before Continuing
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Verify NTBackup.exe ]", False)
Call VerifyFileOrDir(ntBackupExe, False, False, Replace(WScript.ScriptFullName,".vbs",".log"))

Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Verify NT Backup Log Directory ]", False)
Call VerifyFileOrDir(ntBackupLogDir, True, False, Replace(WScript.ScriptFullName,".vbs",".log"))

Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Verify NT Backup Selection File (.bks) ]", False)
Call VerifyFileOrDir(bksFile, True, True, Replace(WScript.ScriptFullName,".vbs",".log"))

Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Verify NT Backup Destination Directory ]", False)
Call VerifyFileOrDir(backupDestination, True, True, Replace(WScript.ScriptFullName,".vbs",".log"))

'Get Backup Selections
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ NT Backup Selections ]", False)
Dim ntBackupSelection: ntBackupSelection = GetBackupSelection(bksFile)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), ntBackupSelection, False)

'Run NT Backup
Dim startTime: startTime = Now()
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ NT Backup ]", False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "Start Time: " & startTime, False)
Call RunNTBackup(backupType, backupOverwrite, ntBackupExe, bksFile, backupName, bkfFile, Replace(WScript.ScriptFullName,".vbs",".log"))
Dim endTime: endTime = Now()
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "End Time: " & endTime, False)

'Get NT Backup Results
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ NT Backup Results ]", False)
Dim ntBackupResult: ntBackupResult = GetNTBackupResult(".", startTime, endTime, Replace(WScript.ScriptFullName,".vbs",".log"))
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "Returned Result = " & ntBackupResult, False)

'Find NT Backup Log File
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Find NT Backup Log File ]", False)
Dim ntBackupLogFile: ntBackupLogFile = GetNTBackupLog(ntBackupLogDir, startTime, endTime, Replace(WScript.ScriptFullName,".vbs",".log"))

'Set Blat Email Variables and Email Results
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Email Results ]", False)
Dim emailSubject: emailSubject = "NTBackup " & backupTitle & " - " & ntBackupResult
Dim emailBody: emailBody = backupName & " - " & ntBackupResult & " Backing up:" & "|" & ntBackupSelection
emailBody = ReplaceLineBreaks(emailBody)
Call SendBlatEmail(emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody, ntBackupLogFile, Replace(WScript.ScriptFullName,".vbs",".log"))

'Finish Script
Set objShell = Nothing

Private Sub VerifyFileOrDir(strPath, blnCreate, blnUnicode, strLog)

    On Error Resume Next

    Dim objFile
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.DriveExists(objFSO.GetDriveName(strPath)) Then
        If StrComp(objFSO.GetExtensionName(strPath), "", 1) = 0 Then
            If Not objFSO.FolderExists(strPath) Then
                If objFSO.FolderExists(objFSO.GetParentFolderName(strPath)) Then
                    If blnCreate = True Then
                        objFSO.CreateFolder strPath 'Create Folder In Current Path
                        'LOG CREATING FOLDER
                        If Err.Number <> 0 Then
                            Err.Clear
                            Call Logger(strLog, "Err Creating: " & strPath, False)
                            Call Logger(strLog, "Verification Failed - Quitting Script!", False)
                            Wscript.Quit
                        Else
                            Call Logger(strLog, "Created: " & strPath, False)
                        End If
                    Else
                        Call Logger(strLog, "Verification Failed, Folder Doesn't Exist - Quitting Script!", False)
                        Wscript.Quit
                    End If
                Else
                    VerifyFileOrDir objFSO.GetParentFolderName(strPath), blnCreate, blnUnicode, strLog 'Recurse Creating Parent Folder
                   VerifyFileOrDir strPath, blnCreate, blnUnicode, strLog 'Recurse Creating Current Folder
               End If
            Else
                'LOG FOLDER EXISTS
                Call Logger(strLog, "Exists: " & strPath, False)
            End If
        Else
            If Not objFSO.FileExists(strPath) Then
                If objFSO.FolderExists(objFSO.GetParentFolderName(strPath)) Then
                    If blnCreate = True Then
                        'Create File In Current Path
                        If blnUnicode = True Then
                            Set objFile = objFSO.CreateTextFile(strPath, True, True)
                            If StrComp(objFSO.GetExtensionName(strPath), "bks", 1) = 0 Then
                                'Default New Selection File to SystemState
                                objFile.Write "SystemState"
                                objFile.Close
                            End If
                            Set objFile = Nothing
                        Else
                            objFSO.CreateTextFile strPath, True
                        End If
                        'LOG CREATING FILE
                        If Err.Number <> 0 Then
                            Err.Clear
                            Call Logger(strLog, "Err Creating: " & strPath, False)
                            Call Logger(strLog, "Verification Failed - Quitting Script!", False)
                            Wscript.Quit
                        Else
                            Call Logger(strLog, "Created: " & strPath, False)
                        End If
                    Else
                        Call Logger(strLog, "Verification Failed, File Doesn't Exist - Quitting Script!", False)
                        Wscript.Quit
                    End If
                Else
                    VerifyFileOrDir objFSO.GetParentFolderName(strPath), blnCreate, blnUnicode, strLog  'Recurse Creating Parent Folder
                   VerifyFileOrDir strPath, blnCreate, blnUnicode, strLog  'Recurse Creating Current Folder
               End If
            Else
                'LOG FILE EXISTS
                Call Logger(strLog, "Exists: " & strPath, False)
            End If
        End If
    Else
        Call Logger(strLog, "Verification Failed, Drive Doesn't Exist - Quitting Script!", False)
        Wscript.Quit
    End If

    On Error Goto 0

End Sub

Private Function GetBackupSelection(strFile)

    On Error Resume Next

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objTextFile: Set objTextFile = objFSO.OpenTextFile(strFile, 1, False, -1)
    Dim strResult: strResult = objTextFile.ReadAll
    objTextFile.Close

    If Err.Number <> 0 Then
        Err.Clear
        strResult = "Error Reading Selection (.bks) File!"
    Else
        If strResult = "" OR IsNull(strResult) Then
            strResult = "Error Backup Selection (.bks) File is Blank!"
        End If
    End If

    GetBackupSelection = strResult

    On Error Goto 0

End Function

Private Sub RunNTBackup(strBackupType, blnBackupOverwrite, strNtBackupExe, strBksFile, strBackupName, strBkfFile, strLog)

    On Error Resume Next

    'Create Objects and Variables
    Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
    Dim runCommand

    'Set NT Backup Command 
    If StrComp(strBackupType,"Full",1) = 0 Then
        ' Full Backup Overwrite
        runCommand = strNtBackupExe & " backup " & chr(34) & "@" & strBksFile & chr(34) & " /n " & chr(34) & strBackupName & ".bkf created " & Now() & chr(34) & " /d " & chr(34) & "Set created " & Now() & chr(34) & " /v:yes /r:no /rs:no /hc:off /m normal /j " & chr(34) & strBackupName & chr(34) & " /l:s /f " & chr(34) & strBkfFile & chr(34)
    Elseif StrComp(strBackupType,"Inc",1) = 0 Then
        If blnBackupOverwrite = True Then
            'Incremental Backup Overwrite
            runCommand = strNtBackupExe & " backup " & chr(34) & "@" & strBksFile & chr(34) & " /n " & chr(34) & strBackupName & ".bkf created " & Now() & chr(34) & " /d " & chr(34) & "Set created " & Now() & chr(34) & " /v:yes /r:no /rs:no /hc:off /m incremental /j " & chr(34) & strBackupName & chr(34) & " /l:s /f " & chr(34) & strBkfFile & chr(34)
        Elseif blnBackupOverwrite = False Then
            'Incremental Backup Append
            runCommand = strNtBackupExe & " backup " & chr(34) & "@" & strBksFile & chr(34) & " /a /d " & chr(34) & strBackupName & ".bkf created " & Now() & chr(34) & " /v:yes /r:no /rs:no /hc:off /m incremental /j " & chr(34) & strBackupName & chr(34) & " /l:s /f " & chr(34) & strBkfFile & chr(34)
        Else
            Call Logger(strLog, "Error 'backupOverwrite' variable is not Set to True Or False - Aborting Script!", False)
            Wscript.Quit
        End If
    Else
        Call Logger(strLog, "Error 'backupType' variable is not Set to Full Or Inc - Aborting Script!", False)
        Wscript.Quit
    End If

    'Run NT Backup
    Call Logger(strLog, runCommand, False)
    objShell.Run runCommand, 1, True

    If Err.Number <> 0 Then
        Err.Clear
        Call Logger(strLog, "Error Occurred During NT Backup", False)
    End If

    On Error Goto 0

End Sub

Private Function GetNTBackupResult(strComputer, strStart, strEnd, strLog)

    On Error Goto 0

    'Get Job Status's From Event Viewer (Logs Event 8001 For Each Folder Completed in .bks file)
    'All Jobs logged to Most Recent Log in Default User Profile NTBackup Folder
    Dim objWMIService: Set objWMIService = GetObject("winmgmts:{(Security)}\\" & strComputer & "\root\cimv2")
    Dim colEvents: Set colEvents = objWMIService.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'Application' AND EventCode = '8001'")
    Dim objEvent, strRecordDate, strResult: strResult = ""
    Call Logger(strLog, colEvents.Count & " NT Backup Logs Found Wherre EventCode = 8001", False)
    For Each objEvent in colEvents
        strRecordDate = WMIDateStringToDate(objEvent.TimeWritten)
        If DateDiff("S", startTime, strRecordDate) >= 0 AND DateDiff("S", endTime, strRecordDate) <= 0 Then
            Call Logger(strLog, "Time Written: " & strRecordDate & vbCrLf & objEvent.Message, False)
            If InStr(1, objEvent.Message, "error") > 1 Then
                'Error
                If strResult = "" OR null Then
                    strResult = "Error"
                End If
                If StrComp(strResult, "Success", 1) = 0 Then
                    strResult = "Error"
                End If
                If StrComp(strResult, "Warning", 1) = 0 Then
                    strResult = "Error"
                End If
                If StrComp(strResult, "Unknown", 1) = 0 Then
                    strResult = "Error"
                End If
            Elseif InStr(1,objEvent.Message,"warning",1) > 0 Then
                'Warning
                If strResult = "" OR null Then
                    strResult = "Warning"
                End If
                If StrComp(strResult, "Success", 1) = 0 Then
                    strResult = "Warning"
                End If
                If StrComp(strResult, "Unknown", 1) = 0 Then
                    strResult = "Warning"
                End If
            Elseif InStr(1,objEvent.Message,"successfully",1) > 0 Then
                'Success
                If strResult = "" OR null Then
                    strResult = "Success"
                End If
            Else
                'Uknown
                If strResult = "" OR null Then
                    strResult = "Unknown"
                End If
                If StrComp(strResult, "Success", 1) = 0 Then
                    strResult = "Unknown"
                End If
            End If
        End If
    Next

    'Set Return Value
    If strResult = "" or null Then
        strResult = "Unknown"
        Call Logger(strLog, "No Log Files Found Between " & strStart & " to " & strEnd, False)
    End If

    If Err.Number <> 0 Then
        Err.Clear
        strResult = "ERROR"
        Call Logger(strLog, "Error Detected Getting NT Backup Results", False)
    End If

    GetNTBackupResult = strResult

    On Error Goto 0

End Function

' Function Conver WMI Date to String Date
Function WMIDateStringToDate(dtmBootup)
    WMIDateStringToDate = CDate(Mid(dtmBootup, 5, 2) & "/" & _
    Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) _
    & " " & Mid (dtmBootup, 9, 2) & ":" & _
    Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup, _
    13, 2))
End Function

Private Function GetNTBackupLog(strDir, strStart, strEnd, strLog)

    On Error Resume Next

    'Find Log File with the Latest Time Stamp
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim strResult: strResult = ""
    Dim file, nfile
    Dim objFolder: Set objFolder = objFSO.GetFolder(strDir)
    For Each file In objFolder.Files
        If Right(file.Name, 4) = ".log" Then
            If nfile = "" or nfile = null Then
                Set nfile = file
                strResult = nfile.Path
                Call Logger(strLog, "Original Latest Log: " & nfile.Name & " (" & nfile.DateLastModified & ")", False)
            Else
                If nfile.DateLastModified < file.DateLastModified Then
                    Set nfile = file
                    strResult = nfile.Path
                    Call Logger(strLog, "Later Log: " & nfile.Name & " (" & nfile.DateLastModified & ")", False)
                End If
            End If
        End If
    Next

    If strResult = "" Then     
        Call Logger(strLog, "Error No Log Files Found!", False)
    Else
        Call Logger(strLog, "Latest Log: " & strResult, False)
    End If

    If Err.Number <> 0 Then
        Err.Clear
        Call Logger(strLog, "Error Occured Getting NT Backup Log File!", False)
        strResult = ""
    End If

    GetNTBackupLog = strResult

    On Error Goto 0

End Function

Private Function ReplaceLineBreaks(myStr)

    On Error Resume Next

    myStr = Replace(myStr, vbCrLf, "|")

    ReplaceLineBreaks = myStr

    On Error Goto 0

End Function

Private Sub SendBlatEmail(blatPath, blatProfile, strRecipients, strSubject, strBody, strAttachment, strLog)

    'Need blat.exe, blat.dll, blat.lib
    On Error Resume Next

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))

    'Ensure Blat Exists
    If Not objFSO.FileExists(blatPath) Then
        Call Logger(strLog, "Provided Blat.exe Location Not Found: " & blatPath, False)
        Call Logger(strLog, "Attempt to Locate Blat.exe in Current Directory: " & scriptPath, False)
        If Not objFSO.FileExists(scriptPath & "blat.exe") Then
            Call Logger(strLog, "Default Blat.exe Location Not Found: " & scriptPath & "blat.exe", False)
            Exit Sub
        Else
            blatPath = scriptPath & "blat.exe"
            Call Logger(strLog, "Default Blat.exe Location Found: " & blatPath, False)
        End If
    Else
        Call Logger(strLog, "Provided Blat.exe Location Found: " & scriptPath & "blat.exe", False)
    End If

    'Set Blat Email Command
    Dim commandText: commandText = chr(34) & blatPath & chr(34)
    commandText = commandText & " -p " & chr(34) & blatProfile & chr(34)
    commandText = commandText & " -to " & strRecipients
    commandText = commandText & " -subject " & chr(34) & strSubject & " " & chr(34) 'Keep Space to Prevent Escaping the Quote
    commandText = commandText & " -body " & chr(34) & strBody & " " & chr(34) 'Keep Space to Prevent Escaping the Quote

    'Append Attachment(s)
    If objFSO.FileExists(strAttachment) Then
        commandText = commandText & " -attach " & chr(34) & strAttachment & "," & strLog & chr(34)
        Call Logger(strLog, "Provided Attachment Found: " & strAttachment, False)
    Else
        Call Logger(strLog, "Provided Attachment Not Found: " & strAttachment, False)
        Call Logger(strLog, "Attempt to Locate Attachment in Current Directory: " & scriptPath, False)
        If objFSO.FileExists(scriptPath & strAttachment) Then
            commandText = commandText & " -attach " & chr(34) & scriptPath & strAttachment & "," & strLog & chr(34)
            Call Logger(strLog, "Default Attachment Found: " & scriptPath & strAttachment, False)
        Else
            Call Logger(strLog, "Default Attachment Not Found: " & scriptPath & strAttachment, False)
            commandText = commandText & " -attach " & chr(34) & strLog & chr(34)
        End If
    End If

    'Send Blat Email
    Call Logger(strLog, "Email Results: " & commandText, False)
    objShell.run commandText, True

    Set objFSO = Nothing
    Set objShell = Nothing

    If Err.Number <> 0 Then
        Err.Clear
        Call Logger(strLog, "Error Occurred Emailing Results!", False)
    End If

    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

ScriptSuicide.vbs

'=========================================================================
' ScriptSuicide.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Deletes the current script. This is useful when you are running
' scripts to automate tasks such as installations, logins, etc and you want
' to remove the script after it executes.
' EXAMPLE: Call ScriptSuicde()
'=========================================================================
Option Explicit

Call ScriptSuicide()

Private Sub ScriptSuicide()

    On Error Resume Next

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    objFSO.DeleteFile WScript.ScriptFullName
    Set objFSO = nothing

    On Error GoTo 0

End Sub

 

Jan 01

GenerateIPv4Addresses.vbs

'=========================================================================
' GenerateIPv4Addresses.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Input the Start IPv4 IP Address and the End IPv4 IP Address to
' Generate All IP Addresses In a Log File for the Given Range.
' EXAMPLE: Input the Starting IPv4 Address:    192.168.1.1
'          Input the Ending IPv4 Address: 192.168.1.255
'=========================================================================
Option Explicit

' Generate IPv4 Addresses
Dim ipStart: ipStart = InputBox("Input the Starting IPv4 Address")
Dim ipEnd: ipEnd = InputBox("Input the Ending IPv4 Address")
Call Logger("GenerateIPv4Addresses.txt", GenerateIPv4Addresses(ipStart, ipEnd), True)
Wscript.Echo "Finished"

Private Function GenerateIPv4Addresses(ipStart, ipEnd)

On Error Resume Next

' Validate IPv4 Address
Dim strResult: strResult = ""
If ValidateIPv4(ipStart) = False OR ValidateIPv4(ipEnd) = False Then
strResult = "Invalid IP Range: " & ipStart & " - " & ipEnd
Else
' Generate IP Range
Dim ipOctetStart: ipOctetStart = Split(ipStart,".")
Dim ipOctetEnd: ipOctetEnd = Split(ipEnd,".")
Dim i, oct1,oct2,oct3,oct4, blnInitial: blnInitial = True
For oct1 = ipOctetStart(0) to ipOctetEnd(0)
For oct2 = ipOctetStart(1) to ipOctetEnd(1)
For oct3 = ipOctetStart(2) to ipOctetEnd(2)
If blnInitial = True Then
blnInitial = False
If StrComp(oct1, ipOctetEnd(0)) = 0 AND StrComp(oct2, ipOctetEnd(1)) = 0 AND StrComp(oct3, ipOctetEnd(2)) = 0 Then
' Initial Loop on Octet4 is the Final Loop
For oct4 = ipOctetStart(3) to ipOctetEnd(3)
strResult = strResult & oct1 & "." & oct2 & "." & oct3 & "." & oct4 & vbCrLf
Next
Else
' Initial Loop on Octet4 is Not the Final Loop
For oct4 = ipOctetStart(3) to 255
strResult = strResult & oct1 & "." & oct2 & "." & oct3 & "." & oct4 & vbCrLf
Next
End If
Else
If StrComp(oct1, ipOctetEnd(0)) = 0 AND StrComp(oct2, ipOctetEnd(1)) = 0 AND StrComp(oct3, ipOctetEnd(2)) = 0 Then
' Non-Initial Loop is the Final Loop
For oct4 = 0 to ipOctetEnd(3)
strResult = strResult & oct1 & "." & oct2 & "." & oct3 & "." & oct4 & vbCrLf
Next
Else
' Non-Initial Loop is Not the Final Loop
For oct4 = 0 to 255
strResult = strResult & oct1 & "." & oct2 & "." & oct3 & "." & oct4 & vbCrLf
Next
End If
End If
Next
Next
Next
End If

' Return Results
GenerateIPv4Addresses = strResult

On Error Goto 0

End Function

Private Function ValidateIPv4(ip)

On Error Resume Next

' Validate IPv4 Address
Dim blnValid: blnValid = True
Dim arrIP: arrIP = Split(ip,".")
If UBound(arrIP) = 3 Then
Dim i
For i = LBound(arrIP) to UBound(arrIP)
If IsNumeric(arrIP(i)) = True Then
If arrIP(i) > 255 Then
blnValid = False
End If
Else
blnValid = False
End If
Next
Else
blnValid = False
End If

' Check For Errors
If Err.Number <> 0 Then
blnValid = False
Err.Clear
End If

' Return Result
If blnValid = True Then
ValidateIPv4 = True
Else
ValidateIPv4 = False
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