Search This Blog

Sunday, July 4, 2010

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

No comments:

Post a Comment

Followers