1838 lines
69 KiB
ObjectPascal
1838 lines
69 KiB
ObjectPascal
unit uDABin2DataStreamer;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up }
|
|
{ platform: Win32 }
|
|
{ }
|
|
{ (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}
|
|
|
|
{.$DEFINE BIN2DEBUG_time}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
uDAInterfaces, uDADelta, uROTypes,
|
|
uDADataStreamer;
|
|
|
|
type
|
|
TBIN2AdapterSignature = array[0..7] of char;
|
|
|
|
const
|
|
BIN2AdapterSignature: TBIN2AdapterSignature = 'DABIN200';
|
|
type
|
|
|
|
TDASmallFieldInfo = packed record
|
|
Name: String;
|
|
Datatype: TDADataType;
|
|
Size: integer;
|
|
end;
|
|
|
|
TDADataForAppendBin2 = class(TDADataForAppend)
|
|
public
|
|
FieldsInfo: array of TDASmallFieldInfo;
|
|
end;
|
|
|
|
TDAElementType = (etDataset, etDelta);
|
|
{ TElementInfo }
|
|
TDAElementInfo = class
|
|
ElementType: TDAElementType;
|
|
Name: Ansistring;
|
|
Offset: integer;
|
|
end;
|
|
|
|
|
|
|
|
type
|
|
TDABin2DataStreamer = class(TDADataStreamer)
|
|
private
|
|
fInfoIntOffset: integer;
|
|
fHasReducedDelta: Boolean;
|
|
procedure ReadElementInfo;
|
|
procedure WriteElementInfo(ElementInfo: TDAElementInfo);
|
|
procedure AddElementInfo(ElementType: TDAElementType; ElementName: string; Offset: integer);
|
|
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;
|
|
procedure WriteField(const AField: TDAField);
|
|
procedure WriteParam(const AParam: TDAParam);
|
|
procedure ReadParam(const AParam: TDAParam; const aParamPropertiesCount: integer);
|
|
procedure ReadField(const AField: TDAField; const aFieldPropertiesCount: integer);
|
|
protected
|
|
procedure InternalDoReadDataset(const Destination: IDAEditableDataset; ARecordCount: integer; ARealFields: array of integer);virtual;
|
|
procedure InternalDoWriteDataset(const Source: IDADataset; var k: integer; const Maxrecords: integer; ARealFields: array of integer;aDataIndex: Integer; info: array of TDASmallFieldInfo);virtual;
|
|
procedure InternalDoWriteDataset_NonDataset(const Source: IDADataset; var k: integer; const Maxrecords: integer; ARealFields: array of integer;aDataIndex: Integer; info: array of TDASmallFieldInfo);virtual;
|
|
procedure CheckSignature(aSignature: TBIN2AdapterSignature);
|
|
// To override
|
|
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;
|
|
|
|
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;
|
|
|
|
|
|
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;
|
|
public
|
|
function HasReducedDelta: Boolean; override;
|
|
function GetTargetDataType: TRODataType; override;
|
|
published
|
|
property BufferSize;
|
|
property SendReducedDelta;
|
|
end;
|
|
|
|
|
|
implementation
|
|
{$IFNDEF MSWINDOWS}
|
|
{$UNDEF BIN2DEBUG_time}
|
|
{$ENDIF}
|
|
uses
|
|
{$IFDEF BIN2DEBUG_time}Windows,{$ENDIF BIN2DEBUG_time}
|
|
SysUtils, Variants, FMTBcd, uROBinaryHelpers, DB,
|
|
uROClasses, uDAEngine, uDAClasses;
|
|
|
|
type
|
|
{$IFDEF DELPHI6}
|
|
UInt64 = Int64;
|
|
{$ENDIF}
|
|
PUInt64 = ^UInt64;
|
|
|
|
const
|
|
field_count = 34;
|
|
param_count = 11;
|
|
TAlignmentStrings: array[Low(TAlignment)..High(TAlignment)] of ansistring =
|
|
('taLeftJustify', 'taRightJustify', 'taCenter');
|
|
TDABlobTypeStrings: array[Low(TDABlobType)..High(TDABlobType)] of ansistring =
|
|
('dabtUnknown', 'dabtBlob', 'dabtMemo', 'dabtOraBlob',
|
|
'dabtOraClob', 'dabtGraphic', 'dabtTypedBinary', 'dabtTimestamp');
|
|
TDADataTypeStrings: array[Low(TDADataType)..High(TDADataType)] of ansistring =
|
|
('datUnknown', 'datString', 'datDateTime', 'datFloat',
|
|
'datCurrency', 'datAutoInc', 'datInteger', 'datLargeInt',
|
|
'datBoolean', 'datMemo', 'datBlob', 'datWideString',
|
|
'datWideMemo', 'datLargeAutoInc', 'datByte', 'datShortInt',
|
|
'datWord', 'datSmallInt', 'datCardinal', 'datLargeUInt',
|
|
'datGuid', 'datXml', 'datDecimal', 'datSingleFloat');
|
|
TDAParamTypeStrings:array[Low(TDAParamType)..High(TDAParamType)] of ansistring =
|
|
('daptUnknown', 'daptInput', 'daptOutput', 'daptInputOutput',
|
|
'daptResult');
|
|
|
|
|
|
function TAlignmentStringsToTAlignment(aValue: Ansistring): TAlignment;
|
|
begin
|
|
for Result := Low(TAlignment) to High(TAlignment) do
|
|
if TAlignmentStrings[Result] = aValue then Exit;
|
|
raise Exception.Create('Unknown TAlignment value: '''+aValue+'''');
|
|
end;
|
|
|
|
function TDABlobTypeStringsToTDABlobType(aValue: Ansistring): TDABlobType;
|
|
begin
|
|
for Result := Low(TDABlobType) to High(TDABlobType) do
|
|
if TDABlobTypeStrings[Result] = aValue then Exit;
|
|
raise Exception.Create('Unknown TDABlobType value: '''+aValue+'''');
|
|
end;
|
|
|
|
function TDADataTypeStringsToTDADataType(aValue: Ansistring): TDADataType;
|
|
begin
|
|
for Result := Low(TDADataType) to High(TDADataType) do
|
|
if TDADataTypeStrings[Result] = aValue then Exit;
|
|
raise Exception.Create('Unknown TDADataType value: '''+aValue+'''');
|
|
end;
|
|
|
|
function TDAParamTypeStringsToTDAParamType(aValue: Ansistring): TDAParamType;
|
|
begin
|
|
for Result := Low(TDAParamType) to High(TDAParamType) do
|
|
if TDAParamTypeStrings[Result] = aValue then Exit;
|
|
raise Exception.Create('Unknown TDAParamType value: '''+aValue+'''');
|
|
end;
|
|
|
|
procedure SetBitMask(Buffer: PAnsiChar; const Index: Integer; const Value: boolean);
|
|
var
|
|
i: byte;
|
|
begin
|
|
i := Index shr 3;
|
|
if Value then
|
|
Buffer[I] := AnsiChar(ord(Buffer[I]) or (1 shl (Index and 7)))
|
|
else
|
|
Buffer[I] := AnsiChar(ord(Buffer[I]) and not (1 shl (Index and 7)))
|
|
end;
|
|
|
|
function GetBitMask(Buffer: PAnsiChar; const Index: Integer): boolean;
|
|
begin
|
|
Result := (ord(Buffer[Index shr 3]) shr (Index and 7)) and 1 = 1;
|
|
end;
|
|
|
|
procedure ClearBitMask(Buffer: PAnsiChar; BitMaskSize:integer; Value: byte = 0 );
|
|
begin
|
|
FillChar(Buffer^, BitMaskSize, Value);
|
|
end;
|
|
|
|
function ReadBooleanFromStream(Stream: TStream): ByteBool;
|
|
begin
|
|
Stream.Read(Result, SizeOf(ByteBool));
|
|
end;
|
|
|
|
procedure WriteBooleanToStream(Stream: TStream; const Value: ByteBool);
|
|
begin
|
|
Stream.Write(Value, SizeOf(ByteBool));
|
|
end;
|
|
|
|
function ReadWordBoolFromStream(Stream: TStream): WordBool;
|
|
begin
|
|
Stream.Read(Result, SizeOf(WordBool));
|
|
end;
|
|
|
|
procedure WriteWordBoolToStream(Stream: TStream; const Value: WordBool);
|
|
begin
|
|
Stream.Write(Value, SizeOf(WordBool));
|
|
end;
|
|
|
|
|
|
function ReadByteFromStream(Stream: TStream): Byte;
|
|
begin
|
|
Stream.Read(Result, SizeOf(Byte));
|
|
end;
|
|
|
|
procedure WriteByteToStream(Stream: TStream; const Value: Byte);
|
|
begin
|
|
Stream.Write(Value, SizeOf(Byte));
|
|
end;
|
|
|
|
function ReadShortIntFromStream(Stream: TStream): ShortInt;
|
|
begin
|
|
Stream.Read(Result, SizeOf(ShortInt));
|
|
end;
|
|
|
|
procedure WriteShortIntToStream(Stream: TStream; const Value: ShortInt);
|
|
begin
|
|
Stream.Write(Value, SizeOf(ShortInt));
|
|
end;
|
|
|
|
function ReadWordFromStream(Stream: TStream): Word;
|
|
begin
|
|
Stream.Read(Result, SizeOf(Word));
|
|
end;
|
|
|
|
procedure WriteWordToStream(Stream: TStream; const Value: Word);
|
|
begin
|
|
Stream.Write(Value, SizeOf(Word));
|
|
end;
|
|
|
|
function ReadGUIDFromStream(Stream: TStream): Ansistring;
|
|
begin
|
|
SetLength(Result,38);
|
|
Result[1]:='{';
|
|
Stream.Read(Result[2], 36 {Length(GuidString)-2});
|
|
Result[38]:='}'
|
|
end;
|
|
|
|
procedure WriteGUIDToStream(Stream: TStream; const Value: Ansistring);
|
|
begin
|
|
if Length(Value) <> 38 then
|
|
raise Exception.Create('Invalid GUID: '+Value)
|
|
else
|
|
Stream.Write(Value[2], 36 {Length(GuidString)-2});
|
|
end;
|
|
|
|
|
|
function ReadDecimalFromStream(Stream: TStream): TDecimal;
|
|
begin
|
|
Stream.Read(Result, Sizeof(Result));
|
|
end;
|
|
|
|
function ReadBCDFromStream(Stream: TStream): TBCD;
|
|
begin
|
|
Result := DecimalToBCD(ReadDecimalFromStream(Stream));
|
|
end;
|
|
|
|
procedure WriteDecimalToStream(Stream: TStream; const Value: TDecimal);
|
|
begin
|
|
Stream.Write(Value, Sizeof(Value));
|
|
end;
|
|
|
|
procedure WriteBCDToStream(Stream: TStream; const Value: TBCD);
|
|
begin
|
|
WriteDecimalToStream(Stream,BCDToDecimal(Value));
|
|
end;
|
|
|
|
function ReadSingleFromStream(Stream: TStream): Single;
|
|
begin
|
|
Stream.Read(Result, SizeOf(Single));
|
|
end;
|
|
|
|
procedure WriteSingleToStream(Stream: TStream; const Value: Single);
|
|
begin
|
|
Stream.Write(Value, SizeOf(Single));
|
|
end;
|
|
|
|
function ReadSmallIntFromStream(Stream: TStream): SmallInt;
|
|
begin
|
|
Stream.Read(Result, SizeOf(SmallInt));
|
|
end;
|
|
|
|
procedure WriteSmallIntToStream(Stream: TStream; const Value: SmallInt);
|
|
begin
|
|
Stream.Write(Value, SizeOf(SmallInt));
|
|
end;
|
|
|
|
function ReadCardinalFromStream(Stream: TStream): Cardinal;
|
|
begin
|
|
Stream.Read(Result, SizeOf(Cardinal));
|
|
end;
|
|
|
|
procedure WriteCardinalToStream(Stream: TStream; const Value: Cardinal);
|
|
begin
|
|
Stream.Write(Value, SizeOf(Cardinal));
|
|
end;
|
|
|
|
function ReadCurrencyFromStream(Stream: TStream): Currency;
|
|
begin
|
|
Stream.Read(Result, SizeOf(Currency));
|
|
end;
|
|
|
|
procedure WriteCurrencyToStream(Stream: TStream; const Value: Currency);
|
|
begin
|
|
Stream.Write(Value, SizeOf(Currency));
|
|
end;
|
|
|
|
function ReadDoubleFromStream(Stream: TStream): Double;
|
|
begin
|
|
Stream.Read(Result, SizeOf(Double));
|
|
end;
|
|
|
|
procedure WriteDoubleToStream(Stream: TStream; const Value: Double);
|
|
begin
|
|
Stream.Write(Value, SizeOf(Double));
|
|
end;
|
|
|
|
function ReadDateTimeFromStream(Stream: TStream): TDateTime;
|
|
begin
|
|
Stream.Read(Result, SizeOf(TDateTime));
|
|
end;
|
|
|
|
procedure WriteDateTimeToStream(Stream: TStream; const Value: TDateTime);
|
|
begin
|
|
Stream.Write(Value, SizeOf(TDateTime));
|
|
end;
|
|
|
|
|
|
procedure Writeint64ToStream(Stream: TStream; const Value: int64);
|
|
begin
|
|
Stream.Write(Value, SizeOf(int64));
|
|
end;
|
|
|
|
function Readint64FromStream(Stream: TStream): int64;
|
|
begin
|
|
Stream.Read(Result, SizeOf(int64));
|
|
end;
|
|
|
|
procedure WriteUint64ToStream(Stream: TStream; const Value: UInt64);
|
|
begin
|
|
Stream.Write(Value, SizeOf(Uint64));
|
|
end;
|
|
|
|
function ReadUint64FromStream(Stream: TStream): UInt64;
|
|
begin
|
|
Stream.Read(Result, SizeOf(Uint64));
|
|
end;
|
|
|
|
procedure WriteIntegerToStream(Stream: TStream; const Value: Integer);
|
|
begin
|
|
Stream.Write(Value, SizeOf(integer));
|
|
end;
|
|
|
|
function ReadIntegerFromStream(Stream: TStream): Integer;
|
|
begin
|
|
Stream.Read(Result, SizeOf(integer));
|
|
end;
|
|
|
|
function ReadAnsistringFromStream(Stream: TStream): AnsiString;
|
|
var
|
|
Len: Cardinal;
|
|
begin
|
|
Len := ReadIntegerFromStream(Stream);
|
|
SetLength(Result, Len div SizeOf(AnsiChar));
|
|
Stream.Read(Pointer(Result)^, len);
|
|
end;
|
|
|
|
procedure WriteAnsistringToStream(Stream: TStream; const AString: Ansistring);
|
|
var
|
|
Len: Cardinal;
|
|
begin
|
|
Len := Length(AString);
|
|
WriteIntegerToStream(Stream, Len);
|
|
Stream.Write(Pointer(AString)^, len*SizeOf(AnsiChar));
|
|
end;
|
|
|
|
procedure WriteWidestringToStream(Stream: TStream; const AString: Widestring);
|
|
var
|
|
Len: Cardinal;
|
|
begin
|
|
Len := Length(AString) * sizeOf(WideChar);
|
|
WriteIntegerToStream(Stream, Len);
|
|
Stream.Write(Pointer(AString)^, len);
|
|
end;
|
|
|
|
function ReadWidestringFromStream(Stream: TStream): WideString;
|
|
var
|
|
Len: Cardinal;
|
|
begin
|
|
Len := ReadIntegerFromStream(Stream);
|
|
SetLength(Result, Len div sizeOf(WideChar));
|
|
Stream.Read(Pointer(Result)^, len);
|
|
end;
|
|
|
|
procedure BlobToStreamAsStr(Stream: TStream; Value: Variant);
|
|
var
|
|
p: pointer;
|
|
lSize: cardinal;
|
|
begin
|
|
case VarType(Value) of
|
|
varEmpty: WriteIntegerToStream(Stream, 0);
|
|
varOleStr: WriteWidestringToStream(Stream, VarToWideStr(Value));
|
|
varString: WriteAnsistringToStream(Stream, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(VarToStr(Value)));
|
|
8209: begin { 8209 is binary array }
|
|
lSize := VarArrayHighBound(Value, 1) - VarArrayLowBound(Value, 1) + 1;
|
|
p := VarArrayLock(Value);
|
|
try
|
|
WriteIntegerToStream(Stream, lSize);
|
|
Stream.Write(p^, lSize);
|
|
finally
|
|
VarArrayUnlock(Value);
|
|
end;
|
|
end;
|
|
else
|
|
raise Exception.CreateFmt('Invalid variant type (%d) for Blob.', [VarType(Value)]);
|
|
end;
|
|
end;
|
|
|
|
function WriteVariantToStream(Stream: TStream; Value: Variant; DataType: TDADataType): Boolean;
|
|
begin
|
|
Result := True;
|
|
|
|
case Datatype of
|
|
datWideString, datWideMemo, datXml: WriteWidestringToStream(Stream, VarToWideStr(Value));
|
|
datString, datMemo: WriteAnsistringToStream(Stream, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(VarToStr(Value)));
|
|
datDateTime: WriteDateTimeToStream(Stream, VarToDateTime(Value));
|
|
datFloat: WriteDoubleToStream(Stream, Value);
|
|
datBoolean: WriteBooleanToStream(Stream, Value = True);
|
|
datCurrency: WriteCurrencyToStream(Stream, Value);
|
|
datAutoInc, datInteger: WriteIntegerToStream(Stream, Value);
|
|
datLargeInt, datLargeAutoInc: Writeint64ToStream(Stream, Value);
|
|
datLargeUInt: WriteUint64ToStream(Stream, Value);
|
|
datBlob: BlobToStreamAsStr(Stream, Value);
|
|
datByte: WriteByteToStream(Stream, Value);
|
|
datShortInt: WriteShortIntToStream(Stream, Value);
|
|
datWord: WriteWordToStream(Stream, Value);
|
|
datSmallInt: WriteSmallIntToStream(Stream, Value);
|
|
datCardinal: WriteCardinalToStream(Stream, Value);
|
|
datGuid: WriteGuidToStream(Stream, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(VarToStr(Value)));
|
|
datSingleFloat: WriteSingleToStream(Stream, Value);
|
|
datDecimal: WriteDecimalToStream(Stream, VariantToDecimal(Value));
|
|
else
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function ReadVariantFromStream(Stream: TStream; DataType: TDADataType): Variant;
|
|
begin
|
|
case Datatype of
|
|
datWideString, datWideMemo, datXml: Result := ReadWidestringFromStream(Stream);
|
|
datString, datMemo, DatBlob: Result := ReadAnsistringFromStream(Stream);
|
|
datDateTime: Result := ReadDateTimeFromStream(Stream);
|
|
datFloat: Result := ReadDoubleFromStream(Stream);
|
|
datCurrency: Result := ReadCurrencyFromStream(Stream);
|
|
datBoolean: Result := ReadBooleanFromStream(Stream);
|
|
datAutoInc, datInteger: Result := ReadIntegerFromStream(Stream);
|
|
datLargeInt, datLargeAutoInc: Result := Readint64FromStream(Stream);
|
|
datLargeUInt: Result := ReadUint64FromStream(Stream);
|
|
datByte: Result := ReadByteFromStream(Stream);
|
|
datShortInt: Result := ReadShortIntFromStream(Stream);
|
|
datWord: Result := ReadWordFromStream(Stream);
|
|
datSmallInt: Result := ReadSmallIntFromStream(Stream);
|
|
datCardinal: Result := ReadCardinalFromStream(Stream);
|
|
datGuid: Result := ReadGUIDFromStream(Stream);
|
|
datSingleFloat: Result := ReadSingleFromStream(Stream);
|
|
datDecimal: Result := DecimalToVariant(ReadDecimalFromStream(Stream));
|
|
else
|
|
Result := varNull;
|
|
end;
|
|
end;
|
|
|
|
{ TDABin2DataStreamer }
|
|
|
|
procedure TDABin2DataStreamer.AddElementInfo(ElementType: TDAElementType;
|
|
ElementName: string; Offset: integer);
|
|
var
|
|
element: TDAElementInfo;
|
|
begin
|
|
element := TDAElementInfo.Create;
|
|
element.ElementType := ElementType;
|
|
element.Name := {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(ElementName);
|
|
element.Offset := Offset;
|
|
|
|
if ElementType = etDataset then
|
|
AddingDataset(ElementName, element)
|
|
else
|
|
AddingDelta(ElementName, element);
|
|
end;
|
|
|
|
function TDABin2DataStreamer.DoCreateStream: TStream;
|
|
begin
|
|
// outdated, for backward capability
|
|
result := nil;
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.DoFinalize;
|
|
var
|
|
finalpos, i: integer;
|
|
begin
|
|
if (AdapterInitialization in AdapterWriteModes) then try
|
|
finalpos := Data.Position;
|
|
|
|
// Element count. WIll be read by the DoInitialize method
|
|
WriteIntegerToStream(Data, DatasetCount + DeltaCount);
|
|
|
|
for i := 0 to (DatasetCount - 1) do
|
|
WriteElementInfo(TDAElementInfo(DatasetInfoObjects[i]));
|
|
|
|
for i := 0 to (DeltaCount - 1) do
|
|
WriteElementInfo(TDAElementInfo(DeltaInfoObjects[i]));
|
|
|
|
Data.Position := fInfoIntOffset;
|
|
WriteIntegerToStream(Data, finalpos);
|
|
except
|
|
beep;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.DoInitialize(Mode: TDAAdapterInitialization);
|
|
var
|
|
signature: TBIN2AdapterSignature;
|
|
currpos, i: integer;
|
|
begin
|
|
if (Mode in AdapterReadModes) then begin
|
|
// Checks the signature
|
|
Data.Read(signature, SizeOf(signature));
|
|
CheckSignature(signature);
|
|
|
|
fInfoIntOffset := ReadIntegerFromStream(Data);
|
|
currpos := Data.Position;
|
|
// Reads the information attached at the end of the stream
|
|
if (Data.Position = fInfoIntOffset) then Exit; // Nothing to read!
|
|
Data.Position := fInfoIntOffset;
|
|
|
|
// Number of elements
|
|
i := ReadIntegerFromStream(Data);
|
|
for i := i downto 1 do
|
|
ReadElementInfo;
|
|
// Restores its position and continues
|
|
Data.Position := currpos;
|
|
end
|
|
else if (Mode in AdapterWriteModes) then begin
|
|
// Writes the signature
|
|
signature := BIN2AdapterSignature;
|
|
Data.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 := Data.Position;
|
|
WriteIntegerToStream(Data, 0);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDABin2DataStreamer.DoReadDataset(const DatasetName: string;
|
|
const Destination: IDADataset; ApplySchema: boolean);
|
|
|
|
var
|
|
elementinfo: TDAElementInfo;
|
|
editable: IDAEditableDataset;
|
|
schemaend, cnt, i, k: integer;
|
|
fld: TDAField;
|
|
schemapresent: boolean;
|
|
readonlyfields: array of boolean;
|
|
//
|
|
Realfldcount: integer;
|
|
info: array of TDASmallFieldInfo;
|
|
RealFields: array of integer;
|
|
lErrorMessage: String;
|
|
lErrorMesCnt: integer;
|
|
lFldList: TStringList;
|
|
begin
|
|
if Destination.Active and ApplySchema then raise Exception.Create('Cannot apply a schema if the destination is active');
|
|
|
|
elementinfo := GetElementInfo(etDataset, DatasetName);
|
|
Data.Position := elementinfo.Offset;
|
|
lErrorMessage := '';
|
|
lErrorMesCnt := 0;
|
|
|
|
editable := Destination as IDAEditableDataset;
|
|
|
|
Destination.DisableControls;
|
|
try
|
|
editable.DisableEventHandlers;
|
|
try
|
|
if ApplySchema then begin
|
|
// Checks to see if the schema is present
|
|
schemapresent := ReadBooleanFromStream(Data);
|
|
schemaend := ReadIntegerFromStream(Data);
|
|
|
|
if schemapresent and ApplySchema then begin
|
|
ReadAndApplySchema(Destination, ApplySchema);
|
|
end
|
|
else if (schemaend > 0) then
|
|
Data.Position := schemaend;
|
|
Exit;
|
|
end
|
|
else begin
|
|
{schemapresent :=} ReadBooleanFromStream(Data);
|
|
schemaend := ReadIntegerFromStream(Data);
|
|
if (schemaend > 0) then
|
|
Data.Position := schemaend;
|
|
|
|
// Reads the row count
|
|
cnt := ReadIntegerFromStream(Data);
|
|
if (cnt = -1) then Exit; // Only schema is present!
|
|
|
|
if not Destination.Active then Destination.Open;
|
|
with editable do try
|
|
// Temporarily sets all fields as writable
|
|
Destination.DisableConstraints;
|
|
Realfldcount := ReadIntegerFromStream(Data);
|
|
SetLength(info, Realfldcount);
|
|
SetLength(RealFields, Realfldcount);
|
|
//Data.Read(pointer(info)^, Sizeof(TDASmallFieldInfo) * Realfldcount);
|
|
lFldList:=TStringList.Create;
|
|
try
|
|
lFldList.Sorted:=False;
|
|
lFldList.Duplicates:=dupIgnore;
|
|
For i:= 0 to Fields.Count-1 do
|
|
lFldList.AddObject(Fields[i].Name,Pointer(Fields[i].Index));
|
|
lFldList.Sorted:=True;
|
|
|
|
for i := 0 to Realfldcount - 1 do begin
|
|
info[i].Name := {$IFDEF UNICODE}Utf8ToAnsi{$ENDIF} (ReadAnsistringFromStream(Data));
|
|
info[i].Datatype := TDADataType(ReadByteFromStream(Data));
|
|
info[i].Size := ReadIntegerFromStream(Data);
|
|
k:=lFldList.IndexOf(info[i].Name);
|
|
if k = -1 then begin
|
|
inc(lErrorMesCnt);
|
|
if lErrorMesCnt > 5 then begin
|
|
lErrorMessage := lErrorMessage + '<skip>' + sLineBreak;
|
|
break;
|
|
end
|
|
else begin
|
|
lErrorMessage := lErrorMessage + Format('The %s field isn''t found.' + sLineBreak,[info[i].Name])
|
|
end;
|
|
end
|
|
else begin
|
|
RealFields[i]:= Integer(lFldList.Objects[k]);
|
|
end;
|
|
end;
|
|
finally
|
|
lFldList.Free;
|
|
end;
|
|
if (Length(lErrorMessage) > 0) then begin
|
|
lErrorMessage := 'Format of the data in the stream doesn''t match the destination table format.'+ #10#13 + #10#13 + lErrorMessage;
|
|
RaiseError(lErrorMessage);
|
|
end;
|
|
|
|
k := 0;
|
|
SetLength(readonlyfields, Fields.Count);
|
|
for i := 0 to (Fields.Count - 1) do begin
|
|
readonlyfields[i] := Fields[i].ReadOnly;
|
|
Fields[i].ReadOnly := FALSE;
|
|
if Fields[i].Calculated or Fields[i].Lookup then Continue;
|
|
//RealFields[k] := i;
|
|
if (k >= Realfldcount) then begin
|
|
lErrorMessage := lErrorMessage + 'Fields count mismatch' + sLineBreak
|
|
end
|
|
else begin
|
|
fld:=Fields[RealFields[k]];
|
|
// if (fld.Name <> Info[k].Name) then lErrorMessage := lErrorMessage + Format('Name mismatch: %s expected but %s found in stream.', [fld.Name, Info[k].Name])+ sLineBreak
|
|
if (fld.DataType <> Info[k].Datatype) then lErrorMessage := lErrorMessage + Format('Data type mismatch for column ''%s.%s'': %s expected but %s found in stream.', [DatasetName, fld.Name, TDADataTypeStrings[fld.DataType], TDADataTypeStrings[Info[k].Datatype]]) + sLineBreak
|
|
else if (fld.Size <> Info[k].Size) then lErrorMessage := lErrorMessage + Format('Size mismatch for column ''%s.%s'': %d expected but %d found in stream.', [DatasetName, fld.Name, fld.Size, Info[k].Size]) + sLineBreak;
|
|
end;
|
|
inc(k);
|
|
end;
|
|
try
|
|
if (k <> Realfldcount) then lErrorMessage := lErrorMessage + Format('Fields count mismatch: %d expected but %d found in the stream', [k, Realfldcount]) + sLineBreak;
|
|
if (Length(lErrorMessage) > 0) then begin
|
|
lErrorMessage := 'Format of the data in the stream doesn''t match the destination table format.'+ sLineBreak + sLineBreak + lErrorMessage;
|
|
RaiseError(lErrorMessage);
|
|
end;
|
|
// Inserts the records
|
|
try
|
|
InternalDoReadDataset(editable, cnt, RealFields);
|
|
except
|
|
raise;
|
|
end;
|
|
finally
|
|
// Restores the read-only property
|
|
for i := 0 to (Fields.Count - 1) do
|
|
Fields[i].ReadOnly := readonlyfields[i];
|
|
end;
|
|
finally
|
|
Destination.EnableConstraints;
|
|
end;
|
|
end;
|
|
finally
|
|
editable.EnableEventHandlers;
|
|
end;
|
|
finally
|
|
Destination.EnableControls;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.DoReadDelta(const DeltaName: string;
|
|
const Destination: IDADelta);
|
|
var
|
|
elementinfo: TDAElementInfo;
|
|
msg, str: string;
|
|
recid, i, cnt, x: integer;
|
|
change: TDADeltaChange;
|
|
changetype: TDAChangeType;
|
|
status: TDAChangeStatus;
|
|
BitMask: AnsiString;
|
|
BitMaskSize: integer;
|
|
begin
|
|
elementinfo := GetElementInfo(etDelta, DeltaName);
|
|
Data.Position := elementinfo.Offset;
|
|
|
|
// Number of changes
|
|
cnt := ReadIntegerFromStream(Data);
|
|
|
|
// Field number, names and types
|
|
Destination.ClearFieldNames;
|
|
i := ReadIntegerFromStream(Data);
|
|
for i := i downto 1 do begin
|
|
str := {$IFDEF UNICODE}Utf8ToAnsi{$ENDIF} (ReadAnsiStringFromStream(Data));
|
|
Destination.AddFieldName(str);
|
|
Destination.LoggedFieldTypes[Destination.LoggedFieldCount - 1] := TDADataType(ReadByteFromStream(Data));
|
|
end;
|
|
|
|
// Key fields
|
|
Destination.ClearKeyFieldNames;
|
|
i := ReadIntegerFromStream(Data);
|
|
for i := i downto 1 do begin
|
|
str := {$IFDEF UNICODE}Utf8ToAnsi{$ENDIF}(ReadAnsiStringFromStream(Data));
|
|
Destination.AddKeyFieldName(str);
|
|
end;
|
|
|
|
if (cnt = 0) then Exit;
|
|
|
|
BitMaskSize := (Destination.LoggedFieldCount + 7) div 8;
|
|
SetLength(BitMask, BitMaskSize);
|
|
|
|
// mode of Delta
|
|
fHasReducedDelta := ReadBooleanFromStream(Data);
|
|
|
|
// Actual changes
|
|
cnt := ReadIntegerFromStream(Data);
|
|
for i := 1 to cnt do begin
|
|
changetype := TDAChangeType(ReadIntegerFromStream(Data));
|
|
recid := ReadIntegerFromStream(Data);
|
|
status := TDAChangeStatus(ReadIntegerFromStream(Data));
|
|
msg := {$IFDEF UNICODE}Utf8ToAnsi{$ENDIF}(ReadAnsiStringFromStream(Data));
|
|
change := Destination.Add(recid, changetype, status, msg);
|
|
|
|
// bitmask has different value that in ReadDeataset/WriteDataset !!!
|
|
// 1 = field is not null
|
|
// 0 = field is null
|
|
Data.Read(pointer(BitMask)^, BitMaskSize);
|
|
// Old values
|
|
for x := 0 to (Destination.LoggedFieldCount - 1) do
|
|
if GetBitMask(PAnsiChar(BitMask),x) then
|
|
change.OldValues[x] := ReadVariantFromStream(Data, Destination.LoggedFieldTypes[x]);
|
|
|
|
Data.Read(pointer(BitMask)^, BitMaskSize);
|
|
// new values
|
|
for x := 0 to (Destination.LoggedFieldCount - 1) do
|
|
if GetBitMask(PAnsiChar(BitMask),x) then
|
|
change.NewValues[x] := ReadVariantFromStream(Data, Destination.LoggedFieldTypes[x]);
|
|
end;
|
|
end;
|
|
|
|
function TDABin2DataStreamer.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;
|
|
|
|
procedure TDABin2DataStreamer.DoWriteDelta(const Source: IDADelta);
|
|
var
|
|
i, x: integer;
|
|
pk_array: array of boolean;
|
|
BitMask_Old,BitMask_new: AnsiString;
|
|
BitMaskSize: integer;
|
|
old_val,new_val: variant;
|
|
l_bitmaskflag: boolean;
|
|
fLocalSendReducedDelta: Boolean;
|
|
begin
|
|
// This information will be used later to complete the stream (see DoInitialize)
|
|
AddElementInfo(etDelta, Source.LogicalName, Data.Position);
|
|
Source.RemoveUnchangedChanges;
|
|
|
|
// Number of changes
|
|
WriteIntegertoStream(Data, Source.Count);
|
|
|
|
// Numnber of fields, field names and their types
|
|
WriteIntegertoStream(Data, Source.LoggedFieldCount);
|
|
for i := 0 to (Source.LoggedFieldCount - 1) do begin
|
|
WriteAnsiStringtoStream(Data,{$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(Source.LoggedFieldNames[i]));
|
|
WriteByteToStream(Data, Ord(Source.LoggedFieldTypes[i]));
|
|
end;
|
|
|
|
// Key fields
|
|
WriteIntegertoStream(Data, Source.KeyFieldCount);
|
|
for i := 0 to (Source.KeyFieldCount - 1) do begin
|
|
WriteAnsiStringtoStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(Source.KeyFieldNames[i]));
|
|
end;
|
|
|
|
if (Source.Count = 0) then Exit;
|
|
|
|
// mode of Delta
|
|
WriteBooleanToStream(Data, SendReducedDelta);
|
|
|
|
// Actual changes
|
|
WriteIntegertoStream(Data, Source.Count);
|
|
|
|
BitMaskSize := (Source.LoggedFieldCount + 7) div 8;
|
|
SetLength(BitMask_old, BitMaskSize);
|
|
SetLength(BitMask_new, BitMaskSize);
|
|
fLocalSendReducedDelta := SendReducedDelta and (Source.KeyFieldCount >0);
|
|
if fLocalSendReducedDelta then begin
|
|
SetLength(pk_array, Source.LoggedFieldCount);
|
|
for i := 0 to Source.LoggedFieldCount - 1 do
|
|
pk_array[i]:=False;
|
|
|
|
for i := 0 to Source.KeyFieldCount - 1 do begin
|
|
x := Source.IndexOfLoggedField(Source.KeyFieldNames[i]);
|
|
if x <> -1 then pk_array[x]:=True;
|
|
end;
|
|
end;
|
|
|
|
for i := 0 to (Source.Count - 1) do begin
|
|
// Change type, RecID, status and message
|
|
WriteIntegertoStream(Data, integer(Source.Changes[i].ChangeType));
|
|
WriteIntegertoStream(Data, Source.Changes[i].RecID);
|
|
WriteIntegertoStream(Data, integer(Source.Changes[i].Status));
|
|
WriteAnsiStringtoStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(Source.Changes[i].Message));
|
|
|
|
// bitmask has different value that in ReadDeataset/WriteDataset !!!
|
|
// 1 = field is not null
|
|
// 0 = field is null
|
|
ClearBitMask(PAnsiChar(BitMask_old),BitMaskSize,0);
|
|
ClearBitMask(PAnsiChar(BitMask_New),BitMaskSize,0);
|
|
if fLocalSendReducedDelta then begin
|
|
for x := 0 to (Source.LoggedFieldCount - 1) do begin
|
|
old_val:=Source.Changes[i].OldValues[x];
|
|
new_val:=Source.Changes[i].NewValues[x];
|
|
l_bitmaskflag:=pk_array[x] or not ROVariantsEqual(old_val,new_val);
|
|
SetBitMask(PAnsiChar(BitMask_Old), x, l_bitmaskflag and not (VarIsNull(old_val) or (VarIsEmpty(old_val))));
|
|
SetBitMask(PAnsiChar(BitMask_new), x, l_bitmaskflag and not (VarIsNull(new_val) or (VarIsEmpty(new_val))));
|
|
end;
|
|
end else begin
|
|
for x := 0 to (Source.LoggedFieldCount - 1) do begin
|
|
old_val:=Source.Changes[i].OldValues[x];
|
|
new_val:=Source.Changes[i].NewValues[x];
|
|
SetBitMask(PAnsiChar(BitMask_Old), x, not (VarIsNull(old_val) or (VarIsEmpty(old_val))));
|
|
SetBitMask(PAnsiChar(BitMask_new), x, not (VarIsNull(new_val) or (VarIsEmpty(new_val))));
|
|
end;
|
|
end;
|
|
|
|
// old
|
|
Data.Write(pointer(BitMask_Old)^, BitMaskSize);
|
|
for x := 0 to (Source.LoggedFieldCount - 1) do
|
|
if GetBitMask(PAnsiChar(BitMask_Old),x) then
|
|
WriteVariantToStream(Data,Source.Changes[i].OldValues[x],Source.LoggedFieldTypes[x]);
|
|
|
|
// new
|
|
Data.Write(pointer(BitMask_new)^, BitMaskSize);
|
|
for x := 0 to (Source.LoggedFieldCount - 1) do
|
|
if GetBitMask(PAnsiChar(BitMask_new),x) then
|
|
WriteVariantToStream(Data,Source.Changes[i].NewValues[x],Source.LoggedFieldTypes[x]);
|
|
end;
|
|
end;
|
|
|
|
function TDABin2DataStreamer.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;
|
|
|
|
function TDABin2DataStreamer.HasReducedDelta: Boolean;
|
|
begin
|
|
Result:= fHasReducedDelta;
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.ReadAndApplySchema(
|
|
const Destination: IDADataset; ApplySchema: boolean);
|
|
var
|
|
lField_cnt: integer;
|
|
lparam_cnt: integer;
|
|
i: integer;
|
|
cnt: integer;
|
|
begin
|
|
Destination.Fields.Clear;
|
|
cnt := ReadIntegerFromStream(Data);
|
|
lField_cnt:= ReadIntegerFromStream(Data);
|
|
for i := 0 to (cnt - 1) do
|
|
ReadField(Destination.Fields.Add, lField_cnt);
|
|
|
|
Destination.Params.Clear;
|
|
cnt := ReadIntegerFromStream(Data);
|
|
lparam_cnt:= ReadIntegerFromStream(Data);
|
|
for i := 0 to (cnt - 1) do
|
|
ReadParam(Destination.Params.Add, lparam_cnt);
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.ReadElementInfo;
|
|
var
|
|
et: TDAElementType;
|
|
nme: string;
|
|
ofs: integer;
|
|
begin
|
|
et := TDAElementType(ReadIntegerFromStream(Data));
|
|
nme := {$IFDEF UNICODE}Utf8ToAnsi{$ENDIF}(ReadAnsistringFromStream(Data));
|
|
ofs := ReadIntegerFromStream(Data);
|
|
AddElementInfo(et, nme, ofs);
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.WriteElementInfo(
|
|
ElementInfo: TDAElementInfo);
|
|
begin
|
|
WriteIntegerToStream(Data, integer(ElementInfo.ElementType));
|
|
WriteAnsiStringToStream(Data, ElementInfo.Name);
|
|
WriteIntegerToStream(Data, ElementInfo.Offset);
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.WriteSchema(const Fields: TDAFieldCollection; const Params: TDAParamCollection; aFieldsIndex: array of integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
WriteIntegerToStream(Data, Length(aFieldsIndex));
|
|
WriteIntegerToStream(Data, field_count);
|
|
for i := 0 to High(aFieldsIndex) do
|
|
WriteField(Fields[aFieldsIndex[i]]);
|
|
|
|
WriteIntegerToStream(Data, Params.Count);
|
|
WriteIntegerToStream(Data, param_count);
|
|
for i := 0 to Params.Count - 1 do
|
|
WriteParam(Params[i]);
|
|
end;
|
|
|
|
function TDABin2DataStreamer.DoBeginWriteDataset(
|
|
const Source: IDADataset; const Schema: TDADataset;
|
|
Options: TDAWriteOptions; MaxRows: integer;
|
|
ADynFieldNames: array of string): TDADataForAppend;
|
|
var
|
|
max, cntpos, currpos, k, i, Realfldcnt: integer;
|
|
fld: TDAField;
|
|
wrtschema: boolean;
|
|
info: array of TDASmallFieldInfo;
|
|
RealFields: array of integer;
|
|
lfields: array of integer;
|
|
lDataForAppend : TDADataForAppendBin2;
|
|
lSchemaFields: TDAFieldCollection;
|
|
lSchemaParams: TDAParamCollection;
|
|
lLogicalName: String;
|
|
begin
|
|
lDataForAppend := TDADataForAppendBin2.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]:= i
|
|
else
|
|
lfields[i]:= -1; // TODO: shoudln't this raise an exception "field not found", or the like?
|
|
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, Data.Position);
|
|
|
|
// Writes a boolean flag that indicates if the schema is being written
|
|
wrtschema := (woSchema in Options) or (Length(ADynFieldNames)>0);
|
|
WriteBooleanToStream(Data, wrtschema);
|
|
// Write the offset to jump to if the reader wants to skip the schema
|
|
currpos := Data.Position;
|
|
WriteIntegerToStream(Data, 0);
|
|
|
|
if wrtschema then begin
|
|
WriteSchema(lSchemaFields, lSchemaParams, lfields);
|
|
|
|
// Writes the offset of the schema's end
|
|
k := Data.Position;
|
|
Data.Position := currpos;
|
|
WriteIntegerToStream(Data, k);
|
|
Data.Position := k;
|
|
end;
|
|
|
|
// Writes the row count
|
|
if not (woRows in Options) then begin
|
|
WriteIntegerToStream(Data, -1);
|
|
Exit;
|
|
end
|
|
else begin
|
|
cntpos := Data.Position;
|
|
WriteIntegerToStream(Data, 0);
|
|
max := MaxRows;
|
|
end;
|
|
|
|
// write datatypes+offsets
|
|
SetLength(info, lSchemaFields.Count);
|
|
SetLength(RealFields, lSchemaFields.Count);
|
|
Realfldcnt := 0;
|
|
for i := 0 to High(lfields) do begin
|
|
if lSchemaFields[lfields[i]].Calculated or lSchemaFields[lfields[i]].Lookup then Continue;
|
|
RealFields[Realfldcnt] := lfields[i];
|
|
info[Realfldcnt].Name := lSchemaFields[lfields[i]].Name;
|
|
info[Realfldcnt].Datatype := lSchemaFields[lfields[i]].DataType;
|
|
info[Realfldcnt].Size := lSchemaFields[lfields[i]].Size;
|
|
inc(Realfldcnt);
|
|
end;
|
|
SetLength(info, Realfldcnt);
|
|
SetLength(RealFields, Realfldcnt);
|
|
|
|
WriteIntegerToStream(Data, Realfldcnt);
|
|
//Data.Write(pointer(info)^, Sizeof(TDASmallFieldInfo) * Realfldcnt);
|
|
for i := 0 to Realfldcnt - 1 do begin
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(info[i].Name));
|
|
WriteByteToStream(Data, Byte(info[i].DataType));
|
|
WriteIntegerToStream(Data, info[i].Size);
|
|
end;
|
|
|
|
|
|
// prepare DataForAppend structure...
|
|
SetLength(lDataForAppend.RealFields, Realfldcnt);
|
|
SetLength(lDataForAppend.FieldsInfo, Realfldcnt);
|
|
for i := Low(RealFields) to High(RealFields) do begin
|
|
lDataForAppend.RealFields[i] := RealFields[i];
|
|
lDataForAppend.FieldsInfo[i].Name := info[i].Name;
|
|
lDataForAppend.FieldsInfo[i].Datatype := info[i].Datatype;
|
|
lDataForAppend.FieldsInfo[i].Size := info[i].Size;
|
|
end;
|
|
|
|
lDataForAppend.MaxRowCount := max;
|
|
lDataForAppend.CountOfRecordsPosition := cntpos;
|
|
|
|
k := 0;
|
|
|
|
lDataForAppend.EndDataPosition := Data.Position;
|
|
lDataForAppend.RecordCount := k;
|
|
|
|
result := lDataForAppend;
|
|
end;
|
|
|
|
|
|
function TDABin2DataStreamer.DoWriteDatasetData(const Source: IDADataset; var aDataForAppend: TDADataForAppend; aDataIndex: Integer = -1): Integer;
|
|
var
|
|
max, k, i, Realfldcnt: integer;
|
|
info: array of TDASmallFieldInfo;
|
|
RealFields: array of integer;
|
|
lDataForAppend: TDADataForAppendBin2;
|
|
lMapToFieldName: String;
|
|
lColumnMappings: TDAColumnMappingCollection;
|
|
lColumnMapping: TDAColumnMapping;
|
|
begin
|
|
|
|
lDataForAppend := aDataForAppend as TDADataForAppendBin2;
|
|
Realfldcnt := Length(lDataForAppend.RealFields);
|
|
Data.Position := lDataForAppend.EndDataPosition;
|
|
SetLength(info, Realfldcnt);
|
|
SetLength(RealFields, Realfldcnt);
|
|
for i := 0 to Realfldcnt - 1 do begin
|
|
info[i].Name := lDataForAppend.FieldsInfo[i].Name;
|
|
info[i].Datatype := lDataForAppend.FieldsInfo[i].Datatype;
|
|
info[i].Size := lDataForAppend.FieldsInfo[i].Size;
|
|
// these arrays always have the same size
|
|
RealFields[i] := lDataForAppend.RealFields[i];
|
|
end;
|
|
max := lDataForAppend.MaxRowCount;
|
|
k := lDataForAppend.RecordCount;
|
|
|
|
// 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 Realfldcnt - 1 do begin
|
|
if info[i].Name = def_SourceTableFieldName then begin
|
|
RealFields[i] := -10;
|
|
continue;
|
|
end;
|
|
lMapToFieldName := info[i].Name;
|
|
if Assigned(lColumnMappings) then begin
|
|
lColumnMapping := lColumnMappings.MappingByDatasetField(info[i].Name);
|
|
if Assigned(lColumnMapping) and (lColumnMapping.TableField <> '') then
|
|
lMapToFieldName := lColumnMapping.TableField;
|
|
end;
|
|
RealFields[i] := Source.FieldByName(lMapToFieldName).Index;
|
|
end;
|
|
end;
|
|
|
|
with Source do try
|
|
DisableControls;
|
|
|
|
if not Source.Active then Source.Open;
|
|
try
|
|
InternalDoWriteDataset_NonDataset(Source,k, max, RealFields, aDataIndex, info)
|
|
except
|
|
raise;
|
|
end;
|
|
|
|
lDataForAppend.EndDataPosition := Data.Position;
|
|
lDataForAppend.RecordCount := k;
|
|
|
|
finally
|
|
EnableControls;
|
|
result := k;
|
|
end;
|
|
end;
|
|
|
|
function TDABin2DataStreamer.DoEndWriteDataset(aDataForAppend: TDADataForAppend): Integer;
|
|
begin
|
|
result := aDataForAppend.RecordCount;
|
|
Data.Position := aDataForAppend.CountOfRecordsPosition;
|
|
WriteIntegerToStream(Data, aDataForAppend.RecordCount);
|
|
Data.Position := aDataForAppend.EndDataPosition;
|
|
aDataForAppend.Free();
|
|
end;
|
|
|
|
function BoolToAnsiStr(B: Boolean): Ansistring;
|
|
begin
|
|
if b then
|
|
Result:= 'True'
|
|
else
|
|
Result := 'False';
|
|
end;
|
|
|
|
|
|
procedure TDABin2DataStreamer.WriteField(const AField: TDAField);
|
|
begin
|
|
WriteAnsistringToStream(Data, 'Alignment');
|
|
WriteAnsistringToStream(Data, TAlignmentStrings[AField.Alignment]);
|
|
WriteAnsistringToStream(Data, 'BlobType');
|
|
WriteAnsistringToStream(Data, TDABlobTypeStrings[AField.BlobType]);
|
|
WriteAnsistringToStream(Data, 'BusinessClassID');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.BusinessClassID));
|
|
WriteAnsistringToStream(Data, 'Calculated');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.Calculated));
|
|
WriteAnsistringToStream(Data, 'CustomAttributes');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.CustomAttributes.Text));
|
|
WriteAnsistringToStream(Data, 'DataType');
|
|
WriteAnsistringToStream(Data, TDADataTypeStrings[AField.DataType]);
|
|
WriteAnsistringToStream(Data, 'DecimalPrecision');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(IntToStr(AField.DecimalPrecision)));
|
|
WriteAnsistringToStream(Data, 'DecimalScale');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(IntToStr(AField.DecimalScale)));
|
|
WriteAnsistringToStream(Data, 'DefaultValue');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.DefaultValue));
|
|
WriteAnsistringToStream(Data, 'Description');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.Description));
|
|
WriteAnsistringToStream(Data, 'DictionaryEntry');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.DictionaryEntry));
|
|
WriteAnsistringToStream(Data, 'DisplayFormat');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.DisplayFormat));
|
|
WriteAnsistringToStream(Data, 'DisplayLabel');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.DisplayLabel));
|
|
WriteAnsistringToStream(Data, 'DisplayWidth');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(IntToStr(AField.DisplayWidth)));
|
|
WriteAnsistringToStream(Data, 'EditFormat');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.EditFormat));
|
|
WriteAnsistringToStream(Data, 'EditMask');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.EditMask));
|
|
WriteAnsistringToStream(Data, 'Expression');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.Expression));
|
|
WriteAnsistringToStream(Data, 'GeneratorName');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.GeneratorName));
|
|
WriteAnsistringToStream(Data, 'InPrimaryKey');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.InPrimaryKey));
|
|
WriteAnsistringToStream(Data, 'KeyFields');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.KeyFields));
|
|
WriteAnsistringToStream(Data, 'LogChanges');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.LogChanges));
|
|
WriteAnsistringToStream(Data, 'Lookup');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.Lookup));
|
|
WriteAnsistringToStream(Data, 'LookupCache');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.LookupCache));
|
|
WriteAnsistringToStream(Data, 'LookupKeyFields');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.LookupKeyFields));
|
|
WriteAnsistringToStream(Data, 'LookupResultField');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.LookupResultField));
|
|
WriteAnsistringToStream(Data, 'LookupSource');
|
|
WriteAnsistringToStream(Data, '');
|
|
WriteAnsistringToStream(Data, 'Name');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.Name));
|
|
WriteAnsistringToStream(Data, 'ReadOnly');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.ReadOnly));
|
|
WriteAnsistringToStream(Data, 'RegExpression');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AField.RegExpression));
|
|
WriteAnsistringToStream(Data, 'Required');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.Required));
|
|
WriteAnsistringToStream(Data, 'ServerAutoRefresh');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.ServerAutoRefresh));
|
|
WriteAnsistringToStream(Data, 'ServerCalculated');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.ServerCalculated));
|
|
WriteAnsistringToStream(Data, 'Size');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(IntToStr(AField.Size)));
|
|
WriteAnsistringToStream(Data, 'Visible');
|
|
WriteAnsistringToStream(Data, BoolToAnsiStr(AField.Visible));
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.WriteParam(const AParam: TDAParam);
|
|
begin
|
|
WriteAnsistringToStream(Data, 'AsString');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AParam.AsString));
|
|
WriteAnsistringToStream(Data, 'BlobType');
|
|
WriteAnsistringToStream(Data, TDABlobTypeStrings[AParam.BlobType]);
|
|
WriteAnsistringToStream(Data, 'DataType');
|
|
WriteAnsistringToStream(Data, TDADataTypeStrings[AParam.DataType]);
|
|
WriteAnsistringToStream(Data, 'DecimalPrecision');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(IntToStr(AParam.DecimalPrecision)));
|
|
WriteAnsistringToStream(Data, 'DecimalScale');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(IntToStr(AParam.DecimalScale)));
|
|
WriteAnsistringToStream(Data, 'Description');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AParam.Description));
|
|
WriteAnsistringToStream(Data, 'GeneratorName');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AParam.GeneratorName));
|
|
WriteAnsistringToStream(Data, 'Name');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(AParam.Name));
|
|
WriteAnsistringToStream(Data, 'ParamType');
|
|
WriteAnsistringToStream(Data, TDAParamTypeStrings[AParam.ParamType]);
|
|
WriteAnsistringToStream(Data, 'Size');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(IntToStr(AParam.Size)));
|
|
WriteAnsistringToStream(Data, 'Value');
|
|
WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(VarToStr(AParam.Value)));
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.ReadParam(const AParam: TDAParam; const aParamPropertiesCount: integer);
|
|
var
|
|
i: integer;
|
|
sName: AnsiString;
|
|
sAnsiValue: AnsiString;
|
|
sValue: String;
|
|
begin
|
|
For i := 0 to aParamPropertiesCount-1 do begin
|
|
sName := ReadAnsistringFromStream(Data);
|
|
sAnsiValue :=ReadAnsistringFromStream(Data);
|
|
sValue :={$IFDEF UNICODE}Utf8ToAnsi{$ENDIF}(sAnsiValue);
|
|
if sName = 'AsString' then AParam.AsString:= sValue
|
|
else if sName = 'BlobType' then AParam.BlobType := TDABlobTypeStringsToTDABlobType(sAnsiValue)
|
|
else if sName = 'DataType' then AParam.DataType := TDADataTypeStringsToTDADataType(sAnsiValue)
|
|
else if sName = 'DecimalPrecision' then AParam.DecimalPrecision := StrToInt(sValue)
|
|
else if sName = 'DecimalScale' then AParam.DecimalScale := StrToInt(sValue)
|
|
else if sName = 'Description' then AParam.Description := sValue
|
|
else if sName = 'GeneratorName' then AParam.GeneratorName := sValue
|
|
else if sName = 'Name' then AParam.Name := sValue
|
|
else if sName = 'ParamType' then AParam.ParamType := TDAParamTypeStringsToTDAParamType(sAnsiValue)
|
|
else if sName = 'Size' then AParam.Size := StrToInt(sValue)
|
|
else if sName = 'Value' then AParam.Value := sValue
|
|
else ;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.ReadField(const AField: TDAField;
|
|
const aFieldPropertiesCount: integer);
|
|
var
|
|
i: integer;
|
|
sName, sAnsiValue: AnsiString;
|
|
sValue: string;
|
|
begin
|
|
For i := 0 to aFieldPropertiesCount-1 do begin
|
|
sName := ReadAnsistringFromStream(Data);
|
|
sAnsiValue :=ReadAnsistringFromStream(Data);
|
|
sValue :={$IFDEF UNICODE}Utf8ToAnsi{$ENDIF}(sAnsiValue);
|
|
if sName = 'Alignment' then AField.Alignment := TAlignmentStringsToTAlignment(sAnsiValue)
|
|
else if sName = 'BlobType' then AField.BlobType := TDABlobTypeStringsToTDABlobType(sAnsiValue)
|
|
else if sName = 'BusinessClassID' then AField.BusinessClassID := sValue
|
|
else if sName = 'Calculated' then AField.Calculated := StrToBool(sValue)
|
|
else if sName = 'CustomAttributes' then AField.CustomAttributes.Text := sValue
|
|
else if sName = 'DataType' then AField.DataType := TDADataTypeStringsToTDADataType(sAnsiValue)
|
|
else if sName = 'DecimalPrecision' then AField.DecimalPrecision := StrToInt(sValue)
|
|
else if sName = 'DecimalScale' then AField.DecimalScale := StrToInt(sValue)
|
|
else if sName = 'DefaultValue' then AField.DefaultValue := sValue
|
|
else if sName = 'Description' then AField.Description := sValue
|
|
else if sName = 'DictionaryEntry' then AField.DictionaryEntry := sValue
|
|
else if sName = 'DisplayFormat' then AField.DisplayFormat := sValue
|
|
else if sName = 'DisplayLabel' then AField.DisplayLabel := sValue
|
|
else if sName = 'DisplayWidth' then AField.DisplayWidth := StrToInt(sValue)
|
|
else if sName = 'EditFormat' then AField.EditFormat := sValue
|
|
else if sName = 'EditMask' then AField.EditMask := sValue
|
|
else if sName = 'Expression' then AField.Expression := sValue
|
|
else if sName = 'GeneratorName' then AField.GeneratorName := sValue
|
|
else if sName = 'InPrimaryKey' then AField.InPrimaryKey := StrToBool(sValue)
|
|
else if sName = 'KeyFields' then AField.KeyFields := sValue
|
|
else if sName = 'LogChanges' then AField.LogChanges := StrToBool(sValue)
|
|
else if sName = 'Lookup' then AField.Lookup := StrToBool(sValue)
|
|
else if sName = 'LookupCache' then AField.LookupCache := StrToBool(sValue)
|
|
else if sName = 'LookupKeyFields' then AField.LookupKeyFields := sValue
|
|
else if sName = 'LookupResultField' then AField.LookupResultField := sValue
|
|
else if sName = 'LookupSource' then // AField.LookupSource:=nil;
|
|
else if sName = 'Name' then AField.Name := sValue
|
|
else if sName = 'ReadOnly' then AField.ReadOnly := StrToBool(sValue)
|
|
else if sName = 'RegExpression' then AField.RegExpression := sValue
|
|
else if sName = 'Required' then AField.Required := StrToBool(sValue)
|
|
else if sName = 'ServerAutoRefresh' then AField.ServerAutoRefresh := StrToBool(sValue)
|
|
else if sName = 'ServerCalculated' then AField.ServerCalculated := StrToBool(sValue)
|
|
else if sName = 'Size' then AField.Size := StrToInt(sValue)
|
|
else if sName = 'Visible' then AField.Visible := StrToBool(sValue)
|
|
else ;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.InternalDoReadDataset(const Destination: IDAEditableDataset; ARecordCount: integer;ARealFields: array of integer);
|
|
var
|
|
memdataset: IDAMemDatasetBatchAdding;
|
|
type
|
|
PMemDatasetrecord_Native = ^TMemDatasetrecord_Native;
|
|
TMemDatasetrecord_Native = packed record
|
|
Ident: byte;
|
|
Data: PAnsichar;
|
|
end;
|
|
|
|
procedure BitmaskToNativeBuf(Bitmask, buf: PAnsiChar; aFields: array of integer);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i:=Low(aFields) to High(aFields) do
|
|
SetBitMask(buf, aFields[i], GetBitMask(Bitmask,i));
|
|
end;
|
|
|
|
var
|
|
FRecordsList: TList;
|
|
buf1: pointer;
|
|
s: Ansistring;
|
|
Buf: PAnsiChar;
|
|
val: Variant;
|
|
memdataset_BitMaskSize: integer;
|
|
BindedFields: array of integer;
|
|
flds: array of TDAField;
|
|
BitMask: Ansistring;
|
|
streamer_BitMaskSize: integer;
|
|
i: integer;
|
|
Realfldcount: integer;
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t1,t2,t3: TDateTime;
|
|
{$ENDIF BIN2DEBUG_time}
|
|
begin
|
|
if Destination.QueryInterface(IDAMemDatasetBatchAdding, memdataset) <> s_ok then memdataset := nil;
|
|
Realfldcount := Length(ARealFields);
|
|
setLength(flds, Realfldcount);
|
|
For i:= 0 to Realfldcount-1 do
|
|
flds[i] := Destination.Fields[ARealFields[i]];
|
|
|
|
streamer_BitMaskSize := (Realfldcount + 7) div 8;
|
|
SetLength(BitMask, streamer_BitMaskSize);
|
|
// bitmask has different value that in ReadDelta/WriteDelta !!!
|
|
// 0 = field is not null
|
|
// 1 = field is null
|
|
|
|
|
|
if (memdataset = nil) or Assigned(OnReadFieldValue) then begin
|
|
// standard mode
|
|
while (ARecordCount > 0) do try
|
|
Destination.Append;
|
|
// read bitmask
|
|
Data.Read(pointer(BitMask)^, streamer_BitMaskSize);
|
|
for i := 0 to Realfldcount - 1 do begin
|
|
if GetBitMask(PAnsiChar(BitMask), i) then
|
|
//
|
|
else begin
|
|
case flds[i].Datatype of
|
|
datWideString, datWideMemo, datXml: flds[i].AsWideString := ReadWidestringFromStream(Data);
|
|
datString, datMemo, DatBlob: flds[i].AsString := {$IFDEF UNICODE}Utf8ToAnsi{$ENDIF}(ReadAnsistringFromStream(Data));
|
|
datDateTime: flds[i].AsDateTime := ReadDateTimeFromStream(Data);
|
|
datFloat: flds[i].AsFloat := ReadDoubleFromStream(Data);
|
|
datCurrency: flds[i].AsCurrency := ReadCurrencyFromStream(Data);
|
|
datBoolean: flds[i].AsBoolean := ReadBooleanFromStream(Data);
|
|
datAutoInc, datInteger: flds[i].AsInteger := ReadIntegerFromStream(Data);
|
|
datLargeInt, datLargeAutoInc: flds[i].AsLargeInt := Readint64FromStream(Data);
|
|
datLargeUInt: flds[i].AsLargeUInt := ReadUint64FromStream(Data);
|
|
datByte: flds[i].AsByte := ReadByteFromStream(Data);
|
|
datShortInt: flds[i].AsShortInt := ReadShortIntFromStream(Data);
|
|
datWord: flds[i].AsWord := ReadWordFromStream(Data);
|
|
datSmallInt: flds[i].AsSmallInt := ReadSmallIntFromStream(Data);
|
|
datCardinal: flds[i].AsCardinal := ReadCardinalFromStream(Data);
|
|
datGuid: flds[i].AsString := {$IFDEF UNICODE}Utf8ToAnsi{$ENDIF}(ReadGuidFromStream(Data));
|
|
datSingleFloat: flds[i].AsSingle := ReadSingleFromStream(Data);
|
|
datDecimal: flds[i].AsDecimal := ReadBCDFromStream(Data);
|
|
end;
|
|
end;
|
|
if Assigned(OnReadFieldValue) then begin
|
|
val := flds[i].Value;
|
|
OnReadFieldValue(flds[i], val);
|
|
flds[i].Value := val;
|
|
end;
|
|
end;
|
|
try
|
|
Destination.Post;
|
|
except
|
|
// Introduced to restore the dsBrowse state of the datatable
|
|
// in case of errors
|
|
Destination.Cancel;
|
|
raise;
|
|
end;
|
|
finally
|
|
Dec(ARecordCount);
|
|
end;
|
|
end
|
|
else begin
|
|
// superfast mode
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t1:=now;
|
|
{$ENDIF BIN2DEBUG_time}
|
|
SetLength(BindedFields, Realfldcount);
|
|
For i:= 0 to Realfldcount - 1 do
|
|
BindedFields[i]:=Destination.Fields[ARealFields[i]].BindedField.Index;
|
|
|
|
FRecordsList := TList.Create;
|
|
try
|
|
memdataset_BitMaskSize := (Realfldcount + 1 {RECID} + 7) div 8;
|
|
SetLength(BitMask, memdataset_BitMaskSize);
|
|
|
|
while (ARecordCount > 0) do try
|
|
Buf := memdataset.AllocRecordBuffer;
|
|
try
|
|
Data.Read(pointer(BitMask)^, streamer_BitMaskSize);
|
|
BitmaskToNativeBuf(pointer(BitMask), Pointer(PMemDatasetrecord_Native(buf)^.Data), BindedFields);
|
|
//Data.Read(buf^, BitMaskSize);
|
|
for i := 0 to Realfldcount - 1 do begin
|
|
if GetBitMask(PAnsiChar(BitMask), i) then
|
|
//
|
|
else begin
|
|
buf1 := memdataset.GetFieldNativeBuffer(Buf, flds[i].BindedField);
|
|
case flds[i].DataType of
|
|
datWideString, datXml: memdataset.SetWideString(buf1,flds[i].BindedField,ReadWidestringFromStream(Data));//PWideString(buf1)^ := ReadWidestringFromStream(Data);
|
|
datString: memdataset.SetAnsiString(buf1,flds[i].BindedField,ReadAnsistringFromStream(Data));//PAnsiString(buf1)^ := ReadAnsistringFromStream(Data);
|
|
datDateTime: PDateTime(buf1)^ := TimeStampToMSecs(DateTimeToTimeStamp(ReadDateTimeFromStream(Data)));
|
|
datFloat: PDouble(buf1)^ := ReadDoubleFromStream(Data);
|
|
datCurrency: PCurrency(buf1)^ := ReadCurrencyFromStream(Data);
|
|
datBoolean: PBoolean(buf1)^ := ReadBooleanFromStream(Data);
|
|
datLargeInt, datLargeAutoInc: PInt64(buf1)^ := Readint64FromStream(Data);
|
|
datLargeUInt: PUInt64(buf1)^ := ReadUint64FromStream(Data);
|
|
datAutoInc, datInteger: PInteger(buf1)^ := ReadIntegerFromStream(Data);
|
|
datCardinal: PCardinal(buf1)^ := ReadCardinalFromStream(Data);
|
|
datWord: PWord(buf1)^ := ReadWordFromStream(Data);
|
|
datShortInt: PSmallInt(buf1)^ := ReadShortIntFromStream(Data);
|
|
datSmallInt: PSmallInt(buf1)^ := ReadSmallIntFromStream(Data);
|
|
datByte: PSmallInt(buf1)^ := ReadByteFromStream(Data);
|
|
datSingleFloat: PDouble(buf1)^ := ReadSingleFromStream(Data);
|
|
datDecimal: PBCD(buf1)^ := ReadBCDFromStream(Data);
|
|
datGuid: begin
|
|
s := ReadGUIDFromStream(Data);
|
|
Move(pointer(s)^, pointer(buf1)^, 38 {Length(GuidString)});
|
|
end;
|
|
datWideMemo, datMemo, DatBlob: begin
|
|
s := ReadAnsistringFromStream(Data);
|
|
PPointer(buf1)^ := memdataset.MakeBlobFromString(s);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
FRecordsList.Add(Buf);
|
|
except
|
|
memdataset.FreeRecordBuffer(buf);
|
|
For i:=0 to FRecordsList.Count-1 do begin
|
|
buf:=FRecordsList[i];
|
|
memdataset.FreeRecordBuffer(Buf);
|
|
end;
|
|
raise;
|
|
end;
|
|
finally
|
|
Dec(ARecordCount);
|
|
end;
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t2:=now;
|
|
{$ENDIF BIN2DEBUG_time}
|
|
memdataset.AddRecordsfromList(FRecordsList);
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t3:=now;
|
|
OutputDebugString(PAnsiChar('TDABIN2DataStreamer.InternalDoReadDataset: SF Mode '+TimeToStr(t2-t1)+' | ' +FloatToStr(t2-t1) + ' ||| Adding '+TimeToStr(t3-t2)+' | ' +FloatToStr(t3-t2)));
|
|
{$ENDIF BIN2DEBUG_time}
|
|
finally
|
|
FRecordsList.Free;
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.InternalDoWriteDataset(
|
|
const Source: IDADataset; var k: integer;const Maxrecords: integer;
|
|
ARealFields: array of integer;aDataIndex: Integer;info: array of TDASmallFieldInfo);
|
|
var
|
|
currpos: integer;
|
|
ev1, ev2: boolean;
|
|
BitMask: Ansistring;
|
|
BitMaskSize: integer;
|
|
bitmaskpos : integer;
|
|
NeedWriteBitMask: Boolean;
|
|
i : integer;
|
|
Realfldcnt: integer;
|
|
flds: array of TDAField;
|
|
val: Variant;
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t1,t2: TDateTime;
|
|
{$ENDIF BIN2DEBUG_time}
|
|
begin
|
|
Realfldcnt:= Length(ARealFields);
|
|
BitMaskSize := (Realfldcnt + 7) div 8;
|
|
SetLength(BitMask, BitMaskSize);
|
|
SetLength(flds,Realfldcnt);
|
|
for i := 0 to Realfldcnt-1 do begin
|
|
if ARealFields[i] = -10 then
|
|
flds[i]:=nil
|
|
else
|
|
flds[i]:=Source.Fields[ARealFields[i]];
|
|
end;
|
|
|
|
|
|
// bitmask has different value that in ReadDelta/WriteDelta !!!
|
|
// 0 = field is not null
|
|
// 1 = field is null
|
|
ev1 := Assigned(OnBeforeFieldValueSerialization);
|
|
ev2 := Assigned(OnWriteFieldValue);
|
|
if ev1 or ev2 then begin
|
|
// with events
|
|
while (k <> Maxrecords) and not Source.EOF do begin
|
|
ClearBitMask(PAnsiChar(BitMask),BitMaskSize); // all is not Null
|
|
bitmaskpos := Data.Position;
|
|
Data.Write(pointer(BitMask)^, BitMaskSize);
|
|
NeedWriteBitMask := False;
|
|
for i := 0 to (Realfldcnt - 1) do begin
|
|
//ARealFields[i] = -10 then this is @SourceTable field
|
|
if ARealFields[i] = -10 then begin
|
|
//We shouldn't fire events since this is special internal field
|
|
val := aDataIndex;
|
|
end else begin
|
|
val := Source.FieldValues[ARealFields[i]];
|
|
if ev1 then OnBeforeFieldValueSerialization(flds[i], val);
|
|
if ev2 then OnWriteFieldValue(flds[i], val);
|
|
end;
|
|
|
|
if VarIsNull(Val) or VarIsEmpty(Val) then begin
|
|
NeedWriteBitMask := True;
|
|
SetBitMask(PAnsiChar(BitMask), i, True);
|
|
end else begin
|
|
if not WriteVariantToStream(Data, val, Info[i].Datatype) then begin
|
|
NeedWriteBitMask := True;
|
|
SetBitMask(PAnsiChar(BitMask), i, True);
|
|
end;
|
|
end;
|
|
if NeedWriteBitMask then begin
|
|
currpos := Data.Position;
|
|
Data.Position := bitmaskpos;
|
|
Data.Write(pointer(BitMask)^, BitMaskSize);
|
|
Data.Position := currpos;
|
|
end;
|
|
end;
|
|
// Inc(result);
|
|
Inc(k);
|
|
Source.Next;
|
|
if Source.EOF then Break;
|
|
end;
|
|
end
|
|
else begin
|
|
// Writes the actual records
|
|
// without events
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t1:=now;
|
|
{$ENDIF BIN2DEBUG_time}
|
|
while (k <> Maxrecords) and not Source.EOF do begin
|
|
ClearBitMask(PAnsiChar(BitMask),BitMaskSize); // all is not Null
|
|
|
|
for i := 0 to (Realfldcnt - 1) do
|
|
//ARealFields[i] = -10 then this is @SourceTable field
|
|
if ((ARealFields[i] <> -10) and (flds[i].IsNull)) then
|
|
SetBitMask(PAnsiChar(BitMask), i, True);
|
|
Data.Write(pointer(BitMask)^, BitMaskSize);
|
|
|
|
for i := 0 to (Realfldcnt - 1) do begin
|
|
|
|
//ARealFields[i] = -10 then this is @SourceTable field
|
|
if ARealFields[i] = -10 then begin
|
|
WriteIntegerToStream(Data, aDataIndex);
|
|
end else begin
|
|
if GetBitMask(PAnsiChar(BitMask), i) then begin
|
|
end else begin
|
|
case Info[i].Datatype of
|
|
datWideString, datWideMemo, datXml: WriteWidestringToStream(Data, flds[i].AsWideString);
|
|
datString, datMemo, datBlob: WriteAnsistringToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF} (flds[i].AsString));
|
|
datDateTime: WriteDateTimeToStream(Data, flds[i].AsDateTime);
|
|
datFloat: WriteDoubleToStream(Data, flds[i].AsFloat);
|
|
datBoolean: WriteBooleanToStream(Data, flds[i].AsBoolean);
|
|
datCurrency: WriteCurrencyToStream(Data, flds[i].AsCurrency);
|
|
datAutoInc, datInteger: WriteIntegerToStream(Data, flds[i].AsInteger);
|
|
datLargeInt, datLargeAutoInc: Writeint64ToStream(Data, flds[i].AsLargeInt);
|
|
datLargeUInt: WriteUint64ToStream(Data, flds[i].AsLargeUInt);
|
|
datByte: WriteByteToStream(Data, flds[i].AsByte);
|
|
datShortInt: WriteShortIntToStream(Data, flds[i].AsShortInt);
|
|
datWord: WriteWordToStream(Data, flds[i].AsWord);
|
|
datSmallInt: WriteSmallIntToStream(Data, flds[i].AsSmallInt);
|
|
datCardinal: WriteCardinalToStream(Data, flds[i].AsCardinal);
|
|
datGuid: WriteGUIDToStream(Data, {$IFDEF UNICODE}AnsiToUtf8{$ENDIF}(flds[i].AsString));
|
|
datSingleFloat: WriteSingleToStream(Data, flds[i].AsSingle);
|
|
datDecimal: WriteBCDToStream(Data, flds[i].AsDecimal);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Inc(result);
|
|
Inc(k);
|
|
Source.Next;
|
|
if Source.EOF then Break;
|
|
end;
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t2:=now;
|
|
OutputDebugString(PAnsiChar('TDABIN2DataStreamer.InternalDoWriteDataset:'+TimeToStr(t2-t1)+' | ' +FloatToStr(t2-t1)));
|
|
{$ENDIF BIN2DEBUG_time}
|
|
end;
|
|
end;
|
|
|
|
function TDABin2DataStreamer.GetTargetDataType: TRODataType;
|
|
begin
|
|
Result := rtBinary;
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.CheckSignature(aSignature: TBIN2AdapterSignature);
|
|
begin
|
|
if (asignature <> BIN2AdapterSignature) then raise Exception.Create('Incompatible binary2 adapter stream');
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.InternalDoWriteDataset_NonDataset(
|
|
const Source: IDADataset; var k: integer; const Maxrecords: integer;
|
|
ARealFields: array of integer; aDataIndex: Integer;
|
|
info: array of TDASmallFieldInfo);
|
|
|
|
type
|
|
TfldInfo = packed record
|
|
isNull: Boolean;
|
|
Data: pointer;
|
|
DataSize: Cardinal;
|
|
DataType: TFieldType;
|
|
end;
|
|
|
|
var
|
|
currpos: integer;
|
|
ev1, ev2: boolean;
|
|
BitMask: Ansistring;
|
|
BitMaskSize: integer;
|
|
bitmaskpos : integer;
|
|
NeedWriteBitMask: Boolean;
|
|
i : integer;
|
|
Realfldcnt: integer;
|
|
flds: array of TDAField;
|
|
val: Variant;
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t1,t2: TDateTime;
|
|
{$ENDIF BIN2DEBUG_time}
|
|
NativeDataset: IDASQLCommandNativeObject;
|
|
fldInfo: array of TfldInfo;
|
|
s: Ansistring;
|
|
lbcd: TBCD;
|
|
lCanFreeNativeData: Boolean;
|
|
begin
|
|
if (Source.QueryInterface(IDASQLCommandNativeObject, NativeDataset) <> 0)
|
|
{$IFDEF Drivers_CompatibilityMode}or NativeDataset.IsTDatasetCompatible{$ENDIF} then begin
|
|
// dataset-compatible mode
|
|
InternalDoWriteDataset(Source, k, Maxrecords, ARealFields, aDataIndex, info);
|
|
exit;
|
|
end;
|
|
Realfldcnt:= Length(ARealFields);
|
|
BitMaskSize := (Realfldcnt + 7) div 8;
|
|
SetLength(BitMask, BitMaskSize);
|
|
// bitmask has different value that in ReadDelta/WriteDelta !!!
|
|
// 0 = field is not null
|
|
// 1 = field is null
|
|
ev1 := Assigned(OnBeforeFieldValueSerialization);
|
|
ev2 := Assigned(OnWriteFieldValue);
|
|
if ev1 or ev2 then begin
|
|
// with events
|
|
SetLength(flds,Realfldcnt);
|
|
for i := 0 to Realfldcnt-1 do begin
|
|
if ARealFields[i] = -10 then
|
|
flds[i]:=nil
|
|
else
|
|
flds[i]:=Source.Fields[ARealFields[i]];
|
|
end;
|
|
while (k <> Maxrecords) and not Source.EOF do begin
|
|
ClearBitMask(PAnsiChar(BitMask),BitMaskSize); // all is not Null
|
|
bitmaskpos := Data.Position;
|
|
Data.Write(pointer(BitMask)^, BitMaskSize);
|
|
NeedWriteBitMask := False;
|
|
for i := 0 to (Realfldcnt - 1) do begin
|
|
//ARealFields[i] = -10 then this is @SourceTable field
|
|
if ARealFields[i] = -10 then begin
|
|
//We shouldn't fire events since this is special internal field
|
|
val := aDataIndex;
|
|
end else begin
|
|
val := Source.FieldValues[ARealFields[i]];
|
|
if ev1 then OnBeforeFieldValueSerialization(flds[i], val);
|
|
if ev2 then OnWriteFieldValue(flds[i], val);
|
|
end;
|
|
|
|
if VarIsNull(Val) or VarIsEmpty(Val) then begin
|
|
NeedWriteBitMask := True;
|
|
SetBitMask(PAnsiChar(BitMask), i, True);
|
|
end else begin
|
|
if not WriteVariantToStream(Data, val, Info[i].Datatype) then begin
|
|
NeedWriteBitMask := True;
|
|
SetBitMask(PAnsiChar(BitMask), i, True);
|
|
end;
|
|
end;
|
|
if NeedWriteBitMask then begin
|
|
currpos := Data.Position;
|
|
Data.Position := bitmaskpos;
|
|
Data.Write(pointer(BitMask)^, BitMaskSize);
|
|
Data.Position := currpos;
|
|
end;
|
|
end;
|
|
// Inc(result);
|
|
Inc(k);
|
|
Source.Next;
|
|
if Source.EOF then Break;
|
|
end;
|
|
end
|
|
else begin
|
|
// Writes the actual records
|
|
// without events
|
|
SetLength(fldInfo,Realfldcnt);
|
|
for i := 0 to (Realfldcnt - 1) do begin
|
|
if (ARealFields[i] = -10) then
|
|
fldInfo[i].DataType:= ftInteger
|
|
else
|
|
fldInfo[i].DataType:= NativeDataset.NativeFields[i].DataType;
|
|
end;
|
|
lCanFreeNativeData := NativeDataset.CanFreeNativeFieldData;
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t1:=now;
|
|
{$ENDIF BIN2DEBUG_time}
|
|
while (k <> Maxrecords) and not Source.EOF do begin
|
|
ClearBitMask(PAnsiChar(BitMask),BitMaskSize); // all is not Null
|
|
|
|
|
|
for i := 0 to (Realfldcnt - 1) do begin
|
|
if (ARealFields[i] = -10) then begin
|
|
//ARealFields[i] = -10 then this is @SourceTable field
|
|
fldInfo[i].isNull := False;
|
|
GetMem(fldInfo[i].Data, SizeOf(Integer));
|
|
PInteger(fldInfo[i].Data)^ := aDataIndex;
|
|
fldInfo[i].DataSize:=4;
|
|
end
|
|
else begin
|
|
fldInfo[i].isNull:= not NativeDataset.GetNativeFieldData(ARealFields[i],fldInfo[i].Data, fldInfo[i].DataSize);
|
|
end;
|
|
if fldInfo[i].isNull then
|
|
SetBitMask(PAnsiChar(BitMask), i, True);
|
|
end;
|
|
Data.Write(pointer(BitMask)^, BitMaskSize);
|
|
for i := 0 to (Realfldcnt - 1) do begin
|
|
if not fldInfo[i].isNull then begin
|
|
try
|
|
case Info[i].Datatype of
|
|
datWideString, datWideMemo, datXml,
|
|
datString, datMemo, datBlob: begin
|
|
WriteIntegerToStream(Data, fldInfo[i].DataSize);
|
|
Data.Write(fldInfo[i].Data^, fldInfo[i].DataSize);
|
|
end;
|
|
datDecimal: begin
|
|
case fldInfo[i].DataType of
|
|
ftFMTBCD: WriteBCDToStream(Data, PBCD(fldinfo[i].Data)^);
|
|
ftBCD: begin
|
|
CurrToBcd(PCurrency(fldinfo[i].Data)^, lbcd);
|
|
WriteBCDToStream(Data, lbcd);
|
|
end;
|
|
end;
|
|
end;
|
|
datGuid: begin
|
|
if fldinfo[i].DataSize <> 39 then begin
|
|
SetString(s, PAnsiChar(fldinfo[i].Data),38);
|
|
raise Exception.Create('Invalid GUID: '+s)
|
|
end
|
|
else
|
|
Data.Write((PAnsiChar(fldinfo[i].Data)+1)^,36);
|
|
end;
|
|
datBoolean: WriteBooleanToStream(Data, PWordBool(fldinfo[i].Data)^);
|
|
else
|
|
Data.Write((fldinfo[i].Data)^, fldinfo[i].DataSize);
|
|
end;
|
|
finally
|
|
if lCanFreeNativeData then FreeMem(fldinfo[i].Data);
|
|
end;
|
|
end;
|
|
end;
|
|
// Inc(result);
|
|
Inc(k);
|
|
Source.Next;
|
|
if Source.EOF then Break;
|
|
end;
|
|
{$IFDEF BIN2DEBUG_time}
|
|
t2:=now;
|
|
OutputDebugString(PAnsiChar('TDABIN2DataStreamer.InternalDoWriteDataset:'+TimeToStr(t2-t1)+' | ' +FloatToStr(t2-t1)));
|
|
{$ENDIF BIN2DEBUG_time}
|
|
end;
|
|
end;
|
|
|
|
end.
|
|
|