Option Explicit
Dim Obar
Set Obar = New ProgressBar
Obar.startbar "This is a test."
Wscript.Sleep (3000)
Obar.setline "So are this."
Wscript.Sleep (3000)
Obar.closebar
Class ProgressBar
Dim Obarcat, Sprogressbarhtafile, Sprogressbarrunfile, Sprogressbarsleepfile, Sinitialtempbuild
Public Sub Startbar (smessagetodisplay)
Dim Sinitialtemp, I
Executeglobal "Dim Oshell, oFSO, oenv"
Set Oshell = CreateObject ("Wscript.Shell")
Set oFSO = CreateObject ("Scripting.FileSystemObject")
Set oenv = oshell.environment ("Process")
For i = 1 to 16
Sinitialtempbuild = sinitialtempbuild & Chr (Frand (97,122))
Next
Sinitialtemp = Ofso.getdrivename (oenv ("TEMP")) & "\" & Sinitialtempbuild & "\" & Ofso.getfilename ( Fgettempname)
Sprogressbarhtafile = Left (Sinitialtemp, (Len (Sinitialtemp)-4)) & ". HTA"
Sprogressbarrunfile = Left (Sprogressbarhtafile, Len (sprogressbarhtafile)-4) & ". Run"
Sprogressbarsleepfile = Left (Sprogressbarhtafile, Len (sprogressbarhtafile)-4) & "Sleep.vbs"
Set Obarcat = CreateObject ("Scripting.Dictionary")
Obarcat.add Obarcat.count, "Obarcat.add Obarcat.count, "Obarcat.add obarcat.count, "<title id=" & Chr (%) & "title" & Chr (+) & ">please wait</title>"
Obarcat.add Obarcat.count, "Obarcat.add Obarcat.count, "id=" & Chr (+) & "StatusBar" & Chr (+) & ""
Obarcat.add Obarcat.count, "Applicationname=" & Chr (+) & "StatusBar" & Chr (+) & ""
Obarcat.add Obarcat.count, "scroll=" & Chr (+) & "NO" & Chr (+) & ""
Obarcat.add Obarcat.count, "singleinstance=" & Chr (+) & "YES" & Chr (+) & ""
Obarcat.add Obarcat.count, "caption=" & Chr (+) & "NO" & Chr (+) & ""
Obarcat.add Obarcat.count, "border=" & Chr (+) & "NO" & Chr (+) & ""
Obarcat.add Obarcat.count, "borderstyle=" & Chr (+) & "NORMAL" & Chr (+) & ""
Obarcat.add Obarcat.count, "sysmenu=" & Chr (+) & "NO" & Chr (+) & ""
Obarcat.add Obarcat.count, "contextmenu=" & Chr (+) & "NO" & Chr (+) & ""
Obarcat.add Obarcat.count, "showintaskbar=" & Chr (+) & "NO" & Chr (+) & ""
Obarcat.add obarcat.count, "/>"
Obarcat.add obarcat.count, "<script language=" & Chr (+) & "VBScript" & Chr (+) & ">"
Obarcat.add obarcat.count, "Dim Oshell, ITimer1, ITimer2, Sstatusbarasciitext, SPID, Icid, sstatusmsg"
Obarcat.add obarcat.count, "Set Oshell = CreateObject (" & Chr (%) & "Wscript.Shell" & Chr (%) & ")"
Obarcat.add Obarcat.count, "SPID =" & Chr (10) & "" & Chr (+) & ": Icid ="
Obarcat.add obarcat.count, "Sub window_onload"
Obarcat.add obarcat.count, "Window.resizeto 320,250"
Obarcat.add Obarcat.count, "CreateObject (& CHR) &" Scripting.FileSystemObject "& Chr (+) &"). CreateTextFile ("& Chr) & Sprogressbarrunfile & Chr (+) &")
Obarcat.add Obarcat.count, "CreateObject (& CHR) &" Scripting.FileSystemObject "& Chr (+) &"). CreateTextFile ("& Chr) & Sprogressbarsleepfile & Chr (+) &")
Obarcat.add Obarcat.count, "CreateObject (& CHR) &" Scripting.FileSystemObject "& Chr (+) &"). OpenTextFile ("& Chr & Sprogressbarsleepfile & Chr () &", 2). WriteLine "& Chr (+) &" Wscript.Sleep (1000) "& Chr (+) &" "
Obarcat.add Obarcat.count, "iTimer1 = Window.setinterval (" & Chr (175) & "Do_refresh" & Chr () & ","
Obarcat.add Obarcat.count, "iTimer2 = Window.setinterval (" & Chr (500) & "Do_nothing" & Chr () & ","
Obarcat.add Obarcat.count, "End Sub"
Obarcat.add obarcat.count, "Sub do_nothing"
Obarcat.add Obarcat.count, "If CreateObject" ("& Chr () &" Scripting.FileSystemObject "& Chr (%) &"). FileExists ("& Chr (a) & Sprogressbarrunfile & Chr (+) &") Then "
Obarcat.add obarcat.count, "Dim owmiservice, CItems, Oitem"
Obarcat.add obarcat.count, "Set owmiservice = GetObject (" & Chr (%) & "Winmgmts:\\.\root\cimv2" & Chr (&AM) P ")"
Obarcat.add obarcat.count, "Set cItems = Owmiservice.execquery (" & Chr) & "Select Name, ExecutablePath, Comman Dline from Win32_Process where Name = ' Mshta.exe ' & Chr (+) & ")"
Obarcat.add Obarcat.count, "for each oitem in CItems"
Obarcat.add obarcat.count, "If oitem.commandline = document." Location.pathname Then "
Obarcat.add obarcat.count, "Oshell.appactivate oitem.handle"
Obarcat.add Obarcat.count, "End If"
Obarcat.add Obarcat.count, "Next"
Obarcat.add Obarcat.count, "Else"
Obarcat.add Obarcat.count, "CreateObject (& CHR) &" Scripting.FileSystemObject "& Chr (+) &"). DeleteFile "& Chr (+) & Sprogressbarsleepfile & Chr (+) &", True "
Obarcat.add Obarcat.count, "Window.clearinterval (ITimer1)"
Obarcat.add Obarcat.count, "Window.clearinterval (ITimer2)"
Obarcat.add Obarcat.count, "self." Close "
Obarcat.add Obarcat.count, "End If"
Obarcat.add Obarcat.count, "End Sub"
Obarcat.add obarcat.count, "Sub Do_refresh"
Obarcat.add obarcat.count, "Select Case Icid"
Obarcat.add Obarcat.count, "Case 10"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Ooooo" & Chr (+) & ": icid = 0"
Obarcat.add Obarcat.count, "Case 0"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Oooon" & Chr (+) & ": Icid = 1"
Obarcat.add Obarcat.count, "Case 1"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Ooono" & Chr (+) & ": Icid = 2"
Obarcat.add Obarcat.count, "Case 2"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Oonoo" & Chr (+) & ": Icid = 3"
Obarcat.add Obarcat.count, "Case 3"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Onooo" & Chr (+) & ": Icid = 4"
Obarcat.add Obarcat.count, "Case 4"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Noooo" & Chr (+) & ": Icid = 5"
Obarcat.add Obarcat.count, "Case 5"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Onooo" & Chr (+) & ": Icid = 6"
Obarcat.add Obarcat.count, "Case 6"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Oonoo" & Chr (+) & ": Icid = 7"
Obarcat.add Obarcat.count, "Case 7"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Ooono" & Chr (+) & ": Icid = 8"
Obarcat.add Obarcat.count, "Case 8"
Obarcat.add Obarcat.count, "Sstatusbarasciitext =" & Chr (a) & "Oooon" & Chr (+) & ": Icid = 1"
Obarcat.add Obarcat.count, "End Select"
Obarcat.add Obarcat.count, "stats.innerhtml = Sstatusbarasciitext"
Obarcat.add Obarcat.count, "on Error Resume Next"
Obarcat.add Obarcat.count, "Oshell.regread (" & Chr (+) & "Hklm\system\progressbar\msg" & Chr (+) & ")"
Obarcat.add Obarcat.count, "Iregerr = Err.Number"
Obarcat.add Obarcat.count, "on Error Goto 0"
Obarcat.add obarcat.count, "If iregerr = 0 Then"
Obarcat.add Obarcat.count, "sstatusmsg = Replace (Oshell.regread (" & Chr (%) & "Hklm\system\progressbar\msg" & Amp Chr & "), VbCrLf, & Chr (+) &" <br> "& Chr (+) &") "
Obarcat.add Obarcat.count, "Else"
Obarcat.add Obarcat.count, "sstatusmsg =" & Chr (+) & "" & Chr (+) & ""
Obarcat.add Obarcat.count, "End If"
Obarcat.add Obarcat.count, "mymsg.innerhtml = sstatusmsg"
Obarcat.add Obarcat.count, "End Sub"
Obarcat.add Obarcat.count, "</SCRIPT>"
Obarcat.add Obarcat.count, "<style>"
Obarcat.add Obarcat.count, "Body,td,a {font-family:arial;font-size:12px;text-decoration:none;color:black;}"
Obarcat.add Obarcat.count, "body {filter:progid:DXImageTransform.Microsoft.Gradient (gradienttype=0, startcolorstr= ' #9999FF ', endcolorstr= ' #FFFFFF ')} "
Obarcat.add obarcat.count, ". pix {width:1px; Height 1px;} "
Obarcat.add Obarcat.count, "</style>"
Obarcat.add Obarcat.count, "Obarcat.add Obarcat.count, "<body>"
Obarcat.add Obarcat.count, "<center>"
Obarcat.add obarcat.count, "<table width=" & Chr (+) & "275" & Chr (+) & ">"
Obarcat.add Obarcat.count, "<tr><td>"
Obarcat.add obarcat.count, "<fieldset><legend align=" & Chr (+) & "center" & Chr (+) & ">< b> please Patient </b></legend> "
Obarcat.add Obarcat.count, "<br><center>"
Obarcat.add obarcat.count, "<span id=" & Chr (+) & "Stats" & Chr (+) & "style=" & Chr (a) & "font-family:wingdings;font-weight:bold;font-size:20px" & Chr (+) & "></span>"
Obarcat.add Obarcat.count, "</center><br><br>"
Obarcat.add Obarcat.count, "</fieldset>"
Obarcat.add Obarcat.count, "</td></tr>"
Obarcat.add Obarcat.count, "</table>"
Obarcat.add obarcat.count, "<span id=" & Chr (+) & "Mymsg" & Chr (+) & "style=" & Chr (+) & font-family:ariel;font-size:12px "& Chr (a) &" ></span> "
Obarcat.add Obarcat.count, "</body>"
Obarcat.add Obarcat.count, "Subwritefile Sprogressbarhtafile, Join (OBARCAT.ITEMS,VBCRLF)
Oshell.regwrite "Hklm\system\progressbar\msg", Smessagetodisplay, "REG_SZ"
Oshell.run sprogressbarhtafile, 1, False
End Sub
Public Sub Closebar ()
Fkillfile Sprogressbarrunfile
Dim Sprogressbarhtafilekiller
Subkillregkey "Hklm\system\progressbar", "DELETE"
Sprogressbarhtafilekiller = Ofso.getdrivename (oenv ("TEMP")) & "\htakiller.vbs"
Subwritefile Sprogressbarhtafilekiller, "on Error Resume Next"
Subwritefile Sprogressbarhtafilekiller, "Wscript.Sleep (10000)"
Subwritefile Sprogressbarhtafilekiller, "Set oFSO = CreateObject (" "Scripting.FileSystemObject") "
Subwritefile Sprogressbarhtafilekiller, "Ofso.deletefile" & Chr (+) & Sprogressbarhtafile & Chr (+) & ", True "
Subwritefile Sprogressbarhtafilekiller, "Ofso.deletefolder" & Chr (A) & Ofso.getdrivename (oenv ("TEMP")) & "\" & Sinitialtempbuild & Chr (+) & "True"
Subwritefile Sprogressbarhtafilekiller, "Ofso.deletefile" & Chr (+) & Sprogressbarhtafilekiller & Chr (34) & Amp ", True"
Oshell.run "%comspec%/C cscript.exe" & Sprogressbarhtafilekiller, 0, False
End Sub
Public Sub Setline (sNewText)
Oshell.regwrite "Hklm\system\progressbar\msg", sNewText, "REG_SZ"
End Sub
Private Function Fgettempname ()
Dim ifilenamecharacters, Ihighestasciivalue, Ilowestasciivalue
Dim Icharasciivalue, Stmpfilename, Otempnamedic
Set Otempnamedic = CreateObject ("Scripting.Dictionary")
Ifilenamecharacters = 8
Ihighestasciivalue = 126
Ilowestasciivalue = 46
Stmpfilename = ""
Randomize
Todo
Icharasciivalue = Int ((ihighestasciivalue-ilowestasciivalue + 1) * Rnd) + ilowestasciivalue)
Select Case True
Case Icharasciivalue = 47
Case Icharasciivalue > Icharasciivalue < 95
Case Icharasciivalue = 96
Case Icharasciivalue > 122 and Icharasciivalue < 126
Case Else
Otempnamedic.add OTEMPNAMEDIC.COUNT,CHR (Icharasciivalue)
End Select
Loop while Otempnamedic.count < ifilenamecharacters
Fgettempname = oenv ("TEMP") & "\" & Join (Otempnamedic.items, "") & ". tmp"
Otempnamedic.removeall
End Function
Private Function fkillfile (Sfiletokill)
Dim IERR, SERR
Select Case True
Case INSTR (Sfiletokill, "*") <> 0
If ofso.folderexists (Ofso.getparentfoldername (Sfiletokill)) Then
On Error Resume Next
Ofso.deletefile Sfiletokill, True
IERR = Err.Number
SERR = Err.Description
On Error GoTo 0
If IERR = Then IERR = 0
End If
Case Ofso.fileexists (Sfiletokill)
On Error Resume Next
Ofso.deletefile Sfiletokill, True
IERR = Err.Number
SERR = Err.Description
On Error GoTo 0
End Select
Select Case IERR
Case 0
Fkillfile = 0
Case Else
Fkillfile = SERR
End Select
End Function
Private Function Frand (ilowerlimit,iupperlimit)
Executeglobal "Dim brandomized"
If brandomized <> True Then Randomize
brandomized = True
Frand = Int ((iupperlimit-ilowerlimit + 1) *rnd () + ilowerlimit)
End Function
Private Sub subwritefile (Sfiletowrite, Stexttowrite)
Dim Ofiletowrite
Subcreatefile Sfiletowrite
Set ofiletowrite = Ofso.opentextfile (sfiletowrite,8)
Ofiletowrite.writeline Stexttowrite
Ofiletowrite.close
End Sub
Private Sub subcreatefile (sfiletocreate)
Subcreatefolder Ofso.getparentfoldername (sfiletocreate)
If not ofso.fileexists (sfiletocreate) Then ofso.createtextfile (sfiletocreate)
End Sub
Private Sub Subcreatefolder (sfolderpathtocreate)
If Trim (sfolderpathtocreate) <> "" Then
If ofso.folderexists (sfolderpathtocreate) Then
Exit Sub
Else
Subcreatefolder (Ofso.getparentfoldername (sfolderpathtocreate))
End If
Ofso.createfolder (Sfolderpathtocreate)
End If
End Sub
Private Sub Subkillregkey (ByVal skeytodelete, sdeleteconfirmation)
Dim Asubkeys, Ssubkey, Isubkeycheck, Skeytokill, ielement
Dim akeypathsubsection, Hkeyroot, Owmireg, Skeyroot
Const HKEY_CLASSES_ROOT = &h80000000
Const HKEY_CURRENT_USER = &h80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &h80000003
Const hkey_current_config = &h80000005
If sdeleteconfirmation <> "DELETE" Then Exit Sub
Akeypathsubsection = Split (Skeytodelete, "\")
Select Case UCase (akeypathsubsection (0))
Case "HKEY_CLASSES_ROOT", "HKCR"
Hkeyroot = HKEY_CLASSES_ROOT
Skeyroot = "HKEY_CLASSES_ROOT"
Case "HKEY_CURRENT_USER", "HKCU"
Hkeyroot = HKEY_CURRENT_USER
Skeyroot = "HKEY_CURRENT_USER"
Case "HKEY_LOCAL_MACHINE", "HKLM"
Hkeyroot = HKEY_LOCAL_MACHINE
Skeyroot = "HKEY_LOCAL_MACHINE"
Case "HKEY_USERS", "HKU"
Hkeyroot = HKEY_USERS
Skeyroot = "HKEY_USERS"
Case "Hkey_current_config"
Hkeyroot = Hkey_current_config
Skeyroot = "Hkey_current_config"
Case Else
Subkillregkey = 1
Exit Sub
End Select
For ielement = 1 to UBound (akeypathsubsection)
Skeytokill = Skeytokill & "\" & Akeypathsubsection (ielement)
Next
If Left (skeytokill,1) = "\" Then Skeytokill = Right (Skeytokill, Len (Skeytokill)-1)
On Error Resume Next
Set Owmireg = GetObject ("Winmgmts:{impersonationlevel=impersonate}!\\.\root\default:stdregprov")
Isubkeycheck = Owmireg.enumkey (Hkeyroot, Skeytokill, Asubkeys)
If Isubkeycheck = 0 and IsArray (asubkeys) Then
For each ssubkey in Asubkeys
If err.number <> 0 Then
Err.Clear
Exit Sub
End If
Subkillregkey Skeyroot & "& Skeytokill &" \ "& Ssubkey," DELETE "
Next
End If
Owmireg.deletekey Hkeyroot, Skeytokill
End Sub
End Class
