1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
|
program MultiIntfDelegation;
{$mode objfpc}{$h+}
type
IGMGetHandle = interface(IUnknown)
['{5BB45961-15A9-11d5-A5E4-00E0987755DD}']
function GetHandle: THandle; stdcall;
property Handle: THandle read GetHandle;
end;
IGMGetFileName = interface(IUnknown)
['{D3ECCB42-A563-4cc4-B375-79931031ECBA}']
function GetFileName: String; stdcall;
property FileName: String read GetFileName;
end;
IGMGetSetFileName = Interface(IGMGetFileName)
['{ECFB879F-86F6-41a3-A685-0C899A2B5BCA}']
procedure SetFileName(const Value: String); stdcall;
property FileName: String read GetFileName write SetFileName;
end;
{ TImplementor }
TImplementor = class(TObject, IGMGetHandle, IGMGetFileName, IGMGetSetFileName)
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;
procedure SetFileName(const Value: String); stdcall;
end;
{ TIntfDelegator }
TIntfDelegator = class(TInterfacedObject, IGMGetFileName, IGMGetSetFileName)
protected
FImplementor: TImplementor;
FGetSetFileName: IGMGetSetFileName;
public
constructor Create;
destructor Destroy; override;
//
// This would be nice. NOTE: IGMGetFileName is derived from IGMGetSetFileName!
//
property Implementor: IGMGetSetFileName read FGetSetFileName implements IGMGetFileName, IGMGetSetFileName;
end;
{ TObjDelegator }
TObjDelegator = class(TInterfacedObject, IGMGetHandle, IGMGetFileName, IGMGetSetFileName)
protected
FImplementor: TImplementor;
public
constructor Create;
destructor Destroy; override;
//
// This would be really smart!
//
property Implementor: TImplementor read FImplementor implements IGMGetHandle, IGMGetFileName, IGMGetSetFileName;
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
writeln('TImplementor.GetHandle');
Result := 0;
end;
function TImplementor.GetFileName: String; stdcall;
begin
writeln('TImplementor.GetFileName');
Result := '';
end;
procedure TImplementor.SetFileName(const Value: String); stdcall;
begin
writeln('TImplementor.SetFileName');
end;
{ TIntfDelegator }
constructor TIntfDelegator.Create;
begin
FImplementor := TImplementor.Create(Self);
FGetSetFileName := FImplementor;
end;
destructor TIntfDelegator.Destroy;
begin
FImplementor.Free;
inherited Destroy;
end;
{ TObjDelegator }
constructor TObjDelegator.Create;
begin
FImplementor := TImplementor.Create(Self);
end;
destructor TObjDelegator.Destroy;
begin
FImplementor.Free;
inherited Destroy;
end;
var
PIUnk: IUnknown;
PIGetFileNAme: IGMGetFileName;
PIGetSetFileName: IGMGetSetFileName;
obj: TObjDelegator;
begin
PIUnk := TIntfDelegator.Create;
PIUnk.QueryInterface(IGMGetFileName, PIGetFileName);
PIGetFileName.GetFileName;
PIUnk.QueryInterface(IGMGetSetFileName, PIGetSetFileName);
PIGetSetFileName.SetFileName('');
obj := TObjDelegator.Create;
(obj as IGMGetFileName).GetFileName;
(obj as IGMGetSetFileName).SetFileName('');
(obj as IGMGetHandle).GetHandle;
end.
|
