|
15.02.2021, 22:25
#40045622
Ссылка:
Ссылка на сообщение:
Ссылка с названием темы:
|
|
|
|
FIX
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.
174.
175.
176.
177.
178.
179.
180.
181.
182.
183.
184.
185.
186.
187.
188.
189.
190.
191.
unit Unit2;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, rtti,
Generics.Collections, Vcl.ExtCtrls,
System.IOUtils, typinfo;
type
TForm2 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TA = class
public
constructor Create; virtual;
function Test(const A: string): Integer; overload;
function Test(const B: PWideChar): Integer; overload;
function Test(const B: PAnsiChar): Integer; overload;
end;
TB = class(TA)
public
constructor Create; overload; override;
constructor Create(const aParam: Int32); reintroduce; overload;
function Test(const A: string): Integer; overload;
function Test(const B: PWideChar): Integer; overload;
function Test(const B: PAnsiChar): Integer; overload;
end;
var
Form2: TForm2;
implementation
{$R *.dfm}
function TA.Test(const A: string): Integer;
begin
end;
function TA.Test(const B: PWideChar): Integer;
begin
end;
function TA.Test(const B: PAnsiChar): Integer;
begin
end;
constructor TA.Create;
begin
end;
constructor TB.Create;
begin
end;
function TB.Test(const A: string): Integer;
begin
end;
function TB.Test(const B: PWideChar): Integer;
begin
end;
function TB.Test(const B: PAnsiChar): Integer;
begin
end;
constructor TB.Create(const aParam: Int32);
begin
end;
type
TListMethods = TArray<TRttiMethod>;
TArgsExistList = TDictionary<string, TListMethods>;
TArgsExistListPairItem = TPair<string, TListMethods>;
function GetMethodsOnly2(base: TRttiType; var MethodsCount: Integer)
: TArgsExistList;
var
Method: TRttiMethod;
name: string;
Items: TListMethods;
i: Integer;
function IsParameterExist: Boolean;
var
A, B: TArray<TRttiParameter>;
count, i: Integer;
begin
A := Method.GetParameters;
for i := Low(Items) to High(Items) do
begin
B := Items[i].GetParameters;
count := length(A);
if count <> length(B) then
Continue;
while count > 0 do
begin
if A[count - 1].ParamType <> B[count - 1].ParamType then
Break;
dec(count);
end;
if count <= 0 then
exit(true);
end;
Result := false;
end;
begin
MethodsCount := 0;
Result := TArgsExistList.Create();
while base <> nil do
begin
for Method in base.GetDeclaredMethods do
begin
name := Method.name.ToLower;
if Result.TryGetValue(name, Items) then
if IsParameterExist then
Continue;
i := length(Items);
SetLength(Items, i + 1);
Items[i] := Method;
inc(MethodsCount);
Result.AddOrSetValue(name, Items);
end;
base := base.BaseType;
end;
end;
procedure TForm2.Button1Click(Sender: TObject);
var
r: TRttiType;
m: TRttiMethod;
List: TArgsExistList;
Item: TArgsExistListPairItem;
MethodsCount: Integer;
begin
Memo1.Lines.Clear;
r := TRttiContext.Create.GetType(TypeInfo(TB));
List := GetMethodsOnly2(r, MethodsCount);
Memo1.Lines.Add('-------------');
for Item in List do
begin
for m in Item.Value do
begin
Memo1.Lines.Add(m.ToString);
end;
Memo1.Lines.Add('-------------');
end;
Memo1.Lines.Add(MethodsCount.ToString);
List.Free;
end;
end.
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.
-------------
function ClassType: TClass
-------------
class function GetInterfaceTable: PInterfaceTable
-------------
class function InheritsFrom(AClass: TClass): Boolean
-------------
class function GetInterfaceEntry(const IID: TGUID): PInterfaceEntry
-------------
class function InstanceSize: Integer
-------------
function Test(const A: string): Integer
function Test(const B: PWideChar): Integer
function Test(const B: PAnsiChar): Integer
-------------
function SafeCallException(ExceptObject: TObject; ExceptAddr: Pointer): HRESULT
-------------
procedure AfterConstruction
-------------
class function InitInstance(Instance: Pointer): TObject
-------------
class function ClassParent: TClass
-------------
function GetHashCode: Integer
-------------
procedure Free
-------------
class function MethodAddress(const Name: ShortString): Pointer
class function MethodAddress(const Name: string): Pointer
-------------
class function QualifiedClassName: string
-------------
function GetInterface(const IID: TGUID; out Obj): Boolean
-------------
class function UnitName: string
-------------
procedure Dispatch(var Message)
-------------
constructor Create
constructor Create(const aParam: Integer)
-------------
procedure BeforeDestruction
-------------
class function ClassInfo: Pointer
-------------
class function MethodName(Address: Pointer): string
-------------
procedure CleanupInstance
-------------
procedure DefaultHandler(var Message)
-------------
function FieldAddress(const Name: ShortString): Pointer
function FieldAddress(const Name: string): Pointer
-------------
destructor Destroy
-------------
class function ClassName: string
-------------
class function NewInstance: TObject
-------------
function ToString: string
-------------
function Equals(Obj: TObject): Boolean
-------------
procedure FreeInstance
-------------
procedure DisposeOf
-------------
class function ClassNameIs(const Name: string): Boolean
-------------
class function UnitScope: string
-------------
38
|
|
|
