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

 

Jan 01

CreateFileOrDir.vbs

'=========================================================================
' CreateFileOrDir.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass a File or Folder Path to the Sub and It Will Create the
' Full Path of the Directory Structure.
' EXAMPLE: Call CreateFileOrDir("C:\Level 1\Level 2\test.txt")
'          Call CreateFileOrDir("C:\Test\Folder\Structure")
'=========================================================================
Option Explicit

Call CreateFileOrDir("C:\Level 1\Level 2\test.txt")

Private Sub CreateFileOrDir(strPath)

    On Error Resume Next

    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
                    objFSO.CreateFolder strPath 'Create Folder In Current Path
                Else
                    CreateFileOrDir(objFSO.GetParentFolderName(strPath)) 'Recurse Creating Parent Folder
                    CreateFileOrDir(strPath) 'Recurse Creating Current Folder
                End If
            End If
        Else
            If Not objFSO.FileExists(strPath) Then
                If objFSO.FolderExists(objFSO.GetParentFolderName(strPath)) Then
                    objFSO.CreateTextFile strPath, True  'Create File In Current Path
                Else
                    CreateFileOrDir(objFSO.GetParentFolderName(strPath))  'Recurse Creating Parent Folder
                    CreateFileOrDir(strPath)  'Recurse Creating Current Folder
                End If
            End If
        End If
    End If

    On Error Goto 0

End Sub

 

Jan 01

Logger.vbs

'=========================================================================
' Logger.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass the Log Name, Message, and Whether It's a New Log File
' to the Sub and It will Create or Append the Specified Log File in the Current
' Directory. The Log Name Can Be a Full Directory Path, or Just the File Name
' To Create It in the Current Directory. This Sub is Useful When You Need to
' Create Multiple Output Files and Use Multiple Subs/Functions.
' EXAMPLE: Call Logger("Test.txt", "Test Message", True)
'          Call Logger("C:\Full\Path\test.txt", "Test Message", True)
'          Call Logger("C:\Full\Path\test.txt", "Call 2", False)
'          Call Logger("C:\Full\Path\test.txt", "Call 3" &amp; vbCrLf &amp; "Line 4", False)
'          Call Logger("Test.txt", "Test Message2", False)
'=========================================================================
Option Explicit

Call Logger("Test.txt", "Test Message", True)
Call Logger("C:\Full\Path\test.txt", "Test Message", True)
Call Logger("C:\Full\Path\test.txt", "Call 2", False)
Call Logger("C:\Full\Path\test.txt", "Call 3" &amp; vbCrLf &amp; "Line 4", False)
Call Logger("Test.txt", "Test Message2", False)
Wscript.Echo "Finished"

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