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 + '' + 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.