Solved

How do I create a progress windows (through command prompt or something else) while using a vb/hta script

Posted on 2007-12-03
7
1,401 Views
Last Modified: 2008-02-01
I've got a HT script with a pretty lenghty vbscript encapsulated inside.

This is a post imaging install/configuation script. I want give the user a progress of what the script is doing through each step. Can someone show me how I could have this work to a txt file or command prompt. This would have to happen live while the script is working.

Thanks
0
Comment
Question by:WinPE
  • 3
  • 3
7 Comments
 
LVL 12

Expert Comment

by:chandru_sol
ID: 20397268
Can you post your HTA script to better understand?
0
 

Author Comment

by:WinPE
ID: 20398345
Here it is, took out alot of domain/site specific stuff

Thanks!
html>
<head>
<TITLE> Image Setup</TITLE>
<HTA:APPLICATION
   ID="objHTA"
   APPLICATIONNAME="PostSetup"
   SCROLL="yes"
   SINGLEINSTANCE="yes"
>
</head>
 
<SCRIPT LANGUAGE="VBScript">
 
Const adOpenStatic=3
Const adLockOptimistic=3
Const adCmdText=&H0001
 
Set objNetwork = CreateObject("Wscript.Network")
Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
 
 
strRegion=""
strColo=""
strColoCode=""
strSyslog=""
strTimeZone=""
strNtp=""
strYw1=""
strYw2=""
strYw3=""
 
 
 
 
 
Sub RunScript (strColoCode, strNewPasswd, strDomainPswd, strDomainUser)
 
 
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
Dim strComputer
Dim manufacturer, model, ver
 
 
Dim objNetwork, WshEnv, foldersys
Dim objFSO, objShell, objWMIService
 
On Error Resume Next
strComputer = "."
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objShell = CreateObject("Wscript.Shell")
Set objNetwork = CreateObject("Wscript.Network")
Set WshEnv = objShell.Environment("PROCESS")
 
 
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colmodel = objWMIService.ExecQuery("SELECT * FROM Win32_ComputerSystem")  
 
 
For Each objitem in colmodel
    model = objitem.model
	manufacturer = objitem.manufacturer
Next
 
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
 
Set colOperatingSystems = objWMIService.ExecQuery _
    ("Select * from Win32_OperatingSystem")
 
For Each objOperatingSystem in colOperatingSystems
    ver = objOperatingSystem.Version
Next
 
 
strComputer = "."
DomainUser = strDomainUser.value
DomainPswd = strDomainPswd.value
NewPasswd = strNewPasswd.value
strColo = strColoCode.value
 
'Selecting PESERVER
 
'''Took out a bunch of company specific stuff...That sets the variables
 
'Bigin Postconfig
WScript.echo "*** Declared Variables ***"
WScript.echo "Region:" & strRegion
WScript.echo "Colo:" & strColo
WScript.echo "PE Server:" & strColoCode
WScript.echo "Syslog Server:" & strSyslogCode
WScript.echo "TimeZone:" & strTimeZone
WScript.echo "Ntp Server:" & strNtp
WScript.echo "YWatch Server1:" & strYw1
WScript.echo "YWatch Server2:" & strYw2
WScript.echo "YWatch Server3:" & strYw3
WScript.echo "user:" & DomainUser
WScript.echo "winroot:" & NewPasswd
 
WScript.echo "Model:" & model
WScript.echo "Manufacturer:" & manufacturer
WScript.echo "Operating System Version:" & ver
Wscript.sleep 5000
 
 
WScript.echo "*** Starting Post Configuration Script ***"
WScript.echo "*** Setting Time Zone ***"
objShell.Run "Control.exe TIMEDATE.CPL,,/Z " & strTimeZone,1,True
 
 
'Setting NTP
WScript.echo "*** Setting NTP Registry Keys ***"
filesys = objShell.RegWrite("HKLM\SYSTEM\CurrentControlSet\Services\W32Time\Parameters\NtpServer","" & strNtp & ",0x8","REG_SZ")
filesys = objShell.RegWrite("HKLM\SYSTEM\CurrentControlSet\Services\W32Time\Parameters\Type","AllSync","REG_SZ")
 
'Setting YWATCH
WScript.echo "*** Setting Ywatch Registry Keys ***"
filesys = objShell.RegWrite("HKLM\SYSTEM\CurrentControlSet\Services\SNMP\Parameters\PermittedManagers\1","localhost","REG_SZ")
filesys = objShell.RegWrite("HKLM\SYSTEM\CurrentControlSet\Services\SNMP\Parameters\PermittedManagers\2",strYw1,"REG_SZ")
filesys = objShell.RegWrite("HKLM\SYSTEM\CurrentControlSet\Services\SNMP\Parameters\PermittedManagers\3",strYw2,"REG_SZ")
filesys = objShell.RegWrite("HKLM\SYSTEM\CurrentControlSet\Services\SNMP\Parameters\PermittedManagers\4",strYw3,"REG_SZ")
 
 
'Setting Services
strSvcName1 = "Browser"
strSvcName2 = "WinHttpAutoProxySvc"
strSvcName3 = "RDSessMgr"
strSvcName4 = "TapiSrv"
strStartupType1 = "Automatic" ' can be "Automatic", "Manual", or "Disabled"
strStartupType2 = "Disabled"
'Browser Service
WScript.echo "*** Setting Browser Service ***"
'Set Browser Service to Automatic
set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
set objService = objWMI.Get("Win32_Service.Name='" & strSvcName1 & "'")
intRC = objService.Change(,,,,strStartupType1)
 
'Start Browser Service
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
        ("Select * from Win32_Service where Name='" & strSvcName1 & "'")
For each objService in colServiceList
     errReturn = objService.StartService()
Next
 
'Remote Desktop Help Service
WScript.echo "*** Setting Remote Desktop Help Service ***"
'Stop Remote Desktop Help Service Service
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
        ("Select * from Win32_Service where Name='" & strSvcName3 & "'")
For each objService in colServiceList
     errReturn = objService.StopService()
Next
 
'Set Remote Desktop Help Service to Disabled
set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
set objService = objWMI.Get("Win32_Service.Name='" & strSvcName3 & "'")
intRC = objService.Change(,,,,strStartupType2)
 
'Telephony Service
WScript.echo "*** Setting Telephony Service ***"
'Stop Telephony Service Service
Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colServiceList = objWMIService.ExecQuery _
        ("Select * from Win32_Service where Name='" & strSvcName4 & "'")
For each objService in colServiceList
     errReturn = objService.StopService()
Next
'Set Telephony Service to Disabled
set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
set objService = objWMI.Get("Win32_Service.Name='" & strSvcName4 & "'")
intRC = objService.Change(,,,,strStartupType2)
 
If ver= "5.1.2600" Then
	WScript.echo "*** WinHTTP Web Proxy Auto-Discovery Service does not apply to WinXP***"
Else
	'WinHttpAutoProx Service
	WScript.echo "*** Setting WinHttpAutoProx Service ***"
	'Stop WinHttpAutoProx Service
	Set objWMIService = GetObject("winmgmts:" _
    	& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
	Set colServiceList = objWMIService.ExecQuery _
        ("Select * from Win32_Service where Name='" & strSvcName2 & "'")
	For each objService in colServiceList
    	errReturn = objService.StopService()
	Next
 
	'Set WinHttpAutoProx Service to Disabled
	set objWMI = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
	set objService = objWMI.Get("Win32_Service.Name='" & strSvcName2 & "'")
	intRC = objService.Change(,,,,strStartupType2)
End If
 
 
WScript.echo "*** Installing Patchlink ***"
If objFSO.FileExists("C:\Progra~1\PatchLink\Update Agent\pddm.exe")=True Then
	WScript.echo "Patchlink Already Present!"
	WScript.echo "Reinstalling.."
	objFSO.CopyFile "\\" & strColoCode & "\p$\post.configuration\PostConfigPatchlink.msi","c:\pepostconfig\"
	If strColoCode = "site3" Then
	objShell.Run "msiexec /x ""c:\pepostconfig\PostConfigPatchlink.msi"" /qb",1,True
	objShell.Run "msiexec /i ""c:\pepostconfig\PostConfigPatchlink.msi"" /qb",1,True
	Else
	objShell.Run "msiexec /x ""c:\pepostconfig\PostConfigPatchlink.msi"" /qb",1,True
	objShell.Run "msiexec /i ""c:\pepostconfig\PostConfigPatchlink.msi"" USEPROXY=1 PROXYURL=""http://" & strColoCode & ":25253"" REBOOT=ReallySuppress /qb",1,True
	End If
Else
	objFSO.CopyFile "\\" & strColoCode & "\p$\post.configuration\PostConfigPatchlink.msi","c:\pepostconfig\"
	If strColoCode = "site3" Then
	objShell.Run "msiexec /i ""c:\pepostconfig\PostConfigPatchlink.msi"" /qb",1,True
	Else
	objShell.Run "msiexec /i ""c:\pepostconfig\PostConfigPatchlink.msi"" USEPROXY=1 PROXYURL=""http://" & strColoCode & ":25253"" REBOOT=ReallySuppress /qb",1,True
	End If
End If
 
 
WScript.echo "*** Installing SAV ***"
If objFSO.FileExists("C:\Progra~1\Symant~1\VPC32.exe")=True Then
	WScript.echo "*** SAV Already Present ***"
	WScript.echo "Reinstalling.."
	filesys = objShell.RegWrite("HKLM\SOFTWARE\Intel\LANDesk\VirusProtect6\CurrentVersion\AdministratorOnly\Security\LockUnloadServices","0","REG_DWORD")
	filesys = objShell.RegWrite("HKLM\SOFTWARE\Intel\LANDesk\VirusProtect6\CurrentVersion\AdministratorOnly\Security\UseVPUninstallPassword","0","REG_DWORD")
	objShell.Run "msiexec /x ""\\" & strColoCode & "\VPHOME\CLT-INST\WIN32\Symantec AntiVirus.msi"" /qb"
	objShell.Run "msiexec /i ""\\" & strColoCode & "\VPHOME\CLT-INST\WIN32\Symantec AntiVirus.msi"" ADDLOCAL=SAVMain,SAVUI,SAVHelp,QClient ENABLEAUTOPROTECT=0 RUNLIVEUPDATE=0 REBOOT=ReallySuppress /qb",1,True
Else
	objShell.Run "msiexec /i ""\\" & strColoCode & "\VPHOME\CLT-INST\WIN32\Symantec AntiVirus.msi"" ADDLOCAL=SAVMain,SAVUI,SAVHelp,QClient ENABLEAUTOPROTECT=0 RUNLIVEUPDATE=0 REBOOT=ReallySuppress /qb",1,True
End If
 
'Install Dosa
If manufacturer = "Dell Computer Corporation" Then
	WScript.echo "*** Installing DOSA ***"
	If model = "PowerEdge SC1425" Then
		WScript.echo "*** DOSA CANNOT BE INSTALLED ON 1425 ***"
 	Else
 		If objFSO.FileExists("C:\Progra~1\Dell\SysMgt\omastart.exe")=True Then
		WScript.echo "*** DOSA Already Present ***"
		Else
		objFSO.CopyFile "\\" & strColoCode & "\p$\post.configuration\PostConfigDosa.msi","c:\pepostconfig\"
		objShell.Run "msiexec /i ""c:\pepostconfig\PostConfigDosa.msi"" ADDLOCAL=ALL /qb",1,True
		End If
	End If
Else
End If
 
'Install Dell Diag
If manufacturer = "Dell Computer Corporation" Then
	WScript.echo "*** Installing Dell Diagnostics ***"
	If objFSO.FileExists("C:\Program Files\PowerEdge Diagnostics\oldiags\bin\pediags.exe")=True Then
		WScript.echo "*** Dell Diagnostics Already Present ***"
	Else
		objFSO.CopyFile "\\" & strColoCode & "\p$\post.configuration\PostConfigDellDiag.msi","c:\pepostconfig\"
		objShell.Run "msiexec /i ""c:\pepostconfig\PostConfigDellDiag.msi"" /qb",1,True
	End If
Else
End If
 
'Install Snare
 
WScript.echo "*** Installing Snare ***"
WshEnv("SEE_MASK_NOZONECHECKS") = 1
If objFSO.FileExists("C:\Progra~1\Snare\SnareCore.exe")=True Then
	WScript.echo "*** Snare Already Present ***"
	filesys = objShell.RegWrite("HKLM\SOFTWARE\InterS~1\AuditService\Network",strSyslogCode,"REG_SZ")
Else
	objFSO.CopyFile "\\" & strColoCode & "\p$\post.configuration\PostConfigSnareAgent.msi","c:\pepostconfig\"
	objShell.Run "msiexec /i ""c:\pepostconfig\PostConfigSnareAgent.msi"" DESTSERVER=" & strSyslogCode & " /qb",1,True
End If
 
'Install MS Support Tools
WScript.echo "*** Installing MS Support Tools ***"
If objFSO.FileExists("C:\Program Files\Suppor~1\netdom.exe")=True Then
		WScript.echo "*** MS Support Tools Already Present ***"
Else
		objFSO.CopyFile "\\" & strColoCode & "\p$\post.configuration\suptools.msi","c:\pepostconfig\"
		objFSO.CopyFile "\\" & strColoCode & "\p$\post.configuration\sup_pro.cab","c:\pepostconfig\"
		objFSO.CopyFile "\\" & strColoCode & "\p$\post.configuration\sup_srv.cab","c:\pepostconfig\"
		objFSO.CopyFile "\\" & strColoCode & "\p$\post.configuration\support.cab","c:\pepostconfig\"
		objShell.Run "msiexec /i ""c:\pepostconfig\suptools.msi"" /qb",1,True
End If
 
 
'Set Winroot
UserName = "admin"
WScript.echo "*** Setting Admin Password***"
set objUser = GetObject("WinNT://" & strComputer & "/" & UserName)
objUser.SetPassword(NewPasswd)
 
'Join Domain
WScript.echo " *** Joining Domain ***"
strDomain = "domain" 
Const JOIN_DOMAIN = 1 
Const ACCT_CREATE = 2 
Const ACCT_DELETE = 4 
Const WIN9X_UPGRADE = 16 
Const DOMAIN_JOIN_IF_JOINED = 32 
Const JOIN_UNSECURE = 64 
Const MACHINE_PASSWORD_PASSED = 128 
Const DEFERRED_SPN_SET = 256 
Const INSTALL_INVOCATION = 262144 
 
Set objNetwork = CreateObject("WScript.Network") 
strComputer = objNetwork.ComputerName 
Set objComputer = _ 
GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & _ 
strComputer & "\root\cimv2:Win32_ComputerSystem.Name='" _ 
& strComputer & "'") 
ReturnValue = objComputer.JoinDomainOrWorkGroup(strDomain, _ 
DomainPswd, _ 
strDomain & "\" & DomainUser, _ 
NULL, _ 
JOIN_DOMAIN + ACCT_CREATE)
if ReturnValue <> 0 then
    WScript.Echo "Join failed with error: " & ReturnValue
else
    WScript.Echo "Successfully joined " & strComputer & " to " & strDomain
end If
WScript.echo " *** Removing Domain Users ***"
filesys = objShell.Run("NET LOCALGROUP USERS ""Domain Users"" /delete",1,True)
 
 
 
 
'Installing HP Support Pack
If manufacturer = "Compaq" Then
	WScript.echo " *** Installing HP Support Pack ***"
	If model = "ProLiant DL140" Then
 		WScript.echo " *** HP Support Pack Cannot be Installed on a DL140 ***"
	Else
 	WshEnv("SEE_MASK_NOZONECHECKS") = 1
	objShell.Run "\\" & strColoCode & "\p$\server.platforms\HPAQ\Suppor~1\7.90\2003\hpsum.exe /f /s",1,True
	End If
Else
End If
 
'Update Dell Drivers
If manufacturer = "Dell Computer Corporation" Then
	WScript.echo "*** Updating Dell Drivers ***"
	WshEnv("SEE_MASK_NOZONECHECKS") = 1
	objShell.Run "\\" & strColoCode & "\p$\server.platforms\Dell\SUU\5.2.1\suu.cmd -u",1,True
Else
End If
 
End Sub
 
</SCRIPT>
 
<BODY STYLE="font:12 pt arial; color:white; filter:progid:DXImageTransform.Microsoft.Gradient(GradientType=0, StartColorStr='#0000FF', EndColorStr='#000000')">
<TABLE BORDER="0" CELLPADDING="0" CELLSPACING="0">
<TR>
    <TD ALIGN="center" COLSPAN="4"><B>Post Configuration Script</B></TD>
    
</TR>
<TR>
    <TD COLSPAN="7">&nbsp;</TD>
</TR>
<TR>
    <TD ALIGN="right" COLSPAN="4"><B>Domain Username:</B>&nbsp;&nbsp;&nbsp;<INPUT NAME="strDomainUser" TYPE=TEXT SIZE="20" TITLE="Adprod Username"></TD>
    <TD ALIGN="left" COLSPAN="3">&nbsp;&nbsp;&nbsp;<B>Domain Password:</B>&nbsp;&nbsp;&nbsp;<INPUT NAME="strDomainPswd" TYPE=PASSWORD SIZE="20" TITLE="Adprod Password"></TD>
</TR>
<TR>
    <TD COLSPAN="7">&nbsp;</TD>
</TR>
<TR>
    <TD ALIGN="right" COLSPAN="4"><B>Winroot Password:</B>&nbsp;&nbsp;&nbsp;<INPUT NAME="strNewPasswd" TYPE=PASSWORD SIZE="20" TITLE="AdminPassword"></TD>
<TR>
<TR>
    <TD COLSPAN="7">&nbsp;</TD>
</TR>
<TR>
    <TD ALIGN="right" COLSPAN="4"><B>Select Region:</B>&nbsp;&nbsp;&nbsp;
<select name="strColoCode">
    <option value="">Select Colo</option>
    <option value="Site1">Site1</option>
    <option value="Site2">Site2</option>
    <option value="Site3">Site3</option>
    <option value="Site4">Site4</option>
 
</select>
</TD>
</TR>
<TR>
    <TD COLSPAN="7">&nbsp;</TD>
</TR>
<TR>
    <TD><INPUT ID=runbutton CLASS="button" TYPE="button" VALUE="Run Script" NAME="ok_button" onClick="RunScript strColoCode, strNewPasswd, strDomainPswd, strDomainUser"></TD>
</TR>
</TABLE>
 
 
</BODY>

Open in new window

0
 

Author Comment

by:WinPE
ID: 20398357
I know this is ugly, havent cleaned it up yet... alot of stuff pieces together... so variables all over the place...
0
Problems using Powershell and Active Directory?

Managing Active Directory does not always have to be complicated.  If you are spending more time trying instead of doing, then it's time to look at something else. For nearly 20 years, AD admins around the world have used one tool for day-to-day AD management: Hyena. Discover why

 
LVL 12

Expert Comment

by:chandru_sol
ID: 20400372
Will it be fine if i write the result to a text file?
0
 

Author Comment

by:WinPE
ID: 20405154
it would have to show the results in a text file in real time though..
0
 
LVL 12

Expert Comment

by:chandru_sol
ID: 20408511
You mean to write the information in text file and open at the end using notepd
0
 
LVL 2

Accepted Solution

by:
biztopia earned 500 total points
ID: 20424560
In my experiance the best way to provide status information in a HTA is via another IE window.  Maintaining a log in a text file is a good idea, and I'd recommend it anyway, but I don't know how you would be able to keep it "live" on the screen for the user.

The attached code snippet is a progress bar class I've used in an HTA before.  I can't take credit for the code, it was something I found that was freely available.

You could try using this as a reference for building an IE window that updates status.

Cheers
D.
'----- //////////////////////////////////////////////////////////////////////////////////////////////
 
' -- Progress Bar Class that can be pasted into scripts.
'--   To create Progress Bar:   Dim ob  
                             '            Set ob = New IEProgBar
                             
'-- This progress bar is created with an HTML file, which is written to the Temp folder
'-- and opened from there.
                             
  '-- Methods and Properties:
   
'    Methods -
 
'            Show - displays progress bar by writing file, causing IE to open it and setting IE visible.
'            Advance - advances progress by 1 unit.
'            Move(Left, Top, Width, Height) - moves and/or resizes window. All parameters must be used.
'                                                          use -1 For any dimension Not being changed: ob.Move 10, 10, -1, -1  
'                                                          default size is 400 W x 120 H. default position is Windows default.                          
  
'            CleanIETitle - removes Registry settings that append advertising to the page
'                               title in the IE title bar so that only the specified Title Property
'                               will be displayed. (This is a general change to IE and is Not reversible
'                               with this script as written.)    
   
'   Properties - 
 
'            BackColor - 6-character hex code to specify background color. default is "E0E0E4".
'            TextColor -  6-character hex code to specify caption text color. default is "000000".
'             ProgressColor -  6-character hex code to specify progress color. default is "0000A0".
'             Title - window title text. default is "Progress"
'             Caption - text caption in window. default is "Progress. . ."
'             Units - number of progress units to use. default is 20.
'             Icon - path of any image file that can be used as an icon. (JPG, GIF, BMP or ICO)
'                      default is no icon. If an icon is specifed it appears to left of caption.
 
 
'--- ////////////////////////////////////////////////////////////////////////////////////////
 
 
 
 
'--------  Start Progress Bar Class  ----------------------------------
Class IEProgressBar
   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 = 20          '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
     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><B>" & ProgCaption & "</B></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

Open in new window

0

Featured Post

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

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

Displaying an arrayList in a listView using the default adapter is rarely the best solution. To get full control of your display data, and to be able to refresh it after editing, requires the use of a custom adapter.
Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…

831 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