Re: date/time -vbscript by D
D
Fri May 27 10:03:24 CDT 2005
Here's the 'shell' of vbs code that I use for small to medium sized
scripts... It create a date stamped log file.
Option Explicit
'*******************************************************************************************************************************************************
'* File: "????.vbs"
'* Purpose: To ????.
'*
'* Vers Date Who Description
'* ---- ---- --- -----------
'* v0.01 ??-???-2005 DR First version.
'*******************************************************************************************************************************************************
Const cs_script_version = "v0.01"
'*******************************************************************************************************************************************************
'* Changes to make:
'* -
'*******************************************************************************************************************************************************
Const ci_for_reading = 1 'File access constants.
Const ci_for_writing = 2
Const ci_for_appending = 8
Const ci_event_success = 0 'For logging events.
Const ci_event_error = 1
Const ci_event_warning = 2
Const ci_event_information = 4
Const ci_event_audit_success = 8
Const ci_event_audit_failure = 16
Const ci_popup_mark = 16 'Popup icons.
Const ci_popup_question = 32
Const ci_popup_exclamation = 48
Const ci_popup_info = 64
Const ci_windows_folder = 0 'Where Windows is installed.
Const ci_system_folder = 1 'Usually the \System32 folder.
Const ci_temporary_folder = 2 'Temporary files folder.
Const cs_stars = "*************************************"
Dim go_fso, go_wsh, go_net, go_app, go_ads 'Global variables.
Dim gs_script_spec, gs_script_path, gs_script_name, gs_script_title
Dim gs_time_stamp, gs_log_spec, go_log_chan
Call s_init()
Call s_main()
Call s_quit("")
WScript.Quit
Sub s_init()
Const cs_fac = "%s_init, "
If Not WScript.Interactive Then
WScript.Echo cs_fac & "Script can only be run interactively. Now
quitting..."
WScript.Quit
End If
Set go_fso = CreateObject( "Scripting.FileSystemObject" )
Set go_net = CreateObject( "WScript.Network" )
Set go_wsh = CreateObject( "WScript.Shell" )
Set go_app = CreateObject( "Shell.Application" )
On Error Resume Next
Set go_ads = CreateObject( "ADSystemInfo" )
On Error Goto 0
gs_script_spec = Wscript.ScriptFullName 'Get this script's full file
specification...
gs_script_path = go_fso.GetParentFolderName( gs_script_spec ) '...split
off the folder path...
gs_script_name = go_fso.GetBaseName( gs_script_spec ) '...and
also the actual file name of this script at run time.
gs_script_title = gs_script_name & " (" & cs_script_version & ")" 'For
title bar of all dialog boxes (msgbox, popup, inputbox).
gs_time_stamp = fs_time_stamp( Now )
Call s_create_log_file()
End Sub
Sub s_main()
Const cs_fac = "%s_main, "
End Sub
Sub s_create_log_file()
Const cs_fac = "%s_create_log_file, "
Dim ls_ads_username
On Error Resume Next
ls_ads_username = go_ads.UserName
If Err Then ls_ads_username = "(not available)"
On Error Goto 0
gs_log_spec = gs_script_path & "\" & gs_script_name & "-" & gs_time_stamp
& ".log"
On Error Resume Next
Set go_log_chan = go_fso.OpenTextFile( gs_log_spec, ci_for_appending,
True )
Select Case Err.Number
Case 0
Case 70
Call s_error( cs_fac & "Failed to open log file `" & gs_log_spec & "`
for appending, another instance of this script is probably already
running..." )
Case Else
Call s_error( cs_fac & "Failed to open log file `" & gs_log_spec & "`
for appending..." )
End Select
On Error Goto 0
Call s_log( cs_stars ) 'Now write the log file header...
Call s_log( "Log File: " & gs_log_spec )
Call s_log( "Script File: " & gs_script_spec )
Call s_log( "Version: " & cs_script_version )
Call s_log( "Run Date: " & fs_datetime(Now) )
Call s_log( "Arguments: " & fs_arguments_list() )
Call s_log( "" )
Call s_log( "Username: " & go_net.UserName )
Call s_log( "Domain: " & go_net.UserDomain )
Call s_log( "Computer Name: " & go_net.ComputerName )
Call s_log( "AD Sys Info: " & ls_ads_username )
Call s_log( "" )
Call s_log( "O/S Version: " & fs_get_os_version() )
Call s_log( "Run by: " & Wscript.FullName )
Call s_log( "Interactive: " & Wscript.Interactive )
Call s_log( "WScript: " & Wscript.Name & " v" & Wscript.Version &
"." & Wscript.BuildVersion )
Call s_log( "ScriptEngine: " & ScriptEngine & " v" &
ScriptEngineMajorVersion & "." & ScriptEngineMinorVersion & "." &
ScriptEngineBuildVersion )
Call s_log( cs_stars )
End Sub
'*************************************************************
'******************* Minor sub-routines ********************
'*************************************************************
Sub s_popup( pl_seconds, ps_message )
Dim ls_message
Call s_log( ps_message )
ls_message = fs_datetime(Now) & vbCrlf & vbCrlf & ps_message
go_wsh.PopUp ls_message, pl_seconds, gs_script_title, ci_popup_info
End Sub
Sub s_warning( ps_message )
Dim ls_error, ls_message
ls_error = ""
ls_error = ls_error & vbCrlf & " error: " & vbTab & Err.Number
ls_error = ls_error & vbCrlf & " text: " & vbTab & Err.Description
ls_error = ls_error & vbCrlf & " source:" & vbTab & Err.Source
On Error Resume Next
ls_message = "Script has encountered an error, and cannot process
requested action, script will continue..."
ls_message = ls_message & vbCrlf & " at: " & vbTab & fs_datetime(Now)
ls_message = ls_message & vbCrlf & " reason:" & vbTab & ps_message
ls_message = ls_message & vbCrlf & ls_error
Call s_log_event( ci_event_warning, ls_message )
Call s_msgbox( ls_message )
End Sub
Sub s_error( ps_message )
Dim ls_error, ls_message
ls_error = " error:" & vbTab & Err.Number
ls_error = ls_error & vbCrlf & " text:" & vbTab & Err.Description
ls_error = ls_error & vbCrlf & " source:" & vbTab & Err.Source
On Error Resume Next
ls_message = "Script has encountered an error, and will now stop..."
ls_message = l_message & vbCrlf & " at:" & vbTab & fs_datetime( Now )
ls_message = l_message & vbCrlf & " reason:" & vbTab & ps_message
ls_message = l_message & vbCrlf & ls_error
Call s_log_event( ci_event_error, ls_message )
Call s_quit( ls_message )
End Sub
Sub s_abort( ps_message )
Dim ls_message
ls_message = "Script is aborting, and will now stop..."
ls_message = ls_message & vbCrlf & " at:" & vbTab & fs_datetime( Now )
ls_message = ls_message & vbCrlf & " reason:" & vbTab & ps_message
Call s_log_event( ci_event_error, ls_message )
Call s_quit( ls_message )
End Sub
Sub s_quit( ps_message )
Const cs_fac = "%s_quit, "
Dim ls_message
ls_message = cs_fac & "Script quit at " & fs_datetime(Now)
If ps_message <> "" Then
ls_message = ps_message & vbCrlf & vbCrlf & ls_message
End If
Call s_msgbox( ls_message )
WScript.Quit
End Sub
Sub s_msgbox( ps_message )
On Error Resume Next
Call s_log( ps_message )
MsgBox ps_message, , gs_script_title
End Sub
Sub s_log( ps_text )
On Error Resume Next
go_log_chan.WriteLine fs_hhmmss() & " " & ps_text
On Error Goto 0
End Sub
Sub s_log_event( pi_status, ps_message )
On Error Resume Next
Dim ls_text
ls_text = ""
ls_text = ls_text & "Script:" & vbTab & gs_script_spec & vbCrlf
ls_text = ls_text & "Date:" & vbTab & fs_datetime(Now) & vbCrlf
ls_text = ls_text & "Username:" & vbTab & go_net.UserName & vbCrlf
ls_text = ls_text & "Computer:" & vbTab & go_net.ComputerName & vbCrlf
ls_text = ls_text & "Message:" & vbTab & ps_message & vbCrlf
go_wsh.LogEvent pi_status, ls_text
End Sub
Sub s_pause()
On Error Resume Next
Call s_msgbox( "Script is paused, hit OK to continue..." )
End Sub
'*************************************************************
'************************ Functions ************************
'*************************************************************
Function fs_arguments_list()
Dim ls_out, ll_cnt, ls_arg, ll_i, lo_arg
ll_cnt = 0
ls_out = ""
For Each lo_arg In WScript.Arguments
ll_cnt = ll_cnt + 1
ls_out = ls_out & "Arg: " & ll_cnt & " = [" & lo_arg & "] "
Next
fs_arguments_list = Trim( ls_out )
End Function
Function fs_datetime( pd_datetime )
Dim ld_datetime, ls_result
If VarType( pd_datetime ) = vbDate Then
ld_datetime = pd_datetime
Else
ld_datetime = Now
End If
ls_result = WeekDayName( WeekDay( ld_datetime ), False, 1 )
ls_result = ls_result & " " & FormatDateTime( ld_datetime, vbLongdate )
ls_result = ls_result & " " & FormatDateTime( ld_datetime, vbLongtime )
fs_datetime = ls_result
End Function
Function fs_time_stamp( pd_datetime )
Const cs_fac = "%fs_time_stamp, "
Dim ld_datetime, ls_result
Dim ls_yyyy, ls_mm, ls_dd, ls_hh, ls_nn, ls_ss
If gs_time_stamp <> "" Then Call s_abort( cs_fac & "Function appears to
have been called more than once, this should not happen, cannot continue." )
If VarType( pd_datetime ) = vbDate Then
ld_datetime = pd_datetime
Else
ld_datetime = Now
End If
ls_yyyy = fs_zeroes( DatePart( "yyyy", ld_datetime ), 4 )
ls_mm = fs_zeroes( DatePart( "m", ld_datetime ), 2 )
ls_dd = fs_zeroes( DatePart( "d", ld_datetime ), 2 )
ls_hh = fs_zeroes( DatePart( "h", ld_datetime ), 2 )
ls_nn = fs_zeroes( DatePart( "n", ld_datetime ), 2 )
ls_ss = fs_zeroes( DatePart( "s", ld_datetime ), 2 )
ls_result = "" & ls_yyyy & "-" & ls_mm & "-" & ls_dd & "-" & ls_hh & "-" &
ls_nn & "-" & ls_ss
fs_time_stamp = ls_result
End Function
Function fs_get_os_version()
Const cs_fac = "%fs_get_os_version, "
Dim lo_net, ls_computer, lo_wmi, lo_systems, lo_os, ls_os, ll_cnt
fs_get_os_version = "(unknown)"
Set lo_net = CreateObject( "WScript.Network" )
ls_computer = lo_net.ComputerName
Set lo_wmi = GetObject( "WinMgmts:\\" & ls_computer & "\root\cimv2" )
Set lo_systems = lo_wmi.InstancesOf( "Win32_OperatingSystem" )
On Error Resume Next
ll_cnt = lo_systems.Count
If Err.Number <> 0 Then
Call s_error( cs_fac & "Unable to connect to WMI object to retrieve OS
version." )
End If
On Error Goto 0
For Each lo_os In lo_systems 'Only one instance is ever returned (the
currently active OS).
Select Case lo_os.OSType
Case 16
ls_os = "Win95"
Case 17
ls_os = "Win98"
Case 18
Select Case Left( lo_os.Version, 3 )
Case "4.0"
ls_os = "WinNT4"
Case "5.0"
ls_os = "Win2000"
Case "5.1"
ls_os = "WinXP"
Case "5.2"
ls_os = "Win2003"
Case Else
ls_os = "WinNT v" & lo_os.Version
End Select
If lo_os.ServicePackMajorVersion > 0 Then
ls_os = ls_os & " SP" & lo_os.ServicePackMajorVersion
End If
Case Else
ls_os = "(unknown)"
End Select
Next
fs_get_os_version = ls_os
End Function
Function fs_hhmmss()
Const cs_fac = "%fs_hhmmss, "
Dim ld_dt
ld_dt = Now
fs_hhmmss = fs_zeroes( DatePart( "h", ld_dt ), 2 ) & ":" & fs_zeroes(
DatePart( "n", ld_dt ), 2 ) & ":" & fs_zeroes( DatePart( "s", ld_dt ), 2 )
End Function
Function fs_zeroes( pl_number, pl_length )
Const cs_fac = "%fs_zeroes, "
Dim ls_result
ls_result = String( pl_length, "0" ) & CStr( pl_number )
ls_result = Right( ls_result, pl_length )
fs_zeroes = ls_result
End Function
Function fs_format( ps_text, pl_length )
Const cs_fac = "%fs_format, "
If Len( ps_text ) >= pl_length Then
fs_format = ps_text
Else
fs_format = Left( ps_text & Space( pl_length ), pl_length )
End If
End Function
Function fs_replace( ps_data, pl_start, pl_length, ps_replace )
Const cs_fac = "%fs_replace, "
Dim ls_left, ls_right, ls_replace
If Len( ps_replace ) > pl_length Then
Call s_abort( cs_fac & "String to overwrite/replace `" & ps_replace & "`
is not the same length as the field `" & pl_length & "`." )
End If
ls_replace = fs_format( ps_replace, pl_length )
ls_left = Mid( ps_data, 1, pl_start - 1 )
ls_right = Mid( ps_data, pl_start + pl_length, Len( ps_data ) )
fs_replace = ls_left & ls_replace & ls_right
End Function