Re: Event Log Query
- From: "D.R." <a@xxxxx>
- Date: Sun, 29 Apr 2007 11:19:10 +0100
Hu Ayth (Darrin),
This might help...
Option Explicit
'*******************************************************************************************************************************************************
'* File: "event log email.vbs"
'* Purpose: To report/summarize Event Log entries.
'* Change the constants below to suit your requirements.
'*
'* Vers Date Who Description
'* ---- ---- --- -----------
'* v0.01 25-MAY-2005 DR Original version.
'* v0.02 25-MAY-2005 DR Sort into time order, and report a count of
occurrences for each distinct event.
'* v0.03 25-MAY-2005 DR Use constants to identify testing computer, and
email from and to, and smtp server.
'* v0.04 1-JUN-2005 DR Send report as plain text, i.e. only as attachment
if over a certain size.
'* v0.05 22-MAR-2006 DR Added Manish to email delivery.
'* v0.06 3-MAY-2006 DR Amended email recipients.
'*******************************************************************************************************************************************************
Const cs_script_version = "v0.05"
'*******************************************************************************************************************************************************
'* Usage:
'* Switches:
'* -h Show help, usage summary.
'* -c:<computer> Name of computer to scan, default to this computer.
'* -d:<days> Number of days ago/past cutoff for event retrieval. Default
to 3 days on Mon, 2 on Sun, and 1 on Tue to Sat.
'*******************************************************************************************************************************************************
'* Changes To Make:
'* - Tidy up some of the variable names in the `s_events` routine.
'* - Add switch `-s:<datetime>`, mutually exclusive with `-d:<days>`.
'*******************************************************************************************************************************************************
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 cl_max_log_size_kb = 19999 'Max size in kb of event files that
will be attempted.
Const cl_max_report_size_b = 65536 'Any reports over 64kb in size will
be emailed as an attachment.
Const cs_stars = "*************************************"
Const cs_regkey_computer = "HKLM\Software\Scripts\event log email\computer"
'**********************************************************************
'* Change these constants to suit your needs...
'*
Const cs_email_smtp_server = "mail.my.org.uk"
Const cs_email_from = "@my.org.uk"
Const cs_email_to = "inbox@xxxxxxxxx"
Const cs_email_to_testing = "inbox@xxxxxxxxx"
Const cs_computer_testing = "mycomp"
'**********************************************************************
Dim go_fso, go_net, go_wsh, go_app, go_ads
Dim gs_script_spec, gs_script_path, gs_script_name, gs_script_title
Dim gb_echo, gb_popup
Dim gs_log_spec, go_log_chan
Dim gs_arg_list, gs_arg_computer, gl_arg_days, gd_arg_since
Call s_initialize()
Call s_main()
WScript.Quit
Sub s_initialize()
Const cs_fac = "%s_initialize, "
Dim ls_engine
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).
ls_engine = go_fso.GetFileName( Wscript.FullName ) 'Check the script
engine.
Select Case Lcase( ls_engine )
Case "cscript.exe" 'Running from command line?
gb_echo = True 'Only echo is available, no popup, msgbox or
inputbox.
gb_popup = False
Case "wscript.exe" 'Probably running from a double click.
gb_echo = False 'So we don't get loads of popups/echoes.
gb_popup = True
Case Else
Call s_abort( cs_fac & "Unknown script engine `" & ls_engine & "`." )
End Select
Call s_get_arguments() 'Retrieve any options from the command line
or shortcut.
gd_arg_since = DateAdd( "d", -gl_arg_days, Now ) 'Note the `-` minus
sign.
Call s_create_log_file()
End Sub
Sub s_main()
Const cs_fac = "%s_main, "
Dim ld_run_start, ld_run_end
ld_run_start = Now
Call s_events( gs_arg_computer )
ld_run_end = Now
Call s_quit( cs_fac & "Run time duration `" & Trim( fs_duration(
ld_run_start, ld_run_end ) ) & "`." )
End Sub
Sub s_events( ps_computer )
Const cs_fac = "%s_events, "
Dim lo_wmi, lc_events, lo_event, ls_properties
Dim ld_events_text, ld_events_count, ls_event, ls_key, ll_count,
ls_message, ls_tmp, ll_log_size, ll_tmp, ls_array
Dim lc_logs, lo_log
Dim ls_report, lo_report
Dim ls_email_from, ls_email_to, ls_email_subject, ls_email_message,
ls_email_attachment
Call s_log( "" )
Call s_log( cs_fac & "Attempting to connect to `" & ps_computer & "`..." )
On Error Resume Next
' Set lo_wmi = GetObject( "WinMgmts:" &
"{ImpersonationLevel=Impersonate}!\\" & ps_computer & "\root\cimv2" )
Set lo_wmi = GetObject( "WinMgmts:\\" & ps_computer & "\root\cimv2" )
If Err.Number <> 0 Then
Call s_popup( 4, cs_fac & "Unable to connect to `" & ps_computer & "`,
continuing..." )
On Error Goto 0
Exit Sub
End If
On Error Goto 0
On Error Resume Next
Set lc_logs = lo_wmi.ExecQuery( "Select * from Win32_NTEventLogFile" )
If Err.Number <> 0 Then
Call s_popup( 4, cs_fac & "Unable to query event log file size on `" &
ps_computer & "`, continuing..." )
On Error Goto 0
Exit Sub
End If
For Each lo_log In lc_logs
ll_log_size = lo_log.FileSize \ 1024
If ll_log_size > cl_max_log_size_kb Then
Call s_popup( 4, cs_fac & "Log file `" & lo_log.LogFileName & "` of `"
& ps_computer & "` is too big, at `" & ll_log_size & "`kb, continuing..." )
Exit Sub
End If
Next
ls_properties =
"Message,LogFile,Category,EventCode,SourceName,Type,User,RecordNumber,TimeWritten"
On Error Resume Next
Set lc_events = lo_wmi.ExecQuery( "Select " & ls_properties & " from
Win32_NTLogEvent " _
& "Where TimeWritten>='" & gd_arg_since & "' AND Type<>'Information'" )
If Err.Number <> 0 Then
Call s_popup( 4, cs_fac & "Unable to query event log entries for `" &
ps_computer & "`, continuing..." )
On Error Goto 0
Exit Sub
End If
On Error Goto 0
On Error Resume Next
ll_tmp = lc_events.Count 'Make sure we can actually retrieve
data...
If Err.Number <> 0 Then
Call s_popup( 4, cs_fac & "Unable to retrieve events count for `" &
ps_computer & "`, continuing..." )
On Error Goto 0
Exit Sub
End If
On Error Goto 0
Call s_log( cs_fac & "Connected to computer, and attached to events, now
starting to report `" & ps_computer & "`..." )
Set ld_events_text = CreateObject( "Scripting.Dictionary" )
Set ld_events_count = CreateObject( "Scripting.Dictionary" )
ls_report = gs_script_path & "\" & gs_script_name & " - " & ps_computer &
".txt"
Set lo_report = go_fso.OpenTextFile( ls_report, ci_for_writing, True )
lo_report.WriteLine "Event Log Extract Summary Of Distinct Events"
lo_report.WriteLine ""
For Each lo_log In lc_logs
ll_log_size = lo_log.FileSize \ 1024
lo_report.WriteLine "Log File: " & fs_left( lo_log.LogFileName,
11 ) & vbTab & "(" & fs_right( ll_log_size, 4 ) & " kb)"
Next
For Each lo_event In lc_events
ls_message = lo_event.Message
If Len( ls_message ) > 0 Then
Do
ls_tmp = ls_message
ls_message = Replace( ls_message, vbCrlf, " | " )
ls_message = Replace( ls_message, " ", " " )
Loop Until ls_message = ls_tmp
End If
'class Win32_NTLogEvent
'{
' uint16 Category;
' string CategoryString;
' string ComputerName;
' uint8 Data[];
' uint16 EventCode;
' uint32 EventIdentifier;
' uint8 EventType;
' string InsertionStrings[];
' string Logfile;
' string Message;
' uint32 RecordNumber;
' string SourceName;
' datetime TimeGenerated;
' datetime TimeWritten;
' string Type;
' string User;
'};
ls_event = ""
ls_event = ls_event & "Log File: " & Trim( lo_event.LogFile ) &
vbCrlf
ls_event = ls_event & "Category: " & Trim( lo_event.Category ) &
vbCrlf
ls_event = ls_event & "Event Code: " & Trim( lo_event.EventCode ) &
vbCrlf
ls_event = ls_event & "Message: " & Trim( ls_message ) & vbCrlf
ls_event = ls_event & "Source Name: " & Trim( lo_event.SourceName ) &
vbCrlf
ls_event = ls_event & "Type: " & Trim( lo_event.Type ) &
vbCrlf
ls_event = ls_event & "User: " & Trim( lo_event.User ) &
vbCrlf
ls_key = ls_event
ls_event = ls_event & "Record Number: " & Trim( lo_event.RecordNumber )
& vbCrlf
ls_event = "Time Written: " & fs_datetime( fd_written(
lo_event.TimeWritten ) ) & vbCrlf & ls_event
If ld_events_count.Exists( ls_key ) Then 'Have we seen this type of
event before?
ll_count = ld_events_count.Item( ls_key )
ld_events_count.Remove ls_key
Else
ld_events_text.Add ls_key, lo_event.TimeWritten & Chr(255) & ls_event
ll_count = 0
End If
ll_count = ll_count + 1
ld_events_count.Add ls_key, ll_count
Next 'event log entry...
Call s_sort_dictionary_by_item_descending( ld_events_text )
lo_report.WriteLine ""
lo_report.WriteLine "Computer: " & ps_computer
lo_report.WriteLine "Report File: " & ls_report
lo_report.WriteLine "Run Date: " & Date & " " & Time
lo_report.WriteLine "Events Found: " & lc_events.Count
lo_report.WriteLine "Events Reported: " & ld_events_text.Count
lo_report.WriteLine "Since: " & fs_datetime( gd_arg_since ) & "
(" & gl_arg_days & " days ago)"
lo_report.WriteLine ""
lo_report.WriteLine "This report only shows the most recent occurrence of
an event."
lo_report.WriteLine ""
lo_report.WriteLine cs_stars
For Each ls_key In ld_events_text
ll_count = ld_events_count.Item( ls_key )
ls_tmp = ld_events_text.Item( ls_key )
ls_array = Split( ls_tmp, Chr(255) )
lo_report.WriteLine ls_array(1) & "Count: " & ll_count
lo_report.WriteLine cs_stars
Next
lo_report.WriteLine ""
lo_report.WriteLine "Found `" & ld_events_text.Count & "` distinct events
out of `" & lc_events.Count & "` for `" & ps_computer & "`."
lo_report.WriteLine ""
lo_report.WriteLine "[end]"
lo_report.Close
ls_email_from = gs_arg_computer & cs_email_from
If LCase( go_net.ComputerName ) = LCase( cs_computer_testing ) Then 'If
running on the test PC...
ls_email_to = cs_email_to_testing
Else
ls_email_to = cs_email_to
End If
ls_email_subject = "Event log extract of `" & gs_arg_computer & "` found
`" & ld_events_text.Count & "/" & lc_events.Count & "` distinct errors since
" & fs_datetime( gd_arg_since ) & "."
Set lo_report = go_fso.GetFile( ls_report )
If lo_report.Size < cl_max_report_size_b Then
Set lo_report = go_fso.OpenTextFile( ls_report, ci_for_reading )
ls_email_message = lo_report.ReadAll
lo_report.Close
ls_email_attachment = ""
Else
ls_email_message = ls_email_subject & vbCrlf & vbCrlf & "Please see
attached summary report ;"
ls_email_attachment = ls_report
End If
Call s_email_smtp( ls_email_from, ls_email_to, ls_email_subject,
ls_email_message, ls_email_attachment )
Call s_log( cs_fac & "Found `" & ld_events_text.Count & "` distinct events
out of `" & lc_events.Count & "` for `" & ps_computer & "`." )
Set ld_events_count = Nothing
Set ld_events_text = Nothing
Set lc_events = Nothing
Set lo_wmi = Nothing
End Sub
Sub s_sort_dictionary_by_item_descending( pd_dic )
Const cs_fac = "%s_sort_dictionary_by_item_descending, "
Dim ls_keys, ls_items, ls_key, ls_item, ls_data
Dim ll_count, ll_i, ll_j, lb_swapped, ll_compares, ll_swaps
Redim ls_keys( pd_dic.Count ) 'Create array big enough to hold all
the keys.
Redim ls_items( pd_dic.Count )
ll_count = 0
For Each ls_key In pd_dic.Keys 'Pull each key off (unsorted), and add
to the array...
ls_item = pd_dic.Item( ls_key )
pd_dic.Remove ls_key '...and empty the dictionary (will be reloaded
after sorting).
ll_count = ll_count + 1
ls_keys( ll_count ) = ls_key
ls_items( ll_count ) = ls_item
Next
ll_compares = 0
ll_swaps = 0
For ll_i = 1 To ll_count 'Bubble sort the array.
lb_swapped = False
For ll_j = ll_count - 1 To ll_i Step -1
ll_compares = ll_compares + 1
If ls_items( ll_j ) < ls_items( ll_j + 1 ) Then
Set ls_data = Nothing
ls_data = ls_items( ll_j )
ls_items( ll_j ) = ls_items( ll_j + 1 )
ls_items( ll_j + 1 ) = ls_data
Set ls_data = Nothing
ls_data = ls_keys( ll_j )
ls_keys( ll_j ) = ls_keys( ll_j + 1 )
ls_keys( ll_j + 1 ) = ls_data
lb_swapped = True
ll_swaps = ll_swaps + 1
End If
Next
If Not lb_swapped Then Exit For 'If we ran through the list and all
required swaps have happenned, then no need to carry on.
Next
Call s_log( cs_fac & "Did " & ll_compares & " compares, and " & ll_swaps &
" swaps, stopped at major iteration " & ll_i & " of possible " & ll_count &
"." )
For ll_i = 1 To ll_count 'Use the sorted `Keys` to rebuild the list
of `Items`, i.e. the dictionary.
ls_key = ls_keys( ll_i )
ls_item = ls_items( ll_i )
pd_dic.Add ls_key, ls_item '...and pop it on the end of the
dictionary.
Next
If ll_count <> pd_dic.Count Then 'One last check.
Call s_abort( cs_fac & "Unexpected change in number of keys, with
ll_count=`" & ll_count & "` and pd_dic.Count=`" & pd_dic.Count & "`, script
cannot continue..." )
End If
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 & ".log"
On Error Resume Next
Set go_log_chan = go_fso.OpenTextFile( gs_log_spec, ci_for_writing, True )
Select Case Err.Number
Case 0
Case 70
Call s_error( cs_fac & "Failed to open log file `" & gs_log_spec & "`
for writing, 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 writing..." )
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 )
Call s_log( "Report Computer: " & gs_arg_computer )
Call s_log( "Report Since: " & fs_datetime( gd_arg_since ) & " (" &
gl_arg_days & " days ago)" )
Call s_log( cs_stars )
End Sub
Sub s_email_smtp( ps_from, ps_to, ps_subject, ps_message, ps_attachment )
Const cs_fac = "%s_email_smtp, "
'// Set the visual basic constants as they do not exist within VBScript.
Const cdoSendUsingMethod =
"http://schemas.microsoft.com/cdo/configuration/sendusing";
Const cdoSendUsingPort = 2
Const 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
.Item(cdoSMTPServer) = cs_email_smtp_server
.Update
End With
'// Set the message properties, and send.
With iMsg
Set .Configuration = iConf
.From = ps_from
.To = ps_to
.Subject = ps_subject
.TextBody = ps_message & vbCrlf & vbCrlf & vbCrlf
If ps_attachment <> "" Then
.AddAttachment ps_attachment
End If
.Send
End With
End Sub
Sub s_get_arguments()
Const cs_fac = "%s_get_arguments, "
Dim ls_switch, ls_value, ls_arg, lo_arg, ll_bad, ls_bad
Dim ls_arg_days, ls_arg_max_log_size
gs_arg_list = ""
gs_arg_computer = ""
gl_arg_days = 0
ll_bad = 0
ls_bad = ""
For Each lo_arg In WScript.Arguments
gs_arg_list = gs_arg_list & " " & lo_arg
ls_arg = Split( LCase( lo_arg ), ":", 2 )
ls_switch = ls_arg( 0 )
If UBound( ls_arg ) > 0 Then
ls_value = ls_arg( 1 )
Else
ls_value = ""
End If
Select Case ls_switch
Case "-h", "-?"
If ls_value = "" Then
Call s_show_usage()
Else
ls_bad = ls_bad & "Switches `-h` and `-?` do not accept any
parameters." & vbCrlf
ll_bad = ll_bad + 1
End If
Case "-c"
gs_arg_computer = ls_value
If gs_arg_computer = "" Then
ls_bad = ls_bad & "Switch `-c` requires a single computer name to
attempt to scan for event log entries." & vbCrlf
ll_bad = ll_bad + 1
End If
Case "-d"
ls_arg_days = ls_value
If ls_arg_days = "" Then
ls_bad = ls_bad & "Switch `-d` requires a value (range 1 to 999) for
number of days ago/past." & vbCrlf
ll_bad = ll_bad + 1
Else
If Not IsNumeric( ls_arg_days ) Then
ls_bad = ls_bad & "Switch `-d` requires a value (range 1 to 999)
for number of days ago/past." & vbCrlf
ll_bad = ll_bad + 1
Else
gl_arg_days = CLng( ls_arg_days )
If ( gl_arg_days < 1 ) Or ( gl_arg_days > 999 ) Then
ls_bad = ls_bad & "Switch `-d` requires a value (range 1 to 999)
for number of days ago/past." & vbCrlf
ll_bad = ll_bad + 1
End If
End If
End If
Case Else
ls_bad = ls_bad & "Unrecognised command switch of `" & ls_switch &
"`." & vbCrlf
ll_bad = ll_bad + 1
End Select
Next
If gs_arg_computer = "" Then 'Default to this computer.
If LCase( go_net.ComputerName ) = LCase( cs_computer_testing ) Then
gs_arg_computer = LCase( fs_input_computer() )
Else
gs_arg_computer = LCase( go_net.ComputerName )
End If
End If
If gl_arg_days = 0 Then 'Default the number of days.
Select Case WeekDay( Now )
Case vbMonday
gl_arg_days = 3
Case vbSunday
gl_arg_days = 2
Case Else
gl_arg_days = 1
End Select
End If
If ll_bad > 0 Then
Call s_abort( cs_fac & "Script cannot continue. Found `" & ll_bad & "`
problem(s) with command line switches and parameters, as follows;" & vbCrlf
& vbCrlf & ls_bad )
End If
End Sub
Sub s_show_usage()
Dim l_text
l_text = ""
l_text = l_text & "Usage table as follows :" & vbCrlf & vbCrlf
l_text = l_text & " -h" & vbTab & vbTab & "Show this usage table"
& vbCrlf
l_text = l_text & " -c:<computer>" & vbTab & "The name of the computer
that you wish to scan" & vbCrlf
l_text = l_text & " -d:<days>" & vbTab & "Number of days ago/past, for
cutoff of events" & vbCrlf
Call s_msgbox( l_text )
End Sub
'*************************************************************
'******************* Minor sub-routines ********************
'*************************************************************
Sub s_popup( pl_seconds, ps_message )
Dim ls_message
Call s_log( ps_message )
If gb_echo Then
WScript.Echo ps_message
Else
If gb_popup Then
ls_message = fs_datetime(Now) & vbCrlf & vbCrlf & ps_message
go_wsh.PopUp ls_message, pl_seconds, gs_script_title, ci_popup_info
End If
End If
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 = ""
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 will now stop..."
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_error, ls_message )
Call s_quit( ls_message )
End Sub
Sub s_abort( ps_message )
Dim ls_message
On Error Resume Next
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_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_quit( ps_message )
Const cs_fac = "%s_quit, "
Dim ls_message
If Trim( ps_message ) = "" Then
ls_message = cs_fac & "Script completed at " & fs_datetime(Now) & "."
Else
ls_message = ps_message & " Script completed at " & fs_datetime(Now) &
"."
End If
On Error Resume Next
Call s_msgbox( ls_message )
WScript.Quit
End Sub
Sub s_pause()
On Error Resume Next
Call s_msgbox( "Script is paused, hit OK to continue..." )
End Sub
Sub s_msgbox( ps_message )
On Error Resume Next
If gb_echo Then
WScript.Echo ps_message
Else
Call s_popup( 30, ps_message )
End If
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
'*************************************************************
'************************ 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 fb_regkey_exists( ps_key )
Dim ls_test
On Error Resume Next
ls_test = go_wsh.RegRead( ps_key )
If Err.Number <> 0 Then
fb_regkey_exists = False
Else
fb_regkey_exists = True
End If
On Error Goto 0
End Function
Function fs_regkey_read( ps_key )
Const cs_fac = "%fs_regkey_read, "
Dim ls_value
On Error Resume Next
ls_value = go_wsh.RegRead( ps_key )
If Err.Number <> 0 Then
Call s_error( cs_fac & "Failed to read registry key `" & ps_key & "`." )
End If
On Error Goto 0
fs_regkey_read = ls_value
End Function
Sub s_regkey_write( ps_key, ps_value )
Const cs_fac = "%s_regkey_write, "
On Error Resume Next
go_wsh.RegWrite ps_key, ps_value
If Err.Number <> 0 Then
Call s_error( cs_fac & "Failed to write registry key `" & ps_key & "`
with a value of `" & ps_value & "`." )
End If
On Error Goto 0
End Sub
Sub s_regkey_delete( ps_key )
Const cs_fac = "%s_regkey_delete, "
On Error Resume Next
go_wsh.RegDelete ps_key
If Err.Number <> 0 Then
Call s_error( cs_fac & "Failed to delete registry key `" & ps_key &
"`." )
End If
On Error Goto 0
End Sub
Function fs_left( ps_text, pl_len )
Const cs_fac = "%fs_left, "
If Len( ps_text ) > pl_len Then
fs_left = ps_text
Else
fs_left = Left( ps_text & Space( pl_len ), pl_len )
End If
End Function
Function fs_right( ps_text, pl_len )
Const cs_fac = "%fs_right, "
If Len( ps_text ) > pl_len Then
fs_right = ps_text
Else
fs_right = Right( Space( pl_len ) & ps_text, pl_len )
End If
End Function
Function fd_written( ps_dt )
Const cs_fac = "%fd_written, "
Dim ls_dt, ls_date, ls_time
Dim ld_dt, ld_date, ld_time
fd_written = Now
ls_dt = Mid( ps_dt, 1, 14 )
If Len( ls_dt ) <> 14 Then Exit Function
ls_date = Mid( ls_dt, 1, 8 )
If (ls_date<"19000101") Or (ls_date>"29991231") Then Exit Function
ls_time = Mid( ls_dt, 9, 6 )
If (ls_time<"000000") Or (ls_time>"235959") Then Exit Function
ld_date = DateSerial( Mid(ls_date,1,4), Mid(ls_date,5,2),
Mid(ls_date,7,2) )
ld_time = TimeSerial( Mid(ls_time,1,2), Mid(ls_time,3,2),
Mid(ls_time,5,2) )
ld_dt = ld_date + ld_time
fd_written = ld_dt
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 VarType( pd_datetime ) = vbDate Then
ld_datetime = pd_datetime
Else
ld_datetime = Now
End If
ls_yyyy = fs_format( 4, DatePart( "yyyy", ld_datetime ) )
ls_mm = fs_format( 2, DatePart( "m", ld_datetime ) )
ls_dd = fs_format( 2, DatePart( "d", ld_datetime ) )
ls_hh = fs_format( 2, DatePart( "h", ld_datetime ) )
ls_nn = fs_format( 2, DatePart( "n", ld_datetime ) )
ls_ss = fs_format( 2, DatePart( "s", ld_datetime ) )
ls_result = "" & ls_yyyy & "-" & ls_mm & "-" & ls_dd & "-" & ls_hh & "-" &
ls_nn & "-" & ls_ss
fs_time_stamp = ls_result
End Function
Function fs_format( pl_digits, pl_number )
Const cs_fac = "%fs_format, "
Dim ls_result
ls_result = String( pl_digits, "0" ) & CStr( pl_number )
ls_result = Right( ls_result, pl_digits )
fs_format = 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_hhmm, "
Dim ld_dt
ld_dt = Now
fs_hhmmss = fs_format( 2, DatePart( "h", ld_dt ) ) & ":" & fs_format( 2,
DatePart( "n", ld_dt ) ) & ":" & fs_format( 2, DatePart( "s", ld_dt ) )
End Function
Function fs_duration( pd_start, pd_end )
Const cs_fac = "%fs_duration, "
Dim ll_diff, ll_dddd, ll_hh, ll_mm, ll_ss, ls_duration
ll_diff = DateDiff( "s", pd_start, pd_end )
ll_ss = ll_diff - ( ( ll_diff \ 60 ) * 60 )
ll_diff = ll_diff \ 60
ll_mm = ll_diff - ( ( ll_diff \ 60 ) * 60 )
ll_diff = ll_diff \ 60
ll_hh = ll_diff - ( ( ll_diff \ 24 ) * 24 )
ll_diff = ll_diff \ 24
ll_dddd = ll_diff
ls_duration = ""
ls_duration = ls_duration & fs_right( ll_dddd, 4 ) & " "
ls_duration = ls_duration & fs_format( 2, ll_hh ) & ":"
ls_duration = ls_duration & fs_format( 2, ll_mm ) & ":"
ls_duration = ls_duration & fs_format( 2, ll_ss )
fs_duration = ls_duration
End Function
Function fl_input_number( ps_prompt, pl_default, pl_min, pl_max )
Const cs_fac = "%fl_input_number, "
Dim ls_input, ll_input
fl_input_number = pl_default
Do
ls_input = LCase( Trim( InputBox( ps_prompt & " (" & pl_min & " to " &
pl_max & ").", gs_script_title, pl_default ) ) )
Select Case ls_input
Case ""
Exit Function
Case "quit"
Exit Function
Case "exit"
Exit Function
Case Else
If Not IsNumeric( ls_input ) Then
ls_input = ""
Call s_msgbox( "Please enter a number in range `" & pl_min & "` to
`" & pl_max & "`. Try again." )
Else
ll_input = CLng( ls_input )
If ( ll_input < pl_min ) Or ( ll_input > pl_max ) Then
ls_input = ""
Call s_msgbox( "Please enter a number in range `" & pl_min & "` to
`" & pl_max & "`. Try again." )
End If
End If
End Select
Loop Until ls_input <> ""
fl_input_number = ll_input
End Function
Function fs_input_computer()
Const cs_fac = "%fs_input_computer, "
Dim ls_default, ls_computer
If fb_regkey_exists( cs_regkey_computer ) Then
ls_default = LCase( fs_regkey_read( cs_regkey_computer ) )
Else
ls_default = LCase( go_net.ComputerName )
End If
Do
ls_computer = LCase( Trim( InputBox( "Please enter a computer name to
extract the event log from...", gs_script_title, ls_default ) ) )
If ls_computer = "exit" Then Call s_quit("")
Loop Until ls_computer <> ""
Call s_regkey_write( cs_regkey_computer, ls_computer )
fs_input_computer = ls_computer
End Function
"Ayth" <darrin.henshaw@xxxxxxxxx> wrote in message
news:1177520458.290542.85270@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Hello,
I have a script that among other things queries the System and
Application Log on a remote computer for Error events within the pas 8
days, then writes the Category, Event Code, Time Written and Message
to a text file, that is formatted for HTML code with tables. My
problem is the output file gets quite long, what I need to do is toss
the entire contents of the query to an array, then pull out how many
times each event occurs, and write the number of occurences along with
a sample of the event. I've always had problems with arrays, and I'm
not sure how to extract the data I need. Here is my script at the
moment:
g_strHostFile = "C:\ChecklistScript\Misc\tmpSrvAvail.txt"
Set objFse = CreateObject("Scripting.FileSystemObject")
Set objTextStream = objFse.OpenTextFile(g_strHostFile, FOR_READING)
Const CONVERT_TO_LOCAL_TIME = True
Set dtmStartDate = CreateObject("WbemScripting.SWbemDateTime")
DateToCheck = CDate(Date())
dtmStartDate.SetVarDate DateToCheck - 8, CONVERT_TO_LOCAL_TIME
objFinalLog.Write strHeader4 & strBold & "Error Events from System
Log" & strEndBold & strEndTD _
& strEndTR
objFinalLog.Write vbCrLf
Do Until objTextStream.AtEndOfStream
g_strComputer = objTextStream.ReadLine
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & g_strComputer & "\root
\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery ("Select * From
Win32_NTLogEvent Where _
& LogFile = 'System' AND TimeWritten >= '" & dtmStartDate & "'
AND EventType = 1")
'If no error is returned, a small line is inputted telling the tech
where these entries are coming from.
' If Err = 0 Then
objFinalLog.Write strHeader3 & g_strComputer & strEndTD & strEndTR
objFinalLog.Write vbCrLf
objFinalLog.Write strTR & strTH & "Category" & strEndTH & strTH &
"Event Code" & strEndTH & strTH & "Date" & strEndTH & strTH &
"Message" & strEndTH & strEndTR
objFinalLog.Write vbCrLf
' End If
For Each objEvent in colLoggedEvents
objFinalLog.Write strTR & strTD & objEvent.Category & strEndTD & strTD
& objEvent.EventCode _
& strEndTD & strTD & objEvent.TimeWritten & strEndTD & strTD &
objEvent.Message
End If
Next
Loop
objTextStream.Close
Can someone point me in the right direction? Thanks.
D
.
- References:
- Event Log Query
- From: Ayth
- Event Log Query
- Prev by Date: Re: Check folder permissions
- Next by Date: Re: Accessing Task Manager programmatically using VBScript
- Previous by thread: RE: Event Log Query
- Next by thread: Re: Event Log Query
- Index(es):
Relevant Pages
|
Loading
