After experiencing a lot of down time, We decided to move this site to CrystalTech.com. CrystalTech.com is powered by only the finest Windows servers providing the best performance, reliability, and value anywhere.

Dynamic Activity Window

Change Page: 1 2 > | Showing page 1 of 2, messages 1 to 40 of 60

Author	Message

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

Dynamic Activity Window - Saturday, March 18, 2006 5:21 PM

Code updated: July 4, 2006
Comments updated: July 18, 2006
This is my HTA-based progress bar. There are many like it, but this one is mine. My HTA-based progress bar is my best fri... oh sorry, Full Metal Jacket flashback. heh heh
In any case, I've updated it with a bunch of private subs to make the main codebase a little cleaner. Minor tweaks for performance and stability to overcome the issues when running very long scripts the progressbar bombs out. Also, the class is completely self-contained now, so there no additional functions that need to be utilized.
Enjoy!
**NOTE: The HTA version uses WMI to get a list of the running processes, so will be unstable/unusable on Win9x & WinNT4.0 even with the WMI addon installed. Users needing a progressbar to run on those OS's should use the IE-based bar located at http://www.visualbasicscript.com/m_31631/tm.htm.
===============

I shamelessly stole the beginnings of this code from http://www.visualbasicscript.com/fb.aspx?m=31585.
I then beat it with a hammer, beat myself with a soup spoon and came up with this little gem
It's a class that pops up an HTA window to show the user that something is going on, and allows
you to change the text in the window to match what you are doing.
The code below contains the class itself, and about 8 lines of code to demonstrate it's use.
All you have to do is paste it into a .vbs file and run the .vbs.
You should see something like the screenshot I am posting.
To modify the colors, change the text on lines 151,152:
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')}"

 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

[image]local://8013/537B5E8D889D454C94E517898922BB01.jpg[/image]

Attachments are not available: Download requirements not met - - -

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

rOOs

Total Posts : 68
Scores: 0
Reward points : 0
Joined: 2/28/2006
Location: Switzerland

RE: Dynamic Activity Window - Sunday, March 19, 2006 6:17 PM

I see you shamelessly stole the code and modified it promptly :-P

Question: (i just copied the code and run it)
Is it necessary to write the files?
isn't it possible to just dynamically change the content of the hta?

with the internetexplorer object it would go. You just use sth. like: objIE.document.body.innerhtml = "<html><body>test</body></html>"

but the rest is GREAT....

rOOs Total Posts : 68 Scores: 0 Reward points : 0 Joined: 2/28/2006 Location: Switzerland	RE: Dynamic Activity Window - Sunday, March 19, 2006 7:58 PM 0 btw: delete this line of code: subBarCat " document.title = document.title" it doesn't do anything ;-) its a bit code that i used to change the Title of the Window dynamically and you deleted the dynamical thing of it (the strVer Value) ... ;-)

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

RE: Dynamic Activity Window - Sunday, March 19, 2006 11:42 PM

I know that an IE object being opened from a vbs is able to be updated, but I am not so sure about an hta.
From what I gathered on the net, writing a file and having the hta pick out the data was the only way to get the job done.

As I am admittedly weak when it comes to html or hta design, etc. I will let others make any modifications to the code they see fit, rather than trying to 'perfect' the html. heh heh

And thanks for the original code, btw!

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

usavic

Total Posts : 10
Scores: 0
Reward points : 0
Joined: 3/17/2006

RE: Dynamic Activity Window - Wednesday, April 05, 2006 3:59 AM

Hey there. I am trying to implement this class in my printer installing code, and for some reason it is coflicting with the WshShell
'**************Load Prnadmin.dll*****************
Set WshShell = Wscript.CreateObject("Wscript.Shell")
WshShell.Run "regsvr32 Prnadmin.dll /s",1,TRUE
'*****************************************************

Is there anything else in the implementaion I should know about??

By the way, good job, it looks slick

ebgreen

Total Posts : 8081
Scores: 94
Reward points : 0
Joined: 7/12/2005

RE: Dynamic Activity Window - Wednesday, April 05, 2006 4:01 AM

What is the conflict? Do you get an error? What is the error? Could you post all the code that you are running and point out the problem line(s)?

"... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick
Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm
http://www.visualbasicscript.com/m_47117/tm.htm

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

RE: Dynamic Activity Window - Wednesday, April 05, 2006 4:14 AM

ORIGINAL: usavic

Hey there. I am trying to implement this class in my printer installing code, and for some reason it is coflicting with the WshShell
'**************Load Prnadmin.dll*****************
Set WshShell = Wscript.CreateObject("Wscript.Shell")
WshShell.Run "regsvr32 Prnadmin.dll /s",1,TRUE
'*****************************************************

What kind of conflict are you getting? I don't use anything named WshShell in my code, so unless you changed something, it shouldn't be conflicting with anything.
From what code you posted, it looks like yer just registering a .dll file, but I don't see where that would affect anything else in the script.
The best thing that you could do, would be to take ebgrren's advice, and post the entire code that you are trying to run, along with an explanation of the errors you are receiving.

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

usavic

Total Posts : 10
Scores: 0
Reward points : 0
Joined: 3/17/2006

RE: Dynamic Activity Window - Wednesday, April 05, 2006 4:52 AM

Here is my whole code. The conflicts appears depending on which I put first. If I put the Option explicit first it won't execute the wShell and viceversa. No matter what, it allways ends up in a endless loop. Here's the code.

 
 '*****************Code to work work in progress************************
 Option Explicit 
 Dim oBar
 Set oBar = New ProgressBar
 oBar.StartBar "Your printer will now be installed"
 WScript.Sleep(3000)
 oBar.SetLine "Your printer is being installed"
 WScript.Sleep(3000)
 
 '*****************End of code to show work in progress******************
 '**************Load Prnadmin.dll*****************
 Set WshShell = Wscript.CreateObject("Wscript.Shell")
 WshShell.Run "regsvr32 Prnadmin.dll /s",1,TRUE
 '*****************************************************
 
 '*********************This is the installation of the printers, but it never gets here***************
 
 '*************Copy Files to users computer*******
 set filesys=CreateObject("Scripting.FileSystemObject")
   filesys.CopyFolder "Canon Irunner 5000i", "C:\Program Files\"
 '*******************************************************
 '*************Copy Files to users computer*******
 set filesys=CreateObject("Scripting.FileSystemObject")
   filesys.CopyFolder "Canon Irunner 5020i", "C:\Program Files\"
 '*******************************************************
 '*********************Put all ports into a string*******************
 Set objDictionary = CreateObject("Scripting.Dictionary")
 strComputer = "."
 Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 Set colPrinters =  objWMIService.ExecQuery _
    ("Select * from Win32_Printer")
 For Each objPrinter in colPrinters 
    objDictionary.Add objPrinter.PortName, objPrinter.PortName
 Next
 
 Set colPorts = objWMIService.ExecQuery _
    ("Select * from Win32_TCPIPPrinterPort")
 For Each objPort in colPorts
    If objDictionary.Exists(objPort.Name) Then
        strPorts = strPorts & _
            objDictionary.Item(objPort.Name) & VbCrLf
    Else
        strPorts = strPorts & objPort.Name & vbCrLf
    End If
 Next
 '*******************************************************
 
 
 '*************************************Add second printer******************
 '**************************Create and add a port****************************
 set oPort = CreateObject("Port.Port.1")
 set oMaster = CreateObject("PrintMaster.PrintMaster.1")
 'Indicate where to add the port. Double quotes ("" ) stand for the local computer, which is the default.??????
 oPort.ServerName = ""
 'The name of the port cannot be omitted.
 oPort.PortName = "IP_10.30.4.57"
 'The type of the port can be 1 (TCP RAW), 2 (TCP LPR), or 3 (standard local).
 oPort.PortType = 1
 'Mandatory for TCP ports. This is the address of the device to which the port connects.
 oPort.HostAddress = "10.30.4.57"
 'For TCP RAW ports. Default is 9100.
 oPort.PortNumber = 9100
 'Enable or disable SNMP.
 oPort.SNMP = true
 'If SNMP is enabled, 1 is the default for index.
 oPort.SNMPDeviceIndex = 1
 'If SNMP is enabled, "public" is the default community name.
 oPort.CommunityName = "public"
 
 '******************Check for existing ports and adding**********************
 If InStr(strPorts, oPort.PortName) Then
 Else
 'Add the port.
 oMaster.PortAdd oPort
 End if
 '********************End of CHeck*******************************
 '*********************************Add the drivers printer**********************************
 'The following code creates the required PrintMaster and Printer objects.
 set oMaster = CreateObject("PrintMaster.PrintMaster.1")
 set oPrinter = CreateObject("Printer.Printer.1")
 'The following code assigns a name to the printer. The string is required and cannot be empty. 
 oPrinter.PrinterName = "Canon iR5000-6000 PS3"
 'The following code specifies the printer driver to use. The string is required and cannot be empty. 
 oPrinter.DriverName  = "Canon iR5000-6000 PS3"
 'The following code specifies the printer port to use. The string is required and cannot be empty. 
 oPrinter.PortName    = "IP_10.30.4.57"
 'The following code specifies the location of the printer driver. This setting is optional, because by default
 'the drivers are picked up from the driver cache directory.
 oPrinter.DriverPath  = "C:\Program Files\Canon Irunner 5000i"
 'The following code specifies the location of the INF file. This setting is optional, because by default the INF
 'file is picked up from the %windir%\inf\ntprint.inf directory.
 oPrinter.InfFile = "C:\Program Files\Canon Irunner 5000i\W2KPS3U.inf"
 'The following code adds the printer.
 oMaster.PrinterAdd oPrinter
 '***********************************ADD THE 3RD PRINTER***************************************
 '***********Create a port***************************
 set oPort = CreateObject("Port.Port.1")
 set oMaster = CreateObject("PrintMaster.PrintMaster.1")
 
 'Indicate where to add the port. Double quotes ("" ) stand for the local computer, which is the default.??????
 oPort.ServerName = ""
 'The name of the port cannot be omitted.
 oPort.PortName = "IP_10.30.5.22"
 'The type of the port can be 1 (TCP RAW), 2 (TCP LPR), or 3 (standard local).
 oPort.PortType = 1
 'Mandatory for TCP ports. This is the address of the device to which the port connects.
 oPort.HostAddress = "10.30.5.22"
 'For TCP RAW ports. Default is 9100.
 oPort.PortNumber = 9100
 'Enable or disable SNMP.
 oPort.SNMP = true
 'If SNMP is enabled, 1 is the default for index.
 oPort.SNMPDeviceIndex = 1
 'If SNMP is enabled, "public" is the default community name.
 oPort.CommunityName = "public"
 
 '******************Check for existing ports**********************
 If InStr(strPorts, oPort.PortName) Then
 Else
 'add the port.
 oMaster.PortAdd oPort
 End if
 '********************End of CHeck*******************************
 
 'The following code creates the required PrintMaster and Printer objects.
 set oMaster = CreateObject("PrintMaster.PrintMaster.1")
 set oPrinter = CreateObject("Printer.Printer.1")
 'The following code assigns a name to the printer. The string is required and cannot be empty. 
 oPrinter.PrinterName = "Canon iR5020/iR6020 PS3"
 'The following code specifies the printer driver to use. The string is required and cannot be empty. 
 oPrinter.DriverName  = "Canon iR5020/iR6020 PS3"
 'The following code specifies the printer port to use. The string is required and cannot be empty. 
 oPrinter.PortName    = "IP_10.30.5.22"
 'The following code specifies the location of the printer driver. This setting is optional, because by default
 'the drivers are picked up from the driver cache directory.
 oPrinter.DriverPath  = "C:\Program Files\Canon Irunner 5020i"
 'The following code specifies the location of the INF file. This setting is optional, because by default the INF
 'file is picked up from the %windir%\inf\ntprint.inf directory.
 oPrinter.InfFile     = "C:\Program Files\Canon Irunner 5020i\W2KPS3U.inf"
 'The following code adds the printer.
 oMaster.PrinterAdd oPrinter
 oBar.CloseBar
 
 
 If Err <> 0 then
 msgbox "There was an error creating the printer."
 Else
 MsgBox "Your printer is now installed"
 end if
 '************************End of installation of printers***************************
 '********************************Class*****************
 
 Class ProgressBar
 
 
 Dim sProgressBarHTAFile, sProgressBarRunFile, sProgressBarSleepFile
 Dim sProgressBarMsgFile, oShell, oFSO, iBarElementCount, sProgressBarHTAFileKiller
 Dim sTempRoot, sProgressBarMsgTempFile, sInitialTemp, aHTATextCat, oFileToWrite
 Private Sub Class_Initialize()
    Set oShell = CreateObject("Wscript.Shell")
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    sTempRoot = oShell.ExpandEnvironmentStrings("%TEMP%") & "\"
    ReDim aHTATextCat(0)
 End Sub
 
 Public Sub StartBar(sMessageToDisplay)
    sInitialTemp = oFSO.GetTempName
    sProgressBarHTAFile = sTempRoot & oFSO.GetBaseName(sInitialTemp) & ".hta"
    sProgressBarRunFile = sTempRoot & oFSO.GetBaseName(sInitialTemp) & ".run"
    sProgressBarSleepFile = sTempRoot & oFSO.GetBaseName(sInitialTemp) & "sleep.vbs"
    sProgressBarMsgFile = sTempRoot & oFSO.GetBaseName(sInitialTemp) & ".msg"
    subBarCat "<html>"
    subBarCat "<head>"
    subBarCat "<title id=" & Chr(34) & "title" & Chr(34) & ">Please Wait</title>"
    subBarCat "<HTA:APPLICATION "
    subBarCat "    ID=" & Chr(34) & "StatusBar" & Chr(34) & ""
    subBarCat "    APPLICATIONNAME=" & Chr(34) & "StatusBar" & Chr(34) & ""
    subBarCat "    SCROLL=" & Chr(34) & "no" & Chr(34) & ""
    subBarCat "    SINGLEINSTANCE=" & Chr(34) & "yes" & Chr(34) & ""
    subBarCat "    caption=" & Chr(34) & "no" & Chr(34) & ""
    subBarCat "    BORDER=" & Chr(34) & "no" & Chr(34) & ""
    subBarCat "    BORDERSTYLE=" & Chr(34) & "normal" & Chr(34) & ""
    subBarCat "    MAXIMIZEBUTTON=" & Chr(34) & "no" & Chr(34) & ""
    subBarCat "    MINIMIZEBUTTON=" & Chr(34) & "yes" & Chr(34) & ""
    subBarCat "    SYSMENU=" & Chr(34) & "no" & Chr(34) & ""
    subBarCat "    CONTEXTMENU=" & Chr(34) & "NO" & Chr(34) & ""
    subBarCat "    WINDOWSTATE=" & Chr(34) & "normal" & Chr(34) & ""
    subBarCat "    ShowInTaskBar=" & Chr(34) & "no" & Chr(34) & ""
    subBarCat "    />"
    subBarCat "<SCRIPT Language=" & Chr(34) & "VBScript" & Chr(34) & ">"
    subBarCat "Set objShell = CreateObject(" & Chr(34) & "Wscript.Shell" & Chr(34) & ")"
    subBarCat "Set oFSO = CreateObject(" & Chr(34) & "Scripting.FileSystemObject" & Chr(34) & ")"
    subBarCat "Dim strTimer, strTimerCnt, sPID, iCID, sStatusMsg, sStatusMsgFile, oStatusMsgFile"
    subBarCat "sPID = " & Chr(34) & "" & Chr(34) & ""
    subBarCat "iCID = 10"
    subBarCat "sStatusMsgFile = " & Chr(34) & sProgressBarMsgFile & Chr(34) & ""
    subBarCat " Sub Window_Onload"
    subBarCat " window.resizeTo 320,250"
    subBarCat " Stats " & Chr(34) & "Init" & Chr(34) & ""
    subBarCat " document.title = document.title"
    subBarCat " oFSO.CreateTextFile(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")"
    subBarCat " oFSO.CreateTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ")"
    subBarCat " Set oVBS = oFSO.OpenTextFile(" & Chr(34) & sProgressBarSleepFile & Chr(34) & ",2)"
    subBarCat " oVBS.WriteLine " & Chr(34) & "WScript.Sleep(1000)" & Chr(34) & ""
    subBarCat " oVBS.Close"
    subBarCat "Dim oWMIService, cItems, oItem"
    subBarCat "Set oWMIService = GetObject(" & Chr(34) & "winmgmts:\\.\root\CIMV2" & Chr(34) & ")"
    subBarCat "Set cItems = oWMIService.ExecQuery(" & Chr(34) & "SELECT Name, ExecutablePath FROM Win32_Process where Name = 'mshta.exe'" & Chr(34) & ")"
    subBarCat "For Each oItem in cItems"
    subBarCat "   sPID = oItem.Handle"
    subBarCat "Next"
    subBarCat " Do While oFSO.FileExists(" & Chr(34) & sProgressBarRunFile & Chr(34) & ")"
    subBarCat "    objShell.Run " & Chr(34) & sProgressBarSleepFile & Chr(34) & ",0,True"
    subBarCat "      objShell.AppActivate sPID"
    subBarCat " Loop "
    subBarCat " oFSO.DeleteFile " & Chr(34) & sProgressBarSleepFile & Chr(34) & ", True "
    subBarCat " Stats " & Chr(34) & "End" & Chr(34) & ""
    subBarCat " window.Close"
    subBarCat " End Sub"
    subBarCat " Sub Stats(strStatus)"
    subBarCat " If strStatus = " & Chr(34) & "Init" & Chr(34) & " Then"
    subBarCat "   strTimer = window.setInterval(" & Chr(34) & "Stats('Run')" & Chr(34) & ", 175)"
    subBarCat " Elseif strStatus = " & Chr(34) & "Run" & Chr(34) & " Then"
    subBarCat "Select Case iCID"
    subBarCat "      Case 10"
    subBarCat "         strTimerCnt =" & Chr(34) & "ooooo" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 0"
    subBarCat "      Case 0"
    subBarCat "        strTimerCnt =  " & Chr(34) & "oooon" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 1"
    subBarCat "      Case 1"
    subBarCat "        strTimerCnt =  " & Chr(34) & "ooono" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 2"
    subBarCat "      Case 2"
    subBarCat "        strTimerCnt =  " & Chr(34) & "oonoo" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 3"
    subBarCat "      Case 3"
    subBarCat "        strTimerCnt =  " & Chr(34) & "onooo" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 4"
    subBarCat "      Case 4"
    subBarCat "        strTimerCnt =  " & Chr(34) & "noooo" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 5"
    subBarCat "      Case 5"
    subBarCat "        strTimerCnt =  " & Chr(34) & "onooo" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 6"
    subBarCat "      Case 6"
    subBarCat "        strTimerCnt =  " & Chr(34) & "oonoo" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 7"
    subBarCat "      Case 7"
    subBarCat "        strTimerCnt =  " & Chr(34) & "ooono" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 8"
    subBarCat "      Case 8"
    subBarCat "        strTimerCnt =  " & Chr(34) & "oooon" & Chr(34) & ""
    subBarCat "         objShell.AppActivate sPID"
    subBarCat "         iCID = 1"
    subBarCat "   End Select "
    subBarCat "   document.getElementById(" & Chr(34) & "Stats" & Chr(34) & ").innerHTML = strTimerCnt"
    subBarCat "   If oFSO.FileExists(sStatusMsgFile) and oFSO.GetFile(sStatusMsgFile).Size <> 0 Then"
    subBarCat "      Set oStatusMsgFile = oFSO.OpenTextFile(sStatusMsgFile, 1)"
    subBarCat "      sStatusMsg = oStatusMsgFile.ReadAll"
    subBarCat "      oStatusMsgFile.Close"
    subBarCat "         If Trim(sStatusMsg) <> " & Chr(34) & "" & Chr(34) & " Then "
    subBarCat "            sStatusMsg = Replace(sStatusMsg, VbCrLf, " & Chr(34) & "<br>" & Chr(34) & ")"
    subBarCat "         Else"
    subBarCat "            sStatusMsg = " & Chr(34) & "" & Chr(34) & ""
    subBarCat "      End If "
    subBarCat "   Else"
    subBarCat "      sStatusMsg = " & Chr(34) & "" & Chr(34) & ""
    subBarCat "   End If "
    subBarCat "   document.getElementById(" & Chr(34) & "MyMsg" & Chr(34) & ").innerHTML = sStatusMsg"
    subBarCat " Elseif strStatus = " & Chr(34) & "End" & Chr(34) & " Then"
    subBarCat "   window.clearInterval(strTimer)"
    subBarCat "   document.getElementById(" & Chr(34) & "Stats" & Chr(34) & ").innerHTML = " & Chr(34) & "" & Chr(34) & ""
    subBarCat "   oFSO.DeleteFile " & chr(34) & sProgressBarMsgFile & Chr(34) & ", True"
    subBarCat " End If"
    subBarCat " End Sub"
    subBarCat "</SCRIPT>"
    subBarCat "<style>"
     'Change the settings in the two lines below to alter the colors of the window
    subBarCat "body,td,a {font-family:Arial;font-size:12px;text-decoration:none;color:black;}"
    subBarCat "body {filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#9999FF', EndColorStr='#FFFFFF')}"
    subBarCat ".pix {width: 1px; height 1px;}"
    subBarCat "</style>"
    subBarCat "</head>"
    subBarCat "<body>"
    subBarCat "<center>"
    subBarCat "<table width=" & Chr(34) & "275" & Chr(34) & ">"
    subBarCat " <tr><td>"
    subBarCat "   <fieldset><legend align=" & Chr(34) & "center" & Chr(34) & "><b> Please Be Patient </b></legend>"
    subBarCat "     <br><center>"
    subBarCat "       <span id=Stats style=" & Chr(34) & "font-family: wingdings;font-weight: bold;font-size:20px;" & Chr(34) & "></span>"
    subBarCat "     </center><br><br>"
    subBarCat "   </fieldset>"
    subBarCat " </td></tr>"
    subBarCat "</table>"
    subBarCat "<span id=MyMsg style=" & Chr(34) & "font-family: Ariel;font-size:12px;" & Chr(34) & "></span>"
    subBarCat "</body>"
    subBarCat "</html>"
    subWriteFile sProgressBarHTAFile, Join(aHTATextCat,VbCrLf)
    subWriteFile sProgressBarMsgFile, sMessageToDisplay
    oShell.Run sProgressBarHTAFile, 1, False 
 End Sub
 
 Private Sub subBarCat(sStringToAdd)
    ReDim Preserve aHTATextCat(iBarElementCount)
    aHTATextCat(iBarElementCount) = sStringToAdd
    iBarElementCount = iBarElementCount + 1
 End Sub
 
 Public Sub CloseBar()
    subKillFile sProgressBarRunFile
    sProgressBarHTAFileKiller = sTempRoot & "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)
    sProgressBarMsgTempFile = sTempRoot & oFSO.GetTempName & ".tmp"
    subWriteFile sProgressBarMsgTempFile, sNewText      
    subKillFile sProgressBarMsgFile
    oFSO.MoveFile sProgressBarMsgTempFile, sProgressBarMsgFile
 End Sub 
 
 Private Sub subKillFile(sFileToKill)
       If oFSO.FileExists(sFileToKill) Then oFSO.DeleteFile sFileToKill, True 
 End Sub
 Private Sub subWriteFile(sFileToWrite, sTextToWrite)
       If not oFSO.FileExists(sFileToWrite) Then oFSO.CreateTextFile sFileToWrite
    Set oFileToWrite = oFSO.OpenTextFile(sFileToWrite,8)
    oFileToWrite.WriteLine sTextToWrite
    oFileToWrite.Close
 End Sub
 Private Sub Class_Terminate()
 End Sub 
 End Class

ebgreen Total Posts : 8081 Scores: 94 Reward points : 0 Joined: 7/12/2005	RE: Dynamic Activity Window - Wednesday, April 05, 2006 4:58 AM 0 Put: Dim WshShell just after the Option Explicit line "... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm http://www.visualbasicscript.com/m_47117/tm.htm

usavic Total Posts : 10 Scores: 0 Reward points : 0 Joined: 3/17/2006	RE: Dynamic Activity Window - Wednesday, April 05, 2006 5:30 AM 0 So I am assuming, I am going to have to declare all the variables since I am using this class??

usavic Total Posts : 10 Scores: 0 Reward points : 0 Joined: 3/17/2006	RE: Dynamic Activity Window - Wednesday, April 05, 2006 5:34 AM 0 By the way, is there any way to terminate the script??

ebgreen Total Posts : 8081 Scores: 94 Reward points : 0 Joined: 7/12/2005	RE: Dynamic Activity Window - Wednesday, April 05, 2006 5:42 AM 0 Anytime you use Option Explicit you must Dim all variables. That is its purpose. WScript.Quit will terminate execution. "... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm http://www.visualbasicscript.com/m_47117/tm.htm

usavic Total Posts : 10 Scores: 0 Reward points : 0 Joined: 3/17/2006	RE: Dynamic Activity Window - Wednesday, April 05, 2006 5:57 AM 0 So after declaring the variables, my script runs fine and the activity window shows, but it stays there as if in an infinite loop. Any suggestions??

usavic Total Posts : 10 Scores: 0 Reward points : 0 Joined: 3/17/2006	RE: Dynamic Activity Window - Wednesday, April 05, 2006 6:06 AM 0 So my antyspyware kept detecting it and creating a delay that would throw it into the loop. Now it's working perfectly. Thanx so much for the help, I really appreciate it, and it's been very useful

NssB Total Posts : 31 Scores: 0 Reward points : 0 Joined: 6/26/2006	RE: Dynamic Activity Window - Tuesday, July 11, 2006 6:09 PM 0 Strange.... Copy/Pasted exactly what you have into VBS file....ran it and got....... Line: 162 Code: 2 Error: The system cannot find the file specified Number: 80070002 This line points to: " oBarCat.Add oBarCat.Count, "</table>"" Any ideas? Its all about the code!

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

RE: Dynamic Activity Window - Tuesday, July 11, 2006 10:44 PM

ORIGINAL: NssB

Strange....

Copy/Pasted exactly what you have into VBS file....ran it and got.......

Line: 162
Code: 2
Error: The system cannot find the file specified
Number: 80070002

This line points to: " oBarCat.Add oBarCat.Count, "</table>""

Any ideas?

Very strange. I copy/pasted the code from my post into a new .vbs, and it worked fine. And my line 162 is a bit different from yours.

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

NssB Total Posts : 31 Scores: 0 Reward points : 0 Joined: 6/26/2006	RE: Dynamic Activity Window - Thursday, July 13, 2006 4:42 AM 0 Very strange. I copy/pasted the code from my post into a new .vbs, and it worked fine. And my line 162 is a bit different from yours. ok, starting to get very weird now. Tried it on XP machine at home, working 100% I use a Win2K machine at work. Could this be an issue? Regards NssB

ebgreen Total Posts : 8081 Scores: 94 Reward points : 0 Joined: 7/12/2005	RE: Dynamic Activity Window - Thursday, July 13, 2006 6:36 AM 0 What is the version of WSH on each machine? "... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm http://www.visualbasicscript.com/m_47117/tm.htm

Fredledingue Total Posts : 572 Scores: 0 Reward points : 0 Joined: 5/9/2005 Location: Europe	RE: Dynamic Activity Window - Sunday, July 16, 2006 10:55 AM 0 Running on w98 but with WSH 5.6, I get an error. (at least with the HTA version of this progress bar) Probably because of the WMI object that doesn't exists on w98 Fred

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

RE: Dynamic Activity Window - Tuesday, July 18, 2006 3:45 AM

I updated the comments to reflect the WMI issue. Good catch! I don't utilize Win98 anywhere anymore, so am unable to do any testing.

It probably won't work with Windows for Workgroups 3.11 either. heh heh

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

alienprotein

Total Posts : 50
Scores: 0
Reward points : 0
Joined: 2/23/2005
Location: USA

RE: Dynamic Activity Window - Friday, August 04, 2006 6:13 AM

DiGiTAL.SkReAM

Thank you very much for pointing me to this code. Very nice, to say the least. I plugged in the code below and it does exactly what I want it too do, however I have a consideration you may be able to assist with.

My intention for this script is to give something visual the our VPN users letting then know the VPN login script is doing something and then notify them once it is complete. Otherwise they complain that Lotus Notes is erroring out due to not finding their ID file, etc...Blah blah...

So this works great for kicking off the script as a local admin on the laptop, but when logging in as a non privileged user I get the following error.

Windows Script Host
Line: 180
Char: 1
Error: Invalid root in registry key "HKLM\SYSTEM\PROGRESSBAR\MSG".
Code: 80070005
Source: WshShell.RegWrite

I attempted to replace "HKLM" with "HKCU" but it too generates almost the exact same error. When "HKCU" is tested with Admin rights it works perfectly.

Any ideas how to get this to run on a non-privileged user account (As we will not\Never allow our users local admin rights?)

 'Option Explicit 
 Dim StrPath
 Dim WshShell
 Dim oBar
 
 Set oBar = New ProgressBar
 Set WshShell = WScript.CreateObject("WScript.Shell")
 oBar.StartBar "Please wait while network drives are mapped."
 WScript.Sleep (8000)
 
 [color=#ff0000]WshShell.Run("C:\temp\test.vbs")[/color]
 [color=#ff0000]ReturnCode = WshShell.Run("C:\temp\test.vbs", 1, True)[/color]
 oBar.SetLine "Drive mapping completed......"
 WScript.Sleep (6000)
 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) & ">W&K VPN 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, "    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> VPN Login in Progress </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

Also, I hae been unable to identify where to change the value that forces the status box on top of everything.Any advice would be useful...

Regards,

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

RE: Dynamic Activity Window - Friday, August 04, 2006 10:19 AM

Thanks for the tip! I decided to do some testing, so...
Created a new winxp virtual machine in vmware server.
Created a new user called User. Member of users group only.
Opened Regedit and verified that the user was able to modify/add/subtract from HKCU, and that HKLM was refused. User had read only access to HKLM.
Ran your script that you posted, it bombed with the same error you reported.
I changed the HKLM's to HKCU, and ran it again.
It worked as advertised.

Are you running some GPOs that I don't know about, or possibly have some default security settings that prevent this behavior? because everything that i ahve seen and read on the subject suggests that a normal - NON privileged user has change access to HKCU.

Here is the code that ran fine for me:
You will notice that I commented out your commands in the very beginning, and that I changed HKLM to HKCU except for inside of the Subroutine 'subKillRegKey'. I had to leave that one so that HKLM nicknames would be recognized.

 'Option Explicit 
 Dim StrPath
 Dim WshShell
 Dim oBar
 Set oBar = New ProgressBar
 Set WshShell = WScript.CreateObject("WScript.Shell")
 oBar.StartBar "Please wait while network drives are mapped."
 WScript.Sleep (8000)
 '[color=#ff0000]WshShell.Run("C:\temp\test.vbs")[/color]
 '[color=#ff0000]ReturnCode = WshShell.Run("C:\temp\test.vbs", 1, True)[/color]
 oBar.SetLine "Drive mapping completed......"
 WScript.Sleep (6000)
 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) & ">W&K VPN 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, "    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) & "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 = oShell.RegRead(" & Chr(34) & "HKCU\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> VPN Login in Progress </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 "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.DeleteFile " & Chr(34) & sProgressBarHTAFileKiller & Chr(34) & ", True"
 oShell.Run 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 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

Here is the answer to your second question:

 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 "

It finds the PID of the mshta.exe that is running the progressbar hta file, and performs an appactivate on it.
The sProgressbarSleepFile that is being run during every do...loop is my own way of doing a "sleep" function from an hta since you can't use 'wscript.sleep(2000)'. Basically, it is a text file taht is created earlier in the script execution that contains the line:
wscript.sleep(1000)
This gets run giving me a nice sleep function.
And then the appactivate forces focus to the hta progressbar.

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

alienprotein

Total Posts : 50
Scores: 0
Reward points : 0
Joined: 2/23/2005
Location: USA

RE: Dynamic Activity Window - Monday, August 07, 2006 1:41 AM

Are you running some GPOs that I don't know about, or possibly have some default security settings that prevent this behavior? because everything that i ahve seen and read on the subject suggests that a normal - NON privileged user has change access to HKCU.

You hit the nail right on the head Digital.Skream. Once I moved the test user account from the Test OU to the standard users OU, everything worked.

Thanks again for this wonderful piece of code.

stephen.wolfe

Total Posts : 117
Scores: 0
Reward points : 0
Joined: 8/9/2005
Location: Tampa, FL

RE: Dynamic Activity Window - Wednesday, August 30, 2006 5:11 AM

I just found this code, looking for progressbar code I could shamelessly borrow ... <g>, anyway, I wanted to see what it did so I copied the code into a .vbs file, took the blank line above 'Option Explicit', ran it and got the following error:

Script:     D:\$$Logon_Script\ProgressBar2.vbs
Line:        3
Char:      16
Error:      Expected identifier
Code:     800A03F2
Source   Microsoft VBScript compilation error

Here is the code I copied from the forum:

  
 Option Explicit
 Dim oBar
 Set oBar = New <span class="high">Progress</span>Bar
 oBar.StartBar "This is a test."
 WScript.Sleep (3000)
 oBar.SetLine "So is this."
 WScript.Sleep (3000)
 oBar.CloseBar
 
 Class <span class="high">Progress</span>Bar
 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\<span class="high">Progress</span>Bar\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\<span class="high">Progress</span>Bar\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\<span class="high">Progress</span>Bar\MSG", sMessageToDisplay, "REG_SZ"
 oShell.Run sProgressBarHTAFile, 1, False 
 End Sub
 Public Sub CloseBar()
 fKillFile sProgressBarRunFile
 Dim sProgressBarHTAFileKiller
 subKillRegKey "HKLM\SYSTEM\<span class="high">Progress</span>Bar","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\<span class="high">Progress</span>Bar\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'm probably more of a newbie than some of the other posters, but I don't understand why that eroor happened?

Steve

stephen.wolfe

Total Posts : 117
Scores: 0
Reward points : 0
Joined: 8/9/2005
Location: Tampa, FL

RE: Dynamic Activity Window - Wednesday, August 30, 2006 7:29 AM

Never Mind, I fixed it the problem. Gee, the weather must be making me crazy, anyway, for some strange reason some HTML tags got mixed up in the code. I was like staring right at them but didn't have enough sense to see that was the problem.

Once I got my ass in gear and removed the tags the demo worked perfect.

Digital Screamer, great piece of code, I think this will be very useful for the roll out we are fixing to do.

Thanks!!!!

Steve

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

RE: Dynamic Activity Window - Thursday, August 31, 2006 9:31 PM

New info: I was just testing and found that IE 7 beta breaks this class. There is something different with the way that it displays the fonts, I think, that is causing problems with the 'scrolling'.
I'm still trying to pin down a fix.

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

TNO Total Posts : 2089 Scores: 34 Reward points : 0 Joined: 12/18/2004 Location: Earth	RE: Dynamic Activity Window - Sunday, November 26, 2006 9:57 AM 0 I've tinkered with your problem a little more and still not 100% sure of the reason....Have you tried reinstalling WScript? That may rebind the engine to the browser properly. *To iterate is human, to recurse divine.* -- L. Peter Deutsch

Snipah Total Posts : 1339 Scores: 8 Reward points : 0 Joined: 11/1/2004 Location: Scotland	RE: Dynamic Activity Window - Monday, November 27, 2006 1:05 AM 0 I have it working with IE7.....and it works like a charm.... For more information, please see the "Read me First" topic. http://www.visualbasicscript.com

DiGiTAL.SkReAM Total Posts : 1259 Scores: 7 Reward points : 0 Joined: 9/7/2005 Location: Clearwater, FL, USA	RE: Dynamic Activity Window - Monday, November 27, 2006 1:58 AM 0 Did you do anything to get it to work, or did it just work outta the box for you? "Would you like to touch my monkey?" - Dieter (Mike Meyers) "It is better to die like a tiger, than to live like a pussy." -Master Wong, from Balls of Fury

TNO

Total Posts : 2089
Scores: 34
Reward points : 0
Joined: 12/18/2004
Location: Earth

RE: Dynamic Activity Window - Monday, November 27, 2006 2:56 AM

Alot of people on the web are having troubles with IE7, nothing specific towards the scripting engine though. From what I can gather, re-installing one or the other or both fixed a majority of the cases. No one else has had a similar issue with rendering anomalies. So in short...I still have no idea what the problem is, lol

To iterate is human, to recurse divine. -- L. Peter Deutsch

Snipah Total Posts : 1339 Scores: 8 Reward points : 0 Joined: 11/1/2004 Location: Scotland	RE: Dynamic Activity Window - Monday, November 27, 2006 4:10 AM 0 I took the code from this (http://www.visualbasicscript.com/m_32390/mpage_2/key_/tm.htm#) post.... (Post #: 24) and voila....only modifications are to remove the <span.... in between the code...... For more information, please see the "Read me First" topic. http://www.visualbasicscript.com

TNO Total Posts : 2089 Scores: 34 Reward points : 0 Joined: 12/18/2004 Location: Earth	RE: Dynamic Activity Window - Monday, November 27, 2006 10:11 AM 0 This calls for a group hug *To iterate is human, to recurse divine.* -- L. Peter Deutsch

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

RE: Dynamic Activity Window - Tuesday, November 28, 2006 2:36 AM

Yer killing me. I still have the same problem with it. I run it, and it just sits there until I wave the mouse cursor over the window - at which point it updates, but only for as long as the mouse cursor is moving. Once the mouse stops moving, the window stops updating. Maybe I'm missing a patch or something...

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

Snipah Total Posts : 1339 Scores: 8 Reward points : 0 Joined: 11/1/2004 Location: Scotland	RE: Dynamic Activity Window - Tuesday, November 28, 2006 6:13 AM 0 I suggest you test it on a Virtual Machine environment..clean slate....easy to rebuild.... and ofcourse, the group hug For more information, please see the "Read me First" topic. http://www.visualbasicscript.com

TNO

Total Posts : 2089
Scores: 34
Reward points : 0
Joined: 12/18/2004
Location: Earth

RE: Dynamic Activity Window - Saturday, December 02, 2006 7:54 AM

This looks like a reproducible bug...look what I found on MSDN:

I'm originally an MCSE and Web designer, creating enterprise HTA solutions for my company. I've found lots of bugs and workarounds when using HTAs as an application which may be inherited from the Internet Explorer DOM. One of them is threading where I use setTimeout functions. My question is: why does the GUI (window) freeze on time-consuming operations? Is mshta.exe actually a J++ compiled application?I'm not sure. No, an HTA isn't actually a J++ compiled application. Please send some details about the freezing problem to scripter@microsoft.com with subject "HTA FREEZE" and we'll see what we can do.

...

The "freeze" issue is the same thing I mentioned in my previous question. No output shows up until the sub finishes.
Can't really give you an answer right now. If you want to zip up the HTA and email it to scripter@microsoft.com we'll try to take a look at it.

My god....no wonder its so hard to find good hta applications out there...The microsoft scripting guys no next to nothing when it comes to anything related to web development teechniques....just take a glance at the answers they give to these questions people ask:

http://www.microsoft.com/technet/scriptcenter/webcasts/sweek3/day4qanda.mspx

To iterate is human, to recurse divine. -- L. Peter Deutsch

TNO Total Posts : 2089 Scores: 34 Reward points : 0 Joined: 12/18/2004 Location: Earth	RE: Dynamic Activity Window - Saturday, December 02, 2006 7:59 AM 0 Heres another thought....have you tried changing all your Subs to Functions? I have IE7 Beta 2 still, so anything I test isn't going to be accurate.... *To iterate is human, to recurse divine.* -- L. Peter Deutsch

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

RE: Dynamic Activity Window - Saturday, December 09, 2006 7:23 PM

Ok, I solved the problem.
I am pasting the correct, current version of the code below, sicne I - for some reason - am unable to edit my original post in this thread.
The solution was to move the cycling into a second window.setInterval.
So, instead of creating a single timer to update the hta's display and then running a do...loop to perform the 'waiting' function, I just stuffed the do...loop into a second timer function.
Also, I cleaned up a lot of the code. After seeing others' nice and neat hta code, I was starting to feel ebarrassed.

So, now I have tested this on WinXP with IE6 & IE7 and it works juuuuuust fine.

Oh, and thanks go to anoop_pv7 for motivating me to get off my lazy a$$ and fix this shizit by posting his own timer bar!

 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, "<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 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"
  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 = "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

EDIT: Would it be possible for a forum admin to copy the above code and paste it into the original post in this thread? Or prefereably make it so that I can edit the original?

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

TNO Total Posts : 2089 Scores: 34 Reward points : 0 Joined: 12/18/2004 Location: Earth	RE: Dynamic Activity Window - Saturday, December 09, 2006 10:14 PM 0 Looks good, working here too *To iterate is human, to recurse divine.* -- L. Peter Deutsch

ehvbs

Total Posts : 3310
Scores: 110
Reward points : 0
Joined: 6/22/2005
Location: Germany

RE: Dynamic Activity Window - Monday, December 11, 2006 10:10 AM

Hi DiGiTAL.SkReAM,

your nice/interesting code is working here (W2K, IE 6.0) too! I look forward to
study it in detail.

One hasty (?) remark: Default action for .vbs on my computer is "edit it with UltraEdit";
that makes killing rather difficult! How do you think about using "cscript " as a prefix
for automagically running scripts?

ehvbs

DiGiTAL.SkReAM

Total Posts : 1259
Scores: 7
Reward points : 0
Joined: 9/7/2005
Location: Clearwater, FL, USA

RE: Dynamic Activity Window - Tuesday, December 12, 2006 2:39 AM

Hmmm... I hadn't really even considered that some people might have modified their setups so that running a .vbs file doesn't actually RUN it, but rather opens it with another app.
This should fix that issue. Also, I took this opportunity to remove the extra "oBarCat.Add oBarCat.Count, "<html>"" that I had in there.

 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, "    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 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"
 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 = "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 "%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 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

"Would you like to touch my monkey?" - Dieter (Mike Meyers)

"It is better to die like a tiger, than to live like a pussy."
-Master Wong, from Balls of Fury

Change Page: 1 2 > | Showing page 1 of 2, messages 1 to 40 of 60