david
2a98435b14
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@68 b6239004-a887-0f4b-9937-50029ccdca16
795 lines
31 KiB
ObjectPascal
795 lines
31 KiB
ObjectPascal
unit uDALocalDataAdapter;
|
|
|
|
{----------------------------------------------------------------------------}
|
|
{ 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
|
|
{$IFDEF MSWINDOWS}Windows,{$ENDIF}
|
|
SysUtils, Classes,
|
|
uROTypes, uROClasses,
|
|
uDAInterfaces, DataAbstract4_Intf, uDADelta, uDADataTable,
|
|
uDADataStreamer, uDADataAdapter, uDAClasses, uDALocalHelpers;
|
|
|
|
type
|
|
TDALocalDataAdapter = class;
|
|
|
|
TDALDADatasetOperation = procedure(DataStreamer: TDALocalDataAdapter; const Datasetname: string; const Dataset: IDADataset) of object;
|
|
TDALDADataStreamerReadDatasetProgress = procedure(Sender: TDALocalDataAdapter; const aDataset: IDADataset; const aCurrent, aTotal: Integer) of object;
|
|
TDALDADataStreamerWriteDatasetProgress = procedure(Sender: TDALocalDataAdapter; const aDataset: IDADataset; const aCurrent, aMaxRecords: Integer) of object;
|
|
|
|
|
|
{ TDALocalDataAdapter }
|
|
TDALocalDataAdapter = class(TDABaseDataAdapter)
|
|
private
|
|
fServiceInstance: IDataAbstractLocalServiceAccess;
|
|
fServiceName: string;
|
|
fServiceInstanceNeedsRelease: Boolean;
|
|
FSessionID: TGuid;
|
|
fOnBeforeFieldValueSerialization: TDAReadWriteFieldValue;
|
|
fOnReadFieldValue: TDAReadWriteFieldValue;
|
|
fOnWriteDataset: TDALDADatasetOperation;
|
|
fOnWriteFieldValueEx: TDAReadWriteFieldValueEx;
|
|
fOnWriteFieldValue: TDAReadWriteFieldValue;
|
|
fOnReadDatasetProgress: TDALDADataStreamerReadDatasetProgress;
|
|
fOnWriteDatasetProgress: TDALDADataStreamerWriteDatasetProgress;
|
|
function GetServiceInstance: IDataAbstractLocalServiceAccess;
|
|
procedure SetServiceInstance(value: IDataAbstractLocalServiceAccess);
|
|
procedure SetServiceName(value: string);
|
|
// stub for events
|
|
procedure DoWriteDataset(DataStreamer: TDADataStreamer; const Datasetname: string; const Dataset: IDADataset);
|
|
procedure DoReadDatasetProgress(Sender: TDADataStreamer; const aDataset: IDADataset; const aCurrent, aTotal: Integer);
|
|
procedure DoWriteDatasetProgress(Sender: TDADataStreamer; const aDataset: IDADataset; const aCurrent, aMaxRecords: Integer);
|
|
procedure AssignEvents(aDataStreamer: TDADataStreamer);
|
|
protected
|
|
function InternalFillSchema(var aStream: TROBinaryMemoryStream): TRODataType; override;
|
|
function InternalFillScripts(aTables: array of TDADataTable): UTF8String; override;
|
|
procedure InternalApplyUpdates(aTables, aTablesWithDetails: array of TDADataTable); override;
|
|
function InternalReadSchema: UTF8String; override;
|
|
procedure InternalFill(aTableArray: array of TDADataTable; aArray: TableRequestInfoArray; const aIncludeSchema, aAppendMode: boolean; aSavedOptions: TDATableOptionsArray);override;
|
|
public
|
|
destructor Destroy; override;
|
|
property ServiceInstance: IDataAbstractLocalServiceAccess read GetServiceInstance write SetServiceInstance;
|
|
property SessionID: TGuid read FSessionID write fSessionID;
|
|
published
|
|
property ServiceName: String read fServiceName write SetServiceName;
|
|
|
|
property OnStreamerWriteDataset: TDALDADatasetOperation read fOnWriteDataset write fOnWriteDataset;
|
|
property OnStreamerReadFieldValue: TDAReadWriteFieldValue read fOnReadFieldValue write fOnReadFieldValue;
|
|
property OnStreamerWriteFieldValue: TDAReadWriteFieldValue read fOnWriteFieldValue write fOnWriteFieldValue;
|
|
property OnStreamerWriteFieldValueEx: TDAReadWriteFieldValueEx read fOnWriteFieldValueEx write fOnWriteFieldValueEx;
|
|
property OnStreamerBeforeFieldValueSerialization: TDAReadWriteFieldValue read fOnBeforeFieldValueSerialization write fOnBeforeFieldValueSerialization;
|
|
property OnStreamerReadDatasetProgress: TDALDADataStreamerReadDatasetProgress read fOnReadDatasetProgress write fOnReadDatasetProgress;
|
|
property OnStreamerWriteDatasetProgress: TDALDADataStreamerWriteDatasetProgress read fOnWriteDatasetProgress write fOnWriteDatasetProgress;
|
|
end;
|
|
|
|
|
|
implementation
|
|
uses
|
|
Variants, DB,FMTBcd,
|
|
uROBinaryHelpers,
|
|
uDAEngine;
|
|
|
|
const
|
|
TDADataTypeStrings: array[Low(TDADataType)..High(TDADataType)] of AnsiString =
|
|
('datUnknown', 'datString', 'datDateTime', 'datFloat',
|
|
'datCurrency', 'datAutoInc', 'datInteger', 'datLargeInt',
|
|
'datBoolean', 'datMemo', 'datBlob', 'datWideString',
|
|
'datWideMemo', 'datLargeAutoInc', 'datByte', 'datShortInt',
|
|
'datWord', 'datSmallInt', 'datCardinal', 'datLargeUInt',
|
|
'datGuid', 'datXml', 'datDecimal', 'datSingleFloat');
|
|
type
|
|
TDASmallFieldInfo = record
|
|
Name: String;
|
|
Datatype: TDADataType;
|
|
Size: integer;
|
|
end;
|
|
|
|
TDADataForAppendBin2 = class(TDADataForAppend)
|
|
public
|
|
FieldsInfo: array of TDASmallFieldInfo;
|
|
CurrentDataTable : TDADataTable;
|
|
readonlyfields: array of boolean;
|
|
|
|
DestRealFields: array of integer;
|
|
Destflds: TDAFieldArray;
|
|
|
|
IncludeSchema: Boolean;
|
|
// for append mode
|
|
CurrentAppendMode: Boolean;
|
|
lPK: string;
|
|
lPKValues: array of variant;
|
|
lOnePK:Boolean;
|
|
lPKFlds: TDAFieldArray; // PK flds (Append mode)
|
|
lFldValues: array of Variant; // flds values for append mode
|
|
|
|
// MemDatasetBatchAdding
|
|
lBatchAdding: IDAMemDatasetBatchAdding;
|
|
lBatchAddingList: TList;
|
|
end;
|
|
|
|
TDALocalDataStreamer = class(TDADataStreamer)
|
|
private
|
|
fTables: array of TDADataTable;
|
|
fAppendMode: array of boolean;
|
|
fIncludeSchema: array of boolean;
|
|
protected
|
|
procedure DoReadDelta(const DeltaName: string; const Destination: IDADelta); override;
|
|
procedure DoWriteDelta(const Source: IDADelta); override;
|
|
procedure DoReadDataset(const DatasetName: string; const Destination: IDADataset; ApplySchema: boolean; AppendMode: Boolean); 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 InternalDoWriteDataset(const Source: IDADataset; aDataIndex: Integer; aDataForAppend: TDADataForAppendBin2);
|
|
procedure DoInitialize(Mode: TDAAdapterInitialization); override;
|
|
procedure DoFinalize; override;
|
|
function DoCreateStream: TStream; override;
|
|
public
|
|
constructor Create(aOwner: TComponent; aTables: array of TDADataTable; aSavedOptions: TDATableOptionsArray; aArray: TableRequestInfoArray); reintroduce;
|
|
destructor Destroy; override;
|
|
function GetTargetDataType: TRODataType; override;
|
|
end;
|
|
|
|
{ TDALocalDataAdapter }
|
|
|
|
|
|
procedure TDALocalDataAdapter.AssignEvents(aDataStreamer: TDADataStreamer);
|
|
begin
|
|
aDataStreamer.OnBeforeFieldValueSerialization := fOnBeforeFieldValueSerialization;
|
|
aDataStreamer.OnReadFieldValue := fOnReadFieldValue;
|
|
aDataStreamer.OnWriteFieldValue := fOnWriteFieldValue;
|
|
aDataStreamer.OnWriteFieldValueEx := fOnWriteFieldValueEx;
|
|
if Assigned(fOnWriteDataset) then aDataStreamer.OnWriteDataset := DoWriteDataset;
|
|
if Assigned(fOnReadDatasetProgress) then aDataStreamer.OnReadDatasetProgress := DoReadDatasetProgress;
|
|
if Assigned(fOnWriteDatasetProgress) then aDataStreamer.OnWriteDatasetProgress := DoWriteDatasetProgress;
|
|
end;
|
|
|
|
destructor TDALocalDataAdapter.Destroy;
|
|
begin
|
|
ServiceInstance := nil;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TDALocalDataAdapter.DoReadDatasetProgress(Sender: TDADataStreamer;
|
|
const aDataset: IDADataset; const aCurrent, aTotal: Integer);
|
|
begin
|
|
if Assigned(fOnReadDatasetProgress) then fOnReadDatasetProgress(Self,aDataset, aCurrent, aTotal);
|
|
end;
|
|
|
|
procedure TDALocalDataAdapter.DoWriteDataset(DataStreamer: TDADataStreamer;
|
|
const Datasetname: string; const Dataset: IDADataset);
|
|
begin
|
|
if Assigned(fOnWriteDataset) then fOnWriteDataset(Self, Datasetname, Dataset);
|
|
end;
|
|
|
|
procedure TDALocalDataAdapter.DoWriteDatasetProgress(Sender: TDADataStreamer;
|
|
const aDataset: IDADataset; const aCurrent, aMaxRecords: Integer);
|
|
begin
|
|
if Assigned(fOnWriteDatasetProgress) then fOnWriteDatasetProgress(Self,aDataset, aCurrent, aMaxRecords);
|
|
end;
|
|
|
|
function TDALocalDataAdapter.GetServiceInstance: IDataAbstractLocalServiceAccess;
|
|
begin
|
|
if fServiceInstance <> nil then begin
|
|
Result := fServiceInstance;
|
|
Exit;
|
|
end;
|
|
if csDesigning in ComponentState then
|
|
if ServiceName = '' then raise Exception.Create('For data adapter ServiceName must be set.')
|
|
else raise Exception.Create('Service "' + ServiceName + '" for data adapter isn''t found.');
|
|
result:= LocalServiceAccessHelper_Acquire(SessionID, ServiceName);
|
|
fServiceInstanceNeedsRelease := true;
|
|
end;
|
|
|
|
procedure TDALocalDataAdapter.InternalApplyUpdates(aTables,aTablesWithDetails: array of TDADataTable);
|
|
var
|
|
aList: IDeltaArray;
|
|
i: integer;
|
|
begin
|
|
SetLength(aList, Length(aTablesWithDetails));
|
|
try
|
|
for I := 0 to Length(aTablesWithDetails) - 1 do
|
|
aList[i] := aTablesWithDetails[i].Delta;
|
|
ServiceInstance.UpdateData(aList);
|
|
finally
|
|
SetLength(aList, 0);
|
|
end;
|
|
end;
|
|
|
|
procedure TDALocalDataAdapter.InternalFill(aTableArray: array of TDADataTable;
|
|
aArray: TableRequestInfoArray; const aIncludeSchema, aAppendMode: boolean;
|
|
aSavedOptions: TDATableOptionsArray);
|
|
var
|
|
lArray : StringArray;
|
|
i: integer;
|
|
lDataStreamer :TDALocalDataStreamer;
|
|
begin
|
|
lDataStreamer := TDALocalDataStreamer.Create(Self, aTableArray, aSavedOptions,aArray);
|
|
lArray := StringArray.Create();
|
|
try
|
|
AssignEvents(lDataStreamer);
|
|
lArray.Resize(Length(aTableArray));
|
|
for i := Low(aTableArray) to High(aTableArray) do
|
|
lArray[i-Low(aTableArray)] := UTF8Encode(aTableArray[i].LogicalName);
|
|
ServiceInstance.GetData(lArray, aArray, lDataStreamer);
|
|
finally
|
|
lArray.Free;
|
|
lDataStreamer.Free;
|
|
end;
|
|
end;
|
|
|
|
function TDALocalDataAdapter.InternalFillSchema(var aStream: TROBinaryMemoryStream): TRODataType;
|
|
begin
|
|
Result := rtString;
|
|
Schema;
|
|
end;
|
|
|
|
function TDALocalDataAdapter.InternalFillScripts(
|
|
aTables: array of TDADataTable): UTF8String;
|
|
begin
|
|
Result := ServiceInstance.GetDatasetScripts(GetTableNamesAsCommaText(aTables));
|
|
end;
|
|
|
|
function TDALocalDataAdapter.InternalReadSchema: UTF8String;
|
|
begin
|
|
Result := ServiceInstance.GetSchema('');
|
|
end;
|
|
|
|
procedure TDALocalDataAdapter.SetServiceInstance(
|
|
Value: IDataAbstractLocalServiceAccess);
|
|
begin
|
|
if Value <> fServiceInstance then begin
|
|
if (fServiceInstanceNeedsRelease) and (fServiceInstance <> nil) then begin
|
|
LocalServiceAccessHelper_Release(SessionID, ServiceName, fServiceInstance);
|
|
end;
|
|
fServiceInstance := value;
|
|
fServiceInstanceNeedsRelease := false;
|
|
end;
|
|
end;
|
|
|
|
procedure TDALocalDataAdapter.SetServiceName(value: string);
|
|
begin
|
|
ServiceInstance := nil;
|
|
fServiceName := value;
|
|
end;
|
|
|
|
constructor TDALocalDataStreamer.Create(aOwner: TComponent; aTables: array of TDADataTable; aSavedOptions: TDATableOptionsArray; aArray: TableRequestInfoArray);
|
|
var
|
|
i: integer;
|
|
begin
|
|
inherited Create(aOwner);
|
|
SetLength(fTables, Length(aTables));
|
|
SetLength(fAppendMode, Length(aTables));
|
|
SetLength(fIncludeSchema, Length(aTables));
|
|
for I := 0 to Length(aTables) - 1 do begin
|
|
fTables[i] := aTables[i];
|
|
fAppendMode[i] := aSavedOptions[i].AppendMode;
|
|
fIncludeSchema[i]:= aArray[i].IncludeSchema;
|
|
end;
|
|
AdapterInitialization := aiWrite;
|
|
end;
|
|
|
|
destructor TDALocalDataStreamer.Destroy;
|
|
begin
|
|
SetLength(fTables, 0);
|
|
inherited;
|
|
end;
|
|
|
|
function TDALocalDataStreamer.DoBeginWriteDataset(const Source: IDADataset;
|
|
const Schema: TDADataset; Options: TDAWriteOptions; MaxRows: integer;
|
|
ADynFieldNames: array of string): TDADataForAppend;
|
|
var
|
|
k, i, Realfldcnt: integer;
|
|
fld: TDAField;
|
|
// RealFields: array of integer;
|
|
lfields: array of integer;
|
|
lDataForAppend : TDADataForAppendBin2;
|
|
lSchemaFields: TDAFieldCollection;
|
|
lLogicalName: String;
|
|
lFldList:TStringList;
|
|
lErrorMessage: String;
|
|
lErrorMesCnt: integer;
|
|
lCurrTable: TDADataTable;
|
|
FTableInitializedFromSource: Boolean;
|
|
begin
|
|
lDataForAppend := TDADataForAppendBin2.Create();
|
|
|
|
try
|
|
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;
|
|
lLogicalName := Schema.Name;
|
|
end else begin
|
|
if Assigned(Source) then begin
|
|
lSchemaFields := Source.Fields;
|
|
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;
|
|
|
|
SetLength(lDataForAppend.FieldsInfo, lSchemaFields.Count);
|
|
SetLength(lDataForAppend.RealFields, lSchemaFields.Count);
|
|
SetLength(lDataForAppend.DestRealFields, lSchemaFields.Count);
|
|
Realfldcnt := 0;
|
|
for i := 0 to High(lfields) do begin
|
|
if lSchemaFields[lfields[i]].Calculated or lSchemaFields[lfields[i]].Lookup then Continue;
|
|
lDataForAppend.RealFields[Realfldcnt] := lfields[i];
|
|
lDataForAppend.DestRealFields[Realfldcnt] := lfields[i]; // by default = RealFields
|
|
lDataForAppend.FieldsInfo[Realfldcnt].Name := lSchemaFields[lfields[i]].Name;
|
|
lDataForAppend.FieldsInfo[Realfldcnt].Datatype := lSchemaFields[lfields[i]].DataType;
|
|
lDataForAppend.FieldsInfo[Realfldcnt].Size := lSchemaFields[lfields[i]].Size;
|
|
inc(Realfldcnt);
|
|
end;
|
|
SetLength(lDataForAppend.FieldsInfo, Realfldcnt);
|
|
SetLength(lDataForAppend.RealFields, Realfldcnt);
|
|
SetLength(lDataForAppend.DestRealFields, Realfldcnt);
|
|
lDataForAppend.MaxRowCount := MaxRows;
|
|
|
|
k := 0;
|
|
lDataForAppend.RecordCount := k;
|
|
lCurrTable := nil;
|
|
// detect DataTable
|
|
for I := 0 to Length(fTables) - 1 do
|
|
if AnsiSameText(lLogicalName,fTables[i].LogicalName) then begin
|
|
lCurrTable :=fTables[i];
|
|
lDataForAppend.IncludeSchema := fIncludeSchema[i];
|
|
lDataForAppend.CurrentAppendMode:= fAppendMode[i] and lCurrTable.Active and not (lCurrTable.EOF and lCurrTable.BOF);;
|
|
Break;
|
|
end;
|
|
|
|
if lCurrTable = nil then raise EDAException.CreateFmt('LDA: Destination data table not found.: %s',[lLogicalName]);
|
|
FTableInitializedFromSource := lDataForAppend.IncludeSchema and not (soIgnoreStreamSchema in lCurrTable.StreamingOptions);
|
|
if FTableInitializedFromSource then begin
|
|
lDataForAppend.CurrentAppendMode := False;
|
|
lCurrTable.Close;
|
|
lCurrTable.Fields.AssignFieldCollection(lSchemaFields);
|
|
end;
|
|
if not lCurrTable.Active then lCurrTable.InitializeDataTable;
|
|
|
|
if TDALocalDataAdapter(Owner).AutoFillScripts then TDALocalDataAdapter(Owner).FillScripts([lCurrTable]);
|
|
|
|
if not FTableInitializedFromSource then begin
|
|
lErrorMessage := '';
|
|
lErrorMesCnt := 0;
|
|
// checking schema with table schema
|
|
|
|
// step 1
|
|
lFldList:=TStringList.Create;
|
|
try
|
|
lFldList.Sorted:=False;
|
|
lFldList.Duplicates:=dupIgnore;
|
|
For i:= 0 to lCurrTable.Fields.Count-1 do
|
|
lFldList.AddObject(lCurrTable.Fields[i].Name,Pointer(lCurrTable.Fields[i].Index));
|
|
lFldList.Sorted:=True;
|
|
|
|
for i := 0 to Realfldcnt - 1 do begin
|
|
k:=lFldList.IndexOf(lDataForAppend.FieldsInfo[i].Name);
|
|
if k = -1 then begin
|
|
inc(lErrorMesCnt);
|
|
if lErrorMesCnt > 5 then begin
|
|
lErrorMessage := lErrorMessage + '<skip>' + sLineBreak;
|
|
break;
|
|
end
|
|
else begin
|
|
lErrorMessage := lErrorMessage + Format('The %s field isn''t found.' + sLineBreak,[lDataForAppend.FieldsInfo[i].Name])
|
|
end;
|
|
end
|
|
else begin
|
|
lDataForAppend.DestRealFields[i]:= Integer(lFldList.Objects[k]);
|
|
end;
|
|
end;
|
|
finally
|
|
lFldList.Free;
|
|
end;
|
|
// step 2
|
|
if (Length(lErrorMessage) = 0) then begin
|
|
k := 0;
|
|
for i := 0 to (lCurrTable.Fields.Count - 1) do begin
|
|
if lCurrTable.Fields[i].Calculated or lCurrTable.Fields[i].Lookup then Continue;
|
|
if (k >= Realfldcnt) then begin
|
|
lErrorMessage := lErrorMessage + 'Fields count mismatch' + sLineBreak
|
|
end
|
|
else begin
|
|
fld:=lCurrTable.Fields[lDataForAppend.DestRealFields[k]];
|
|
// if (fld.Name <> Info[k].Name) then lErrorMessage := lErrorMessage + Format('Name mismatch: %s expected but %s found in stream.', [fld.Name, Info[k].Name])+ sLineBreak
|
|
if (fld.DataType <> lDataForAppend.FieldsInfo[k].Datatype) then
|
|
lErrorMessage := lErrorMessage + Format('Data type mismatch for column ''%s.%s'': %s expected but %s found in source.',
|
|
[lLogicalName, fld.Name, TDADataTypeStrings[fld.DataType], TDADataTypeStrings[lDataForAppend.FieldsInfo[k].Datatype]])+ sLineBreak
|
|
else if (fld.Size <> lDataForAppend.FieldsInfo[k].Size) then
|
|
lErrorMessage := lErrorMessage + Format('Size mismatch for column ''%s.%s'': %d expected but %d found in source.',
|
|
[lLogicalName, fld.Name, fld.Size, lDataForAppend.FieldsInfo[k].Size]) + sLineBreak;
|
|
end;
|
|
inc(k);
|
|
end;
|
|
if (k <> Realfldcnt) then lErrorMessage := lErrorMessage + Format('Fields count mismatch: %d expected but %d found in the stream', [k, Realfldcnt]) + sLineBreak;
|
|
end;
|
|
if (Length(lErrorMessage) > 0) then begin
|
|
lErrorMessage := 'Format of the data of source doesn''t match the destination table format.'+ sLineBreak + sLineBreak + lErrorMessage;
|
|
RaiseError(lErrorMessage);
|
|
end;
|
|
end;
|
|
except
|
|
lDataForAppend.Free;
|
|
raise;
|
|
end;
|
|
|
|
setLength(lDataForAppend.Destflds, Realfldcnt);
|
|
For i:= 0 to Realfldcnt-1 do
|
|
lDataForAppend.Destflds[i] := lCurrTable.Fields[lDataForAppend.DestRealFields[i]];
|
|
|
|
lDataForAppend.lPK := Dataset_GetPK(lDataForAppend.Destflds, lDataForAppend.lPKFlds);
|
|
lDataForAppend.lOnePK := Length(lDataForAppend.lPKFlds) = 1;
|
|
lDataForAppend.CurrentAppendMode := lDataForAppend.CurrentAppendMode and (Length(lDataForAppend.lPKFlds)>0);
|
|
if lDataForAppend.CurrentAppendMode then begin
|
|
SetLength(lDataForAppend.lFldValues, Length(lDataForAppend.Destflds));
|
|
SetLength(lDataForAppend.lPKValues, Length(lDataForAppend.lPKFlds));
|
|
end;
|
|
|
|
|
|
lDataForAppend.CurrentDataTable := lCurrTable;
|
|
lDataForAppend.CurrentDataTable.DisableControls;
|
|
|
|
if not Supports(lCurrTable,IDAMemDatasetBatchAdding, lDataForAppend.lBatchAdding) then begin
|
|
lDataForAppend.lBatchAdding := nil
|
|
end
|
|
else begin
|
|
lDataForAppend.lBatchAddingList := TList.Create;
|
|
end;
|
|
|
|
SetLength(lDataForAppend.readonlyfields, lCurrTable.Fields.Count);
|
|
// reset Fields[i].ReadOnly
|
|
for i := 0 to (lCurrTable.Fields.Count - 1) do begin
|
|
lDataForAppend.readonlyfields[i] := lCurrTable.Fields[i].ReadOnly;
|
|
lCurrTable.Fields[i].ReadOnly := FALSE;
|
|
end;
|
|
result := lDataForAppend;
|
|
end;
|
|
|
|
function TDALocalDataStreamer.DoCreateStream: TStream;
|
|
begin
|
|
// outdated, for backward capability
|
|
Result := nil;
|
|
end;
|
|
|
|
function TDALocalDataStreamer.DoEndWriteDataset(
|
|
aDataForAppend: TDADataForAppend): Integer;
|
|
var
|
|
i: integer;
|
|
lData : TDADataForAppendBin2;
|
|
begin
|
|
lData := TDADataForAppendBin2(aDataForAppend);
|
|
|
|
if (lData.lBatchAdding <> nil) and (lData.lBatchAddingList.Count <> 0) then begin
|
|
lData.lBatchAdding.AddRecordsfromList(lData.lBatchAddingList,lData.CurrentAppendMode);
|
|
end;
|
|
|
|
// restore ReadOnly
|
|
for i := 0 to (lData.CurrentDataTable.Fields.Count - 1) do
|
|
lData.CurrentDataTable.Fields[i].ReadOnly := lData.readonlyfields[i];
|
|
// enable controls
|
|
lData.CurrentDataTable.EnableControls;
|
|
Result:= aDataForAppend.RecordCount;
|
|
lData.lBatchAddingList.Free;
|
|
aDataForAppend.Free();
|
|
end;
|
|
|
|
procedure TDALocalDataStreamer.DoFinalize;
|
|
begin
|
|
// empty
|
|
end;
|
|
|
|
procedure TDALocalDataStreamer.DoInitialize(Mode: TDAAdapterInitialization);
|
|
begin
|
|
// empty
|
|
end;
|
|
|
|
procedure TDALocalDataStreamer.DoReadDataset(const DatasetName: string;
|
|
const Destination: IDADataset; ApplySchema, AppendMode: Boolean);
|
|
begin
|
|
NotSupported;
|
|
end;
|
|
|
|
procedure TDALocalDataStreamer.DoReadDelta(const DeltaName: string;
|
|
const Destination: IDADelta);
|
|
begin
|
|
NotSupported;
|
|
end;
|
|
|
|
function TDALocalDataStreamer.DoWriteDataset(const Source: IDADataset;
|
|
Options: TDAWriteOptions; MaxRows: integer;
|
|
ADynFieldNames: array of string): integer;
|
|
var
|
|
lData : TDADataForAppend;
|
|
begin
|
|
lData := DoBeginWriteDataset(Source, nil,Options, MaxRows, ADynFieldNames);
|
|
try
|
|
DoWriteDatasetData(Source, lData, -1);
|
|
finally
|
|
Result := DoEndWriteDataset(lData);
|
|
end;
|
|
end;
|
|
|
|
function TDALocalDataStreamer.DoWriteDatasetData(const Source: IDADataset;
|
|
var aDataForAppend: TDADataForAppend; aDataIndex: Integer): Integer;
|
|
var
|
|
i, Realfldcnt: integer;
|
|
lDataForAppend: TDADataForAppendBin2;
|
|
lMapToFieldName: String;
|
|
lColumnMappings: TDAColumnMappingCollection;
|
|
lColumnMapping: TDAColumnMapping;
|
|
begin
|
|
lDataForAppend := TDADataForAppendBin2(aDataForAppend);
|
|
Realfldcnt := Length(lDataForAppend.RealFields);
|
|
|
|
// 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 lDataForAppend.FieldsInfo[i].Name = def_SourceTableFieldName then begin
|
|
lDataForAppend.RealFields[i] := -10;
|
|
continue;
|
|
end;
|
|
lMapToFieldName := lDataForAppend.FieldsInfo[i].Name;
|
|
if Assigned(lColumnMappings) then begin
|
|
lColumnMapping := lColumnMappings.MappingByDatasetField(lDataForAppend.FieldsInfo[i].Name);
|
|
if Assigned(lColumnMapping) and (lColumnMapping.TableField <> '') then
|
|
lMapToFieldName := lColumnMapping.TableField;
|
|
end;
|
|
lDataForAppend.RealFields[i] := Source.FieldByName(lMapToFieldName).Index;
|
|
end;
|
|
end;
|
|
|
|
with Source do try
|
|
DisableControls;
|
|
|
|
if not Source.Active then Source.Open;
|
|
try
|
|
InternalDoWriteDataset(Source, aDataIndex, lDataForAppend);
|
|
except
|
|
raise;
|
|
end;
|
|
|
|
finally
|
|
EnableControls;
|
|
result := lDataForAppend.RecordCount ;
|
|
end;
|
|
end;
|
|
|
|
procedure TDALocalDataStreamer.DoWriteDelta(const Source: IDADelta);
|
|
begin
|
|
NotSupported;
|
|
end;
|
|
|
|
function TDALocalDataStreamer.GetTargetDataType: TRODataType;
|
|
begin
|
|
Result := rtBinary;
|
|
end;
|
|
|
|
procedure TDALocalDataStreamer.InternalDoWriteDataset(
|
|
const Source: IDADataset;
|
|
aDataIndex: Integer;
|
|
aDataForAppend: TDADataForAppendBin2);
|
|
|
|
function Dataset_Locate(): boolean;
|
|
begin
|
|
if aDataForAppend.lOnePK then
|
|
Result:= aDataForAppend.CurrentDataTable.Locate(aDataForAppend.lPK,aDataForAppend.lPKValues[0],[])
|
|
else
|
|
Result:= aDataForAppend.CurrentDataTable.Locate(aDataForAppend.lPK,aDataForAppend.lPKValues,[]);
|
|
end;
|
|
|
|
var
|
|
ev1, ev2, ev3, ev4: boolean;
|
|
Realfldcnt: integer;
|
|
Sourceflds: array of TDAField;
|
|
val: array of Variant;
|
|
|
|
procedure GetSourceValues;
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to (Realfldcnt - 1) do begin
|
|
//ARealFields[i] = -10 then this is @SourceTable field
|
|
if aDataForAppend.RealFields[i] = -10 then begin
|
|
//We shouldn't fire events since this is special internal field
|
|
val[i] := aDataIndex;
|
|
end else begin
|
|
val[i] := Source.FieldValues[aDataForAppend.RealFields[i]];
|
|
if ev1 then OnBeforeFieldValueSerialization(Sourceflds[i], val[i]);
|
|
if ev2 then OnWriteFieldValue(Sourceflds[i], val[i]);
|
|
if ev3 then OnWriteFieldValueEx(Source,Sourceflds[i], val[i]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetDestValues_StdMode;
|
|
var
|
|
i: integer;
|
|
begin
|
|
aDataForAppend.CurrentDataTable.Append;
|
|
for i := 0 to Realfldcnt - 1 do begin
|
|
if ev4 then OnReadFieldValue(aDataForAppend.Destflds[i], val[i]);
|
|
aDataForAppend.Destflds[i].Value := val[i];
|
|
end;
|
|
if aDataForAppend.CurrentAppendMode then begin
|
|
// store values and avoid firing OnReadFieldValue event
|
|
for i := 0 to Length(aDataForAppend.Destflds) - 1 do
|
|
aDataForAppend.lFldValues[i]:= aDataForAppend.Destflds[i].Value;
|
|
// store PK values for locate
|
|
for I := 0 to Length(aDataForAppend.lPKFlds) - 1 do
|
|
aDataForAppend.lPKValues[i]:= aDataForAppend.lPKFlds[i].Value;
|
|
|
|
aDataForAppend.CurrentDataTable.Cancel;
|
|
if Dataset_Locate then
|
|
aDataForAppend.CurrentDataTable.Edit
|
|
else
|
|
aDataForAppend.CurrentDataTable.Append;
|
|
// assign new values
|
|
for i := 0 to Length(aDataForAppend.Destflds) - 1 do
|
|
aDataForAppend.Destflds[i].Value := aDataForAppend.lFldValues[i];
|
|
end;
|
|
|
|
try
|
|
aDataForAppend.CurrentDataTable.Post;
|
|
except
|
|
// Introduced to restore the dsBrowse state of the datatable
|
|
// in case of errors
|
|
aDataForAppend.CurrentDataTable.Cancel;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
procedure SetDestValues_BatchMode;
|
|
type
|
|
PMemDatasetrecord_Native = ^TMemDatasetrecord_Native;
|
|
TMemDatasetrecord_Native = packed record
|
|
Ident: byte;
|
|
Data: PAnsichar;
|
|
end;
|
|
|
|
var
|
|
i: integer;
|
|
buf, buf1: PAnsiChar;
|
|
s: AnsiString;
|
|
begin
|
|
buf:= aDataForAppend.lBatchAdding.AllocRecordBuffer;
|
|
try
|
|
for i := 0 to Length(aDataForAppend.Destflds) - 1 do begin
|
|
if aDataForAppend.Destflds[i].Calculated or aDataForAppend.Destflds[i].Lookup then Continue;
|
|
if ev4 then OnReadFieldValue(aDataForAppend.Destflds[i], val[i]);
|
|
if VarIsNull(Val[i]) then
|
|
aDataForAppend.lBatchAdding.SetNullMask(PMemDatasetrecord_Native(buf)^.Data,aDataForAppend.Destflds[i].BindedField, True)
|
|
else begin
|
|
aDataForAppend.lBatchAdding.SetNullMask(PMemDatasetrecord_Native(buf)^.Data,aDataForAppend.Destflds[i].BindedField, False);
|
|
buf1:= aDataForAppend.lBatchAdding.GetFieldNativeBuffer(buf,aDataForAppend.Destflds[i].BindedField);
|
|
case aDataForAppend.Destflds[i].DataType of
|
|
datUnknown: ;
|
|
datWideString: aDataForAppend.lBatchAdding.SetWideString(buf1,aDataForAppend.Destflds[i].BindedField,{$IFDEF UNICODE}VarToStr{$ELSE}VarToWideStr{$ENDIF}(Val[i]));
|
|
datString: aDataForAppend.lBatchAdding.SetAnsiString(buf1,aDataForAppend.Destflds[i].BindedField,VarToAnsiStr(val[i]));
|
|
datCurrency: PCurrency(buf1)^ := Currency(Val[i]);
|
|
datDateTime: PDateTime(buf1)^ := TimeStampToMSecs(DateTimeToTimeStamp(VarToDateTime(Val[i])));
|
|
datFloat: PDouble(buf1)^ := Double(Val[i]);
|
|
datLargeInt, datLargeAutoInc, datLargeUInt: PInt64(buf1)^ := Val[i];
|
|
datBoolean: System.PBoolean(buf1)^ := Boolean(Val[i]);
|
|
datAutoInc,
|
|
datInteger: PInteger(buf1)^ := integer(Val[i]);
|
|
datSingleFloat: PDouble(buf1)^ := Double(Val[i]);
|
|
datDecimal: PBCD(buf1)^ := VariantToBCD(val[i]);
|
|
datCardinal: PCardinal(buf1)^ := Cardinal(Val[i]);
|
|
datByte: PSmallInt(buf1)^ := Byte(Val[i]);
|
|
datWord: PWord(buf1)^ := Word(Val[i]);
|
|
datShortInt: PSmallInt(buf1)^ := ShortInt(Val[i]);
|
|
datSmallInt: PSmallInt(buf1)^ := SmallInt(Val[i]);
|
|
datGuid: begin
|
|
s:= VarToAnsiStr(val[i]);
|
|
Move(pointer(s)^, pointer(buf1)^, 38 {Length(GuidString)});
|
|
end;
|
|
datBlob,
|
|
datMemo,
|
|
datWideMemo,
|
|
datXml: PPointer(buf1)^ := aDataForAppend.lBatchAdding.MakeBlobFromString(VariantToAnsiString(Val[i]));
|
|
end;
|
|
end;
|
|
end;
|
|
aDataForAppend.lBatchAddingList.Add(Buf);
|
|
except
|
|
aDataForAppend.lBatchAdding.FreeRecordBuffer(buf);
|
|
For i:=0 to aDataForAppend.lBatchAddingList.Count-1 do begin
|
|
buf:=aDataForAppend.lBatchAddingList[i];
|
|
aDataForAppend.lBatchAdding.FreeRecordBuffer(Buf);
|
|
end;
|
|
aDataForAppend.lBatchAddingList.Clear;
|
|
raise;
|
|
end;
|
|
end;
|
|
|
|
|
|
var
|
|
i : integer;
|
|
{$IFDEF LDADEBUG_time}
|
|
t1,t2: TDateTime;
|
|
{$ENDIF LDADEBUG_time}
|
|
lWriteProgress: boolean;
|
|
lReadProgress: Boolean;
|
|
begin
|
|
Realfldcnt:= Length(aDataForAppend.RealFields);
|
|
|
|
lWriteProgress := Assigned(onWriteDatasetProgress);
|
|
lReadProgress := Assigned(OnReadDatasetProgress);
|
|
ev1 := Assigned(OnBeforeFieldValueSerialization);
|
|
ev2 := Assigned(OnWriteFieldValue);
|
|
ev3 := Assigned(OnWriteFieldValueEx);
|
|
ev4 := Assigned(OnReadFieldValue);
|
|
|
|
SetLength(Sourceflds,Realfldcnt);
|
|
for i := 0 to Realfldcnt-1 do begin
|
|
if aDataForAppend.RealFields[i] = -10 then
|
|
Sourceflds[i]:=nil
|
|
else
|
|
Sourceflds[i]:=Source.Fields[aDataForAppend.RealFields[i]];
|
|
end;
|
|
SetLength(val,Realfldcnt);
|
|
|
|
while (aDataForAppend.RecordCount <> aDataForAppend.MaxRowCount) and not Source.EOF do begin
|
|
GetSourceValues;
|
|
|
|
Inc(aDataForAppend.RecordCount);
|
|
if lWriteProgress then OnWriteDatasetProgress(Self, Source, aDataForAppend.RecordCount, aDataForAppend.MaxRowCount);
|
|
Source.Next;
|
|
|
|
if aDataForAppend.lBatchAdding <> nil then
|
|
SetDestValues_BatchMode
|
|
else
|
|
SetDestValues_StdMode;
|
|
|
|
if lReadProgress then OnReadDatasetProgress(Self, Source, aDataForAppend.RecordCount, aDataForAppend.MaxRowCount);
|
|
if Source.EOF then Break;
|
|
end;
|
|
{$IFDEF LDADEBUG_time}
|
|
t2:=now;
|
|
OutputDebugString(PAnsiChar('TDABIN2DataStreamer.InternalDoWriteDataset:'+TimeToStr(t2-t1)+' | ' +FloatToStr(t2-t1)));
|
|
{$ENDIF LDADEBUG_time}
|
|
end;
|
|
|
|
end.
|