Interface nur unter bestimmten Bedingungen unterstützen

[Der schöne Günther]

Kannst du mal deinen vollständigen Quelltext posten? Welches QueryInterface wird denn zur Laufzeit benutzt? Ich denke mal, du hast vergessen, in deiner Klassendefinition IInterface anzugeben, oder?+

Hier mal ein Beispiel:

Delphi-Quellcode:

program SupportsProject;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

type
   IMyInterface = interface
   ['{03A20C4F-400C-462F-B10D-D19B01E82919}']
      procedure testProcedure();
   end;

   TMyClass = class(TInterfacedObject, (*IInterface, *)IMyInterface)
      protected var
         shouldSupport: Boolean;
      public
         constructor Create(const shouldSupport: Boolean = True);
         procedure testProcedure();

         function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
   end;

procedure justSupportThings();
var
   instance:      IInterface;
   myIntf:         IMyInterface;
   shouldSupport:   Boolean;
begin
   shouldSupport := False; // Hier anpassen

   instance := TMyClass.Create(shouldSupport);
   if Supports(instance, IMyInterface, myIntf) then begin
      WriteLn('Instance supports interface');
      myIntf.testProcedure();
   end else
      WriteLn('Instance does not support interface');
end;

{ TMyClass }

procedure TMyClass.testProcedure();
begin
   WriteLn('This is the test procedure');
end;

constructor TMyClass.Create(const shouldSupport: Boolean);
begin
   inherited Create();
   self.shouldSupport := shouldSupport;
end;

function TMyClass.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
   if (not shouldSupport) then Exit(E_NOINTERFACE) else Result := inherited;
end;

begin
  try
   justSupportThings();
  except
    on E: Exception do
     Writeln(E.ClassName, ': ', E.Message);
  end;
  readln;
end.