unit uDABinAdapter;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Core Library                                       }
{                                                                            }
{ compiler: Delphi 6 and up, Kylix 3 and up                                  }
{ platform: Win32, Linux                                                     }
{                                                                            }
{ (c)opyright RemObjects Software. all rights reserved.                      }
{                                                                            }
{ Using this code requires a valid license of the Data Abstract              }
{ which can be obtained at http://www.remobjects.com.                        }
{----------------------------------------------------------------------------}

{$I DataAbstract.inc}

interface

uses
  Classes,
  uROTypes,
  uDADataTable, uDAInterfaces, uDADataStreamer, uDADelta, FMTBcd;

type
  TBINAdapterSignature = array[0..7] of char;

const
  BINAdapterSignature: TBINAdapterSignature = 'DABIN100';

type
  TDAElementType = (etDataset, etDelta);

  { TElementInfo }
  TDAElementInfo = class
    ElementType: TDAElementType;
      Name: string;
    Offset: integer;
  end;

  { TDABinDataStreamer }
  TDABinDataStreamer = class(TDADataStreamer)
  private
    fReader: TReader;
    fWriter: TWriter;

    fInfoIntOffset: integer;
    fIsCompatibleV4: boolean;

    procedure AddElementInfo(ElementType: TDAElementType; ElementName: string; Offset: integer);
    procedure WriteElementInfo(ElementInfo: TDAElementInfo);
    procedure ReadElementInfo;
    function GetElementInfo(ElementType: TDAElementType; const Name: string): TDAElementInfo;

    procedure ReadAndApplySchema(const Destination: IDADataset; ApplySchema: boolean);
    procedure WriteSchema(const Fields: TDAFieldCollection; const Params: TDAParamCollection; aFieldsIndex: array of integer); overload;
    function ReadOffset: integer;
    procedure WriteOffset(Offset: integer);

  protected
    // Overriden
    function DoCreateStream: TStream; override;
    procedure DoInitialize(Mode: TDAAdapterInitialization); override;
    procedure DoFinalize; override;
    function DoWriteDataset(const Source: IDADataset; Options: TDAWriteOptions; MaxRows: integer;ADynFieldNames: array of string): integer; override;
    procedure DoWriteDelta(const Source: IDADelta); override;
    procedure DoReadDataset(const DatasetName: string; const Destination: IDADataset; ApplySchema: boolean); override;
    procedure DoReadDelta(const DeltaName: string; const Destination: IDADelta); override;
    procedure SetBufferSize(const Value: cardinal); override;

    function DoBeginWriteDataset( const Source: IDADataset; const Schema: TDADataset;
                                  Options: TDAWriteOptions; MaxRows: integer;
                                  ADynFieldNames: array of string): TDADataForAppend; override;

    function DoWriteDatasetData(const Source: IDADataset; var aDataForAppend: TDADataForAppend; aDataIndex: Integer = -1): Integer; override;
    function DoEndWriteDataset(aDataForAppend: TDADataForAppend): Integer; override;

  public
    constructor Create(aOwner: TComponent); override;
    destructor Destroy; override;

    function GetTargetDataType: TRODataType; override;
  published
    property BufferSize;
    property IsCompatibleV4: boolean read fIsCompatibleV4 write fIsCompatibleV4 default True;
  end;

  TDABINAdapter = class(TDABinDataStreamer) end deprecated;

implementation

uses Math, SysUtils, Variants, uROBinaryHelpers, uDaClasses, uDAEngine, uROClasses{$IFDEF DELPHI6}, RTLConsts{$ENDIF};


{$IFDEF FPC}
type
  THackBinaryObjectWriter = class(TBinaryObjectWriter)
  end;

  THackBinaryObjectReader = class(TBinaryObjectReader)
  end;
{$ENDIF}

procedure Writer_FlushBuffer(AWriter: TWriter);
begin
  {$IFNDEF FPC}
  AWriter.FlushBuffer;
  {$ELSE}
  THackBinaryObjectWriter(AWriter.Driver).FlushBuffer;
  {$ENDIF}
end;

function GetWriterPosition(AWriter: TWriter):Longint;
begin
  {$IFNDEF FPC}
  Result := AWriter.Position
  {$ELSE}
  Result := THackBinaryObjectWriter(AWriter.Driver).FStream.Position;
  {$ENDIF}
end;

Procedure SetWriterPosition(AWriter: TWriter; APosition:Longint);
begin
  {$IFNDEF FPC}
  AWriter.Position:=APosition;
  {$ELSE}
  Writer_FlushBuffer(AWriter);
  THackBinaryObjectWriter(AWriter.Driver).FStream.Position:=APosition;
  {$ENDIF}
end;

{$IFDEF FPC}
procedure Writer_WriteValue(AWriter: TWriter; aValue: TValueType);
begin
  THackBinaryObjectWriter(AWriter.Driver).WriteValue(aValue);
end;
{$ENDIF}

procedure Writer_WriteVariant(AWriter: TWriter; AValue: Variant);
begin
  {$IFNDEF FPC}
   AWriter.WriteVariant(AValue);
  {$ELSE}
  if VarIsArray(aValue) then raise EWriteError.Create('Stream write error');
  case VarType(aValue) and varTypeMask of
    varEmpty: Writer_WriteValue(AWriter,vaNil);
    varNull: Writer_WriteValue(AWriter,vaNull);
    varOleStr: aWriter.WriteWideString(aValue);
    varString: aWriter.WriteString(aValue);
    varByte, varShortInt, varWord, varSmallInt,
      varInteger,varLongWord, varInt64: aWriter.WriteInteger(aValue);
    varSingle: aWriter.WriteSingle(aValue);
    varDouble: aWriter.WriteFloat(aValue);
    varCurrency: aWriter.WriteCurrency(aValue);
    varDate: aWriter.WriteDate(aValue);
    varBoolean:  aWriter.WriteBoolean(aValue);
  else
    aWriter.WriteString(aValue)
  end;
  {$ENDIF}
end;

function GetReaderPosition(AReader: TReader):Longint;
begin
  {$IFNDEF FPC}
  Result := AReader.Position
  {$ELSE}
  Result := THackBinaryObjectReader(AReader.Driver).FStream.Position;
  {$ENDIF}
end;

Procedure SetReaderPosition(AReader: TReader; APosition:Longint);
begin
  {$IFNDEF FPC}
  AReader.Position:=APosition;
  {$ELSE}
  THackBinaryObjectReader(AReader.Driver).FStream.Position:=APosition;
  {$ENDIF}
end;


{$IFDEF DELPHI6}

function D6_Reader_ReadVariant(AReader: TReader): Variant;

  function ReadCustomVariant: Variant;
  var
    OuterStream, InnerStream: TMemoryStream;
    OuterReader: TReader;
    StreamSize: Integer;
    CustomType: TCustomVariantType;
    CustomTypeClassName: string;
    VarStreamer: IVarStreamable;
  begin
    with AReader do begin
      CheckValue(vaBinary);
      OuterStream := TMemoryStream.Create;
      InnerStream := TMemoryStream.Create;
      try
        Read(StreamSize, SizeOf(StreamSize));
        OuterStream.Size := StreamSize;
        Read(OuterStream.Memory^, StreamSize);

        OuterReader := TReader.Create(OuterStream, 1024);
        try
          CustomTypeClassName := OuterReader.ReadString;
          OuterReader.Read(StreamSize, SizeOf(StreamSize));
          InnerStream.Size := StreamSize;
          OuterReader.Read(InnerStream.Memory^, StreamSize);

          if not FindCustomVariantType(CustomTypeClassName, CustomType) or
             not Supports(TObject(CustomType), IVarStreamable, VarStreamer) then
            raise EReadError.CreateRes(@SReadError);
          TVarData(Result).VType := CustomType.VarType;
          VarStreamer.StreamIn(TVarData(Result), InnerStream);
        finally
          OuterReader.Free;
        end;
      finally
        InnerStream.Free;
        OuterStream.Free;
      end;
    end;
  end;

begin
  with AReader do begin
    VarClear(Result);
    case NextValue of
      vaNil, vaNull:       if ReadValue <> vaNil then
                             Result := NULL;
                           // Delphi 6 has a bug vaInt8: Result := Byte(ReadInteger);
      vaInt8:              Result := Shortint(ReadInteger);
      vaInt16:             Result := Smallint(ReadInteger);
      vaInt32:             Result := ReadInteger;
      vaExtended:          Result := ReadFloat;
      vaSingle:            Result := ReadSingle;
      vaCurrency:          Result := ReadCurrency;
      vaDate:              Result := ReadDate;
      vaString, vaLString: Result := ReadString;
      vaWString,
      vaUTF8String:        Result := ReadWideString;
      vaFalse, vaTrue:     Result := ReadValue = vaTrue;
      vaBinary:            Result := ReadCustomVariant;
      vaInt64:             Result := ReadInt64;
    else
      raise EReadError.CreateRes(@SReadError);
    end;
  end;
end;
{$ENDIF}

function Reader_ReadVariant(AReader: TReader): Variant;
begin
  {$IFDEF FPC}
  {$ELSE}
    {$IFDEF DELPHI6}
      Result:= D6_Reader_ReadVariant(AReader);
    {$ELSE}
      Result:= AReader.ReadVariant;
    {$ENDIF}
  {$ENDIF}
end;

{ TDABinDataStreamer }

constructor TDABinDataStreamer.Create(aOwner: TComponent);
begin
  inherited;
  fIsCompatibleV4:=True;
end;

destructor TDABinDataStreamer.Destroy;
begin
  // Just in case the user did not call Finalize

  {if Assigned(fReader) then fReader.Free;
  if Assigned(fWriter) then fWriter.Free;}

  inherited;
end;

procedure TDABinDataStreamer.SetBufferSize(const Value: cardinal);
begin
  if (Value > 0) then inherited SetBufferSize(Value);
end;

procedure TDABinDataStreamer.DoFinalize;
var
  finalpos, i: integer;
begin
  try
    if (AdapterInitialization in AdapterWriteModes) then try
      finalpos := GetWriterPosition(FWriter);

      // Element count. WIll be read by the DoInitialize method
      fWriter.WriteInteger(DatasetCount + DeltaCount);

      for i := 0 to (DatasetCount - 1) do
        WriteElementInfo(TDAElementInfo(DatasetInfoObjects[i]));

      for i := 0 to (DeltaCount - 1) do
        WriteElementInfo(TDAElementInfo(DeltaInfoObjects[i]));

      Writer_FlushBuffer(FWriter);

      SetWriterPosition(FWriter, fInfoIntOffset);
      WriteOffset(finalpos);
    except
      beep;
      raise;
    end;
  finally
    // Somehow I need to check because the FreeAndNIL fails on these objects even if the are set to NIL...
    if AdapterInitialization in AdapterReadModes then
      FreeAndNIL(fReader)

    else if AdapterInitialization in AdapterWriteModes then
      FreeAndNIL(fWriter);
  end;
end;

procedure TDABinDataStreamer.WriteElementInfo(ElementInfo: TDAElementInfo);
begin
  fWriter.WriteInteger(integer(ElementInfo.ElementType));
  fWriter.WriteString(ElementInfo.Name);
  fWriter.WriteInteger(ElementInfo.Offset);
end;

procedure TDABinDataStreamer.ReadElementInfo;
var
  et: TDAElementType;
  nme: string;
  ofs: integer;
begin
  et := TDAElementType(fReader.ReadInteger);
  nme := fReader.ReadString;
  ofs := fReader.ReadInteger;
  AddElementInfo(et, nme, ofs);
end;

procedure TDABinDataStreamer.DoInitialize(Mode: TDAAdapterInitialization);
var
  signature: TBINAdapterSignature;
  currpos, i: integer;
begin
  if (Mode in AdapterReadModes) then begin
    fReader := TReader.Create(Data, BufferSize);
    freader.Root := Owner;

    // Checks the signature
    signature := BINAdapterSignature;
    fReader.Read(signature, SizeOf(signature));
    if (signature <> BINAdapterSignature) then raise Exception.Create('Incompatible binary adapter stream');

    fInfoIntOffset := ReadOffset;
    currpos := GetReaderPosition(FReader);

    // Reads the information attached at the end of the stream
    if (GetReaderPosition(FReader) = fInfoIntOffset) then Exit; // Nothing to read!
    SetReaderPosition(FReader, fInfoIntOffset);

    // Number of elements
    i := fReader.ReadInteger;

    for i := i downto 1 do
      ReadElementInfo;

    // Restores its position and continues
    SetReaderPosition(FReader, currpos);
  end
  else if (Mode in AdapterWriteModes) then begin
    fWriter := TWriter.Create(Data, BufferSize);

    // Writes the signature
    signature := BINAdapterSignature;
    fWriter.Write(signature, SizeOf(signature));

    // This integer will contain the offset of the stream information (datasetcount, names, etc)
    // which will be attached at the end of the stream since this is a sequential write
    fInfoIntOffset := GetWriterPosition(FWriter);
    WriteOffset(0);
  end;
end;

function TDABinDataStreamer.GetElementInfo(ElementType: TDAElementType; const Name: string): TDAElementInfo;
begin
  result := nil;
  case ElementType of
    etDataset: result := TDAElementInfo(DatasetInfoObjects[GetDatasetIndex(Name)]);
    etDelta: result := TDAElementInfo(DeltaInfoObjects[GetDeltaIndex(Name)]);
  end;
end;

procedure TDABinDataStreamer.AddElementInfo(ElementType: TDAElementType; ElementName: string; Offset: integer);
var
  element: TDAElementInfo;
begin
  element := TDAElementInfo.Create;
  element.ElementType := ElementType;
  element.Name := ElementName;
  element.Offset := Offset;

  if ElementType = etDataset then
    AddingDataset(ElementName, element)
  else
    AddingDelta(ElementName, element);
end;

function TDABinDataStreamer.DoCreateStream: TStream;
begin
  result := TMemoryStream.Create;
end;

procedure TDABinDataStreamer.ReadAndApplySchema(const Destination: IDADataset; ApplySchema: boolean);
var
  cnt: integer;
  fields: TDAFieldCollection;
  params: TDAParamCollection;
begin
  fields := Destination.Fields;
  params := Destination.Params;

  cnt := fReader.ReadInteger;

  if (cnt > 0) then begin
    fReader.ReadValue; // Must do for ReadCollection. Do not remove.
    fReader.ReadCollection(fields);
  end
  else fields.Clear;

  cnt := fReader.ReadInteger;
  if (cnt > 0) then begin
    fReader.ReadValue; // Must do for ReadCollection. Do not remove.
    fReader.ReadCollection(params);
  end
  else params.Clear;
end;

procedure TDABinDataStreamer.WriteSchema(const Fields: TDAFieldCollection; const Params: TDAParamCollection; aFieldsIndex: array of integer);
var
  lcoll: TDAFieldCollection;
  i: integer;
begin
  fWriter.WriteInteger(Length(aFieldsIndex));
  if Length(aFieldsIndex) > 0 then begin
    lcoll:=TDAFieldCollection.Create(nil);
    lcoll.IsCompatibleV4:= self.IsCompatibleV4;
    try
      For i:=0 to High(aFieldsIndex) do
        lcoll.Add.AssignField(Fields[aFieldsIndex[i]]);
      fWriter.WriteCollection(lColl);
    finally
      lcoll.Free;
    end;
  end;

  fWriter.WriteInteger(Params.Count);
  if Params.Count > 0 then fWriter.WriteCollection(Params);
end;

procedure TDABinDataStreamer.WriteOffset(Offset: integer);
begin
  fWriter.Write(Offset, SizeOf(integer));
end;

function TDABinDataStreamer.ReadOffset: integer;
begin
  fReader.Read(result, SizeOf(integer));
end;

procedure VariantToWriterAsStr(aDataType : TDADataType; const aSourceVariant : Variant; aWriter : TWriter);
var
  p: pointer;
  s: string;
  lVt: TValueType;
  lSize: cardinal;
begin
  case aDataType of
    datBlob: begin
        case VarType(aSourceVariant) of
          varEmpty: begin
              lSize := 0;
              aWriter.Write(lSize, SizeOf(lSize));
            end;
          varOleStr:
            awriter.WriteWideString(aSourceVariant);
          varString, VarNull:
            begin
              s := VarToStr(aSourceVariant);
              lSize := Length(s);
              if lSize < 256 then begin
                lVt := vaString;
                aWriter.Write(lVt, sizeof(lVt));
                aWriter.Write(lSize, 1);
                awriter.Write(pointer(s)^, lSize);
              end
              else begin
                lVt := vaLString;
                aWriter.Write(lVt, sizeof(lVt));
                aWriter.Write(lSize, sizeof(lSize));
                awriter.Write(pointer(s)^, lSize);
              end;
            end;
          8209:begin { 8209 is binary array }
              lSize := VarArrayHighBound(aSourceVariant, 1)-VarArrayLowBound(aSourceVariant, 1)+1;
              p := VarArrayLock(aSourceVariant);
              try
                if lSize < 256 then begin
                  lVt := vaString;
                  aWriter.Write(lVt, sizeof(lVt));
                  aWriter.Write(lSize, 1);
                  awriter.Write(p^, lSize);
                end
                else begin
                  lVt := vaLString;
                  aWriter.Write(lVt, sizeof(lVt));
                  aWriter.Write(lSize, sizeof(lSize));
                  awriter.Write(p^, lSize);
                end;
              finally
                VarArrayUnlock(aSourceVariant);
              end;
            end;
          else begin
            RaiseError('Invalid variant type (%d) for Blob.',[VarType(aSourceVariant)]);
          end;
        end;
      end;
    else begin
      Writer_WriteVariant(aWriter, aSourceVariant);
    end;
  end;
end;

procedure WriteGuid(aWriter: TWriter; const aVal: String);
var
  g: TGuid;
begin
  g := StringToGUID(aVal);
  aWriter.Write(g, Sizeof(g));
end;

procedure WriteDecimal(aWriter: TWriter; const aVal: Variant);
var
  dec: TDecimal;
begin
  dec:= VariantToDecimal(aVal);
  aWriter.Write(dec, Sizeof(Dec));
end;


function TDABinDataStreamer.DoWriteDataset(const Source: IDADataset;
  Options: TDAWriteOptions;
  MaxRows: integer;
  ADynFieldNames: array of string): integer;
var
  lDataForAppend: TDADataForAppend;
begin
  lDataForAppend := DoBeginWriteDataset(Source, {schema}nil, Options, MaxRows, ADynFieldNames);
  if woRows in Options then begin
    DoWriteDatasetData(Source, lDataForAppend);
    result := DoEndWriteDataset(lDataForAppend);
  end
  else begin
    result := -1;
  end;
end;

function CreateByteArray(const s: string): Variant;
begin
  result := VarArrayCreate([0, Length(s)-1], varByte);
  if Length(s) > 0 then
    Move(s[1], VarArrayLock(Result)^, Length(S));
  VarArrayUnlock(Result);
end;

function ReadGuid(aReader: TReader): TGuid;
begin
  aReader.Read(Result, Sizeof(Result));
end;

function ReadDecimal(aReader: TReader): Variant;
var
  dec: TDecimal;
begin
  aReader.Read(dec, Sizeof(Dec));
  Result := DecimalToVariant(dec);
end;

{$IFDEF FPC}
type
 PDateTime = ^TDateTime;
{$ENDIF}

procedure TDABinDataStreamer.DoReadDataset(const DatasetName: string; const Destination: IDADataset; ApplySchema: boolean);
var
  elementinfo: TDAElementInfo;
  editable: IDAEditableDataset;
  schemaend, cnt, i: integer;
  fld: TDAField;
  dt: TDADataType;
  schemapresent: boolean;
  val: Variant;
  readonlyfields: array of boolean;
  //bigVal: Int64;
  memdataset: IDAMemDatasetBatchAdding;
  buf, buf1: pchar;
  ws: widestring;
  s: string;
  bcd: TDecimal;
begin
  if Destination.Active and ApplySchema then raise Exception.Create('Cannot apply a schema if the destination is active');

  elementinfo := GetElementInfo(etDataset, DatasetName);
  SetReaderPosition(FReader, elementinfo.Offset);

  editable := Destination as IDAEditableDataset;

  Destination.DisableControls;
  try
    editable.DisableEventHandlers;
    try
      fReader.BeginReferences;
      try
        // Checks to see if the schema is present
        schemapresent := fReader.ReadBoolean;
        schemaend := ReadOffset;

        if schemapresent and ApplySchema then begin
          ReadAndApplySchema(Destination, ApplySchema);
        end
        else if (schemaend > 0) then
          SetReaderPosition(FReader, schemaend);
        fReader.FixupReferences;

        // Reads the row count
        //cnt := fReader.ReadInteger;
        fReader.Read(cnt, SizeOf(cnt));
        if (cnt = -1) then Exit; // Only schema is present!

        // TODO: this is a nasty bug. If we read the schema AND the stream, also contains data
        // it goes in recursion here... Temporary fix is you just do one of the two for now
        if ApplySchema then Exit;

        if not Destination.Active then Destination.Open;

        with editable do try
          // Temporarily sets all fields as writable
          Destination.DisableConstraints;
          SetLength(readonlyfields, Fields.Count);
          for i := 0 to (Fields.Count - 1) do begin
            readonlyfields[i] := Fields[i].ReadOnly;
            Fields[i].ReadOnly := FALSE;
          end;

          {$IFDEF STORERECID}
          Destination.CurrentRecIdValue := max(1,Destination.CurrentRecIdValue);
          {$ENDIF}

          if Destination.QueryInterface(IDAMemDatasetBatchAdding, memdataset) <> s_ok then memdataset := nil;

          if (memdataset = nil) or Assigned(OnReadFieldValue) then begin
            // standard mode
            // Inserts the records
            while (cnt > 0) do try
              Append;

              {$IFDEF STORERECID}
          Destination.CurrentRecIdValue := max(Destination.CurrentRecIdValue,fReader.ReadInteger);//#2
              {$ENDIF}

              for i := 0 to (Fields.Count - 1) do begin
                fld := Fields[i];

                if fld.Calculated or fld.Lookup then Continue;

                val := Null; // Default (see datUnknown below)
                dt := TDADataType(fReader.ReadInteger);

                case dt of
                  datUnknown: ; // Field was null
                  datWideString,
                  datWideMemo: val := fReader.ReadWideString;
                  datString: val := fReader.ReadString;
                  datDateTime: val := fReader.ReadDate;
                  datFloat: val := fReader.ReadFloat;
                  datCurrency: val := fReader.ReadCurrency;
                  datBoolean: val := fReader.ReadBoolean;
                  datAutoInc,
                  datInteger: val := fReader.ReadInteger;
                  datSingleFloat: val := fReader.ReadSingle;
                  datLargeUInt,
                  datLargeAutoInc,
                  datLargeInt: val := fReader.ReadInt64;

                  datByte: val := Byte(fReader.ReadInteger);
                  datShortInt: val := ShortInt(fReader.ReadInteger);
                  datWord: val := Word(fReader.ReadInteger);
                  datSmallInt: val := SmallInt(fReader.ReadInteger);
                  datCardinal: val := Cardinal(fReader.ReadInteger);
                  datGuid: val := GuidToString(ReadGuid(fReader));
                  datXml: val := fReader.ReadWideString;
                  datDecimal: val := ReadDecimal(fReader);
                  datMemo: val := fReader.ReadString;
                  datBlob: val := fReader.ReadString;
                end;

                if Assigned(OnReadFieldValue) then OnReadFieldValue(fld, val);
                if VarIsNull(val) then continue;
                fld.Value := val;
              end;

              try
                Post;
              except
                // Introduced to restore the dsBrowse state of the datatable
                // in case of errors
                Cancel;
                raise;
              end;
            finally
              Dec(cnt);
            end;
          end else begin
            // batch loading
            // Inserts the records
            while (cnt > 0) do try
              //Append;
              buf:= memdataset.AllocRecordBuffer;
              try
                for i := 0 to (Fields.Count - 1) do begin
                  fld := Fields[i];

                  if fld.Calculated or fld.Lookup then Continue;
                  buf1:= memdataset.GetFieldNativeBuffer(buf,fld.BindedField);
                  dt := TDADataType(fReader.ReadInteger);
                  if dt = datUnknown then
                    memdataset.SetNullMask(buf,fld.BindedField,True)  // Field was null
                  else
                    memdataset.SetNullMask(buf,fld.BindedField,False) ; // Field was not null
                  case dt of
                    datUnknown: ;
                    datWideString, datXml: memdataset.SetWideString(buf1,fld.BindedField,fReader.ReadWideString);//PWideString(buf1)^ := fReader.ReadWideString;
                    datString: memdataset.SetAnsiString(buf1,fld.BindedField,fReader.ReadString);//PAnsiString(buf1)^ := fReader.ReadString;
                    datCurrency: PDouble(buf1)^ := fReader.ReadCurrency;
                    datDateTime: PDateTime(buf1)^ := TimeStampToMSecs(DateTimeToTimeStamp(fReader.ReadDate));
                    datFloat: PDouble(buf1)^ := fReader.ReadFloat;
                    datLargeInt, datLargeAutoInc, datLargeUInt: PInt64(buf1)^ := fReader.ReadInt64;
                    datBoolean: PBoolean(buf1)^ := fReader.ReadBoolean;
                    datAutoInc, datInteger: PInteger(buf1)^ := fReader.ReadInteger;
                    datSingleFloat: PDouble(buf1)^ := fReader.ReadSingle;
                    datDecimal: begin
                      fReader.Read(bcd, Sizeof(bcd));
                      PBCD(buf1)^ := DecimalToBCD(bcd);
                    end;
                    datCardinal: PCardinal(buf1)^ := Cardinal(fReader.ReadInteger);
                    datByte: PSmallInt(buf1)^ := Byte(fReader.ReadInteger);
                    datWord: PWord(buf1)^ := Word(fReader.ReadInteger);
                    datShortInt: PSmallInt(buf1)^ := ShortInt(fReader.ReadInteger);
                    datSmallInt: PSmallInt(buf1)^ := SmallInt(fReader.ReadInteger);
                    datGuid: begin
                      s := GuidToString(ReadGuid(fReader));
                      Move(pointer(s)^, pointer(buf1)^, 38 {Length(GuidString)});
                    end;
                    datBlob,datMemo: PPointer(buf1)^ := memdataset.MakeBlobFromString(fReader.ReadString);
                    datWideMemo: begin
                      ws:= fReader.ReadWideString;
                      SetString(S,PChar(PWideChar(ws)),Length(ws)*SizeOf(WideChar));
                      PPointer(buf1)^ := memdataset.MakeBlobFromString(s);
                      ws:='';
                    end;
                  end;
                 // val =
                 // if Assigned(OnReadFieldValue) then OnReadFieldValue(fld, val);
                 // fld.Value := val;
                end;
                memdataset.AppendBuffer(Buf);
              except
                memdataset.FreeRecordBuffer(buf);
                raise;
              end;
            finally
              Dec(cnt);
            end;
            memdataset.FinalizeBatchAdding;            
          end;
        finally
          // Restores the read-only property
          for i := 0 to (Fields.Count - 1) do
            Fields[i].ReadOnly := readonlyfields[i];
          Destination.EnableConstraints;
        end;

        // TODO: temporary hack for the TClientDataset. Somehow if we don't do this the
        //       cursor is locked to the last record and there's no way to move!
        {editable.Next;
        editable.First;}
      finally
        fReader.EndReferences;
      end;
    finally
      editable.EnableEventHandlers;
    end;
  finally
    Destination.EnableControls;
  end;
end;

procedure VariantToWriter(aDataType : TDADataType; const aSourceVariant : Variant; aWriter : TWriter);
var
  p: pointer;
  lSize: cardinal;
begin
  case aDataType of
    datBlob: begin
        case VarType(aSourceVariant) of
          varEmpty:begin
              lSize := 0;
              aWriter.Write(lSize, SizeOf(lSize));
            end;
          8209:begin { 8209 is binary array }
              lSize := VarArrayHighBound(aSourceVariant, 1)-VarArrayLowBound(aSourceVariant, 1)+1;
              p := VarArrayLock(aSourceVariant);
              try
                aWriter.Write(lSize, SizeOf(lSize));
                aWriter.Write(p^, lSize);
              finally
                VarArrayUnlock(aSourceVariant);
              end;
            end;
          else begin
            RaiseError('Invalid variant type (%d) for Blob.',[VarType(aSourceVariant)]);
          end;
        end;
      end;
    else begin
      Writer_WriteVariant(aWriter, aSourceVariant);
    end;
  end;
end;

function ReaderToVariant(aDataType : TDADataType; aReader : TReader): Variant;
var
  p: pointer;
  sze : cardinal;
begin
  case aDataType of
    datBlob : begin
      aReader.Read(sze, SizeOf(sze));

        if (sze = 0) then
          result := Unassigned
      else try
        result := VarArrayCreate([0, sze-1], varByte);
        p := VarArrayLock(result);
        aReader.Read(p^, sze);
      finally
        VarArrayUnlock(result);
      end;
    end;
  else
    result := Reader_ReadVariant(aReader);
  end;
end;

procedure TDABinDataStreamer.DoWriteDelta(const Source: IDADelta);
var
  i, x: integer;
begin
  // This information will be used later to complete the stream (see DoInitialize)
  AddElementInfo(etDelta, Source.LogicalName, GetWriterPosition(FWriter));

  // Number of changes
  fWriter.WriteInteger(Source.Count);

  // Numnber of fields, field names and their types
  fWriter.WriteInteger(Source.LoggedFieldCount);
  for i := 0 to (Source.LoggedFieldCount - 1) do begin
    fWriter.WriteString(Source.LoggedFieldNames[i]);
    fWriter.WriteInteger(integer(Source.LoggedFieldTypes[i]));
  end;

  // Key fields
  fWriter.WriteInteger(Source.KeyFieldCount);
  for i := 0 to (Source.KeyFieldCount - 1) do begin
    fWriter.WriteString(Source.KeyFieldNames[i]);
  end;

  if (Source.Count = 0) then Exit;

  // Actual changes
  fWriter.WriteInteger(Source.Count);
  for i := 0 to (Source.Count - 1) do begin
    // Change type, RecID, status and message
    x := integer(Source.Changes[i].ChangeType);
    fWriter.WriteInteger(x);

    fWriter.WriteInteger(Source.Changes[i].RecID);

    x := integer(Source.Changes[i].Status);
    fWriter.WriteInteger(x);

    fWriter.WriteString(Source.Changes[i].Message);

    // Old values
    for x := 0 to (Source.LoggedFieldCount - 1) do begin
      //fWriter.WriteVariant(Source.Changes[i].OldValues[x]);
      VariantToWriter(Source.LoggedFieldTypes[x], Source.Changes[i].OldValues[x], fWriter);
    end;

    // New values
    for x := 0 to (Source.LoggedFieldCount - 1) do begin
      //fWriter.WriteVariant(Source.Changes[i].NewValues[x]);                                           }
      VariantToWriter(Source.LoggedFieldTypes[x], Source.Changes[i].NewValues[x], fWriter);
    end;
  end;
end;

procedure TDABinDataStreamer.DoReadDelta(const DeltaName: string; const Destination: IDADelta);
var
  elementinfo: TDAElementInfo;
  msg, str: string;
  recid, i, cnt, x: integer;
  change: TDADeltaChange;
  changetype: TDAChangeType;
  status: TDAChangeStatus;
  val: Variant;
begin
  elementinfo := GetElementInfo(etDelta, DeltaName);
  SetReaderPosition(FReader, elementinfo.Offset);

  // Number of changes
  cnt := fReader.ReadInteger;

  // Field number, names and types
  Destination.ClearFieldNames;
  i := fReader.ReadInteger;
  for i := i downto 1 do begin
    str := fReader.ReadString;
    Destination.AddFieldName(str);
    Destination.LoggedFieldTypes[Destination.LoggedFieldCount-1] := TDADataType(fReader.ReadInteger);
  end;

  // Key fields
  Destination.ClearKeyFieldNames;
  i := fReader.ReadInteger;
  for i := i downto 1 do begin
    str := fReader.ReadString;
    Destination.AddKeyFieldName(str);
  end;

  if (cnt = 0) then Exit;

  // Actual changes
  cnt := fReader.ReadInteger;
  for i := 1 to cnt do begin
    x := fReader.ReadInteger;
    changetype := TDAChangeType(x);
    recid := fReader.ReadInteger;

    x := fReader.ReadInteger;
    status := TDAChangeStatus(x);

    msg := fReader.ReadString;

    change := Destination.Add(recid, changetype, status, msg);
    //Destination.Add(change);

    // Old values
    for x := 0 to (Destination.LoggedFieldCount - 1) do begin
      {val := fReader.ReadVariant;
      change.OldValues[x] := val;}
      val := ReaderToVariant(Destination.LoggedFieldTypes[x], fReader);
      change.OldValues[x] := val;
    end;

    // New values
    for x := 0 to (Destination.LoggedFieldCount - 1) do begin
      {val := fReader.ReadVariant;
      change.NewValues[x] := val;}
        val := ReaderToVariant(Destination.LoggedFieldTypes[x], fReader);
        change.NewValues[x] := val;
    end;
  end;
end;

function TDABinDataStreamer.GetTargetDataType: TRODataType;
begin
  result := rtBinary
end;

function TDABinDataStreamer.DoBeginWriteDataset( const Source: IDADataset; const Schema: TDADataset;
                              Options: TDAWriteOptions; MaxRows: integer;
                              ADynFieldNames: array of string): TDADataForAppend;
var
  cntpos, currpos, k, i: integer;
  fld: TDAField;
  wrtschema: boolean;
  lfields: array of integer;
  lDataForAppend : TDADataForAppend;
  lSchemaFields: TDAFieldCollection;
  lSchemaParams: TDAParamCollection;
  lLogicalName: String;
begin
  lDataForAppend := TDADataForAppend.Create();
  result := lDataForAppend;

  if Assigned(Schema) then begin
    lDataForAppend.TableSchema := Schema;
    if Schema is TDAUnionDataTable then begin
      fld := Schema.FindField(def_SourceTableFieldName);
      if not Assigned(fld) then begin
        fld := Schema.Fields.Add();
        fld.Name := def_SourceTableFieldName;
        fld.DataType := datInteger;
        fld.InPrimaryKey := true;
        fld.ServerAutoRefresh := true;
      end;
    end;
    lSchemaFields := Schema.Fields;
    lSchemaParams := Schema.Params;
    lLogicalName := Schema.Name;
  end else begin
    if Assigned(Source) then begin
      lSchemaFields := Source.Fields;
      lSchemaParams := Source.Params;
      lLogicalName := Source.LogicalName;
    end else begin
      raise EDAException.Create('Schema or source should be assigned.');
    end;
  end;


  if Length(ADynFieldNames) > 0 then begin
    SetLength(lfields, Length(ADynFieldNames));
    For i:=0 to High(ADynFieldNames) do begin
      fld:=lSchemaFields.FindField(ADynFieldNames[i]);
      if fld <> nil then
        lfields[i]:= fld.Index
      else
        lfields[i]:= -1;
    end;
  end else begin
    SetLength(lfields, lSchemaFields.Count);
    For i:=0 to lSchemaFields.Count-1 do
      lfields[i]:=i;
  end;

  // This information will be used later to complete the stream (see DoInitialize)
  AddElementInfo(etDataset, lLogicalName, GetWriterPosition(FWriter));

  // Writes a boolean flag that indicates if the schema is being written
  wrtschema := (woSchema in Options) or (Length(ADynFieldNames)>0);
  fWriter.WriteBoolean(wrtschema);

  // Write the offset to jump to if the reader wants to skip the schema
  currpos := GetWriterPosition(FWriter);
  WriteOffset(0);

  if wrtschema then begin
    WriteSchema(lSchemaFields, lSchemaParams, lfields);
    Writer_FlushBuffer(FWriter);

    // Writes the offset of the schema's end
    k := GetWriterPosition(FWriter);
    SetWriterPosition(FWriter, currpos);
    WriteOffset(k);
    SetWriterPosition(FWriter, k);
  end;

  // Writes the row count
  cntpos := GetWriterPosition(FWriter);

  if not (woRows in Options) then begin
    fWriter.WriteInteger(-1);
  end else begin
    k := 0;
    fWriter.Write(k, SizeOf(k));
  end;

  SetLength(lDataForAppend.RealFields, Length(lFields));
  for i:= 0 to Length(lFields) -1 do
  lDataForAppend.RealFields[i] := lFields[i];

  lDataForAppend.MaxRowCount := MaxRows;
  lDataForAppend.CountOfRecordsPosition := cntpos;
  lDataForAppend.EndDataPosition := GetWriterPosition(FWriter);
  lDataForAppend.RecordCount := k;
end;

function TDABinDataStreamer.DoWriteDatasetData(const Source: IDADataset; var aDataForAppend: TDADataForAppend; aDataIndex: Integer = -1): Integer;
var
  max, k, i: integer;
  fld: TDAField;
  val: Variant;
  lDataForAppend: TDADataForAppend;
  lFields: array of integer;
  bigVal: Int64;
  lFieldName: String;
  lMapToFieldName: String;
  lColumnMappings: TDAColumnMappingCollection;
  lColumnMapping: TDAColumnMapping;
begin

  lDataForAppend := aDataForAppend;
  SetWriterPosition(FWriter, lDataForAppend.EndDataPosition);
  SetLength(lfields, Length(lDataForAppend.RealFields));
  for i:= 0 to Length(lDataForAppend.RealFields) -1 do
    lFields[i] := lDataForAppend.RealFields[i];

  k := lDataForAppend.RecordCount;
  max := lDataForAppend.MaxRowCount;


  // Mapping fields of Source table to the streamed dataset
  if Assigned(lDataForAppend.TableSchema) and (lDataForAppend.TableSchema is TDAUnionDataTable) then begin
    lColumnMappings := TDAUnionSourceTable(TDAUnionDataTable(lDataForAppend.TableSchema).SourceTables.ItemByName(Source.Name)).ColumnMappings;
    for i := 0 to lDataForAppend.TableSchema.Fields.Count - 1 do begin
      lFieldName := lDataForAppend.TableSchema.Fields[lFields[i]].Name;
      if lFieldName = def_SourceTableFieldName then begin
        lFields[i] := -10;
        continue;
      end;
      lMapToFieldName := lFieldName;
      if Assigned(lColumnMappings) then begin
        lColumnMapping := lColumnMappings.MappingByDatasetField(lFieldName);
        if Assigned(lColumnMapping) and (lColumnMapping.TableField <> '') then
          lMapToFieldName := lColumnMapping.TableField;
      end;
      lFields[i] := Source.FieldByName(lMapToFieldName).Index;
    end;
  end;


  Source.DisableControls();
  if not Source.active then Source.Open();
  try
    // Writes the actual records
    while (k<>max) and not Source.EOF do begin
      {$IFDEF STORERECID}
      fWriter.WriteInteger(Source.GetRowRecIdValue);
      {$ENDIF}
      for i := 0 to Length(lfields) - 1 do begin

        //RealFields[i] = -10 then this is @SourceTable field
        if lfields[i] = -10 then begin
          fld := lDataForAppend.TableSchema.FieldByName(def_SourceTableFieldName);
          val := aDataIndex;
        end else begin
          fld := Source.Fields[lfields[i]];
          val := Source.FieldValues[lfields[i]];
        end;

        if Assigned(OnBeforeFieldValueSerialization) then OnBeforeFieldValueSerialization(fld, val);

        if fld.Calculated or fld.Lookup then Continue;
        if Assigned(OnWriteFieldValue) then OnWriteFieldValue(fld, val);

        if (lfields[i] = -10) or ((not fld.IsNull) and (not VarIsNull(Val))) then begin
          fWriter.WriteInteger(integer(fld.DataType));
          case fld.DataType of
            datWideString,
            datWideMemo: fWriter.WriteWideString(VarToWideStr(val));
            datString: fWriter.WriteString(VarToStr(val));
            datDateTime: fWriter.WriteDate(val);
            datFloat: fWriter.WriteFloat(val);
            datBoolean: fWriter.WriteBoolean(val);
            datCurrency: fWriter.WriteCurrency(val);
            datByte,
            datShortInt,
            datWord,
            datSmallInt,
            datCardinal,
            datAutoInc,
            datInteger: fWriter.WriteInteger(val);
            datSingleFloat: fwriter.WRiteSingle(val);

            //datLargeInt: fWriter. WriteInteger(val);
            datLargeAutoInc,
            datLargeUInt,
            datLargeInt: begin
              bigVal := val;
              fWriter.WriteInteger(bigVal);
            end;
            datGuid: WriteGuid(fWriter, Val);
            datXml: fWriter.WriteWideString(Val);
            datDecimal: WriteDecimal(fWriter, Val);
            datMemo: fWriter.WriteString(VarToStr(val));
            datBlob: begin
                VariantToWriterAsStr(datBlob, val, fWriter);
            end;
          end;
        end else
          fWriter.WriteInteger(Ord(datUnknown));
      end;

      Inc(result);
      Inc(k);
      Source.Next;

      if Source.EOF then Break;
    end;

    lDataForAppend.EndDataPosition := GetWriterPosition(FWriter);
    lDataForAppend.RecordCount := k;
    result := k;
  finally
    Source.EnableControls;
  end;
end;

function TDABinDataStreamer.DoEndWriteDataset(aDataForAppend: TDADataForAppend): Integer;
begin
  Writer_FlushBuffer(FWriter);
  result := aDataForAppend.RecordCount;
  SetWriterPosition(FWriter, aDataForAppend.CountOfRecordsPosition);
  fWriter.Write(aDataForAppend.RecordCount, SizeOf(aDataForAppend.RecordCount));
  SetWriterPosition(FWriter, aDataForAppend.EndDataPosition);
  aDataForAppend.Free();
end;


end.