Тема: VBScript: COM-сервер для управления окнами HTA
COM-сервер по заголовку окна HTA возвращает объект IHTMLDocument, что даёт возможность полностью управлять этим окном из скрипта VBScript или другого HTA. Перекликается с этой темой: VBScript: конструирование и выдача диалогов с помощью HTA. Исходник (VB 6):
Private Const SMTO_ABORTIFHUNG = &H2
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Declare Function ObjectFromLresult Lib "oleacc" ( _
ByVal lResult As Long, _
riid As UUID, _
ByVal wParam As Long, _
ppvObject As Any) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Private Declare Function RegisterWindowMessage Lib "user32" Alias _
"RegisterWindowMessageA" (ByVal lpString As String) As Long Private Declare Function SendMessageTimeout Lib "user32" _
Alias "SendMessageTimeoutA" _
(ByVal hwnd As Long, ByVal msg As Long, _
ByVal wParam As Long, ByVal lParam As Long, _
ByVal fuFlags As Long, ByVal uTimeout As Long, _
lpdwResult As Long) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Function HTA(ByVal WHAT As String) As Object 'IHTMLDocument2 'IHTMLDocument Dim hwnd As Long
hwnd = FindWindow("HTML Application Host Window Class", WHAT) If hwnd <> 0 Then
Set HTA = IEDOMFromhWnd(hwnd)
Else
'MsgBox "Не найден " & WHAT
Set HTA = Nothing
End If
End Function
Function IEDOMFromhWnd(ByVal hwnd As Long) As Object 'IHTMLDocument2
Dim IID_IHTMLDocument As UUID
Dim hWndChild As Long
Dim lRes As Long
Dim lMsg As Long
Dim hr As Long
If hwnd <> 0 Then
hWndChild = FindWindowEx(hwnd, ByVal 0&, "Internet Explorer_Server", vbNullString)
If hWndChild <> 0 Then
lMsg = RegisterWindowMessage("WM_HTML_GETOBJECT")
SendMessageTimeout hWndChild, lMsg, 0, 0, SMTO_ABORTIFHUNG, 1000, lRes
If lRes Then
With IID_IHTMLDocument
.Data1 = &H626FC520
.Data2 = &HA41E
.Data3 = &H11CF
.Data4(0) = &HA7
.Data4(1) = &H31
.Data4(2) = &H0
.Data4(3) = &HA0
.Data4(4) = &HC9
.Data4(5) = &H8
.Data4(6) = &H26
.Data4(7) = &H37
End With
hr = ObjectFromLresult(lRes, IID_IHTMLDocument, 0, IEDOMFromhWnd)
End If
Else
Set IEDOMFromhWnd = Nothing
MsgBox "Не найден Internet Explorer_Server"
End If
End If
End Function
Автор решения - ingvar68.
Пример использования:
Set HTA = CreateObject("FindHTA68.HTA68")
Set CWindow = HTA.HTA("Заголовок окна HTA")
CWindow.ParentWindow.Close
Ещё один пример:
Set HTA = CreateObject("FindHTA68.HTA68")
Set CWindow = HTA.HTA("Sample Application")
WScript.Echo TypeName(CWindow)
WScript.Echo TypeName(CWindow.ParentWindow)
CWindow.body.innerHTML = "<h1>Привет, FindHTA68.HTA68!</h1>"
For i=0 To 12
CWindow.body.innerHTML = CWindow.body.innerHTML & "<h1>Привет, FindHTA68.HTA68!</h1>"
WScript.Sleep 1000
Next
Во вложении поста - скомпилированная DLL (скомпилировал Xameleon).
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.