Solved

VBScript - How Do I integrate Progress Bar into Script

Posted on 2009-05-05
7
8,035 Views
Last Modified: 2012-05-06
Greetsings Experts,

I have a script that I was able to get a simple progress bar function to run on it.  It works fine with no errors, but the only way that I can get it to work is to put it as the very first thing in the code.  It runs before the script start and then closes...the Script runs after that.

What I need help with is  somehow modifying  the progress bar code so that it actually runs at the same time while the script is running.  I have created an .hta file for the Gui that has a progress bar embedded into the frame.   Is it possible to:

1.  Can I get the progress bar script to run while the script is running
2.  Is there a method where I can call the progress bar to in the exactly spot that I have build into the .hta file.   I have included samples of code below.
1.  This is the code that I get to run the progress bar:
 
'**********************************************************************************************
On Error Resume Next
Dim bar, i 
Set bar = new IEProgBar
With bar 
.Move -1, -1, 500, -1
.Units = 100
.Show
For i = 0 to 100
WScript.Sleep 500
.Advance
Next
End With 
Set bar = Nothing 
 
'-------- Start Progress bar Class ----------------------------------
Class IEProgBar
Private FSO, IE, BCol, TCol, ProgCol, ProgNum, ProgCaption, Pic, Q2, sTemp, iProg, ProgTitle
 
Private Sub Class_Initialize()
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
sTemp = FSO.GetSpecialFolder(2)
Set IE = CreateObject("InternetExplorer.Application") 
With IE
.AddressBar = False
.menubar = False
.ToolBar = False
.StatusBar = False
.width = 400
.height = 120
.resizable = True
End With 
BCol = "E0E0E4" '--background color.
TCol = "000000" '--caption text color.
ProgCol = "0000A0" '--progress color.
ProgNum = 19 'number of progress units.
ProgCaption = "Progress. . ."
ProgTitle = "Progress"
Q2 = chr(34)
iProg = 0 '--to track progress.
End Sub
 
Private Sub Class_Terminate()
On Error Resume Next
IE.Quit
Set IE = Nothing 
Set FSO = Nothing 
End Sub
 
Public Sub Show()
Dim s, i, TS
On Error Resume Next
s = "<HTML><HEAD><TITLE>" & ProgTitle & "</TITLE></HEAD>"
s = s & "<BODY SCROLL=" & Q2 & "NO" & Q2 & " BGCOLOR=" & Q2 _
& "#" & BCol & Q2 & " TEXT=" & Q2 & "#" & TCol & Q2 & ">"
If (Pic <> "") Then 
s = s & "<IMG SRC=" & Q2 & Pic & Q2 & " ALIGN=" & Q2 & "Left" & Q2 & ">"
End If
If (ProgCaption <> "") Then
s = s & "<FONT FACE=" & Q2 & "arial" & Q2 & " SIZE=2>" _
& ProgCaption & "</FONT><BR><BR>"
Else
s = s & "<BR>"
End If
s = s & "<TABLE BORDER=1><TR><TD><TABLE BORDER=0 CELLPADDING=0 CELLSPACING=0><TR>"
For i = 1 to ProgNum
s = s & "<TD WIDTH=16 HEIGHT=16 ID=" & Q2 & "P" & Q2 & ">"
Next
s = s & "</TR></TABLE></TD></TR></TABLE><BR><BR></BODY></HTML>" 
Set TS = FSO.CreateTextFile(sTemp & "\iebar1.html", True)
TS.Write s
TS.Close
Set TS = Nothing
IE.Navigate "file:///" & sTemp & "\iebar1.html"
IE.visible = True
End Sub
 
'-- Advance method colors one progress unit. 
' iProg variable tracks how many
'-- units have been colored.
' Each progress unit is a <TD> with ID="P". They can be
'-- accessed in sequence through Document.All.Item.
 
Public Sub Advance()
On Error Resume Next
If (iProg < ProgNum) and (IE.Visible = True) Then
IE.Document.All.Item("P", (iProg)).bgcolor = Q2 & "#" _
& ProgCol & Q2
iProg = iProg + 1
End If 
End Sub
 
'--resize and/or position window. Use -1 For any value Not being Set.
Public Sub Move(PixLeft, PixTop, PixWidth, PixHeight)
On Error Resume Next
If (PixLeft > -1) Then IE.Left = PixLeft
If (PixTop > -1) Then IE.Top = PixTop
If (PixWidth > 0) Then IE.Width = PixWidth
If (PixHeight > 0) Then IE.Height = PixHeight
End Sub
 
'--remove Registry settings that display advertising in the IE title bar.
'-- This change won't show up the first time it's used because the IE
'-- instance has already been created when the method is called.
 
Public Sub CleanIETitle()
Dim sR1, sR2, SH
On Error Resume Next
sR1 = "HKLM\Software\Microsoft\Internet Explorer\Main\Window Title"
sR2 = "HKCU\Software\Microsoft\Internet Explorer\Main\Window Title"
Set SH = CreateObject("WScript.Shell") 
SH.RegWrite sR1, "", "REG_SZ"
SH.RegWrite sR2, "", "REG_SZ"
Set SH = Nothing 
End Sub
 
'------------- Set background color: ---------------------
 
Public Property Let BackColor(sCol)
If (TestColor(sCol) = True) Then BCol = sCol
End Property
 
'------------- Set caption color: ---------------------
 
Public Property Let TextColor(sCol)
If (TestColor(sCol) = True) Then TCol = sCol
End Property
 
'------------- Set progress color: ---------------------
 
Public Property Let ProgressColor(sCol)
If (TestColor(sCol) = True) Then ProgCol = sCol
End Property
 
'------------- Set icon: ---------------------
 
Public Property Let Icon(sPath)
If (FSO.FileExists(sPath) = True) Then Pic = sPath
End Property
 
'------------- Set title text: ---------------------
 
Public Property Let Title(sCap)
ProgTitle = sCap
End Property
 
'------------- Set caption text: ---------------------
 
Public Property Let Caption(sCap)
ProgCaption = sCap
End Property
 
'------------- Set number of progress units: ---------------------
 
Public Property Let Units(iNum)
ProgNum = iNum
End Property
 
'--confirm that color variables are valid 6-character hex color codes:
'-- If Not 6 characters Then TestColor = False
'-- If any character is Not 0-9 or A-F Then TestColor = False
 
Private Function TestColor(Col6)
Dim iB, sB, iB2, Boo1
On Error Resume Next
TestColor = False
If (Len(Col6) <> 6) Then Exit Function
For iB = 1 to 6
sB = Mid(Col6, iB, 1)
iB2 = Asc(UCase(sB))
If ((iB2 > 47) and (iB2 < 58)) or ((iB2 > 64) and (iB2 < 71)) Then
Boo1 = True
Else
Boo1 = False
Exit For
End If
Next
If (Boo1 = True) Then TestColor = True 
End Function
 
End class
'**********************************************************************************************
 
 
 
 
2.  This the section of my main code that I am trying to synch up with the Progress BarCode.  I want to get the progress bar to run during the functions that are call in either side of the IFThenElse statement:
'********************************************************************************************
If backupOrRestoreResponse = 0 Then
	executeBackup
	executePermissions
			ElseIf backupOrRestoreResponse = 1 Then				
			executeRestore
			  deleteBackup
	Else
	MsgBox "You did not enter a valid number."	
End If	
  Else
     MsgBox "You did not enter a valid number."
  End If
Else
    MsgBox "You did not enter a valid number."
End If
'******************************************************************************************************
 
 
3.   This Is the HTML code on my .hta shell that creates a space for a progress bar.   I am trying to figure out to get the bar to pop up at these same dimensions and run in that space:
 
<DIV>
   ...
<HTML>
   ...
<SCRIPT>
   ...
</SCRIPT>
</HEAD>
<BODY bgcolor="white">
      <H3>Data Migration Status:</H3>
  <DIV id=lblStatus class=clsIndent>Ready to begin</DIV>
  <H3><span style="text-decoration:underline">Click the Start Button</span> to begin the process. <br><span style="text-decoration:underline">Click the Close Button</span> when the process has finished:</H3><br>
    <DIV id=lblMore class=clsIndent></DIV><br>
  <DIV>
    <INPUT type=button id=cmdStart value="Start"> 
    <INPUT type=button id=cmdReset value=Reset disabled>
    <button accesskey=C id=buttonClose onclick=ButtonCloseClick><U>C</U>lose</button><br><br><br>
     <p>
		<object classid="clsid:35053A22-8589-11D1-B16A-00C0F0283628" id="ProgressBar1" height="20" width="400">
    <param name="Min" value="0">
    <param name="Max" value="100">
    <param name="Orientation" value="0">
    <param name="Scrolling" value="1">
		</object>
		</p><br><br>
  </DIV>
</BODY>
</HTML>

Open in new window

0
Comment
Question by:aceklub97
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
7 Comments
 
LVL 14

Expert Comment

by:rejoinder
ID: 24378740
Can you please post the entire HTA.  I cannot proceed without seeing the functions being referenced in area #2.
0
 

Author Comment

by:aceklub97
ID: 24380822
Here is the .HTA that you requested.  Please let me know if you need any other information.
<HTML>
<HEAD>
  <TITLE>
    Nationwide Sales Solutions - Training Room Data Migration Tool
  </TITLE>
  <link href="\\10.120.28.74\scripts\Backup\nwlogo.ico" type="text/css" rel="stylesheet">
  <HTA:application scroll=yes>
  <STYLE>
    div.clsIndent {margin-left: 30px}
    div.clsIndentRed {margin-left: 30px; color: red}
  </STYLE>
  <SCRIPT language=VBScript>
    Option Explicit
    Const WshRunning = 0
    Const WshFinished = 1
    Dim wshShell
    Dim wseExternal
    Dim tmrExternal
    Dim strComputer
    Dim objWMIService
    Dim colItems
    Dim intHorizontal
    Dim intVertical
    Dim objExplorer
    Dim colServices
    Dim intServices
    Dim intIncrement
 
    Sub cmdStart_onclick()
      On Error Resume Next
      Set wseExternal = _
        wshShell.Exec("wscript.exe //NOLOGO \\10.120.28.74\scripts\Backup\nss_Backuptest.vbs")
        If Err.number <> 0 Then
        lblStatus.innerText = "Failed to start!"
      Else
        lblStatus.innerText = "Your Backup/Restore is in progress.  Please wait ... This process could take several minutes to complete." _
        
        cmdStart.disabled = True
        cmdReset.disabled = true
        tmrExternal = _
          window.setInterval("tmrExternal_timer", _
                             1000, _
                             "VBScript")             	       
       End if
        
End sub
 
'sub cmdStart_Progress()
'End sub
 		    
    Sub cmdReset_onclick()
      lblStatus.innerText = "Click the Start Button to begin the process:"
      lblResults.innerHTML = " "
      lblMore.innerHTML = ""
      cmdReset.disabled = true
      cmdStart.disabled = False
    End Sub
   
   'Button Close
		Sub ButtonCloseClick()
      If msgbox ("Are you sure you want to Close?",4,"Close Backup?") = vbYes then
            window.Close
      End if
		End Sub 
    Sub Continue()
      lblMore.innerHTML = _
          "The Data Migration process has completed.<br>" _
        & vbCrLf & "If you have just backed up your PC, please go to your new PC and run this process again, selecting '1' for restore.<P>" _
        & vbCrLf & "If you have just restored you data to the new PC, then your work is done. Please double check to make sure everything was successfully transfered.<br>" _
        & vbCrLf & "If you have any computer related issues, please call the IT Service Desk at 515-508-8515." _
        & VbCrLf & VbCrLf
    cmdReset.disabled = true
    End Sub
 
    Sub tmrExternal_timer()
      With lblStatus
        If wseExternal.Status = WshRunning Then
          If .className = "clsIndentRed" Then
            .className = "clsIndent"
          Else
            .className = "clsIndentRed"
          End If
        Else
          window.clearInterval tmrExternal
          .innerText = _
              "Finished. Exit code " _
            & CStr(wseExternal.ExitCode)
          .className = "clsIndent"
          Set wseExternal = Nothing
          window.setTimeout "Continue", 200, "VBScript"
        End If
      End With
    End Sub
 
    Sub window_onload()
      Set wshShell = CreateObject("WScript.Shell")
    End Sub
 
    Sub window_onunload()
      Set wshShell = Nothing
    End Sub
</SCRIPT>
</HEAD>
<BODY bgcolor="white">
    <img src="\\10.120.28.74\scripts\Backup\image002.gif" alt="Go"><br><br><br><br><br><br>
  <H3>Data Migration Status:</H3>
  <DIV id=lblStatus class=clsIndent>Ready to begin</DIV>
  <H3><span style="text-decoration:underline">Click the Start Button</span> to begin the process. <br><span style="text-decoration:underline">Click the Close Button</span> when the process has finished:</H3><br>
    <DIV id=lblMore class=clsIndent></DIV><br>
  <DIV>
    <INPUT type=button id=cmdStart value="Start"> 
    <INPUT type=button id=cmdReset value=Reset disabled>
    <button accesskey=C id=buttonClose onclick=ButtonCloseClick><U>C</U>lose</button><br><br><br>
    <img src="\\10.120.28.74\scripts\Backup\image001.gif" alt="Go"><br><br><br><br>
     <p>
		<object classid="clsid:35053A22-8589-11D1-B16A-00C0F0283628" id="ProgressBar1" height="20" width="400">
    <param name="Min" value="0">
    <param name="Max" value="100">
    <param name="Orientation" value="0">
    <param name="Scrolling" value="1">
		</object>
		</p><br><br>
  </DIV>
</BODY>
</HTML>

Open in new window

0
 
LVL 65

Accepted Solution

by:
RobSampson earned 500 total points
ID: 24469413
Hey mate,

You can adjust the "value" of the Progress bar at any time throughout your code, so you're probably better off using
ProgressBar1.Value = 50

to set it to 50% percent when your code is half way done.

See the below sample HTA on how this is done when the amount of time is known.  Unfortunately, without knowing the time, it's hard to get the bar accurate....

Regards,

Rob.
<Html>
<Head>
<Title>Progress Bar Sample</Title>
 
<HTA:Application
Caption = Yes
Border = Thick
ShowInTaskBar = Yes
SingleInstance = Yes
MaximizeButton = Yes
MinimizeButton = Yes>
 
<script Language = VBScript>
 
Sub StartProgress
	btnStart.disabled = True
	' The larger intIncrement is set, the shorter time it will take when it counts in seconds
	intIncrement = 20
	For intCount = 0 To (100 / intIncrement) - 1
		spanProgress.InnerHTML = "Seconds remaining: " & (100 / intIncrement) - (intCount)
	    HTASleep 1
	    ProgressBar1.Value = ProgressBar1.Value + intIncrement
	Next
	spanProgress.InnerHTML = "Seconds remaining: 0"
	btnStart.disabled = False
End Sub
 
Sub HTASleep(intSeconds)
	Set objShell = CreateObject("WScript.Shell")
	objShell.Run "ping 127.0.0.1 -n " & intSeconds + 1, 0, True
End Sub
 
</script>
<body>
<p>
<object classid="clsid:35053A22-8589-11D1-B16A-00C0F0283628" id="ProgressBar1" height="20" width="400">
    <param name="Min" value="0">
    <param name="Max" value="100">
    <param name="Orientation" value="0">
    <param name="Scrolling" value="1">
</object>
</p>
<span id="spanProgress">Click Start to begin...</span>
<br><br>
<button accesskey="S" id="btnStart" onclick="vbs:StartProgress"><U>S</U>tart</button>
</body>
</head>
</html>

Open in new window

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 65

Expert Comment

by:RobSampson
ID: 24469416
Oh, P.S. that sample was based on this code:
http://www.microsoft.com/technet/scriptcenter/topics/activex/progressbar.mspx

Regards,

Rob.
0
 

Author Closing Comment

by:aceklub97
ID: 31578298
Thanks again Rob.  I get the concept.  I just need to play with it to get it right.
0
 
LVL 65

Expert Comment

by:RobSampson
ID: 24489297
OK, thanks for the grade. Good luck with it...

Regards,

Rob.
0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Subtraction v Hex2Dec in vbscript 6 30
Validating Date 4 29
What cart is this? 2 38
Telerik RadEditor Control Save 8 15
This article describes how to create custom column layout styles for Bootstrap. The article uses 5 columns to illustrate the concept, but the principle can be extended to any number of columns.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
In this tutorial viewers will learn how to style elements, such a divs, with a "drop shadow" effect using the CSS box-shadow property Start with a normal styled element, such as a div.: In the element's style, type the box shadow property: "box-shad…
The viewer will learn the basics of jQuery, including how to invoke it on a web page. Reference your jQuery libraries: (CODE) Include your new external js/jQuery file: (CODE) Write your first lines of code to setup your site for jQuery.: (CODE)

726 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question