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.
Delphi DatasetToJson

相关推荐

评论
