david
2824855ea7
- Recompilación en Delphi10 de todos los paquetes de RO para generar las DCU's en Lib\D10 - Recompilación en Delphi10 de todos los paquetes de DA para generar las DCU's en Lib\D10 git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@9 b6239004-a887-0f4b-9937-50029ccdca16
1225 lines
40 KiB
ObjectPascal
1225 lines
40 KiB
ObjectPascal
unit uDABinAdapter;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ Data Abstract Library - Core Library }
|
|
{ }
|
|
{ compiler: Delphi 6 and up, Kylix 3 and up }
|
|
{ platform: Win32, Linux }
|
|
{ }
|
|
{ (c)opyright RemObjects Software. all rights reserved. }
|
|
{ }
|
|
{ Using this code requires a valid license of the Data Abstract }
|
|
{ which can be obtained at http://www.remobjects.com. }
|
|
{----------------------------------------------------------------------------}
|
|
|
|
{$I DataAbstract.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes,
|
|
uROTypes,
|
|
uDADataTable, uDAInterfaces, uDADataStreamer, uDADelta, FMTBcd;
|
|
|
|
type
|
|
TBINAdapterSignature = array[0..7] of char;
|
|
|
|
const
|
|
BINAdapterSignature: TBINAdapterSignature = 'DABIN100';
|
|
|
|
type
|
|
TDAElementType = (etDataset, etDelta);
|
|
|
|
{ TElementInfo }
|
|
TDAElementInfo = class
|
|
ElementType: TDAElementType;
|
|
Name: string;
|
|
Offset: integer;
|
|
end;
|
|
|
|
{ TDABinDataStreamer }
|
|
TDABinDataStreamer = class(TDADataStreamer)
|
|
private
|
|
fReader: TReader;
|
|
fWriter: TWriter;
|
|
|
|
fInfoIntOffset: integer;
|
|
fIsCompatibleV4: boolean;
|
|
|
|
procedure AddElementInfo(ElementType: TDAElementType; ElementName: string; Offset: integer);
|
|
procedure WriteElementInfo(ElementInfo: TDAElementInfo);
|
|
procedure ReadElementInfo;
|
|
function GetElementInfo(ElementType: TDAElementType; const Name: string): TDAElementInfo;
|
|
|
|
procedure ReadAndApplySchema(const Destination: IDADataset; ApplySchema: boolean);
|
|
procedure WriteSchema(const Fields: TDAFieldCollection; const Params: TDAParamCollection; aFieldsIndex: array of integer); overload;
|
|
function ReadOffset: integer;
|
|
procedure WriteOffset(Offset: integer);
|
|
|
|
protected
|
|
// Overriden
|
|
function DoCreateStream: TStream; override;
|
|
procedure DoInitialize(Mode: TDAAdapterInitialization); override;
|
|
procedure DoFinalize; override;
|
|
function DoWriteDataset(const Source: IDADataset; Options: TDAWriteOptions; MaxRows: integer;ADynFieldNames: array of string): integer; override;
|
|
procedure DoWriteDelta(const Source: IDADelta); override;
|
|
procedure DoReadDataset(const DatasetName: string; const Destination: IDADataset; ApplySchema: boolean); override;
|
|
procedure DoReadDelta(const DeltaName: string; const Destination: IDADelta); override;
|
|
procedure SetBufferSize(const Value: cardinal); override;
|
|
|
|
function DoBeginWriteDataset( const Source: IDADataset; const Schema: TDADataset;
|
|
Options: TDAWriteOptions; MaxRows: integer;
|
|
ADynFieldNames: array of string): TDADataForAppend; override;
|
|
|
|
function DoWriteDatasetData(const Source: IDADataset; var aDataForAppend: TDADataForAppend; aDataIndex: Integer = -1): Integer; override;
|
|
function DoEndWriteDataset(aDataForAppend: TDADataForAppend): Integer; override;
|
|
|
|
public
|
|
constructor Create(aOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
|
|
function GetTargetDataType: TRODataType; override;
|
|
published
|
|
property BufferSize;
|
|
property IsCompatibleV4: boolean read fIsCompatibleV4 write fIsCompatibleV4 default True;
|
|
end;
|
|
|
|
TDABINAdapter = class(TDABinDataStreamer) end deprecated;
|
|
|
|
implementation
|
|
|
|
uses Math, SysUtils, Variants, uROBinaryHelpers, uDaClasses, uDAEngine, uROClasses{$IFDEF DELPHI6}, RTLConsts{$ENDIF};
|
|
|
|
|
|
{$IFDEF FPC}
|
|
type
|
|
THackBinaryObjectWriter = class(TBinaryObjectWriter)
|
|
end;
|
|
|
|
THackBinaryObjectReader = class(TBinaryObjectReader)
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure Writer_FlushBuffer(AWriter: TWriter);
|
|
begin
|
|
{$IFNDEF FPC}
|
|
AWriter.FlushBuffer;
|
|
{$ELSE}
|
|
THackBinaryObjectWriter(AWriter.Driver).FlushBuffer;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetWriterPosition(AWriter: TWriter):Longint;
|
|
begin
|
|
{$IFNDEF FPC}
|
|
Result := AWriter.Position
|
|
{$ELSE}
|
|
Result := THackBinaryObjectWriter(AWriter.Driver).FStream.Position;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
Procedure SetWriterPosition(AWriter: TWriter; APosition:Longint);
|
|
begin
|
|
{$IFNDEF FPC}
|
|
AWriter.Position:=APosition;
|
|
{$ELSE}
|
|
Writer_FlushBuffer(AWriter);
|
|
THackBinaryObjectWriter(AWriter.Driver).FStream.Position:=APosition;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
procedure Writer_WriteValue(AWriter: TWriter; aValue: TValueType);
|
|
begin
|
|
THackBinaryObjectWriter(AWriter.Driver).WriteValue(aValue);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure Writer_WriteVariant(AWriter: TWriter; AValue: Variant);
|
|
begin
|
|
{$IFNDEF FPC}
|
|
AWriter.WriteVariant(AValue);
|
|
{$ELSE}
|
|
if VarIsArray(aValue) then raise EWriteError.Create('Stream write error');
|
|
case VarType(aValue) and varTypeMask of
|
|
varEmpty: Writer_WriteValue(AWriter,vaNil);
|
|
varNull: Writer_WriteValue(AWriter,vaNull);
|
|
varOleStr: aWriter.WriteWideString(aValue);
|
|
varString: aWriter.WriteString(aValue);
|
|
varByte, varShortInt, varWord, varSmallInt,
|
|
varInteger,varLongWord, varInt64: aWriter.WriteInteger(aValue);
|
|
varSingle: aWriter.WriteSingle(aValue);
|
|
varDouble: aWriter.WriteFloat(aValue);
|
|
varCurrency: aWriter.WriteCurrency(aValue);
|
|
varDate: aWriter.WriteDate(aValue);
|
|
varBoolean: aWriter.WriteBoolean(aValue);
|
|
else
|
|
aWriter.WriteString(aValue)
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function GetReaderPosition(AReader: TReader):Longint;
|
|
begin
|
|
{$IFNDEF FPC}
|
|
Result := AReader.Position
|
|
{$ELSE}
|
|
Result := THackBinaryObjectReader(AReader.Driver).FStream.Position;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
Procedure SetReaderPosition(AReader: TReader; APosition:Longint);
|
|
begin
|
|
{$IFNDEF FPC}
|
|
AReader.Position:=APosition;
|
|
{$ELSE}
|
|
THackBinaryObjectReader(AReader.Driver).FStream.Position:=APosition;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
|
|
{$IFDEF DELPHI6}
|
|
|
|
function D6_Reader_ReadVariant(AReader: TReader): Variant;
|
|
|
|
function ReadCustomVariant: Variant;
|
|
var
|
|
OuterStream, InnerStream: TMemoryStream;
|
|
OuterReader: TReader;
|
|
StreamSize: Integer;
|
|
CustomType: TCustomVariantType;
|
|
CustomTypeClassName: string;
|
|
VarStreamer: IVarStreamable;
|
|
begin
|
|
with AReader do begin
|
|
CheckValue(vaBinary);
|
|
OuterStream := TMemoryStream.Create;
|
|
InnerStream := TMemoryStream.Create;
|
|
try
|
|
Read(StreamSize, SizeOf(StreamSize));
|
|
OuterStream.Size := StreamSize;
|
|
Read(OuterStream.Memory^, StreamSize);
|
|
|
|
OuterReader := TReader.Create(OuterStream, 1024);
|
|
try
|
|
CustomTypeClassName := OuterReader.ReadString;
|
|
OuterReader.Read(StreamSize, SizeOf(StreamSize));
|
|
InnerStream.Size := StreamSize;
|
|
OuterReader.Read(InnerStream.Memory^, StreamSize);
|
|
|
|
if not FindCustomVariantType(CustomTypeClassName, CustomType) or
|
|
not Supports(TObject(CustomType), IVarStreamable, VarStreamer) then
|
|
raise EReadError.CreateRes(@SReadError);
|
|
TVarData(Result).VType := CustomType.VarType;
|
|
VarStreamer.StreamIn(TVarData(Result), InnerStream);
|
|
finally
|
|
OuterReader.Free;
|
|
end;
|
|
finally
|
|
InnerStream.Free;
|
|
OuterStream.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
begin
|
|
with AReader do begin
|
|
VarClear(Result);
|
|
case NextValue of
|
|
vaNil, vaNull: if ReadValue <> vaNil then
|
|
Result := NULL;
|
|
// Delphi 6 has a bug vaInt8: Result := Byte(ReadInteger);
|
|
vaInt8: Result := Shortint(ReadInteger);
|
|
vaInt16: Result := Smallint(ReadInteger);
|
|
vaInt32: Result := ReadInteger;
|
|
vaExtended: Result := ReadFloat;
|
|
vaSingle: Result := ReadSingle;
|
|
vaCurrency: Result := ReadCurrency;
|
|
vaDate: Result := ReadDate;
|
|
vaString, vaLString: Result := ReadString;
|
|
vaWString,
|
|
vaUTF8String: Result := ReadWideString;
|
|
vaFalse, vaTrue: Result := ReadValue = vaTrue;
|
|
vaBinary: Result := ReadCustomVariant;
|
|
vaInt64: Result := ReadInt64;
|
|
else
|
|
raise EReadError.CreateRes(@SReadError);
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function Reader_ReadVariant(AReader: TReader): Variant;
|
|
begin
|
|
{$IFDEF FPC}
|
|
{$ELSE}
|
|
{$IFDEF DELPHI6}
|
|
Result:= D6_Reader_ReadVariant(AReader);
|
|
{$ELSE}
|
|
Result:= AReader.ReadVariant;
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TDABinDataStreamer }
|
|
|
|
constructor TDABinDataStreamer.Create(aOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
fIsCompatibleV4:=True;
|
|
end;
|
|
|
|
destructor TDABinDataStreamer.Destroy;
|
|
begin
|
|
// Just in case the user did not call Finalize
|
|
|
|
{if Assigned(fReader) then fReader.Free;
|
|
if Assigned(fWriter) then fWriter.Free;}
|
|
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.SetBufferSize(const Value: cardinal);
|
|
begin
|
|
if (Value > 0) then inherited SetBufferSize(Value);
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.DoFinalize;
|
|
var
|
|
finalpos, i: integer;
|
|
begin
|
|
try
|
|
if (AdapterInitialization in AdapterWriteModes) then try
|
|
finalpos := GetWriterPosition(FWriter);
|
|
|
|
// Element count. WIll be read by the DoInitialize method
|
|
fWriter.WriteInteger(DatasetCount + DeltaCount);
|
|
|
|
for i := 0 to (DatasetCount - 1) do
|
|
WriteElementInfo(TDAElementInfo(DatasetInfoObjects[i]));
|
|
|
|
for i := 0 to (DeltaCount - 1) do
|
|
WriteElementInfo(TDAElementInfo(DeltaInfoObjects[i]));
|
|
|
|
Writer_FlushBuffer(FWriter);
|
|
|
|
SetWriterPosition(FWriter, fInfoIntOffset);
|
|
WriteOffset(finalpos);
|
|
except
|
|
beep;
|
|
raise;
|
|
end;
|
|
finally
|
|
// Somehow I need to check because the FreeAndNIL fails on these objects even if the are set to NIL...
|
|
if AdapterInitialization in AdapterReadModes then
|
|
FreeAndNIL(fReader)
|
|
|
|
else if AdapterInitialization in AdapterWriteModes then
|
|
FreeAndNIL(fWriter);
|
|
end;
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.WriteElementInfo(ElementInfo: TDAElementInfo);
|
|
begin
|
|
fWriter.WriteInteger(integer(ElementInfo.ElementType));
|
|
fWriter.WriteString(ElementInfo.Name);
|
|
fWriter.WriteInteger(ElementInfo.Offset);
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.ReadElementInfo;
|
|
var
|
|
et: TDAElementType;
|
|
nme: string;
|
|
ofs: integer;
|
|
begin
|
|
et := TDAElementType(fReader.ReadInteger);
|
|
nme := fReader.ReadString;
|
|
ofs := fReader.ReadInteger;
|
|
AddElementInfo(et, nme, ofs);
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.DoInitialize(Mode: TDAAdapterInitialization);
|
|
var
|
|
signature: TBINAdapterSignature;
|
|
currpos, i: integer;
|
|
begin
|
|
if (Mode in AdapterReadModes) then begin
|
|
fReader := TReader.Create(Data, BufferSize);
|
|
freader.Root := Owner;
|
|
|
|
// Checks the signature
|
|
signature := BINAdapterSignature;
|
|
fReader.Read(signature, SizeOf(signature));
|
|
if (signature <> BINAdapterSignature) then raise Exception.Create('Incompatible binary adapter stream');
|
|
|
|
fInfoIntOffset := ReadOffset;
|
|
currpos := GetReaderPosition(FReader);
|
|
|
|
// Reads the information attached at the end of the stream
|
|
if (GetReaderPosition(FReader) = fInfoIntOffset) then Exit; // Nothing to read!
|
|
SetReaderPosition(FReader, fInfoIntOffset);
|
|
|
|
// Number of elements
|
|
i := fReader.ReadInteger;
|
|
|
|
for i := i downto 1 do
|
|
ReadElementInfo;
|
|
|
|
// Restores its position and continues
|
|
SetReaderPosition(FReader, currpos);
|
|
end
|
|
else if (Mode in AdapterWriteModes) then begin
|
|
fWriter := TWriter.Create(Data, BufferSize);
|
|
|
|
// Writes the signature
|
|
signature := BINAdapterSignature;
|
|
fWriter.Write(signature, SizeOf(signature));
|
|
|
|
// This integer will contain the offset of the stream information (datasetcount, names, etc)
|
|
// which will be attached at the end of the stream since this is a sequential write
|
|
fInfoIntOffset := GetWriterPosition(FWriter);
|
|
WriteOffset(0);
|
|
end;
|
|
end;
|
|
|
|
function TDABinDataStreamer.GetElementInfo(ElementType: TDAElementType; const Name: string): TDAElementInfo;
|
|
begin
|
|
result := nil;
|
|
case ElementType of
|
|
etDataset: result := TDAElementInfo(DatasetInfoObjects[GetDatasetIndex(Name)]);
|
|
etDelta: result := TDAElementInfo(DeltaInfoObjects[GetDeltaIndex(Name)]);
|
|
end;
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.AddElementInfo(ElementType: TDAElementType; ElementName: string; Offset: integer);
|
|
var
|
|
element: TDAElementInfo;
|
|
begin
|
|
element := TDAElementInfo.Create;
|
|
element.ElementType := ElementType;
|
|
element.Name := ElementName;
|
|
element.Offset := Offset;
|
|
|
|
if ElementType = etDataset then
|
|
AddingDataset(ElementName, element)
|
|
else
|
|
AddingDelta(ElementName, element);
|
|
end;
|
|
|
|
function TDABinDataStreamer.DoCreateStream: TStream;
|
|
begin
|
|
result := TMemoryStream.Create;
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.ReadAndApplySchema(const Destination: IDADataset; ApplySchema: boolean);
|
|
var
|
|
cnt: integer;
|
|
fields: TDAFieldCollection;
|
|
params: TDAParamCollection;
|
|
begin
|
|
fields := Destination.Fields;
|
|
params := Destination.Params;
|
|
|
|
cnt := fReader.ReadInteger;
|
|
|
|
if (cnt > 0) then begin
|
|
fReader.ReadValue; // Must do for ReadCollection. Do not remove.
|
|
fReader.ReadCollection(fields);
|
|
end
|
|
else fields.Clear;
|
|
|
|
cnt := fReader.ReadInteger;
|
|
if (cnt > 0) then begin
|
|
fReader.ReadValue; // Must do for ReadCollection. Do not remove.
|
|
fReader.ReadCollection(params);
|
|
end
|
|
else params.Clear;
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.WriteSchema(const Fields: TDAFieldCollection; const Params: TDAParamCollection; aFieldsIndex: array of integer);
|
|
var
|
|
lcoll: TDAFieldCollection;
|
|
i: integer;
|
|
begin
|
|
fWriter.WriteInteger(Length(aFieldsIndex));
|
|
if Length(aFieldsIndex) > 0 then begin
|
|
lcoll:=TDAFieldCollection.Create(nil);
|
|
lcoll.IsCompatibleV4:= self.IsCompatibleV4;
|
|
try
|
|
For i:=0 to High(aFieldsIndex) do
|
|
lcoll.Add.AssignField(Fields[aFieldsIndex[i]]);
|
|
fWriter.WriteCollection(lColl);
|
|
finally
|
|
lcoll.Free;
|
|
end;
|
|
end;
|
|
|
|
fWriter.WriteInteger(Params.Count);
|
|
if Params.Count > 0 then fWriter.WriteCollection(Params);
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.WriteOffset(Offset: integer);
|
|
begin
|
|
fWriter.Write(Offset, SizeOf(integer));
|
|
end;
|
|
|
|
function TDABinDataStreamer.ReadOffset: integer;
|
|
begin
|
|
fReader.Read(result, SizeOf(integer));
|
|
end;
|
|
|
|
procedure VariantToWriterAsStr(aDataType : TDADataType; const aSourceVariant : Variant; aWriter : TWriter);
|
|
var
|
|
p: pointer;
|
|
s: string;
|
|
lVt: TValueType;
|
|
lSize: cardinal;
|
|
begin
|
|
case aDataType of
|
|
datBlob: begin
|
|
case VarType(aSourceVariant) of
|
|
varEmpty: begin
|
|
lSize := 0;
|
|
aWriter.Write(lSize, SizeOf(lSize));
|
|
end;
|
|
varOleStr:
|
|
awriter.WriteWideString(aSourceVariant);
|
|
varString, VarNull:
|
|
begin
|
|
s := VarToStr(aSourceVariant);
|
|
lSize := Length(s);
|
|
if lSize < 256 then begin
|
|
lVt := vaString;
|
|
aWriter.Write(lVt, sizeof(lVt));
|
|
aWriter.Write(lSize, 1);
|
|
awriter.Write(pointer(s)^, lSize);
|
|
end
|
|
else begin
|
|
lVt := vaLString;
|
|
aWriter.Write(lVt, sizeof(lVt));
|
|
aWriter.Write(lSize, sizeof(lSize));
|
|
awriter.Write(pointer(s)^, lSize);
|
|
end;
|
|
end;
|
|
8209:begin { 8209 is binary array }
|
|
lSize := VarArrayHighBound(aSourceVariant, 1)-VarArrayLowBound(aSourceVariant, 1)+1;
|
|
p := VarArrayLock(aSourceVariant);
|
|
try
|
|
if lSize < 256 then begin
|
|
lVt := vaString;
|
|
aWriter.Write(lVt, sizeof(lVt));
|
|
aWriter.Write(lSize, 1);
|
|
awriter.Write(p^, lSize);
|
|
end
|
|
else begin
|
|
lVt := vaLString;
|
|
aWriter.Write(lVt, sizeof(lVt));
|
|
aWriter.Write(lSize, sizeof(lSize));
|
|
awriter.Write(p^, lSize);
|
|
end;
|
|
finally
|
|
VarArrayUnlock(aSourceVariant);
|
|
end;
|
|
end;
|
|
else begin
|
|
RaiseError('Invalid variant type (%d) for Blob.',[VarType(aSourceVariant)]);
|
|
end;
|
|
end;
|
|
end;
|
|
else begin
|
|
Writer_WriteVariant(aWriter, aSourceVariant);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure WriteGuid(aWriter: TWriter; const aVal: String);
|
|
var
|
|
g: TGuid;
|
|
begin
|
|
g := StringToGUID(aVal);
|
|
aWriter.Write(g, Sizeof(g));
|
|
end;
|
|
|
|
procedure WriteDecimal(aWriter: TWriter; const aVal: Variant);
|
|
var
|
|
dec: TDecimal;
|
|
begin
|
|
dec:= VariantToDecimal(aVal);
|
|
aWriter.Write(dec, Sizeof(Dec));
|
|
end;
|
|
|
|
|
|
function TDABinDataStreamer.DoWriteDataset(const Source: IDADataset;
|
|
Options: TDAWriteOptions;
|
|
MaxRows: integer;
|
|
ADynFieldNames: array of string): integer;
|
|
var
|
|
lDataForAppend: TDADataForAppend;
|
|
begin
|
|
lDataForAppend := DoBeginWriteDataset(Source, {schema}nil, Options, MaxRows, ADynFieldNames);
|
|
if woRows in Options then begin
|
|
DoWriteDatasetData(Source, lDataForAppend);
|
|
result := DoEndWriteDataset(lDataForAppend);
|
|
end
|
|
else begin
|
|
result := -1;
|
|
end;
|
|
end;
|
|
|
|
function CreateByteArray(const s: string): Variant;
|
|
begin
|
|
result := VarArrayCreate([0, Length(s)-1], varByte);
|
|
if Length(s) > 0 then
|
|
Move(s[1], VarArrayLock(Result)^, Length(S));
|
|
VarArrayUnlock(Result);
|
|
end;
|
|
|
|
function ReadGuid(aReader: TReader): TGuid;
|
|
begin
|
|
aReader.Read(Result, Sizeof(Result));
|
|
end;
|
|
|
|
function ReadDecimal(aReader: TReader): Variant;
|
|
var
|
|
dec: TDecimal;
|
|
begin
|
|
aReader.Read(dec, Sizeof(Dec));
|
|
Result := DecimalToVariant(dec);
|
|
end;
|
|
|
|
{$IFDEF FPC}
|
|
type
|
|
PDateTime = ^TDateTime;
|
|
{$ENDIF}
|
|
|
|
procedure TDABinDataStreamer.DoReadDataset(const DatasetName: string; const Destination: IDADataset; ApplySchema: boolean);
|
|
var
|
|
elementinfo: TDAElementInfo;
|
|
editable: IDAEditableDataset;
|
|
schemaend, cnt, i: integer;
|
|
fld: TDAField;
|
|
dt: TDADataType;
|
|
schemapresent: boolean;
|
|
val: Variant;
|
|
readonlyfields: array of boolean;
|
|
//bigVal: Int64;
|
|
memdataset: IDAMemDatasetBatchAdding;
|
|
buf, buf1: pchar;
|
|
ws: widestring;
|
|
s: string;
|
|
bcd: TDecimal;
|
|
begin
|
|
if Destination.Active and ApplySchema then raise Exception.Create('Cannot apply a schema if the destination is active');
|
|
|
|
elementinfo := GetElementInfo(etDataset, DatasetName);
|
|
SetReaderPosition(FReader, elementinfo.Offset);
|
|
|
|
editable := Destination as IDAEditableDataset;
|
|
|
|
Destination.DisableControls;
|
|
try
|
|
editable.DisableEventHandlers;
|
|
try
|
|
fReader.BeginReferences;
|
|
try
|
|
// Checks to see if the schema is present
|
|
schemapresent := fReader.ReadBoolean;
|
|
schemaend := ReadOffset;
|
|
|
|
if schemapresent and ApplySchema then begin
|
|
ReadAndApplySchema(Destination, ApplySchema);
|
|
end
|
|
else if (schemaend > 0) then
|
|
SetReaderPosition(FReader, schemaend);
|
|
fReader.FixupReferences;
|
|
|
|
// Reads the row count
|
|
//cnt := fReader.ReadInteger;
|
|
fReader.Read(cnt, SizeOf(cnt));
|
|
if (cnt = -1) then Exit; // Only schema is present!
|
|
|
|
// TODO: this is a nasty bug. If we read the schema AND the stream, also contains data
|
|
// it goes in recursion here... Temporary fix is you just do one of the two for now
|
|
if ApplySchema then Exit;
|
|
|
|
if not Destination.Active then Destination.Open;
|
|
|
|
with editable do try
|
|
// Temporarily sets all fields as writable
|
|
Destination.DisableConstraints;
|
|
SetLength(readonlyfields, Fields.Count);
|
|
for i := 0 to (Fields.Count - 1) do begin
|
|
readonlyfields[i] := Fields[i].ReadOnly;
|
|
Fields[i].ReadOnly := FALSE;
|
|
end;
|
|
|
|
{$IFDEF STORERECID}
|
|
Destination.CurrentRecIdValue := max(1,Destination.CurrentRecIdValue);
|
|
{$ENDIF}
|
|
|
|
if Destination.QueryInterface(IDAMemDatasetBatchAdding, memdataset) <> s_ok then memdataset := nil;
|
|
|
|
if (memdataset = nil) or Assigned(OnReadFieldValue) then begin
|
|
// standard mode
|
|
// Inserts the records
|
|
while (cnt > 0) do try
|
|
Append;
|
|
|
|
{$IFDEF STORERECID}
|
|
Destination.CurrentRecIdValue := max(Destination.CurrentRecIdValue,fReader.ReadInteger);//#2
|
|
{$ENDIF}
|
|
|
|
for i := 0 to (Fields.Count - 1) do begin
|
|
fld := Fields[i];
|
|
|
|
if fld.Calculated or fld.Lookup then Continue;
|
|
|
|
val := Null; // Default (see datUnknown below)
|
|
dt := TDADataType(fReader.ReadInteger);
|
|
|
|
case dt of
|
|
datUnknown: ; // Field was null
|
|
datWideString,
|
|
datWideMemo: val := fReader.ReadWideString;
|
|
datString: val := fReader.ReadString;
|
|
datDateTime: val := fReader.ReadDate;
|
|
datFloat: val := fReader.ReadFloat;
|
|
datCurrency: val := fReader.ReadCurrency;
|
|
datBoolean: val := fReader.ReadBoolean;
|
|
datAutoInc,
|
|
datInteger: val := fReader.ReadInteger;
|
|
datSingleFloat: val := fReader.ReadSingle;
|
|
datLargeUInt,
|
|
datLargeAutoInc,
|
|
datLargeInt: val := fReader.ReadInt64;
|
|
|
|
datByte: val := Byte(fReader.ReadInteger);
|
|
datShortInt: val := ShortInt(fReader.ReadInteger);
|
|
datWord: val := Word(fReader.ReadInteger);
|
|
datSmallInt: val := SmallInt(fReader.ReadInteger);
|
|
datCardinal: val := Cardinal(fReader.ReadInteger);
|
|
datGuid: val := GuidToString(ReadGuid(fReader));
|
|
datXml: val := fReader.ReadWideString;
|
|
datDecimal: val := ReadDecimal(fReader);
|
|
datMemo: val := fReader.ReadString;
|
|
datBlob: val := fReader.ReadString;
|
|
end;
|
|
|
|
if Assigned(OnReadFieldValue) then OnReadFieldValue(fld, val);
|
|
if VarIsNull(val) then continue;
|
|
fld.Value := val;
|
|
end;
|
|
|
|
try
|
|
Post;
|
|
except
|
|
// Introduced to restore the dsBrowse state of the datatable
|
|
// in case of errors
|
|
Cancel;
|
|
raise;
|
|
end;
|
|
finally
|
|
Dec(cnt);
|
|
end;
|
|
end else begin
|
|
// batch loading
|
|
// Inserts the records
|
|
while (cnt > 0) do try
|
|
//Append;
|
|
buf:= memdataset.AllocRecordBuffer;
|
|
try
|
|
for i := 0 to (Fields.Count - 1) do begin
|
|
fld := Fields[i];
|
|
|
|
if fld.Calculated or fld.Lookup then Continue;
|
|
buf1:= memdataset.GetFieldNativeBuffer(buf,fld.BindedField);
|
|
dt := TDADataType(fReader.ReadInteger);
|
|
if dt = datUnknown then
|
|
memdataset.SetNullMask(buf,fld.BindedField,True) // Field was null
|
|
else
|
|
memdataset.SetNullMask(buf,fld.BindedField,False) ; // Field was not null
|
|
case dt of
|
|
datUnknown: ;
|
|
datWideString, datXml: memdataset.SetWideString(buf1,fld.BindedField,fReader.ReadWideString);//PWideString(buf1)^ := fReader.ReadWideString;
|
|
datString: memdataset.SetAnsiString(buf1,fld.BindedField,fReader.ReadString);//PAnsiString(buf1)^ := fReader.ReadString;
|
|
datCurrency: PDouble(buf1)^ := fReader.ReadCurrency;
|
|
datDateTime: PDateTime(buf1)^ := TimeStampToMSecs(DateTimeToTimeStamp(fReader.ReadDate));
|
|
datFloat: PDouble(buf1)^ := fReader.ReadFloat;
|
|
datLargeInt, datLargeAutoInc, datLargeUInt: PInt64(buf1)^ := fReader.ReadInt64;
|
|
datBoolean: PBoolean(buf1)^ := fReader.ReadBoolean;
|
|
datAutoInc, datInteger: PInteger(buf1)^ := fReader.ReadInteger;
|
|
datSingleFloat: PDouble(buf1)^ := fReader.ReadSingle;
|
|
datDecimal: begin
|
|
fReader.Read(bcd, Sizeof(bcd));
|
|
PBCD(buf1)^ := DecimalToBCD(bcd);
|
|
end;
|
|
datCardinal: PCardinal(buf1)^ := Cardinal(fReader.ReadInteger);
|
|
datByte: PSmallInt(buf1)^ := Byte(fReader.ReadInteger);
|
|
datWord: PWord(buf1)^ := Word(fReader.ReadInteger);
|
|
datShortInt: PSmallInt(buf1)^ := ShortInt(fReader.ReadInteger);
|
|
datSmallInt: PSmallInt(buf1)^ := SmallInt(fReader.ReadInteger);
|
|
datGuid: begin
|
|
s := GuidToString(ReadGuid(fReader));
|
|
Move(pointer(s)^, pointer(buf1)^, 38 {Length(GuidString)});
|
|
end;
|
|
datBlob,datMemo: PPointer(buf1)^ := memdataset.MakeBlobFromString(fReader.ReadString);
|
|
datWideMemo: begin
|
|
ws:= fReader.ReadWideString;
|
|
SetString(S,PChar(PWideChar(ws)),Length(ws)*SizeOf(WideChar));
|
|
PPointer(buf1)^ := memdataset.MakeBlobFromString(s);
|
|
ws:='';
|
|
end;
|
|
end;
|
|
// val =
|
|
// if Assigned(OnReadFieldValue) then OnReadFieldValue(fld, val);
|
|
// fld.Value := val;
|
|
end;
|
|
memdataset.AppendBuffer(Buf);
|
|
except
|
|
memdataset.FreeRecordBuffer(buf);
|
|
raise;
|
|
end;
|
|
finally
|
|
Dec(cnt);
|
|
end;
|
|
memdataset.FinalizeBatchAdding;
|
|
end;
|
|
finally
|
|
// Restores the read-only property
|
|
for i := 0 to (Fields.Count - 1) do
|
|
Fields[i].ReadOnly := readonlyfields[i];
|
|
Destination.EnableConstraints;
|
|
end;
|
|
|
|
// TODO: temporary hack for the TClientDataset. Somehow if we don't do this the
|
|
// cursor is locked to the last record and there's no way to move!
|
|
{editable.Next;
|
|
editable.First;}
|
|
finally
|
|
fReader.EndReferences;
|
|
end;
|
|
finally
|
|
editable.EnableEventHandlers;
|
|
end;
|
|
finally
|
|
Destination.EnableControls;
|
|
end;
|
|
end;
|
|
|
|
procedure VariantToWriter(aDataType : TDADataType; const aSourceVariant : Variant; aWriter : TWriter);
|
|
var
|
|
p: pointer;
|
|
lSize: cardinal;
|
|
begin
|
|
case aDataType of
|
|
datBlob: begin
|
|
case VarType(aSourceVariant) of
|
|
varEmpty:begin
|
|
lSize := 0;
|
|
aWriter.Write(lSize, SizeOf(lSize));
|
|
end;
|
|
8209:begin { 8209 is binary array }
|
|
lSize := VarArrayHighBound(aSourceVariant, 1)-VarArrayLowBound(aSourceVariant, 1)+1;
|
|
p := VarArrayLock(aSourceVariant);
|
|
try
|
|
aWriter.Write(lSize, SizeOf(lSize));
|
|
aWriter.Write(p^, lSize);
|
|
finally
|
|
VarArrayUnlock(aSourceVariant);
|
|
end;
|
|
end;
|
|
else begin
|
|
RaiseError('Invalid variant type (%d) for Blob.',[VarType(aSourceVariant)]);
|
|
end;
|
|
end;
|
|
end;
|
|
else begin
|
|
Writer_WriteVariant(aWriter, aSourceVariant);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ReaderToVariant(aDataType : TDADataType; aReader : TReader): Variant;
|
|
var
|
|
p: pointer;
|
|
sze : cardinal;
|
|
begin
|
|
case aDataType of
|
|
datBlob : begin
|
|
aReader.Read(sze, SizeOf(sze));
|
|
|
|
if (sze = 0) then
|
|
result := Unassigned
|
|
else try
|
|
result := VarArrayCreate([0, sze-1], varByte);
|
|
p := VarArrayLock(result);
|
|
aReader.Read(p^, sze);
|
|
finally
|
|
VarArrayUnlock(result);
|
|
end;
|
|
end;
|
|
else
|
|
result := Reader_ReadVariant(aReader);
|
|
end;
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.DoWriteDelta(const Source: IDADelta);
|
|
var
|
|
i, x: integer;
|
|
begin
|
|
// This information will be used later to complete the stream (see DoInitialize)
|
|
AddElementInfo(etDelta, Source.LogicalName, GetWriterPosition(FWriter));
|
|
|
|
// Number of changes
|
|
fWriter.WriteInteger(Source.Count);
|
|
|
|
// Numnber of fields, field names and their types
|
|
fWriter.WriteInteger(Source.LoggedFieldCount);
|
|
for i := 0 to (Source.LoggedFieldCount - 1) do begin
|
|
fWriter.WriteString(Source.LoggedFieldNames[i]);
|
|
fWriter.WriteInteger(integer(Source.LoggedFieldTypes[i]));
|
|
end;
|
|
|
|
// Key fields
|
|
fWriter.WriteInteger(Source.KeyFieldCount);
|
|
for i := 0 to (Source.KeyFieldCount - 1) do begin
|
|
fWriter.WriteString(Source.KeyFieldNames[i]);
|
|
end;
|
|
|
|
if (Source.Count = 0) then Exit;
|
|
|
|
// Actual changes
|
|
fWriter.WriteInteger(Source.Count);
|
|
for i := 0 to (Source.Count - 1) do begin
|
|
// Change type, RecID, status and message
|
|
x := integer(Source.Changes[i].ChangeType);
|
|
fWriter.WriteInteger(x);
|
|
|
|
fWriter.WriteInteger(Source.Changes[i].RecID);
|
|
|
|
x := integer(Source.Changes[i].Status);
|
|
fWriter.WriteInteger(x);
|
|
|
|
fWriter.WriteString(Source.Changes[i].Message);
|
|
|
|
// Old values
|
|
for x := 0 to (Source.LoggedFieldCount - 1) do begin
|
|
//fWriter.WriteVariant(Source.Changes[i].OldValues[x]);
|
|
VariantToWriter(Source.LoggedFieldTypes[x], Source.Changes[i].OldValues[x], fWriter);
|
|
end;
|
|
|
|
// New values
|
|
for x := 0 to (Source.LoggedFieldCount - 1) do begin
|
|
//fWriter.WriteVariant(Source.Changes[i].NewValues[x]); }
|
|
VariantToWriter(Source.LoggedFieldTypes[x], Source.Changes[i].NewValues[x], fWriter);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDABinDataStreamer.DoReadDelta(const DeltaName: string; const Destination: IDADelta);
|
|
var
|
|
elementinfo: TDAElementInfo;
|
|
msg, str: string;
|
|
recid, i, cnt, x: integer;
|
|
change: TDADeltaChange;
|
|
changetype: TDAChangeType;
|
|
status: TDAChangeStatus;
|
|
val: Variant;
|
|
begin
|
|
elementinfo := GetElementInfo(etDelta, DeltaName);
|
|
SetReaderPosition(FReader, elementinfo.Offset);
|
|
|
|
// Number of changes
|
|
cnt := fReader.ReadInteger;
|
|
|
|
// Field number, names and types
|
|
Destination.ClearFieldNames;
|
|
i := fReader.ReadInteger;
|
|
for i := i downto 1 do begin
|
|
str := fReader.ReadString;
|
|
Destination.AddFieldName(str);
|
|
Destination.LoggedFieldTypes[Destination.LoggedFieldCount-1] := TDADataType(fReader.ReadInteger);
|
|
end;
|
|
|
|
// Key fields
|
|
Destination.ClearKeyFieldNames;
|
|
i := fReader.ReadInteger;
|
|
for i := i downto 1 do begin
|
|
str := fReader.ReadString;
|
|
Destination.AddKeyFieldName(str);
|
|
end;
|
|
|
|
if (cnt = 0) then Exit;
|
|
|
|
// Actual changes
|
|
cnt := fReader.ReadInteger;
|
|
for i := 1 to cnt do begin
|
|
x := fReader.ReadInteger;
|
|
changetype := TDAChangeType(x);
|
|
recid := fReader.ReadInteger;
|
|
|
|
x := fReader.ReadInteger;
|
|
status := TDAChangeStatus(x);
|
|
|
|
msg := fReader.ReadString;
|
|
|
|
change := Destination.Add(recid, changetype, status, msg);
|
|
//Destination.Add(change);
|
|
|
|
// Old values
|
|
for x := 0 to (Destination.LoggedFieldCount - 1) do begin
|
|
{val := fReader.ReadVariant;
|
|
change.OldValues[x] := val;}
|
|
val := ReaderToVariant(Destination.LoggedFieldTypes[x], fReader);
|
|
change.OldValues[x] := val;
|
|
end;
|
|
|
|
// New values
|
|
for x := 0 to (Destination.LoggedFieldCount - 1) do begin
|
|
{val := fReader.ReadVariant;
|
|
change.NewValues[x] := val;}
|
|
val := ReaderToVariant(Destination.LoggedFieldTypes[x], fReader);
|
|
change.NewValues[x] := val;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TDABinDataStreamer.GetTargetDataType: TRODataType;
|
|
begin
|
|
result := rtBinary
|
|
end;
|
|
|
|
function TDABinDataStreamer.DoBeginWriteDataset( const Source: IDADataset; const Schema: TDADataset;
|
|
Options: TDAWriteOptions; MaxRows: integer;
|
|
ADynFieldNames: array of string): TDADataForAppend;
|
|
var
|
|
cntpos, currpos, k, i: integer;
|
|
fld: TDAField;
|
|
wrtschema: boolean;
|
|
lfields: array of integer;
|
|
lDataForAppend : TDADataForAppend;
|
|
lSchemaFields: TDAFieldCollection;
|
|
lSchemaParams: TDAParamCollection;
|
|
lLogicalName: String;
|
|
begin
|
|
lDataForAppend := TDADataForAppend.Create();
|
|
result := lDataForAppend;
|
|
|
|
if Assigned(Schema) then begin
|
|
lDataForAppend.TableSchema := Schema;
|
|
if Schema is TDAUnionDataTable then begin
|
|
fld := Schema.FindField(def_SourceTableFieldName);
|
|
if not Assigned(fld) then begin
|
|
fld := Schema.Fields.Add();
|
|
fld.Name := def_SourceTableFieldName;
|
|
fld.DataType := datInteger;
|
|
fld.InPrimaryKey := true;
|
|
fld.ServerAutoRefresh := true;
|
|
end;
|
|
end;
|
|
lSchemaFields := Schema.Fields;
|
|
lSchemaParams := Schema.Params;
|
|
lLogicalName := Schema.Name;
|
|
end else begin
|
|
if Assigned(Source) then begin
|
|
lSchemaFields := Source.Fields;
|
|
lSchemaParams := Source.Params;
|
|
lLogicalName := Source.LogicalName;
|
|
end else begin
|
|
raise EDAException.Create('Schema or source should be assigned.');
|
|
end;
|
|
end;
|
|
|
|
|
|
if Length(ADynFieldNames) > 0 then begin
|
|
SetLength(lfields, Length(ADynFieldNames));
|
|
For i:=0 to High(ADynFieldNames) do begin
|
|
fld:=lSchemaFields.FindField(ADynFieldNames[i]);
|
|
if fld <> nil then
|
|
lfields[i]:= fld.Index
|
|
else
|
|
lfields[i]:= -1;
|
|
end;
|
|
end else begin
|
|
SetLength(lfields, lSchemaFields.Count);
|
|
For i:=0 to lSchemaFields.Count-1 do
|
|
lfields[i]:=i;
|
|
end;
|
|
|
|
// This information will be used later to complete the stream (see DoInitialize)
|
|
AddElementInfo(etDataset, lLogicalName, GetWriterPosition(FWriter));
|
|
|
|
// Writes a boolean flag that indicates if the schema is being written
|
|
wrtschema := (woSchema in Options) or (Length(ADynFieldNames)>0);
|
|
fWriter.WriteBoolean(wrtschema);
|
|
|
|
// Write the offset to jump to if the reader wants to skip the schema
|
|
currpos := GetWriterPosition(FWriter);
|
|
WriteOffset(0);
|
|
|
|
if wrtschema then begin
|
|
WriteSchema(lSchemaFields, lSchemaParams, lfields);
|
|
Writer_FlushBuffer(FWriter);
|
|
|
|
// Writes the offset of the schema's end
|
|
k := GetWriterPosition(FWriter);
|
|
SetWriterPosition(FWriter, currpos);
|
|
WriteOffset(k);
|
|
SetWriterPosition(FWriter, k);
|
|
end;
|
|
|
|
// Writes the row count
|
|
cntpos := GetWriterPosition(FWriter);
|
|
|
|
if not (woRows in Options) then begin
|
|
fWriter.WriteInteger(-1);
|
|
end else begin
|
|
k := 0;
|
|
fWriter.Write(k, SizeOf(k));
|
|
end;
|
|
|
|
SetLength(lDataForAppend.RealFields, Length(lFields));
|
|
for i:= 0 to Length(lFields) -1 do
|
|
lDataForAppend.RealFields[i] := lFields[i];
|
|
|
|
lDataForAppend.MaxRowCount := MaxRows;
|
|
lDataForAppend.CountOfRecordsPosition := cntpos;
|
|
lDataForAppend.EndDataPosition := GetWriterPosition(FWriter);
|
|
lDataForAppend.RecordCount := k;
|
|
end;
|
|
|
|
function TDABinDataStreamer.DoWriteDatasetData(const Source: IDADataset; var aDataForAppend: TDADataForAppend; aDataIndex: Integer = -1): Integer;
|
|
var
|
|
max, k, i: integer;
|
|
fld: TDAField;
|
|
val: Variant;
|
|
lDataForAppend: TDADataForAppend;
|
|
lFields: array of integer;
|
|
bigVal: Int64;
|
|
lFieldName: String;
|
|
lMapToFieldName: String;
|
|
lColumnMappings: TDAColumnMappingCollection;
|
|
lColumnMapping: TDAColumnMapping;
|
|
begin
|
|
|
|
lDataForAppend := aDataForAppend;
|
|
SetWriterPosition(FWriter, lDataForAppend.EndDataPosition);
|
|
SetLength(lfields, Length(lDataForAppend.RealFields));
|
|
for i:= 0 to Length(lDataForAppend.RealFields) -1 do
|
|
lFields[i] := lDataForAppend.RealFields[i];
|
|
|
|
k := lDataForAppend.RecordCount;
|
|
max := lDataForAppend.MaxRowCount;
|
|
|
|
|
|
// Mapping fields of Source table to the streamed dataset
|
|
if Assigned(lDataForAppend.TableSchema) and (lDataForAppend.TableSchema is TDAUnionDataTable) then begin
|
|
lColumnMappings := TDAUnionSourceTable(TDAUnionDataTable(lDataForAppend.TableSchema).SourceTables.ItemByName(Source.Name)).ColumnMappings;
|
|
for i := 0 to lDataForAppend.TableSchema.Fields.Count - 1 do begin
|
|
lFieldName := lDataForAppend.TableSchema.Fields[lFields[i]].Name;
|
|
if lFieldName = def_SourceTableFieldName then begin
|
|
lFields[i] := -10;
|
|
continue;
|
|
end;
|
|
lMapToFieldName := lFieldName;
|
|
if Assigned(lColumnMappings) then begin
|
|
lColumnMapping := lColumnMappings.MappingByDatasetField(lFieldName);
|
|
if Assigned(lColumnMapping) and (lColumnMapping.TableField <> '') then
|
|
lMapToFieldName := lColumnMapping.TableField;
|
|
end;
|
|
lFields[i] := Source.FieldByName(lMapToFieldName).Index;
|
|
end;
|
|
end;
|
|
|
|
|
|
Source.DisableControls();
|
|
if not Source.active then Source.Open();
|
|
try
|
|
// Writes the actual records
|
|
while (k<>max) and not Source.EOF do begin
|
|
{$IFDEF STORERECID}
|
|
fWriter.WriteInteger(Source.GetRowRecIdValue);
|
|
{$ENDIF}
|
|
for i := 0 to Length(lfields) - 1 do begin
|
|
|
|
//RealFields[i] = -10 then this is @SourceTable field
|
|
if lfields[i] = -10 then begin
|
|
fld := lDataForAppend.TableSchema.FieldByName(def_SourceTableFieldName);
|
|
val := aDataIndex;
|
|
end else begin
|
|
fld := Source.Fields[lfields[i]];
|
|
val := Source.FieldValues[lfields[i]];
|
|
end;
|
|
|
|
if Assigned(OnBeforeFieldValueSerialization) then OnBeforeFieldValueSerialization(fld, val);
|
|
|
|
if fld.Calculated or fld.Lookup then Continue;
|
|
if Assigned(OnWriteFieldValue) then OnWriteFieldValue(fld, val);
|
|
|
|
if (lfields[i] = -10) or ((not fld.IsNull) and (not VarIsNull(Val))) then begin
|
|
fWriter.WriteInteger(integer(fld.DataType));
|
|
case fld.DataType of
|
|
datWideString,
|
|
datWideMemo: fWriter.WriteWideString(VarToWideStr(val));
|
|
datString: fWriter.WriteString(VarToStr(val));
|
|
datDateTime: fWriter.WriteDate(val);
|
|
datFloat: fWriter.WriteFloat(val);
|
|
datBoolean: fWriter.WriteBoolean(val);
|
|
datCurrency: fWriter.WriteCurrency(val);
|
|
datByte,
|
|
datShortInt,
|
|
datWord,
|
|
datSmallInt,
|
|
datCardinal,
|
|
datAutoInc,
|
|
datInteger: fWriter.WriteInteger(val);
|
|
datSingleFloat: fwriter.WRiteSingle(val);
|
|
|
|
//datLargeInt: fWriter. WriteInteger(val);
|
|
datLargeAutoInc,
|
|
datLargeUInt,
|
|
datLargeInt: begin
|
|
bigVal := val;
|
|
fWriter.WriteInteger(bigVal);
|
|
end;
|
|
datGuid: WriteGuid(fWriter, Val);
|
|
datXml: fWriter.WriteWideString(Val);
|
|
datDecimal: WriteDecimal(fWriter, Val);
|
|
datMemo: fWriter.WriteString(VarToStr(val));
|
|
datBlob: begin
|
|
VariantToWriterAsStr(datBlob, val, fWriter);
|
|
end;
|
|
end;
|
|
end else
|
|
fWriter.WriteInteger(Ord(datUnknown));
|
|
end;
|
|
|
|
Inc(result);
|
|
Inc(k);
|
|
Source.Next;
|
|
|
|
if Source.EOF then Break;
|
|
end;
|
|
|
|
lDataForAppend.EndDataPosition := GetWriterPosition(FWriter);
|
|
lDataForAppend.RecordCount := k;
|
|
result := k;
|
|
finally
|
|
Source.EnableControls;
|
|
end;
|
|
end;
|
|
|
|
function TDABinDataStreamer.DoEndWriteDataset(aDataForAppend: TDADataForAppend): Integer;
|
|
begin
|
|
Writer_FlushBuffer(FWriter);
|
|
result := aDataForAppend.RecordCount;
|
|
SetWriterPosition(FWriter, aDataForAppend.CountOfRecordsPosition);
|
|
fWriter.Write(aDataForAppend.RecordCount, SizeOf(aDataForAppend.RecordCount));
|
|
SetWriterPosition(FWriter, aDataForAppend.EndDataPosition);
|
|
aDataForAppend.Free();
|
|
end;
|
|
|
|
|
|
end.
|
|
|