mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-05 12:38:29 +02:00
128 lines
3.1 KiB
ObjectPascal
128 lines
3.1 KiB
ObjectPascal
program IntfDelegationCrash;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
|
|
type
|
|
|
|
IGMGetFileName = interface(IUnknown)
|
|
['{D3ECCB42-A563-4cc4-B375-79931031ECBA}']
|
|
function GetFileName: String; stdcall;
|
|
property FileName: String read GetFileName;
|
|
end;
|
|
|
|
|
|
IGMGetHandle = interface(IUnknown)
|
|
['{5BB45961-15A9-11d5-A5E4-00E0987755DD}']
|
|
function GetHandle: THandle; stdcall;
|
|
property Handle: THandle read GetHandle;
|
|
end;
|
|
|
|
|
|
{ TImplementor }
|
|
|
|
TImplementor = class(TObject, IGMGetFileName, IGMGetHandle)
|
|
protected
|
|
FController: Tobject;
|
|
|
|
public
|
|
constructor Create(const AController: TObject);
|
|
|
|
function QueryInterface(constref IID: TGUID; out Intf): HResult; virtual; {$ifdef windows}stdcall{$else}cdecl{$endif};
|
|
function _AddRef: LongInt; virtual; {$ifdef windows}stdcall{$else}cdecl{$endif};
|
|
function _Release: LongInt; virtual; {$ifdef windows}stdcall{$else}cdecl{$endif};
|
|
|
|
function GetHandle: THandle; stdcall;
|
|
function GetFileName: String; stdcall;
|
|
end;
|
|
|
|
{ TDelegator }
|
|
|
|
TDelegator = class(TInterfacedObject, IGMGetFileName) // IGMGetHandle
|
|
protected
|
|
FImplementor: TImplementor;
|
|
FGetFileName: IGMGetFileName;
|
|
|
|
public
|
|
constructor Create;
|
|
destructor Destroy;
|
|
|
|
//
|
|
// This crashes
|
|
//
|
|
property Implementor: TImplementor read FImplementor implements IGMGetFileName;
|
|
|
|
//
|
|
// This works
|
|
//
|
|
//property Implementor: IGMGetFileName read FGetFileName implements IGMGetFileName;
|
|
|
|
//
|
|
// This is what i really need
|
|
//
|
|
//property Implementor: TImplementor read FImplementor implements IGMGetFileName, IGMGetHandle;
|
|
end;
|
|
|
|
|
|
{ TImplementor }
|
|
|
|
constructor TImplementor.Create(const AController: TObject);
|
|
begin
|
|
FController := AController;
|
|
end;
|
|
|
|
function TImplementor.QueryInterface(constref IID: TGUID; out Intf): HResult; {$ifdef windows}stdcall{$else}cdecl{$endif};
|
|
var PIUnkController: IUnknown;
|
|
begin
|
|
if GetInterface(IID, Intf) then Result := S_OK else
|
|
if (FController <> nil) and FController.GetInterface(IUnknown, PIUnkController) then
|
|
Result := PIUnkController.QueryInterface(IID, Intf) else Result := E_NOINTERFACE;
|
|
end;
|
|
|
|
function TImplementor._AddRef: LongInt; {$ifdef windows}stdcall{$else}cdecl{$endif};
|
|
var PIUnkController: IUnknown;
|
|
begin
|
|
if (FController <> nil) and FController.GetInterface(IUnknown, PIUnkController) then
|
|
Result := PIUnkController._AddRef
|
|
end;
|
|
|
|
function TImplementor._Release: LongInt; {$ifdef windows}stdcall{$else}cdecl{$endif};
|
|
var PIUnkController: IUnknown;
|
|
begin
|
|
if (FController <> nil) and FController.GetInterface(IUnknown, PIUnkController) then
|
|
Result := PIUnkController._Release
|
|
end;
|
|
|
|
function TImplementor.GetHandle: THandle; stdcall;
|
|
begin
|
|
Result := 0;
|
|
end;
|
|
|
|
function TImplementor.GetFileName: String; stdcall;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
|
|
{ TDelegator }
|
|
|
|
constructor TDelegator.Create;
|
|
begin
|
|
FImplementor := TImplementor.Create(Self);
|
|
FGetFileName := FImplementor;
|
|
end;
|
|
|
|
destructor TDelegator.Destroy;
|
|
begin
|
|
FImplementor.Free;;
|
|
end;
|
|
|
|
|
|
var PIUnk: IUnknown; PIGetFileNAme: IGMGetFileName;
|
|
begin
|
|
PIUnk := TDelegator.Create;
|
|
PIUnk.QueryInterface(IGMGetFileName, PIGetFileNAme);
|
|
end.
|
|
|
|
|