* Parent class for hidden TVirtualInterface thunking class

rtl/inc/objpas.inc

@@ -1224,6 +1224,28 @@
       FName:=aName;
     end;
 
+{****************************************************************************
+                             TInterfaceThunk
+****************************************************************************}
+
+Constructor TInterfaceThunk.Create(aCallback : TThunkCallback);
+
+begin
+  FCallBack:=aCallBack;
+end;
+
+Procedure TInterfaceThunk.Thunk(aMethod: Longint; aCount : Longint; aData : PArgData);
+
+begin
+  if Assigned(FCallBack) then
+    FCallBack(Self,aMethod,aCount,aData); 
+end;
+
+function TInterfaceThunk.InterfaceVMTOffset : word;
+
+begin
+  Result:=0;
+end;
 
 {****************************************************************************
                              Exception Support

rtl/inc/objpash.inc

@@ -340,7 +340,28 @@
            function _AddRef : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
            function _Release : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
        end;
-                   
+
+       
+       TInterfaceThunk = Class(TInterfacedObject)
+       Public
+         Type
+           TArgData = record
+             addr : pointer;   // Location
+             info : pointer;   // type info (if available: nil for untyped args)
+             idx  : smallint;  // param index in rtti
+             ahigh : sizeint;  // For open arrays, high()
+           end;
+           PArgData = ^TargData;
+         TThunkCallBack = Procedure(aInstance: Pointer; aMethod,aCount : Longint; aData : PArgData) of object;
+       Private  
+         FCallback : TThunkCallback;
+       Protected  
+         Procedure Thunk(aMethod: Longint; aCount : Longint; aData : PArgData); virtual;
+       Public  
+         constructor create(aCallBack : TThunkCallback);
+         function InterfaceVMTOffset : word; virtual;
+       end;  
+       TInterfaceThunkClass = class of TInterfaceThunk;
 
        { some pointer definitions }
        PUnknown = ^IUnknown;

rtl/objpas/typinfo.pp

@@ -515,6 +515,7 @@ unit TypInfo;
           Parent: PPTypeInfo;
           Flags: TIntfFlagsBase;
           GUID: TGUID;
+          ThunkClass : PPTypeInfo;
           UnitNameField: ShortString;
           { PropertyTable: TPropData }
           { MethodTable: TIntfMethodTable }
@@ -555,6 +556,7 @@ unit TypInfo;
             Parent: PPTypeInfo;
             Flags : TIntfFlagsBase;
             IID: TGUID;
+            ThunkClass : PPTypeInfo;
             UnitNameField: ShortString;
             { IIDStr: ShortString; }
             { PropertyTable: TPropData }
@@ -756,6 +758,7 @@ unit TypInfo;
                IntfParentRef: TypeInfoPtr;
                IntfFlags : TIntfFlagsBase;
                GUID: TGUID;
+               ThunkClass : PPTypeInfo;
                IntfUnit: ShortString;
                { PropertyTable: TPropData }
                { MethodTable: TIntfMethodTable }
@@ -765,6 +768,7 @@ unit TypInfo;
                RawIntfParentRef: TypeInfoPtr;
                RawIntfFlags : TIntfFlagsBase;
                IID: TGUID;
+               RawThunkClass : PPTypeInfo;
                RawIntfUnit: ShortString;
                { IIDStr: ShortString; }
                { PropertyTable: TPropData }