Browse Source

* Interface thunk class must query owner object interface list

Michaël Van Canneyt 2 years ago
parent
commit
517d1b017c
2 changed files with 15 additions and 1 deletions
  1. 13 0
      rtl/inc/objpas.inc
  2. 2 1
      rtl/inc/objpash.inc

+ 13 - 0
rtl/inc/objpas.inc

@@ -1241,6 +1241,19 @@ begin
     FCallBack(Self,aMethod,aCount,aData); 
 end;
 
+function TInterfaceThunk.QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
+
+begin
+  result:=longint(E_NOINTERFACE);
+  if (TMethod(FCallBack).Data<>Nil) then
+    // Query the object that created us, this is normally TVirtualInterface
+    // Take care: do not call QueryInterface, that would create a never-ending loop !!
+    if TObject(TMethod(FCallBack).Data).GetInterface(iid,obj) then
+      result:=S_OK;
+  if (Result<>S_OK) then
+    Result:=Inherited QueryInterface(iid,obj);
+end;
+
 function TInterfaceThunk.InterfaceVMTOffset : word;
 
 begin

+ 2 - 1
rtl/inc/objpash.inc

@@ -356,6 +356,7 @@
        Private  
          FCallback : TThunkCallback;
        Protected  
+         function QueryInterface({$IFDEF FPC_HAS_CONSTREF}constref{$ELSE}const{$ENDIF} iid : tguid;out obj) : longint;{$IFNDEF WINDOWS}cdecl{$ELSE}stdcall{$ENDIF};
          Procedure Thunk(aMethod: Longint; aCount : Longint; aData : PArgData); virtual;
        Public  
          constructor create(aCallBack : TThunkCallback);
@@ -623,4 +624,4 @@ Type
   end;
   
 operator =(Left, Right: TPtrWrapper) c : Boolean;  
-operator <>(Left, Right: TPtrWrapper) c : Boolean;
+operator <>(Left, Right: TPtrWrapper) c : Boolean;