Recent

Author Topic: RTTI get procedure prototype  (Read 28143 times)

MiniApp

  • New Member
  • *
  • Posts: 10
RTTI get procedure prototype
« on: September 15, 2017, 07:01:57 pm »
Hi !

I would like introspect published methods of a TPersistent. I need to know the procedure list name and her parameters and results.

Anyone know how to do this ?

Thanks
French and under the latest Ubuntu ;-p !

ASerge

  • Hero Member
  • *****
  • Posts: 2222
Re: RTTI get procedure prototype
« Reply #1 on: September 15, 2017, 07:55:15 pm »
TPersistent has no published properties, only its successors.
If you need an example of getting published properties for an object, then please:
Code: Pascal  [Select][+][-]
  1. uses TypInfo;
  2.  
  3. {$R *.lfm}
  4.  
  5. type
  6.   TPropertyEnumProc = procedure(Sender: TObject; PropInfo: PPropInfo;
  7.     Storage: TStrings);
  8.  
  9. procedure EnumProps(Obj: TObject; WithStorage: TStrings;
  10.   Proc: TPropertyEnumProc);
  11. const
  12.   CValidKinds = [tkInteger, tkEnumeration, tkSet, tkLString, tkAString,
  13.     tkWString, tkBool, tkInt64, tkUString, tkPointer];
  14. var
  15.   PropList: PPropList;
  16.   PropInfo: PPropInfo;
  17.   PropCount, i: Integer;
  18. begin
  19.   if (Obj = nil) or (WithStorage = nil) or not Assigned(Proc) then
  20.     Exit;
  21.   PropCount := GetPropList(Obj, PropList);
  22.   if PropCount > 0 then
  23.   try
  24.     for i := 0 to PropCount - 1 do
  25.     begin
  26.       PropInfo := PropList^[i];
  27.       if (PropInfo <> nil) and (PropInfo^.PropType^.Kind in CValidKinds) then
  28.         Proc(Obj, PropInfo, WithStorage);
  29.     end;
  30.   finally
  31.     FreeMem(PropList);
  32.   end;
  33. end;
  34.  
  35. function PropFullName(Obj: TObject; PropInfo: PPropInfo): string;
  36. begin
  37.   Result := Format('%s.%s', [Obj.ClassName, PropInfo^.Name]);
  38. end;
  39.  
  40. procedure WritePropValueToStorage(Sender: TObject; PropInfo: PPropInfo;
  41.   Storage: TStrings);
  42. var
  43.   Value: string;
  44. begin
  45.   if not Assigned(PropInfo^.GetProc) then
  46.     Exit;
  47.   case PropInfo^.PropType^.Kind of
  48.     tkInteger, tkInt64, tkBool:
  49.       Value := IntToStr(GetOrdProp(Sender, PropInfo));
  50.     tkEnumeration:
  51.       Value := GetEnumProp(Sender, PropInfo);
  52.     tkSet:
  53.       Value := GetSetProp(Sender, PropInfo, True);
  54.     tkLString, tkAString:
  55.       Value := GetStrProp(Sender, PropInfo);
  56.     tkWString:
  57.       Value := UTF8Encode(GetWideStrProp(Sender, PropInfo));
  58.     tkUString:
  59.       Value := UTF8Encode(GetUnicodeStrProp(Sender, PropInfo));
  60.   else
  61.      Value := '';
  62.   end;
  63.   Storage.Values[PropFullName(Sender, PropInfo)] := Value;
  64. end;
  65.  
  66. procedure TForm1.FormCreate(Sender: TObject);
  67. begin
  68.   Memo1.Clear;
  69.   EnumProps(Self, Memo1.Lines, @WritePropValueToStorage);
  70. end;

MiniApp

  • New Member
  • *
  • Posts: 10
Re: RTTI get procedure prototype
« Reply #2 on: September 16, 2017, 10:47:39 am »
Thank for the answer but it's not what I would like do.
In this class
Code: Pascal  [Select][+][-]
  1.   TPersistentSub = class(TPersistent)
  2.     public
  3.       procedure HiProc(Message:string);
  4.       function HoProc:string;
  5.     published
  6.       function Proc(Param1:boolean;Spec:integer):string;
  7.       property Pro:string read HoProc write HiProc;
  8. end;  
I would like get the prototype of Proc.
Since yesterday I have progress.
Code: Pascal  [Select][+][-]
  1. uses TypInfo;
  2. type
  3.   tmethodnamerec = packed record
  4.     name : pshortstring;
  5.     addr : codepointer;
  6. end;
  7.   tmethodnametable = packed record
  8.     count : dword;
  9.     entries : packed array[0..0] of tmethodnamerec;
  10. end;
  11.   pmethodnametable =  ^tmethodnametable;
  12. procedure EnumVmt(const Obj:TObject;WithStorage:TStrings);
  13. var
  14.   methodtable :pmethodnametable;
  15.   i,o : dword;
  16.   ovmt : PVmt;
  17.   Tmp:string;
  18. type
  19.   PProcedureSignature = ^TProcedureSignature;
  20. begin
  21.   ovmt:=PVmt(Obj.ClassType);
  22.   if assigned(ovmt) then
  23.     begin
  24.       methodtable:=pmethodnametable(ovmt^.vMethodTable);
  25.         if assigned(methodtable) then
  26.           begin
  27.             for i:=0 to methodtable^.count-1 do
  28.               begin
  29.                 Tmp := methodtable^.entries[i].name^;
  30.                 {with PProcedureSignature(methodtable^.entries[i].addr)^ do
  31.                   begin
  32.                     Tmp := Tmp+'(';
  33.                     for o := 0 to ParamCount-1 do
  34.                       Tmp := Tmp+GetParam(o)^.Name+';';
  35.                     SetLength(Tmp,Length(Tmp)-1);
  36.                     Tmp := Tmp+')'+ResultType^.Name+';';
  37.                   end;}
  38.                 WithStorage.Add(Tmp);
  39.               end;
  40.         end;
  41.     end;
  42. end;
I can list and get name of published procs. But currently I don't know how to retreive the procedure signature.
French and under the latest Ubuntu ;-p !

ASerge

  • Hero Member
  • *****
  • Posts: 2222
Re: RTTI get procedure prototype
« Reply #3 on: September 16, 2017, 04:49:54 pm »
I think for methods this information is not saved. For the properties of events is preserved, but apparently it's not what you wanted:
Code: Pascal  [Select][+][-]
  1. uses TypInfo;
  2.  
  3. {$R *.lfm}
  4.  
  5. type
  6.   TPropertyEnumProc = procedure(Sender: TObject; PropInfo: PPropInfo;
  7.     Storage: TStrings);
  8.  
  9. procedure EnumProps(Obj: TObject; WithStorage: TStrings;
  10.   Proc: TPropertyEnumProc);
  11. const
  12.   CValidKinds = [tkMethod];
  13. var
  14.   PropList: PPropList;
  15.   PropInfo: PPropInfo;
  16.   PropCount, i: Integer;
  17. begin
  18.   if (Obj = nil) or (WithStorage = nil) or not Assigned(Proc) then
  19.     Exit;
  20.   PropCount := GetPropList(Obj, PropList);
  21.   if PropCount > 0 then
  22.   try
  23.     for i := 0 to PropCount - 1 do
  24.     begin
  25.       PropInfo := PropList^[i];
  26.       if (PropInfo <> nil) and (PropInfo^.PropType^.Kind in CValidKinds) then
  27.         Proc(Obj, PropInfo, WithStorage);
  28.     end;
  29.   finally
  30.     FreeMem(PropList);
  31.   end;
  32. end;
  33.  
  34. function ExtractName(var Buf: Pointer): ShortString;
  35. begin
  36.   SetLength(Result, Byte(Buf^));
  37.   Inc(Buf, 1);
  38.   if Length(Result) > 0 then
  39.   begin
  40.     Move(Buf^, Result[1], Length(Result));
  41.     Inc(Buf, Length(Result));
  42.   end;
  43. end;
  44.  
  45. function ExtractParam(var Buf: Pointer): string;
  46. var
  47.   ParamType: record
  48.     Flags: TParamFlags;
  49.     ParamName: ShortString;
  50.     TypeName: ShortString;
  51.   end;
  52. begin
  53.   ParamType.Flags := TParamFlags(Pointer(Buf)^);
  54.   Inc(Buf, SizeOf(TParamFlags));
  55.   ParamType.ParamName := ExtractName(Buf);
  56.   ParamType.TypeName := ExtractName(Buf);
  57.   Result := '';
  58.   if pfVar in ParamType.Flags then
  59.     Result := 'var '
  60.   else
  61.     if pfConst in ParamType.Flags then
  62.       Result := 'const '
  63.     else
  64.       if pfOut in ParamType.Flags then
  65.         Result := 'out ';
  66.   Result := Result + ParamType.ParamName + ': ' + ParamType.TypeName;
  67. end;
  68.  
  69. procedure WritePropValueToStorage(Sender: TObject; PropInfo: PPropInfo;
  70.   Storage: TStrings);
  71. const
  72.   CMethodKind: array[mkProcedure..mkFunction] of string =
  73.     ('procedure ', 'function ');
  74. var
  75.   TypeData: PTypeData;
  76.   S: string;
  77.   i, ParamCount: Integer;
  78.   Buf: Pointer;
  79. begin
  80.   if not Assigned(PropInfo^.GetProc) then
  81.     Exit;
  82.   case PropInfo^.PropType^.Kind of
  83.     tkMethod:
  84.       begin
  85.         TypeData := GetTypeData(PropInfo^.PropType);
  86.         if TypeData^.MethodKind in [Low(CMethodKind)..High(CMethodKind)] then
  87.         begin
  88.           S := CMethodKind[TypeData^.MethodKind];
  89.           S := S + PropInfo^.Name;
  90.           Buf := @TypeData^.ParamList;
  91.           ParamCount := TypeData^.ParamCount;
  92.           if ParamCount > 0 then
  93.           begin
  94.             S := S + '(';
  95.             for i := 1 to ParamCount - 1 do
  96.               S := S + ExtractParam(Buf) + '; ';
  97.             S := S + ExtractParam(Buf) + ')';
  98.             if TypeData^.MethodKind = mkFunction then
  99.               S := S + ': ' + ExtractName(Buf);
  100.             S := S + ';';
  101.           end;
  102.           Storage.Append(S);
  103.         end;
  104.       end;
  105.   end;
  106. end;
  107.  
  108. procedure TForm1.FormCreate(Sender: TObject);
  109. begin
  110.   Memo1.Clear;
  111.   EnumProps(Self, Memo1.Lines, @WritePropValueToStorage);
  112. end;

howardpc

  • Hero Member
  • *****
  • Posts: 4144
Re: RTTI get procedure prototype
« Reply #4 on: September 17, 2017, 03:45:26 pm »
I think for methods this information is not saved. For the properties of events is preserved, but apparently it's not what you wanted:

You may be right about RTTI for methods. After all they are not (ever?) published, and it is not clear why publishing them would add anything, unless it were to gain access to the sort of information the OP is after. But that would be a sledgehammer to crack a nut.
In terms of code, only method pointers (event properties) are normally published.
Method information may nevertheless be accessible.
The TypInfo unit does not provide a GetMethodList analogue to GetPropList.
So if the data is stored and accessible you would have to poke around the VMT unaided, and it is not obvious where any method typeinfo data is stored (if it is).

BTW, I think for completeness your ExtractParam function should be
Code: Pascal  [Select][+][-]
  1. function ExtractParam(var Buf: Pointer): string;
  2. var
  3.   ParamType: record
  4.     Flags: TParamFlags;
  5.     ParamName: ShortString;
  6.     TypeName: ShortString;
  7.   end;
  8. begin
  9.   ParamType.Flags := TParamFlags(Pointer(Buf)^);
  10.   Inc(Buf, SizeOf(TParamFlags));
  11.   ParamType.ParamName := ExtractName(Buf);
  12.   ParamType.TypeName := ExtractName(Buf);
  13.   Result := '';
  14.   if pfVar in ParamType.Flags then
  15.     Result := 'var '
  16.   else
  17.     if pfConst in ParamType.Flags then
  18.       Result := 'const '
  19.     else
  20.       if pfOut in ParamType.Flags then
  21.         Result := 'out '
  22.       else
  23.         if pfArray in ParamType.Flags then
  24.           Result := ' array of ';
  25.   Result := Result + ParamType.ParamName + ': ' + ParamType.TypeName;
  26. end;

MiniApp

  • New Member
  • *
  • Posts: 10
Re: RTTI get procedure prototype
« Reply #5 on: September 24, 2017, 04:31:08 pm »
Thanks for your answers (sorry for the long time before reply...).
Then... I can't do what I want do :o ! While searching I have look somethings about interfaces but I abort this way.
For why I need it... I am trying to make for the fun a high-level dbus implementation :). And the RTTI things was for a automatic dbus introspection and invocation of interfaces. To store proc... I will provide a simple TCollection.
French and under the latest Ubuntu ;-p !

PascalDragon

  • Hero Member
  • *****
  • Posts: 5446
  • Compiler Developer
Re: RTTI get procedure prototype
« Reply #6 on: September 29, 2017, 10:06:12 pm »
If you use trunk you can do this with interfaces. See e.g. $fpcdir/tests/test/trtti15.pp for an example.

MiniApp

  • New Member
  • *
  • Posts: 10
[SOLVED] RTTI get procedure prototype
« Reply #7 on: September 30, 2017, 08:22:15 am »
Great job ! It's exactly the kind I was would like to do :D !
French and under the latest Ubuntu ;-p !

 

TinyPortal © 2005-2018