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,368 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
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
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

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

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.
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …
In this seventh video of the Xpdf series, we discuss and demonstrate the PDFfonts utility, which lists all the fonts used in a PDF file. It does this via a command line interface, making it suitable for use in programs, scripts, batch files — any pl…

706 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

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now