delphi ORM和泛型模板实现CRUD

delphi ORM和泛型模板实现CRUD

1）定义数据模型（data-model）

数据模型是ORM数据序列/还原所必需的。

?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
TTable<T: record> = record      //1个表
  rows: TArray<T>;              //表的行
end;
 
TTable2<T, T2: record> = record  //2个表
  table1: TTable<T>;             //表1
  table2: TTable<T2>;            //表2
end;
 
TTable3<T, T2, T3: record> = record  //3个表
  table1: TTable<T>;                 //表1
  table2: TTable<T2>;                //表2
  table3: TTable<T3>;                //表3
end;

　2）实现ORM CRUD泛型模板

?
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
192
193
194
195
196
197
198
199
200
/// <author>cxg 2024-3-30</author>
unit db.crud;
 
interface
 
uses
  Data.DB,
  System.Classes, System.SysUtils, serialize, yn.log, db.unidacpool, db.unidac,
  global;
 
type
  TCRUD<T: record> = record  //1个表
    dbid: string;
    func: string;
    sql: string;
    db: TDB;
    table: TTable<T>;
    req: TRequest;
    res: TResponse;
    type
      TTableModel = reference to procedure(db: TDB; table: TTable<T>; i: integer);
    procedure open(OnTableModel: TTableModel);  //查询
    procedure execsql(OnTableModel: TTableModel);  //执行事务性SQL
  end;
 
  TCRUD2<T, T2: record> = record   //2个表
    dbid: string;
    func: string;
    sqls: array of string;
    db: TDB;
    tables: TTable2<T, T2>;
    req: TRequest;
    res: TResponse;
    type
      TTableModel2 = reference to procedure(db: TDB; tables: TTable2<T, T2>; i: integer);
    procedure open(OnTableModel, OnTableModel2: TTableModel2);  //查询
    procedure execsql(OnTableModel, OnTableModel2: TTableModel2);  //执行事务性SQL
  end;
 
implementation
 
{ TCRUD<T> }
 
procedure TCRUD<T>.execsql(OnTableModel: TTableModel);
//执行事务性SQL
begin
  if req.Body = nil then
    Exit;
  var pool: TDBPool := GetDBPool(dbid);  //database pool
  db := pool.Lock;
  try
    try
      table := serialize.TSerial<TTable<T>>.unjson(TStream(req.Body));  //json string--->record
      db.startTrans;                //开启事务
      for var i: Integer := 0 to High(table.rows) do
      begin
        db.qry.Close;
        db.qry.SQL.Clear;
        db.qry.sql.add(sql);
        OnTableModel(db, table, i);  //set field value
        db.qry.ExecSQL;
      end;
      db.commitTrans;         //提交事务
      res.Send(success);
    except
      on E: Exception do
      begin
        db.rollbackTrans;     //回滚事务
        res.Send(error(E.Message));
        WriteLog(func + E.Message);
      end;
    end;
  finally
    pool.Unlock(db);
  end;
end;
 
procedure TCRUD<T>.open(OnTableModel: TTableModel);
//查询
begin
  var pool: TDBPool := GetDBPool(dbid);
  db := pool.Lock;
  try
    try
      var where: string;              //where条件
      if req.Body <> nil then
        where := TEncoding.UTF8.GetString(TBytesStream(req.Body).Bytes);
      var lsql: string;
      if where = '' then             //拼SQL查询命令
        lsql := sql
      else
        lsql := sql + ' where ' + where;
      db.select(lsql);       //查询
      SetLength(table.rows, db.qry.RecordCount);    //记录条数
      var i: Integer := 0;
      db.qry.First;                    //dataset--->record
      while not db.qry.Eof do
      begin
        OnTableModel(db, table, i);    //set field value
        db.qry.Next;
        Inc(i);
      end;
      res.Send(TSerial<TTable<T>>.json(table));   //send json string
    except
      on E: Exception do
      begin
        res.Send(error(E.Message));
        writelog(func + E.Message);
      end;
    end;
  finally
    pool.Unlock(db);
  end;
end;
 
{ TCRUD2<T, T2> }
 
procedure TCRUD2<T, T2>.execsql(OnTableModel, OnTableModel2: TTableModel2);
//2个表执行事务性SQL
begin
  if req.Body = nil then
    Exit;
  var pool: TDBPool := GetDBPool(dbid);  //database pool
  db := pool.Lock;
  try
    try
      tables := serialize.TSerial<TTable2<T, T2>>.unjson(TStream(req.Body));  //json string--->record
      db.startTrans;      //开启事务
      for var i: Integer := 0 to High(tables.table1.rows) do  //遍历table1 record
      begin
        db.qry.Close;
        db.qry.SQL.Clear;
        db.qry.sql.add(sqls[0]);
        OnTableModel(db, tables, i);    //set field value
        db.qry.ExecSQL;
      end;
      for var i: Integer := 0 to High(tables.table2.rows) do   //遍历table2 record
      begin
        db.qry.Close;
        db.qry.SQL.Clear;
        db.qry.sql.add(sqls[1]);
        OnTableModel2(db, tables, i);  //set field value
        db.qry.ExecSQL;
      end;
      db.commitTrans;     //提交事务
      res.Send(success);
    except
      on E: Exception do
      begin
        db.rollbackTrans;   //回滚事务
        res.Send(error(E.Message));
        WriteLog(func + E.Message);
      end;
    end;
  finally
    pool.Unlock(db);
  end;
end;
 
procedure TCRUD2<T, T2>.open(OnTableModel, OnTableModel2: TTableModel2);
//2个表查询
begin
  var pool: TDBPool := GetDBPool(dbid);   //database pool
  db := pool.Lock;
  try
    try
      db.select(sqls[0]);    //table1 查询
      SetLength(tables.table1.rows, db.qry.RecordCount);    //记录条数
      var i: Integer := 0;
      db.qry.First;
      while not db.qry.Eof do
      begin
        OnTableModel(db, tables, i);   //set field value
        db.qry.Next;
        Inc(i);
      end;
      db.select(sqls[1]);     //table2 查询
      SetLength(tables.table2.rows, db.qry.RecordCount);  //记录条数
      i := 0;
      db.qry.First;
      while not db.qry.Eof do
      begin
        OnTableModel2(db, tables, i);   //set field value
        db.qry.Next;
        Inc(i);
      end;
      res.Send(TSerial<TTable2<T, T2>>.json(tables));  //send json string
    except
      on E: Exception do
      begin
        res.Send(error(E.Message));
        writelog(func + E.Message);
      end;
    end;
  finally
    pool.Unlock(db);
  end;
end;
 
end.

　3）通过CRUD泛型模板实现资源（resource）数据操作

3.1）单表的

?
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
unit danwei;
/// <author>cxg 2024-1-21</author>
 
interface
 
uses
  db.crud, yn.log, danwei.model, global,
  db.unidac, system.Classes, serialize, System.SysUtils;
 
type
  TRESTdanwei = class(Trpc)  //单位的远程方法类
    procedure select(const req: TRequest; const res: TResponse);  //查询
    procedure insert(const req: TRequest; const res: TResponse);  //新增
    procedure update(const req: TRequest; const res: TResponse);  //修改
    procedure delete(const req: TRequest; const res: TResponse);  //删除
  end;
 
implementation
 
procedure TRESTdanwei.select(const req: TRequest; const res: TResponse);
//查询
begin
  var crud: TCRUD<Tdanwei>;
  crud.dbid := '1';
  crud.func := 'TRESTdanwei.select()';
  crud.req := req;
  crud.res := res;
  crud.sql := 'select * from tunit';
  crud.open(
    procedure(db: TDB; table: TTable<Tdanwei>; i: Integer)
    begin
      table.rows[i].unitid := db.qry.FieldByName('unitid').AsString;//dataset-->model
      table.rows[i].unitname := db.qry.FieldByName('unitname').AsString;
    end);
end;
 
procedure TRESTdanwei.delete(const req: TRequest; const res: TResponse);
//删除
begin
  var crud: TCRUD<Tdanwei>;
  crud.dbid := '1';
  crud.func := 'TRESTdanwei.delete()';
  crud.req := req;
  crud.res := res;
  crud.sql := 'delete from tunit where unitid=:unitid';
  crud.execsql(
    procedure(db: TDB; table: TTable<Tdanwei>; i: Integer)
    begin
      db.qry.ParamByName('unitid').AsString := table.rows[i].unitid;
    end);
end;
 
procedure TRESTdanwei.insert(const req: TRequest; const res: TResponse);
//新增
begin
  var crud: TCRUD<Tdanwei>;
  crud.dbid := '1';
  crud.func := 'TRESTdanwei.insert()';
  crud.req := req;
  crud.res := res;
  crud.sql := 'insert into tunit(unitid,unitname) values (:unitid,:unitname)';
  crud.execsql(
    procedure(db: TDB; table: TTable<Tdanwei>; i: Integer)
    begin
      db.qry.ParamByName('unitid').AsString := table.rows[i].unitid;
      db.qry.ParamByName('unitname').AsString := table.rows[i].unitname;
    end);
end;
 
procedure TRESTdanwei.update(const req: TRequest; const res: TResponse);
//修改
begin
  var crud: TCRUD<Tdanwei>;
  crud.dbid := '1';
  crud.func := 'TRESTdanwei.update()';
  crud.req := req;
  crud.res := res;
  crud.sql := 'update tunit set unitid=:unitid,unitname=:unitname where unitid=:key';
  crud.execsql(
    procedure(db: TDB; table: TTable<Tdanwei>; i: Integer)
    begin
      db.qry.ParamByName('unitid').AsString := table.rows[i].unitid;
      db.qry.ParamByName('unitname').AsString := table.rows[i].unitname;
      db.qry.ParamByName('key').AsString := table.rows[i].unitid;
    end);
end;
 
initialization
  RegisterClass(TRESTdanwei);
 
finalization
  UnRegisterClass(TRESTdanwei);
 
end.

　　3.2）多表的

?
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
unit tables ;
/// <author>cxg 2024-1-21</author>
/// 多表演示
interface
 
uses
  db.crud, yn.log, danwei.model, product.model, global,
  db.unidac, system.Classes, serialize, System.SysUtils;
 
type
  TRESTtables = class(Trpc)  //单位的远程方法类
    procedure select(const req: TRequest; const res: TResponse);  //查询
    procedure insert(const req: TRequest; const res: TResponse);  //新增
    procedure update(const req: TRequest; const res: TResponse);  //修改
    procedure delete(const req: TRequest; const res: TResponse);  //删除
  end;
 
implementation
 
procedure TRESTtables.select(const req: TRequest; const res: TResponse);
//多表查询
begin
  var crud: TCRUD2<Tdanwei, Tproduct>;
  crud.dbid := '1';
  crud.func := 'TRESTtables.select()';
  crud.req := req;
  crud.res := res;
  var sql1: string := 'select top 2 * from tunit';
  var sql2: string := 'select top 2 * from tgoods';
  crud.sqls := [sql1, sql2];
  crud.open(
    procedure(db: TDB; tables: TTable2<Tdanwei, Tproduct>; i: integer)
    begin
      tables.table1.rows[i].unitid := db.qry.FieldByName('unitid').AsString;//dataset-->model
      tables.table1.rows[i].unitname := db.qry.FieldByName('unitname').AsString;
    end,
    procedure(db: TDB; tables: TTable2<Tdanwei, Tproduct>; i: integer)
    begin
      tables.table2.rows[i].goodsid := db.qry.FieldByName('goodsid').AsString;//dataset-->model
      tables.table2.rows[i].jj := db.qry.FieldByName('jj').AsFloat;
    end);
end;
 
procedure TRESTtables.delete(const req: TRequest; const res: TResponse);
//多表删除
begin
  var crud: TCRUD2<Tdanwei, Tproduct>;
  crud.dbid := '1';
  crud.func := 'TRESTtables.delete()';
  crud.req := req;
  crud.res := res;
  var sql1: string := 'delete from tunit where unitid=:unitid';
  var sql2: string := 'delete from tgoods where goodsid=:goodsid';
  crud.sqls := [sql1, sql2];
  crud.execsql(
    procedure(db: TDB; tables: TTable2<Tdanwei, Tproduct>; i: integer)
    begin
      db.qry.ParamByName('unitid').AsString := tables.table1.rows[i].unitid;
    end,
    procedure(db: TDB; tables: TTable2<Tdanwei, Tproduct>; i: integer)
    begin
      db.qry.ParamByName('goodsid').AsString := tables.table2.rows[i].goodsid;
    end);
end;
 
procedure TRESTtables.insert(const req: TRequest; const res: TResponse);
//多表新增
begin
  var crud: TCRUD2<Tdanwei, Tproduct>;
  crud.dbid := '1';
  crud.func := 'TRESTtables.insert()';
  crud.req := req;
  crud.res := res;
  var sql1: string := 'insert into tunit(unitid,unitname) values (:unitid,:unitname)';
  var sql2: string := 'insert into tgoods(goodsid,jj) values (:goodsid,:jj)';
  crud.sqls := [sql1, sql2];
  crud.execsql(
    procedure(db: TDB; tables: TTable2<Tdanwei, Tproduct>; i: integer)
    begin
      db.qry.ParamByName('unitid').AsString := tables.table1.rows[i].unitid;
      db.qry.ParamByName('unitname').AsString := tables.table1.rows[i].unitname;
    end,
    procedure(db: TDB; tables: TTable2<Tdanwei, Tproduct>; i: integer)
    begin
      db.qry.ParamByName('goodsid').AsString := tables.table2.rows[i].goodsid;
      db.qry.ParamByName('jj').AsFloat := tables.table2.rows[i].jj;
    end);
end;
 
procedure TRESTtables.update(const req: TRequest; const res: TResponse);
//多表修改
begin
  var crud: TCRUD2<Tdanwei, Tproduct>;
  crud.dbid := '1';
  crud.func := 'TRESTtables.update()';
  crud.req := req;
  crud.res := res;
  var sql1: string := 'update tunit set unitid=:unitid,unitname=:unitname where unitid=:key';
  var sql2: string := 'update tgoods set goodsid=:goodsid,jj=:jj where goodsid=:key';
  crud.sqls := [sql1, sql2];
  crud.execsql(
    procedure(db: TDB; tables: TTable2<Tdanwei, Tproduct>; i: integer)
    begin
      db.qry.ParamByName('unitid').AsString := tables.table1.rows[i].unitid;
      db.qry.ParamByName('unitname').AsString := tables.table1.rows[i].unitname;
      db.qry.ParamByName('key').AsString := tables.table1.rows[i].unitid;
    end,
    procedure(db: TDB; tables: TTable2<Tdanwei, Tproduct>; i: integer)
    begin
      db.qry.ParamByName('goodsid').AsString := tables.table2.rows[i].goodsid;
      db.qry.ParamByName('jj').AsFloat := tables.table2.rows[i].jj;
      db.qry.ParamByName('key').AsString := tables.table2.rows[i].goodsid;
    end);
end;
 
initialization
  RegisterClass(TRESTtables);
 
finalization
  UnRegisterClass(TRESTtables);
 
end.

　　

　

　

posted @   delphi中间件  阅读(302)  评论(0)  编辑  收藏  举报
相关博文：
· delphi模板开发
· delphi orm
· Delphi 根据数据库表生成Record类型，并封装CRUD
· Dos.ORM简单说明
· Django基础 - 02Model入门
阅读排行：
· DeepSeek 开源周回顾「GitHub 热点速览」
· 物流快递公司核心技术能力-地址解析分单基础技术分享
· .NET 10首个预览版发布：重大改进与新特性概览！
· AI与.NET技术实操系列（二）：开始使用ML.NET
· 单线程的Redis速度为什么快？
历史上的今天：
2020-03-30 mormot websocket
2017-03-30 Ubuntu上安装MySQL
2017-03-30 vcl.Forms等与VCL界面有关的单元不支持跨平台
2017-03-30 vcl.Forms等与VCL界面有关的单元不支持跨平台
2017-03-30 DELPHI10.2的LINUX数据库开发环境配置
点击右上角即可分享
微信分享提示
AI FOR CODE 大赛