<?xml version="1.0" encoding="utf-8"?>
<feed xmlns="http://www.w3.org/2005/Atom">
	<title type="html"><![CDATA[Серый форум &mdash; VBScript: dynwrap.dll & Excel.Application - перебор окон]]></title>
	<link rel="self" href="http://forum.script-coding.com/extern.php?action=feed&amp;tid=13759&amp;type=atom" />
	<updated>2018-06-03T14:41:32Z</updated>
	<generator>PunBB</generator>
	<id>http://forum.script-coding.com/viewtopic.php?id=13759</id>
		<entry>
			<title type="html"><![CDATA[VBScript: dynwrap.dll & Excel.Application - перебор окон]]></title>
			<link rel="alternate" href="http://forum.script-coding.com/viewtopic.php?pid=125729#p125729" />
			<content type="html"><![CDATA[<p><em>Без гарантий. Используете на свой страх и риск.</em></p><p>Перебор окон в VBScript с помощью объекта <a href="http://www.script-coding.com/dynwrap.html">DynamicWrapper</a>. Функция обратного вызова построена на использовании <a href="http://www.script-coding.com/MSOffice.html">MS Excel как COM-сервера</a> и вызывает целевую функцию из VBScript.</p><p>Lang VBScript<br />Потребуется установленный MS Office со средой VBE<br />Потребуется библиотека <a href="http://www.script-coding.com/dynwrap.html">dynwrap.dll</a> <a href="http://www.script-coding.com/dynwrapNT.zip">[NT версия]</a><br />Тестировалось на Win7</p><div class="codebox"><pre><code>
 &#039;------------------------------------------------------------- 
 &#039; Перебор окон в VBScript с помощью объекта DynamicWrapper.
 &#039; Функция обратного вызова построена на использовании MS 
 &#039; Excel как COM-сервера и вызывает целевую функцию из VBScript.
 &#039;
 &#039; Lang VBScript
 &#039; Потребуется установленный MS Office со средой VBE
 &#039; Потребуется библиотека dynwrap.dll (http://www.script-coding.com/dynwrap.html)
 &#039; Тестировалось на Win7
 &#039;------------------------------------------------------------- 
 Option Explicit

 Dim objExcel, objWorkBook, objModule, oVBComps, oExWrap 
 Dim lAddr

 Set objExcel = CreateObject(&quot;Excel.Application&quot;)
 objExcel.Visible = False
 Set objWorkBook = objExcel.WorkBooks.Add


 &#039; Формирование кода Excel 
 &#039;------------------------------------------------------------- 
 &#039; Set oVBComps = objExcel.VBE.ActiveVBProject.VBComponents
 &#039; равнозначно
 Set oVBComps = objWorkBook.VBProject.VBComponents

 Set objModule = oVBComps.Add(1)

 With objModule.CodeModule
	.InsertLines 1,	&quot;Option Explicit&quot;
	.InsertLines 2,	&quot;Declare Sub MoveMem Lib &quot;&quot;kernel32&quot;&quot; _&quot;
	.InsertLines 3,	&quot;Alias &quot;&quot;RtlMoveMemory&quot;&quot; (ByRef Destination As Long, _&quot;
	.InsertLines 4,	&quot;                        ByRef Source As Long, _&quot;
	.InsertLines 5,	&quot;                        ByVal Length As Long)&quot;
	.InsertLines 6,	&quot;Dim oMe As Object&quot;
	.InsertLines 7, &quot;Function SetContext(ByVal o As Object) As Object&quot;
	.InsertLines 8,&quot;	Set oMe = o&quot;
	.InsertLines 9,	&quot;	Set SetContext = CreateObject(&quot;&quot;DynamicWrapper&quot;&quot;)&quot;
	.InsertLines 10,&quot;End Function&quot;
	.InsertLines 11,&quot;&#039;//Получить адрес функции обратного вызова//&quot;
	.InsertLines 12,&quot;Function GetEnumProcAddress() As Long&quot;
	.InsertLines 13,&quot;	GetEnumProcAddress = 0&quot;
	.InsertLines 14,&quot;	MoveMem GetEnumProcAddress, AddressOf ENUMPROC_CALLER, 4&quot;
	.InsertLines 15,&quot;End Function&quot;
	.InsertLines 16,&quot;&#039;//Функция обратного вызова, которая вызывает целевую функцию из VBScript//&quot;
	.InsertLines 17,&quot;Function ENUMPROC_CALLER(ByVal hwnd As Long, ByVal lParam As Long) As Long&quot;
	.InsertLines 18,&quot;	ENUMPROC_CALLER = oMe.ENUMPROC(hwnd, lParam)	 &quot;
	.InsertLines 19,&quot;End Function&quot;
 End With

 &#039;/Адрес функции обратного вызова/
 lAddr = objExcel.Application.Run(&quot;GetEnumProcAddress&quot;)
 
 &#039;/Регистрация API/
 Set oExWrap = objExcel.Application.Run(&quot;SetContext&quot;, Me)
 oExWrap.Register &quot;USER32.DLL&quot;,&quot;EnumWindows&quot;,&quot;i=ll&quot;,&quot;f=s&quot;,&quot;r=l&quot;

 &#039; Запуск перебора окон
 &#039;-------------------------------------------------------------
 oExWrap.EnumWindows lAddr, 0
 
 &#039; Завершение работы
 &#039;-------------------------------------------------------------
 oVBComps.Remove objModule 

 objExcel.DisplayAlerts = False
 objExcel.Quit()
 WScript.Quit()
 

 &#039; Целевая функция обратного вызова, вызываемая из потока Excel
 &#039;-------------------------------------------------------------
 Public Function ENUMPROC(ByVal hwnd, ByVal lParam)

	Dim sH
	Dim iAnsw

	sH = Hex(hwnd)
	iAnsw = MsgBox(&quot;Дескриптор окна: 0x&quot; &amp; String(8-Len(sH),&quot;0&quot;) &amp; sH, vbOKCancel + vbSystemModal + vbExclamation, &quot;HWND&quot;)
	If iAnsw = vbCancel Then 
		ENUMPROC = 0
	Else
		ENUMPROC = 1
	End If

 End Function
</code></pre></div>]]></content>
			<author>
				<name><![CDATA[Poltergeyst]]></name>
				<uri>http://forum.script-coding.com/profile.php?id=83</uri>
			</author>
			<updated>2018-06-03T14:41:32Z</updated>
			<id>http://forum.script-coding.com/viewtopic.php?pid=125729#p125729</id>
		</entry>
</feed>
