Apologies if this is a big Code...
' _startup.vbs
' %%% This StartUp Program is Automatically initiated during Windows Startup
'
' @@@@ TO CANCEL THE START-UP PROCESS Alt + F4 Then close Script Error @@@@
'
' ************************
' ** THIS SCRIPT WILL RUN AUTOMATICALLY DURING BOOT UP STAGE..
' ** IT WILL THEN LOG THE TIME THAT COMPUTER WAS RESTARTED & ALL PROGRAMS LOADED..
' ** ONCE LOADED THE LOG FILE WILL BE UPDATED AND EMAILED TO ADMINISTRATOR.
' ************************
' ** HERE WE GO !!! **
' ************************
Dim strDateLayout, strCurrentTime, strCntDwnTimer1, strCntDwnTimer2, strCntDwnHTML1, strCntDwnHTML2, strCntDwnHTML3
Dim strStatus1, strStatus2, strStatus3, strStatus4, strLOGDirectory, strLOGFile
Dim objWshell, oIE, oIEDoc
Set FSO = CreateObject("Scripting.FileSystemObject")
Set objWshell = Wscript.CreateObject("Wscript.Shell")
'
' SETTINGS THAT CAN BE CHANGED
'
strDateLayout = WeekDayName(WeekDay(Now()),1) & " " _
& Right("0" & DatePart("d", Now),2) & "-" _
& MonthName(Month(Now()),1) & "-" _
& DatePart("yyyy", Now) & " -- " _
& FormatDateTime(Now(),vbShortTime) & " (" & Right("0" & DatePart("s", Now),2) & " secs)" ' Sat 03-Nov-2012 -- 03:19 (36 secs)
strCurrentTime = "<b>Time Process Started: </b>" & strDateLayout
strCntDwnTimer1 = "<font size='6'>Approx <font size='7' color='red'><b>"
strCntDwnTimer2 = "</b></font> Seconds Remaining</font>"
strCntDwnHTML1 = "<br> <br> <br> <table align='center'><tr><td align='center'><font size='7'><b>PLEASE WAIT !!!</b></font></td></tr><tr><td> <br><br> </td></tr><tr><td align='center'>"
strCntDwnHTML2 = "</td></tr><tr><td align='center'> <br> </td></tr><tr><td align='center'><font size='5'><b><u>WE ARE CURRENTLY</u></b></font><br><br><b>" '
strCntDwnHTML3 = "</b></td></tr><tr><td align='center'> <br> <br> <br> </td></tr><tr><td align='center'><img height='116' width='505' src='\\localhost\images\LOADING.gif'></td></tr></table>"
strStatus1 = "<font size='5' color='green'>APPENDING THE COMPUTER RESTART TIME TO SYSTEM LOG</font>"
strStatus2 = "<font size='5' color='green'>WAITING FOR PRINTER TO INITIATE</font>"
strStatus3 = "<font size='5' color='green'>SENDING EMAIL TO <font color='blue'>'Administrator'<font color='green'> ADVISING SYSTEM RESTARTED</font>"
strStatus4 = "<font size='5' color='green'>REBOOTING <font color='blue'>000 Nav Turnout System</font>"
strLOGDirectory = "C:\_DRFB_StationPC\Logs\"
strLOGFile = "Shutdown_Restart_LOG.txt"
'
' ##### DO NOT TOUCH ANYTHING BELOW THIS LINE
'
' ************************************************
' ** CHECK CURRENT DATE TO SEE IF BACK-UP OF **
' ** SYSTEM LOG IS REQUIRED. IF SO THEN DO IT **
' ************************************************
On Error Resume Next
Dim strDayNumb, strBkupDate, strFileFolder, strBkupFolder, strFileCLEAN
strDayNumb = Right("0" & DatePart("d", Now),2)
strBkupDate = DatePart("yyyy", Now) & "-" & Right("0" & DatePart("m", Now),2) & "-" & Right("0" & DatePart("d", Now),2) & "_" & Right("0" & Hour(Now),2) & Right("0" & Minute(Now),2) & "." & Right("0" & Second(Now),2) & "sec_"' 2012-11-20_LOGFile.txt
strFileFolder = strLOGDirectory & strLOGFile
strBkupFolder = strLOGDirectory & "_BackUps\"
strFileCLEAN = strBkupFolder & "CLEAN\" & strLOGFile
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
If strDayNumb = 01 Then ' Checking for 1st Day of Month
'MsgBox "Today's date is " & strDayNumb & vbCrLf & "Which means we need to BackUp Log File"
'
If FSO.FileExists(strFileFolder) Then
FSO.CopyFile strFileFolder ,strBkupFolder
wscript.sleep(5000) ' ** Pause for a few seconds (5 sec)
FSO.MoveFile strBkupFolder & strLOGFile ,strBkupFolder & strBkupDate & strLOGFile ' Rename File with Date Appended
wscript.sleep(5000) ' ** Pause for a few seconds (5 sec)
ErrLOGFile1 = 0
Else
ErrLOGFile1 = 1
End If
If FSO.FileExists(strFileFolder) Then
FSO.DeleteFile strFileFolder
ErrLOGFile2 = 0
Else
ErrLOGFile2 = 1
End If
wscript.sleep(5000) ' ** Pause for a few seconds (5 sec)
FSO.CopyFile strFileCLEAN ,strLOGDirectory
Else
'MsgBox "Today is not the day to BackUp Logs"
End If
'MsgBox "PROCESS COMPLETE"
'
' ERROR DATA
'
If Err.Number <> 0 Or ErrLOGFile = 1 Or ErrLOGFile2 = 1 Then
' ******************************
' ** ERROR DETAILS IN LOG **
' ******************************
Dim strErrLOGText
strErrLOGText = " ********** " & vbCrLf & "ERR LOGFILE: " & strDateLayout & " == Error Trying to BackUp System Log File - Possible File/Folder Not Exist == " & vbCrLf & "ErrorLOGFile 1 status is " & ErrLOGFile1 & " -- ErrorLOGFile 2 status is " & ErrLOGFile2 & vbCrLf & " *** ERROR IGNORED -- Will Continue To Load *** " & vbCrLf & " ********** " 'Err LogFile: Sat 03-Nov-2012 -- 03:19 (36 secs)
' Now Append The Restarted Time
Const ErrLOGForAppending = 8 ' ForAppending = 8 ForReading = 1 ForWriting = 2
Set objTextFile = FSO.OpenTextFile _
(strLOGDirectory & strLOGFile, ErrLOGForAppending, True)
objTextFile.WriteLine(strErrLOGText) ' Writes strText every time script Runs
objTextFile.Close
End If
wscript.sleep(5000) ' ** Pause for a few seconds (5 sec)
' ************************
' ** END OF BACK-UP **
' ************************
'
' Initialize the "Please Wait" window
'
Set oIE = Wscript.CreateObject("InternetExplorer.Application")
oIE.Navigate "about:blank"
do while oIE.busy : wscript.sleep 10 : loop
Set oIEDoc = oIE.Document
' As it's an Internet Explorer window, we must get rid of the toolbars
'
oIE.AddressBar = False
oIE.StatusBar = False
oIE.ToolBar = False
oIE.FullScreen = True
oIE.Document.Body.Scroll = "no"
oIE.document.title = "-- LOADING SETTINGS -- Please StandBy........"
'oIE.height=700
'oIE.width=550
oIE.Resizable = False
oIE.Visible = True
' Display HTML within this window with animated Loading Image
'
'## Message 1
'#########################
Dim CountDown : CountDown = 45 ' Total Amount of CountDown Time
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus1 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 40 ' Ready for Next Step
' ******************************
' ** RUN RESTART TIME LOG **
' ******************************
Dim strText
strText = " Restarted: " & strDateLayout 'Restarted: Sat 03-Nov-2012 -- 03:19 (36 secs)
' Now Append The Restarted Time
Const ForAppending = 8 ' ForAppending = 8 ForReading = 1 ForWriting = 2
Set objTextFile = FSO.OpenTextFile _
(strLOGDirectory & strLOGFile, ForAppending, True)
objTextFile.WriteLine(strText) ' Writes strText every time script Runs
objTextFile.Close
Set sMsg = Nothing
'## Message 2
'#########################
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus2 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 30 ' Ready for Next Step
' *****************************************
' ** WAITING FOR PRINTER TO INITIATE **
' *****************************************
Set sMsg = Nothing
'## Message 3
'#########################
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus3 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 20 ' Ready for Next Step
'
' ERROR DATA
'
On Error Resume Next
'
' **************************************************
' ** LET's SEND EMAIL - To Administrators !!! **
' **************************************************
Dim oName, ODomain, oMyIP, oTo, oSender, oSubject, oTextBody, oAddAttach, oAttachment1, oAttachment2, oAttachment3, oAttachment4, oMsgBox
' Get the computer name
Set WshNetwork = CreateObject("WScript.Network")
oName = WshNetwork.ComputerName
' *****************************
' ** Set Information Below **
' *****************************
'
' Email Domain Name
ODomain = "mydomain.org.au"
' SMTP - Outgoing Email Server
oMyIP = "mail.ourserver.com.au"
' Recipient Email Address {Separate using ; if Multiple Recipients}
oTo = "us@mydomain.org.au"
' Sender Name
oSender = "Main_PC" ' NO SPACES ALLOWED
' Email Subject
oSubject = "Main PC StartUp/Reboot !!"
' Email Text Body {You can have 2 different Views for Emails Sent. Plain Text / HTML which can display as both the same or both completely different.}
oTextBody = "MAIN PC -- StartUp / Reboot" & vbCrLf & vbCrLf & "The Main PC has Rebooted and successfully Loaded"& vbCrLf &"At: " & now & vbCrLf & vbCrLf &"Computer Name: " & oName & vbCrLf & vbCrLf &"You should also receive an E-Mail from { Server } advising of a possible Reason For Reboot (if occurred)."& vbCrLf & vbCrLf &"Attached are System Log Files [Showing STARTUP / RESTART Times]"& vbCrLf & vbCrLf &"Regards,"& vbCrLf &"MAIN PC"& vbCrLf & vbCrLf &" "
oHTMLBody = "<html><body><h1>MAIN PC -- StartUp / Reboot</h1><br>The Main PC has Rebooted and successfully Loaded<br>At: "& now &"<br><br><b>Computer Name:</b> "& oName &"<br><br>You should also receive an E-Mail from { Server } advising of a possible Reason For Reboot (if occurred).<br><br>Attached are System Log Files [Showing STARTUP / RESTART Times]<br><br>Regards,<br>MAIN PC<br> <br> </body></html>"
'
' Email Attachment/s
' 0 = No Email Attachment
' 1 = Includes Email Attachment
oAddAttach1 = 1 ' ## Attachment 1
oAttachment1= strLOGDirectory & strLOGFile
'
oAddAttach2 = 0 ' ## Attachment 2
oAttachment2 = "C:\Document (2).txt"
'
' Message Box
oMsgBox = 0 ' 0 = No Sent MsgBox
' 1 = Display Sent MsgBox
'
' ***************************************
' ** DO NOT CHANGE ANYTHING BELOW HERE **
' ***************************************
'
' Setting the VB constants as they do not exist within VBScript
Const cdoSendUsingMethod = "http://schemas.microsoft.com/cdo/configuration/sendusing", _
cdoSendUsingPort = 2, _
cdoSMTPServer = "http://schemas.microsoft.com/cdo/configuration/smtpserver"
' Create the CDO connections
Dim iMsg, iConf, Flds
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
' SMTP server configuration
With Flds
.Item(cdoSendUsingMethod) = cdoSendUsingPort
' Set the SMTP server address here
.Item(cdoSMTPServer) = oMyIP
.Update
End With
' Set the Message properties
With iMsg
Set .Configuration = iConf
.To = oTo
'.CC = "user@domain.com" ' Uncomment this Line (.CC) to enable Carbon Copy
'.BCC = "user@domain.com" ' Uncomment this Line (.BCC) to enable Blind Carbon Copy
.From = oSender & "@" & oDomain
.Subject = oSubject
.TextBody = oTextBody
.HTMLBody = oHTMLBody
End With
' An attachment/s can be included
If oAddAttach1 = 1 then
iMsg.AddAttachment oAttachment1
End If
If oAddAttach2 = 1 then
iMsg.AddAttachment oAttachment2
End If
' Send the message
iMsg.Send
Set iMsg = Nothing
' Confirmation Message Box
If oMsgBox = 1 then
MsgBox "SYSTEM EMAIL SENT"
Else
End If
'
' ERROR DATA
'
If Err.Number <> 0 Then
Set sMsg = Nothing
' ******************************
' ** ERROR DETAILS IN LOG **
' ******************************
Dim strErrText
strErrText = " ********** " & vbCrLf & " ERROR INET: " & strDateLayout & " == Error while trying to send ADMIN Email" & vbCrLf & " *** ERROR -- Possible Internet Not Working " & vbCrLf & " *** ERROR IGNORED -- Will Continue To Load 'Programs' *** " & vbCrLf & " ********** " 'Restarted: Sat 03-Nov-2012 -- 03:19 (36 secs)
' Now Append The Restarted Time
Const ErrForAppending = 8 ' ForAppending = 8 ForReading = 1 ForWriting = 2
Set objTextFile = FSO.OpenTextFile _
(strLOGDirectory & strLOGFile, ErrForAppending, True)
objTextFile.WriteLine(strErrText) ' Writes strText every time script Runs
objTextFile.Close
End If
'
'## Message 4
'#########################
Do
wscript.sleep (1000) ' Pause for a second
CountDown = CountDown - 1
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
sMsg= strCurrentTime & strCntDwnHTML1 & strCntDwnTimer1 & CountDown & strCntDwnTimer2 & strCntDwnHTML2 & strStatus4 & strCntDwnHTML3
oIEDoc.Body.Innerhtml= sMsg
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Loop until CountDown = 0 ' Ready for Next Step
' **********************
' ** LOAD PROGRAM **
' **********************
objWshell.run """C:\Folder\File.exe"""
Set sMsg = Nothing
' Time To Close Down The Script and "Please Wait" window
'
Set oIEDoc = Nothing
oIE.Quit
Set oIE = Nothing
Set objFSO = Nothing
Set objWshell = Nothing
Set WshShell = Nothing
WScript.Quit
Frontpage
Forums
Tutorials
Members
Calendar
Subscription
Donate
Links
Contact 
Help
Posted 27 January 2013 - 08:40 PM
Back to top
