mormot2 json

mormot2 json

unit Unit1;

interface

uses
  mormot.core.variants, mormot.core.text,
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var r: Variant;
  doc: TDocVariantData;
begin
  TDocVariant.NewFast(r);
  doc.AddItem(_ObjFast(['unitid', 1, 'unitname', '测试']));
  doc.AddItem(_ObjFast(['unitid', '2', 'unitname', '个']));
  r.tunits := _Json(doc.ToJson);
  Memo1.Text := VariantSaveJson(r);  // {"tunits":[{"unitid":"1","unitname":"测试"},{"unitid":"2","unitname":"个"}]}
end;

end.

 

unit rest.tunit;
///cxg 2023-2-20
{$IFDEF fpc}
  {$MODE DELPHI}{$H+}
{$ENDIF}

interface

uses
  mormot.db.rad.ui, db.unidac, db.unidacpool, classes, db,
  System.NetEncoding, api.router, mormot.core.variants, mormot.core.text, yn.log,
  SysUtils, mormot.net.http, global;

type
  TFunc1549 = class(TFunc)
    procedure select(ctxt: THttpServerRequestAbstract);
    procedure insert(ctxt: THttpServerRequestAbstract);
    procedure update(ctxt: THttpServerRequestAbstract);
    procedure delete(ctxt: THttpServerRequestAbstract);
  end;

implementation

procedure TFunc1549.select(ctxt: THttpServerRequestAbstract);
var
  db: tdb;
  pool: tdbpool;
  r: variant;
begin
  try
    try
      TDocVariant.NewFast(r);
      pool := GetDBPool(DBID);
      db := pool.Lock;
      db.qry.Close;
      db.qry.SQL.Clear;
      db.qry.SQL.Text := 'select * from tunit';
      db.qry.Open;
      r.status := 200;
      r.message := 'success';
      r.tunits := _json(DataSetToJson(db.qry));
      ctxt.OutContent := VariantSaveJSON(r);
    except
      on E: Exception do
      begin
        r.status := 500;
        r.message := 'fail';
        r.exception := E.Message;
        ctxt.OutContent := VariantSaveJSON(r);
        yn.log.WriteLog('TFunc1549.select()' + E.Message);
      end;
    end;
  finally
    pool.Unlock(db);
  end;
end;

procedure TFunc1549.insert(ctxt: THttpServerRequestAbstract);
var
  db: tdb;
  pool: tdbpool;
  jo, ja, jo2: PDocVariantData;
  i: integer;
  r: variant;
begin
  New(jo);
  try
    try
      TDocVariant.New(r);
      pool := GetDBPool(DBID);
      db := pool.Lock;
      db.startTrans;
      {$IFDEF fpc}
      jo.InitJson(ctxt.InContent);
      {$ELSE}
      jo.InitJson(UTF8Decode(ctxt.InContent));
      {$ENDIF}
      ja := jo.A['tunits'];
      for i := 0 to ja.Count - 1 do
      begin
        db.qry.Close;
        db.qry.SQL.Clear;
        jo2 := ja._[i];
        db.qry.SQL.Text := 'insert into tunit (unitid,unitname) values (' + QuotedStr(jo2.S['unitid']) + ',' + QuotedStr(jo2.S['unitname']) + ')';
        db.qry.ExecSQL;
      end;
      db.commitTrans;
      r.status := 200;
      r.message := 'success';
      ctxt.OutContent := VariantSaveJSON(r);
    except
      on E: Exception do
      begin
        db.rollbackTrans;
        r.status := 500;
        r.exception := E.Message;
        ctxt.OutContent := VariantSaveJSON(r);
        yn.log.WriteLog('TFunc1549.insert()' + E.Message);
      end;
    end;
  finally
    pool.Unlock(db);
    Dispose(jo);
  end;
end;

procedure TFunc1549.update(ctxt: THttpServerRequestAbstract);
var
  db: tdb;
  pool: tdbpool;
  jo, ja, jo2: PDocVariantData;
  i: integer;
  r: variant;
begin
  New(jo);
  try
    try
      TDocVariant.New(r);
      pool := GetDBPool(DBID);
      db := pool.Lock;
      db.startTrans;
      {$IFDEF fpc}
      jo.InitJson(ctxt.InContent);
      {$ELSE}
      jo.InitJson(UTF8Decode(ctxt.InContent));
      {$ENDIF}
      ja := jo.A['tunits'];
      for i := 0 to ja.Count - 1 do
      begin
        db.qry.Close;
        db.qry.SQL.Clear;
        jo2 := ja._[i];
        db.qry.SQL.Text := 'update tunit set unitid=' + QuotedStr(jo2.S['unitid']) + ',unitname=' + QuotedStr(jo2.S['unitname']) + ' where unitid=' + QuotedStr(jo2.S['unitid']);
        db.qry.ExecSQL;
      end;
      db.commitTrans;
      r.status := 200;
      r.message := 'success';
      ctxt.OutContent := VariantSaveJSON(r);
    except
      on E: Exception do
      begin
        db.rollbackTrans;
        r.status := 500;
        r.exception := E.Message;
        ctxt.OutContent := VariantSaveJSON(r);
        yn.log.WriteLog('TFunc1549.update()' + E.Message);
      end;
    end;
  finally
    pool.Unlock(db);
    Dispose(jo);
  end;
end;

procedure TFunc1549.delete(ctxt: THttpServerRequestAbstract);
var
  db: tdb;
  pool: tdbpool;
  arr: tarray<string>;
  r: variant;
  url, where: string;
begin
  try
    try
      TDocVariant.New(r);
      url := ctxt.Url;
      arr := url.Split(['/']);
      pool := GetDBPool(DBID);
      db := pool.Lock;
      db.qry.Close;
      db.qry.SQL.Clear;
      where := ' where ' + TNetEncoding.URL.Decode(arr[3]);
      db.qry.SQL.Text := 'delete from tunit' + where;
      db.qry.ExecSQL;
      r.status := 200;
      r.message := 'success';
      ctxt.OutContent := VariantSaveJSON(r);
    except
      on E: Exception do
      begin
        r.status := 500;
        r.exception := E.Message;
        ctxt.OutContent := VariantSaveJSON(r);
        yn.log.WriteLog('TFunc1549.delete()' + E.Message);
      end;
    end;
  finally
    pool.Unlock(db);
  end;
end;

initialization
  RegisterClass(TFunc1549);

end.