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.
来源：oschina
链接：https://my.oschina.net/u/4300166/blog/3220196