paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 09:26:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* added supports helper functions for IInterface supports TClass -> TObject,Boolean

Browse Source 
git-svn-id: trunk@15086 -
This commit is contained in:
ivost 2010-03-28 11:51:38 +00:00
parent 561997e8ef
commit 7025b1ac01
2 changed files with 28 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
rtl/objpas/sysutils/intfh.inc
View File

@ -23,12 +23,16 @@
const
GUID_NULL: TGuid = '{00000000-0000-0000-0000-000000000000}';
function Supports(const Instance: IInterface; const AClass: TClass; out Obj): Boolean; overload;
function Supports(const Instance: IInterface; const IID: TGUID; out Intf): Boolean; overload;
function Supports(const Instance: TObject; const IID: TGUID; out Intf): Boolean; overload;
function Supports(const Instance: TObject; const IID: Shortstring; out Intf): Boolean; overload;
function Supports(const Instance: IInterface; const AClass: TClass): Boolean; overload;
function Supports(const Instance: IInterface; const IID: TGUID): Boolean; overload;
function Supports(const Instance: TObject; const IID: TGUID): Boolean; overload;
function Supports(const Instance: TObject; const IID: Shortstring): Boolean; overload;
function Supports(const AClass: TClass; const IID: TGUID): Boolean; overload;
function Supports(const AClass: TClass; const IID: Shortstring): Boolean; overload;

28
rtl/objpas/sysutils/sysuintf.inc
View File

@ -20,6 +20,18 @@
System Utilities For Free Pascal
}
function Supports(const Instance: IInterface; const AClass: TClass; out Obj): Boolean;
var
Getter: IImplementorGetter;
begin
if (Instance<>nil) and (Instance.QueryInterface(IImplementorGetter,Getter)=S_OK) then
begin
TObject(Obj) := Getter.GetObject;
Result := Assigned(TObject(Obj)) and (TObject(Obj).InheritsFrom(AClass));
end else
Result := False;
end;
function Supports(const Instance: IInterface; const IID: TGUID; out Intf): Boolean;
begin
Result:=(Instance<>nil) and (Instance.QueryInterface(IID,Intf)=S_OK);
@ -40,6 +52,15 @@ begin
Result:=(Instance<>nil) and Instance.GetInterface(IID,Intf);
end;
function Supports(const Instance: IInterface; const AClass: TClass): Boolean;
var
Temp: TObject;
begin
Result:=Supports(Instance,AClass,Temp);
end;
function Supports(const Instance: IInterface; const IID: TGUID): Boolean;
var
Temp: IInterface;
@ -59,6 +80,8 @@ begin
Result:=(Instance<>nil) and (Instance.GetInterfaceEntryByStr(IID)<>nil);
end;
function Supports(const AClass: TClass; const IID: TGUID): Boolean;
begin
Result:=(AClass<>nil) and (AClass.GetInterfaceEntry(IID)<>nil);
@ -70,13 +93,13 @@ begin
end;
function StringToGUID(const S: string): TGUID;
begin
if not TryStringToGUID(S, Result) then
raise EConvertError.CreateFmt(SInvalidGUID, [S]);
end;
function TryStringToGUID(const S: string; out Guid: TGUID): Boolean;
var
e: Boolean;
@ -124,7 +147,6 @@ begin
Result := e;
end;
function IsEqualGUID(const guid1, guid2: TGUID): Boolean;
var
a1,a2: PIntegerArray;
@ -137,7 +159,6 @@ begin
(a1^[3]=a2^[3]);
end;
function GuidCase(const GUID: TGUID; const List: array of TGuid): Integer;
begin
for Result := High(List) downto 0 do
@ -146,7 +167,6 @@ begin
Result := -1;
end;
function GUIDToString(const GUID: TGUID): string;
begin
SetLength(Result, 38);