1501 lines
57 KiB
ObjectPascal
1501 lines
57 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}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
uDAInterfaces, uDADelta,
|
|
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
|
|
// 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;
|
|
published
|
|
property BufferSize;
|
|
property SendReducedDelta;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, Variants, FMTBcd, uROBinaryHelpers,
|
|
uROClasses, uDAEngine, uDAClasses;
|
|
|
|
const
|
|
field_count = 34;
|
|
param_count = 11;
|
|
TAlignmentStrings: array[Low(TAlignment)..High(TAlignment)] of string =
|
|
('taLeftJustify', 'taRightJustify', 'taCenter');
|
|
TDABlobTypeStrings: array[Low(TDABlobType)..High(TDABlobType)] of string =
|
|
('dabtUnknown', 'dabtBlob', 'dabtMemo', 'dabtOraBlob',
|
|
'dabtOraClob', 'dabtGraphic', 'dabtTypedBinary');
|
|
TDADataTypeStrings: array[Low(TDADataType)..High(TDADataType)] of string =
|
|
('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 string =
|
|
('daptUnknown', 'daptInput', 'daptOutput', 'daptInputOutput',
|
|
'daptResult');
|
|
|
|
|
|
|
|
|
|
// from uDAMemDataset
|
|
const
|
|
ft_Reference = [datString, datMemo, datBlob, datWideString, datWideMemo];
|
|
|
|
function TAlignmentStringsToTAlignment(aValue: string): TAlignment;
|
|
begin
|
|
for Result := Low(TAlignment) to High(TAlignment) do
|
|
if SameText(TAlignmentStrings[Result], aValue) then Exit;
|
|
raise Exception.Create('Unknown TAlignment value: '''+aValue+'''');
|
|
end;
|
|
|
|
function TDABlobTypeStringsToTDABlobType(aValue: string): TDABlobType;
|
|
begin
|
|
for Result := Low(TDABlobType) to High(TDABlobType) do
|
|
if SameText(TDABlobTypeStrings[Result], aValue) then Exit;
|
|
raise Exception.Create('Unknown TDABlobType value: '''+aValue+'''');
|
|
end;
|
|
|
|
function TDADataTypeStringsToTDADataType(aValue: string): TDADataType;
|
|
begin
|
|
for Result := Low(TDADataType) to High(TDADataType) do
|
|
if SameText(TDADataTypeStrings[Result], aValue) then Exit;
|
|
raise Exception.Create('Unknown TDADataType value: '''+aValue+'''');
|
|
end;
|
|
|
|
function TDAParamTypeStringsToTDAParamType(aValue: string): TDAParamType;
|
|
begin
|
|
for Result := Low(TDAParamType) to High(TDAParamType) do
|
|
if SameText(TDAParamTypeStrings[Result], aValue) then Exit;
|
|
raise Exception.Create('Unknown TDAParamType value: '''+aValue+'''');
|
|
end;
|
|
|
|
procedure SetBitMask(Buffer: Pchar; const Index: Integer; const Value: boolean);
|
|
var
|
|
i: byte;
|
|
begin
|
|
i := Index shr 3;
|
|
if Value then
|
|
Buffer[I] := Chr(ord(Buffer[I]) or (1 shl (Index and 7)))
|
|
else
|
|
Buffer[I] := Chr(ord(Buffer[I]) and not (1 shl (Index and 7)))
|
|
end;
|
|
|
|
function GetBitMask(Buffer: Pchar; const Index: Integer): boolean;
|
|
begin
|
|
Result := (ord(Buffer[Index shr 3]) shr (Index and 7)) and 1 = 1;
|
|
end;
|
|
|
|
procedure ClearBitMask(Buffer: Pchar; 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 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): string;
|
|
begin
|
|
SetLength(Result,38);
|
|
Result[1]:='{';
|
|
Stream.Read(Result[2], 36 {Length(GuidString)-2});
|
|
Result[38]:='}'
|
|
end;
|
|
|
|
procedure WriteGUIDToStream(Stream: TStream; const Value: string);
|
|
begin
|
|
if Length(Value) <> 38 then RaiseError('Invalid GUID: '+Value);
|
|
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 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);
|
|
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);
|
|
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, Value);
|
|
varString: WriteAnsistringToStream(Stream, 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, VarToStr(Value));
|
|
datDateTime: WriteDateTimeToStream(Stream, VarToDateTime(Value));
|
|
datFloat: WriteDoubleToStream(Stream, Value);
|
|
datBoolean: WriteBooleanToStream(Stream, Value);
|
|
datCurrency: WriteCurrencyToStream(Stream, Value);
|
|
datAutoInc, datInteger: WriteIntegerToStream(Stream, Value);
|
|
datLargeInt, datLargeAutoInc, datLargeUInt: Writeint64ToStream(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, 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, datLargeUInt: Result := Readint64FromStream(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 := 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
|
|
signature := BIN2AdapterSignature;
|
|
Data.Read(signature, SizeOf(signature));
|
|
if (signature <> BIN2AdapterSignature) then raise Exception.Create('Incompatible binary2 adapter stream');
|
|
|
|
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;
|
|
|
|
{$IFDEF FPC}
|
|
type
|
|
PDateTime = ^TDateTime;
|
|
{$ENDIF}
|
|
|
|
procedure BitmaskToNativeBuf(Bitmask, buf: pChar; BitMaskSize: integer);
|
|
var
|
|
j: integer;
|
|
i: integer;
|
|
begin
|
|
j := BitMaskSize;
|
|
for i:=0 to j-1 do begin
|
|
buf[i] := chr((ord(bitmask[i]) shl 1) and $FE);
|
|
if i > 0 then buf[i]:= chr(ord(buf[i]) + ((ord(bitmask[i-1]) shr 7) and 1));
|
|
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;
|
|
val: Variant;
|
|
readonlyfields: array of boolean;
|
|
//
|
|
Realfldcount: integer;
|
|
info: array of TDASmallFieldInfo;
|
|
BitMask: string;
|
|
streamer_BitMaskSize, memdataset_BitMaskSize: integer;
|
|
RealFields: array of integer;
|
|
Buf: Pchar;
|
|
buf1: pointer;
|
|
memdataset: IDAMemDatasetBatchAdding;
|
|
s: string;
|
|
lErrorMessage: String;
|
|
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;
|
|
|
|
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);
|
|
//Data.Read(pointer(info)^, Sizeof(TDASmallFieldInfo) * Realfldcount);
|
|
for i := 0 to Realfldcount - 1 do begin
|
|
info[i].Name := ReadAnsistringFromStream(Data);
|
|
info[i].Datatype := TDADataType(ReadByteFromStream(Data));
|
|
info[i].Size := ReadIntegerFromStream(Data);
|
|
end;
|
|
SetLength(RealFields, Fields.Count);
|
|
|
|
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
|
|
lErrorMessage := lErrorMessage + 'Fields count mismatch' + #10#13
|
|
else begin
|
|
if (Fields[i].Name <> Info[k].Name) then lErrorMessage := lErrorMessage + Format('Name mismatch: %s expected but %s found in stream.', [Fields[i].Name, Info[k].Name]) + #10#13;
|
|
if (Fields[i].DataType <> Info[k].Datatype) then lErrorMessage := lErrorMessage + Format('Data type mismatch for column ''%s.%s'': %s expected but %s found in stream.', [DatasetName, Fields[i].Name, TDADataTypeStrings[Fields[i].DataType], TDADataTypeStrings[Info[k].Datatype]]) + #10#13;
|
|
if (Fields[i].Size <> Info[k].Size) then lErrorMessage := lErrorMessage + Format('Size mismatch for column ''%s.%s'': %d expected but %d found in stream.', [DatasetName, Fields[i].Name, Fields[i].Size, Info[k].Size]) + #10#13;
|
|
end;
|
|
inc(k);
|
|
end;
|
|
if (k <> Realfldcount) then lErrorMessage := lErrorMessage + Format('Fields count mismatch: %d expected but %d found in the stream', [Realfldcount, k]) + #10#13;
|
|
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;
|
|
|
|
|
|
SetLength(RealFields, Realfldcount);
|
|
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
|
|
|
|
// Inserts the records
|
|
try
|
|
if Destination.QueryInterface(IDAMemDatasetBatchAdding, memdataset) <> s_ok then memdataset := nil;
|
|
|
|
if (memdataset = nil) or Assigned(OnReadFieldValue) then begin
|
|
// standard mode
|
|
while (cnt > 0) do try
|
|
Append;
|
|
// read bitmask
|
|
Data.Read(pointer(BitMask)^, streamer_BitMaskSize);
|
|
for i := 0 to Realfldcount - 1 do begin
|
|
fld := Fields[RealFields[i]];
|
|
if GetBitMask(Pchar(BitMask), i) then
|
|
//
|
|
else begin
|
|
case fld.Datatype of
|
|
datWideString, datWideMemo, datXml: fld.AsWideString := ReadWidestringFromStream(Data);
|
|
datString, datMemo, DatBlob: fld.AsString := ReadAnsistringFromStream(Data);
|
|
datDateTime: fld.AsDateTime := ReadDateTimeFromStream(Data);
|
|
datFloat: fld.AsFloat := ReadDoubleFromStream(Data);
|
|
datCurrency: fld.AsCurrency := ReadCurrencyFromStream(Data);
|
|
datBoolean: fld.AsBoolean := ReadBooleanFromStream(Data);
|
|
datAutoInc, datInteger: fld.AsInteger := ReadIntegerFromStream(Data);
|
|
datLargeInt, datLargeAutoInc, datLargeUInt: fld.AsLargeInt := Readint64FromStream(Data);
|
|
datByte: fld.AsByte := ReadByteFromStream(Data);
|
|
datShortInt: fld.AsShortInt := ReadShortIntFromStream(Data);
|
|
datWord: fld.AsWord := ReadWordFromStream(Data);
|
|
datSmallInt: fld.AsSmallInt := ReadSmallIntFromStream(Data);
|
|
datCardinal: fld.AsCardinal := ReadCardinalFromStream(Data);
|
|
datGuid: fld.AsString := ReadGuidFromStream(Data);
|
|
datSingleFloat: fld.AsSingle := ReadSingleFromStream(Data);
|
|
datDecimal: fld.AsDecimal := ReadBCDFromStream(Data);
|
|
end;
|
|
end;
|
|
if Assigned(OnReadFieldValue) then begin
|
|
val := fld.Value;
|
|
OnReadFieldValue(fld, val);
|
|
fld.Value := val;
|
|
end;
|
|
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
|
|
// superfast mode
|
|
memdataset_BitMaskSize := (Realfldcount + 1 {RECID} + 7) div 8;
|
|
SetLength(BitMask, memdataset_BitMaskSize);
|
|
|
|
while (cnt > 0) do try
|
|
Buf := memdataset.AllocRecordBuffer;
|
|
try
|
|
Data.Read(pointer(BitMask)^, streamer_BitMaskSize);
|
|
BitmaskToNativeBuf(pointer(BitMask),buf, memdataset_BitMaskSize);
|
|
//Data.Read(buf^, BitMaskSize);
|
|
for i := 0 to Realfldcount - 1 do begin
|
|
fld := Fields[RealFields[i]];
|
|
if GetBitMask(Pchar(BitMask), i) then
|
|
//
|
|
else begin
|
|
buf1 := memdataset.GetFieldNativeBuffer(Buf, fld.BindedField);
|
|
case fld.DataType of
|
|
datWideString, datXml: memdataset.SetWideString(buf1,fld.BindedField,ReadWidestringFromStream(Data));//PWideString(buf1)^ := ReadWidestringFromStream(Data);
|
|
datString: memdataset.SetAnsiString(buf1,fld.BindedField,ReadAnsistringFromStream(Data));//PAnsiString(buf1)^ := ReadAnsistringFromStream(Data);
|
|
datDateTime: PDateTime(buf1)^ := TimeStampToMSecs(DateTimeToTimeStamp(ReadDateTimeFromStream(Data)));
|
|
datFloat: PDouble(buf1)^ := ReadDoubleFromStream(Data);
|
|
datCurrency: PDouble(buf1)^ := ReadCurrencyFromStream(Data);
|
|
datBoolean: PBoolean(buf1)^ := ReadBooleanFromStream(Data);
|
|
datLargeInt, datLargeAutoInc, datLargeUInt: PInt64(buf1)^ := Readint64FromStream(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;
|
|
memdataset.AppendBuffer(Buf);
|
|
except
|
|
memdataset.FreeRecordBuffer(buf);
|
|
raise;
|
|
end;
|
|
finally
|
|
Dec(cnt);
|
|
end;
|
|
memdataset.FinalizeBatchAdding;
|
|
end;
|
|
except
|
|
raise;
|
|
end;
|
|
finally
|
|
// Restores the read-only property
|
|
for i := 0 to (Fields.Count - 1) do
|
|
Fields[i].ReadOnly := readonlyfields[i];
|
|
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: string;
|
|
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 := 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 := 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 := 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(Pchar(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(Pchar(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: string;
|
|
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);
|
|
|
|
// 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, 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, 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, Source.Changes[i].Message);
|
|
|
|
// bitmask has different value that in ReadDeataset/WriteDataset !!!
|
|
// 1 = field is not null
|
|
// 0 = field is null
|
|
ClearBitMask(Pchar(BitMask_old),BitMaskSize,0);
|
|
ClearBitMask(Pchar(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(Pchar(BitMask_Old), x, l_bitmaskflag and not (VarIsNull(old_val) or (VarIsEmpty(old_val))));
|
|
SetBitMask(Pchar(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(Pchar(BitMask_Old), x, not (VarIsNull(old_val) or (VarIsEmpty(old_val))));
|
|
SetBitMask(Pchar(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(Pchar(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(Pchar(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 := 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]:= fld.Index
|
|
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, 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, currpos, k, i, bitmaskpos, Realfldcnt: integer;
|
|
fld: TDAField;
|
|
val: Variant;
|
|
info: array of TDASmallFieldInfo;
|
|
BitMask: string;
|
|
BitMaskSize: integer;
|
|
RealFields: array of integer;
|
|
ev1, ev2: boolean;
|
|
NeedWriteBitMask: Boolean;
|
|
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;
|
|
|
|
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);
|
|
try
|
|
if ev1 or ev2 then begin
|
|
// with events
|
|
while (k <> max) and not EOF do begin
|
|
ClearBitMask(Pchar(BitMask),BitMaskSize); // all is not Null
|
|
bitmaskpos := Data.Position;
|
|
Data.Write(pointer(BitMask)^, BitMaskSize);
|
|
NeedWriteBitMask := False;
|
|
for i := 0 to (Realfldcnt - 1) do begin
|
|
//RealFields[i] = -10 then this is @SourceTable field
|
|
if RealFields[i] = -10 then begin
|
|
//We shouldn't fire events since this is special internal field
|
|
val := aDataIndex;
|
|
end else begin
|
|
fld := Fields[RealFields[i]];
|
|
val := FieldValues[RealFields[i]];
|
|
if ev1 then OnBeforeFieldValueSerialization(fld, val);
|
|
if ev2 then OnWriteFieldValue(fld, val);
|
|
end;
|
|
|
|
if VarIsNull(Val) or VarIsEmpty(Val) then begin
|
|
NeedWriteBitMask := True;
|
|
SetBitMask(Pchar(BitMask), i, True);
|
|
// if info[i].Datatype in ft_Reference then WriteIntegerToStream(Data, 0); // size=0
|
|
end else begin
|
|
if not WriteVariantToStream(Data, val, Info[i].Datatype) then begin
|
|
NeedWriteBitMask := True;
|
|
SetBitMask(Pchar(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
|
|
while (k <> max) and not EOF do begin
|
|
ClearBitMask(Pchar(BitMask),BitMaskSize); // all is not Null
|
|
|
|
|
|
|
|
for i := 0 to (Realfldcnt - 1) do
|
|
//RealFields[i] = -10 then this is @SourceTable field
|
|
if ((RealFields[i] <> -10) and (Fields[RealFields[i]].IsNull)) then
|
|
SetBitMask(Pchar(BitMask), i, True);
|
|
Data.Write(pointer(BitMask)^, BitMaskSize);
|
|
|
|
for i := 0 to (Realfldcnt - 1) do begin
|
|
|
|
//RealFields[i] = -10 then this is @SourceTable field
|
|
if RealFields[i] = -10 then begin
|
|
WriteIntegerToStream(Data, aDataIndex);
|
|
end else begin
|
|
fld := Fields[RealFields[i]];
|
|
if GetBitMask(Pchar(BitMask), i) then begin
|
|
// if info[i].Datatype in ft_Reference then WriteIntegerToStream(Data, 0); // size=0
|
|
end else begin
|
|
case Info[i].Datatype of
|
|
datWideString, datWideMemo, datXml: WriteWidestringToStream(Data, fld.AsWideString);
|
|
datString, datMemo, datBlob: WriteAnsistringToStream(Data, fld.AsString);
|
|
datDateTime: WriteDateTimeToStream(Data, fld.AsDateTime);
|
|
datFloat: WriteDoubleToStream(Data, fld.AsFloat);
|
|
datBoolean: WriteBooleanToStream(Data, fld.AsBoolean);
|
|
datCurrency: WriteCurrencyToStream(Data, fld.AsCurrency);
|
|
datAutoInc, datInteger: WriteIntegerToStream(Data, fld.AsInteger);
|
|
datLargeInt, datLargeAutoInc, datLargeUInt: Writeint64ToStream(Data, fld.AsLargeInt);
|
|
datByte: WriteByteToStream(Data, fld.AsByte);
|
|
datShortInt: WriteShortIntToStream(Data, fld.AsShortInt);
|
|
datWord: WriteWordToStream(Data, fld.AsWord);
|
|
datSmallInt: WriteSmallIntToStream(Data, fld.AsSmallInt);
|
|
datCardinal: WriteCardinalToStream(Data, fld.AsCardinal);
|
|
datGuid: WriteGUIDToStream(Data, fld.AsString);
|
|
datSingleFloat: WriteSingleToStream(Data, fld.AsSingle);
|
|
datDecimal: WriteBCDToStream(Data, fld.AsDecimal);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
// Inc(result);
|
|
Inc(k);
|
|
Source.Next;
|
|
if Source.EOF then Break;
|
|
end;
|
|
end;
|
|
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;
|
|
|
|
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, AField.BusinessClassID);
|
|
WriteAnsistringToStream(Data, 'Calculated');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.Calculated,True));
|
|
WriteAnsistringToStream(Data, 'CustomAttributes');
|
|
WriteAnsistringToStream(Data, AField.CustomAttributes.Text);
|
|
WriteAnsistringToStream(Data, 'DataType');
|
|
WriteAnsistringToStream(Data, TDADataTypeStrings[AField.DataType]);
|
|
WriteAnsistringToStream(Data, 'DecimalPrecision');
|
|
WriteAnsistringToStream(Data, IntToStr(AField.DecimalPrecision));
|
|
WriteAnsistringToStream(Data, 'DecimalScale');
|
|
WriteAnsistringToStream(Data, IntToStr(AField.DecimalScale));
|
|
WriteAnsistringToStream(Data, 'DefaultValue');
|
|
WriteAnsistringToStream(Data, AField.DefaultValue);
|
|
WriteAnsistringToStream(Data, 'Description');
|
|
WriteAnsistringToStream(Data, AField.Description);
|
|
WriteAnsistringToStream(Data, 'DictionaryEntry');
|
|
WriteAnsistringToStream(Data, AField.DictionaryEntry);
|
|
WriteAnsistringToStream(Data, 'DisplayFormat');
|
|
WriteAnsistringToStream(Data, AField.DisplayFormat);
|
|
WriteAnsistringToStream(Data, 'DisplayLabel');
|
|
WriteAnsistringToStream(Data, AField.DisplayLabel);
|
|
WriteAnsistringToStream(Data, 'DisplayWidth');
|
|
WriteAnsistringToStream(Data, IntToStr(AField.DisplayWidth));
|
|
WriteAnsistringToStream(Data, 'EditFormat');
|
|
WriteAnsistringToStream(Data, AField.EditFormat);
|
|
WriteAnsistringToStream(Data, 'EditMask');
|
|
WriteAnsistringToStream(Data, AField.EditMask);
|
|
WriteAnsistringToStream(Data, 'Expression');
|
|
WriteAnsistringToStream(Data, AField.Expression);
|
|
WriteAnsistringToStream(Data, 'GeneratorName');
|
|
WriteAnsistringToStream(Data, AField.GeneratorName);
|
|
WriteAnsistringToStream(Data, 'InPrimaryKey');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.InPrimaryKey,True));
|
|
WriteAnsistringToStream(Data, 'KeyFields');
|
|
WriteAnsistringToStream(Data, AField.KeyFields);
|
|
WriteAnsistringToStream(Data, 'LogChanges');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.LogChanges,True));
|
|
WriteAnsistringToStream(Data, 'Lookup');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.Lookup,True));
|
|
WriteAnsistringToStream(Data, 'LookupCache');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.LookupCache,True));
|
|
WriteAnsistringToStream(Data, 'LookupKeyFields');
|
|
WriteAnsistringToStream(Data, AField.LookupKeyFields);
|
|
WriteAnsistringToStream(Data, 'LookupResultField');
|
|
WriteAnsistringToStream(Data, AField.LookupResultField);
|
|
WriteAnsistringToStream(Data, 'LookupSource');
|
|
WriteAnsistringToStream(Data, '');
|
|
WriteAnsistringToStream(Data, 'Name');
|
|
WriteAnsistringToStream(Data, AField.Name);
|
|
WriteAnsistringToStream(Data, 'ReadOnly');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.ReadOnly,True));
|
|
WriteAnsistringToStream(Data, 'RegExpression');
|
|
WriteAnsistringToStream(Data, AField.RegExpression);
|
|
WriteAnsistringToStream(Data, 'Required');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.Required,True));
|
|
WriteAnsistringToStream(Data, 'ServerAutoRefresh');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.ServerAutoRefresh,True));
|
|
WriteAnsistringToStream(Data, 'ServerCalculated');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.ServerCalculated,True));
|
|
WriteAnsistringToStream(Data, 'Size');
|
|
WriteAnsistringToStream(Data, IntToStr(AField.Size));
|
|
WriteAnsistringToStream(Data, 'Visible');
|
|
WriteAnsistringToStream(Data, BoolToStr(AField.Visible,True));
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.WriteParam(const AParam: TDAParam);
|
|
begin
|
|
WriteAnsistringToStream(Data, 'AsString');
|
|
WriteAnsistringToStream(Data, AParam.AsString);
|
|
WriteAnsistringToStream(Data, 'BlobType');
|
|
WriteAnsistringToStream(Data, TDABlobTypeStrings[AParam.BlobType]);
|
|
WriteAnsistringToStream(Data, 'DataType');
|
|
WriteAnsistringToStream(Data, TDADataTypeStrings[AParam.DataType]);
|
|
WriteAnsistringToStream(Data, 'DecimalPrecision');
|
|
WriteAnsistringToStream(Data, IntToStr(AParam.DecimalPrecision));
|
|
WriteAnsistringToStream(Data, 'DecimalScale');
|
|
WriteAnsistringToStream(Data, IntToStr(AParam.DecimalScale));
|
|
WriteAnsistringToStream(Data, 'Description');
|
|
WriteAnsistringToStream(Data, AParam.Description);
|
|
WriteAnsistringToStream(Data, 'GeneratorName');
|
|
WriteAnsistringToStream(Data, AParam.GeneratorName);
|
|
WriteAnsistringToStream(Data, 'Name');
|
|
WriteAnsistringToStream(Data, AParam.Name);
|
|
WriteAnsistringToStream(Data, 'ParamType');
|
|
WriteAnsistringToStream(Data, TDAParamTypeStrings[AParam.ParamType]);
|
|
WriteAnsistringToStream(Data, 'Size');
|
|
WriteAnsistringToStream(Data, IntToStr(AParam.Size));
|
|
WriteAnsistringToStream(Data, 'Value');
|
|
WriteAnsistringToStream(Data, VarToStr(AParam.Value));
|
|
end;
|
|
|
|
procedure TDABin2DataStreamer.ReadParam(const AParam: TDAParam; const aParamPropertiesCount: integer);
|
|
var
|
|
i: integer;
|
|
sName,sValue: string;
|
|
begin
|
|
For i := 0 to aParamPropertiesCount-1 do begin
|
|
sName := ReadAnsistringFromStream(Data);
|
|
sValue := ReadAnsistringFromStream(Data);
|
|
if sName = 'AsString' then AParam.AsString:= sValue
|
|
else if sName = 'BlobType' then AParam.BlobType := TDABlobTypeStringsToTDABlobType(sValue)
|
|
else if sName = 'DataType' then AParam.DataType := TDADataTypeStringsToTDADataType(sValue)
|
|
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(sValue)
|
|
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,sValue: string;
|
|
begin
|
|
For i := 0 to aFieldPropertiesCount-1 do begin
|
|
sName := ReadAnsistringFromStream(Data);
|
|
sValue := ReadAnsistringFromStream(Data);
|
|
if sName = 'Alignment' then AField.Alignment := TAlignmentStringsToTAlignment(sValue)
|
|
else if sName = 'BlobType' then AField.BlobType := TDABlobTypeStringsToTDABlobType(sValue)
|
|
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(sValue)
|
|
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;
|
|
|
|
end.
|
|
|