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语言的注解：

type Person struct {
  Name    string `json:"name" xml:"name"`
  Email   string `json:"email" xml:"email"`
  Age     int    `json:"age,omitempty" xml:"age,omitempty"`
}

delphi的注解：

//用json做注解
  json = class(TCustomAttribute)
    txt: string;
  public
    constructor Create(AJson: string);
  end;
  //数据模型(data-model)
  [json('{"tablename":"goods","keyfields":"goodsid"}')]//表的注解
  TGoods = record
    [json('{"fieldname":"goodsid"}')] //字段的注解
    goodsid: string;
    [json('{"fieldname":"goodsname"}')] //字段的注解
    goodsname: string;
  end;

注解的常见用途：

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 注解+反射的样例:

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)
  [json('{"tablename":"goods","keyfields":"goodsid"}')]//表的注解
  TGoods = record
    [json('{"fieldname":"goodsid"}')] //字段的注解
    goodsid: string;
    [json('{"fieldname":"goodsname"}')] //字段的注解
    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
    [json('{"url":"v1/test","method":"get"}')]//函数的注解
    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.