mormot 数据集转换为JSON字串

mormot 数据集转换为JSON字串

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, DB, ADODB
,SynCommons, SynDB
;

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

var
Form1: TForm1;

implementation

{$R *.dfm}

function DataSetToJSON(Data: TDataSet; const RecNo:Integer=0): RawUTF8;
var W: TJSONWriter;
f: integer;
blob: TRawByteStringStream;
begin
result := 'null';
if Data=nil then
exit;
if (RecNo=0) then
Data.First;
if Data.Eof then
exit;
W := TJSONWriter.Create(nil,true,false);
try
// get col names and types
SetLength(W.ColNames,Data.FieldCount);
for f := 0 to high(W.ColNames) do
StringToUTF8(Data.FieldDefs[f].Name,W.ColNames[f]);
W.AddColumns;
if (RecNo=0) then
W.Add('{');
repeat
W.Add('{');
for f := 0 to Data.FieldCount-1 do begin
W.AddString(W.ColNames[f]);
with Data.Fields[f] do
if IsNull then
W.AddShort('null') else
case DataType of
ftBoolean:
W.Add(AsBoolean);
ftSmallint, ftInteger, ftWord, ftAutoInc:
W.Add(AsInteger);
ftLargeint:
W.Add(TLargeintField(Data.Fields[f]).AsLargeInt);
ftFloat, db.ftCurrency: 
W.Add(AsFloat,TFloatField(Data.Fields[f]).Precision);
ftBCD:
W.AddCurr64(AsCurrency);
ftTimeStamp, db.ftDate, ftTime, ftDateTime: begin
W.Add('"');
W.AddDateTime(AsDateTime);
W.Add('"');
end;
ftString, ftFixedChar, ftMemo: begin
W.Add('"');
W.AddAnsiString({$ifdef UNICODE}urlencode( AsAnsiString){$else}urlencode( AsString){$endif},
twJSONEscape);
W.Add('"');
end;
ftWideString: begin
W.Add('"');
W.AddJSONEscapeW(pointer(TWideStringField(Data.Fields[f]).Value));
W.Add('"');
end;
ftVariant:
W.AddVariant(AsVariant);
ftBytes, ftVarBytes, DB.ftBlob, ftGraphic, ftOraBlob, ftOraClob: begin
blob := TRawByteStringStream.Create;
try
(Data.Fields[f] as TBlobField).SaveToStream(blob);
W.WrBase64(pointer(blob.DataString),length(blob.DataString),true);
finally
blob.Free;
end;
end;
{$ifdef ISDELPHI2007ANDUP}
ftWideMemo, ftFixedWideChar: begin
W.Add('"');
W.AddJSONEscapeW(pointer(AsWideString));
W.Add('"');
end;
{$endif}
{$ifdef UNICODE}
ftShortint, ftByte:
W.Add(AsInteger);
ftLongWord:
W.AddU(TLongWordField(Data.Fields[f]).Value);
ftExtended:
W.Add(AsFloat,DOUBLE_PRECISION);
ftSingle:
W.Add(AsFloat,SINGLE_PRECISION);
{$endif}
else W.AddShort('null'); 
end;
W.Add(',');
end;
W.CancelLastComma;
W.Add('}',',');
if (RecNo=0) then Data.Next else break;
until (Data.Eof);
W.CancelLastComma;
if (RecNo=0) then
W.Add('}');
W.SetText(result);
finally
W.Free;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ADOConnection1.Close;
ADOConnection1.Open;
ADOQuery1.Connection := ADOConnection1;
ADOQuery1.Close;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Text := 'select top 5 * from t1';
ADOQuery1.Open;
Memo1.Lines.Text := DataSetToJSON(ADOQuery1);
end;

end.

从上面的代码可以看出，对字符串类型的字段值，进行了URL编码，对BLOB字段值 ，进行了BASE64编码