Создание форм для VBScript

Здесь можно найти готовые «кирпичики» — части кода, пригодные для построения более крупных проектов, а также решения различных типовых и не очень задач на VB.

Модератор: Brickgroup

ALX_2002
Мега гуру
Мега гуру
 
Сообщения: 2003
Зарегистрирован: 25.11.2002 (Пн) 20:03

Создание форм для VBScript

Сообщение ALX_2002 » 05.07.2008 (Сб) 16:09

Доброго времени суток господа. Не раз натыкался в интернете на вопросы как сделать форму для VBS скрипта. Иногда требуется сделать самое банальное окошко с двумя тремя полями ввода, чтобы не мучать пользователя поочерёдно, вылезающими InputBox-ами, а VBS как назло не даёт никаких средств для отображения обычных форм. Не так давно наткнулся на удобный инструмент для этих целей - HTA (HTML Application). Подробнее об этом можно почитать тут http://www.script-coding.info/HTA.html. В принципе для создания "интерфейса" вполне достаточно было бы использовать HTA как есть, ведь он полноценно выполняет VBS скрипты, но передо мной встала задача показывать формы из среды, выполняющей VBS код. При чём сначала на основании данных встроенных объектов этой среды заполнить форму и отобразить, а затем собрать с неё введённые данные и передать обратно в скрипт. В итоге пришлось искать пути соединения HTA с VBS средой.
К сожалению объектной модели для загрузки 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
   
Вложения
HTA Form.zip
(2.02 Кб) Скачиваний: 516

Вернуться в Кирпичный завод

Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 1

    TopList