Option Explicit
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim objDictionary, objFSO, wshShell, wshNetwork
Dim scriptBaseName, scriptPath, scriptLogPath
Dim ipAddress, macAddress, item, messageType, message
On Error Resume Next
Set objDictionary = NewDictionary
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set wshShell = CreateObject("Wscript.Shell")
Set wshNetwork = CreateObject("Wscript.Network")
scriptBaseName = objFSO.GetBaseName(Wscript.ScriptFullName)
scriptPath = objFSO.GetFile(Wscript.ScriptFullName).ParentFolder.Path
scriptLogPath = scriptPath & "\" & IsoDateString(Now)
If Err.Number <> 0 Then
Wscript.Quit
End If
On Error Goto 0
'----------------------------------------------------------------------------------------------------------------------------
'Main Processing Section
'----------------------------------------------------------------------------------------------------------------------------
On Error Resume Next
PromptScriptStart
ProcessScript
If Err.Number <> 0 Then
MsgBox BuildError("Processing Script"), vbCritical, scriptBaseName
Wscript.Quit
End If
PromptScriptEnd
On Error Goto 0
'----------------------------------------------------------------------------------------------------------------------------
'Functions Processing Section
'----------------------------------------------------------------------------------------------------------------------------
'Name : ProcessScript -> Primary Function that controls all other script processing.
'Parameters : None ->
'Return : None ->
'----------------------------------------------------------------------------------------------------------------------------
Function ProcessScript
Dim hostName, logName, startDateTime, endDateTime
Dim events, eventNumbers, i
hostName = wshNetwork.ComputerName
logName = "Security"
eventNumbers = Array("672")
startDateTime = DateAdd("n", -120, Now)
'-------------------------------------------------------------------------------------------------------------------------
'Query the event log for the eventID's within the specified event log name and date range.
'-------------------------------------------------------------------------------------------------------------------------
If Not QueryEventLog(events, hostName, logName, eventNumbers, startDateTime) Then
Exit Function
End If
'-------------------------------------------------------------------------------------------------------------------------
'Log the scripts results to the scripts
'-------------------------------------------------------------------------------------------------------------------------
For i = 0 To UBound(events)
LogMessage events(i)
Next
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : QueryEventLog -> Primary Function that controls all other script processing.
'Parameters : results -> Input/Output : Variable assigned to an array of results from querying the event log.
' : hostName -> String containing the hostName of the system to query the event log on.
' : logName -> String containing the name of the Event Log to query on the system.
' : eventNumbers -> Array containing the EventID's (eventCode) to search for within the event log.
' : startDateTime -> Date\Time containing the date to finish searching at.
' : minutes -> Integer containing the number of minutes to subtract from the startDate to begin the search.
'Return : QueryEventLog -> Returns True if the event log was successfully queried otherwise returns False.
'----------------------------------------------------------------------------------------------------------------------------
Function QueryEventLog(results, hostName, logName, eventNumbers, startDateTime)
Dim wmiDateTime, wmi, query, eventItems, eventItem
Dim timeWritten, eventDate, eventTime, description
Dim eventsDict, eventInfo, errorCount, i
QueryEventLog = False
errorCount = 0
If Not IsArray(eventNumbers) Then
eventNumbers = Array(eventNumbers)
End If
'-------------------------------------------------------------------------------------------------------------------------
'Construct part of the WMI Query to account for searching multiple eventID's
'-------------------------------------------------------------------------------------------------------------------------
query = "Select * from Win32_NTLogEvent Where Logfile = " & SQ(logName) & " And (EventCode = "
For i = 0 To UBound(eventNumbers)
query = query & SQ(eventNumbers(i)) & " Or EventCode = "
Next
On Error Resume Next
Set eventsDict = NewDictionary
If Err.Number <> 0 Then
LogError "Creating Dictionary Object"
Exit Function
End If
Set wmi = GetObject("winmgmts:{impersonationLevel=impersonate,(Security)}!\\" & hostName & "\root\cimv2")
If Err.Number <> 0 Then
LogError "Creating WMI Object to connect to " & DQ(hostName)
Exit Function
End If
'----------------------------------------------------------------------------------------------------------------------
'Create the "SWbemDateTime" Object for converting WMI Date formats. Supported in Windows Server 2003 & Windows XP.
'----------------------------------------------------------------------------------------------------------------------
Set wmiDateTime = CreateObject("WbemScripting.SWbemDateTime")
If Err.Number <> 0 Then
LogError "Creating " & DQ("WbemScripting.SWbemDateTime") & " object"
Exit Function
End If
'----------------------------------------------------------------------------------------------------------------------
'Build the WQL query and execute it.
'----------------------------------------------------------------------------------------------------------------------
wmiDateTime.SetVarDate startDateTime, True
query = Left(query, InStrRev(query, "'")) & ") And (TimeWritten >= " & SQ(wmiDateTime.Value) & ")"
Set eventItems = wmi.ExecQuery(query)
If Err.Number <> 0 Then
LogError "Executing WMI Query " & DQ(query)
Exit Function
End If
'----------------------------------------------------------------------------------------------------------------------
'Convert the property values of Each event found to a comma seperated string and add it to the dictionary.
'----------------------------------------------------------------------------------------------------------------------
For Each eventItem In eventItems
Do
timeWritten = ""
eventDate = ""
eventTime = ""
eventInfo = ""
timeWritten = ConvertWMIDateTime(eventItem.TimeWritten)
eventDate = FormatDateTime(timeWritten, vbShortDate)
eventTime = FormatDateTime(timeWritten, vbLongTime)
eventInfo = eventDate & ","
eventInfo = eventInfo & eventTime & ","
eventInfo = eventInfo & eventItem.SourceName & ","
eventInfo = eventInfo & eventItem.Type & ","
eventInfo = eventInfo & eventItem.Category & ","
eventInfo = eventInfo & eventItem.EventCode & ","
eventInfo = eventInfo & eventItem.User & ","
eventInfo = eventInfo & eventItem.ComputerName & ","
description = eventItem.Message
'------------------------------------------------------------------------------------------------------------------------
'Ensure the event description is not blank.
'------------------------------------------------------------------------------------------------------------------------
If IsNull(description) Then
description = "The event description cannot be found."
End If
description = Replace(description, vbCrLf, " ")
eventInfo = eventInfo & description
'------------------------------------------------------------------------------------------------------------------------
'Check if any errors occurred enumerating the event Information
'------------------------------------------------------------------------------------------------------------------------
If Err.Number <> 0 Then
LogError "Enumerating Event Properties from the " & DQ(logName) & " event log on " & DQ(hostName)
errorCount = errorCount + 1
Err.Clear
Exit Do
End If
'------------------------------------------------------------------------------------------------------------------------
'Remove all Tabs and spaces.
'------------------------------------------------------------------------------------------------------------------------
eventInfo = Trim(Replace(eventInfo, vbTab, " "))
Do While InStr(1, eventInfo, " ", vbTextCompare) <> 0
eventInfo = Replace(eventInfo, " ", " ")
Loop
'------------------------------------------------------------------------------------------------------------------------
'Add the Event Information to the Dictionary object if it doesn't exist.
'------------------------------------------------------------------------------------------------------------------------
If Not eventsDict.Exists(eventInfo) Then
eventsDict(eventsDict.Count) = eventInfo
End If
Loop Until True
Next
On Error Goto 0
If errorCount <> 0 Then
Exit Function
End If
results = eventsDict.Items
QueryEventLog = True
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : ConvertWMIDateTime -> Converts a WMI Date Time String into a String that can be formatted as a valid Date Time.
'Parameters : wmiDateTimeString -> String containing a WMI Date Time String.
'Return : ConvertWMIDateTime -> Returns a valid Date Time String otherwise returns a Blank String.
'----------------------------------------------------------------------------------------------------------------------------
Function ConvertWMIDateTime(wmiDateTimeString)
Dim integerValues, i
'-------------------------------------------------------------------------------------------------------------------------
'Ensure the wmiDateTimeString contains a "+" or "-" character. If it doesn't it is not a valid WMI date time so exit.
'-------------------------------------------------------------------------------------------------------------------------
If InStr(1, wmiDateTimeString, "+", vbTextCompare) = 0 And _
InStr(1, wmiDateTimeString, "-", vbTextCompare) = 0 Then
ConvertWMIDateTime = ""
Exit Function
End If
'-------------------------------------------------------------------------------------------------------------------------
'Replace any "." or "+" or "-" characters in the wmiDateTimeString and check each character is a valid integer.
'-------------------------------------------------------------------------------------------------------------------------
integerValues = Replace(Replace(Replace(wmiDateTimeString, ".", ""), "+", ""), "-", "")
For i = 1 To Len(integerValues)
If Not IsNumeric(Mid(integerValues, i, 1)) Then
ConvertWMIDateTime = ""
Exit Function
End If
Next
'-------------------------------------------------------------------------------------------------------------------------
'Convert the WMI Date Time string to a String that can be formatted as a valid Date Time value.
'-------------------------------------------------------------------------------------------------------------------------
ConvertWMIDateTime = CDate(Mid(wmiDateTimeString, 5, 2) & "/" & _
Mid(wmiDateTimeString, 7, 2) & "/" & Left(wmiDateTimeString, 4) & " " & _
Mid(wmiDateTimeString, 9, 2) & ":" & _
Mid(wmiDateTimeString, 11, 2) & ":" & _
Mid(wmiDateTimeString, 13, 2))
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : NewDictionary -> Creates a new dictionary object.
'Parameters : None ->
'Return : NewDictionary -> Returns a dictionary object.
'----------------------------------------------------------------------------------------------------------------------------
Function NewDictionary
Dim dict
Set dict = CreateObject("scripting.Dictionary")
dict.CompareMode = vbTextCompare
Set NewDictionary = dict
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : SQ -> Places single quotes around a string
'Parameters : stringValue -> String containing the value to place single quotes around
'Return : SQ -> Returns a single quoted string
'----------------------------------------------------------------------------------------------------------------------------
Function SQ(ByVal stringValue)
If VarType(stringValue) = vbString Then
SQ = "'" & stringValue & "'"
End If
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : DQ -> Place double quotes around a string and replace double quotes
' : -> within the string with pairs of double quotes.
'Parameters : stringValue -> String value to be double quoted
'Return : DQ -> Double quoted string.
'----------------------------------------------------------------------------------------------------------------------------
Function DQ (ByVal stringValue)
If stringValue <> "" Then
DQ = """" & Replace (stringValue, """", """""") & """"
Else
DQ = """"""
End If
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : IsoDateTimeString -> Generate an ISO date and time string from a date/time value.
'Parameters : dateValue -> Input date/time value.
'Return : IsoDateTimeString -> Date and time parts of the input value in "yyyy-mm-dd hh:mm:ss" format.
'----------------------------------------------------------------------------------------------------------------------------
Function IsoDateTimeString(dateValue)
IsoDateTimeString = IsoDateString (dateValue) & " " & IsoTimeString (dateValue)
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : IsoDateString -> Generate an ISO date string from a date/time value.
'Parameters : dateValue -> Input date/time value.
'Return : IsoDateString -> Date part of the input value in "yyyy-mm-dd" format.
'----------------------------------------------------------------------------------------------------------------------------
Function IsoDateString(dateValue)
If IsDate(dateValue) Then
IsoDateString = Right ("000" & Year (dateValue), 4) & "-" & _
Right ( "0" & Month (dateValue), 2) & "-" & _
Right ( "0" & Day (dateValue), 2)
Else
IsoDateString = "0000-00-00"
End If
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : IsoTimeString -> Generate an ISO time string from a date/time value.
'Parameters : dateValue -> Input date/time value.
'Return : IsoTimeString -> Time part of the input value in "hh:mm:ss" format.
'----------------------------------------------------------------------------------------------------------------------------
Function IsoTimeString(dateValue)
If IsDate(dateValue) Then
IsoTimeString = Right ("0" & Hour (dateValue), 2) & ":" & _
Right ("0" & Minute (dateValue), 2) & ":" & _
Right ("0" & Second (dateValue), 2)
Else
IsoTimeString = "00:00:00"
End If
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : LogMessage -> Writes a message to a log file.
'Parameters : logPath -> String containing the full folder path and file name of the Log file without with file extension.
' : message -> String containing the message to include in the log message.
'Return : None ->
'----------------------------------------------------------------------------------------------------------------------------
Function LogMessage(message)
If Not LogToCentralFile(scriptLogPath & ".log", IsoDateTimeString(Now) & "," & message) Then
Exit Function
End If
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : LogError -> Writes an error message to a log file.
'Parameters : logPath -> String containing the full folder path and file name of the Log file without with file extension.
' : message -> String containing a description of the event that caused the error to occur.
'Return : None ->
'----------------------------------------------------------------------------------------------------------------------------
Function LogError(message)
If Not LogToCentralFile(scriptLogPath & ".err", IsoDateTimeString(Now) & "," & BuildError(message)) Then
Exit Function
End If
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : BuildError -> Builds a string of information relating to the error object.
'Parameters: message -> String containnig the message that relates to the process that caused the error.
'Return : BuildError -> Returns a string relating to error object.
'----------------------------------------------------------------------------------------------------------------------------
Function BuildError(message)
BuildError = "Error " & Err.Number & " (Hex " & Hex(Err.Number) & ") " & message & ". " & Err.Description
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : LogToCentralFile -> Attempts to Appends information to a central file.
'Parameters : logSpec -> Folder path, file name and extension of the central log file to append to.
' : message -> String to include in the central log file
'Return : LogToCentralFile -> Returns True if Successfull otherwise False.
'----------------------------------------------------------------------------------------------------------------------------
Function LogToCentralFile(logSpec, message)
Dim attempts, objLogFile
LogToCentralFile = False
'-------------------------------------------------------------------------------------------------------------------------
'Attempt to append to the central log file up to 10 times, as it may be locked by some other system.
'-------------------------------------------------------------------------------------------------------------------------
attempts = 0
Do
On Error Resume Next
Set objLogFile = objFSO.OpenTextFile(logSpec, ForAppending, True)
If Err.Number = 0 Then
objLogFile.WriteLine message
objLogFile.Close
LogToCentralFile = True
Exit Function
End If
On Error Goto 0
Randomize
Wscript.sleep 1000 + Rnd * 100
attempts = attempts + 1
Loop Until attempts >= 10
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : PromptScriptStart -> Prompt when script starts.
'Parameters : None
'Return : None
'----------------------------------------------------------------------------------------------------------------------------
Function PromptScriptStart
MsgBox "Now processing the " & DQ(Wscript.ScriptName) & " script.", vbInformation, scriptBaseName
End Function
'----------------------------------------------------------------------------------------------------------------------------
'Name : PromptScriptEnd -> Prompt when script has completed.
'Parameters : None
'Return : None
'----------------------------------------------------------------------------------------------------------------------------
Function PromptScriptEnd
MsgBox "The " & DQ(Wscript.ScriptName) & " script has completed successfully.", vbInformation, scriptBaseName
End Function
'----------------------------------------------------------------------------------------------------------------------------
Sunday, July 4, 2010
VBScript: Query Event Log
VBS Library
'On Error Resume Next
'============================ Constants ============================
DesktopFolder = CreateObject("Shell.Application").NameSpace(&H10&).Self.Path
StartupFolder = CreateObject("Shell.Application").NameSpace(&H7&).Self.Path
ProgramsFolder = CreateObject("Shell.Application").NameSpace(&H2&).Self.Path
StartMenuFolder = CreateObject("Shell.Application").NameSpace(&Hb&).Self.Path
AppPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")
LinkName = Replace(WScript.ScriptName,Right(WScript.ScriptName,3),"")&"lnk"
Title = "Kz(^.^)WinTools"
'=====================================================================
Dim Output : Output = ""
'TaskMan
'HPSystemHomePage
p
WScript.Quit
If IsStartup Then
If MsgBox("Do you want remove this Program from Startup?",vbYesNo,Title)=vbyes Then RemoveFromStartup
Else
If MsgBox("Do you want add this Program to Startup?",vbYesNo,Title)=vbyes Then AddToStartup
End If
Output = Output & UpTime
Output = Output & vbCrLf & ChkAuSvc
Output = Output & vbCrLf & DiskSpace
'Output = Output & vbCrLf & UnExpectedReboots
'Output = Output & vbCrLf & HPSystemHomePage
'Output = Output & vbCrLf & ReadSystemEvents
Notepad WriteToRandomFile(Output)
' =========================== Library ==============================
Function PadZero(n,l)
PadZero = Right(String(l,"0")&n,l)
End Function
Function z2(n)
z2 = PadZero(n,2)
End Function
Function z4(n)
z4 = PadZero(n,4)
End Function
Function DateTimeSerial(Seprator)
Dim t,a
t = Now
a = Year(t)
a = a & Seprator & z2(Month(t))
a = a & Seprator & z2(Day(t))
a = a & Seprator & z2(Hour(t))
a = a & Seprator & z2(Minute(t))
a = a & Seprator & z2(Second(t))
DateTimeSerial = a
End Function
Function dt
dt = DateTimeSerial("")
End Function
Function FromSecondsToHMS(TimeInSeconds)
THour = Int(TimeInSeconds / 3600)
TMins = Int(TimeInSeconds / 60) - (THour*60)
TSecs = TimeInSeconds - THour*3600 - TMins*60
FromSecondsToHMS = THour&" Hour(s) "&TMins&" Minute(s) "&TSecs&" Second(s)"
End Function
Function WriteToFile(sFileName,sText)
Dim FSO, TextFile
Set FSO = CreateObject("Scripting.FilesystemObject")
Set TextFile = FSO.CreateTextFile(sFileName)
TextFile.WriteLine(sText)
TextFile.Close
WriteToFile = FSO.GetAbsolutePathName(sFileName)
End Function
Function WriteToRandomFile(sText)
sFileName = "output"&dt&".txt"
WriteToRandomFile = WriteToFile(sFileName,sText)
End Function
Function SystemUpTime(strComputer)
If Trim(strComputer) = "" Then strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PerfFormattedData_PerfOS_System",,48)
For Each objItem in colItems
SystemUpTime = "System Up Time: " & FromSecondsToHMS(objItem.SystemUpTime)
Next
End Function
Function UpTime
UpTime = SystemUpTime(".")
End Function
Sub Notepad(sFileName)
Set shell = WScript.CreateObject("WScript.Shell")
shell.Run "Notepad " & sFileName
Set shell = Nothing
End Sub
Function CheckAutomaticServices(strComputer)
If Trim(strComputer) = "" Then strComputer = "."
AllAutoServiceRunning = True
Output=String(50,"-")
Output=Output&vbcrlf&" Automatic Service status "
Output=Output&vbcrlf&String(50,"-")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery _
("Select * from Win32_Service")
For Each objService in colListOfServices
if objService.StartMode = "Auto" and objService.State <> "Running" Then
If Output <> "" Then Output = Output & vbCrLf
Output = Output & objService.DisplayName & ":"&objService.StartMode&"="&objService.State
'WScript.Echo objService.SystemName & "," & objService.Name & ": Automatic Service Failed"
AllAutoServiceRunning = False
End if
Next
If AllAutoServiceRunning Then
CheckAutomaticServices = "All Automatic Services are Running"
Else
CheckAutomaticServices = Output
End If
End Function
Function ChkAuSvc
ChkAuSvc = CheckAutomaticServices(".")
End Function
Function StartAutomaticServices(strComputer)
If Trim(strComputer) = "" Then strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery _
("Select * from Win32_Service")
For Each objService in colListOfServices
If objService.StartMode = "Auto" and objService.State <> "Running" Then
WScript.Echo objService.Name & ":"&objService.StartMode&"="&objService.State
objService.StartService()
End if
Next
End Function
Sub SvcConsole
Set shell = WScript.CreateObject("WScript.Shell")
shell.Run "services.msc"
Set shell = Nothing
End Sub
Function HPSystemHomePage
Set shell = WScript.CreateObject("WScript.Shell")
shell.Run "iexplore http://127.0.0.1:2381/"
If MsgBox("Any hardware errors found?",vbYesNo,title) = vbNo Then
HPSystemHomePage = "No hardware errors"
Else
HPSystemHomePage = Trim(InputBox("Specify the hardware Error:",Title))
End If
End Function
Function DiskSpace
Const HARD_DISK = 3
Output=String(50,"-")
Output=Output&vbcrlf&" Disk Free Space Status "
Output=Output&vbcrlf&String(50,"-")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
If Output <> "" Then Output = Output & vbCrLf
Output = Output & objDisk.DeviceID & "=" & Int(objDisk.FreeSpace/objDisk.Size*100)&"% free"
Next
DiskSpace = Output
End Function
Sub AddToStartup
CreateShortCut(StartupFolder)
End Sub
Sub CreateShortCut(Path)
Set shell = CreateObject("WScript.shell")
Set Link = shell.CreateShortcut(Path&"\"&LinkName)
Link.WorkingDirectory = DesktopFolder
Link.TargetPath = WScript.ScriptFullName
Link.Save
End Sub
Function IsStartup
IsStartup = FileExists(StartupFolder&"\"&LinkName)
End Function
Function FileExists(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
FileExists = FSO.FileExists(FileName)
End Function
Sub RemoveFromStartup
CreateObject("Scripting.FileSystemObject").DeleteFile(StartupFolder&"\"&LinkName)
End Sub
Function ConvertWMIDateTime(wmiDateTimeString)
Dim integerValues, i
'-------------------------------------------------------------------------------------------------------------------------
'Ensure the wmiDateTimeString contains a "+" or "-" character. If it doesn't it is not a valid WMI date time so exit.
'-------------------------------------------------------------------------------------------------------------------------
If InStr(1, wmiDateTimeString, "+", vbTextCompare) = 0 And _
InStr(1, wmiDateTimeString, "-", vbTextCompare) = 0 Then
ConvertWMIDateTime = ""
Exit Function
End If
'-------------------------------------------------------------------------------------------------------------------------
'Replace any "." or "+" or "-" characters in the wmiDateTimeString and check each character is a valid integer.
'-------------------------------------------------------------------------------------------------------------------------
integerValues = Replace(Replace(Replace(wmiDateTimeString, ".", ""), "+", ""), "-", "")
For i = 1 To Len(integerValues)
If Not IsNumeric(Mid(integerValues, i, 1)) Then
ConvertWMIDateTime = ""
Exit Function
End If
Next
'-------------------------------------------------------------------------------------------------------------------------
'Convert the WMI Date Time string to a String that can be formatted as a valid Date Time value.
'-------------------------------------------------------------------------------------------------------------------------
ConvertWMIDateTime = CDate(Mid(wmiDateTimeString, 5, 2) & "/" & _
Mid(wmiDateTimeString, 7, 2) & "/" & Left(wmiDateTimeString, 4) & " " & _
Mid(wmiDateTimeString, 9, 2) & ":" & _
Mid(wmiDateTimeString, 11, 2) & ":" & _
Mid(wmiDateTimeString, 13, 2))
End Function
Function UnExpectedReboots
Output = ""
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery _
("Select * from Win32_NTLogEvent Where Logfile = 'System' and " _
& "EventCode = '6008'")
Message = Message + vbCrLf & String(50,"-")
Message = Message + vbCrLf & "There are "&colLoggedEvents.Count & " unexpected shutdown(s)"
Message = Message + vbCrLf & String(50,"-")
For Each objEvent in colLoggedEvents
Message = Message + vbCrLf
Message = Message & "Time:"&ConvertWMIDateTime(objEvent.TimeWritten)
Message = Message + vbTab&"Event:"&objEvent.EventCode
'Message = Message + vbTab + "Message: " & objEvent.Message
'Message2 = Message + vbCrLf + vbCrLf +"Do you want notedown this Error and read further?"
'Response = MsgBox(Message2,vbYesNoCancel)
'If Repsonse = vbYes Then Output = Output & vbCrLf & Message
'If Repsonse = vbCancel Then Exit For
Next
UnExpectedReboots = Message
End Function
Function ReadSystemEvents
If MsgBox("Do you want process system event log?",vbYesNo,title) = vbno Then Exit Function
strComputer = "."
Output = ""
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery _
("Select * from Win32_NTLogEvent Where Logfile = 'System' and " _
& "Type = 'Error'")
Output = Output & vbCrLf &String(50,"-")
Output = Output & vbCrLf &"System Event log has " & colLoggedEvents.Count & " errors"
'Output = Output & vbCrLf &String(50,"-")
Message2 = "System Event log has errors: " & colLoggedEvents.Count & vbcrlf & vbcrlf & "Do you want to Read Errors?"
If MsgBox(Message2 ,vbYesNo,title)=vbYes Then
For Each objEvent in colLoggedEvents
Message = ""
'Message = Message + vbCrLf + "Category: " & objEvent.Category
'Message = Message + vbCrLf + "Computer Name: " & objEvent.ComputerName
Message = Message + vbCrLf + "Event ID :" & objEvent.EventCode
Message = Message + vbTab + "Time :" & ConvertWMIDateTime(objEvent.TimeWritten)
Message = Message + vbCrLf + "Source : " & objEvent.SourceName
Message = Message + vbCrLf + "Message: " & objEvent.Message
'Message = Message + vbCrLf + "Record Number: " & objEvent.RecordNumber
'Message = Message + vbCrLf + "Event Type: " & objEvent.Type
'Message = Message + vbCrLf + "User: " & objEvent.User
Message2 = Message + vbCrLf + vbCrLf +"Do you want notedown this error and read further?"
Response = MsgBox(Message2,vbYesNoCancel,title)
If Response = vbYes Then
Output = Output & vbCrLf &String(50,"-")
Output = Output & vbCrLf & Message
End If
If Response = vbCancel Then Exit For
Next
End If
ReadSystemEvents = Output
End Function
Sub CmdHere
Set objShell = CreateObject("WScript.Shell")
objShell.RegWrite "HKCR\Folder\Shell\MenuText\Command\", _
"cmd.exe /k cd " & chr(34) & "%1" & chr(34)
objShell.RegWrite "HKCR\Folder\Shell\MenuText\", "Command Prompt Here"
End Sub
Sub TaskMan
CreateObject("WScript.Shell").run "TaskMgr"
End Sub
Function ProcessorStatus
If Trim(strComputer) = "" Then strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PerfFormattedData_PerfOS_System",,48)
For Each objItem in colItems
SystemUpTime = "System Up Time: " & FromSecondsToHMS(objItem.SystemUpTime)
Next
End Function
Sub p
Set objService = GetObject( _
"Winmgmts:{impersonationlevel=impersonate}!\Root\Cimv2")
For i = 1 to 8
Set objInstance1 = objService.Get( _
"Win32_PerfRawData_PerfOS_Processor.Name='_Total'")
N1 = objInstance1.PercentProcessorTime
D1 = objInstance1.TimeStamp_Sys100NS
'Sleep for two seconds = 2000 ms
WScript.Sleep(2000)
Set perf_instance2 = objService.Get( _
"Win32_PerfRawData_PerfOS_Processor.Name='_Total'")
N2 = perf_instance2.PercentProcessorTime
D2 = perf_instance2.TimeStamp_Sys100NS
' Look up the CounterType qualifier for the PercentProcessorTime
' and obtain the formula to calculate the meaningful data.
' CounterType - PERF_100NSEC_TIMER_INV
' Formula - (1- ((N2 - N1) / (D2 - D1))) x 100
PercentProcessorTime = (1 - ((N2 - N1)/(D2-D1)))*100
WScript.Echo "% Processor Time=" , Round(PercentProcessorTime,2)
Next
End Sub
'============================ Constants ============================
DesktopFolder = CreateObject("Shell.Application").NameSpace(&H10&).Self.Path
StartupFolder = CreateObject("Shell.Application").NameSpace(&H7&).Self.Path
ProgramsFolder = CreateObject("Shell.Application").NameSpace(&H2&).Self.Path
StartMenuFolder = CreateObject("Shell.Application").NameSpace(&Hb&).Self.Path
AppPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")
LinkName = Replace(WScript.ScriptName,Right(WScript.ScriptName,3),"")&"lnk"
Title = "Kz(^.^)WinTools"
'=====================================================================
Dim Output : Output = ""
'TaskMan
'HPSystemHomePage
p
WScript.Quit
If IsStartup Then
If MsgBox("Do you want remove this Program from Startup?",vbYesNo,Title)=vbyes Then RemoveFromStartup
Else
If MsgBox("Do you want add this Program to Startup?",vbYesNo,Title)=vbyes Then AddToStartup
End If
Output = Output & UpTime
Output = Output & vbCrLf & ChkAuSvc
Output = Output & vbCrLf & DiskSpace
'Output = Output & vbCrLf & UnExpectedReboots
'Output = Output & vbCrLf & HPSystemHomePage
'Output = Output & vbCrLf & ReadSystemEvents
Notepad WriteToRandomFile(Output)
' =========================== Library ==============================
Function PadZero(n,l)
PadZero = Right(String(l,"0")&n,l)
End Function
Function z2(n)
z2 = PadZero(n,2)
End Function
Function z4(n)
z4 = PadZero(n,4)
End Function
Function DateTimeSerial(Seprator)
Dim t,a
t = Now
a = Year(t)
a = a & Seprator & z2(Month(t))
a = a & Seprator & z2(Day(t))
a = a & Seprator & z2(Hour(t))
a = a & Seprator & z2(Minute(t))
a = a & Seprator & z2(Second(t))
DateTimeSerial = a
End Function
Function dt
dt = DateTimeSerial("")
End Function
Function FromSecondsToHMS(TimeInSeconds)
THour = Int(TimeInSeconds / 3600)
TMins = Int(TimeInSeconds / 60) - (THour*60)
TSecs = TimeInSeconds - THour*3600 - TMins*60
FromSecondsToHMS = THour&" Hour(s) "&TMins&" Minute(s) "&TSecs&" Second(s)"
End Function
Function WriteToFile(sFileName,sText)
Dim FSO, TextFile
Set FSO = CreateObject("Scripting.FilesystemObject")
Set TextFile = FSO.CreateTextFile(sFileName)
TextFile.WriteLine(sText)
TextFile.Close
WriteToFile = FSO.GetAbsolutePathName(sFileName)
End Function
Function WriteToRandomFile(sText)
sFileName = "output"&dt&".txt"
WriteToRandomFile = WriteToFile(sFileName,sText)
End Function
Function SystemUpTime(strComputer)
If Trim(strComputer) = "" Then strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PerfFormattedData_PerfOS_System",,48)
For Each objItem in colItems
SystemUpTime = "System Up Time: " & FromSecondsToHMS(objItem.SystemUpTime)
Next
End Function
Function UpTime
UpTime = SystemUpTime(".")
End Function
Sub Notepad(sFileName)
Set shell = WScript.CreateObject("WScript.Shell")
shell.Run "Notepad " & sFileName
Set shell = Nothing
End Sub
Function CheckAutomaticServices(strComputer)
If Trim(strComputer) = "" Then strComputer = "."
AllAutoServiceRunning = True
Output=String(50,"-")
Output=Output&vbcrlf&" Automatic Service status "
Output=Output&vbcrlf&String(50,"-")
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery _
("Select * from Win32_Service")
For Each objService in colListOfServices
if objService.StartMode = "Auto" and objService.State <> "Running" Then
If Output <> "" Then Output = Output & vbCrLf
Output = Output & objService.DisplayName & ":"&objService.StartMode&"="&objService.State
'WScript.Echo objService.SystemName & "," & objService.Name & ": Automatic Service Failed"
AllAutoServiceRunning = False
End if
Next
If AllAutoServiceRunning Then
CheckAutomaticServices = "All Automatic Services are Running"
Else
CheckAutomaticServices = Output
End If
End Function
Function ChkAuSvc
ChkAuSvc = CheckAutomaticServices(".")
End Function
Function StartAutomaticServices(strComputer)
If Trim(strComputer) = "" Then strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colListOfServices = objWMIService.ExecQuery _
("Select * from Win32_Service")
For Each objService in colListOfServices
If objService.StartMode = "Auto" and objService.State <> "Running" Then
WScript.Echo objService.Name & ":"&objService.StartMode&"="&objService.State
objService.StartService()
End if
Next
End Function
Sub SvcConsole
Set shell = WScript.CreateObject("WScript.Shell")
shell.Run "services.msc"
Set shell = Nothing
End Sub
Function HPSystemHomePage
Set shell = WScript.CreateObject("WScript.Shell")
shell.Run "iexplore http://127.0.0.1:2381/"
If MsgBox("Any hardware errors found?",vbYesNo,title) = vbNo Then
HPSystemHomePage = "No hardware errors"
Else
HPSystemHomePage = Trim(InputBox("Specify the hardware Error:",Title))
End If
End Function
Function DiskSpace
Const HARD_DISK = 3
Output=String(50,"-")
Output=Output&vbcrlf&" Disk Free Space Status "
Output=Output&vbcrlf&String(50,"-")
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colDisks = objWMIService.ExecQuery _
("Select * from Win32_LogicalDisk Where DriveType = " & HARD_DISK & "")
For Each objDisk in colDisks
If Output <> "" Then Output = Output & vbCrLf
Output = Output & objDisk.DeviceID & "=" & Int(objDisk.FreeSpace/objDisk.Size*100)&"% free"
Next
DiskSpace = Output
End Function
Sub AddToStartup
CreateShortCut(StartupFolder)
End Sub
Sub CreateShortCut(Path)
Set shell = CreateObject("WScript.shell")
Set Link = shell.CreateShortcut(Path&"\"&LinkName)
Link.WorkingDirectory = DesktopFolder
Link.TargetPath = WScript.ScriptFullName
Link.Save
End Sub
Function IsStartup
IsStartup = FileExists(StartupFolder&"\"&LinkName)
End Function
Function FileExists(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
FileExists = FSO.FileExists(FileName)
End Function
Sub RemoveFromStartup
CreateObject("Scripting.FileSystemObject").DeleteFile(StartupFolder&"\"&LinkName)
End Sub
Function ConvertWMIDateTime(wmiDateTimeString)
Dim integerValues, i
'-------------------------------------------------------------------------------------------------------------------------
'Ensure the wmiDateTimeString contains a "+" or "-" character. If it doesn't it is not a valid WMI date time so exit.
'-------------------------------------------------------------------------------------------------------------------------
If InStr(1, wmiDateTimeString, "+", vbTextCompare) = 0 And _
InStr(1, wmiDateTimeString, "-", vbTextCompare) = 0 Then
ConvertWMIDateTime = ""
Exit Function
End If
'-------------------------------------------------------------------------------------------------------------------------
'Replace any "." or "+" or "-" characters in the wmiDateTimeString and check each character is a valid integer.
'-------------------------------------------------------------------------------------------------------------------------
integerValues = Replace(Replace(Replace(wmiDateTimeString, ".", ""), "+", ""), "-", "")
For i = 1 To Len(integerValues)
If Not IsNumeric(Mid(integerValues, i, 1)) Then
ConvertWMIDateTime = ""
Exit Function
End If
Next
'-------------------------------------------------------------------------------------------------------------------------
'Convert the WMI Date Time string to a String that can be formatted as a valid Date Time value.
'-------------------------------------------------------------------------------------------------------------------------
ConvertWMIDateTime = CDate(Mid(wmiDateTimeString, 5, 2) & "/" & _
Mid(wmiDateTimeString, 7, 2) & "/" & Left(wmiDateTimeString, 4) & " " & _
Mid(wmiDateTimeString, 9, 2) & ":" & _
Mid(wmiDateTimeString, 11, 2) & ":" & _
Mid(wmiDateTimeString, 13, 2))
End Function
Function UnExpectedReboots
Output = ""
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery _
("Select * from Win32_NTLogEvent Where Logfile = 'System' and " _
& "EventCode = '6008'")
Message = Message + vbCrLf & String(50,"-")
Message = Message + vbCrLf & "There are "&colLoggedEvents.Count & " unexpected shutdown(s)"
Message = Message + vbCrLf & String(50,"-")
For Each objEvent in colLoggedEvents
Message = Message + vbCrLf
Message = Message & "Time:"&ConvertWMIDateTime(objEvent.TimeWritten)
Message = Message + vbTab&"Event:"&objEvent.EventCode
'Message = Message + vbTab + "Message: " & objEvent.Message
'Message2 = Message + vbCrLf + vbCrLf +"Do you want notedown this Error and read further?"
'Response = MsgBox(Message2,vbYesNoCancel)
'If Repsonse = vbYes Then Output = Output & vbCrLf & Message
'If Repsonse = vbCancel Then Exit For
Next
UnExpectedReboots = Message
End Function
Function ReadSystemEvents
If MsgBox("Do you want process system event log?",vbYesNo,title) = vbno Then Exit Function
strComputer = "."
Output = ""
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colLoggedEvents = objWMIService.ExecQuery _
("Select * from Win32_NTLogEvent Where Logfile = 'System' and " _
& "Type = 'Error'")
Output = Output & vbCrLf &String(50,"-")
Output = Output & vbCrLf &"System Event log has " & colLoggedEvents.Count & " errors"
'Output = Output & vbCrLf &String(50,"-")
Message2 = "System Event log has errors: " & colLoggedEvents.Count & vbcrlf & vbcrlf & "Do you want to Read Errors?"
If MsgBox(Message2 ,vbYesNo,title)=vbYes Then
For Each objEvent in colLoggedEvents
Message = ""
'Message = Message + vbCrLf + "Category: " & objEvent.Category
'Message = Message + vbCrLf + "Computer Name: " & objEvent.ComputerName
Message = Message + vbCrLf + "Event ID :" & objEvent.EventCode
Message = Message + vbTab + "Time :" & ConvertWMIDateTime(objEvent.TimeWritten)
Message = Message + vbCrLf + "Source : " & objEvent.SourceName
Message = Message + vbCrLf + "Message: " & objEvent.Message
'Message = Message + vbCrLf + "Record Number: " & objEvent.RecordNumber
'Message = Message + vbCrLf + "Event Type: " & objEvent.Type
'Message = Message + vbCrLf + "User: " & objEvent.User
Message2 = Message + vbCrLf + vbCrLf +"Do you want notedown this error and read further?"
Response = MsgBox(Message2,vbYesNoCancel,title)
If Response = vbYes Then
Output = Output & vbCrLf &String(50,"-")
Output = Output & vbCrLf & Message
End If
If Response = vbCancel Then Exit For
Next
End If
ReadSystemEvents = Output
End Function
Sub CmdHere
Set objShell = CreateObject("WScript.Shell")
objShell.RegWrite "HKCR\Folder\Shell\MenuText\Command\", _
"cmd.exe /k cd " & chr(34) & "%1" & chr(34)
objShell.RegWrite "HKCR\Folder\Shell\MenuText\", "Command Prompt Here"
End Sub
Sub TaskMan
CreateObject("WScript.Shell").run "TaskMgr"
End Sub
Function ProcessorStatus
If Trim(strComputer) = "" Then strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_PerfFormattedData_PerfOS_System",,48)
For Each objItem in colItems
SystemUpTime = "System Up Time: " & FromSecondsToHMS(objItem.SystemUpTime)
Next
End Function
Sub p
Set objService = GetObject( _
"Winmgmts:{impersonationlevel=impersonate}!\Root\Cimv2")
For i = 1 to 8
Set objInstance1 = objService.Get( _
"Win32_PerfRawData_PerfOS_Processor.Name='_Total'")
N1 = objInstance1.PercentProcessorTime
D1 = objInstance1.TimeStamp_Sys100NS
'Sleep for two seconds = 2000 ms
WScript.Sleep(2000)
Set perf_instance2 = objService.Get( _
"Win32_PerfRawData_PerfOS_Processor.Name='_Total'")
N2 = perf_instance2.PercentProcessorTime
D2 = perf_instance2.TimeStamp_Sys100NS
' Look up the CounterType qualifier for the PercentProcessorTime
' and obtain the formula to calculate the meaningful data.
' CounterType - PERF_100NSEC_TIMER_INV
' Formula - (1- ((N2 - N1) / (D2 - D1))) x 100
PercentProcessorTime = (1 - ((N2 - N1)/(D2-D1)))*100
WScript.Echo "% Processor Time=" , Round(PercentProcessorTime,2)
Next
End Sub
Subscribe to:
Comments (Atom)
Subscribe To
Posts
All Comments