|
@@ -131,6 +131,11 @@ unit TypInfo;
|
|
);
|
|
);
|
|
{$pop}
|
|
{$pop}
|
|
|
|
|
|
|
|
+{$IF FPC_FULLVERSION>=30301}
|
|
|
|
+{$DEFINE HAVE_INVOKEHELPER}
|
|
|
|
+{$DEFINE HAVE_HIDDENTHUNKCLASS}
|
|
|
|
+{$ENDIF}
|
|
|
|
+
|
|
{$MINENUMSIZE DEFAULT}
|
|
{$MINENUMSIZE DEFAULT}
|
|
|
|
|
|
const
|
|
const
|
|
@@ -143,6 +148,10 @@ unit TypInfo;
|
|
TTypeKinds = set of TTypeKind;
|
|
TTypeKinds = set of TTypeKind;
|
|
ShortStringBase = string[255];
|
|
ShortStringBase = string[255];
|
|
|
|
|
|
|
|
+ {$IFDEF HAVE_INVOKEHELPER}
|
|
|
|
+ TInvokeHelper = procedure(Instance : Pointer; Args : PPointer);
|
|
|
|
+ {$ENDIF}
|
|
|
|
+
|
|
PParameterLocation = ^TParameterLocation;
|
|
PParameterLocation = ^TParameterLocation;
|
|
TParameterLocation =
|
|
TParameterLocation =
|
|
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
@@ -378,6 +387,7 @@ unit TypInfo;
|
|
property Next: PVmtMethodParam read GetNext;
|
|
property Next: PVmtMethodParam read GetNext;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+
|
|
PIntfMethodEntry = ^TIntfMethodEntry;
|
|
PIntfMethodEntry = ^TIntfMethodEntry;
|
|
TIntfMethodEntry =
|
|
TIntfMethodEntry =
|
|
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
{$ifndef FPC_REQUIRES_PROPER_ALIGNMENT}
|
|
@@ -396,6 +406,9 @@ unit TypInfo;
|
|
Kind: TMethodKind;
|
|
Kind: TMethodKind;
|
|
ParamCount: Word;
|
|
ParamCount: Word;
|
|
StackSize: SizeInt;
|
|
StackSize: SizeInt;
|
|
|
|
+ {$IFDEF HAVE_INVOKEHELPER}
|
|
|
|
+ InvokeHelper : TInvokeHelper;
|
|
|
|
+ {$ENDIF}
|
|
NamePtr: PShortString;
|
|
NamePtr: PShortString;
|
|
{ Params: array[0..ParamCount - 1] of TVmtMethodParam }
|
|
{ Params: array[0..ParamCount - 1] of TVmtMethodParam }
|
|
{ ResultLocs: PParameterLocations (if ResultType != Nil) }
|
|
{ ResultLocs: PParameterLocations (if ResultType != Nil) }
|
|
@@ -515,7 +528,9 @@ unit TypInfo;
|
|
Parent: PPTypeInfo;
|
|
Parent: PPTypeInfo;
|
|
Flags: TIntfFlagsBase;
|
|
Flags: TIntfFlagsBase;
|
|
GUID: TGUID;
|
|
GUID: TGUID;
|
|
|
|
+ {$IFDEF HAVE_HIDDENTHUNKCLASS}
|
|
ThunkClass : PPTypeInfo;
|
|
ThunkClass : PPTypeInfo;
|
|
|
|
+ {$ENDIF}
|
|
UnitNameField: ShortString;
|
|
UnitNameField: ShortString;
|
|
{ PropertyTable: TPropData }
|
|
{ PropertyTable: TPropData }
|
|
{ MethodTable: TIntfMethodTable }
|
|
{ MethodTable: TIntfMethodTable }
|
|
@@ -556,7 +571,9 @@ unit TypInfo;
|
|
Parent: PPTypeInfo;
|
|
Parent: PPTypeInfo;
|
|
Flags : TIntfFlagsBase;
|
|
Flags : TIntfFlagsBase;
|
|
IID: TGUID;
|
|
IID: TGUID;
|
|
|
|
+ {$IFDEF HAVE_HIDDENTHUNKCLASS}
|
|
ThunkClass : PPTypeInfo;
|
|
ThunkClass : PPTypeInfo;
|
|
|
|
+ {$ENDIF}
|
|
UnitNameField: ShortString;
|
|
UnitNameField: ShortString;
|
|
{ IIDStr: ShortString; }
|
|
{ IIDStr: ShortString; }
|
|
{ PropertyTable: TPropData }
|
|
{ PropertyTable: TPropData }
|
|
@@ -981,6 +998,7 @@ function GetDynArrayProp(Instance: TObject; PropInfo: PPropInfo): Pointer;
|
|
procedure SetDynArrayProp(Instance: TObject; const PropName: string; const Value: Pointer);
|
|
procedure SetDynArrayProp(Instance: TObject; const PropName: string; const Value: Pointer);
|
|
procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
|
|
procedure SetDynArrayProp(Instance: TObject; PropInfo: PPropInfo; const Value: Pointer);
|
|
|
|
|
|
|
|
+
|
|
// Extended RTTI
|
|
// Extended RTTI
|
|
function GetAttributeTable(TypeInfo: PTypeInfo): PAttributeTable;
|
|
function GetAttributeTable(TypeInfo: PTypeInfo): PAttributeTable;
|
|
|
|
|
|
@@ -988,6 +1006,10 @@ function GetPropAttribute(PropInfo: PPropInfo; AttributeNr: Word): TCustomAttrib
|
|
|
|
|
|
function GetAttribute(AttributeTable: PAttributeTable; AttributeNr: Word): TCustomAttribute;
|
|
function GetAttribute(AttributeTable: PAttributeTable; AttributeNr: Word): TCustomAttribute;
|
|
|
|
|
|
|
|
+{$IFDEF HAVE_INVOKEHELPER}
|
|
|
|
+procedure CallInvokeHelper(aTypeInfo : PTypeInfo; Instance: Pointer; const aMethod : String; aArgs : PPointer);
|
|
|
|
+{$ENDIF}
|
|
|
|
+
|
|
// Auxiliary routines, which may be useful
|
|
// Auxiliary routines, which may be useful
|
|
Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
|
|
Function GetEnumName(TypeInfo : PTypeInfo;Value : Integer) : string;
|
|
Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
|
|
Function GetEnumValue(TypeInfo : PTypeInfo;const Name : string) : Integer;
|
|
@@ -3789,5 +3811,56 @@ begin
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
+{$IFDEF HAVE_INVOKEHELPER}
|
|
|
|
+procedure CallInvokeHelper(Instance: Pointer; aMethod : PIntfMethodEntry; aArgs : PPointer);
|
|
|
|
+
|
|
|
|
+begin
|
|
|
|
+ if (aMethod=Nil) then
|
|
|
|
+ Raise EArgumentNilException.Create('Cannot call invoke helper on nil method info');
|
|
|
|
+ if (aMethod^.InvokeHelper=Nil) then
|
|
|
|
+ Raise EArgumentException.CreateFmt('Method %s has no invoke helper.',[aMethod^.Name]);
|
|
|
|
+ aMethod^.InvokeHelper(Instance,aArgs);
|
|
|
|
+end;
|
|
|
|
+
|
|
|
|
+procedure CallInvokeHelper(aTypeInfo : PTypeInfo; Instance: Pointer; const aMethod : String; aArgs : PPointer);
|
|
|
|
+
|
|
|
|
+Var
|
|
|
|
+ Data : PInterfaceData;
|
|
|
|
+ DataR : PInterfaceRawData;
|
|
|
|
+ MethodTable : PIntfMethodTable;
|
|
|
|
+ MethodEntry : PIntfMethodEntry;
|
|
|
|
+ I : Integer;
|
|
|
|
+
|
|
|
|
+begin
|
|
|
|
+ If Instance=Nil then
|
|
|
|
+ Raise EArgumentNilException.Create('Cannot call invoke helper on nil instance');
|
|
|
|
+ if not (aTypeInfo^.Kind in [tkInterface,tkInterfaceRaw]) then
|
|
|
|
+ Raise EArgumentException.Create('Cannot call invoke helper non non-interfaces');
|
|
|
|
+ // Get method table
|
|
|
|
+ if (aTypeInfo^.Kind=tkInterface) then
|
|
|
|
+ begin
|
|
|
|
+ Data:=PInterfaceData(GetTypeData(aTypeInfo));
|
|
|
|
+ MethodTable:=Data^.MethodTable;
|
|
|
|
+ end
|
|
|
|
+ else
|
|
|
|
+ begin
|
|
|
|
+ DataR:=PInterfaceRawData(GetTypeData(aTypeInfo));
|
|
|
|
+ MethodTable:=DataR^.MethodTable;
|
|
|
|
+ end;
|
|
|
|
+ // Search method in method table
|
|
|
|
+ MethodEntry:=nil;
|
|
|
|
+ I:=MethodTable^.Count-1;
|
|
|
|
+ While (MethodEntry=Nil) and (I>=0) do
|
|
|
|
+ begin
|
|
|
|
+ MethodEntry:=MethodTable^.Method[i];
|
|
|
|
+ if not SameText(MethodEntry^.Name,aMethod) then
|
|
|
|
+ MethodEntry:=Nil;
|
|
|
|
+ Dec(I);
|
|
|
|
+ end;
|
|
|
|
+ if MethodEntry=Nil then
|
|
|
|
+ Raise EArgumentException.CreateFmt('Interface %s has no method %s.',[aTypeInfo^.Name,aMethod]);
|
|
|
|
+ CallInvokeHelper(Instance,MethodEntry,aArgs);
|
|
|
|
+end;
|
|
|
|
+{$ENDIF HAVE_INVOKEHELPER}
|
|
|
|
|
|
end.
|
|
end.
|