delphi DatasetToJson

以下代码用法由星五 WebPascal.com 提供

uses EncdDecd;

function UnicodeToAnsi(aSubUnicode: string): string;

var

tmpLen, iCount: Integer;

tmpWS: WideString;

begin

tmpWS := '';

iCount := 1;

tmpLen := Length(aSubUnicode);

while iCount <= tmpLen do

try

if (Copy(aSubUnicode, iCount, 1) = '\')

and (Copy(aSubUnicode, iCount, 2) = '\u') then

begin

tmpWS := tmpWS

+ WideChar(StrToInt('$' + Copy(aSubUnicode, iCount + 2, 4)));

iCount := iCount + 6;

end

else

begin

tmpWS := tmpWS + Copy(aSubUnicode, iCount, 1);

iCount := iCount + 1;

end;

except

end;

Result := tmpWS;

end;

function DataSetToJson(ds: TDataSet): string;

var

vRecord: string;

vField: TField;

i: Integer;

vIn, vOut: TStringStream;

begin

Result := '';

if (not ds.Active) or (ds.IsEmpty) then

Exit;

Result := '[';

ds.DisableControls;

ds.First;

while not ds.Eof do

begin

for i := 0 to ds.FieldCount - 1 do

begin

vField := ds.Fields[i];

if vRecord = '' then

vRecord := '{';

vRecord := vRecord + '"' + vField.FieldName + '":';

if vField.DataType = ftTimeStamp then

// 日期类型处理一下

vRecord := vRecord + '"'

+ FormatDateTime('yyyy-MM-DD hh:mm:ss', vField.AsDateTime) + '"'

else if (vField.DataType = ftBoolean) then

vRecord := vRecord + vField.AsString.ToLower

else if (vField.DataType = ftBlob) then

begin

vIn := TStringStream.Create(vField.AsBytes);

try

vOut := TStringStream.Create;

try

EncdDecd.EncodeStream(vIn, vOut);

vRecord := vRecord + '"' + vOut.DataString.Replace(#13#10, '\r\n')

+ '"';

finally

vIn.Free;

vOut.Free;

end;

except

vRecord := vRecord + '""';

end;

end

else if (vField.DataType = ftAutoInc)

or (vField.DataType = ftInteger) then

begin // 整型为空时，需要返回null

if vField.IsNull then

vRecord := vRecord + 'null'

else

vRecord := vRecord + vField.AsString

end

else

vRecord := vRecord + '"'

// 字符串中的双引号和换行符需要转义

+ vField.AsString.Replace(#13#10, '\r\n').Replace('"', '\"')

+ '"';

if i = ds.FieldCount - 1 then

begin

vRecord := vRecord + '}';

if Result = '[' then

Result := Result + vRecord

else

Result := Result + ',' + vRecord;

vRecord := '';

end

else

vRecord := vRecord + ',';

end;

ds.Next;

end;

ds.EnableControls;

Result := Result + ']';

end;

procedure TForm1.btn1Click(Sender: TObject);

begin

fdqry1.Close;

fdqry1.Open(edt1.Text);

mmo1.Lines.Text := DataSetToJson(fdqry1);

end;

procedure TForm1.edt1KeyPress(Sender: TObject; var Key: Char);

begin

if Key = #13 then

btn1.Click;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

con1.ConnectionString := 'DriverID=MSAcc;Database='+ ExtractFilePath(ParamStr(0)) + 'db.mdb;';

end;

end.

推荐分享