1

Тема: 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).

Post's attachments

FindHTA68.zip 7.3 kb, 483 downloads since 2008-10-04 

You don't have the permssions to download the attachments of this post.
Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.

2

Re: VBScript: COM-сервер для управления окнами HTA

С помощью вышеприведённого COM-сервера можно транслировать объект WScript в HTA.
Создайте файл C:\Temp\test.js:

var HTA = new ActiveXObject("FindHTA68.HTA68");
WScript.Sleep(500);
var dom = HTA.HTA("Трансляция объекта WScript").parentWindow;
var global = this;
    dom.WScript = WScript;

dom.Register = function (EventName, EventHandler)
{
    global[EventName] = EventHandler;
}

for (;;) WScript.Sleep(0x7fffffff);

Демонстрационное HTA-приложение:

<HTML>
<HEAD>
<TITLE>Трансляция объекта WScript</TITLE>
<HTA:APPLICATION
    BORDER="thin"
    CAPTION="yes" />
<SCRIPT>
function window.onload(){
    var WScriptProcess = (new ActiveXObject("WScript.Shell")).Exec('wscript.exe \"' +
                               'C:\\Temp\\test.js' + '\"');
    window.attachEvent('onunload',
    function () {
        try {WScriptProcess.Terminate()} catch (e) {}; return false;
    });
}
function demo(){
    alert('Через 3 секунды после нажатия на \"ОК\" текст будет изменён...')
    WScript.Sleep(3000);
    if (oH1.innerText == 'Текст изменён'){
        oH1.innerText = 'Использование объекта WScript в HTA';
    } else {
        oH1.innerText = 'Текст изменён';
    }
}
</SCRIPT>
</HEAD>
<BODY>
    <H1 ID=oH1>Использование объекта WScript в HTA</H1>
    <button onclick="demo();">Демонстация метода WScript.Sleep()</button>
</BODY>
</HTML>

Автор идеи — JSman.

Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.

3

Re: VBScript: COM-сервер для управления окнами HTA

Вариант ActiveX в EXE (саморегистрируемый ActiveX, достаточно один раз запустить для регистрации в реестре). Если ActiveХ DLL встраивается в адресное пространство вызывающего процесса, то ActiveX EXE — независимый процесс, присутствующий в списке процессов, и при выходе из вызывающего приложения он должен выгрузиться из памяти.
В архиве во вложении поста — сам ActiveX и демонстрационный пример (запускать PROCESS1.vbs).
Автор решения — ingvar68.

Post's attachments

hta.zip 14.82 kb, 432 downloads since 2009-03-12 

You don't have the permssions to download the attachments of this post.
Предложения в русском языке начинаются с большой буквы и заканчиваются точкой.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.