1 (изменено: Poltergeyst, 2019-09-29 22:52:47)

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