盒子论坛 v2.1

unit Unit1;
/// <author>cxg 2022-7-13</author>
interface

uses   Grijjy.ProtocolBuffers, serialize,
  Data.DB, FireDAC.Stan.Intf, FireDAC.Stan.Option, server.rest.api,
  FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf,
  FireDAC.DApt.Intf, Datasnap.DBClient, FireDAC.Comp.DataSet,
  FireDAC.Comp.Client, Vcl.StdCtrls, Vcl.Controls, Vcl.Grids, Vcl.DBGrids,
  System.Classes ,vcl.forms ,  vcl.dialogs
  , system.SysUtils
  ;

type
  {$REGION '定义model'}
  Ttunit = record
    [Serialize(1)] unitid: string;
    [Serialize(2)] unitname: string;
  end;

  TtunitArray = record
    [Serialize(1)] status: integer;
    [Serialize(2)] exception: string;
    [Serialize(3)] message: string;
    [Serialize(4)] tunits: TArray<Ttunit>;
  end;

  TRes = record
    [Serialize(1)] status: integer;
    [Serialize(2)] exception: string;
    [Serialize(3)] message: string;
  end;
  {$ENDREGION}

  TForm1 = class(TForm)
    DBGrid1: TDBGrid;
    DataSource1: TDataSource;
    FDMemTable1: TFDMemTable;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button1: TButton;
    Button2: TButton;
    Button7: TButton;
    Button8: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
//新增json
begin
  var t: TtunitArray;
  SetLength(t.tunits, 1);
  t.tunits[0].Unitid := '1';
  t.tunits[0].Unitname := '新增';
  var res: string := TRest.insert<TtunitArray>('tunit', t);
  var r: TRes := TSerial.unmarshal<TRes>(res);
  if r.Status = 500 then
    ShowMessage('err: ' + r.Exception)
  else
    ShowMessage('ok');
end;

procedure TForm1.Button2Click(Sender: TObject);
//新增protobuf
begin
  var t: TtunitArray;
  SetLength(t.tunits, 1);
  t.tunits[0].Unitid := '1';
  t.tunits[0].Unitname := 'insert';
  var res: tbytes := TRest.insert2<TtunitArray>('tunit', t);
  var r: TRes := TSerial.unmarshal<TRes>(res);
  if r.Status = 500 then
    ShowMessage('err: ' + r.Exception)
  else
    ShowMessage('ok');
end;

procedure TForm1.Button3Click(Sender: TObject);
//修改json
begin
  var t: TtunitArray;
  SetLength(t.tunits, 1);
  t.tunits[0].Unitid := '1';
  t.tunits[0].Unitname := '修改';
  var res: string := TRest.update<TtunitArray>('tunit', t);
  var r: TRes := TSerial.unmarshal<TRes>(res);
  if r.Status = 500 then
    ShowMessage('err: ' + r.Exception)
  else
    ShowMessage('ok');
end;

procedure TForm1.Button4Click(Sender: TObject);
//修改protobuf
begin
  var t: TtunitArray;
  SetLength(t.tunits, 1);
  t.tunits[0].Unitid := '1';
  t.tunits[0].Unitname := 'update';
  var res: tbytes := TRest.update2<TtunitArray>('tunit', t);
  var r: TRes := TSerial.unmarshal<TRes>(res);
  if r.Status = 500 then
    ShowMessage('err: ' + r.Exception)
  else
    ShowMessage('ok');
end;

procedure TForm1.Button5Click(Sender: TObject);
//json查询
begin
  var t: TtunitArray := TRest.select<TtunitArray>('tunit');
  if t.Status = 500 then
  begin
    ShowMessage(t.Exception);
    Exit;
  end;
  FDMemTable1.EmptyDataSet;
  FDMemTable1.DisableControls;
  for var dw: Ttunit in t.tunits do
    FDMemTable1.AppendRecord([dw.Unitid, dw.Unitname]);
  FDMemTable1.First;
  FDMemTable1.EnableControls;
end;

procedure TForm1.Button6Click(Sender: TObject);
//PROTOBUF查询
begin
  var t: TtunitArray := TRest.select2<TtunitArray>('tunit');
  if t.Status = 500 then
  begin
    ShowMessage(t.Exception);
    Exit;
  end;
  FDMemTable1.EmptyDataSet;
  FDMemTable1.DisableControls;
  for var dw: Ttunit in t.tunits do
    FDMemTable1.AppendRecord([dw.Unitid, dw.Unitname]);
  FDMemTable1.First;
  FDMemTable1.EnableControls;
end;

procedure TForm1.Button7Click(Sender: TObject);
//删除json
begin
  var res: string := TRest.delete('tunit', 'unitid=''1''');
  var r: TRes := TSerial.unmarshal<TRes>(res);
  if r.Status = 500 then
    ShowMessage('err: ' + r.Exception)
  else
    ShowMessage('ok');
end;

procedure TForm1.Button8Click(Sender: TObject);
//删除protobuf
begin
  var res: TBytes := TEncoding.UTF8.GetBytes(TRest.delete2('tunit', 'unitid=''1'''));
  var r: TRes := TSerial.unmarshal<TRes>(res);
  if r.Status = 500 then
    ShowMessage('err: ' + r.Exception)
  else
    ShowMessage('ok');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FDMemTable1.FieldDefs.Add('unitid', ftString, 9);
  FDMemTable1.FieldDefs.Add('unitname', ftString, 9);
  FDMemTable1.CreateDataSet;
end;

end.

此帖子包含附件:hnxxcxg_202282673549.zip 大小:121.2K

----------------------------------------------
中间件QQ群: 92449782 博客: http://www.cnblogs.com/hnxxcxg/

作者：

a5824 (Return)	★☆☆☆☆	-
	普通会员

2022/8/27 9:56:53

1楼：

前面带 [Serialize(1)] 这个是啥意思？
----------------------------------------------
-

作者：

zhyhero (zhyhero)	★☆☆☆☆	-
	盒子活跃会员

2022/8/27 10:54:17

2楼：

https://docwiki.embarcadero.com/Libraries/Sydney/en/System.TCustomAttribute

一个类，继承自TCustomAttribute
通过RTTI方法可以读取他括号里的属性值，然后......
----------------------------------------------
z@S7

作者：

hnxxcxg (咏南中间件)	★☆☆☆☆	-
	盒子活跃会员

2022/8/27 11:14:24

3楼：

DELPHI不知从哪个版本开始支持注解，但很有用。

unit server.Resources.tunit;
//代码由代码工厂自动生成
//2022-08-27
interface

uses
  System.SysUtils, WiRL.Core.Registry, WiRL.Core.Attributes,  WiRL.Core.MessageBody.Default,
  WiRL.http.Accept.MediaType;

type
  Ttunit = record
    [Serialize(1)] unitid: string;
    [Serialize(2)] unitname: string;
  end;

  TtunitArray = record
    [Serialize(1)] status: integer;
    [Serialize(2)] exception: string;
    [Serialize(3)] message: string;
    [Serialize(4)] tunits: TArray<Ttunit>;
  end;

  TRes = record
    [Serialize(1)] status: integer;
    [Serialize(2)] exception: string;
    [Serialize(3)] message: string;
  end;

  [Path('tunit')]
  TtunitAPI = class
    [get, path('/{where}'), Produces(TMediaType.APPLICATION_JSON)]
    function select([PathParam('where')] where: string): TtunitArray; virtual; abstract;
    [post, Consumes(TMediaType.APPLICATION_JSON), Produces(TMediaType.APPLICATION_JSON)]
    function insert([BodyParam] body: TtunitArray): TRes; virtual; abstract;
    [put, Consumes(TMediaType.APPLICATION_JSON), Produces(TMediaType.APPLICATION_JSON)]
    function update([BodyParam] body: TtunitArray): TRes; virtual; abstract;
    [delete, path('/{where}'), Produces(TMediaType.APPLICATION_JSON)]
    function delete([PathParam('where')] where: string): TRes; virtual; abstract;
  end;

implementation

initialization
  TWiRLResourceRegistry.Instance.RegisterResource<TtunitAPI>;

end.
----------------------------------------------
中间件QQ群: 92449782 博客: http://www.cnblogs.com/hnxxcxg/

作者：

zhyhero (zhyhero)	★☆☆☆☆	-
	盒子活跃会员

2022/8/27 11:26:03

4楼：

好像是2009,那个版本RTTI升级了
确实很有用

[TableName('Test')]
TTest=class(TPersistent)
private
  fID:integer;
  fName:String;
  fDate:TDateTime;
published
  [PrimaryKey]
  property ID:integer read fID write fID;
  [Len(50)]
  property Name:stirng read fName write fName;
  [SaveAsString,Nullable]
  proeprty Date:TDateTime read fDate write fDate;
end;
----------------------------------------------
z@S7

作者：

ksrsoft (cb168)	★☆☆☆☆	-
	普通会员

2022/8/27 11:43:14

5楼：

这个厉害，比较流行
----------------------------------------------
-

信息

登陆以后才能回复