Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1447
  • Last Modified:

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

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
WinPE
Asked:
WinPE
  • 3
  • 3
1 Solution
 
chandru_solCommented:
Can you post your HTA script to better understand?
0
 
WinPEAuthor Commented:
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
 
WinPEAuthor Commented:
I know this is ugly, havent cleaned it up yet... alot of stuff pieces together... so variables all over the place...
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!

 
chandru_solCommented:
Will it be fine if i write the result to a text file?
0
 
WinPEAuthor Commented:
it would have to show the results in a text file in real time though..
0
 
chandru_solCommented:
You mean to write the information in text file and open at the end using notepd
0
 
biztopiaCommented:
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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 3
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now