Тема: VBScript: dynwrap.dll & Excel.Application - перебор окон
Без гарантий. Используете на свой страх и риск.
Перебор окон в VBScript с помощью объекта DynamicWrapper. Функция обратного вызова построена на использовании MS Excel как COM-сервера и вызывает целевую функцию из VBScript.
Lang VBScript
Потребуется установленный MS Office со средой VBE
Потребуется библиотека dynwrap.dll [NT версия]
Тестировалось на Win7
'-------------------------------------------------------------
' Перебор окон в VBScript с помощью объекта DynamicWrapper.
' Функция обратного вызова построена на использовании MS
' Excel как COM-сервера и вызывает целевую функцию из VBScript.
'
' Lang VBScript
' Потребуется установленный MS Office со средой VBE
' Потребуется библиотека dynwrap.dll (http://www.script-coding.com/dynwrap.html)
' Тестировалось на Win7
'-------------------------------------------------------------
Option Explicit
Dim objExcel, objWorkBook, objModule, oVBComps, oExWrap
Dim lAddr
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
Set objWorkBook = objExcel.WorkBooks.Add
' Формирование кода Excel
'-------------------------------------------------------------
' Set oVBComps = objExcel.VBE.ActiveVBProject.VBComponents
' равнозначно
Set oVBComps = objWorkBook.VBProject.VBComponents
Set objModule = oVBComps.Add(1)
With objModule.CodeModule
.InsertLines 1, "Option Explicit"
.InsertLines 2, "Declare Sub MoveMem Lib ""kernel32"" _"
.InsertLines 3, "Alias ""RtlMoveMemory"" (ByRef Destination As Long, _"
.InsertLines 4, " ByRef Source As Long, _"
.InsertLines 5, " ByVal Length As Long)"
.InsertLines 6, "Dim oMe As Object"
.InsertLines 7, "Function SetContext(ByVal o As Object) As Object"
.InsertLines 8," Set oMe = o"
.InsertLines 9, " Set SetContext = CreateObject(""DynamicWrapper"")"
.InsertLines 10,"End Function"
.InsertLines 11,"'//Получить адрес функции обратного вызова//"
.InsertLines 12,"Function GetEnumProcAddress() As Long"
.InsertLines 13," GetEnumProcAddress = 0"
.InsertLines 14," MoveMem GetEnumProcAddress, AddressOf ENUMPROC_CALLER, 4"
.InsertLines 15,"End Function"
.InsertLines 16,"'//Функция обратного вызова, которая вызывает целевую функцию из VBScript//"
.InsertLines 17,"Function ENUMPROC_CALLER(ByVal hwnd As Long, ByVal lParam As Long) As Long"
.InsertLines 18," ENUMPROC_CALLER = oMe.ENUMPROC(hwnd, lParam) "
.InsertLines 19,"End Function"
End With
'/Адрес функции обратного вызова/
lAddr = objExcel.Application.Run("GetEnumProcAddress")
'/Регистрация API/
Set oExWrap = objExcel.Application.Run("SetContext", Me)
oExWrap.Register "USER32.DLL","EnumWindows","i=ll","f=s","r=l"
' Запуск перебора окон
'-------------------------------------------------------------
oExWrap.EnumWindows lAddr, 0
' Завершение работы
'-------------------------------------------------------------
oVBComps.Remove objModule
objExcel.DisplayAlerts = False
objExcel.Quit()
WScript.Quit()
' Целевая функция обратного вызова, вызываемая из потока Excel
'-------------------------------------------------------------
Public Function ENUMPROC(ByVal hwnd, ByVal lParam)
Dim sH
Dim iAnsw
sH = Hex(hwnd)
iAnsw = MsgBox("Дескриптор окна: 0x" & String(8-Len(sH),"0") & sH, vbOKCancel + vbSystemModal + vbExclamation, "HWND")
If iAnsw = vbCancel Then
ENUMPROC = 0
Else
ENUMPROC = 1
End If
End Function