delphi模板开发

delphi模板开发

用模板开发，写代码就是填空题。

让开发变为填空题，这也是AI开发的指导思想。

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
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
/// <author>cxg 2023-10-9</author>
unit db.crud;
 
interface
 
uses
  System.Classes, System.SysUtils, serialize, yn.log, db.unidacpool, db.unidac,
  global;
 
type
  TCRUD<T: record> = record
    dbid: string;
    func: string;
    sql: string;
    db: TDB;
    table: TTable<T>;
    req: TRequest;
    res: TResponse;
    type
      TTableModel = reference to procedure(db: TDB; tbl: TTable<T>; i: integer);
    procedure select(OnTableModel: TTableModel);  //查询
    procedure delete(OnTableModel: TTableModel);  //删除
    procedure insert(OnTableModel: TTableModel);  //新增
    procedure update(OnTableModel: TTableModel);  //修改
  end;
 
implementation
 
{ TCRUD<T> }
 
procedure TCRUD<T>.delete(OnTableModel: TTableModel);
begin
  if req.Body = nil then
    Exit;
  var pool: TDBPool := GetDBPool(dbid);
  db := pool.Lock;
  try
    try
      table := TSerial<TTable<T>>.unjson(TStream(req.Body));
      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);
        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>.insert(OnTableModel: TTableModel);
begin
  if req.Body = nil then
    Exit;
  var pool: TDBPool := GetDBPool(dbid);
  db := pool.Lock;
  try
    try
      table := TSerial<TTable<T>>.unjson(TStream(req.Body));
      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);
        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>.select(OnTableModel: TTableModel);
begin
  var pool: TDBPool := GetDBPool(dbid);
  db := pool.Lock;
  try
    try
      var where: string;
      if req.Body <> nil then
        where := TEncoding.UTF8.GetString(TBytesStream(req.Body).Bytes);
      var lsql: string;
      if where = '' then
        lsql := sql
      else
        lsql := sql + ' where ' + where;
      db.select(lsql);
      SetLength(table.rows, db.qry.RecordCount);
      var i: Integer := 0;
      db.qry.First;
      while not db.qry.Eof do
      begin
        OnTableModel(db, table, i);
        db.qry.Next;
        Inc(i);
      end;
      res.Send(TSerial<TTable<T>>.json(table));
    except
      on E: Exception do
      begin
        res.Send(error(E.Message));
        writelog(func + E.Message);
      end;
    end;
  finally
    pool.Unlock(db);
  end;
end;
 
procedure TCRUD<T>.update(OnTableModel: TTableModel);
begin
  if req.Body = nil then
    Exit;
  var pool: TDBPool := GetDBPool(dbid);
  db := pool.Lock;
  try
    try
      table := TSerial<TTable<T>>.unjson(TStream(req.Body));
      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);
        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;
 
end.

　　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
unit danwei;
/// <author>cxg 2023-10-8</author>
 
interface
 
uses
  {product.model,} db.crud, yn.log, danwei.model, global, Net.CrossHttpServer,
  db.unidac, db.unidacpool, system.Classes, serialize, System.SysUtils;
 
type
  TRESTdanwei = class(TPersistent)  //单位的远程方法类
    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.sql := 'select * from tunit';
  crud.req := req;
  crud.res := res;
  crud.select(
    procedure(db: TDB; tbl: TTable<Tdanwei>; i: Integer)
    begin
      tbl.rows[i].unitid := db.qry.FieldByName('unitid').AsString;
      tbl.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.sql := 'delete from tunit where unitid=:unitid';
  crud.req := req;
  crud.res := res;
  crud.delete(
    procedure(db: TDB; tbl: TTable<Tdanwei>; i: Integer)
    begin
      db.qry.ParamByName('unitid').AsString := tbl.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.sql := 'insert into tunit(unitid,unitname) values (:unitid,:unitname)';
  crud.req := req;
  crud.res := res;
  crud.insert(
    procedure(db: TDB; tbl: TTable<Tdanwei>; i: Integer)
    begin
      db.qry.ParamByName('unitid').AsString := tbl.rows[i].unitid;
      db.qry.ParamByName('unitname').AsString := tbl.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.sql := 'update tunit set unitid=:unitid,unitname=:unitname where unitid=:key';
  crud.req := req;
  crud.res := res;
  crud.update(
    procedure(db: TDB; tbl: TTable<Tdanwei>; i: Integer)
    begin
      db.qry.ParamByName('unitid').AsString := tbl.rows[i].unitid;
      db.qry.ParamByName('unitname').AsString := tbl.rows[i].unitname;
      db.qry.ParamByName('key').AsString := tbl.rows[i].unitid;
    end);
end;
 
initialization
  RegisterClass(TRESTdanwei);
 
finalization
  UnRegisterClass(TRESTdanwei);
 
end.

　　

posted @   delphi中间件  阅读(490)  评论(0)  编辑  收藏  举报
相关博文：
· delphi ORM和泛型模板实现CRUD
· DELPHI模板编程
· Delphi 根据数据库表生成Record类型，并封装CRUD
· Delphi数据库备份
· Delphi 经典游戏程序设计40例 的学习 例9 可大可小 随处移动的聚光灯处理
阅读排行：
· DeepSeek 开源周回顾「GitHub 热点速览」
· 物流快递公司核心技术能力-地址解析分单基础技术分享
· .NET 10首个预览版发布：重大改进与新特性概览！
· AI与.NET技术实操系列（二）：开始使用ML.NET
· 单线程的Redis速度为什么快？
历史上的今天：
2019-10-09 DELPHI控件升级
2019-10-09 DNS负载均衡
2016-10-09 咏南中间件+开发框架支持最新的DELPHI XE10.1(BERLIN) UPDATE1
2014-10-09 FIREDAC连接SQLITE乱码的解决
点击右上角即可分享
微信分享提示
AI FOR CODE 大赛