К сожалению объектной модели для загрузки HTA найти не смог. Пришлось создавать свою.
Принцип работы следующий
1) Запускается основной скрипт start.vbs
2) через Wscript.Shell объект запускает форму.
3) В HTA форме создаётся WebBrowser компонент, который автоматически регистрируется в коллекции Shell Application Windows
4) Скрипт находит этот объект и через его свойство Container получает доступ к родительским объектам Document и Window.
Код form1.hta
- Код: Выделить всё
<!- Скрипт для создания соединения с VBS -!>
<SCRIPT language=vbscript src="connector.vbs"></SCRIPT>
<!- Скрипт для создания соединения с VBS -!>
<SCRIPT language=vbscript>
Window.ResizeTo 400,200
</SCRIPT>
<HTA:APPLICATION
ID="APPLICATION"
APPLICATIONNAME="Application"
BORDER="dialog"
BORDERSTYLE="normal"
CAPTION="yes"
ICON=""
MAXIMIZEBUTTON="no"
MINIMIZEBUTTON="no"
SHOWINTASKBAR="yes"
SINGLEINSTANCE="no"
SYSMENU="yes"
VERSION="1.0"
WINDOWSTATE="normal"
INNERBORDER="no"
SCROLL="no"
CONTEXTMENU="yes"
/>
<STYLE>
*.*
{
FONT-FAMILY:Verdana;
FONT-SIZE:11;
}
</STYLE>
<BODY bgcolor="#D4D0C8">
<TABLE width=100% height=100%>
<TR><TD>Param1</TD><TD width=100%><INPUT style="width:100%;" id="inputBox1"></TD></TR>
<TR><TD>Param2</TD><TD><INPUT style="width:100%;" id="inputBox2"></TD></TR>
<TR>
<TD>Param3</TD>
<TD>
<SELECT style="width:100%;" id="ComboBox1">
<OPTION value="1">опция 1</OPTION>
<OPTION value="2">опция 2</OPTION>
<OPTION value="3">опция 3</OPTION>
</SELECT>
</TD>
</TR>
<TR><TD colspan=2><INPUT type="button" style="width:100%" id="CommandButton1" value="OK"></TD></TR>
</TABLE>
</BODY>
Код connector.vbs
- Код: Выделить всё
if IsObject(Window) Then
Document.write "<OBJECT id=""WebBrowser"" style=""display:none;"" classid=""clsid:8856F961-340A-11D0-A96B-00C04FD705A2""><PARAM name=""RegisterAsBrowser"" value=1></OBJECT>"
Document.attachevent "onkeydown",GetRef("Document_onkeydown_event")
window.attachevent "onload",GetRef("onload_event")
End if
Sub onload_event
CommandLine = Document.all.tags("APPLICATION")(0).CommandLine
Pos = InstrRev(CommandLine," ")
CommandLine = mid(CommandLine,Pos + 1,Len(CommandLine)-Pos)
if CommandLine = "" Then Exit Sub
WebBrowser.RegisterAsBrowser = True
WebBrowser.RegisterAsDropTarget = False
WebBrowser.PutProperty "ProcessID",Clng(CommandLine)
End Sub
Function Document_onkeydown_event
if window.event.keycode = 116 Then Document_onkeydown_event = false
End Function
Код start.vbs
- Код: Выделить всё
Option Explicit
Dim WebBrowser,Window, Document, ExitDo
Set WebBrowser = Load("form1.hta")
Dim ShellApplication
Set ShellApplication = CreateObject("Shell.Application")
ShellApplication.BrowseForFolder WebBrowser.GetProperty("ProcessID"),"Title", 0, 36
Set Document = WebBrowser.Document
Set Window = Document.ParentWindow
Document.body.onunload = GetRef("window_onunload")
Document.title = "Form1"
Window.CommandButton1.onclick=GetRef("GetVars")
Sub GetVars
MsgBox Window.InputBox1.value & vbCrlf & Window.InputBox2.value & vbCrlf & Window.ComboBox1.value
window.close
End Sub
Sub Window_onunload
ExitDo = True
End Sub
'// Цикл ожидания события
Do
WScript.Sleep 100
Loop Until ExitDo
'// Функция запуска HTA
Function Load(FilePath)
Set Load = Nothing
Dim WshShell
Set WshShell = CreateObject("Wscript.Shell")
Dim ID
Randomize
'// Создаём уникальный ID и передаём в
ID = Clng(Rnd * 100000)
WshShell.Run filepath & " " & ID
Dim Windows,Counter
Set Windows = CreateObject("Shell.Application").Windows
For Counter = 1 to 1000
For Each Window in Windows
if Window.GetProperty("ProcessID") = ID Then
Set Load = Window
Exit Function
End if
Next
Next
Err.Raise vbObjectError + 1,"Run","Не удалось получить связь с окном HTA"
End Function
