Тема: VBScript: индикатор прогресса с помощью IE
Класс индикатора прогресса для VBScript, который может быть использован в любом скрипте.
Позволяет задать текст надписи и заголовка окна, а также цвета фона, текста надписи и самого индикатора прогресса.
См. комментарии в коде.
Источник - http://www.jsware.net/jsware/scrdex.php3.
Dim bar, i
Set bar = new IEProgBar
With bar
.Move -1, -1, 500, -1
.Units = 30
.Show
WScript.Sleep 500
.Caption = "Выполнение: 0%..."
WScript.Sleep 500
For i = 0 to 29
WScript.Sleep 500 ' вместо этого здесь может быть ваш код, выполняющий нужную вам работу
.Caption = "Выполнение: " & Round((i+1)*100/30, 0) & "%..."
.Advance
Next
End With
WScript.Sleep 1000
Set bar = Nothing
'--- //////////////////////////////////////////////////////////////////////////////////////////////
'
'Класс IEProgBar, который может быть вставлен в любой скрипт.
'Чтобы создать индикатор прогресса, напишите:
'
'Dim ob
'Set ob = New IEProgBar
'
'Индикатор прогресса создается в виде HTML файла,
'который записывается в директорию временных файлов и открывается оттуда.
'
'Свойства и методы:
'
'Методы -
'
' Show - показывает индикатор прогресса, записывая HTML файл, открывая его в IE и делая IE видимым.
' Advance - заполняет индикатор прогресса на одну ячейку.
' Move(Left, Top, Width, Height) - Изменение размеров и/или позиции окна.
' Используйте -1 для любого параметра, который вы не хотите менять.
' Размер по умолчанию - 400x120, положение окна определяет Windows.
' CleanIETitle - удаляет параметры настройки реестра, отвечающие за заголовок IE, делая заголовок IE более компактным.
' Это - глобальное изменение для IE, которое необратимо этим сценарием (тем не менее, это достаточно безопасное изменение).
'
'Свойства -
'
' BackColor - 6-символьный шестнадцатеричный код цвета фона. По умолчанию - "E0E0E4".
' TextColor - 6-символьный шестнадцатеричный код цвета текста. По умолчанию - "000000".
' ProgressColor - 6-символьный шестнадцатеричный код цвета индикатора прогресса. По умолчанию - "0000A0".
' Title - текст заголовка окна. По умолчанию - "Ожидание".
' Caption - текст надписи в окне. По умолчанию - "Подождите..."
' Units - количество единиц индикатора прогресса. По умолчанию - 20.
'
'--- ///////////////////////////////////////////////////////////////////////////////////////////////
'-------- КЛАСС IEProgBar ----------------------------------
Class IEProgBar
Private FSO, IE, BCol, TCol, ProgCol, ProgNum, ProgCaption, 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" 'цвет фона по умолчанию
TCol = "000000" 'цвет текста надписи по умолчанию
ProgCol = "0000A0" 'цвет индикатора прогресса по умолчанию
ProgNum = 20 'количество единиц индикатора прогресса по умолчанию
ProgCaption = "Подождите..." 'надпись по умолчанию
ProgTitle = "Ожидание" 'заголовок окна по умолчанию
Q2 = chr(34) 'двойная кавычка (для HTML-вёрстки)
iProg = 0 'заполнение индикатора прогресса
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 (ProgCaption <> "") Then
s = s & "<FONT FACE=" & Q2 & "arial" & Q2 & " SIZE=2><LABEL ID=" & Q2 & "Cap1" & Q2 & ">" & ProgCaption & "</LABEL></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 раскрашивает одну ячейку индикатора прогресса.
'Переменная iProg отслеживает, сколько ячеек было раскрашено.
'Каждая ячейка индикатора прогресса является тегом <TD> с идентификатором ID="P".
'К этим тегам можно обратиться через 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
'Изменение размеров и/или позиции окна. Используйте -1 для любого параметра, который вы не хотите менять.
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
'Удаление параметров настройки реестра, отвечающих за заголовок IE.
'Это изменение не будет иметь эффекта при первом использовании, поскольку экземпляр IE уже был создан перед вызовом метода.
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
'------------- Установка цвета фона: ---------------------
Public Property Let BackColor(sCol)
If (TestColor(sCol) = True) Then BCol = sCol
End Property
'------------- Установка цвета текста: --------------------
Public Property Let TextColor(sCol)
If (TestColor(sCol) = True) Then TCol = sCol
End Property
'------------- Установка цвета индикатора прогресса: ------
Public Property Let ProgressColor(sCol)
If (TestColor(sCol) = True) Then ProgCol = sCol
End Property
'------------- Установка заголовкеа окна: ------------------
Public Property Let Title(sCap)
ProgTitle = sCap
End Property
'------------- Установка текста: ----------------------------
Public Property Let Caption(sCap)
On Error Resume Next
ProgCaption = sCap
IE.Document.parentWindow.Cap1.innerText = sCap
End Property
'----- Установка количества единиц индикатора прогресса: -----
Public Property Let Units(iNum)
ProgNum = iNum
End Property
'Проверка корректности заданного цвета: цвет должен содержать 6 символов 0-9 или A-F.
'Возвращается True (цвет корректен) или 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Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.
