Hooking into the IDispatch interface.

ProgAndy · January 5, 2010

I tried to get rid of the ObjCreate, but I encountered a few problems:

You MUST specify an object error handler or AutoIt won't exit when there's a COM_error

You MUST free all object-Variables ($oObj = 0) or AutoIt won't exit.

I think this results in the DLLCallbacks freed before the Obj-Variables are destroyed and then the Release-Function can't be called anymore. It seems that this is the same error as #1319. Should I add a feature request that DLLCallbacks are freed after Objects and Windows?

monoceres · January 5, 2010

Yes, however it's tricky.

Let's say we define a callback that acts like IUnknown::Release(). What will happen if this gets called when everything else is freed? I don't know.

JRSmile · January 5, 2010

this is perfect, again a great big thing done by the mono man.

if it gets stable and easier to use i will rewrite all my udfs with it.

is it possible for VBS/VBA for example to ulilize the internal functions of that exe to or are they limited to the current process?

monoceres · January 5, 2010

this is perfect, again a great big thing done by the mono man.
if it gets stable and easier to use i will rewrite all my udfs with it.
is it possible for VBS/VBA for example to ulilize the internal functions of that exe to or are they limited to the current process?

Nice to hear! I'm doing my best to make this as simple as possible. The last example (the last lines) is probably how it will be done. Not very hard according to me, but if you have another idea, then I'm all ears. Just remember that I cannot create new syntax. We're stuck with that.

It will not be visible outside, the manipulation is done on per-instance basis so it's for autoit's eyes only.

junkew · January 5, 2010

With this code it seems we can get MSAA (accessibility) also working within AutoIT

Will play around with this article and an MSAA example as in topic below

http://www.autoitscript.com/forum/index.php?showtopic=95176&st=0&p=683997&hl=msaa&fromsearch=1&#entry683997

monoceres · January 5, 2010

@junkew, good luck! If you have any concrete questions feel free to ask.

Inheritance (and polymorphism) is now possible! Check end of this script for sample usage.

#include <Array.au3>

Global $hOle32 = 0

Global Const $VT_EMPTY = 0
Global Const $VT_NULL = 1
Global Const $VT_I2 = 2
Global Const $VT_I4 = 3
Global Const $VT_R4 = 4
Global Const $VT_R8 = 5
Global Const $VT_CY = 6
Global Const $VT_DATE = 7
Global Const $VT_BSTR = 8
Global Const $VT_DISPATCH = 9
Global Const $VT_ERROR = 10
Global Const $VT_BOOL = 11
Global Const $VT_VARIANT = 12
Global Const $VT_UNKNOWN = 13
Global Const $VT_DECIMAL = 14
Global Const $VT_I1 = 16
Global Const $VT_UI1 = 17
Global Const $VT_UI2 = 18
Global Const $VT_UI4 = 19
Global Const $VT_I8 = 20
Global Const $VT_UI8 = 21
Global Const $VT_INT = 22
Global Const $VT_UINT = 23
Global Const $VT_VOID = 24
Global Const $VT_HRESULT = 25
Global Const $VT_PTR = 26
Global Const $VT_SAFEARRAY = 27
Global Const $VT_CARRAY = 28
Global Const $VT_USERDEFINED = 29
Global Const $VT_LPSTR = 30
Global Const $VT_LPWSTR = 31
Global Const $VT_RECORD = 36
Global Const $VT_INT_PTR = 37
Global Const $VT_UINT_PTR = 38
Global Const $VT_FILETIME = 64
Global Const $VT_BLOB = 65
Global Const $VT_STREAM = 66
Global Const $VT_STORAGE = 67
Global Const $VT_STREAMED_OBJECT = 68
Global Const $VT_STORED_OBJECT = 69
Global Const $VT_BLOB_OBJECT = 70
Global Const $VT_CF = 71
Global Const $VT_CLSID = 72
Global Const $VT_VERSIONED_STREAM = 73
Global Const $VT_BSTR_BLOB = 0xfff
Global Const $VT_VECTOR = 0x1000
Global Const $VT_ARRAY = 0x2000
Global Const $VT_BYREF = 0x4000
Global Const $VT_RESERVED = 0x8000
Global Const $VT_ILLEGAL = 0xffff
Global Const $VT_ILLEGALMASKED = 0xfff
Global Const $VT_TYPEMASK = 0xfff

Global Const $tagGUID = "ulong;ushort;ushort;byte[8]"
Global Const $tagCLSID = $tagGUID
Global Const $tagUUID = $tagGUID
Global Const $CLSCTX_INPROC_SERVER = 0x1
Global Const $S_OK = 0
Global Const $DISP_E_UNKNOWNNAME = 2147614726
Global Const $DISPID_UNKNOWN = 4294967295
Global Const $DISP_E_MEMBERNOTFOUND = 2147614723
Global Const $tagVARIANT = "ushort vt;ushort r1;ushort r2;ushort r3;uint64 data"
Global Const $tagDISPPARAMS = "ptr rgvargs;ptr rgdispidNamedArgs;dword cArgs;dword cNamedArgs;"


Global Const $DISPATCH_METHOD = 0x1
Global Const $DISPATCH_PROPERTYGET = 0x2
Global Const $DISPATCH_PROPERTYPUT = 0x4
Global Const $DISPATCH_PROPERTYPUTREF = 0x8

Global Const $tagLOOKUP_TABLE_ENTRY = "ptr name;ptr value;dword flags;"
Global Const $LOOKUP_TABLE_ENTRY_SIZE = DllStructGetSize(DllStructCreate($tagLOOKUP_TABLE_ENTRY))
Global Const $LOOKUP_TABLE_METHOD = 1
Global Const $LOOKUP_TABLE_PROPERTY = 2
Global Const $LOOKUP_TABLE_PUBLIC = 0
Global Const $LOOKUP_TABLE_PRIVATE = 4


Func SizeOfPtr()
    Return DllStructGetSize(DllStructCreate("ptr"))
EndFunc ;==>SizeOfPtr

; Starts COM
Func CoInitialize()
    Global $hOle32 = DllOpen("Ole32.dll")
    Local $aCall = DllCall($hOle32, "long", "CoInitializeEx", "ptr", 0, "dword", 2) ; COINIT_APARTMENTTHREADED
EndFunc ;==>CoInitialize

; This will make a registry lookup to find out what the passed
; string really means. That is a GUID
Func CLSIDFromProgID($ProgID)
    $clsid = DllStructCreate($tagCLSID)
    DllCall($hOle32, "long", "CLSIDFromProgID", "wstr", $ProgID, "ptr", DllStructGetPtr($clsid))
    Return $clsid
EndFunc ;==>CLSIDFromProgID

; Returns the UUID of IDispatch
Func IDispatch_UUID()
    Local $tUUIDByte = DllStructCreate("byte[16]")
    DllStructSetData($tUUIDByte, 1, "0x0004020000000000C000000000000046") ; IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"
    Return $tUUIDByte
EndFunc ;==>IDispatch_UUID

; Creates a instance of a COM object from a clsid and iid
; Usually done internally by autoit but we need the pointer.
Func CoCreateInstance($clsid, $pUnkOuter, $ClsContext, $iid, $pOutObj)
    Return DllCall($hOle32, "long", "CoCreateInstance", "ptr", DllStructGetPtr($clsid), "ptr", $pUnkOuter, "dword", $ClsContext, "ptr", DllStructGetPtr($iid), "ptr", $pOutObj)
EndFunc ;==>CoCreateInstance

; WRAPPER FOR IDISPATCH INTERFACES.
; This is like ObjCreate except this returns the raw pointer to the IDispatch interface.
; This is essential for hooking the methods of the IDispatch object.
Func CreateIDispatchFromProgID($ProgID)
    ; Ptr to IDispatch object
    $pObj = DllStructCreate("ptr")
    $aCall = CoCreateInstance(CLSIDFromProgID($ProgID), 0, $CLSCTX_INPROC_SERVER, IDispatch_UUID(), DllStructGetPtr($pObj))
    Return DllStructGetData($pObj, 1)
EndFunc ;==>CreateIDispatchFromProgID

; In the end we still want the autoit object. This function converts a raw pointer to an autoit object
Func ConvertPtrToIDispatch($pIDispatch)
    ; This would have been 10000x easier if autoit had supported the idispatch* type in dllstructs...
    ; Fortunetely memcpy can copy the pointer into a idispatch*, lucky us.
    Local $aCall = DllCall("kernel32.dll", "none", "RtlMoveMemory", _
            "idispatch*", 0, _
            "ptr*", $pIDispatch, _
            "dword", 4)

    If @error Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[1]

EndFunc ;==>ConvertPtrToIDispatch

Func ConvertIDispatchToPtr($oIDispatch)

    Local $aCall = DllCall("kernel32.dll", "none", "RtlMoveMemory", _
            "ptr*", 0, _
            "idispatch*", $oIDispatch, _
            "dword", SizeOfPtr())

    If @error Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[1]

EndFunc ;==>ConvertIDispatchToPtr

; Sets the MEM_EXECUTE_READWRITE flag on the specified memory. Use with care, I use because I'm lazy.
Func UnprotectMemory($pointer, $size)
    DllCall("Kernel32.dll", "int", "VirtualProtect", "ptr", $pointer, "long", $size, "dword", 0x40, "dword*", 0)
EndFunc ;==>UnprotectMemory

; Returns the pointer the passed pointer points to ;)
Func DereferencePointer($ptr)
    $tempstruct = DllStructCreate("ptr", $ptr)
    Return DllStructGetData($tempstruct, 1)
EndFunc ;==>DereferencePointer


; Moves the vtable to a new position. useful if you want to add more entries.
Func RelocateVTable($pObj, $pNew, $VTable_size)
    $vtable = DllStructCreate("ptr", $pObj)
    $vtable_ptr = DllStructGetData($vtable, 1)
    DllCall("kernel32.dll", "none", "RtlMoveMemory", "ptr", $pNew, "ptr", $vtable_ptr, "dword", $VTable_size)
    DllStructSetData($vtable, 1, $pNew)
EndFunc ;==>RelocateVTable

; Allocate memory on the heap
Func DynAlloc($dwSize)
    $hHeap = DllCall("Kernel32.dll", "ptr", "GetProcessHeap")
    $hHeap = $hHeap[0]
    $hMem = DllCall("Kernel32.dll", "ptr", "HeapAlloc", "ptr", $hHeap, "dword", 0x8, "dword", $dwSize)
    DllCall("Kernel32.dll", "none", "CloseHandle", "ptr", $hHeap)
    Return $hMem[0]
EndFunc ;==>DynAlloc


Func DynFree($hMem)
    $hHeap = DllCall("Kernel32.dll", "ptr", "GetProcessHeap")
    $hHeap = $hHeap[0]
    $hMem = DllCall("Kernel32.dll", "int", "HeapFree", "ptr", $hHeap, "dword", 0, "ptr", $hMem)
    DllCall("Kernel32.dll", "none", "CloseHandle", "ptr", $hHeap)
    Return $hMem[0]
EndFunc ;==>DynFree




; Takes a pointer to the v-table in a class and replaces specified pointer in it to a new one.
Func ReplaceVTableEntry($vtable_ptr, $offset, $new_ptr)
    ; Dereference the pointer
    $first_entry_ptr = DereferencePointer($vtable_ptr)

    $entry_pointer = $first_entry_ptr + $offset
    ; Make the memory free for all. Yay!
    UnprotectMemory($entry_pointer, 4)
    $entry_struct = DllStructCreate("ptr", $entry_pointer)
    DllStructSetData($entry_struct, 1, $new_ptr)

EndFunc ;==>ReplaceVTableEntry



Func CreateDynamicString($str)
    $dynmem = DynAlloc(StringLen($str) + 1)
    DllStructSetData(DllStructCreate("char[" & StringLen($str) + 1 & "]", $dynmem), 1, $str)
    Return $dynmem
EndFunc ;==>CreateDynamicString



Func AddMembersToLookupTable($pObj, $aNames)



    ; Set point in vtable
    $vtable_entry = DllStructCreate("ptr", DereferencePointer($pObj) + 4 * 7)




    If DllStructGetData($vtable_entry, 1) <> 0 Then

        $header = DllStructCreate("int", DllStructGetData($vtable_entry, 1))

        Local $temparr[UBound($aNames)+DllStructGetData($header,1)][2]
        For $i=0 To DllStructGetData($header,1)-1
            $current_entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY,(DllStructGetData($vtable_entry, 1)+4)+$LOOKUP_TABLE_ENTRY_SIZE*$i)
            $temparr[$i][0] = ChrPtrToString(DllStructGetData($current_entry,"name"))
            if StringLeft($temparr[$i][0],1)="@" Then
                $temparr[$i][1] = ChrPtrToString(DllStructGetData($current_entry,"value"))
            Else
                $temparr[$i][1] = COMVariantToValue(DllStructGetData($current_entry,"value"))
            EndIf

        Next
        For $i=0 To UBound($aNames)-1
            For $j=0 To UBound($temparr)-1
                If $temparr[$j][0]=$aNames[$i][0] Then
                    $temparr[$j][0] = $aNames[$i][0]
                    $temparr[$j][1] = $aNames[$i][1]
                    ExitLoop
                ElseIf $temparr[$j][0]="" Then
                    $temparr[$j][0] = $aNames[$i][0]
                    $temparr[$j][1] = $aNames[$i][1]
                    ExitLoop
                EndIf
            Next
        Next

        For $i=UBound($temparr)-1 To 0 Step -1
            If $temparr[$i][0]<>"" Then ExitLoop
            _ArrayDelete($temparr,$i)
        Next


        $aNames = $temparr


        DynFree(DllStructGetData($vtable_entry, 1))


    EndIf


    ; Create dynamic memory for new lookup table
    $mem = DynAlloc(4 + (UBound($aNames) * $LOOKUP_TABLE_ENTRY_SIZE))
    ; Create lookup table, first element is number of element
    ; Must be sorted!
    $lookup_table = DllStructCreate("int;byte[" & $LOOKUP_TABLE_ENTRY_SIZE & "]", $mem)
    ; Set size of lookup table
    DllStructSetData($lookup_table, 1, UBound($aNames))
    ; Modify vtable to point to the lookup table
;~  MsgBox(0,"", $mem)
    DllStructSetData($vtable_entry, 1, $mem)



    For $i = 0 To UBound($aNames) - 1
        $current_entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, DllStructGetPtr($lookup_table, 2) + $LOOKUP_TABLE_ENTRY_SIZE * $i)

        If StringLeft($aNames[$i][0], 1) = "@" Then ; This is a method
            DllStructSetData($current_entry, "name", CreateDynamicString($aNames[$i][0]))
            DllStructSetData($current_entry, "value", CreateDynamicString($aNames[$i][1]))
        Else ; It's a property then.
            $variant_ptr = DynAlloc(16)
            ValueToCOMVariant($variant_ptr, $aNames[$i][1])
            DllStructSetData($current_entry, "name", CreateDynamicString($aNames[$i][0]))
            DllStructSetData($current_entry, "value", $variant_ptr)
        EndIf




    Next
EndFunc ;==>AddMembersToLookupTable

Func ChrPtrToString($ptr)
    $len = strlen($ptr)
    $str_struct = DllStructCreate("char[" & $len + 1 & "]", $ptr)
    Return DllStructGetData($str_struct, 1)
EndFunc ;==>ChrPtrToString


Func FindNameInLookupTable($pObj, $name)
    $vtable_entry = DllStructCreate("ptr", DereferencePointer($pObj) + 4 * 7) ; sizeof(ptr)*(num entries in idispatch)
    $header = DllStructCreate("int", DllStructGetData($vtable_entry, 1))
    $lookup_table_size = DllStructGetData($header, 1)




    For $i = 0 To $lookup_table_size - 1
        $current_entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($vtable_entry, 1) + 4) + $LOOKUP_TABLE_ENTRY_SIZE * $i)
        If $name = ChrPtrToString(DllStructGetData($current_entry, "name")) Then Return $i
    Next


    Return -1

EndFunc ;==>FindNameInLookupTable

Func IDToValue($pObj, $id)
;~  MsgBox(0,"",$id)
    $vtable_entry = DllStructCreate("ptr", DereferencePointer($pObj) + 4 * 7)
    $header = DllStructCreate("int", DllStructGetData($vtable_entry, 1))
    $lookup_table_size = DllStructGetData($header, 1)


    If $id < 0 Or $id > $lookup_table_size Then Return ""

    $current_entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($vtable_entry, 1) + 4) + $LOOKUP_TABLE_ENTRY_SIZE * $id)

    $member_name = ChrPtrToString(DllStructGetData($current_entry, "name"))
    If StringLeft($member_name, 1) = "@" Then

        Return ChrPtrToString(DllStructGetData($current_entry, "value"))
    Else
        Return DllStructGetData($current_entry, "value")
    EndIf
EndFunc ;==>IDToValue




Func VTType2AutoitType($vt_type)
    Switch $vt_type
        Case $VT_I1
            Return "byte"
        Case $VT_I2
            Return "short"
        Case $VT_I4
            Return "int"
        Case $VT_BSTR
            Return "wstr"
    EndSwitch
EndFunc ;==>VTType2AutoitType

Func AutoitType2VTType($autoit_type)
    Switch $autoit_type
        Case "byte"
            Return $VT_I1
        Case "short"
            Return $VT_I2
        Case "int"
            Return $VT_I4
        Case "wstr"
            Return $VT_BSTR
    EndSwitch

EndFunc ;==>AutoitType2VTType


; Find out length of string. I do not trust autoit to do this.
Func wcslen($pwchar)
    $aCall = DllCall("ntdll.dll", "dword:cdecl", "wcslen", "ptr", $pwchar)
    Return $aCall[0]
EndFunc ;==>wcslen

; Find out length of string. I do not trust autoit to do this.
Func strlen($pchar)
    $aCall = DllCall("ntdll.dll", "dword:cdecl", "strlen", "ptr", $pchar)
    Return $aCall[0]
EndFunc ;==>strlen

Func SysAllocString($str)
    $aCall = DllCall("oleaut32.dll", "ptr", "SysAllocString", "wstr", $str)
    Return $aCall[0]
EndFunc ;==>SysAllocString



Func COMVariantToValue($pVariant)
    Local $var = DllStructCreate($tagVARIANT, $pVariant)
    ; Translate the vt id to a autoit dllcall type
    $type = VTType2AutoitType(DllStructGetData($var, "vt"))

    If $type = "wstr" Then
        $str_ptr = DllStructCreate("ptr", DllStructGetPtr($var, "data"))
        ; Getting random crashes when trusting autoit to automatically use right size.
        ; doing it myself instead (also, it should be a BSTR, but it's not. Is autoit not obeying the rules!?
        $str_size = wcslen(DllStructGetData($str_ptr, 1))
        $tSub = DllStructCreate("dword", DllStructGetData($str_ptr, 1) - 4) ; <- move pointer back 4 bytes!
        ConsoleWrite("!!! " & DllStructGetData($tSub, 1) / 2 & @CRLF)
        $data = DllStructCreate("wchar[" & DllStructGetData($tSub, 1) + 1 & "]", DllStructGetData($str_ptr, 1))
;~      $data = DllStructCreate("wchar[" & $str_size + 1 & "]", DllStructGetData($str_ptr, 1))

    Else
        $data = DllStructCreate($type, DllStructGetPtr($var, "data"))
    EndIf


    Return DllStructGetData($data, 1)
EndFunc ;==>COMVariantToValue

Func ValueToCOMVariant($pVariant, $vValue)
    $var = DllStructCreate($tagVARIANT, $pVariant)

    If IsInt($vValue) Then
        $vt_type = AutoitType2VTType("int")
        $var_data = $vValue
    ElseIf IsString($vValue) Then
        $vt_type = AutoitType2VTType("wstr")
        $var_data = SysAllocString($vValue)
    EndIf
    DllStructSetData($var, "vt", $vt_type)
    DllStructSetData(DllStructCreate("int", DllStructGetPtr($var, "data")), 1, $var_data)

EndFunc ;==>ValueToCOMVariant






; Everytime autoit wants to call a method, get or set a property in a object it needs to go to
; IDispatch::GetIDsFromNames. This is our version of that function, note that by defining this ourselves
; we can fool autoit to believe that the object supports a lot of different properties/methods.
Func IDispatch_GetIDsFromNames($self, $refiid, $str_array, $array_size, $context, $out_array)
    ; It's self explainable that autoit only asks for one member
    $str = DllStructCreate("wchar[256]", DereferencePointer($str_array))
    ConsoleWrite("AutoIt wants to look up: " & DllStructGetData($str, 1) & @CRLF)

    ; Autoit gave us an array with one element ready to accept the id of the member it requested.
    $ids = DllStructCreate("long", $out_array)

;~  ConsoleWrite("ZERO"&@CRLF)
    $id = FindNameInLookupTable($self, "@" & DllStructGetData($str, 1))
    ConsoleWrite("ONE" & @CRLF)
    If $id = -1 Then $id = FindNameInLookupTable($self, DllStructGetData($str, 1))
    ConsoleWrite("TWO" & @CRLF)
    If $id <> -1 Then
        DllStructSetData($ids, 1, $id)
        Return $S_OK
    Else
        DllStructSetData($ids, 1, $DISPID_UNKNOWN)
        Return $DISP_E_UNKNOWNNAME
    EndIf



EndFunc ;==>IDispatch_GetIDsFromNames
; Create the callback so we have a pointer to this function.
$IDispatch_GetIDsFromNames_Callback = DllCallbackRegister("IDispatch_GetIDsFromNames", "long", "ptr;ptr;ptr;int;int;ptr")
$IDispatch_GetIDsFromNames_Callback_Ptr = DllCallbackGetPtr($IDispatch_GetIDsFromNames_Callback)


; This is called when a method is called, a property is set or get.
; This call also contains arguments returns and a lot other stuff.
; However in this trivial example we don't return anything and we don't take any arguments. Puh, could get messy
Func IDispatch_Invoke($self, $dispID, $riid, $lcid, $wFlags, $pDispParams, $pVarResult, $pExceptInfo, $puArgErr)
    ;; Dump all parameters to console.
    ConsoleWrite("DispID: " & $dispID & @CRLF & "RIID: " & $riid & @CRLF & "LCID: " & $lcid & @CRLF & "wFlags: " & $wFlags & @CRLF & _
            "pDispParams: " & $pDispParams & @CRLF & "pVarResult: " & $pVarResult & @CRLF & "pExceptInfo: " & $pExceptInfo & @CRLF & "puArgError: " & $puArgErr & @CRLF)


    $memberval = IDToValue($self, $dispID)

    If $memberval = "" Then Return $DISP_E_MEMBERNOTFOUND
    $dispparams = DllStructCreate($tagDISPPARAMS, $pDispParams)
    If $wFlags = BitOR($DISPATCH_METHOD, $DISPATCH_PROPERTYGET) Then
        If IsString($memberval) Then



            $self_obj = ConvertPtrToIDispatch($self)
            $callstring = $memberval & "($self_obj"

            If $pDispParams <> 0 And DllStructGetData($dispparams, "cArgs") > 0 Then
                Local $params[DllStructGetData($dispparams, "cArgs")]
                ; Fetch all arguments
                For $i = 0 To UBound($params) - 1
                    ; Save the values backwards (that's how autoit do it)
                    $params[(UBound($params) - 1) - $i] = COMVariantToValue(DllStructGetData($dispparams, "rgvargs") + ($i * 16)) ; i*sizeof(VARIANT)
                    $callstring &= ",$params[" & $i & "]"
                Next
            EndIf
            $callstring &= ")"
            ConsoleWrite("Calling function: " & $callstring & @CRLF)
            $ret = Execute($callstring)
            ; Set return value.
            ValueToCOMVariant($pVarResult, $ret)
            ; Give autoit the message that everything went according to plan
            Return $S_OK
        Else
            ValueToCOMVariant($pVarResult, COMVariantToValue($memberval))
            Return $S_OK
        EndIf

    ElseIf $wFlags = $DISPATCH_PROPERTYPUT Then
;~      MsgBox(0,"","")
;~      ConsoleWrite(DereferencePointer($pDispParams+8)&@CRLF)
;~      ConsoleWrite(DllStructGetData($dispparams,"rgvargs")&@CRLF)
        ValueToCOMVariant($memberval, COMVariantToValue(DllStructGetData($dispparams, "rgvargs")))
        Return $S_OK
    EndIf




EndFunc ;==>IDispatch_Invoke
; Create callback
$IDispatch_Invoke_Callback = DllCallbackRegister("IDispatch_Invoke", "long", "ptr;dword;ptr;dword;ushort;ptr;ptr;ptr;ptr")
$IDispatch_Invoke_Callback_Ptr = DllCallbackGetPtr($IDispatch_Invoke_Callback)


Func CreateObject($aMembers,$BaseClass = "")
    ; Create a victim. Could be any COM object that inherits from IDispatch

    If Not IsObj($BaseClass) Then
        $obj_ptr = CreateIDispatchFromProgID("ScriptControl")
    ; Hook into the object
    ; Offset 20 & 24 is fifth entry in vtable. Look at IDispatch and IUnknown interfaces to see why
    ReplaceVTableEntry($obj_ptr, 20, $IDispatch_GetIDsFromNames_Callback_Ptr)
    ReplaceVTableEntry($obj_ptr, 24, $IDispatch_Invoke_Callback_Ptr)

    ; Create space for a new bigger vtable
    $p = DynAlloc(4 * 7 + 4) ; sizeof(ptr)*(num entirs in dispatch)+sizeof(ptr)
    RelocateVTable($obj_ptr, $p, 4 * 7)
    Else
        $obj_ptr = ConvertIDispatchToPtr($BaseClass)
    EndIf






    AddMembersToLookupTable($obj_ptr, $aMembers)

    Return ConvertPtrToIDispatch($obj_ptr)
EndFunc ;==>CreateObject





; Initalize COM
CoInitialize()




Local $animals[2] = [Dog("Fido"),Cat("Kitty")]

For $animal In $animals
    $animal.Speak()
    $animal.Die()
Next



Func Animal($name)
    ; It's okay to not supply a function name to a method
    ; it just means that a derived class will have to define it instead
    Local $members[3][2]=[["@Speak",""],["@Die","Animal_Die"],["name",$name]]
    Return CreateObject($members)
EndFunc

Func Animal_Die($self)
    MsgBox(0,"Too bad",$self.name&" is dying :(")
EndFunc


Func Dog($name)
    Local $members[1][2] = [["@Speak","Dog_Speak"]]
    Return CreateObject($members,Animal($name))
EndFunc

Func Dog_Speak($self)
    MsgBox(0,$self.name&" says","Woof!!")
EndFunc

Func Cat($name)
    Local $members[1][2]=[["@Speak","Cat_Speak"]]
    Return CreateObject($members,Animal($name))
EndFunc

Func Cat_Speak($self)
    MsgBox(0,$self.name&" says","Meow!")
EndFunc

James · January 5, 2010

Awesome work mono! I'm going to go and play with this.

It's a shame that $this can't just refer to the function/scope itself, instead of having to declare it

Edited January 5, 2010 by JamesBrooks

UEZ · January 5, 2010

It seems to be an awesome job monoceres, although I didn't understand currently object orientation, inheritance and polymorphism (started newly with C++)!

Maybe a new way of thinking writting code in AutoIt will born...

Well done

Edited January 5, 2010 by UEZ

monoceres · January 7, 2010

So what's new this time?

Object in object support (that is, you can save objects in properties and pass them as parameters).

This is essential for a good object oriented environment, tricky part to get this working is reference count for the objects, which is now completely of sync, therefore I introduced another memory leak. I promise to fix that later.

So here's another example, a linked list, something that was very hard to accomplish in autoit before, now done in a few lines of code.

#include <Array.au3>

Global $hOle32 = 0

Global Const $VT_EMPTY = 0
Global Const $VT_NULL = 1
Global Const $VT_I2 = 2
Global Const $VT_I4 = 3
Global Const $VT_R4 = 4
Global Const $VT_R8 = 5
Global Const $VT_CY = 6
Global Const $VT_DATE = 7
Global Const $VT_BSTR = 8
Global Const $VT_DISPATCH = 9
Global Const $VT_ERROR = 10
Global Const $VT_BOOL = 11
Global Const $VT_VARIANT = 12
Global Const $VT_UNKNOWN = 13
Global Const $VT_DECIMAL = 14
Global Const $VT_I1 = 16
Global Const $VT_UI1 = 17
Global Const $VT_UI2 = 18
Global Const $VT_UI4 = 19
Global Const $VT_I8 = 20
Global Const $VT_UI8 = 21
Global Const $VT_INT = 22
Global Const $VT_UINT = 23
Global Const $VT_VOID = 24
Global Const $VT_HRESULT = 25
Global Const $VT_PTR = 26
Global Const $VT_SAFEARRAY = 27
Global Const $VT_CARRAY = 28
Global Const $VT_USERDEFINED = 29
Global Const $VT_LPSTR = 30
Global Const $VT_LPWSTR = 31
Global Const $VT_RECORD = 36
Global Const $VT_INT_PTR = 37
Global Const $VT_UINT_PTR = 38
Global Const $VT_FILETIME = 64
Global Const $VT_BLOB = 65
Global Const $VT_STREAM = 66
Global Const $VT_STORAGE = 67
Global Const $VT_STREAMED_OBJECT = 68
Global Const $VT_STORED_OBJECT = 69
Global Const $VT_BLOB_OBJECT = 70
Global Const $VT_CF = 71
Global Const $VT_CLSID = 72
Global Const $VT_VERSIONED_STREAM = 73
Global Const $VT_BSTR_BLOB = 0xfff
Global Const $VT_VECTOR = 0x1000
Global Const $VT_ARRAY = 0x2000
Global Const $VT_BYREF = 0x4000
Global Const $VT_RESERVED = 0x8000
Global Const $VT_ILLEGAL = 0xffff
Global Const $VT_ILLEGALMASKED = 0xfff
Global Const $VT_TYPEMASK = 0xfff

Global Const $tagGUID = "ulong;ushort;ushort;byte[8]"
Global Const $tagCLSID = $tagGUID
Global Const $tagUUID = $tagGUID
Global Const $CLSCTX_INPROC_SERVER = 0x1
Global Const $S_OK = 0
Global Const $DISP_E_UNKNOWNNAME = 2147614726
Global Const $DISPID_UNKNOWN = 4294967295
Global Const $DISP_E_MEMBERNOTFOUND = 2147614723
Global Const $tagVARIANT = "ushort vt;ushort r1;ushort r2;ushort r3;uint64 data"
Global Const $tagDISPPARAMS = "ptr rgvargs;ptr rgdispidNamedArgs;dword cArgs;dword cNamedArgs;"


Global Const $DISPATCH_METHOD = 0x1
Global Const $DISPATCH_PROPERTYGET = 0x2
Global Const $DISPATCH_PROPERTYPUT = 0x4
Global Const $DISPATCH_PROPERTYPUTREF = 0x8

Global Const $tagLOOKUP_TABLE_ENTRY = "ptr name;ptr value;dword flags;"
Global Const $LOOKUP_TABLE_ENTRY_SIZE = DllStructGetSize(DllStructCreate($tagLOOKUP_TABLE_ENTRY))
Global Const $LOOKUP_TABLE_METHOD = 1
Global Const $LOOKUP_TABLE_PROPERTY = 2
Global Const $LOOKUP_TABLE_PUBLIC = 0
Global Const $LOOKUP_TABLE_PRIVATE = 4


Func SizeOfPtr()
    Return DllStructGetSize(DllStructCreate("ptr"))
EndFunc ;==>SizeOfPtr








; In the end we still want the autoit object. This function converts a raw pointer to an autoit object
Func ConvertPtrToIDispatch($pIDispatch)
    ; This would have been 10000x easier if autoit had supported the idispatch* type in dllstructs...
    ; Fortunetely memcpy can copy the pointer into a idispatch*, lucky us.
    Local $aCall = DllCall("kernel32.dll", "none", "RtlMoveMemory", _
            "idispatch*", 0, _
            "ptr*", $pIDispatch, _
            "dword", 4)

    If @error Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[1]

EndFunc ;==>ConvertPtrToIDispatch

Func ConvertIDispatchToPtr($oIDispatch)

    Local $aCall = DllCall("kernel32.dll", "none", "RtlMoveMemory", _
            "ptr*", 0, _
            "idispatch*", $oIDispatch, _
            "dword", SizeOfPtr())

    If @error Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[1]

EndFunc ;==>ConvertIDispatchToPtr

; Sets the MEM_EXECUTE_READWRITE flag on the specified memory. Use with care, I use because I'm lazy.
Func UnprotectMemory($pointer, $size)
    DllCall("Kernel32.dll", "int", "VirtualProtect", "ptr", $pointer, "long", $size, "dword", 0x40, "dword*", 0)
EndFunc ;==>UnprotectMemory

; Returns the pointer the passed pointer points to ;)
Func DereferencePointer($ptr, $type = "ptr")
    $tempstruct = DllStructCreate($type, $ptr)
    Return DllStructGetData($tempstruct, 1)
EndFunc ;==>DereferencePointer


; Moves the vtable to a new position. useful if you want to add more entries.
Func RelocateVTable($pObj, $pNew, $VTable_size)
    $vtable = DllStructCreate("ptr", $pObj)
    $vtable_ptr = DllStructGetData($vtable, 1)
    DllCall("kernel32.dll", "none", "RtlMoveMemory", "ptr", $pNew, "ptr", $vtable_ptr, "dword", $VTable_size)
    DllStructSetData($vtable, 1, $pNew)
EndFunc ;==>RelocateVTable

; Allocate memory on the heap
Func DynAlloc($dwSize)
    $hHeap = DllCall("Kernel32.dll", "ptr", "GetProcessHeap")
    $hHeap = $hHeap[0]
    $hMem = DllCall("Kernel32.dll", "ptr", "HeapAlloc", "ptr", $hHeap, "dword", 0x8, "dword", $dwSize)
    DllCall("Kernel32.dll", "none", "CloseHandle", "ptr", $hHeap)
    Return $hMem[0]
EndFunc ;==>DynAlloc


Func DynFree($hMem)
    $hHeap = DllCall("Kernel32.dll", "ptr", "GetProcessHeap")
    $hHeap = $hHeap[0]
    $hMem = DllCall("Kernel32.dll", "int", "HeapFree", "ptr", $hHeap, "dword", 0, "ptr", $hMem)
    DllCall("Kernel32.dll", "none", "CloseHandle", "ptr", $hHeap)
    Return $hMem[0]
EndFunc ;==>DynFree




; Takes a pointer to the v-table in a class and replaces specified pointer in it to a new one.
Func ReplaceVTableEntry($vtable_ptr, $offset, $new_ptr)
    ; Dereference the pointer
    $first_entry_ptr = DereferencePointer($vtable_ptr)

    $entry_pointer = $first_entry_ptr + $offset
    ; Make the memory free for all. Yay!
    UnprotectMemory($entry_pointer, 4)
    $entry_struct = DllStructCreate("ptr", $entry_pointer)
    DllStructSetData($entry_struct, 1, $new_ptr)

EndFunc ;==>ReplaceVTableEntry



Func CreateDynamicString($str)
    $dynmem = DynAlloc(StringLen($str) + 1)
    DllStructSetData(DllStructCreate("char[" & StringLen($str) + 1 & "]", $dynmem), 1, $str)
    Return $dynmem
EndFunc ;==>CreateDynamicString



Func AddMembersToLookupTable($pObj, $aNames)



    ; Set point in vtable
    $vtable_entry = DllStructCreate("ptr", DereferencePointer($pObj) + 4 * 7)




    If DllStructGetData($vtable_entry, 1) <> 0 Then

        $header = DllStructCreate("int", DllStructGetData($vtable_entry, 1))

        Local $temparr[UBound($aNames) + DllStructGetData($header, 1)][2]
        For $i = 0 To DllStructGetData($header, 1) - 1
            $current_entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($vtable_entry, 1) + 4) + $LOOKUP_TABLE_ENTRY_SIZE * $i)
            $temparr[$i][0] = ChrPtrToString(DllStructGetData($current_entry, "name"))
            If StringLeft($temparr[$i][0], 1) = "@" Then
                $temparr[$i][1] = ChrPtrToString(DllStructGetData($current_entry, "value"))
            Else
                $temparr[$i][1] = COMVariantToValue(DllStructGetData($current_entry, "value"))
            EndIf

        Next
        For $i = 0 To UBound($aNames) - 1
            For $j = 0 To UBound($temparr) - 1
                If $temparr[$j][0] = $aNames[$i][0] Then
                    $temparr[$j][0] = $aNames[$i][0]
                    $temparr[$j][1] = $aNames[$i][1]
                    ExitLoop
                ElseIf $temparr[$j][0] = "" Then
                    $temparr[$j][0] = $aNames[$i][0]
                    $temparr[$j][1] = $aNames[$i][1]
                    ExitLoop
                EndIf
            Next
        Next

        For $i = UBound($temparr) - 1 To 0 Step -1
            If $temparr[$i][0] <> "" Then ExitLoop
            _ArrayDelete($temparr, $i)
        Next


        $aNames = $temparr


        DynFree(DllStructGetData($vtable_entry, 1))


    EndIf


    ; Create dynamic memory for new lookup table
    $mem = DynAlloc(4 + (UBound($aNames) * $LOOKUP_TABLE_ENTRY_SIZE))
    ; Create lookup table, first element is number of element
    ; Must be sorted!
    $lookup_table = DllStructCreate("int;byte[" & $LOOKUP_TABLE_ENTRY_SIZE & "]", $mem)
    ; Set size of lookup table
    DllStructSetData($lookup_table, 1, UBound($aNames))
    ; Modify vtable to point to the lookup table
;~  MsgBox(0,"", $mem)
    DllStructSetData($vtable_entry, 1, $mem)



    For $i = 0 To UBound($aNames) - 1
        $current_entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, DllStructGetPtr($lookup_table, 2) + $LOOKUP_TABLE_ENTRY_SIZE * $i)

        If StringLeft($aNames[$i][0], 1) = "@" Then ; This is a method
            DllStructSetData($current_entry, "name", CreateDynamicString($aNames[$i][0]))
            DllStructSetData($current_entry, "value", CreateDynamicString($aNames[$i][1]))
        Else ; It's a property then.
            $variant_ptr = DynAlloc(16)
            ValueToCOMVariant($variant_ptr, $aNames[$i][1])
            DllStructSetData($current_entry, "name", CreateDynamicString($aNames[$i][0]))
            DllStructSetData($current_entry, "value", $variant_ptr)
        EndIf




    Next
EndFunc ;==>AddMembersToLookupTable

Func ChrPtrToString($ptr)
    $len = strlen($ptr)
    $str_struct = DllStructCreate("char[" & $len + 1 & "]", $ptr)
    Return DllStructGetData($str_struct, 1)
EndFunc ;==>ChrPtrToString


Func FindNameInLookupTable($pObj, $name)
    $vtable_entry = DllStructCreate("ptr", DereferencePointer($pObj) + 4 * 7) ; sizeof(ptr)*(num entries in idispatch)
    $header = DllStructCreate("int", DllStructGetData($vtable_entry, 1))
    $lookup_table_size = DllStructGetData($header, 1)




    For $i = 0 To $lookup_table_size - 1
        $current_entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($vtable_entry, 1) + 4) + $LOOKUP_TABLE_ENTRY_SIZE * $i)
        If $name = ChrPtrToString(DllStructGetData($current_entry, "name")) Then Return $i
    Next


    Return -1

EndFunc ;==>FindNameInLookupTable

Func IDToValue($pObj, $id)
;~  MsgBox(0,"",$id)
    $vtable_entry = DllStructCreate("ptr", DereferencePointer($pObj) + 4 * 7)
    $header = DllStructCreate("int", DllStructGetData($vtable_entry, 1))
    $lookup_table_size = DllStructGetData($header, 1)


    If $id < 0 Or $id > $lookup_table_size Then Return ""

    $current_entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($vtable_entry, 1) + 4) + $LOOKUP_TABLE_ENTRY_SIZE * $id)

    $member_name = ChrPtrToString(DllStructGetData($current_entry, "name"))
    If StringLeft($member_name, 1) = "@" Then

        Return ChrPtrToString(DllStructGetData($current_entry, "value"))
    Else
        Return DllStructGetData($current_entry, "value")
    EndIf
EndFunc ;==>IDToValue




Func VTType2AutoitType($vt_type)
    ConsoleWrite("! " & $vt_type & @CRLF)
    Switch $vt_type
        Case $VT_I1
            Return "byte"
        Case $VT_I2
            Return "short"
        Case $VT_I4
            Return "int"
        Case $VT_BSTR
            Return "wstr"
        Case $VT_R8
            Return "double"
        Case $VT_DISPATCH
            Return "idispatch"
    EndSwitch
EndFunc ;==>VTType2AutoitType

Func AutoitType2VTType($autoit_type)
    Switch $autoit_type
        Case "byte"
            Return $VT_I1
        Case "short"
            Return $VT_I2
        Case "int"
            Return $VT_I4
        Case "wstr"
            Return $VT_BSTR
        Case "double"
            Return $VT_R8
        Case "ptr"
            Return $VT_PTR
        Case "idispatch"
            Return $VT_DISPATCH
    EndSwitch

EndFunc ;==>AutoitType2VTType


; Find out length of string. I do not trust autoit to do this.
Func wcslen($pwchar)
    $aCall = DllCall("ntdll.dll", "dword:cdecl", "wcslen", "ptr", $pwchar)
    Return $aCall[0]
EndFunc ;==>wcslen

; Find out length of string. I do not trust autoit to do this.
Func strlen($pchar)
    $aCall = DllCall("ntdll.dll", "dword:cdecl", "strlen", "ptr", $pchar)
    Return $aCall[0]
EndFunc ;==>strlen

Func SysAllocString($str)
    $aCall = DllCall("oleaut32.dll", "ptr", "SysAllocString", "wstr", $str)
    Return $aCall[0]
EndFunc ;==>SysAllocString



Func COMVariantToValue($pVariant)
    Local $var = DllStructCreate($tagVARIANT, $pVariant)
    ; Translate the vt id to a autoit dllcall type
    $type = VTType2AutoitType(DllStructGetData($var, "vt"))


    If $type = "wstr" Then
        $str_ptr = DllStructCreate("ptr", DllStructGetPtr($var, "data"))
        ; Getting random crashes when trusting autoit to automatically use right size.
        ; doing it myself instead (also, it should be a BSTR, but it's not. Is autoit not obeying the rules!?
        $str_size = wcslen(DllStructGetData($str_ptr, 1))
        $tSub = DllStructCreate("dword", DllStructGetData($str_ptr, 1) - 4) ; <- move pointer back 4 bytes!

        $data = DllStructCreate("wchar[" & DllStructGetData($tSub, 1) + 1 & "]", DllStructGetData($str_ptr, 1))

    ElseIf $type = "idispatch" Then
;~      MsgBox(0,"","fitttan")
        Return ConvertPtrToIDispatch(DllStructGetData(DllStructCreate("ptr", DllStructGetPtr($var, "data")), 1))

    Else
        $data = DllStructCreate($type, DllStructGetPtr($var, "data"))
    EndIf


    Return DllStructGetData($data, 1)
EndFunc ;==>COMVariantToValue

Func ValueToCOMVariant($pVariant, $vValue)
    $var = DllStructCreate($tagVARIANT, $pVariant)

    If IsInt($vValue) Then
        $vt_type = AutoitType2VTType("int")
        $var_data = $vValue
    ElseIf IsString($vValue) Then
        $vt_type = AutoitType2VTType("wstr")
        $var_data = SysAllocString($vValue)
    ElseIf IsObj($vValue) Then
        $vt_type = AutoitType2VTType("idispatch")
        $var_data = ConvertIDispatchToPtr($vValue)

    EndIf
    DllStructSetData($var, "vt", $vt_type)
    DllStructSetData(DllStructCreate("int", DllStructGetPtr($var, "data")), 1, $var_data)

EndFunc ;==>ValueToCOMVariant






; Everytime autoit wants to call a method, get or set a property in a object it needs to go to
; IDispatch::GetIDsFromNames. This is our version of that function, note that by defining this ourselves
; we can fool autoit to believe that the object supports a lot of different properties/methods.
Func IDispatch_GetIDsFromNames($self, $refiid, $str_array, $array_size, $context, $out_array)
    ; It's self explainable that autoit only asks for one member
    $str = DllStructCreate("wchar[256]", DereferencePointer($str_array))
    ConsoleWrite("AutoIt wants to look up: " & DllStructGetData($str, 1) & " (in object: " & $self & ")" & @CRLF)

    ; Autoit gave us an array with one element ready to accept the id of the member it requested.
    $ids = DllStructCreate("long", $out_array)

;~  ConsoleWrite("ZERO"&@CRLF)
    $id = FindNameInLookupTable($self, "@" & DllStructGetData($str, 1))
    ConsoleWrite("ONE" & @CRLF)
    If $id = -1 Then $id = FindNameInLookupTable($self, DllStructGetData($str, 1))
    ConsoleWrite("TWO" & @CRLF)
    If $id <> -1 Then
        DllStructSetData($ids, 1, $id)
        Return $S_OK
    Else
        DllStructSetData($ids, 1, $DISPID_UNKNOWN)
        Return $DISP_E_UNKNOWNNAME
    EndIf



EndFunc ;==>IDispatch_GetIDsFromNames
; Create the callback so we have a pointer to this function.
$IDispatch_GetIDsFromNames_Callback = DllCallbackRegister("IDispatch_GetIDsFromNames", "long", "ptr;ptr;ptr;int;int;ptr")
$IDispatch_GetIDsFromNames_Callback_Ptr = DllCallbackGetPtr($IDispatch_GetIDsFromNames_Callback)


; This is called when a method is called, a property is set or get.
; This call also contains arguments returns and a lot other stuff.
; However in this trivial example we don't return anything and we don't take any arguments. Puh, could get messy
Func IDispatch_Invoke($self, $dispID, $riid, $lcid, $wFlags, $pDispParams, $pVarResult, $pExceptInfo, $puArgErr)
    ;; Dump all parameters to console.
    ConsoleWrite("DispID: " & $dispID & @CRLF & "RIID: " & $riid & @CRLF & "LCID: " & $lcid & @CRLF & "wFlags: " & $wFlags & @CRLF & _
            "pDispParams: " & $pDispParams & @CRLF & "pVarResult: " & $pVarResult & @CRLF & "pExceptInfo: " & $pExceptInfo & @CRLF & "puArgError: " & $puArgErr & @CRLF)


    $memberval = IDToValue($self, $dispID)

    If $memberval = "" Then Return $DISP_E_MEMBERNOTFOUND
    $dispparams = DllStructCreate($tagDISPPARAMS, $pDispParams)
    If $wFlags = BitOR($DISPATCH_METHOD, $DISPATCH_PROPERTYGET) Then
        If IsString($memberval) Then



            $self_obj = ConvertPtrToIDispatch($self)
            $callstring = $memberval & "($self_obj"

            If $pDispParams <> 0 And DllStructGetData($dispparams, "cArgs") > 0 Then
                Local $params[DllStructGetData($dispparams, "cArgs")]
                ; Fetch all arguments
                For $i = 0 To UBound($params) - 1
                    ; Save the values backwards (that's how autoit do it)
                    $params[(UBound($params) - 1) - $i] = COMVariantToValue(DllStructGetData($dispparams, "rgvargs") + ($i * 16)) ; i*sizeof(VARIANT)
                    $callstring &= ",$params[" & $i & "]"
                Next
            EndIf
            $callstring &= ")"
            ConsoleWrite("Calling function: " & $callstring & @CRLF)
            $ret = Execute($callstring)
            ; Set return value.
            ValueToCOMVariant($pVarResult, $ret)
            ; Give autoit the message that everything went according to plan
            Return $S_OK
        Else
            $tempval = COMVariantToValue($memberval)
            If IsObj($tempval) Then IUnknown_AddRef(ConvertIDispatchToPtr($tempval))
            ValueToCOMVariant($pVarResult, $tempval)
            Return $S_OK
        EndIf

    ElseIf $wFlags = $DISPATCH_PROPERTYPUT Or $wFlags = $DISPATCH_PROPERTYPUTREF Then

        $oldval = COMVariantToValue($memberval)
        If IsObj($oldval) Then
            IUnknown_Release(ConvertIDispatchToPtr($oldval))
        EndIf



;~      MsgBox(0,"",DereferencePointer(DllStructGetData($dispparams,"rgvargs"),"short"))
        $tempval = COMVariantToValue(DllStructGetData($dispparams, "rgvargs"))
        If IsObj($tempval) Then ; If saving a object in a property we need to increase its ref count
            IUnknown_AddRef(ConvertIDispatchToPtr($tempval))
        EndIf

        ValueToCOMVariant($memberval, $tempval)
        Return $S_OK
    EndIf




EndFunc ;==>IDispatch_Invoke
; Create callback
$IDispatch_Invoke_Callback = DllCallbackRegister("IDispatch_Invoke", "long", "ptr;dword;ptr;dword;ushort;ptr;ptr;ptr;ptr")
$IDispatch_Invoke_Callback_Ptr = DllCallbackGetPtr($IDispatch_Invoke_Callback)





Func IUnknown_AddRef($pObj)
    $addref_ptr = DereferencePointer(DereferencePointer($pObj) + 4)
    $code = DllStructCreate("byte[13]")
    DllStructSetData($code, 1, "0x68" & SwapEndian($pObj) & "B8" & SwapEndian($addref_ptr) & "FFD0" & "C3")
    $aCall = DllCall("user32.dll", "dword", "CallWindowProc", "ptr", DllStructGetPtr($code), "int", 0, "int", 0, "int", 0, "int", 0)
    Return $aCall[0]
EndFunc ;==>IUnknown_AddRef

Func IUnknown_Release($pObj)
    $addref_ptr = DereferencePointer(DereferencePointer($pObj) + 8)
    $code = DllStructCreate("byte[13]")
    DllStructSetData($code, 1, "0x68" & SwapEndian($pObj) & "B8" & SwapEndian($addref_ptr) & "FFD0" & "C3")
    $aCall = DllCall("user32.dll", "dword", "CallWindowProc", "ptr", DllStructGetPtr($code), "int", 0, "int", 0, "int", 0, "int", 0)
    Return $aCall[0]
EndFunc ;==>IUnknown_Release

Func ObjGetRefCount($obj)
    If IsObj($obj) Then $obj = ConvertIDispatchToPtr($obj)
    IUnknown_AddRef($obj)
    Return IUnknown_Release($obj)
EndFunc


Func SwapEndian($hex)
    Return Hex(Binary($hex))
EndFunc ;==>SwapEndian




Func CreateObject($aMembers, $BaseClass = "")
    ; Create a victim. Could be any COM object that inherits from IDispatch
    $retobj = 0
    If Not IsObj($BaseClass) Then

        $retobj = ObjCreate("ScriptControl")
        $obj_ptr = ConvertIDispatchToPtr($retobj)
        ; Hook into the object
        ; Offset 20 & 24 is fifth entry in vtable. Look at IDispatch and IUnknown interfaces to see why
        ReplaceVTableEntry($obj_ptr, 20, $IDispatch_GetIDsFromNames_Callback_Ptr)
        ReplaceVTableEntry($obj_ptr, 24, $IDispatch_Invoke_Callback_Ptr)
;~  ReplaceVTableEntry($obj_ptr,8,$IUnknown_Release_Callback_Ptr)

        ; Create space for a new bigger vtable
        $p = DynAlloc(4 * 7 + 4) ; sizeof(ptr)*(num entirs in dispatch)+sizeof(ptr)
        RelocateVTable($obj_ptr, $p, 4 * 7)
    Else
        $obj_ptr = ConvertIDispatchToPtr($BaseClass)
        $retobj=$BaseClass
    EndIf


    AddMembersToLookupTable($obj_ptr, $aMembers)


    Return $retobj
EndFunc ;==>CreateObject






$l = LinkedList()
$l.add(10)
$l.add(11)
$l.add(12)
$l.add(13)
$l.display()

Func Element($init_value="")
    Local $members[2][2]=[["data",$init_value],["next",""]]
    Return CreateObject($members)
EndFunc

Func LinkedList()
    Local $members[6][2]=[["@add","LinkedList_add"],["@at","LinkedList_at"], _
    ["@remove","LinkedList_remove"],["size",0],["@display","LinkedList_display"],["first",""]]
    Return CreateObject($members)
EndFunc


Func LinkedList_add($self,$data)
    If $self.first="" Then
        $self.first = Element($data)
        $self.size = $self.size + 1
        Return
    EndIf
    $current_element = $self.first
    while $current_element.next<>""
        $current_element = $current_element.next
    WEnd

    $current_element.next = Element($data)
    $self.size = $self.size + 1
EndFunc

Func LinkedList_at($self,$index)
    If $self.first="" Then Return ""
    $current_element = $self.first
    For $i=0 To $index-1
        If $current_element.next="" Then Return ""
        $current_element = $current_element.next
    Next
    Return $current_element.data

EndFunc

Func LinkedList_remove($self,$index)
    If $self.first="" Then Return -1
    $current_element = $self.first
    for $i=0 To $index-2
        If $current_element.next="" Then Return ""
        $current_element = $current_element.next
    Next


    $current_element.next = $current_element.next.next
    $self.size = $self.size - 1

EndFunc


Func LinkedList_display($self)
    Local $arr[$self.size]
    For $i=0 To UBound($arr)-1
        $arr[$i] = $self.at($i)
    Next
    _ArrayDisplay($arr,"LinkedList Display")


EndFunc

As soon as arrays are fixed and the memory leaks are fixed we have a complete working OO library, what about that

dantay9 · January 7, 2010

Wow! This is great. One more major downfall of AutoIt tackled. Can't wait for the production version with all the kinks worked out.

spudw2k · January 7, 2010

This is awesome...and I admit, over my head. Is there any explanation as to why it works better when compiled? I suppose it doesn't really matter, just a mystery to me. Amazing stuff monoceres.

monoceres · January 7, 2010

This is awesome...and I admit, over my head. Is there any explanation as to why it works better when compiled? I suppose it doesn't really matter, just a mystery to me. Amazing stuff monoceres.

Huh? It does? How? Faster or what?

spudw2k · January 7, 2010

Sorry, better meaning no errors. When I run your first two examples, they both generate "Cannot Read' errors....unless it's compiled, or I threw in a msgbox() debug statement. The last example (list) works great compiled or not.

dantay9 · January 7, 2010

I too have had a better experience with compiled scripts, especially with the script from post #26. When I run it from SciTE in script form, the dog says woof, but the script exits out right after "Calling function: Animal_Die($self_obj)" appears in the output. When I compile it, everything works fine. No errors or anything. The list is the only one that works fine in script form.

Edited January 7, 2010 by dantay9

monoceres · January 7, 2010

It's a shame that $this can't just refer to the function/scope itself, instead of having to declare it

It could be done, but I chose not to deliberately, shipping it as a parameter, is more flexible, logical and imo makes more sense. Even the name I used ($self) is borrowed from Python that employ the exact same syntax.

As for only the last example working in script mode, it's not surprising as I have fixed many bugs between the scripts I post here. The last one isn't perfect as well and I have changed my local copy to fix some bugs.

I'll aim to fix all the memory leaks for the next version. Arrays, 64 bit support and maybe, maybe access modes for members (public, protected and private), but I'm not sure about syntax (I can't fix of anything that wouldn't make it look bad) and how many people would actually use it will be implemented after that.

Stay tuned, and don't hesitate to ask questions and come with ideas.

Edited January 7, 2010 by monoceres

monoceres · January 9, 2010

Exciting news!

Objects now keep reference count, clean up after themselves and allow you to implement deconstructors. And I also cleaned up all the random names I had used.

Oh, and the library no longer requires a victim. Puh, the DA was all over my ass after the repeated molestation of the ScriptHost interface.

Please report crashes, because they should not happen as of now.

New code with a file object example (introduces the concept of deconstructor (and shows how the constructor should be used)).

#include <Array.au3>

Global $hOle32 = 0

Global Const $VT_EMPTY = 0
Global Const $VT_NULL = 1
Global Const $VT_I2 = 2
Global Const $VT_I4 = 3
Global Const $VT_R4 = 4
Global Const $VT_R8 = 5
Global Const $VT_CY = 6
Global Const $VT_DATE = 7
Global Const $VT_BSTR = 8
Global Const $VT_DISPATCH = 9
Global Const $VT_ERROR = 10
Global Const $VT_BOOL = 11
Global Const $VT_VARIANT = 12
Global Const $VT_UNKNOWN = 13
Global Const $VT_DECIMAL = 14
Global Const $VT_I1 = 16
Global Const $VT_UI1 = 17
Global Const $VT_UI2 = 18
Global Const $VT_UI4 = 19
Global Const $VT_I8 = 20
Global Const $VT_UI8 = 21
Global Const $VT_INT = 22
Global Const $VT_UINT = 23
Global Const $VT_VOID = 24
Global Const $VT_HRESULT = 25
Global Const $VT_PTR = 26
Global Const $VT_SAFEARRAY = 27
Global Const $VT_CARRAY = 28
Global Const $VT_USERDEFINED = 29
Global Const $VT_LPSTR = 30
Global Const $VT_LPWSTR = 31
Global Const $VT_RECORD = 36
Global Const $VT_INT_PTR = 37
Global Const $VT_UINT_PTR = 38
Global Const $VT_FILETIME = 64
Global Const $VT_BLOB = 65
Global Const $VT_STREAM = 66
Global Const $VT_STORAGE = 67
Global Const $VT_STREAMED_OBJECT = 68
Global Const $VT_STORED_OBJECT = 69
Global Const $VT_BLOB_OBJECT = 70
Global Const $VT_CF = 71
Global Const $VT_CLSID = 72
Global Const $VT_VERSIONED_STREAM = 73
Global Const $VT_BSTR_BLOB = 0xfff
Global Const $VT_VECTOR = 0x1000
Global Const $VT_ARRAY = 0x2000
Global Const $VT_BYREF = 0x4000
Global Const $VT_RESERVED = 0x8000
Global Const $VT_ILLEGAL = 0xffff
Global Const $VT_ILLEGALMASKED = 0xfff
Global Const $VT_TYPEMASK = 0xfff

Global Const $tagGUID = "ulong;ushort;ushort;byte[8]"
Global Const $tagCLSID = $tagGUID
Global Const $tagUUID = $tagGUID
Global Const $CLSCTX_INPROC_SERVER = 0x1
Global Const $S_OK = 0
Global Const $DISP_E_UNKNOWNNAME = 2147614726
Global Const $DISPID_UNKNOWN = 4294967295
Global Const $DISP_E_MEMBERNOTFOUND = 2147614723
Global Const $tagVARIANT = "ushort vt;ushort r1;ushort r2;ushort r3;uint64 data"
Global Const $tagDISPPARAMS = "ptr rgvargs;ptr rgdispidNamedArgs;dword cArgs;dword cNamedArgs;"


Global Const $DISPATCH_METHOD = 0x1
Global Const $DISPATCH_PROPERTYGET = 0x2
Global Const $DISPATCH_PROPERTYPUT = 0x4
Global Const $DISPATCH_PROPERTYPUTREF = 0x8

Global Const $tagLOOKUP_TABLE_ENTRY = "ptr name;ptr value;dword flags;"
Global Const $LOOKUP_TABLE_ENTRY_SIZE = DllStructGetSize(DllStructCreate($tagLOOKUP_TABLE_ENTRY))
Global Const $LOOKUP_TABLE_METHOD = 1
Global Const $LOOKUP_TABLE_PROPERTY = 2
Global Const $LOOKUP_TABLE_PUBLIC = 0
Global Const $LOOKUP_TABLE_PRIVATE = 4

Global Const $tagOBJECT_INFO = "dword refcount;ptr release;"

Global Const $hOLEOUT = DllOpen("oleaut32.dll")



Func SizeOfPtr()
    Return DllStructGetSize(DllStructCreate("ptr"))
EndFunc ;==>SizeOfPtr





; In the end we still want the autoit object. This function converts a raw pointer to an autoit object
Func ConvertPtrToIDispatch($pIDispatch)
    ; This would have been 10000x easier if autoit had supported the idispatch* type in dllstructs...
    ; Fortunetely memcpy can copy the pointer into a idispatch*, lucky us.
    Local $aCall = DllCall("kernel32.dll", "none", "RtlMoveMemory", _
            "idispatch*", 0, _
            "ptr*", $pIDispatch, _
            "dword", 4)

    If @error Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[1]

EndFunc ;==>ConvertPtrToIDispatch

Func ConvertIDispatchToPtr($oIDispatch)

    Local $aCall = DllCall("kernel32.dll", "none", "RtlMoveMemory", _
            "ptr*", 0, _
            "idispatch*", $oIDispatch, _
            "dword", SizeOfPtr())

    If @error Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[1]

EndFunc ;==>ConvertIDispatchToPtr

; Sets the MEM_EXECUTE_READWRITE flag on the specified memory. Use with care, I use because I'm lazy.
Func UnprotectMemory($pMem, $iSize)
    DllCall("Kernel32.dll", "int", "VirtualProtect", "ptr", $pMem, "long", $iSize, "dword", 0x40, "dword*", 0)
EndFunc ;==>UnprotectMemory

; Returns the pointer the passed pointer points to ;)
Func DereferencePointer($pPointer, $sType = "ptr")
    $hStruct = DllStructCreate($sType, $pPointer)
    Return DllStructGetData($hStruct, 1)
EndFunc ;==>DereferencePointer


; Moves the vtable to a new position. useful if you want to add more entries.
Func RelocateVTable($pObj, $pNew, $iVTable_Size)
    $hVTable = DllStructCreate("ptr", $pObj)
    DllCall("kernel32.dll", "none", "RtlMoveMemory", "ptr", $pNew, "ptr", DllStructGetData($hVTable, 1), "dword", $iVTable_Size)
    DllStructSetData($hVTable, 1, $pNew)
EndFunc ;==>RelocateVTable

; Allocate memory on the heap
Func DynAlloc($dwSize)
    $hHeap = DllCall("Kernel32.dll", "ptr", "GetProcessHeap")
    $hHeap = $hHeap[0]
    $hMem = DllCall("Kernel32.dll", "ptr", "HeapAlloc", "ptr", $hHeap, "dword", 0x8, "dword", $dwSize)
    DllCall("Kernel32.dll", "none", "CloseHandle", "ptr", $hHeap)
    Return $hMem[0]
EndFunc ;==>DynAlloc

; Fantastic function. Does not ask how many bytes that needs to be freed
Func DynFree($hMem)
    $hHeap = DllCall("Kernel32.dll", "ptr", "GetProcessHeap")
    $hHeap = $hHeap[0]
    $hMem = DllCall("Kernel32.dll", "int", "HeapFree", "ptr", $hHeap, "dword", 0, "ptr", $hMem)
    DllCall("Kernel32.dll", "none", "CloseHandle", "ptr", $hHeap)
    Return $hMem[0]
EndFunc ;==>DynFree




; Takes a pointer to the v-table in a class and replaces specified pointer in it to a new one.
Func ReplaceVTableEntry($pVTable, $iOffset, $pNew)
    ; Dereference the pointer


    $pEntry = DereferencePointer($pVTable) + $iOffset
    ; Make the memory free for all. Yay!
    UnprotectMemory($pEntry, SizeOfPtr())
    $hEntry = DllStructCreate("ptr", $pEntry)
    $pOld = DllStructGetData($hEntry, 1)
    DllStructSetData($hEntry, 1, $pNew)
    Return $pOld
EndFunc ;==>ReplaceVTableEntry



Func CreateDynamicString($sString)
    $pDynamic = DynAlloc(StringLen($sString) + 1)
    DllStructSetData(DllStructCreate("char[" & StringLen($sString) + 1 & "]", $pDynamic), 1, $sString)
    Return $pDynamic
EndFunc ;==>CreateDynamicString



Func AddMembersToLookupTable($pObj, $aNames)

    ; Set point in vtable
    $hVTable_Entry = DllStructCreate("ptr", DereferencePointer($pObj) + 4 * 7)


    If DllStructGetData($hVTable_Entry, 1) <> 0 Then

        $hHeader = DllStructCreate("int", DllStructGetData($hVTable_Entry, 1))

        Local $aTemp[UBound($aNames) + DllStructGetData($hHeader, 1)][2]
        For $i = 0 To DllStructGetData($hHeader, 1) - 1
            $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($hVTable_Entry, 1) + SizeOfPtr()) + $LOOKUP_TABLE_ENTRY_SIZE * $i)
            $aTemp[$i][0] = ChrPtrToString(DllStructGetData($hCurrent_Entry, "name"))
            If StringLeft($aTemp[$i][0], 1) = "@" Or StringLeft($aTemp[$i][0], 1) = "~" Then
                $aTemp[$i][1] = ChrPtrToString(DllStructGetData($hCurrent_Entry, "value"))
            Else
                $aTemp[$i][1] = COMVariantToValue(DllStructGetData($hCurrent_Entry, "value"))
            EndIf

        Next
        For $i = 0 To UBound($aNames) - 1
            For $j = 0 To UBound($aTemp) - 1
                If $aTemp[$j][0] = $aNames[$i][0] Then
                    $aTemp[$j][0] = $aNames[$i][0]
                    $aTemp[$j][1] = $aNames[$i][1]
                    ExitLoop
                ElseIf $aTemp[$j][0] = "" Then
                    $aTemp[$j][0] = $aNames[$i][0]
                    $aTemp[$j][1] = $aNames[$i][1]
                    ExitLoop
                EndIf
            Next
        Next

        For $i = UBound($aTemp) - 1 To 0 Step -1
            If $aTemp[$i][0] <> "" Then ExitLoop
            _ArrayDelete($aTemp, $i)
        Next


        $aNames = $aTemp


        DynFree(DllStructGetData($hVTable_Entry, 1))

    EndIf

    ; Create dynamic memory for new lookup table
    $pMem = DynAlloc(SizeOfPtr() + (UBound($aNames) * $LOOKUP_TABLE_ENTRY_SIZE))
    ; Create lookup table, first element is number of element
    ; Must be sorted!
    $hLookupTable = DllStructCreate("int;byte[" & $LOOKUP_TABLE_ENTRY_SIZE & "]", $pMem)
    ; Set size of lookup table
    DllStructSetData($hLookupTable, 1, UBound($aNames))
    ; Modify vtable to point to the lookup table
;~  MsgBox(0,"", $mem)
    DllStructSetData($hVTable_Entry, 1, $pMem)


    For $i = 0 To UBound($aNames) - 1
        $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, DllStructGetPtr($hLookupTable, 2) + $LOOKUP_TABLE_ENTRY_SIZE * $i)

        If StringLeft($aNames[$i][0], 1) = "@" Or StringLeft($aNames[$i][0], 1)="~" Then ; This is a method
            DllStructSetData($hCurrent_Entry, "name", CreateDynamicString($aNames[$i][0]))
            DllStructSetData($hCurrent_Entry, "value", CreateDynamicString($aNames[$i][1]))
        Else ; It's a property then.
            $pVariant = DynAlloc(16)
            ValueToCOMVariant($pVariant, $aNames[$i][1])
            DllStructSetData($hCurrent_Entry, "name", CreateDynamicString($aNames[$i][0]))
            DllStructSetData($hCurrent_Entry, "value", $pVariant)
        EndIf

    Next
EndFunc ;==>AddMembersToLookupTable

Func ChrPtrToString($pString)
    $iLength = strlen($pString)
    $hString = DllStructCreate("char[" & $iLength + 1 & "]", $pString)
    Return DllStructGetData($hString, 1)
EndFunc ;==>ChrPtrToString


Func FindNameInLookupTable($pObj, $sName)
    $hVTable_Entry = DllStructCreate("ptr", DereferencePointer($pObj) + SizeOfPtr() * 7) ; sizeof(ptr)*(num entries in idispatch)
    $hHeader = DllStructCreate("int", DllStructGetData($hVTable_Entry, 1))
    $iLookupTable_Size = DllStructGetData($hHeader, 1)
    For $i = 0 To $iLookupTable_Size - 1
        $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($hVTable_Entry, 1) + SizeOfPtr()) + $LOOKUP_TABLE_ENTRY_SIZE * $i)
        If $sName = ChrPtrToString(DllStructGetData($hCurrent_Entry, "name")) Then Return $i
    Next
    Return -1
EndFunc ;==>FindNameInLookupTable

Func IDToValue($pObj, $iId,$sField="value")
;~  MsgBox(0,"",$id)
    $hVTable_Entry = DllStructCreate("ptr", DereferencePointer($pObj) + SizeOfPtr() * 7)
    $hHeader = DllStructCreate("int", DllStructGetData($hVTable_Entry, 1))
    $iLookupTable_Size = DllStructGetData($hHeader, 1)


    If $iId < 0 Or $iId >= $iLookupTable_Size Then Return ""

    $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($hVTable_Entry, 1) + SizeOfPtr()) + $LOOKUP_TABLE_ENTRY_SIZE * $iId)

    $sMember_Name = ChrPtrToString(DllStructGetData($hCurrent_Entry, "name"))
    If StringLeft($sMember_Name, 1) = "@" Or StringLeft($sMember_Name, 1)="~" Then
        Return ChrPtrToString(DllStructGetData($hCurrent_Entry, $sField))
    Else
        Return DllStructGetData($hCurrent_Entry, $sField)
    EndIf
EndFunc ;==>IDToValue

Func ForceExit($iExitCode=0)
    DllCall("Kernel32.dll", "none", "ExitProcess", "dword", $iExitCode)
EndFunc



Func VTType2AutoitType($iVT_Type)
    ConsoleWrite("! " & $iVT_Type & @CRLF)
    Switch $iVT_Type
        Case $VT_I1
            Return "byte"
        Case $VT_I2
            Return "short"
        Case $VT_I4
            Return "int"
        Case $VT_BSTR
            Return "wstr"
        Case $VT_R8
            Return "double"
        Case $VT_DISPATCH
            Return "idispatch"
    EndSwitch
EndFunc ;==>VTType2AutoitType

Func AutoitType2VTType($sAutoit_Type)
    Switch $sAutoit_Type
        Case "byte"
            Return $VT_I1
        Case "short"
            Return $VT_I2
        Case "int"
            Return $VT_I4
        Case "wstr"
            Return $VT_BSTR
        Case "double"
            Return $VT_R8
        Case "ptr"
            Return $VT_PTR
        Case "idispatch"
            Return $VT_DISPATCH
    EndSwitch
EndFunc ;==>AutoitType2VTType


; Find out length of string. I do not trust autoit to do this.
Func wcslen($pWString)
    $aCall = DllCall("ntdll.dll", "dword:cdecl", "wcslen", "ptr", $pWString)
    Return $aCall[0]
EndFunc ;==>wcslen

; Find out length of string. I do not trust autoit to do this.
Func strlen($pString)
    $aCall = DllCall("ntdll.dll", "dword:cdecl", "strlen", "ptr", $pString)
    Return $aCall[0]
EndFunc ;==>strlen

Func SysAllocString($sString)
    $aCall = DllCall("oleaut32.dll", "ptr", "SysAllocString", "wstr", $sString)
    Return $aCall[0]
EndFunc ;==>SysAllocString

Func SysFreeString($pBStr)
    $aCall = DllCall("oleaut32.dll", "dword", "SysAllocString", "ptr", $pBStr)
    Return $aCall[0]
EndFunc ;==>SysFreeString




Func COMVariantToValue($pVariant)
    Local $hVariant = DllStructCreate($tagVARIANT, $pVariant)
    ; Translate the vt id to a autoit dllcall type
    $sType = VTType2AutoitType(DllStructGetData($hVariant, "vt"))


    If $sType = "wstr" Then
        $pString = DllStructCreate("ptr", DllStructGetPtr($hVariant, "data"))
        ; Getting random crashes when trusting autoit to automatically use right size.
        ; doing it myself instead (also, it should be a BSTR, but it's not. Is autoit not obeying the rules!?
        $iString_Size = wcslen(DllStructGetData($pString, 1))

        ; Sorry trancexx, doesn't seem to work on large strings (crashes like crazy when trying to use on 1 MB string)
        ;$tSub = DllStructCreate("dword", DllStructGetData($str_ptr, 1) - 4) ; <- move pointer back 4 bytes!

        $hData = DllStructCreate("wchar[" & $iString_Size & "]", DllStructGetData($pString, 1))

    ElseIf $sType = "idispatch" Then

        Return ConvertPtrToIDispatch(DllStructGetData(DllStructCreate("ptr", DllStructGetPtr($hVariant, "data")), 1))

    Else
        $hData = DllStructCreate($sType, DllStructGetPtr($hVariant, "data"))
    EndIf

    Return DllStructGetData($hData, 1)
EndFunc ;==>COMVariantToValue

; Starts COM
Func CoInitialize()
    $hOle32 = DllOpen("Ole32.dll")
    Local $aCall = DllCall($hOle32, "long", "CoInitializeEx", "ptr", 0, "dword", 2) ; COINIT_APARTMENTTHREADED
EndFunc ;==>CoInitialize



Func ValueToCOMVariant($pVariant, $vValue)
    $hVariant = DllStructCreate($tagVARIANT, $pVariant)

    If IsInt($vValue) Then
        $iVT_Type = AutoitType2VTType("int")
        $vData = $vValue
    ElseIf IsString($vValue) Then
        $iVT_Type = AutoitType2VTType("wstr")
        $vData = SysAllocString($vValue)
    ElseIf IsObj($vValue) Then
        $iVT_Type = AutoitType2VTType("idispatch")
        $vData = ConvertIDispatchToPtr($vValue)

    EndIf
    DllStructSetData($hVariant, "vt", $iVT_Type)
    DllStructSetData(DllStructCreate("int", DllStructGetPtr($hVariant, "data")), 1, $vData)

EndFunc ;==>ValueToCOMVariant






; Everytime autoit wants to call a method, get or set a property in a object it needs to go to
; IDispatch::GetIDsFromNames. This is our version of that function, note that by defining this ourselves
; we can fool autoit to believe that the object supports a lot of different properties/methods.
Func IDispatch_GetIDsFromNames($pSelf, $pRefIID, $pString_Array, $iArray_Size, $iContext, $pOut_Array)
    ; It's self explainable that autoit only asks for one member
    $hMemberName = DllStructCreate("wchar[256]", DereferencePointer($pString_Array))
    $sMemberName = DllStructGetData($hMemberName, 1)
    ConsoleWrite("AutoIt wants to look up: " & DllStructGetData($hMemberName, 1) & " (in object: " & $pSelf & ")" & @CRLF)

    ; Autoit gave us an array with one element ready to accept the id of the member it requested.
    $hID = DllStructCreate("long", $pOut_Array)


    $iId = FindNameInLookupTable($pSelf, "@" & $sMemberName)
    If $iId = -1 Then $iId = FindNameInLookupTable($pSelf, $sMemberName)
    If $iId <> -1 Then
        DllStructSetData($hID, 1, $iId)
        Return $S_OK
    Else
        MsgBox(16, "Error", "Object have no member named: " & $sMemberName)
        DllStructSetData($hID, 1, $DISPID_UNKNOWN)
        Return $DISP_E_UNKNOWNNAME
    EndIf



EndFunc ;==>IDispatch_GetIDsFromNames
; Create the callback so we have a pointer to this function.
$IDispatch_GetIDsFromNames_Callback = DllCallbackRegister("IDispatch_GetIDsFromNames", "long", "ptr;ptr;ptr;int;int;ptr")
$IDispatch_GetIDsFromNames_Callback_Ptr = DllCallbackGetPtr($IDispatch_GetIDsFromNames_Callback)


; This is called when a method is called, a property is set or get.
; This call also contains arguments returns and a lot other stuff.
; However in this trivial example we don't return anything and we don't take any arguments. Puh, could get messy
Func IDispatch_Invoke($pSelf, $iDispID, $pRefIID, $iLCID, $wFlags, $pDispParams, $pVarResult, $pExceptInfo, $puArgErr)
    ;; Dump all parameters to console.
    ConsoleWrite("DispID: " & $iDispID & @CRLF & "RIID: " & $pRefIID & @CRLF & "LCID: " & $iLCID & @CRLF & "wFlags: " & $wFlags & @CRLF & _
            "pDispParams: " & $pDispParams & @CRLF & "pVarResult: " & $pVarResult & @CRLF & "pExceptInfo: " & $pExceptInfo & @CRLF & "puArgError: " & $puArgErr & @CRLF)


    $vMemberValue = IDToValue($pSelf, $iDispID)

    If $vMemberValue = "" Then Return $DISP_E_MEMBERNOTFOUND ; Should NEVER happen. But, you never know!


    $hDispParams = DllStructCreate($tagDISPPARAMS, $pDispParams)

    ; AutoIt is pretty sneaky methinks, oring these together..
    If $wFlags = BitOR($DISPATCH_METHOD, $DISPATCH_PROPERTYGET) Then

        ; Methods returns strings
        If IsString($vMemberValue) Then


            $oSelf = ConvertPtrToIDispatch($pSelf)
            $sCall = $vMemberValue & "($oSelf"

            If $pDispParams <> 0 And DllStructGetData($hDispParams, "cArgs") > 0 Then
                Local $aParams[DllStructGetData($hDispParams, "cArgs")]
                ; Fetch all arguments
                For $i = 0 To UBound($aParams) - 1
                    ; Save the values backwards (that's how autoit do it)
                    $aParams[(UBound($aParams) - 1) - $i] = COMVariantToValue(DllStructGetData($hDispParams, "rgvargs") + ($i * 16)) ; i*sizeof(VARIANT)
                    $sCall &= ",$aParams[" & $i & "]"
                Next
            EndIf
            $sCall &= ")"
            ConsoleWrite("Calling function: " & $sCall & @CRLF)
            $vReturn = Execute($sCall)
            ; Set return value.
            ValueToCOMVariant($pVarResult, $vReturn)
            ; Give autoit the message that everything went according to plan
            Return $S_OK
        Else ; PROPERTYGET
            $vValue = COMVariantToValue($vMemberValue)
            ; I have no idea why this is needed. Shouldn't AutoIt increase the ref count when it is getting my object!?
            If IsObj($vValue) Then
                IUnknown_AddRef(ConvertIDispatchToPtr($vValue))
            EndIf

            ValueToCOMVariant($pVarResult, $vValue)
            Return $S_OK
        EndIf

    ElseIf $wFlags = $DISPATCH_PROPERTYPUT Or $wFlags = $DISPATCH_PROPERTYPUTREF Then

        DeleteCOMVariant($vMemberValue,False)
;~      $vOld_Value = COMVariantToValue($vMemberValue)
;~      If IsObj($vOld_Value) Then IUnknown_Release(ConvertIDispatchToPtr($vOld_Value))


        $vNewValue = COMVariantToValue(DllStructGetData($hDispParams, "rgvargs"))
        If IsObj($vNewValue) Then ; If saving a object in a property we need to increase its ref count
            IUnknown_AddRef(ConvertIDispatchToPtr($vNewValue))
        EndIf

        ValueToCOMVariant($vMemberValue, $vNewValue)
        Return $S_OK
    EndIf


EndFunc ;==>IDispatch_Invoke
; Create callback
$IDispatch_Invoke_Callback = DllCallbackRegister("IDispatch_Invoke", "long", "ptr;dword;ptr;dword;ushort;ptr;ptr;ptr;ptr")
$IDispatch_Invoke_Callback_Ptr = DllCallbackGetPtr($IDispatch_Invoke_Callback)

Func DeleteCOMVariant($pVariant,$fFreeMem=True)
    $hVariant = DllStructCreate($tagVARIANT, $pVariant)
    Switch DllStructGetData($hVariant, "vt")
        Case $VT_DISPATCH
            IUnknown_Release(DereferencePointer(DllStructGetPtr($hVariant, "data")))
        Case $VT_BSTR
            SysFreeString(DereferencePointer(DllStructGetPtr($hVariant, "data")))
    EndSwitch
    If $fFreeMem Then DynFree($pVariant)
EndFunc ;==>DeleteCOMVariant



Func DeleteObject($pObject)
    ConsoleWrite("! Deleting: " & $pObject & @CRLF)


    $hVTable_Entry = DllStructCreate("ptr", DereferencePointer($pObject) + SizeOfPtr() * 7)
    $hHeader = DllStructCreate("int", DllStructGetData($hVTable_Entry, 1))
    $iLookupTable_Size = DllStructGetData($hHeader, 1)


    For $i = 0 To $iLookupTable_Size - 1
        $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($hVTable_Entry, 1) + SizeOfPtr()) + $LOOKUP_TABLE_ENTRY_SIZE * $i)
        $sMemberName = ChrPtrToString(DllStructGetData($hCurrent_Entry, "name"))
        DynFree(DllStructGetData($hCurrent_Entry, "name"))
        If StringLeft($sMemberName, 1) = "@" Then
            DynFree(DllStructGetData($hCurrent_Entry, "value"))
        Else
            DeleteCOMVariant(DllStructGetData($hCurrent_Entry, "value"))
        EndIf
    Next
    DynFree(DereferencePointer(DereferencePointer($pObject) + SizeOfPtr() * 7))
    DynFree(DereferencePointer(DereferencePointer($pObject) + SizeOfPtr() * 8))
    DynFree(DereferencePointer($pObject))


EndFunc ;==>DeleteObject


Func IUnknown_AddRef($pObject)
    $hObject_Info = DllStructCreate($tagOBJECT_INFO, DereferencePointer(DereferencePointer($pObject) + 8*SizeOfPtr()))
;~  ConsoleWrite("Adding object (" & $pObject & ") Ref count: " & " " & DllStructGetData($hObject_Info, "refcount") & " -> " & DllStructGetData($hObject_Info, "refcount") + 1 & @CRLF)
    DllStructSetData($hObject_Info, "refcount", DllStructGetData($hObject_Info, "refcount") + 1)
    Return DllStructGetData($hObject_Info, "refcount")
EndFunc ;==>IUnknown_AddRef
$IUnknown_AddRef_Callback = DllCallbackRegister("IUnknown_AddRef", "dword", "ptr")
$IUnknown_AddRef_Callback_Ptr = DllCallbackGetPtr($IUnknown_AddRef_Callback)

Func IUnknown_Release($pObject)

    $hObject_Info = DllStructCreate($tagOBJECT_INFO, DereferencePointer(DereferencePointer($pObject) + 8*SizeOfPtr()))
;~  ConsoleWrite("Releasing object (" & $pObject & ") Ref count: " & DllStructGetData($hObject_Info, "refcount") & " -> " & DllStructGetData($hObject_Info, "refcount") - 1 & @CRLF)
    DllStructSetData($hObject_Info, "refcount", DllStructGetData($hObject_Info, "refcount") - 1)

    If DllStructGetData($hObject_Info, "refcount") = 0 Then

        $iDestructorID = -1
        While True
            $iDestructorID+=1
            ConsoleWrite($iDestructorID&@CRLF)
            $sMethodName = IDToValue($pObject,$iDestructorID,"name")
            If $sMethodName="" Then ExitLoop
            if StringLeft($sMethodName,1)="~" Then
                ; Make sure ref count stays stable during deconstructor call
                DllStructSetData($hObject_Info,"refcount",2^16)
                Call(IDToValue($pObject,$iDestructorID),ConvertPtrToIDispatch($pObject))

            EndIf
        WEnd



        DeleteObject($pObject)
    EndIf



    Return DllStructGetData($hObject_Info, "refcount")
EndFunc ;==>IUnknown_Release
$IUnknown_Release_Callback = DllCallbackRegister("IUnknown_Release", "dword", "ptr")
$IUnknown_Release_Callback_Ptr = DllCallbackGetPtr($IUnknown_Release_Callback)

Func ObjGetRefCount($vObject)
    If IsObj($vObject) Then $vObject = ConvertIDispatchToPtr($vObject)
    IUnknown_AddRef($vObject)
    Return IUnknown_Release($vObject)
EndFunc ;==>ObjGetRefCount




Func CreateIDispatch()

    $aCall = DllCall($hOLEOUT, "int", "CreateDispTypeInfo", _
            "ptr", 0, _
            "dword", 0x400, _ ; LOCALE_SYSTEM_DEFAULT
            "idispatch*", 0)

    If @error Or $aCall[0] Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[3]

EndFunc ;==>CreateIDispatch




Func CreateObject($aMembers, $oBaseClass = "")
    ; Create a victim. Could be any COM object that inherits from IDispatch
    $oRetObject = 0
    If Not IsObj($oBaseClass) Then

        $oRetObject = CreateIDispatch()
        $pObject = ConvertIDispatchToPtr($oRetObject)
        ; Hook into the object
        ; Offset 20 & 24 is fifth entry in vtable. Look at IDispatch and IUnknown interfaces to see why
        ReplaceVTableEntry($pObject, 5*SizeOfPtr(), $IDispatch_GetIDsFromNames_Callback_Ptr)
        ReplaceVTableEntry($pObject, 6*SizeOfPtr(), $IDispatch_Invoke_Callback_Ptr)


        ; Create space for a new bigger vtable
        $pNewVTable = DynAlloc(9*SizeOfPtr()) ; sizeof(ptr)*(num entirs in dispatch)+sizeof(ptr)+sizeof(ptr)
        RelocateVTable($pObject, $pNewVTable, SizeOfPtr() * 7)

        $pObject_Info = DynAlloc(DllStructGetSize(DllStructCreate($tagOBJECT_INFO)))
        $hObject_Info = DllStructCreate($tagOBJECT_INFO, $pObject_Info )
        DllStructSetData($hObject_Info, "refcount", 1)
        ReplaceVTableEntry($pObject, 8*SizeOfPtr(), $pObject_Info)
        ReplaceVTableEntry($pObject, SizeOfPtr(), $IUnknown_AddRef_Callback_Ptr)
        ReplaceVTableEntry($pObject, 2*SizeOfPtr(), $IUnknown_Release_Callback_Ptr)

    Else
        $pObject = ConvertIDispatchToPtr($oBaseClass)
        $oRetObject = $oBaseClass
    EndIf


    AddMembersToLookupTable($pObject, $aMembers)


    Return $oRetObject
EndFunc ;==>CreateObject




CoInitialize()


main()


Func main()
    $file = File("somefile.txt",1)

    $file.write_line("Hello World!")
    $file.write_line("Another line")

    ; When the function returns $file goes out of scope and its deconstructor is automatically called.
EndFunc



Func File($filename,$accessmode=0)
    $fhandle = FileOpen($filename,$accessmode)
    If @error Then Return
    ; You can define an optional number of deconstructors
    Local $members[7][2]=[["@read","File_Read"],["@read_line","File_Read_Line"], _
    ["@close","File_Close"],["~Deconstructor","File_Deconstructor"],["@write","File_Write"],["@write_line","File_Write_Line"],["handle",$fhandle]]
    Return CreateObject($members)
EndFunc


Func File_Deconstructor($self)
    ; $self is only valid during the duration of this call.
    ; Other than that you can access methods and properties just as normal
    $self.close()
    ConsoleWrite("File object is being killed."&@CRLF)
EndFunc

Func File_Read($self,$numbytes=0)
    If $self.handle=0 Then Return ""
    If $numbytes=0 Then Return FileRead($self.handle)
    Return FileRead($self.handle,$numbytes)
EndFunc

Func File_Read_Line($self)
    If $self.handle=0 Then Return ""
    Return FileReadLine($self.line)
EndFunc

Func File_Close($self)
    If $self.handle=0 Then Return
    FileClose($self.handle)
    $self.handle=0
EndFunc

Func File_Write($self,$data)
    If $self.handle=0 Then Return
    FileWrite($self.handle,$data)
EndFunc

Func File_Write_Line($self,$line)
    If $self.handle=0 Then Return
    FileWriteLine($self.handle,$line)
EndFunc






ForceExit()

wraithdu · January 9, 2010

This is really a sweet project! One quick suggestion from browsing the code - there's no reason to keep calling SizeOfPtr(), just assign it to a global variable once and use that for the rest of the script. No sense doing it the long way over and over again, the value won't change. Keep up the great work!

monoceres · January 9, 2010

This is really a sweet project! One quick suggestion from browsing the code - there's no reason to keep calling SizeOfPtr(), just assign it to a global variable once and use that for the rest of the script. No sense doing it the long way over and over again, the value won't change. Keep up the great work!

Yeah, you're right. A changed it.

A quick bug fix and an example that shows the power of this.

#include <Array.au3>

Global $hOle32 = 0

Global Const $VT_EMPTY = 0
Global Const $VT_NULL = 1
Global Const $VT_I2 = 2
Global Const $VT_I4 = 3
Global Const $VT_R4 = 4
Global Const $VT_R8 = 5
Global Const $VT_CY = 6
Global Const $VT_DATE = 7
Global Const $VT_BSTR = 8
Global Const $VT_DISPATCH = 9
Global Const $VT_ERROR = 10
Global Const $VT_BOOL = 11
Global Const $VT_VARIANT = 12
Global Const $VT_UNKNOWN = 13
Global Const $VT_DECIMAL = 14
Global Const $VT_I1 = 16
Global Const $VT_UI1 = 17
Global Const $VT_UI2 = 18
Global Const $VT_UI4 = 19
Global Const $VT_I8 = 20
Global Const $VT_UI8 = 21
Global Const $VT_INT = 22
Global Const $VT_UINT = 23
Global Const $VT_VOID = 24
Global Const $VT_HRESULT = 25
Global Const $VT_PTR = 26
Global Const $VT_SAFEARRAY = 27
Global Const $VT_CARRAY = 28
Global Const $VT_USERDEFINED = 29
Global Const $VT_LPSTR = 30
Global Const $VT_LPWSTR = 31
Global Const $VT_RECORD = 36
Global Const $VT_INT_PTR = 37
Global Const $VT_UINT_PTR = 38
Global Const $VT_FILETIME = 64
Global Const $VT_BLOB = 65
Global Const $VT_STREAM = 66
Global Const $VT_STORAGE = 67
Global Const $VT_STREAMED_OBJECT = 68
Global Const $VT_STORED_OBJECT = 69
Global Const $VT_BLOB_OBJECT = 70
Global Const $VT_CF = 71
Global Const $VT_CLSID = 72
Global Const $VT_VERSIONED_STREAM = 73
Global Const $VT_BSTR_BLOB = 0xfff
Global Const $VT_VECTOR = 0x1000
Global Const $VT_ARRAY = 0x2000
Global Const $VT_BYREF = 0x4000
Global Const $VT_RESERVED = 0x8000
Global Const $VT_ILLEGAL = 0xffff
Global Const $VT_ILLEGALMASKED = 0xfff
Global Const $VT_TYPEMASK = 0xfff

Global Const $tagGUID = "ulong;ushort;ushort;byte[8]"
Global Const $tagCLSID = $tagGUID
Global Const $tagUUID = $tagGUID
Global Const $CLSCTX_INPROC_SERVER = 0x1
Global Const $S_OK = 0
Global Const $DISP_E_UNKNOWNNAME = 2147614726
Global Const $DISPID_UNKNOWN = 4294967295
Global Const $DISP_E_MEMBERNOTFOUND = 2147614723
Global Const $tagVARIANT = "ushort vt;ushort r1;ushort r2;ushort r3;uint64 data"
Global Const $tagDISPPARAMS = "ptr rgvargs;ptr rgdispidNamedArgs;dword cArgs;dword cNamedArgs;"


Global Const $DISPATCH_METHOD = 0x1
Global Const $DISPATCH_PROPERTYGET = 0x2
Global Const $DISPATCH_PROPERTYPUT = 0x4
Global Const $DISPATCH_PROPERTYPUTREF = 0x8

Global Const $tagLOOKUP_TABLE_ENTRY = "ptr name;ptr value;dword flags;"
Global Const $LOOKUP_TABLE_ENTRY_SIZE = DllStructGetSize(DllStructCreate($tagLOOKUP_TABLE_ENTRY))
Global Const $LOOKUP_TABLE_METHOD = 1
Global Const $LOOKUP_TABLE_PROPERTY = 2
Global Const $LOOKUP_TABLE_PUBLIC = 0
Global Const $LOOKUP_TABLE_PRIVATE = 4

Global Const $tagOBJECT_INFO = "dword refcount;ptr release;"

Global Const $hOLEOUT = DllOpen("oleaut32.dll")



Global Const $SizeOfPtr = DllStructGetSize(DllStructCreate("ptr"))






; In the end we still want the autoit object. This function converts a raw pointer to an autoit object
Func ConvertPtrToIDispatch($pIDispatch)
    ; This would have been 10000x easier if autoit had supported the idispatch* type in dllstructs...
    ; Fortunetely memcpy can copy the pointer into a idispatch*, lucky us.
    Local $aCall = DllCall("kernel32.dll", "none", "RtlMoveMemory", _
            "idispatch*", 0, _
            "ptr*", $pIDispatch, _
            "dword", 4)

    If @error Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[1]

EndFunc ;==>ConvertPtrToIDispatch

Func ConvertIDispatchToPtr($oIDispatch)

    Local $aCall = DllCall("kernel32.dll", "none", "RtlMoveMemory", _
            "ptr*", 0, _
            "idispatch*", $oIDispatch, _
            "dword", $SizeOfPtr)

    If @error Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[1]

EndFunc ;==>ConvertIDispatchToPtr

; Sets the MEM_EXECUTE_READWRITE flag on the specified memory. Use with care, I use because I'm lazy.
Func UnprotectMemory($pMem, $iSize)
    DllCall("Kernel32.dll", "int", "VirtualProtect", "ptr", $pMem, "long", $iSize, "dword", 0x40, "dword*", 0)
EndFunc ;==>UnprotectMemory

; Returns the pointer the passed pointer points to ;)
Func DereferencePointer($pPointer, $sType = "ptr")
    $hStruct = DllStructCreate($sType, $pPointer)
    Return DllStructGetData($hStruct, 1)
EndFunc ;==>DereferencePointer


; Moves the vtable to a new position. useful if you want to add more entries.
Func RelocateVTable($pObj, $pNew, $iVTable_Size)
    $hVTable = DllStructCreate("ptr", $pObj)
    DllCall("kernel32.dll", "none", "RtlMoveMemory", "ptr", $pNew, "ptr", DllStructGetData($hVTable, 1), "dword", $iVTable_Size)
    DllStructSetData($hVTable, 1, $pNew)
EndFunc ;==>RelocateVTable

; Allocate memory on the heap
Func DynAlloc($dwSize)
    $hHeap = DllCall("Kernel32.dll", "ptr", "GetProcessHeap")
    $hHeap = $hHeap[0]
    $hMem = DllCall("Kernel32.dll", "ptr", "HeapAlloc", "ptr", $hHeap, "dword", 0x8, "dword", $dwSize)
    DllCall("Kernel32.dll", "none", "CloseHandle", "ptr", $hHeap)
    Return $hMem[0]
EndFunc ;==>DynAlloc

; Fantastic function. Does not ask how many bytes that needs to be freed
Func DynFree($hMem)
    $hHeap = DllCall("Kernel32.dll", "ptr", "GetProcessHeap")
    $hHeap = $hHeap[0]
    $hMem = DllCall("Kernel32.dll", "int", "HeapFree", "ptr", $hHeap, "dword", 0, "ptr", $hMem)
    DllCall("Kernel32.dll", "none", "CloseHandle", "ptr", $hHeap)
    Return $hMem[0]
EndFunc ;==>DynFree




; Takes a pointer to the v-table in a class and replaces specified pointer in it to a new one.
Func ReplaceVTableEntry($pVTable, $iOffset, $pNew)
    ; Dereference the pointer


    $pEntry = DereferencePointer($pVTable) + $iOffset
    ; Make the memory free for all. Yay!
    UnprotectMemory($pEntry, $SizeOfPtr)
    $hEntry = DllStructCreate("ptr", $pEntry)
    $pOld = DllStructGetData($hEntry, 1)
    DllStructSetData($hEntry, 1, $pNew)
    Return $pOld
EndFunc ;==>ReplaceVTableEntry



Func CreateDynamicString($sString)
    $pDynamic = DynAlloc(StringLen($sString) + 1)
    DllStructSetData(DllStructCreate("char[" & StringLen($sString) + 1 & "]", $pDynamic), 1, $sString)
    Return $pDynamic
EndFunc ;==>CreateDynamicString



Func AddMembersToLookupTable($pObj, $aNames)

    ; Set point in vtable
    $hVTable_Entry = DllStructCreate("ptr", DereferencePointer($pObj) + 4 * 7)


    If DllStructGetData($hVTable_Entry, 1) <> 0 Then

        $hHeader = DllStructCreate("int", DllStructGetData($hVTable_Entry, 1))

        Local $aTemp[UBound($aNames) + DllStructGetData($hHeader, 1)][2]
        For $i = 0 To DllStructGetData($hHeader, 1) - 1
            $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($hVTable_Entry, 1) + $SizeOfPtr) + $LOOKUP_TABLE_ENTRY_SIZE * $i)
            $aTemp[$i][0] = ChrPtrToString(DllStructGetData($hCurrent_Entry, "name"))
            If StringLeft($aTemp[$i][0], 1) = "@" Or StringLeft($aTemp[$i][0], 1) = "~" Then
                $aTemp[$i][1] = ChrPtrToString(DllStructGetData($hCurrent_Entry, "value"))
            Else
                $aTemp[$i][1] = COMVariantToValue(DllStructGetData($hCurrent_Entry, "value"))
            EndIf

        Next
        For $i = 0 To UBound($aNames) - 1
            For $j = 0 To UBound($aTemp) - 1
                If $aTemp[$j][0] = $aNames[$i][0] Then
                    $aTemp[$j][0] = $aNames[$i][0]
                    $aTemp[$j][1] = $aNames[$i][1]
                    ExitLoop
                ElseIf $aTemp[$j][0] = "" Then
                    $aTemp[$j][0] = $aNames[$i][0]
                    $aTemp[$j][1] = $aNames[$i][1]
                    ExitLoop
                EndIf
            Next
        Next

        For $i = UBound($aTemp) - 1 To 0 Step -1
            If $aTemp[$i][0] <> "" Then ExitLoop
            _ArrayDelete($aTemp, $i)
        Next


        $aNames = $aTemp


        DynFree(DllStructGetData($hVTable_Entry, 1))

    EndIf

    ; Create dynamic memory for new lookup table
    $pMem = DynAlloc($SizeOfPtr + (UBound($aNames) * $LOOKUP_TABLE_ENTRY_SIZE))
    ; Create lookup table, first element is number of element
    ; Must be sorted!
    $hLookupTable = DllStructCreate("int;byte[" & $LOOKUP_TABLE_ENTRY_SIZE & "]", $pMem)
    ; Set size of lookup table
    DllStructSetData($hLookupTable, 1, UBound($aNames))
    ; Modify vtable to point to the lookup table
;~  MsgBox(0,"", $mem)
    DllStructSetData($hVTable_Entry, 1, $pMem)


    For $i = 0 To UBound($aNames) - 1
        $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, DllStructGetPtr($hLookupTable, 2) + $LOOKUP_TABLE_ENTRY_SIZE * $i)

        If StringLeft($aNames[$i][0], 1) = "@" Or StringLeft($aNames[$i][0], 1) = "~" Then ; This is a method
            DllStructSetData($hCurrent_Entry, "name", CreateDynamicString($aNames[$i][0]))
            DllStructSetData($hCurrent_Entry, "value", CreateDynamicString($aNames[$i][1]))
        Else ; It's a property then.
            $pVariant = DynAlloc(16)
            If IsObj($aNames[$i][1]) Then
                IUnknown_AddRef(ConvertIDispatchToPtr($aNames[$i][1]))
            EndIf
            ValueToCOMVariant($pVariant, $aNames[$i][1])
            DllStructSetData($hCurrent_Entry, "name", CreateDynamicString($aNames[$i][0]))
            DllStructSetData($hCurrent_Entry, "value", $pVariant)
        EndIf

    Next
EndFunc ;==>AddMembersToLookupTable

Func ChrPtrToString($pString)
    $iLength = strlen($pString)
    $hString = DllStructCreate("char[" & $iLength + 1 & "]", $pString)
    Return DllStructGetData($hString, 1)
EndFunc ;==>ChrPtrToString


Func FindNameInLookupTable($pObj, $sName)
    $hVTable_Entry = DllStructCreate("ptr", DereferencePointer($pObj) + $SizeOfPtr * 7) ; sizeof(ptr)*(num entries in idispatch)
    $hHeader = DllStructCreate("int", DllStructGetData($hVTable_Entry, 1))
    $iLookupTable_Size = DllStructGetData($hHeader, 1)
    For $i = 0 To $iLookupTable_Size - 1
        $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($hVTable_Entry, 1) + $SizeOfPtr) + $LOOKUP_TABLE_ENTRY_SIZE * $i)
        If $sName = ChrPtrToString(DllStructGetData($hCurrent_Entry, "name")) Then Return $i
    Next
    Return -1
EndFunc ;==>FindNameInLookupTable

Func IDToValue($pObj, $iId, $sField = "value")
;~  MsgBox(0,"",$id)
    $hVTable_Entry = DllStructCreate("ptr", DereferencePointer($pObj) + $SizeOfPtr * 7)
    $hHeader = DllStructCreate("int", DllStructGetData($hVTable_Entry, 1))
    $iLookupTable_Size = DllStructGetData($hHeader, 1)


    If $iId < 0 Or $iId >= $iLookupTable_Size Then Return ""

    $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($hVTable_Entry, 1) + $SizeOfPtr) + $LOOKUP_TABLE_ENTRY_SIZE * $iId)

    $sMember_Name = ChrPtrToString(DllStructGetData($hCurrent_Entry, "name"))
    If StringLeft($sMember_Name, 1) = "@" Or StringLeft($sMember_Name, 1) = "~" Then
        Return ChrPtrToString(DllStructGetData($hCurrent_Entry, $sField))
    Else
        Return DllStructGetData($hCurrent_Entry, $sField)
    EndIf
EndFunc ;==>IDToValue

Func ForceExit($iExitCode = 0)
    DllCall("Kernel32.dll", "none", "ExitProcess", "dword", $iExitCode)
EndFunc ;==>ForceExit



Func VTType2AutoitType($iVT_Type)
    ConsoleWrite("! " & $iVT_Type & @CRLF)
    Switch $iVT_Type
        Case $VT_I1
            Return "byte"
        Case $VT_I2
            Return "short"
        Case $VT_I4
            Return "int"
        Case $VT_BSTR
            Return "wstr"
        Case $VT_R8
            Return "double"
        Case $VT_DISPATCH
            Return "idispatch"
    EndSwitch
EndFunc ;==>VTType2AutoitType

Func AutoitType2VTType($sAutoit_Type)
    Switch $sAutoit_Type
        Case "byte"
            Return $VT_I1
        Case "short"
            Return $VT_I2
        Case "int"
            Return $VT_I4
        Case "wstr"
            Return $VT_BSTR
        Case "double"
            Return $VT_R8
        Case "ptr"
            Return $VT_PTR
        Case "idispatch"
            Return $VT_DISPATCH
    EndSwitch
EndFunc ;==>AutoitType2VTType


; Find out length of string. I do not trust autoit to do this.
Func wcslen($pWString)
    $aCall = DllCall("ntdll.dll", "dword:cdecl", "wcslen", "ptr", $pWString)
    Return $aCall[0]
EndFunc ;==>wcslen

; Find out length of string. I do not trust autoit to do this.
Func strlen($pString)
    $aCall = DllCall("ntdll.dll", "dword:cdecl", "strlen", "ptr", $pString)
    Return $aCall[0]
EndFunc ;==>strlen

Func SysAllocString($sString)
    $aCall = DllCall("oleaut32.dll", "ptr", "SysAllocString", "wstr", $sString)
    Return $aCall[0]
EndFunc ;==>SysAllocString

Func SysFreeString($pBStr)
    $aCall = DllCall("oleaut32.dll", "dword", "SysAllocString", "ptr", $pBStr)
    Return $aCall[0]
EndFunc ;==>SysFreeString




Func COMVariantToValue($pVariant)
    Local $hVariant = DllStructCreate($tagVARIANT, $pVariant)
    ; Translate the vt id to a autoit dllcall type
    $sType = VTType2AutoitType(DllStructGetData($hVariant, "vt"))


    If $sType = "wstr" Then
        $pString = DllStructCreate("ptr", DllStructGetPtr($hVariant, "data"))
        ; Getting random crashes when trusting autoit to automatically use right size.
        ; doing it myself instead (also, it should be a BSTR, but it's not. Is autoit not obeying the rules!?
        $iString_Size = wcslen(DllStructGetData($pString, 1))

        ; Sorry trancexx, doesn't seem to work on large strings (crashes like crazy when trying to use on 1 MB string)
        ;$tSub = DllStructCreate("dword", DllStructGetData($str_ptr, 1) - 4) ; <- move pointer back 4 bytes!

        $hData = DllStructCreate("wchar[" & $iString_Size & "]", DllStructGetData($pString, 1))

    ElseIf $sType = "idispatch" Then

        Return ConvertPtrToIDispatch(DllStructGetData(DllStructCreate("ptr", DllStructGetPtr($hVariant, "data")), 1))

    Else
        $hData = DllStructCreate($sType, DllStructGetPtr($hVariant, "data"))
    EndIf

    Return DllStructGetData($hData, 1)
EndFunc ;==>COMVariantToValue

; Starts COM
Func CoInitialize()
    $hOle32 = DllOpen("Ole32.dll")
    Local $aCall = DllCall($hOle32, "long", "CoInitializeEx", "ptr", 0, "dword", 2) ; COINIT_APARTMENTTHREADED
EndFunc ;==>CoInitialize



Func ValueToCOMVariant($pVariant, $vValue)
    $hVariant = DllStructCreate($tagVARIANT, $pVariant)

    If IsInt($vValue) Then
        $iVT_Type = AutoitType2VTType("int")
        $vData = $vValue
    ElseIf IsString($vValue) Then
        $iVT_Type = AutoitType2VTType("wstr")
        $vData = SysAllocString($vValue)
    ElseIf IsObj($vValue) Then
        $iVT_Type = AutoitType2VTType("idispatch")
        $vData = ConvertIDispatchToPtr($vValue)

    EndIf
    DllStructSetData($hVariant, "vt", $iVT_Type)
    DllStructSetData(DllStructCreate("int", DllStructGetPtr($hVariant, "data")), 1, $vData)

EndFunc ;==>ValueToCOMVariant






; Everytime autoit wants to call a method, get or set a property in a object it needs to go to
; IDispatch::GetIDsFromNames. This is our version of that function, note that by defining this ourselves
; we can fool autoit to believe that the object supports a lot of different properties/methods.
Func IDispatch_GetIDsFromNames($pSelf, $pRefIID, $pString_Array, $iArray_Size, $iContext, $pOut_Array)
    ; It's self explainable that autoit only asks for one member
    $hMemberName = DllStructCreate("wchar[256]", DereferencePointer($pString_Array))
    $sMemberName = DllStructGetData($hMemberName, 1)
    ConsoleWrite("AutoIt wants to look up: " & DllStructGetData($hMemberName, 1) & " (in object: " & $pSelf & ")" & @CRLF)

    ; Autoit gave us an array with one element ready to accept the id of the member it requested.
    $hID = DllStructCreate("long", $pOut_Array)


    $iId = FindNameInLookupTable($pSelf, "@" & $sMemberName)
    If $iId = -1 Then $iId = FindNameInLookupTable($pSelf, $sMemberName)
    If $iId <> -1 Then
        DllStructSetData($hID, 1, $iId)
        Return $S_OK
    Else
        MsgBox(16, "Error", "Object have no member named: " & $sMemberName)
        DllStructSetData($hID, 1, $DISPID_UNKNOWN)
        Return $DISP_E_UNKNOWNNAME
    EndIf



EndFunc ;==>IDispatch_GetIDsFromNames
; Create the callback so we have a pointer to this function.
$IDispatch_GetIDsFromNames_Callback = DllCallbackRegister("IDispatch_GetIDsFromNames", "long", "ptr;ptr;ptr;int;int;ptr")
$IDispatch_GetIDsFromNames_Callback_Ptr = DllCallbackGetPtr($IDispatch_GetIDsFromNames_Callback)


; This is called when a method is called, a property is set or get.
; This call also contains arguments returns and a lot other stuff.
; However in this trivial example we don't return anything and we don't take any arguments. Puh, could get messy
Func IDispatch_Invoke($pSelf, $iDispID, $pRefIID, $iLCID, $wFlags, $pDispParams, $pVarResult, $pExceptInfo, $puArgErr)
    ;; Dump all parameters to console.
    ConsoleWrite("DispID: " & $iDispID & @CRLF & "RIID: " & $pRefIID & @CRLF & "LCID: " & $iLCID & @CRLF & "wFlags: " & $wFlags & @CRLF & _
            "pDispParams: " & $pDispParams & @CRLF & "pVarResult: " & $pVarResult & @CRLF & "pExceptInfo: " & $pExceptInfo & @CRLF & "puArgError: " & $puArgErr & @CRLF)


    $vMemberValue = IDToValue($pSelf, $iDispID)

    If $vMemberValue = "" Then Return $DISP_E_MEMBERNOTFOUND ; Should NEVER happen. But, you never know!


    $hDispParams = DllStructCreate($tagDISPPARAMS, $pDispParams)

    ; AutoIt is pretty sneaky methinks, oring these together..
    If $wFlags = BitOR($DISPATCH_METHOD, $DISPATCH_PROPERTYGET) Then

        ; Methods returns strings
        If IsString($vMemberValue) Then


            $oSelf = ConvertPtrToIDispatch($pSelf)
            $sCall = $vMemberValue & "($oSelf"

            If $pDispParams <> 0 And DllStructGetData($hDispParams, "cArgs") > 0 Then
                Local $aParams[DllStructGetData($hDispParams, "cArgs")]
                ; Fetch all arguments
                For $i = 0 To UBound($aParams) - 1
                    ; Save the values backwards (that's how autoit do it)
                    $aParams[(UBound($aParams) - 1) - $i] = COMVariantToValue(DllStructGetData($hDispParams, "rgvargs") + ($i * 16)) ; i*sizeof(VARIANT)
                    $sCall &= ",$aParams[" & $i & "]"
                Next
            EndIf
            $sCall &= ")"
            ConsoleWrite("Calling function: " & $sCall & @CRLF)
            $vReturn = Execute($sCall)
            ; Set return value.
            ValueToCOMVariant($pVarResult, $vReturn)
            ; Give autoit the message that everything went according to plan
            Return $S_OK
        Else ; PROPERTYGET
            $vValue = COMVariantToValue($vMemberValue)
            ; I have no idea why this is needed. Shouldn't AutoIt increase the ref count when it is getting my object!?
            If IsObj($vValue) Then
                IUnknown_AddRef(ConvertIDispatchToPtr($vValue))
            EndIf

            ValueToCOMVariant($pVarResult, $vValue)
            Return $S_OK
        EndIf

    ElseIf $wFlags = $DISPATCH_PROPERTYPUT Or $wFlags = $DISPATCH_PROPERTYPUTREF Then

        DeleteCOMVariant($vMemberValue, False)
;~      $vOld_Value = COMVariantToValue($vMemberValue)
;~      If IsObj($vOld_Value) Then IUnknown_Release(ConvertIDispatchToPtr($vOld_Value))


        $vNewValue = COMVariantToValue(DllStructGetData($hDispParams, "rgvargs"))
        If IsObj($vNewValue) Then ; If saving a object in a property we need to increase its ref count
            IUnknown_AddRef(ConvertIDispatchToPtr($vNewValue))
        EndIf

        ValueToCOMVariant($vMemberValue, $vNewValue)
        Return $S_OK
    EndIf


EndFunc ;==>IDispatch_Invoke
; Create callback
$IDispatch_Invoke_Callback = DllCallbackRegister("IDispatch_Invoke", "long", "ptr;dword;ptr;dword;ushort;ptr;ptr;ptr;ptr")
$IDispatch_Invoke_Callback_Ptr = DllCallbackGetPtr($IDispatch_Invoke_Callback)

Func DeleteCOMVariant($pVariant, $fFreeMem = True)
    $hVariant = DllStructCreate($tagVARIANT, $pVariant)
    Switch DllStructGetData($hVariant, "vt")
        Case $VT_DISPATCH
            IUnknown_Release(DereferencePointer(DllStructGetPtr($hVariant, "data")))
        Case $VT_BSTR
            SysFreeString(DereferencePointer(DllStructGetPtr($hVariant, "data")))
    EndSwitch
    If $fFreeMem Then DynFree($pVariant)
EndFunc ;==>DeleteCOMVariant



Func DeleteObject($pObject)
    ConsoleWrite("! Deleting: " & $pObject & @CRLF)


    $hVTable_Entry = DllStructCreate("ptr", DereferencePointer($pObject) + $SizeOfPtr * 7)
    $hHeader = DllStructCreate("int", DllStructGetData($hVTable_Entry, 1))
    $iLookupTable_Size = DllStructGetData($hHeader, 1)


    For $i = 0 To $iLookupTable_Size - 1
        $hCurrent_Entry = DllStructCreate($tagLOOKUP_TABLE_ENTRY, (DllStructGetData($hVTable_Entry, 1) + $SizeOfPtr) + $LOOKUP_TABLE_ENTRY_SIZE * $i)
        $sMemberName = ChrPtrToString(DllStructGetData($hCurrent_Entry, "name"))
        DynFree(DllStructGetData($hCurrent_Entry, "name"))
        If StringLeft($sMemberName, 1) = "@" Then
            DynFree(DllStructGetData($hCurrent_Entry, "value"))
        Else
            DeleteCOMVariant(DllStructGetData($hCurrent_Entry, "value"))
        EndIf
    Next
    DynFree(DereferencePointer(DereferencePointer($pObject) + $SizeOfPtr * 7))
    DynFree(DereferencePointer(DereferencePointer($pObject) + $SizeOfPtr * 8))
    DynFree(DereferencePointer($pObject))


EndFunc ;==>DeleteObject


Func IUnknown_AddRef($pObject)
    $hObject_Info = DllStructCreate($tagOBJECT_INFO, DereferencePointer(DereferencePointer($pObject) + 8 * $SizeOfPtr))
;~  ConsoleWrite("Adding object (" & $pObject & ") Ref count: " & " " & DllStructGetData($hObject_Info, "refcount") & " -> " & DllStructGetData($hObject_Info, "refcount") + 1 & @CRLF)
    DllStructSetData($hObject_Info, "refcount", DllStructGetData($hObject_Info, "refcount") + 1)
    Return DllStructGetData($hObject_Info, "refcount")
EndFunc ;==>IUnknown_AddRef
$IUnknown_AddRef_Callback = DllCallbackRegister("IUnknown_AddRef", "dword", "ptr")
$IUnknown_AddRef_Callback_Ptr = DllCallbackGetPtr($IUnknown_AddRef_Callback)

Func IUnknown_Release($pObject)

    $hObject_Info = DllStructCreate($tagOBJECT_INFO, DereferencePointer(DereferencePointer($pObject) + 8 * $SizeOfPtr))
;~  ConsoleWrite("Releasing object (" & $pObject & ") Ref count: " & DllStructGetData($hObject_Info, "refcount") & " -> " & DllStructGetData($hObject_Info, "refcount") - 1 & @CRLF)
    DllStructSetData($hObject_Info, "refcount", DllStructGetData($hObject_Info, "refcount") - 1)

    If DllStructGetData($hObject_Info, "refcount") = 0 Then

        $iDestructorID = -1
        While True
            $iDestructorID += 1
            ConsoleWrite($iDestructorID & @CRLF)
            $sMethodName = IDToValue($pObject, $iDestructorID, "name")
            If $sMethodName = "" Then ExitLoop
            If StringLeft($sMethodName, 1) = "~" Then
                ; Make sure ref count stays stable during deconstructor call
                DllStructSetData($hObject_Info, "refcount", 2 ^ 16)
                Call(IDToValue($pObject, $iDestructorID), ConvertPtrToIDispatch($pObject))

            EndIf
        WEnd



        DeleteObject($pObject)
    EndIf



    Return DllStructGetData($hObject_Info, "refcount")
EndFunc ;==>IUnknown_Release
$IUnknown_Release_Callback = DllCallbackRegister("IUnknown_Release", "dword", "ptr")
$IUnknown_Release_Callback_Ptr = DllCallbackGetPtr($IUnknown_Release_Callback)

Func ObjGetRefCount($vObject)
    If IsObj($vObject) Then $vObject = ConvertIDispatchToPtr($vObject)
    IUnknown_AddRef($vObject)
    Return IUnknown_Release($vObject)
EndFunc ;==>ObjGetRefCount




Func CreateIDispatch()

    $aCall = DllCall($hOLEOUT, "int", "CreateDispTypeInfo", _
            "ptr", 0, _
            "dword", 0x400, _ ; LOCALE_SYSTEM_DEFAULT
            "idispatch*", 0)

    If @error Or $aCall[0] Then
        Return SetError(1, 0, 0)
    EndIf

    Return $aCall[3]

EndFunc ;==>CreateIDispatch




Func CreateObject($aMembers, $oBaseClass = "")
    ; Create a victim. Could be any COM object that inherits from IDispatch
    $oRetObject = 0
    If Not IsObj($oBaseClass) Then

        $oRetObject = CreateIDispatch()
        $pObject = ConvertIDispatchToPtr($oRetObject)
        ; Hook into the object
        ; Offset 20 & 24 is fifth entry in vtable. Look at IDispatch and IUnknown interfaces to see why
        ReplaceVTableEntry($pObject, 5 * $SizeOfPtr, $IDispatch_GetIDsFromNames_Callback_Ptr)
        ReplaceVTableEntry($pObject, 6 * $SizeOfPtr, $IDispatch_Invoke_Callback_Ptr)


        ; Create space for a new bigger vtable
        $pNewVTable = DynAlloc(9 * $SizeOfPtr) ; sizeof(ptr)*(num entirs in dispatch)+sizeof(ptr)+sizeof(ptr)
        RelocateVTable($pObject, $pNewVTable, $SizeOfPtr * 7)

        $pObject_Info = DynAlloc(DllStructGetSize(DllStructCreate($tagOBJECT_INFO)))
        $hObject_Info = DllStructCreate($tagOBJECT_INFO, $pObject_Info)
        DllStructSetData($hObject_Info, "refcount", 1)
        ReplaceVTableEntry($pObject, 8 * $SizeOfPtr, $pObject_Info)
        ReplaceVTableEntry($pObject, $SizeOfPtr, $IUnknown_AddRef_Callback_Ptr)
        ReplaceVTableEntry($pObject, 2 * $SizeOfPtr, $IUnknown_Release_Callback_Ptr)

    Else
        $pObject = ConvertIDispatchToPtr($oBaseClass)
        $oRetObject = $oBaseClass
    EndIf


    AddMembersToLookupTable($pObject, $aMembers)


    Return $oRetObject
EndFunc ;==>CreateObject




CoInitialize()

$e = Container(Container(Container(Container(Container(42)))))
$e.data.data.data.data.display("Hello!")


Func Container($data)
    Local $members[2][2] = [["data", $data],["@display","Container_Display"]]
    Return CreateObject($members)
EndFunc ;==>Container

Func Container_Display($self,$title)
    MsgBox(0,$title,$self.data)
EndFunc






ForceExit()

trancexx · January 9, 2010

I see that remark.

That dword is the size of string in bytes, not wchars. It should have been something like this:

$tSub = DllStructCreate("dword", DllStructGetData($pString, 1) - 4) ; <- move pointer back 4 bytes!
$hData = DllStructCreate("wchar[" & DllStructGetData($tSub, 1)/2 & "]", DllStructGetData($pString, 1))

Dividing by two is essential.

Would that crash?

When do you plan to inform the devs? They should be aware of this. Ignoring it makes no sense.

monoceres · January 9, 2010

I see that remark.
That dword is the size of string in bytes, not wchars. It should have been something like this:
$tSub = DllStructCreate("dword", DllStructGetData($pString, 1) - 4) ; <- move pointer back 4 bytes!
$hData = DllStructCreate("wchar[" & DllStructGetData($tSub, 1)/2 & "]", DllStructGetData($pString, 1))
Dividing by two is essential.
Would that crash?

When do you plan to inform the devs? They should be aware of this. Ignoring it makes no sense.

ProgAndy have done some amazing work. Fixing all shortcomings with my implementation. When presenting this everything must be perfect.

Hooking into the IDispatch interface.

Recommended Posts

Link to comment

Share on other sites

Top Posters In This Topic

Top Posters In This Topic

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Link to comment

Share on other sites

Create an account or sign in to comment

Create an account

Sign in

Recently Browsing 0 members