Серый форум — VBScript: использование структур RECT и POINT в Win32 API

Re: VBScript: использование структур RECT и POINT в Win32 API

null@example.com (Poltergeyst) — Sun, 04 May 2008 18:51:00 +0000

Также можно организовать скрипт,оределяющий размеры BITMAP
изображения,что может оказаться полезным,например,при работе
с элементом ImageList.

'---------------------------------------------------------------------------
'------ Нет гарантий!Используете на свой страх и риск ------------
'---------------------------------------------------------------------------
'Использование структуры BITMAP для определения размеров
'точечного рисунка (*.BMP)
'---------------------------------------------------------------------------
'Language:            VBScript
'Используется             библиотека dynwrap.dll
'---------------------------------------------------------------------------
'ОС Win98 4.10.2222
'---------------------------------------------------------------------------


'------------------ Создание класса -----------------------------------
Class StructRestr
'---------------------------------------------------------------------------
    Private     RtlMoveMemory_Call, _
            lstrcat_Call, _
            HeapAlloc_Call, _
            GetProcessHeap_Call, _
            HeapFree_Call
    Private     hHeap,init
'---------------------------------------------------------------------------
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 GetDataDWORD(lpData,iOffset)
        Dim pDest,tdOffset
        pDest=lstrcat_Call.lstrcat(GetDataDWORD,"")
        GetDataDWORD=CLng(0)
        RtlMoveMemory_Call.RtlMovememory pDest+8,lpData+iOffset,4 
    End Function 
End Class
'---------------------------------------------------------------------------
'--------- Определение размера точечного изображения ---------
'---------------------------------------------------------------------------
Function GetBitmapDimension()

const LR_LOADFROMFILE        =16
const IMAGE_BITMAP        =0

path="C:\...\...\image.bmp"
'---------------------------------------------------------------------------
'Инициализация структуры BITMAP    
    Set BITMAP=new StructRestr
    BITMAP.initStruct(22)
'---------------------------------------------------------------------------
'Загрузка изображения и определение его размеров
Set LoadImageA_Call=CreateObject("DynamicWrapper")
LoadImageA_Call.Register "USER32.DLL","LoadImageA","i=lsllll","f=s","r=l"
hBitmap=LoadImageA_Call.LoadImageA(0,CStr(path),IMAGE_BITMAP, _
0,0,LR_LOADFROMFILE)
Set LoadImageA_Call=Nothing
'---------------------------------------------------------------------------
Set GetObj_Call    =CreateObject("DynamicWrapper")
GetObj_Call.Register "GDI32.DLL","GetObjectA","i=lll","f=s","r=l"
GetObj_Call.GetObjectA CLng(hBitmap),CLng(22),CLng(BITMAP.baseAddr)
Set GetObj_Call=Nothing
'---------------------------------------------------------------------------
    bWidth    =BITMAP.GetDataDWORD(BITMAP.baseAddr,4)
    bHeight    =BITMAP.GetDataDWORD(BITMAP.baseAddr,8)
'---------------------------------------------------------------------------
Set BITMAP=Nothing
WScript.Echo    "Размеры изображения"     & vbCR & _
        "[" & path & "]"     & vbCR & _
        bWidth & " X " & bHeight 
'---------------------------------------------------------------------------
End Function
'---------------------------------------------------------------------------
GetBitmapDimension()

Осталось отметить,что при создании этих скриптов использовалась
несколько переделанная технология представленная в этом примере:

http://www.visualbasicscript.com/m_4747 … .htm#47471

Разница в том,что в примере по вышеуказанной ссылке,память под
структуру выделяется динамически,т.е для доведения структуры
до заданного размера,её надо заполнять нулями,в отличие от
вышеуказанных листингов,где структура заданного размера
жестко локализуется в системной куче текущего процесса.

VBScript: использование структур RECT и POINT в Win32 API

null@example.com (The gray Cardinal) — Sat, 03 May 2008 07:53:28 +0000

Пример демонстрирует использование структур 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.