mormot数据集二进制序列还原

/// <summary>
///   数据集转二进制流单元
/// </summary>
unit UDBDatasetToBinary;

interface
uses
  System.SysUtils, System.Classes, Data.DB, DBAccess,SynCommons,SynTable,SynDBVCL;
type
  /// <summary>
  ///   bit set to identify columns, e.g. null columns
  /// </summary>
  TSQLDBProxyStatementColumns = set of 0..255;
  /// <summary>
  ///   数据集转二进制流类
  /// </summary>
  TDBDatasetToBinary = class
  protected
    class procedure ColumnsToBinary(aDataSet: TDataSet;W: TFileBufferWriter;const Null: TSQLDBProxyStatementColumns;const ColTypes: TSQLDBFieldTypeDynArray);
    class function FetchAllToBinary(aDataSet: TDataSet;Dest: TStream; MaxRowCount: cardinal=0;DataRowPosition: PCardinalDynArray=nil): cardinal;
  public
    /// <summary>
    ///   数据集转二进制流
    /// </summary>
    /// <param name="aDataSet">
    ///   数据集
    /// </param>
    /// <param name="Dest">
    ///   转换后的数据流
    /// </param>
    /// <returns>
    ///   数据集记录数
    /// </returns>
    class function DataSetToBinary(aDataSet: TDataSet;Dest: TStream): cardinal;
    //TSynBinaryDataSet继承自TDataSet
    /// <summary>
    ///   二进制流转数据集
    /// </summary>
    /// <param name="Source">
    ///   数据流
    /// </param>
    /// <returns>
    ///   数据集对象
    /// </returns>
    class function BinaryToDataSet(Source: TStream):TSynBinaryDataSet;
  end;
implementation


{ TDBDatasetToJson }

{ TDBDatasetToBinary }

class function TDBDatasetToBinary.BinaryToDataSet(
  Source: TStream): TSynBinaryDataSet;
begin
  Source.Position := 0;
  Result := SynDBVCL.BinaryToDataSet(nil,StreamToRawByteString(Source));
end;

class procedure TDBDatasetToBinary.ColumnsToBinary(aDataSet: TDataSet;W: TFileBufferWriter;
  const Null: TSQLDBProxyStatementColumns;
  const ColTypes: TSQLDBFieldTypeDynArray);
var F: integer;
    VDouble: double;
    VCurrency: currency absolute VDouble;
    VDateTime: TDateTime absolute VDouble;
    colType: TSQLDBFieldType;
begin
  for F := 0 to length(ColTypes)-1 do
  if not (F in Null) then
  begin
    colType := ColTypes[F];
    case colType of
    ftInt64:
    begin
      if aDataSet.Fields[F].DataType = TFieldType.ftBoolean then
      begin
        W.WriteVarInt64( Integer(aDataSet.Fields[F].AsBoolean) );
      end
      else
      begin
        W.WriteVarInt64( aDataSet.Fields[F].AsLargeInt);
      end;

    end;
    ftDouble: begin
      VDouble := aDataSet.Fields[F].AsFloat;
      W.Write(@VDouble,sizeof(VDouble));
    end;
    ftCurrency: begin
      VCurrency := aDataSet.Fields[F].AsCurrency;
      W.Write(@VCurrency,sizeof(VCurrency));
    end;
    ftDate: begin
      VDateTime := aDataSet.Fields[F].AsDateTime;
      W.Write(@VDateTime,sizeof(VDateTime));
    end;
    ftUTF8:
    begin
      if aDataSet.Fields[F].AsString = '' then
        W.Write(StringToUTF8(#0)) //如果直接传空值，解析会有问题，故改为传#0 暂时不知道这样改法有没问题 by csm 
      else
        W.Write(StringToUTF8(aDataSet.Fields[F].AsString));
      //W.Write(RawByteString(SynCommons.StringToUTF8(aDataSet.Fields[F].AsString)))

    end
//    ftBlob:
//      W.Write(ColumnBlob(F));
    else
    raise Exception.CreateFmt('ColumnsToBinary: Invalid ColumnType(%s)=%d',
      [aDataSet.Fields[F].FieldName,ord(colType)]);
  end;
end;

end;
const
  FETCHALLTOBINARY_MAGIC = 1;
class function TDBDatasetToBinary.DataSetToBinary(aDataSet: TDataSet;
  Dest: TStream): cardinal;
begin
  Result := FetchAllToBinary(aDataSet,Dest);
end;

class function TDBDatasetToBinary.FetchAllToBinary(aDataSet: TDataSet;Dest: TStream;
  MaxRowCount: cardinal; DataRowPosition: PCardinalDynArray): cardinal;
var
  F, FMax, FieldSize, NullRowSize: integer;
  StartPos: cardinal;
  Null: TSQLDBProxyStatementColumns;
  W: TFileBufferWriter;
  ColTypes: TSQLDBFieldTypeDynArray;
  function ColumnType(aFieldIdx: Integer;var aFieldSize: Integer): TSQLDBFieldType;
  begin
    //TSQLDBFieldType =(ftUnknown, ftNull, ftInt64, ftDouble, ftCurrency, ftDate, ftUTF8, ftBlob);
    case aDataSet.Fields[aFieldIdx].DataType of
      TFieldType.ftSmallint,TFieldType.ftShortint, TFieldType.ftInteger, TFieldType.ftWord, TFieldType.ftLargeint,TFieldType.ftLongWord,TFieldType.ftByte:
        Result := ftInt64;
      TFieldType.ftFloat:
        Result := ftDouble;
      TFieldType.ftCurrency:
        Result := ftCurrency;
      TFieldType.ftBoolean:
        Result := ftInt64;
      TFieldType.ftDate, TFieldType.ftTime, TFieldType.ftDateTime:
      begin
        Result := ftDate;
      end;
      TFieldType.ftString, TFieldType.ftWideString, TFieldType.ftMemo, TFieldType.ftWideMemo:
      begin
        Result := ftUTF8;
      end;
    else
      raise Exception.CreateFmt('ColumnType: invalid ColumnType(%d)=%s', [aFieldIdx, GetEnumName(Typeinfo(TFieldType), ord(aDataSet.FieldDefs[aFieldIdx].DataType))^]);
    end;
    aFieldSize := 0;
  end;
begin
  FillChar(Null,sizeof(Null),0);
  result := 0;
  W := TFileBufferWriter.Create(Dest);
  try
    W.WriteVarUInt32(FETCHALLTOBINARY_MAGIC);
    FMax := aDataSet.FieldCount;
    W.WriteVarUInt32(FMax);
    if FMax>0 then begin
      // write column description
      SetLength(ColTypes,FMax);
      dec(FMax);
      for F := 0 to FMax do begin
        W.Write( StringToUTF8(aDataSet.Fields[F].FieldName) );
        ColTypes[F] := ColumnType(F,FieldSize);
        W.Write1(ord(ColTypes[F]));
        W.WriteVarUInt32(FieldSize);
      end;
      // initialize null handling
      NullRowSize := (FMax shr 3)+1;
      if NullRowSize>sizeof(Null) then
        raise Exception.CreateFmt('FetchAllToBinary: too many columns',[]);
      // save all data rows
      StartPos := W.TotalWritten;
      aDataSet.First;
      while not aDataSet.Eof do
      begin
        if DataRowPosition<>nil then begin
          if Length(DataRowPosition^)<=integer(result) then
            SetLength(DataRowPosition^,NextGrow(result));
          DataRowPosition^[result] := W.TotalWritten-StartPos;
        end;
        // first write null columns flags
        if NullRowSize>0 then begin
          FillChar(Null,NullRowSize,0);
          NullRowSize := 0;
        end;
        for F := 0 to FMax do
        if aDataSet.Fields[F].IsNull then begin
          include(Null,F);
          NullRowSize := (F shr 3)+1;
        end;
        W.WriteVarUInt32(NullRowSize);
        if NullRowSize>0 then
          W.Write(@Null,NullRowSize);
        // then write data values
        ColumnsToBinary(aDataSet,W,Null,ColTypes);
        inc(result);
        if (MaxRowCount>0) and (result>=MaxRowCount) then
          break;

        aDataSet.Next;
      end;

    end;
    W.Write(@result,SizeOf(result)); // fixed size at the end for row count
    W.Flush;
  finally
    W.Free;
  end;

end;

end.