Тема: VBScript: использование структур RECT и POINT в Win32 API
Пример демонстрирует использование структур RECT и POINT на примере закрашивания произвольной области окна и отслеживания координат курсора мыши.
Потребуются библиотеки dynwrap.dll и AutoItX3.dll.
'------ Нет гарантий!Используете на свой страх и риск ------------
'-----------------------------------------------------------------
'Использование структур RECT и POINT на примере закрашивания
'произвольной области окна и отслеживания координат курсора мыши.
'-----------------------------------------------------------------
'Language: VBScript
'Используется библиотека dynwrap.dll
'Используется вспомогательная библиотека AutoItX3.dll,v3.2.0.1
'-----------------------------------------------------------------
'ОС Win98 4.10.2222
'-----------------------------------------------------------------
Set aX3 =WScript.CreateObject("AutoItX3.Control") 'Вспомогательный объект
'--------------------------------- Создание класса ---------------------------------------
Class Struct
'-----------------------------------------------------------------------------------------
Private RtlMoveMemory_Call, _
lstrcat_Call, _
HeapAlloc_Call, _
GetProcessHeap_Call, _
HeapFree_Call
Private hHeap,init
'-----------------------------------------------------------------------------------------
Public iOfs
'-----------------------------------------------------------------------------------------
Private Sub Class_Initialize 'Запуск класса
'---------------------------------------------------------------------------------
Set RtlMoveMemory_Call =CreateObject("DynamicWrapper")
RtlMoveMemory_Call.Register "kernel32.dll","RtlMoveMemory","f=s","i=lll","r=l"
'---------------------------------------------------------------------------------
Set lstrcat_Call =CreateObject("DynamicWrapper")
lstrcat_Call.Register "kernel32.dll","lstrcat","f=s","i=ws","r=l"
'---------------------------------------------------------------------------------
Set HeapAlloc_Call =CreateObject("DynamicWrapper")
HeapAlloc_Call.Register "KERNEL32.DLL","HeapAlloc","f=s","i=lll","r=l"
'---------------------------------------------------------------------------------
Set GetProcessHeap_Call =CreateObject("DynamicWrapper")
GetProcessHeap_Call.Register "KERNEL32.DLL","GetProcessHeap","f=s","r=l"
'---------------------------------------------------------------------------------
Set HeapFree_Call =CreateObject("DynamicWrapper")
HeapFree_Call.Register "KERNEL32.DLL","HeapFree","f=s","i=lll","r=l"
'---------------------------------------------------------------------------------
'Локализация кучи
hHeap=GetProcessHeap_Call.GetProcessHeap()
End Sub
'-----------------------------------------------------------------------------------------
Private Sub Class_Terminate 'Уничтожение класса
HeapFree_Call.HeapFree hHeap,0,init
End Sub
'-----------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------
'[Инициализация структуры]
Public Sub initStruct(structSize)
'Локализация структуры
init=HeapAlloc_Call.HeapAlloc(hHeap,0,structSize)
End Sub
'-----------------------------------------------------------------------------------------
'[Возврат базового адреса]
Public Property Get baseAddr
'Базовый адрес
baseAddr=init
End Property
'-----------------------------------------------------------------------------------------
'*[Добавление данных в структуру]
Public Function SetDataDWORD(ptr,iSize,Data)
Dim lW,hW,ConvertedData
hW=Fix(Data/65536)
lW=Data mod 65536
ConvertedData=ChrW(lW) & ChrW(hW)
RtlMoveMemory_Call.RtlMovememory ptr+iOfs,GetBSTRPtr(ConvertedData),iSize
iOfs=iOfs+iSize
End Function
'-----------------------------------------------------------------------------------------
'*[Извлечение данных структуры]
Public Function GetDataDWORD(lpData,iSize,iOffset)
Dim pDest,tdOffset
pDest=lstrcat_Call.lstrcat(GetDataDWORD,"")
GetDataDWORD=CLng(0)
RtlMoveMemory_Call.RtlMovememory pDest+8,lpData+iOffset,iSize
End Function
'-----------------------------------------------------------------------------------------
'*[Получение локального указателя добавляемых данных]
Public Function GetBSTRPtr(ByRef sData)
Dim pSource
Dim pDest
pSource=lstrcat_Call.lstrcat(sData,"")
pDest=lstrcat_Call.lstrcat(GetBSTRPtr,"")
GetBSTRPtr=CLng(GetBSTRPtr)
RtlMoveMemory_Call.RtlMovememory pDest+8,pSource+8,4
End Function
'-----------------------------------------------------------------------------------------
End Class
'-----------------------------------------------------------------------------------------
'----------- Закрашивание заданного прямоугольника в области заданного окна --------------
'-----------------------------------------------------------------------------------------
Function paintRect()
Set wShell =WScript.CreateObject("WScript.Shell")
'---------------------------------------------------------------------------------
wShell.Run "NOTEPAD.EXE",3,0
ax3.Sleep(500)
'---------------------------------------------------------------------------------
'Заполнение структуры
iOfs=0
Set RECT=new Struct
RECT.initStruct(16)
RECT.SetDataDWORD RECT.baseAddr,4,100
RECT.SetDataDWORD RECT.baseAddr,4,100
RECT.SetDataDWORD RECT.baseAddr,4,400
RECT.SetDataDWORD RECT.baseAddr,4,400
ax3.Sleep(500)
'---------------------------------------------------------------------------------
'Закрашивание произвольной области окна
Set GetForegroundWindow_Call =CreateObject("DynamicWrapper")
GetForegroundWindow_Call.Register "USER32.DLL","GetForegroundWindow","f=s","r=h"
hwnd=GetForegroundWindow_Call.GetForegroundWindow()
Set GetForegroundWindow_Call=Nothing
'---------------------------------------------------------------------------------
Set GetWindowDC_Call =CreateObject("DynamicWrapper")
GetWindowDC_Call.Register "USER32.DLL","GetWindowDC","i=h","f=s","r=h"
hDeskDC=GetWindowDC_Call.GetWindowDC(CLng(hwnd))
Set GetWindowDC_Call=Nothing
'---------------------------------------------------------------------------------
color=&Hff8000
Set CreateSolidBrush_Call =CreateObject("DynamicWrapper")
CreateSolidBrush_Call.Register "GDI32.DLL","CreateSolidBrush","i=l","f=s","r=h"
hBrush=CreateSolidBrush_Call.CreateSolidBrush(CLng(color))
Set CreateSolidBrush_Call=Nothing
'---------------------------------------------------------------------------------
Set FillRect_Call =CreateObject("DynamicWrapper")
FillRect_Call.Register "USER32.DLL","FillRect","i=hlh","f=s","r=u"
FillRect_Call.FillRect CLng(hDeskDC),CLng(RECT.baseAddr),CLng(hBrush)
Set FillRect_Call=Nothing
'---------------------------------------------------------------------------------
Set RECT=Nothing
WScript.Echo("Область заполнена с использованием структуры RECT :-)")
End Function
'-----------------------------------------------------------------------------------------
'----------- Отслеживание движений курсора мыши ------------------------------------------
'-----------------------------------------------------------------------------------------
Function trackMouse()
WScript.Echo("Движение курсора мыши отслеживается с помощью структуры POINT :-)")
'---------------------------------------------------------------------------------
'Заполнение структуры
iOfs=0
Set POINT=new Struct
POINT.initStruct(8)
'---------------------------------------------------------------------------------
Set GetCursorPos_Call =CreateObject("DynamicWrapper")
GetCursorPos_Call.Register "USER32.DLL","GetCursorPos","i=l","f=s"
While 1
GetCursorPos_Call.GetCursorPos CLng(POINT.baseAddr)
x=POINT.GetDataDWORD(POINT.baseAddr,4,0)
y=POINT.GetDataDWORD(POINT.baseAddr,4,4)
ax3.ToolTip vbCR & _
"X " & x & vbCR & _
"Y " & y & vbCR & _
"Наведите указатель чтобы" & vbCR & _
"прекратить выполнение" & vbCR,10,10
'-------------------------------------------------------------------------
If x<60 And y<60 then
Set POINT=Nothing
Exit Function
End If
Wend
'---------------------------------------------------------------------------------
End Function
'-----------------------------------------------------------------------------------------
paintRect()
trackMouse()
Автор примера - Poltergeyst.
В названии ветки всегда должен быть указан язык программирования или среда исполнения скрипта, если это возможно.