delphi 注解+反射

爱的心痛 發表於 2025-5-20 12:04:00

delphi 通过注解+反射，可以实现数据的ORM编程，不再需要DATASET。
注解：是一种RTTI。
始创于java，go/c#/java/delphi。。。目前都支持注解。
RTTI对程序性能的影响：https://www.cnblogs.com/hnxxcxg/p/19660714
go语言的注解：
<div class="cnblogs_code">
<pre>type Person struct {
Name string `json:"name" xml:"name"`
Email string `json:"email" xml:"email"`
Age int `json:"age,omitempty" xml:"age,omitempty"`
}</pre>
</div>
delphi的注解：
<div class="cnblogs_code">
<pre>//用json做注解
json = class(TCustomAttribute)
txt: string;
public
constructor Create(AJson: string);
end;
//数据模型(data-model)
//表的注解
TGoods = record
//字段的注解
goodsid: string;
//字段的注解
goodsname: string;
end;</pre>
</div>
 注解的常见用途：
1）序列化和反序列化：
注解常被用于控制结构体的序列化和反序列化。例如，在 Go 的 encoding/json 和 encoding/xml 包中，你可以使用注解来指定字段在 JSON 或 XML 中的名称，或者在编码时是否忽略某个字段。这可以让你有更大的灵活性来定义和控制序列化和反序列化的过程。
2）数据验证：
一些库允许你使用注解来为结构体的字段添加验证规则。例如，你可以使用 valid 注解来指定一个字段必须是邮件地址格式，或者使用 range 注解来指定一个整数字段的值必须在某个范围内。这些库通常提供了一套简洁的 DSL（领域特定语言）让你可以在注解中定义复杂的验证规则。
3）数据库 ORM 映射：
有些数据库 ORM（对象关系映射）库允许你使用注解来定义数据库表和结构体之间的映射关系。例如，你可以使用 sql 注解来指定字段对应的数据库列的名称，或者一个字段是否可以为 null。
4）HTTP 路由和处理：
在某些 Web 框架中，标签可以被用来定义 HTTP 路由规则或者请求处理逻辑。例如，你可以使用 route 注解来指定一个方法处理哪个 URL 路径的请求，或者使用 method 注解来指定一个方法处理哪种 HTTP 方法的请求。
delphi 注解+反射的样例:
 
<div class="cnblogs_code">
<pre>unit Unit1;

interface

uses Rtti, core.json,
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
//用json做注解
json = class(TCustomAttribute)
txt: string;
public
constructor Create(AJson: string);
end;
//数据模型(data-model)
//表的注解
TGoods = record
//字段的注解
goodsid: string;
//字段的注解
goodsname: string;
end;
//注解+反射自动生成记录的CRUD
TCrud<T> = record
class var aRecord: T;//a record
class function select: string; static;
class function insert: string; static;
class function delete: string; static;
class function update: string; static;
private
//处理record.field.value
class function ProcessFieldValue(const ARttiField: TRttiField): string; static;
end;
//远程服务方法
TService1 = class
//函数的注解
 procedure proc1;
end;
//路由服务方法
TRouter<T> = record
class var service: TObject;
class procedure route(const FUrl: string; const FMethod: string); static;
end;

TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
Button4: TButton;
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

constructor json.Create(AJson: string);
begin
txt := AJson;
end;

class function TCrud<T>.Update: string;
var
LRttiContext: TRttiContext;
LRttiType: TRttiType;
LRttiField: TRttiField;
LTableAttribute, LFieldAttribute: TCustomAttribute;
LTableName, LWhere, LFieldName, LValue, LKeyFields, LSet: string;
LJsonO: JO;
begin
LRttiContext := TRttiContext.Create;
try
LRttiType := LRttiContext.GetType(TypeInfo(T));
LTableAttribute := LRttiType.GetAttribute<json>;
LJsonO := SO(json(LTableAttribute).txt);
LTableName := LJsonO.S['tablename']; // 表名
LKeyFields := LJsonO.S['keyfields']; // 主键
 FreeAndNil(LJsonO);
LValue := '';
LWhere := '';
LSet := '';
for LRttiField in LRttiType.GetFields do
begin
 LFieldAttribute := LRttiField.GetAttribute<json>;
 LJsonO := SO(json(LFieldAttribute).txt);
 LFieldName := LJsonO.S['fieldname']; // 字段名
 FreeAndNil(LJsonO);
 LValue := ProcessFieldValue(LRttiField);
 LSet := LSet + ',' + LFieldName + '=' + LValue;
 if Pos(LFieldName, LKeyFields) = 0 then
 Continue; // 非主键不做where条件
 LWhere := LWhere + ' and ' + LFieldName + '=' + LValue; // 拼where条件
 if LWhere = '' then
 begin
 Result := '';
 ShowMessage('没有where条件');
 Exit;
 end;
end;
System.Delete(LWhere, 1, 4);
System.Delete(LSet, 1, 1);
Result := 'update ' + LTableName + ' set ' + LSet + ' where ' + LWhere;
finally
LRttiContext.Free;
end;
end;

class function TCrud<T>.Delete: string;
begin
var LRttiContext: TRttiContext := TRttiContext.Create;
try
var LRttiType: TRttiType := LRttiContext.GetType(TypeInfo(T));
var LTableAttribute: TCustomAttribute := LRttiType.GetAttribute<json>;
var LJsonO: JO := SO(json(LTableAttribute).txt);
var LTableName: string := LJsonO.S['tablename']; // 表名
var LKeyFields: string := LJsonO.S['keyfields']; // 主键
 FreeAndNil(LJsonO);
var LValue: string := '';
var LWhere: string := '';
for var LRttiField: TRttiField in LRttiType.GetFields do
begin
 var LFieldAttribute: TCustomAttribute := LRttiField.GetAttribute<json>;
 LJsonO := SO(json(LFieldAttribute).txt);
 var LFieldName: string := LJsonO.S['fieldname']; // 字段名
 if Pos(LFieldName, LKeyFields) = 0 then // 非主键不做where条件
 begin
 FreeAndNil(LJsonO);
 Continue;
 end;
 FreeAndNil(LJsonO);
 LValue := ProcessFieldValue(LRttiField);
 LWhere := LWhere + ' and ' + LFieldName + '=' + LValue; // 拼where条件
 if LWhere = '' then
 begin
 Result := '';
 ShowMessage('没有where条件');
 Exit;
 end;
end;
System.Delete(LWhere, 1, 4);
Result := 'delete from ' + LTableName + ' where ' + LWhere;
finally
LRttiContext.Free;
end;
end;

class function TCrud<T>.Insert: string;
var
LRttiContext: TRttiContext;
LRttiType: TRttiType;
LRttiField: TRttiField;
LTableAttribute, LFieldAttribute: TCustomAttribute;
LTableName: string;
LJsonO: JO;
LFields, LValues, LValue: string;
begin
LRttiContext := TRttiContext.Create;
try
LRttiType := LRttiContext.GetType(TypeInfo(T));
LTableAttribute := LRttiType.GetAttribute<json>;
LJsonO := SO(json(LTableAttribute).txt);
LTableName := LJsonO.S['tablename']; // 表名
 FreeAndNil(LJsonO);
LFields := '';
LValues := '';
LValue := '';
for LRttiField in LRttiType.GetFields do
begin
 LFieldAttribute := LRttiField.GetAttribute<json>;
 LJsonO := SO(json(LFieldAttribute).txt);
 LFields := LFields + ',' + LJsonO.S['fieldname']; // 拼字段
 FreeAndNil(LJsonO);
 LValue := ProcessFieldValue(LRttiField);
 LValues := LValues + ',' + LValue; // 拼值
 end;
System.Delete(LFields, 1, 1);
System.Delete(LValues, 1, 1);
Result := 'insert into ' + LTableName + '(' + LFields + ') values (' +
 LValues + ')';
finally
LRttiContext.Free;
end;
end;

class function TCrud<T>.ProcessFieldValue(const ARttiField: TRttiField): string;
begin
if (@aRecord = nil) or (ARttiField = nil) then
Exit;
if ARttiField.FieldType.ToString = 'TDateTime' then
Result := FormatDateTime('yyyy-mm-dd hh:nn:ss',
 ARttiField.GetValue(@aRecord).AsType<TDateTime>)
else if ARttiField.FieldType.ToString = 'TDate' then
Result := FormatDateTime('yyyy-mm-dd', ARttiField.GetValue(@aRecord)
 .AsType<TDate>)
else if ARttiField.FieldType.ToString = 'TTime' then
Result := FormatDateTime('hh:nn:ss', ARttiField.GetValue(@aRecord)
 .AsType<TTime>)
else
Result := ARttiField.GetValue(@aRecord).ToString;
if (ARttiField.FieldType.ToString = 'string') or
(ARttiField.FieldType.ToString = 'TDateTime') or
(ARttiField.FieldType.ToString = 'TDate') or
(ARttiField.FieldType.ToString = 'TTime') then
Result := QuotedStr(Result);
end;

class function TCrud<T>.select: string;
begin
var LRttiContext: TRttiContext := TRttiContext.Create;
try
var LRttiType: TRttiType := LRttiContext.GetType(TypeInfo(T));
var LTableAttribute: TCustomAttribute := LRttiType.GetAttribute<json>;
var LJsonObj: JO := SO(json(LTableAttribute).txt);
var LTableName: string := LJsonObj.S['tablename'];
LJsonObj.Free;
Result := 'select * from ' + LTableName;
finally
LRttiContext.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
TCrud<TGoods>.aRecord.goodsid := '666';
Memo1.Text := TCrud<TGoods>.delete;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
TCrud<TGoods>.aRecord.goodsid := '666';
TCrud<TGoods>.aRecord.goodsname := '商品一';
Memo1.Text := TCrud<TGoods>.Insert;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
TCrud<TGoods>.aRecord.goodsid := '666';
TCrud<TGoods>.aRecord.goodsname := '修改';
Memo1.Text := TCrud<TGoods>.Update;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
TRouter<TService1>.service := TService1.Create;
TRouter<TService1>.route('v1/test', 'get');
TRouter<TService1>.service.Free;
end;

procedure TService1.proc1;
begin
ShowMessage('hi');
end;

{ TRouter<T> }

class procedure TRouter<T>.route(const FUrl: string; const FMethod: string);
begin
var LContext: TRttiContext := TRttiContext.Create;
try
var LRttiType: TRttiType := LContext.GetType(TypeInfo(T));
for var LRttiMethod: TRttiMethod in LRttiType.GetMethods do
begin
 var LAttribute: TCustomAttribute := LRttiMethod.GetAttribute<json>;
 var LJsonObject: JO := SO(json(LAttribute).txt);
 if (FUrl = LJsonObject.S['url']) and (FMethod = LJsonObject.S['method']) then
 begin
 if Assigned(LRttiMethod) then
 LRttiMethod.Invoke(service, []); //call rpc
 Exit;
 end;
 LJsonObject.Free;
end;
finally
LContext.Free;
end;
end;

end.</pre>
</div>
 

</div>
<div id="MySignature" role="contentinfo">
本文来自博客园，作者：{咏南中间件}，转载请注明原文链接：https://www.cnblogs.com/hnxxcxg/p/18886555 
来源：https://www.cnblogs.com/hnxxcxg/p/18886555

頁: [1]

琼殿技术论坛's Archiver

delphi 注解+反射