JsonDataObjects序列和还原

JsonDataObjects号称DELPHI最快的JSON库,且支持跨平台。

// cxg 2017-9-12
// Use JsonDataObjects(cross platform json library)
// Use delphi 10.2.1

unit ujson;

interface

uses
System.SysUtils, soap.EncdDecd, Web.HTTPApp, System.NetEncoding, Data.DB,
System.Classes, JsonDataObjects;

// {"data":[{"field1":value1,"field2":value2}]};
function datasetToJson(dataset: TDataSet): string;

// {"data":[{"field1":value1,"field2":value2}]};
procedure jsonToDataset(const json: string; dataset: TDataSet);

// {"cols":[{"name":"field1","size":0,"type":"int"}]"data":[{"field1":value1}]};
function datasetToJsonCols(dataset: TDataSet): string;

// {
// "update":[{"table":"表1","where":"字段1=1","字段1":"1","字段2":0}]
// ,"insert":[{"table":"表1","字段1":"1","字段2":0}]
// ,"delete":[{"table":"表1","where":"字段1=1"}]
// };
procedure parseJsonSql(const json: string; outsql: TStrings);

implementation

procedure parseJsonSql(const json: string; outsql: TStrings);
// {
// "update":[{"table":"表1","where":"字段1=1","字段1":"1","字段2":0}]
// ,"insert":[{"table":"表1","字段1":"1","字段2":0}]
// ,"delete":[{"table":"表1","where":"字段1=1"}]
// };
var
obj, childobj: TJsonObject;
tablename, sql, lname, lvalue, where: string;
i, j: Integer;
function _getValue(value: PJsonDataValue): string;
{
TJsonDataType = (
jdtNone, jdtString, jdtInt, jdtLong, jdtULong, jdtFloat, jdtDateTime
, jdtBool, jdtArray, jdtObject
);
}
begin
case Value.Typ of
jdtString: Result := QuotedStr(UTF8ToString(rawbytestring(TNetEncoding.URL.Decode(value.Value)))); // 解码
jdtBool: Result := BoolToStr(value.BoolValue);
jdtFloat: Result := FloatToStr(value.FloatValue);
jdtInt, jdtLong, jdtULong: Result := IntToStr(value.IntValue);
jdtDateTime: Result := DateTimeToStr(value.DateTimeValue);
end;
end;
begin
if outsql = nil then
Exit;
outsql.Clear;
obj := TJsonObject.Parse(json) as TJsonObject;
try
// 解析并生成insert sql begin-----------------------------------
for i := 0 to obj.A['insert'].Count - 1 do
begin
childobj := obj.A['insert'].O[i];
lname := '';
lvalue := '';
for j := 0 to childobj.Count - 1 do
begin
if childobj.Names[j] = 'table' then
begin
tablename := childobj.Items[j].Value;
Continue;
end;
if lname = '' then
lname := childobj.Names[j]
else
lname := lname + ',' + childobj.Names[j];
if lvalue = '' then
lvalue := _getValue(childobj.Items[j])
else
lvalue := lvalue + ',' + _getValue(childobj.Items[j]);
end;
sql := 'insert into ' + tablename + ' (' + lname + ') values (' + lvalue + ')';
outsql.Add(sql);
end;
// 解析并生成insert sql end----------------------------------------
// 解析并生成update sql begin---------------------------------------
for i := 0 to obj.A['update'].Count - 1 do
begin
childobj := obj.A['update'].O[i];
lname := '';
lvalue := '';
for j := 0 to childobj.Count - 1 do
begin
if childobj.Names[j] = 'table' then
begin
tablename := childobj.Items[j].Value;
Continue;
end
else
if childobj.Names[j] = 'where' then
begin
where := childobj.Items[j].Value;
Continue;
end;
if lname = '' then
lname := childobj.Names[j] + '=' + _getValue(childobj.Items[j])
else
lname := lname + ',' + childobj.Names[j] + '=' + _getValue(childobj.Items[j]);
end;
sql := 'update ' + tablename + ' set ' + lname + ' where ' + where;
outsql.Add(sql);
end;
// 解析并生成update sql end--------------------------------------------
// 解析并生成delete sql begin--------------------------------------------
for i := 0 to obj.A['delete'].Count - 1 do
begin
childobj := obj.A['delete'].O[i];
lname := '';
lvalue := '';
for j := 0 to childobj.Count - 1 do
begin
if childobj.Names[j] = 'table' then
begin
tablename := childobj.Items[j].Value;
Continue;
end
else
if childobj.Names[j] = 'where' then
begin
where := childobj.Items[j].Value;
Continue;
end;
end;
sql := 'delete from ' + tablename + ' where ' + where;
outsql.Add(sql);
end;
// 解析并生成delete sql end-------------------------------------------
finally
obj.free;
end;
end;

function datasetToJsonCols(dataset: TDataSet): string;
// {"cols":[{"name":"field1","size":0,"type":"int"}]"data":[{"field1":value1}]};
var
i: Integer;
obj, childobj: TJsonObject;
field: TField;
blob: TStringStream;

function _getFieldType(fld: TField): string;
begin
case fld.DataType of
ftBoolean:
Result := 'bool';
ftSmallint, ftInteger, ftWord, ftAutoInc:
Result := 'int';
ftLargeint:
Result := 'int64';
ftFloat, ftBCD, ftCurrency:
Result := 'float';
ftTimeStamp, ftDate, ftTime, ftDateTime:
Result := 'datetime';
ftString, ftFixedChar, ftMemo, ftWideString:
Result := 'string';
ftBytes, ftVarBytes, ftBlob, ftGraphic, ftOraBlob, ftOraClob:
Result := 'blob';
end;
end;

begin
// {"cols":[{"name":"c1","size":0,"type":"int"}]"data":[{"c1":1}]};
Result := '{"result":"false"}';
if (dataset = nil) or (not dataset.Active) then
Exit;
obj := TJsonObject.Create;
obj.A['cols'];
obj.A['data'];
dataset.First;
for i := 0 to dataset.FieldCount - 1 do // fill cols array
begin
field := dataset.Fields[i];
childobj := obj.A['cols'].AddObject;
childobj.S['name'] := field.FieldName;
childobj.I['size'] := field.Size;
childobj.S['type'] := _getFieldType(field);
childobj.B['required'] := field.Required;
childobj.B['readonly'] := field.ReadOnly;
end;
// fill data array
dataset.First;
while not dataset.Eof do
begin
childobj := obj.A['data'].AddObject;
for i := 0 to dataset.FieldCount - 1 do
begin
field := dataset.Fields[i];
if field.IsNull then
childobj.S[field.FieldName] := ''
else
begin
case field.DataType of
ftBoolean:
childobj.B[field.FieldName] := field.AsBoolean;
ftSmallint, ftInteger, ftWord, ftAutoInc:
childobj.I[field.FieldName] := field.AsInteger;
ftLargeint:
childobj.L[field.FieldName] := TLargeintField(field).AsLargeInt;
ftFloat, ftBCD, ftCurrency:
childobj.F[field.FieldName] := field.AsFloat;
ftTimeStamp, ftDate, ftTime, ftDateTime:
childobj.D[field.FieldName] := field.AsDateTime;
ftString, ftFixedChar, ftMemo, ftWideString:
childobj.S[field.FieldName] := TNetEncoding.URL.Encode(string(UTF8Encode(field.AsString))); // 编码
ftBytes, ftVarBytes, ftBlob, ftGraphic, ftOraBlob, ftOraClob:
begin
blob := TStringStream.Create('');
try
TBlobField(field).SaveToStream(blob);
childobj.S[field.FieldName] := EncodeString(blob.DataString); // base64 编码
finally
blob.Free;
end;
end;
end;
end;
end; // end for
dataset.Next;
end; // end while
Result := obj.ToString;
end;

procedure jsonToDataset(const json: string; dataset: TDataSet);
// {"data":[{"field1":value1,"field2":value2}]};
var
obj, childobj: TJsonObject;
i, j: Integer;
field: TField;
blob: TStringStream;
begin
if (dataset = nil) or (not dataset.Active) or (json = '{"result":"false"}') then
Exit;
obj := TJsonObject.Parse(json) as TJsonObject;
dataset.DisableControls;
try
for i := 0 to obj.A['data'].Count - 1 do
begin
dataset.Append;
childobj := obj.A['data'].O[i];
if childobj = nil then
continue;
for j := 0 to dataset.FieldCount - 1 do
begin
field := dataset.Fields[j];
if field = nil then
Continue;
case field.datatype of
ftBoolean:
field.AsBoolean := childobj.B[field.FieldName];
ftFloat, ftBCD, ftCurrency:
field.AsFloat := childobj.F[field.FieldName];
ftSmallint, ftInteger, ftWord, ftAutoInc:
field.AsInteger := childobj.I[field.FieldName];
ftString, ftFixedChar, ftMemo, ftWideString:
field.AsString :=UTF8ToString(rawbytestring( TNetEncoding.URL.Decode(childobj.S[field.FieldName]))); // 解码
ftTimeStamp, ftDate, ftTime, ftDateTime:
field.AsDateTime := childobj.D[field.FieldName];
ftLargeint:
TLargeintField(field).AsLargeInt := childobj.L[field.FieldName];
ftBytes, ftVarBytes, ftBlob, ftGraphic, ftOraBlob, ftOraClob:
begin
blob := TStringStream.Create(DecodeString(childobj.S[field.FieldName]));
try
TBlobField(field).LoadFromStream(blob);
finally
blob.Free;
end;
end;
end;
end;
dataset.Post;
end;
finally
dataset.EnableControls;
obj.free;
end;
end;

function datasetToJson(dataset: TDataSet): string;
// {"data":[{"field1":value1,"field2":value2}]};
var
i: Integer;
obj, childobj: TJsonObject;
field: TField;
blob: TStringStream;
begin
Result := '{"result":"false"}';
if (dataset = nil) or (not dataset.Active) then
Exit;
obj := TJsonObject.Create;
try
obj.A['data'];
dataset.First;
while not dataset.Eof do
begin
childobj := obj.A['data'].AddObject;
for i := 0 to dataset.FieldCount - 1 do
begin
field := dataset.Fields[i];
if field.IsNull then
childobj.S[field.FieldName] := ''
else
begin
case field.datatype of
ftBoolean:
childobj.B[field.FieldName] := field.AsBoolean;
ftSmallint, ftInteger, ftWord, ftAutoInc:
childobj.I[field.FieldName] := field.AsInteger;
ftLargeint:
childobj.L[field.FieldName] := TLargeintField(field).AsLargeInt;
ftCurrency, ftFloat, ftBCD:
childobj.F[field.FieldName] := field.AsFloat;
ftTimeStamp, ftDate, ftTime, ftDateTime:
childobj.D[field.FieldName] := field.AsDateTime;
ftString, ftFixedChar, ftMemo, ftWideString:
childobj.S[field.FieldName] := TNetEncoding.URL.Encode(string(UTF8Encode(field.AsString)));
ftBytes, ftVarBytes, ftBlob, ftGraphic, ftOraBlob, ftOraClob:
begin
blob := TStringStream.Create('');
try
TBlobField(field).SaveToStream(blob);
childobj.S[field.FieldName] := EncodeString(blob.DataString); // base64 编码
finally
blob.Free;
end;
end;
end;
end;
end; // end for
dataset.Next;
end; // end while
Result := obj.ToString;
finally
obj.Free;
end;
end;

end.

JsonDataObjects序列和还原的更多相关文章

  1. msgpack的数据序列和还原

    msgpack的数据序列和还原 msgpack不仅可以序列一些常规的数据类型的数据,比如:string.datetime.integer...... 还能序列olevariant.stream 这就非 ...

  2. QJSON封装好的序列和还原方法

    QJSON封装好的序列和还原方法 {*******************************************************}{ }{ QJSON与数据集互转 }{ }{ 版权所 ...

  3. MSGPACK序列和还原TFDParams

    MSGPACK序列和还原TFDParams unit Unit1; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, S ...

  4. 优秀的数据序列和还原类----TSimpleMsgPack

    优秀的数据序列和还原类----TSimpleMsgPack TSimpleMsgPack是D10天地弦的作品. 优点:至简,就一个单元文件实现,不需要引用其他单元. 缺点:不是标准的MSGPACK实现 ...

  5. cross socket和msgpack的数据序列和还原

    cross socket和msgpack的数据序列和还原 procedure TForm1.Button1Click(Sender: TObject); begin var pack: TSimple ...

  6. TynSerial流的序列(还原)

    TynSerial流的序列(还原) procedure TForm1.ToolButton18Click(Sender: TObject); var serial: TynSerial; ms, ms ...

  7. TynSerial基本数据类型序列(还原)

    TynSerial基本数据类型序列(还原) procedure TForm1.ToolButton17Click(Sender: TObject); var serial: TynSerial; be ...

  8. TynSerial序列(还原)TFDMemTable

    TynSerial序列(还原)TFDMemTable 1)TFDMemTable查询数据 procedure TForm1.Qrys(accountno, sql, sql2: string; Dat ...

  9. TynSerial图片序列(还原)

    TynSerial图片序列(还原) 笔者以生成图形验证码为例. function TForm1.VerifyCode(image: TImage): string; // 生成验证码和图像 var u ...

随机推荐

  1. 【linux】如何解决VMWare上linux虚拟机连不上外网的问题?

    >>>故障现象:虚拟机连接不到外网? >>>故障背景: Centos7.4发行版本: 虚拟机和VM软件都是nat模式: 注意这里默认的VMWare的DHCP服务时开 ...

  2. CSS——(2)盒子模型与标准流

    上篇博客<CSS--(1)基础>中简单介绍了CSS的概念和几种使用方法,现在主要是介绍其的核心内容. 盒子模型 为了理解盒子模型,我们可以先从生活中的盒子入手.盒子是用来放置物品的,内部除 ...

  3. qemu中的网络设置

    https://www.cnblogs.com/hukey/p/6436211.html 这个链接里教你怎么操作kvm的各种网络模式,实际操作成

  4. 网站前后台分离 图片 flash 视频 等文件的共享问题

    在网上找了,没有说到点子上的,不详细 问了有经验的同事,要建立 文件服务器,就是一个IIS 下的新网站,网站是共享图片 文件使用的专用网站 后台上传的图片保存在 文件服务器即 文件共享专用的网站目录地 ...

  5. [洛谷P3807]【模板】卢卡斯定理

    题目大意:给你$n,m,p(p \in \rm prime)$,求出$C_{n + m}^m\bmod p(可能p\leqslant n,m)$ 题解:卢卡斯$Lucas$定理,$C_B^A\bmod ...

  6. 【转】百度统计js被劫持用来DDOS Github

    原文链接:http://drops.wooyun.org/papers/5398 今天中午刷着全国最大的信息安全从业人员同性交友社区zone.wooyun.org的时候,忽然浏览器每隔2秒就不断的弹窗 ...

  7. div样式

    DIV样式汇总 一.常用属性: 1.Height:设置DIV的高度. 2.Width:设置DIV的宽度. 例: <div style="width:200px;height:200px ...

  8. 简易web服务器(npm)

    npm install -g http-server 以后可以在任何一个文件夹启动静态文件的访问通过http-server -a localhost -p 8000ctrl + c结束 http-se ...

  9. 蓝萝卜blu netty3升netty4

    老项目是netty3的,本来想直接改到netty5,但是netty5居然是只支持jdk1.7,很奇怪jdk1.6和jdk1.8都不行..为了兼容jdk1.6加上netty4本来和netty5就差别不大 ...

  10. YYH的积木(NOIP模拟赛Round 6)

    题目描述 YYH手上有n盒积木,每个积木有个重量.现在他想从每盒积木中拿一块积木,放在一起,这一堆积木的重量为每块积木的重量和.现在他想知道重量最少的k种取法的重量分别是多少. 输入输出格式 输入格式 ...