Dynamic Activity Window

RE: Dynamic Activity Window (alienprotein)

Fri, 21 Nov 2008 11:48:46 GMT

DiGiTAL.SkReAM, Thanks for fixing this to work with IE 7. When last I poached the code IE7 was not on our radar, so I never thought to test it. But after we deplyed IE7 three weeks ago, I got to find ou the hard way.

I did have to butcher it a little to work for non privileged users by changing the references to HKLM, to HKCU and also forcing the *.hta, *.run, and *sleep.vbs files to be generated under %userprofile%\local settings\temp. Not sure if your intention was to randomly generate a folder at the root of the C drive, or not, but our people are unable to write to that location. So just for Sh*ts and giggles, I'm posting my rendition of this script.
Again, much thanks to you and everyone who contributes on this forum.

 
 Option Explicit 
 Dim StrPath
 Dim WshShell
 Dim oBar
 Dim objNetwork, colDrives, i, ReturnCode
 Set objNetwork = CreateObject("Wscript.Network")
 Set colDrives = objNetwork.EnumNetworkDrives
 WScript.Sleep (2000)
 
 'On Error Resume Next
 Set oBar = New ProgressBar
 Set WshShell = WScript.CreateObject("WScript.Shell")
 oBar.StartBar "This is doing something"
 WScript.Sleep (3000)
 '             WshShell.Run("""\\path\SOMESCRIPT.VBS""")
 'ReturnCode = WshShell.Run("""\\path\SOMESCRIPT.VBS""", 1, True)
 oBar.SetLine "Now it's done......"
 WScript.Sleep (3000)
 oBar.CloseBar
 Class ProgressBar
 Dim oBarCat, sProgressBarHTAFile, sProgressBarRunFile, sProgressBarSleepFile, sInitialTempBuild 
 Public Sub StartBar(sMessageToDisplay)
 Dim sInitialTemp
 ExecuteGlobal "Dim oShell, oFSO, oEnv"
 Set oShell = CreateObject("Wscript.Shell")
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set oEnv = oShell.Environment("Process")
 sInitialTemp = 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, "<html>"
 oBarCat.Add oBarCat.Count, "<head>"
 oBarCat.Add oBarCat.Count, "<title id=" & Chr(34) & "title" & Chr(34) & ">Waters & Kraus Login</title>"
 oBarCat.Add oBarCat.Count, "<HTA:APPLICATION "
 oBarCat.Add oBarCat.Count, "    ID=" & Chr(34) & "StatusBar" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    APPLICATIONNAME=" & Chr(34) & "StatusBar" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SCROLL=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SINGLEINSTANCE=" & Chr(34) & "YES" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    CAPTION=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    BORDER=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    BORDERSTYLE=" & Chr(34) & "NORMAL" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SYSMENU=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    CONTEXTMENU=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SHOWINTASKBAR=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    />"
 oBarCat.Add oBarCat.Count, "<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">"
 oBarCat.Add oBarCat.Count, "Dim oShell, iTimer1, iTimer2, sStatusBarAsciiText, sPID, iCID, sStatusMsg"
 oBarCat.Add oBarCat.Count, "Set oShell = CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "sPID = " & Chr(34) & "" & Chr(34) & ":iCID = 10"
 oBarCat.Add oBarCat.Count, "Sub Window_Onload"
 oBarCat.Add oBarCat.Count, "  window.resizeTo 320,170"
 oBarCat.Add oBarCat.Count, "  CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "  CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").OpenTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ",2).WriteLine " & Chr(34) & "WScript.Sleep(1000)" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " iTimer1 = window.setInterval(" & Chr(34) & "Do_Refresh" & Chr(34) & ",175)"
 oBarCat.Add oBarCat.Count, "  iTimer2 = window.setInterval(" & Chr(34) & "Do_Nothing" & Chr(34) & ",500)"
 oBarCat.Add oBarCat.Count, "End Sub"
 oBarCat.Add oBarCat.Count, "Sub Do_Nothing"
 oBarCat.Add oBarCat.Count, "  If CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").FileExists(" & Chr(34) & sProgressBarRunFile & Chr(34) & ") Then"  
 oBarCat.Add oBarCat.Count, "  Dim oWMIService, cItems, oItem"
 oBarCat.Add oBarCat.Count, "  Set oWMIService = GetObject(" & Chr(34) & "winmgmts:\\.\root\CIMV2" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "  Set cItems = oWMIService.ExecQuery(" & Chr(34) & "SELECT Name, ExecutablePath, CommandLine FROM Win32_Process where Name = 'mshta.exe'" & Chr(34) & ")" 
 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(34) & "Scripting.FileSystemObject" & Chr(34) & ").DeleteFile " & Chr(34) & sProgressBarSleepFile & Chr(34) & ", 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(34) & "ooooo" & Chr(34) & ":iCID = 0"
 oBarCat.Add oBarCat.Count, "      Case 0"
 oBarCat.Add oBarCat.Count, "        sStatusBarAsciiText =  " & Chr(34) & "oooon" & Chr(34) & ":iCID = 1"
 oBarCat.Add oBarCat.Count, "      Case 1"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "ooono" & Chr(34) & ":iCID = 2"
 oBarCat.Add oBarCat.Count, "      Case 2"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "oonoo" & Chr(34) & ":iCID = 3"
 oBarCat.Add oBarCat.Count, "      Case 3"
 oBarCat.Add oBarCat.Count, "        sStatusBarAsciiText =  " & Chr(34) & "onooo" & Chr(34) & ":iCID = 4"
 oBarCat.Add oBarCat.Count, "      Case 4"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "noooo" & Chr(34) & ":iCID = 5"
 oBarCat.Add oBarCat.Count, "     Case 5"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "onooo" & Chr(34) & ":iCID = 6"
 oBarCat.Add oBarCat.Count, "      Case 6"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "oonoo" & Chr(34) & ":iCID = 7"
 oBarCat.Add oBarCat.Count, "     Case 7"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "ooono" & Chr(34) & ":iCID = 8"
 oBarCat.Add oBarCat.Count, "     Case 8"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "oooon" & Chr(34) & ":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(34) & "HKCU\SYSTEM\ProgressBar\MSG" & Chr(34) & ")"
 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(34) & "HKCU\SYSTEM\ProgressBar\MSG" & Chr(34) & "), VbCrLf," & Chr(34) & "<br>" & Chr(34) & ") "
 oBarCat.Add oBarCat.Count, "     Else"
 oBarCat.Add oBarCat.Count, "      sStatusMsg = " & Chr(34) & "" & Chr(34) & ""
 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, "</head>"
 oBarCat.Add oBarCat.Count, "<body>"
 oBarCat.Add oBarCat.Count, "<center>"
 oBarCat.Add oBarCat.Count, "<table width=" & Chr(34) & "275" & Chr(34) & ">"
 oBarCat.Add oBarCat.Count, " <tr><td>"
 oBarCat.Add oBarCat.Count, "   <fieldset><legend align=" & Chr(34) & "center" & Chr(34) & "><b> Waters & Kraus Login </b></legend>"
 oBarCat.Add oBarCat.Count, "     <br><center>"
 oBarCat.Add oBarCat.Count, "       <span id= " & Chr(34) & "Stats" & Chr(34) & " style=" & Chr(34) & "font-family: wingdings;font-weight: bold;font-size:20px;" & Chr(34) & "></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(34) & "MyMsg" & Chr(34) & " style=" & Chr(34) & "font-family: Ariel;font-size:12px;" & Chr(34) & "></span>"
 oBarCat.Add oBarCat.Count, "</body>"
 oBarCat.Add oBarCat.Count, "</html>"
 subWriteFile sProgressBarHTAFile, Join(oBarCat.Items,VbCrLf)
 oShell.RegWrite "HKCU\SYSTEM\ProgressBar\MSG", sMessageToDisplay, "REG_SZ"
 oShell.Run sProgressBarHTAFile, 1, False 
 End Sub
 Public Sub CloseBar()
 fKillFile sProgressBarRunFile
 Dim sProgressBarHTAFileKiller
 subKillRegKey "HKCU\SYSTEM\ProgressBar","DELETE"
 sProgressBarHTAFileKiller = "c:\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(34) & sProgressBarHTAFile & Chr(34) & ", True"
 subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFolder " & Chr(34) & oFSO.GetDriveName(oEnv("TEMP")) & "\" & sInitialTempBuild & Chr(34) & ", True"
 subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) & sProgressBarHTAFileKiller & Chr(34) & ", True"
 oShell.Run "%comspec% /c cscript.exe " & sProgressBarHTAFileKiller, 0, False 
 End Sub
 Public Sub SetLine(sNewText)
 oShell.RegWrite "HKCU\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
 Do
     iCharASCiiValue = Int(((iHighestASCiiValue - iLowestASCiiValue + 1) * Rnd) + iLowestASCiiValue)   
      Select Case True
       Case iCharASCiiValue = 47
       Case iCharASCiiValue > 57 And 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 = 53 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

RE: Dynamic Activity Window (dm_4ever)

Wed, 05 Mar 2008 08:23:04 GMT

Updated your first post...Mountain Dew is a great friend!

RE: Dynamic Activity Window (DiGiTAL.SkReAM)

Wed, 05 Mar 2008 03:28:28 GMT

As happens every so often, I learn something.
As happens more often, someone points out an error that I made, prior to the above.
So, in deference to both of the above, I am posting the latest 'iteration' of the progressbar class.

Changes:
1) Instead of using c:\temp, the code now generates a 16 character folder name at random, and uses that as it's "home".
This prevents errors when the TEMP folder is emptied during a progressbar run.
2) The htakiller.vbs file is now created in the root of the drive letter in which the %TEMP% variable contains.
3) The code now brings to the forefront only the mshta.exe process that ran the progressbar hta in the first place, rather than the first one it finds in memory.

Thanks to KroBaar for pointing out where I'd gone wrong, and thanks to my good friend Mountain Dew for giving me the wakefullness to spend on correcting the code.

Insomnia is a terrible thing.

Could a Fourm Admin please update the code in the first post in this thread with the code below?

 Option Explicit 
 Dim oBar
 Set oBar = New ProgressBar
 oBar.StartBar "This is a test."
 WScript.Sleep (3000)
 oBar.SetLine "So is 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, "<html>"
 oBarCat.Add oBarCat.Count, "<head>"
 oBarCat.Add oBarCat.Count, "<title id=" & Chr(34) & "title" & Chr(34) & ">Please Wait</title>"
 oBarCat.Add oBarCat.Count, "<HTA:APPLICATION "
 oBarCat.Add oBarCat.Count, "    ID=" & Chr(34) & "StatusBar" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    APPLICATIONNAME=" & Chr(34) & "StatusBar" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SCROLL=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SINGLEINSTANCE=" & Chr(34) & "YES" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    CAPTION=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    BORDER=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    BORDERSTYLE=" & Chr(34) & "NORMAL" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SYSMENU=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    CONTEXTMENU=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SHOWINTASKBAR=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    />"
 oBarCat.Add oBarCat.Count, "<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">"
 oBarCat.Add oBarCat.Count, "Dim oShell, iTimer1, iTimer2, sStatusBarAsciiText, sPID, iCID, sStatusMsg"
 oBarCat.Add oBarCat.Count, "Set oShell = CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "sPID = " & Chr(34) & "" & Chr(34) & ":iCID = 10"
 oBarCat.Add oBarCat.Count, "Sub Window_Onload"
 oBarCat.Add oBarCat.Count, "  window.resizeTo 320,250"
 oBarCat.Add oBarCat.Count, "  CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, " CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").CreateTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "  CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").OpenTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ",2).WriteLine " & Chr(34) & "WScript.Sleep(1000)" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " iTimer1 = window.setInterval(" & Chr(34) & "Do_Refresh" & Chr(34) & ",175)"
 oBarCat.Add oBarCat.Count, "  iTimer2 = window.setInterval(" & Chr(34) & "Do_Nothing" & Chr(34) & ",500)"
 oBarCat.Add oBarCat.Count, "End Sub"
 oBarCat.Add oBarCat.Count, "Sub Do_Nothing"
 oBarCat.Add oBarCat.Count, "  If CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ").FileExists(" & Chr(34) & sProgressBarRunFile & Chr(34) & ") Then"  
 oBarCat.Add oBarCat.Count, "  Dim oWMIService, cItems, oItem"
 oBarCat.Add oBarCat.Count, "  Set oWMIService = GetObject(" & Chr(34) & "winmgmts:\\.\root\CIMV2" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "  Set cItems = oWMIService.ExecQuery(" & Chr(34) & "SELECT Name, ExecutablePath, CommandLine FROM Win32_Process where Name = 'mshta.exe'" & Chr(34) & ")" 
 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(34) & "Scripting.FileSystemObject" & Chr(34) & ").DeleteFile " & Chr(34) & sProgressBarSleepFile & Chr(34) & ", 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(34) & "ooooo" & Chr(34) & ":iCID = 0"
 oBarCat.Add oBarCat.Count, "      Case 0"
 oBarCat.Add oBarCat.Count, "        sStatusBarAsciiText =  " & Chr(34) & "oooon" & Chr(34) & ":iCID = 1"
 oBarCat.Add oBarCat.Count, "      Case 1"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "ooono" & Chr(34) & ":iCID = 2"
 oBarCat.Add oBarCat.Count, "      Case 2"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "oonoo" & Chr(34) & ":iCID = 3"
 oBarCat.Add oBarCat.Count, "      Case 3"
 oBarCat.Add oBarCat.Count, "        sStatusBarAsciiText =  " & Chr(34) & "onooo" & Chr(34) & ":iCID = 4"
 oBarCat.Add oBarCat.Count, "      Case 4"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "noooo" & Chr(34) & ":iCID = 5"
 oBarCat.Add oBarCat.Count, "     Case 5"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "onooo" & Chr(34) & ":iCID = 6"
 oBarCat.Add oBarCat.Count, "      Case 6"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "oonoo" & Chr(34) & ":iCID = 7"
 oBarCat.Add oBarCat.Count, "     Case 7"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "ooono" & Chr(34) & ":iCID = 8"
 oBarCat.Add oBarCat.Count, "     Case 8"
 oBarCat.Add oBarCat.Count, "         sStatusBarAsciiText =  " & Chr(34) & "oooon" & Chr(34) & ":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(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & ")"
 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(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & "), VbCrLf," & Chr(34) & "<br>" & Chr(34) & ") "
 oBarCat.Add oBarCat.Count, "     Else"
 oBarCat.Add oBarCat.Count, "      sStatusMsg = " & Chr(34) & "" & Chr(34) & ""
 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, "</head>"
 oBarCat.Add oBarCat.Count, "<body>"
 oBarCat.Add oBarCat.Count, "<center>"
 oBarCat.Add oBarCat.Count, "<table width=" & Chr(34) & "275" & Chr(34) & ">"
 oBarCat.Add oBarCat.Count, " <tr><td>"
 oBarCat.Add oBarCat.Count, "   <fieldset><legend align=" & Chr(34) & "center" & Chr(34) & "><b> Please Be Patient </b></legend>"
 oBarCat.Add oBarCat.Count, "     <br><center>"
 oBarCat.Add oBarCat.Count, "       <span id= " & Chr(34) & "Stats" & Chr(34) & " style=" & Chr(34) & "font-family: wingdings;font-weight: bold;font-size:20px;" & Chr(34) & "></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(34) & "MyMsg" & Chr(34) & " style=" & Chr(34) & "font-family: Ariel;font-size:12px;" & Chr(34) & "></span>"
 oBarCat.Add oBarCat.Count, "</body>"
 oBarCat.Add oBarCat.Count, "</html>"
 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(34) & sProgressBarHTAFile & Chr(34) & ", True"
 subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFolder " & Chr(34) & oFSO.GetDriveName(oEnv("TEMP")) & "\" & sInitialTempBuild & Chr(34) & ", True"
 subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) & sProgressBarHTAFileKiller & Chr(34) & ", 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
 Do
  iCharASCiiValue = Int(((iHighestASCiiValue - iLowestASCiiValue + 1) * Rnd) + iLowestASCiiValue)   
   Select Case True
    Case iCharASCiiValue = 47
    Case iCharASCiiValue > 57 And 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 = 53 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

RE: Dynamic Activity Window (KroBaar)

Tue, 05 Feb 2008 14:56:42 GMT

ehvbs..

1. Thanks for the link to that document. I'm embarrassed to say I never really understood how the garbage collector worked in VBScript until I read through that blog and did more research on it. I was simply "blindly" following the advice of other co-workers as they seem to have that rule set in stone. Thanks for the knock on my noggin. ;-)

2.) Yes, I realized my mistake with the Class_Terminate shortly after posting my message.

So I guess my only real valid comment then would be the mod. to make the progressbar hta the only hta to be affected by the call to oShell.AppActivate and removing the hard coded path to c:\temp.

thanks,
KroBaar.

RE: Dynamic Activity Window (ehvbs)

Thu, 31 Jan 2008 10:25:08 GMT

Hi KroBaar,

two comments on your comments:

(1) "Set oWhatever = Nothing" isn't necessary most of the time; see

http://blogs.msdn.com/ericlippert/archive/2004/04/28/122259.aspx

(2) All 'destructors' in VBScript are named "Class_Terminate"

Regards

ehvbs

RE: Dynamic Activity Window (KroBaar)

Thu, 31 Jan 2008 09:42:47 GMT

I know this thread is old, but I just came across this progressbar the other day and I like the way it works, for the most part. I have a few comments regarding it though.
1). Throughout the code, every pointer to an object created is never set to Nothing when you are finished, this poses a memory leak, does it not? As well as using the If CreateObject(...), how is that object released? Shouldn't it be set to some variable x, then set to Nothing when finished?
2). You mentioned to a user that this code wasn't intended to run inside an HTA, which I agree, however, the code can be executed from within an HTA by used of wscript.shell and the run method. In terms of it killing the mshta.exe process, I acutally couldn't find where you do that, and have noticed that if I have multiple HTA applications running, only progressbar closes. However, your call to oShell.AppActivate causes every HTA application to be activated. To Activate only the progressbar, I modified the code a little. I modified your For loop from:

oBarCat.Add oBarCat.Count, "Set cItems = oWMIService.ExecQuery(" & Chr(34) & "SELECT Name, ExecutablePath FROM Win32_Process where Name = 'mshta.exe'" & Chr(34) & ")"
oBarCat.Add oBarCat.Count, "   For Each oItem in cItems"
oBarCat.Add oBarCat.Count, "      oShell.AppActivate oItem.Handle"
oBarCat.Add oBarCat.Count, "   Next"

to:

oBarCat.Add oBarCat.Count, " Set cItems = oWMIService.ExecQuery(" & Chr(34) & "SELECT Name, ExecutablePath, CommandLine FROM Win32_Process where Name = 'mshta.exe'" & Chr(34) & ")"
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"

This will only activate the HTA that matches the filename running the code, hence progressbar. For that to work, I had to change the select statement and add the column CommandLine to the list you were selecting.

Other mods made:
You hard coded a path on the C: drive which doesn't happen to exist for the workstations at the Corporation I work for:

sProgressBarHTAFileKiller = "c:\temp\htakiller.vbs"

so I made use of an object you were using thoughout for the environment variables and changed the line to:

sProgressBarHTAFileKiller = oEnv("TEMP") & "\htakiller.vbs"

As well, as mentioned before with setting object pointers to Nothing, couldn't this be handled in the class terminate procedure (which would have to be added of course, ProgressBar_Terminate() )? Other than that, it seems to do what I was looking for. : )

RE: Dynamic Activity Window (DiGiTAL.SkReAM)

Tue, 22 May 2007 07:04:12 GMT

The same wayt hat you would call any other external vbs file.
Perform a search in the fora for
filesystemobject
arguments
wscript.shell
and then read some of the docs.
You are looking for a way to run an external vbscript from another, while passing arguments to it. I can provide the class, but it is up to you to learn how to use it in conjunction with your own code.

RE: Dynamic Activity Window (phil999)

Mon, 21 May 2007 15:41:16 GMT

ok so i would have to run as an external vbs file? As i know it works that way but based on the following how would i call it?

  Sub installmediaplayer11
 dim oBar
 set oBar = New ProgressBar
 oBar.StartBar "Now installing some stuff... Be a patient little code-monkey."
 objfso.CopyFile"\\server\sw-package$\Silent_Software_Installs\wmp11-windowsxp-x86-enu.exe", "C:\IT_SOFTWARE\wmp11-windowsxp-x86-enu.exe" 
 winsh.Run("C:\IT_SOFTWARE\wmp11-windowsxp-x86-enu.exe /Q:A /R:N")
 oBar.CloseBar
 End Sub

RE: Dynamic Activity Window (DiGiTAL.SkReAM)

Mon, 21 May 2007 11:47:23 GMT

This code was never meant to be run from inside another HTA.
First off, you are including the example code at the beginning, which includes WScript.Sleep commands that are invalid in an HTA.
Secondly, the section where it tries to bring itself to the forefront performs an appactivate on mshta.exe. Well, if you already have an HTA open, mshta.exe is already being used. When the Progressbar ends, it kills the mshta.exe process - which would kill your original HTA as well.

It is kinda like saying "This snowsuit doesn't keep me dry when I am snorkeling! Snow is just frozen water, so it should work! How do I fix it?"
The only answer is: don't use it while snorkeling!

RE: Dynamic Activity Window (ebgreen)

Mon, 21 May 2007 11:21:41 GMT

I would think about pulling the dictionary creation part out into a seperate script to make it easier to find the problem.

RE: Dynamic Activity Window (phil999)

Mon, 21 May 2007 11:00:37 GMT

What i have just before the </SCRIPT> is

the class from the first post

------------------

 
 Class ProgressBar
 Dim oBarCat, sProgressBarHTAFile, sProgressBarRunFile, sProgressBarSleepFile
 Public Sub StartBar(sMessageToDisplay)
 Dim sInitialTemp
 ExecuteGlobal "Dim oShell, oFSO, oEnv"
 Set oShell = CreateObject("Wscript.Shell")
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set oEnv = oShell.Environment("Process")
 sInitialTemp = 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, "<html>"
 oBarCat.Add oBarCat.Count, "<head>"
 oBarCat.Add oBarCat.Count, "<title id=" & Chr(34) & "title" & Chr(34) & ">Please Wait</title>"
 oBarCat.Add oBarCat.Count, "<HTA:APPLICATION "
 oBarCat.Add oBarCat.Count, "    ID=" & Chr(34) & "StatusBar" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    APPLICATIONNAME=" & Chr(34) & "StatusBar" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SCROLL=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SINGLEINSTANCE=" & Chr(34) & "yes" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    caption=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    BORDER=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    BORDERSTYLE=" & Chr(34) & "normal" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    MAXIMIZEBUTTON=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    MINIMIZEBUTTON=" & Chr(34) & "yes" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SYSMENU=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    CONTEXTMENU=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    WINDOWSTATE=" & Chr(34) & "normal" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    ShowInTaskBar=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    />"
 oBarCat.Add oBarCat.Count, "<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">"
 oBarCat.Add oBarCat.Count, "Set oShell = CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "Set oFSO = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "Dim strTimer, strTimerCnt, sPID, iCID, sStatusMsg"
 oBarCat.Add oBarCat.Count, "sPID = " & Chr(34) & "" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "iCID = 10"
 oBarCat.Add oBarCat.Count, " Sub Window_Onload"
 oBarCat.Add oBarCat.Count, " window.resizeTo 320,250"
 oBarCat.Add oBarCat.Count, " Stats " & Chr(34) & "Init" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " document.title = document.title"
 oBarCat.Add oBarCat.Count, " oFSO.CreateTextFile(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, " oFSO.CreateTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, " Set oVBS = oFSO.OpenTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ",2)"
 oBarCat.Add oBarCat.Count, " oVBS.WriteLine " & Chr(34) & "WScript.Sleep(1000)" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " oVBS.Close"
 oBarCat.Add oBarCat.Count, "Dim oWMIService, cItems, oItem"
 oBarCat.Add oBarCat.Count, "Set oWMIService = GetObject(" & Chr(34) & "winmgmts:\\.\root\CIMV2" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "Set cItems = oWMIService.ExecQuery(" & Chr(34) & "SELECT Name, ExecutablePath FROM Win32_Process where Name = 'mshta.exe'" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "For Each oItem in cItems"
 oBarCat.Add oBarCat.Count, " sPID = oItem.Handle"
 oBarCat.Add oBarCat.Count, "Next"
 oBarCat.Add oBarCat.Count, " Do While oFSO.FileExists(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "  oShell.Run " & Chr(34) & sProgressBarSleepFile & Chr(34) & ",0,True"
 oBarCat.Add oBarCat.Count, "      oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, " Loop "
 oBarCat.Add oBarCat.Count, " oFSO.DeleteFile " & Chr(34) & sProgressBarSleepFile & Chr(34) & ", True "
 oBarCat.Add oBarCat.Count, " Stats " & Chr(34) & "End" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " window.Close"
 oBarCat.Add oBarCat.Count, " End Sub"
 oBarCat.Add oBarCat.Count, " Sub Stats(strStatus)"
 oBarCat.Add oBarCat.Count, " If strStatus = " & Chr(34) & "Init" & Chr(34) & " Then"
 oBarCat.Add oBarCat.Count, "   strTimer = window.setInterval(" & Chr(34) & "Stats('Run')" & Chr(34) & ", 175)"
 oBarCat.Add oBarCat.Count, " Elseif strStatus = " & Chr(34) & "Run" & Chr(34) & " Then"
 oBarCat.Add oBarCat.Count, "Select Case iCID"
 oBarCat.Add oBarCat.Count, "    Case 10"
 oBarCat.Add oBarCat.Count, "       strTimerCnt =" & Chr(34) & "ooooo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 0"
 oBarCat.Add oBarCat.Count, "    Case 0"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "oooon" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 1"
 oBarCat.Add oBarCat.Count, "    Case 1"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "ooono" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 2"
 oBarCat.Add oBarCat.Count, "    Case 2"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "oonoo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 3"
 oBarCat.Add oBarCat.Count, "    Case 3"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "onooo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 4"
 oBarCat.Add oBarCat.Count, "    Case 4"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "noooo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 5"
 oBarCat.Add oBarCat.Count, "    Case 5"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "onooo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 6"
 oBarCat.Add oBarCat.Count, "    Case 6"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "oonoo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 7"
 oBarCat.Add oBarCat.Count, "    Case 7"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "ooono" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 8"
 oBarCat.Add oBarCat.Count, "    Case 8"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "oooon" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 1"
 oBarCat.Add oBarCat.Count, "   End Select "
 oBarCat.Add oBarCat.Count, "   document.getElementById(" & Chr(34) & "Stats" & Chr(34) & ").innerHTML = strTimerCnt"
 oBarCat.Add oBarCat.Count, "  On Error Resume Next"
 oBarCat.Add oBarCat.Count, "  oShell.RegRead(" & Chr(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & ")"
 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 = oShell.RegRead(" & Chr(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & ")" 
 oBarCat.Add oBarCat.Count, "    else"
 oBarCat.Add oBarCat.Count, "     sStatusMsg = " & Chr(34) & "" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    End if"
 oBarCat.Add oBarCat.Count, "     If Trim(sStatusMsg) <> " & Chr(34) & "" & Chr(34) & " Then "
 oBarCat.Add oBarCat.Count, "      sStatusMsg = Replace(sStatusMsg, VbCrLf, " & Chr(34) & "<br>" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "     Else"
 oBarCat.Add oBarCat.Count, "      sStatusMsg = " & Chr(34) & "" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "  End If "
 oBarCat.Add oBarCat.Count, "   document.getElementById(" & Chr(34) & "MyMsg" & Chr(34) & ").innerHTML = sStatusMsg"
 oBarCat.Add oBarCat.Count, " Elseif strStatus = " & Chr(34) & "End" & Chr(34) & " Then"
 oBarCat.Add oBarCat.Count, "   window.clearInterval(strTimer)"
 oBarCat.Add oBarCat.Count, "   document.getElementById(" & Chr(34) & "Stats" & Chr(34) & ").innerHTML = " & Chr(34) & "" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " End If"
 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, "</head>"
 oBarCat.Add oBarCat.Count, "<body>"
 oBarCat.Add oBarCat.Count, "<center>"
 oBarCat.Add oBarCat.Count, "<table width=" & Chr(34) & "275" & Chr(34) & ">"
 oBarCat.Add oBarCat.Count, " <tr><td>"
 oBarCat.Add oBarCat.Count, "   <fieldset><legend align=" & Chr(34) & "center" & Chr(34) & "><b> Please Be Patient </b></legend>"
 oBarCat.Add oBarCat.Count, "     <br><center>"
 oBarCat.Add oBarCat.Count, "       <span id=Stats style=" & Chr(34) & "font-family: wingdings;font-weight: bold;font-size:20px;" & Chr(34) & "></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=MyMsg style=" & Chr(34) & "font-family: Ariel;font-size:12px;" & Chr(34) & "></span>"
 oBarCat.Add oBarCat.Count, "</body>"
 oBarCat.Add oBarCat.Count, "</html>"
 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 = "c:\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(34) & sProgressBarHTAFile & Chr(34) & ", True"
 subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) & sProgressBarHTAFileKiller & Chr(34) & ", True"
 oShell.Run 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
 Do
     iCharASCiiValue = Int(((iHighestASCiiValue - iLowestASCiiValue + 1) * Rnd) + iLowestASCiiValue)   
      Select Case True
       Case iCharASCiiValue = 47
       Case iCharASCiiValue > 57 And 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 = 53 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 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

I even tried a new hta

 <html> 
 <head> 
  <title>Build Doc Rev 2</title> 
  <HTA:APPLICATION 
    ID="objTest" 
    APPLICATIONNAME="Software Installation" 
    SCROLL="no" 
    SINGLEINSTANCE="yes" 
    SysMenu="no"
    VERSION="2.0" 
  > 
  
  <SCRIPT LANGUAGE="VBSCRIPT">
 Option Explicit 
 Dim oBar
 Set oBar = New ProgressBar
 oBar.StartBar "This is a test."
 WScript.Sleep (3000)
 oBar.SetLine "So is this."
 WScript.Sleep (3000)
 oBar.CloseBar
 
 Class ProgressBar
 Dim oBarCat, sProgressBarHTAFile, sProgressBarRunFile, sProgressBarSleepFile
 Public Sub StartBar(sMessageToDisplay)
 Dim sInitialTemp
 ExecuteGlobal "Dim oShell, oFSO, oEnv"
 Set oShell = CreateObject("Wscript.Shell")
 Set oFSO = CreateObject("Scripting.FileSystemObject")
 Set oEnv = oShell.Environment("Process")
 sInitialTemp = 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, "<html>"
 oBarCat.Add oBarCat.Count, "<head>"
 oBarCat.Add oBarCat.Count, "<title id=" & Chr(34) & "title" & Chr(34) & ">Please Wait</title>"
 oBarCat.Add oBarCat.Count, "<HTA:APPLICATION "
 oBarCat.Add oBarCat.Count, "    ID=" & Chr(34) & "StatusBar" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    APPLICATIONNAME=" & Chr(34) & "StatusBar" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SCROLL=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SINGLEINSTANCE=" & Chr(34) & "yes" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    caption=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    BORDER=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    BORDERSTYLE=" & Chr(34) & "normal" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    MAXIMIZEBUTTON=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    MINIMIZEBUTTON=" & Chr(34) & "yes" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    SYSMENU=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    CONTEXTMENU=" & Chr(34) & "NO" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    WINDOWSTATE=" & Chr(34) & "normal" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    ShowInTaskBar=" & Chr(34) & "no" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    />"
 oBarCat.Add oBarCat.Count, "<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">"
 oBarCat.Add oBarCat.Count, "Set oShell = CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "Set oFSO = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "Dim strTimer, strTimerCnt, sPID, iCID, sStatusMsg"
 oBarCat.Add oBarCat.Count, "sPID = " & Chr(34) & "" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "iCID = 10"
 oBarCat.Add oBarCat.Count, " Sub Window_Onload"
 oBarCat.Add oBarCat.Count, " window.resizeTo 320,250"
 oBarCat.Add oBarCat.Count, " Stats " & Chr(34) & "Init" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " document.title = document.title"
 oBarCat.Add oBarCat.Count, " oFSO.CreateTextFile(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, " oFSO.CreateTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, " Set oVBS = oFSO.OpenTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ",2)"
 oBarCat.Add oBarCat.Count, " oVBS.WriteLine " & Chr(34) & "WScript.Sleep(1000)" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " oVBS.Close"
 oBarCat.Add oBarCat.Count, "Dim oWMIService, cItems, oItem"
 oBarCat.Add oBarCat.Count, "Set oWMIService = GetObject(" & Chr(34) & "winmgmts:\\.\root\CIMV2" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "Set cItems = oWMIService.ExecQuery(" & Chr(34) & "SELECT Name, ExecutablePath FROM Win32_Process where Name = 'mshta.exe'" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "For Each oItem in cItems"
 oBarCat.Add oBarCat.Count, " sPID = oItem.Handle"
 oBarCat.Add oBarCat.Count, "Next"
 oBarCat.Add oBarCat.Count, " Do While oFSO.FileExists(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "  oShell.Run " & Chr(34) & sProgressBarSleepFile & Chr(34) & ",0,True"
 oBarCat.Add oBarCat.Count, "      oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, " Loop "
 oBarCat.Add oBarCat.Count, " oFSO.DeleteFile " & Chr(34) & sProgressBarSleepFile & Chr(34) & ", True "
 oBarCat.Add oBarCat.Count, " Stats " & Chr(34) & "End" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " window.Close"
 oBarCat.Add oBarCat.Count, " End Sub"
 oBarCat.Add oBarCat.Count, " Sub Stats(strStatus)"
 oBarCat.Add oBarCat.Count, " If strStatus = " & Chr(34) & "Init" & Chr(34) & " Then"
 oBarCat.Add oBarCat.Count, "   strTimer = window.setInterval(" & Chr(34) & "Stats('Run')" & Chr(34) & ", 175)"
 oBarCat.Add oBarCat.Count, " Elseif strStatus = " & Chr(34) & "Run" & Chr(34) & " Then"
 oBarCat.Add oBarCat.Count, "Select Case iCID"
 oBarCat.Add oBarCat.Count, "    Case 10"
 oBarCat.Add oBarCat.Count, "       strTimerCnt =" & Chr(34) & "ooooo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 0"
 oBarCat.Add oBarCat.Count, "    Case 0"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "oooon" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 1"
 oBarCat.Add oBarCat.Count, "    Case 1"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "ooono" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 2"
 oBarCat.Add oBarCat.Count, "    Case 2"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "oonoo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 3"
 oBarCat.Add oBarCat.Count, "    Case 3"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "onooo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 4"
 oBarCat.Add oBarCat.Count, "    Case 4"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "noooo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 5"
 oBarCat.Add oBarCat.Count, "    Case 5"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "onooo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 6"
 oBarCat.Add oBarCat.Count, "    Case 6"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "oonoo" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 7"
 oBarCat.Add oBarCat.Count, "    Case 7"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "ooono" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 8"
 oBarCat.Add oBarCat.Count, "    Case 8"
 oBarCat.Add oBarCat.Count, "      strTimerCnt =  " & Chr(34) & "oooon" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "       oShell.AppActivate sPID"
 oBarCat.Add oBarCat.Count, "   iCID = 1"
 oBarCat.Add oBarCat.Count, "   End Select "
 oBarCat.Add oBarCat.Count, "   document.getElementById(" & Chr(34) & "Stats" & Chr(34) & ").innerHTML = strTimerCnt"
 oBarCat.Add oBarCat.Count, "  On Error Resume Next"
 oBarCat.Add oBarCat.Count, "  oShell.RegRead(" & Chr(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & ")"
 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 = oShell.RegRead(" & Chr(34) & "HKLM\SYSTEM\ProgressBar\MSG" & Chr(34) & ")" 
 oBarCat.Add oBarCat.Count, "    else"
 oBarCat.Add oBarCat.Count, "     sStatusMsg = " & Chr(34) & "" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "    End if"
 oBarCat.Add oBarCat.Count, "     If Trim(sStatusMsg) <> " & Chr(34) & "" & Chr(34) & " Then "
 oBarCat.Add oBarCat.Count, "      sStatusMsg = Replace(sStatusMsg, VbCrLf, " & Chr(34) & "<br>" & Chr(34) & ")"
 oBarCat.Add oBarCat.Count, "     Else"
 oBarCat.Add oBarCat.Count, "      sStatusMsg = " & Chr(34) & "" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, "  End If "
 oBarCat.Add oBarCat.Count, "   document.getElementById(" & Chr(34) & "MyMsg" & Chr(34) & ").innerHTML = sStatusMsg"
 oBarCat.Add oBarCat.Count, " Elseif strStatus = " & Chr(34) & "End" & Chr(34) & " Then"
 oBarCat.Add oBarCat.Count, "   window.clearInterval(strTimer)"
 oBarCat.Add oBarCat.Count, "   document.getElementById(" & Chr(34) & "Stats" & Chr(34) & ").innerHTML = " & Chr(34) & "" & Chr(34) & ""
 oBarCat.Add oBarCat.Count, " End If"
 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, "</head>"
 oBarCat.Add oBarCat.Count, "<body>"
 oBarCat.Add oBarCat.Count, "<center>"
 oBarCat.Add oBarCat.Count, "<table width=" & Chr(34) & "275" & Chr(34) & ">"
 oBarCat.Add oBarCat.Count, " <tr><td>"
 oBarCat.Add oBarCat.Count, "   <fieldset><legend align=" & Chr(34) & "center" & Chr(34) & "><b> Please Be Patient </b></legend>"
 oBarCat.Add oBarCat.Count, "     <br><center>"
 oBarCat.Add oBarCat.Count, "       <span id=Stats style=" & Chr(34) & "font-family: wingdings;font-weight: bold;font-size:20px;" & Chr(34) & "></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=MyMsg style=" & Chr(34) & "font-family: Ariel;font-size:12px;" & Chr(34) & "></span>"
 oBarCat.Add oBarCat.Count, "</body>"
 oBarCat.Add oBarCat.Count, "</html>"
 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 = "c:\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(34) & sProgressBarHTAFile & Chr(34) & ", True"
 subWriteFile sProgressBarHTAFileKiller, "oFSO.DeleteFile " & Chr(34) & sProgressBarHTAFileKiller & Chr(34) & ", True"
 oShell.Run 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
  Do
      iCharASCiiValue = Int(((iHighestASCiiValue - iLowestASCiiValue + 1) * Rnd) + iLowestASCiiValue)   
       Select Case True
        Case iCharASCiiValue = 47
        Case iCharASCiiValue > 57 And 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 = 53 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 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
  
 </SCRIPT> 
 </head>
 <body>
 </body> 
 </html>

RE: Dynamic Activity Window (ebgreen)

Mon, 21 May 2007 10:57:24 GMT

Hmmmm....that is odd given the lines that you posted. Could you post some more lines from around there?

RE: Dynamic Activity Window (phil999)

Mon, 21 May 2007 10:54:42 GMT

Unterminated string contrant on line 584

line 584 oBarCat.Add oBarCat.Count, " End Sub"
line 585 oBarCat.Add oBarCat.Count, "</SCRIPT>"

it works fine if it is in a vbs but i am trying to run it from an inside an HTA

RE: Dynamic Activity Window (ebgreen)

Mon, 21 May 2007 10:43:48 GMT

How does it fail? What happens?

RE: Dynamic Activity Window (phil999)

Mon, 21 May 2007 10:22:12 GMT

OK so after more testing i have worked out it is because i am running it from an hta if i put it in a vbs file it works fine but when in an hta it fails. Any thoughts?

RE: Dynamic Activity Window (phil999)

Mon, 21 May 2007 07:19:56 GMT

Thanks for your help i am having a few problems getting the class in the right place it should be the last thing before the </script> command right?

oBarCat.Add oBarCat.Count, "</SCRIPT>"

Thats the line it seems to throw back. [sm=rolleyes.gif]

RE: Dynamic Activity Window (DiGiTAL.SkReAM)

Mon, 21 May 2007 06:13:40 GMT

ORIGINAL: phil999
this is probably a stupid question....
I have an hta which installs software via a list box and the listbox calls a sub example
 Sub installmediaplayer11
 objfso.CopyFile"\\server\sw-package$\Silent_Software_Installs\wmp11-windowsxp-x86-enu.exe", "C:\IT_SOFTWARE\wmp11-windowsxp-x86-enu.exe" 
 winsh.Run("C:\IT_SOFTWARE\wmp11-windowsxp-x86-enu.exe /Q:A /R:N")
 End Sub
 
What i would like to do is have a progress bar whilst the install is happening. How would i go about doing this using this code?

Like this:
First, tack the progressbar class onto the end of your code. Then, modify the above Sub to look like this:

 Sub installmediaplayer11
 dim oBar
 set oBar = New ProgressBar
 oBar.StartBar "Now installing some stuff... Be a patient little code-monkey."
 objfso.CopyFile"\\server\sw-package$\Silent_Software_Installs\wmp11-windowsxp-x86-enu.exe", "C:\IT_SOFTWARE\wmp11-windowsxp-x86-enu.exe" 
 winsh.Run("C:\IT_SOFTWARE\wmp11-windowsxp-x86-enu.exe /Q:A /R:N")
 oBar.CloseBar
 End Sub

RE: Dynamic Activity Window (phil999)

Sun, 20 May 2007 06:02:51 GMT

this is probably a stupid question....

I have an hta which installs software via a list box and the listbox calls a sub example

Sub installmediaplayer11
objfso.CopyFile"\\server\sw-package$\Silent_Software_Installs\wmp11-windowsxp-x86-enu.exe", "C:\IT_SOFTWARE\wmp11-windowsxp-x86-enu.exe"
winsh.Run("C:\IT_SOFTWARE\wmp11-windowsxp-x86-enu.exe /Q:A /R:N")
End Sub

What i would like to do is have a progress bar whilst the install is happening. How would i go about doing this using this code?

Thank in advance

Phil

RE: Dynamic Activity Window (DiGiTAL.SkReAM)

Thu, 04 Jan 2007 07:14:38 GMT

Thanks, Tony.
To answer your questions, I Dim'med those variables via ExecuteGlobal as a hack, since I needed them to be there, but I didn't want to have them declared until after the StartBar sub was run.

And the registry access is there because it is so much faster than dumping text to a file. When I was using text files to hold the status text, in earlier incarnations of the class, I found that after a long run time, the chances of my reading and writing to the file at the same time increased, and eventually, it would crash. by using the registry, the processing is much faster (try timing registry i/o vs. file i/o sometime), and I don't have that worry. I have found that if a script is processing in a linear fashion, using a text file as a temp memory storage area is sometimes ok, but when you have two or more processes accessing that same file... things can get a bit dicey.

RE: Dynamic Activity Window (TonyLongson)

Thu, 04 Jan 2007 05:37:10 GMT

Excellent script DiGiTAL.SkReAM !!!

There's only one thing I don't understand: why do you do ExecuteGlobal "Dim oShell, oFSO, oEnv" instead of defining them alongside oBarCat?

Also, you could avoid the registry access issues if you used the .run file to hold the status text instead.

Tony Longson.