Функция, которая возвращает ссылку на объект окна HTA. В качестве аргумента принимает словарь с параметрами тега HTA. Получаем ссылку на объект окна HTA и формируем диалоговую форму с двумя полями ввода с помощью объектной модели DOM:
Option Explicit
Dim ExitDo, oHTA, oDict, oBody, oElem, oText
Dim val_1, val_2, ok
'==================================================================================================
Function GetHTADialog(ByRef Params)
Dim oFSO, oWshShell, oWindows, oTextStream, oWnd, oWindow
Dim sHTAFileName, ID, N
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oWshShell = CreateObject("WScript.Shell")
Set oWindows = CreateObject("Shell.Application").Windows
' формирование имени будущего файла HTA
sHTAFileName = oWshShell.ExpandEnvironmentStrings("%TEMP%") & "\" & oFSO.GetTempName() & ".hta"
' создание файла HTA
Set oTextStream = oFSO.CreateTextFile(sHTAFileName, True)
' заполнение файла HTA
With oTextStream
.WriteLine "<HTML><HEAD>"
.WriteLine "<OBJECT classid=""clsid:8856F961-340A-11D0-A96B-00C04FD705A2"""
.WriteLine "id=""WebBrowserTemplate"" width=""0"" height=""0"">"
.WriteLine "</OBJECT><TITLE></TITLE>"
.WriteLine "<SCRIPT language=vbscript>"
.WriteLine "If IsObject(window) Then"
.WriteLine " window.attachevent ""onload"", GetRef(""Main"")"
.WriteLine " document.attachevent ""onkeydown"", GetRef(""Document_onkeydown_event"")"
.WriteLine "End If"
.WriteLine "Sub Main"
.WriteLine " CommandLine = Document.all.tags(""APPLICATION"")(0).CommandLine"
.WriteLine " Pos = InstrRev(CommandLine, "" "")"
.WriteLine " CommandLine = Mid(CommandLine, Pos + 1, Len(CommandLine) - Pos)"
.WriteLine " If CommandLine = """" Then Exit Sub"
.WriteLine " Set WebBrowser = Document.GetElementById(""WebBrowserTemplate"")"
.WriteLine " WebBrowser.RegisterAsBrowser = True"
.WriteLine " WebBrowser.style.display = ""none"""
.WriteLine " WebBrowser.RegisterAsDropTarget = False"
.WriteLine " WebBrowser.Visible = False"
.WriteLine " WebBrowser.PutProperty ""ID"", Clng(CommandLine)"
.WriteLine "End Sub"
.WriteLine "Function Document_onkeydown_event" ' блокировка F5 (refresh)
.WriteLine " If window.event.keycode = 116 Then Document_onkeydown_event = false"
.WriteLine "End Function"
.WriteLine "</SCRIPT>"
.WriteLine "<HTA:APPLICATION"
.WriteLine "APPLICATIONNAME=""" & Params.Item("APPLICATIONNAME") & """"
If Params.Exists("BORDER") Then
.WriteLine "BORDER=""" & Params.Item("BORDER") & """"
Else
.WriteLine "BORDER=""thick"""
End If
If Params.Exists("BORDERSTYLE") Then
.WriteLine "BORDERSTYLE=""" & Params.Item("BORDERSTYLE") & """"
Else
.WriteLine "BORDERSTYLE=""normal"""
End If
If Params.Exists("CAPTION") Then
.WriteLine "CAPTION=""" & Params.Item("CAPTION") & """"
Else
.WriteLine "CAPTION=""yes"""
End If
If Params.Exists("CONTEXTMENU") Then
.WriteLine "CONTEXTMENU=""" & Params.Item("CONTEXTMENU") & """"
Else
.WriteLine "CONTEXTMENU=""yes"""
End If
If Params.Exists("ICON") Then
.WriteLine "ICON=""" & Params.Item("ICON") & """"
Else
.WriteLine "ICON=""System Application Icon"""
End If
If Params.Exists("INNERBORDER") Then
.WriteLine "INNERBORDER=""" & Params.Item("INNERBORDER") & """"
Else
.WriteLine "INNERBORDER=""yes"""
End If
If Params.Exists("MAXIMIZEBUTTON") Then
.WriteLine "MAXIMIZEBUTTON=""" & Params.Item("MAXIMIZEBUTTON") & """"
Else
.WriteLine "MAXIMIZEBUTTON=""yes"""
End If
If Params.Exists("MINIMIZEBUTTON") Then
.WriteLine "MINIMIZEBUTTON=""" & Params.Item("MINIMIZEBUTTON") & """"
Else
.WriteLine "MINIMIZEBUTTON=""yes"""
End If
If Params.Exists("NAVIGABLE") Then
.WriteLine "NAVIGABLE=""" & Params.Item("NAVIGABLE") & """"
Else
.WriteLine "NAVIGABLE=""no"""
End If
If Params.Exists("SCROLL") Then
.WriteLine "SCROLL=""" & Params.Item("SCROLL") & """"
Else
.WriteLine "SCROLL=""yes"""
End If
If Params.Exists("SCROLLFLAT") Then
.WriteLine "SCROLLFLAT=""" & Params.Item("SCROLLFLAT") & """"
Else
.WriteLine "SCROLLFLAT=""no"""
End If
If Params.Exists("SELECTION") Then
.WriteLine "SELECTION=""" & Params.Item("SELECTION") & """"
Else
.WriteLine "SELECTION=""yes"""
End If
If Params.Exists("SHOWINTASKBAR") Then
.WriteLine "SHOWINTASKBAR=""" & Params.Item("SHOWINTASKBAR") & """"
Else
.WriteLine "SHOWINTASKBAR=""yes"""
End If
If Params.Exists("SINGLEINSTANCE") Then
.WriteLine "SINGLEINSTANCE=""" & Params.Item("SINGLEINSTANCE") & """"
Else
.WriteLine "SINGLEINSTANCE=""no"""
End If
If Params.Exists("SYSMENU") Then
.WriteLine "SYSMENU=""" & Params.Item("SYSMENU") & """"
Else
.WriteLine "SYSMENU=""yes"""
End If
If Params.Exists("VERSION") Then
.WriteLine "VERSION=""" & Params.Item("VERSION") & """"
Else
.WriteLine "VERSION=""1.0"""
End If
If Params.Exists("WINDOWSTATE") Then
.WriteLine "WINDOWSTATE=""" & Params.Item("WINDOWSTATE") & """"
Else
.WriteLine "WINDOWSTATE=""normal"""
End If
If Params.Exists("ID") Then
.WriteLine "ID=""" & Params.Item("ID") & """"
Else
.WriteLine "ID=""oHTA"""
End If
.WriteLine "/>"
.WriteLine "</HEAD><BODY></BODY></HTML>"
.Close
End With
Randomize
ID = Clng(Rnd * 100000)
oWshShell.Run sHTAFileName & " " & ID
' поиск окна HTA
Set oWnd = Nothing
For N = 1 to 1000
For Each oWindow in oWindows
If oWindow.GetProperty("ID") = ID Then
Set oWnd = oWindow
Exit For
End If
Next
If Not oWnd Is Nothing Then Exit For
Next
' удаление файла HTA
oFSO.DeleteFile sHTAFileName, True
' возвращаем ссылку на окно HTA
Set GetHTADialog = oWnd
End Function
'==================================================================================================
Sub HTA_OnUnload
ExitDo = True
End Sub
Sub CloseHTA
oHTA.document.parentWindow.close
End Sub
Sub OK_HTA
val_1 = oHTA.document.parentWindow.input_1.value
val_2 = oHTA.document.parentWindow.input_2.value
oHTA.document.parentWindow.close
ok = True
End Sub
'==================================================================================================
Set oDict = CreateObject("Scripting.Dictionary")
oDict.Add "CONTEXTMENU", "no"
oDict.Add "INNERBORDER", "no"
oDict.Add "SCROLL", "no"
oDict.Add "BORDER", "dialog"
oDict.Add "BORDERSTYLE", "raised"
oDict.Add "MAXIMIZEBUTTON", "no"
oDict.Add "MINIMIZEBUTTON", "no"
ok = False
Set oHTA = GetHTADialog(oDict)
If oHTA Is Nothing Then
WScript.Echo "Не удалось получить связь с окном HTA."
WScript.Quit
End If
' назначаем обработчик события выгрузки (закрытия) формы
oHTA.document.body.onunload = GetRef("HTA_OnUnload")
' задаём размеры формы
oHTA.document.parentWindow.resizeTo 350, 250
' получаем объет тела HTML-документа
Set oBody = oHTA.document.getElementsByTagName("body")(0)
' задаём цвет фона
oBody.bgcolor = "#E0E0E0"
' создаём текстовый элемент
oHTA.document.title = "Ввод значений"
Set oElem = oHTA.Document.createElement("p")
Set oText = oHTA.Document.createTextNode("Введите текстовое значение:")
oElem.appendChild oText
oBody.appendChild oElem
' создаём текстовое поле ввода
Set oElem = oHTA.Document.createElement("input")
oElem.setAttribute "width", "320"
oElem.setAttribute "id", "input_1"
oBody.appendChild oElem
' создаём текстовый элемент
Set oElem = oHTA.Document.createElement("p")
Set oText = oHTA.Document.createTextNode("Выберите файл:")
oElem.appendChild oText
oBody.appendChild oElem
' создаём поле выбора файла
Set oElem = oHTA.Document.createElement("input")
oElem.setAttribute "type", "file"
oElem.setAttribute "width", "320"
oElem.setAttribute "id", "input_2"
oBody.appendChild oElem
' создаём разделители
Set oElem = oHTA.Document.createElement("br")
oBody.appendChild oElem
Set oElem = oHTA.Document.createElement("br")
oBody.appendChild oElem
' создаём кнопку
Set oElem = oHTA.Document.createElement("button")
oElem.setAttribute "value", " О'кей "
oElem.onclick = GetRef("OK_HTA")
oBody.appendChild oElem
' создаём текстовый элемент
Set oText = oHTA.Document.createTextNode(" ")
oBody.appendChild oText
' создаём кнопку
Set oElem = oHTA.Document.createElement("button")
oElem.setAttribute "value", "Отменить"
oElem.onclick = GetRef("CloseHTA")
oBody.appendChild oElem
Do ' ожидание закрытия окна HTA
WScript.Sleep 100
Loop Until ExitDo
If ok Then
WScript.Echo "Введено текстовое значение: " & val_1
WScript.Echo "Выбран файл: " & val_2
Else
WScript.Echo "Окно HTA было закрыто кнопкой ""Отменить""."
End If
Другой вариант предыдущего примера. Делаем ту же диалоговую форму, но с помощью передачи строки HTML-кода:
Option Explicit
Dim ExitDo, oHTA, oDict, oBody, oElem, oText
Dim val_1, val_2, ok, strHTML
'==================================================================================================
Function GetHTADialog(ByRef Params)
Dim oFSO, oWshShell, oWindows, oTextStream, oWnd, oWindow
Dim sHTAFileName, ID, N
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oWshShell = CreateObject("WScript.Shell")
Set oWindows = CreateObject("Shell.Application").Windows
' формирование имени будущего файла HTA
sHTAFileName = oWshShell.ExpandEnvironmentStrings("%TEMP%") & "\" & oFSO.GetTempName() & ".hta"
' создание файла HTA
Set oTextStream = oFSO.CreateTextFile(sHTAFileName, True)
' заполнение файла HTA
With oTextStream
.WriteLine "<HTML><HEAD>"
.WriteLine "<OBJECT classid=""clsid:8856F961-340A-11D0-A96B-00C04FD705A2"""
.WriteLine "id=""WebBrowserTemplate"" width=""0"" height=""0"">"
.WriteLine "</OBJECT><TITLE></TITLE>"
.WriteLine "<SCRIPT language=vbscript>"
.WriteLine "If IsObject(window) Then"
.WriteLine " window.attachevent ""onload"", GetRef(""Main"")"
.WriteLine " document.attachevent ""onkeydown"", GetRef(""Document_onkeydown_event"")"
.WriteLine "End If"
.WriteLine "Sub Main"
.WriteLine " CommandLine = Document.all.tags(""APPLICATION"")(0).CommandLine"
.WriteLine " Pos = InstrRev(CommandLine, "" "")"
.WriteLine " CommandLine = Mid(CommandLine, Pos + 1, Len(CommandLine) - Pos)"
.WriteLine " If CommandLine = """" Then Exit Sub"
.WriteLine " Set WebBrowser = Document.GetElementById(""WebBrowserTemplate"")"
.WriteLine " WebBrowser.RegisterAsBrowser = True"
.WriteLine " WebBrowser.style.display = ""none"""
.WriteLine " WebBrowser.RegisterAsDropTarget = False"
.WriteLine " WebBrowser.Visible = False"
.WriteLine " WebBrowser.PutProperty ""ID"", Clng(CommandLine)"
.WriteLine "End Sub"
.WriteLine "Function Document_onkeydown_event" ' блокировка F5 (refresh)
.WriteLine " If window.event.keycode = 116 Then Document_onkeydown_event = false"
.WriteLine "End Function"
.WriteLine "</SCRIPT>"
.WriteLine "<HTA:APPLICATION"
.WriteLine "APPLICATIONNAME=""" & Params.Item("APPLICATIONNAME") & """"
If Params.Exists("BORDER") Then
.WriteLine "BORDER=""" & Params.Item("BORDER") & """"
Else
.WriteLine "BORDER=""thick"""
End If
If Params.Exists("BORDERSTYLE") Then
.WriteLine "BORDERSTYLE=""" & Params.Item("BORDERSTYLE") & """"
Else
.WriteLine "BORDERSTYLE=""normal"""
End If
If Params.Exists("CAPTION") Then
.WriteLine "CAPTION=""" & Params.Item("CAPTION") & """"
Else
.WriteLine "CAPTION=""yes"""
End If
If Params.Exists("CONTEXTMENU") Then
.WriteLine "CONTEXTMENU=""" & Params.Item("CONTEXTMENU") & """"
Else
.WriteLine "CONTEXTMENU=""yes"""
End If
If Params.Exists("ICON") Then
.WriteLine "ICON=""" & Params.Item("ICON") & """"
Else
.WriteLine "ICON=""System Application Icon"""
End If
If Params.Exists("INNERBORDER") Then
.WriteLine "INNERBORDER=""" & Params.Item("INNERBORDER") & """"
Else
.WriteLine "INNERBORDER=""yes"""
End If
If Params.Exists("MAXIMIZEBUTTON") Then
.WriteLine "MAXIMIZEBUTTON=""" & Params.Item("MAXIMIZEBUTTON") & """"
Else
.WriteLine "MAXIMIZEBUTTON=""yes"""
End If
If Params.Exists("MINIMIZEBUTTON") Then
.WriteLine "MINIMIZEBUTTON=""" & Params.Item("MINIMIZEBUTTON") & """"
Else
.WriteLine "MINIMIZEBUTTON=""yes"""
End If
If Params.Exists("NAVIGABLE") Then
.WriteLine "NAVIGABLE=""" & Params.Item("NAVIGABLE") & """"
Else
.WriteLine "NAVIGABLE=""no"""
End If
If Params.Exists("SCROLL") Then
.WriteLine "SCROLL=""" & Params.Item("SCROLL") & """"
Else
.WriteLine "SCROLL=""yes"""
End If
If Params.Exists("SCROLLFLAT") Then
.WriteLine "SCROLLFLAT=""" & Params.Item("SCROLLFLAT") & """"
Else
.WriteLine "SCROLLFLAT=""no"""
End If
If Params.Exists("SELECTION") Then
.WriteLine "SELECTION=""" & Params.Item("SELECTION") & """"
Else
.WriteLine "SELECTION=""yes"""
End If
If Params.Exists("SHOWINTASKBAR") Then
.WriteLine "SHOWINTASKBAR=""" & Params.Item("SHOWINTASKBAR") & """"
Else
.WriteLine "SHOWINTASKBAR=""yes"""
End If
If Params.Exists("SINGLEINSTANCE") Then
.WriteLine "SINGLEINSTANCE=""" & Params.Item("SINGLEINSTANCE") & """"
Else
.WriteLine "SINGLEINSTANCE=""no"""
End If
If Params.Exists("SYSMENU") Then
.WriteLine "SYSMENU=""" & Params.Item("SYSMENU") & """"
Else
.WriteLine "SYSMENU=""yes"""
End If
If Params.Exists("VERSION") Then
.WriteLine "VERSION=""" & Params.Item("VERSION") & """"
Else
.WriteLine "VERSION=""1.0"""
End If
If Params.Exists("WINDOWSTATE") Then
.WriteLine "WINDOWSTATE=""" & Params.Item("WINDOWSTATE") & """"
Else
.WriteLine "WINDOWSTATE=""normal"""
End If
If Params.Exists("ID") Then
.WriteLine "ID=""" & Params.Item("ID") & """"
Else
.WriteLine "ID=""oHTA"""
End If
.WriteLine "/>"
.WriteLine "</HEAD><BODY></BODY></HTML>"
.Close
End With
Randomize
ID = Clng(Rnd * 100000)
oWshShell.Run sHTAFileName & " " & ID
' поиск окна HTA
Set oWnd = Nothing
For N = 1 to 1000
For Each oWindow in oWindows
If oWindow.GetProperty("ID") = ID Then
Set oWnd = oWindow
Exit For
End If
Next
If Not oWnd Is Nothing Then Exit For
Next
' удаление файла HTA
oFSO.DeleteFile sHTAFileName, True
' возвращаем ссылку на окно HTA
Set GetHTADialog = oWnd
End Function
'==================================================================================================
Sub HTA_OnUnload
ExitDo = True
End Sub
Sub CloseHTA
oHTA.document.parentWindow.close
End Sub
Sub OK_HTA
val_1 = oHTA.document.parentWindow.input_1.value
val_2 = oHTA.document.parentWindow.input_2.value
oHTA.document.parentWindow.close
ok = True
End Sub
'==================================================================================================
Set oDict = CreateObject("Scripting.Dictionary")
oDict.Add "CONTEXTMENU", "no"
oDict.Add "INNERBORDER", "no"
oDict.Add "SCROLL", "no"
oDict.Add "BORDER", "dialog"
oDict.Add "BORDERSTYLE", "raised"
oDict.Add "MAXIMIZEBUTTON", "no"
oDict.Add "MINIMIZEBUTTON", "no"
ok = False
Set oHTA = GetHTADialog(oDict)
If oHTA Is Nothing Then
WScript.Echo "Не удалось получить связь с окном HTA."
WScript.Quit
End If
' назначаем обработчик события выгрузки (закрытия) формы
oHTA.document.body.onunload = GetRef("HTA_OnUnload")
' задаём размеры формы
oHTA.document.parentWindow.resizeTo 350, 250
' получаем объет тела HTML-документа
Set oBody = oHTA.document.getElementsByTagName("body")(0)
' задаём цвет фона
oBody.bgcolor = "#E0E0E0"
' формируем строку HTML-кода
strHTML = ""
strHTML = strHTML & "<P>Введите текстовое значение:</P>"
strHTML = strHTML & "<INPUT id=input_1 size=50>"
strHTML = strHTML & "<P>Выберите файл:</P>"
strHTML = strHTML & "<INPUT id=input_2 type=file size=37>"
strHTML = strHTML & "<BR><BR>"
strHTML = strHTML & "<BUTTON id=bOK> О'кей </BUTTON>"
strHTML = strHTML & " "
strHTML = strHTML & " "
strHTML = strHTML & "<BUTTON id=bCancel>Отменить</BUTTON>"
' записываем HTML-код в тело документа
oBody.innerHTML = strHTML
' назначение событий кнопкам
oHTA.document.parentWindow.bOK.onclick = GetRef("OK_HTA")
oHTA.document.parentWindow.bCancel.onclick = GetRef("CloseHTA")
Do ' ожидание закрытия окна HTA
WScript.Sleep 100
Loop Until ExitDo
If ok Then
WScript.Echo "Введено текстовое значение: " & val_1
WScript.Echo "Выбран файл: " & val_2
Else
WScript.Echo "Окно HTA было закрыто кнопкой ""Отменить""."
End If
Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.