Componentes.Terceros.RemObj.../internal/5.0.23.613/1/Data Abstract for Delphi/Source/uDABusinessProcessor.pas
david 2824855ea7 - Modificación del paquete RemObjects_Core_D10 para que sea un paquete de runtime/designtime (antes era designtime sólo)
- 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
2007-09-10 14:06:19 +00:00

2134 lines
78 KiB
ObjectPascal

unit uDABusinessProcessor;
{----------------------------------------------------------------------------}
{ 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
{ ToDo: for DA3, refactor the Oracle specific stuff OUT of here again }
uses
Classes, DB, Contnrs, SysUtils,
uDAInterfaces, uDADataTable, uDAClasses, uDAOracleInterfaces,
uDAScriptingProvider, uDADelta
, uDASupportClasses
;
type
// These structs are to speed up mapping between command parameters and delta fields.
// See TDABusinessProcessor.ProcessDelta
TDAMappingType = (mtNewValue, mtOldValue{, mtNullCheck});
TDAParamMapping = record
CommandIndex,
DeltaIndex: integer;
MappingType: TDAMappingType;
GeneratorName : string;
GeneratorValue : integer;
end;
TDAParamMappingArray = array of TDAParamMapping;
const
MappingPrefix: array[TDAMappingType] of string = ('', 'OLD_'{, 'NULL_'});
type
TDABusinessProcessor = class;
TDABusinessProcessorRules = class;
TDADeltaProcessorItemCollection = class;
{ Events }
TDAProcessDeltaEvent = procedure(Sender: TDABusinessProcessor; const aDelta: IDADelta) of object;
TDABeforeProcessChangeEvent = procedure(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange; var ProcessChange: boolean) of object;
TDAAfterProcessChangeEvent = procedure(Sender: TDABusinessProcessor; aChange: TDADeltaChange; Processed: boolean; var CanRemoveFromDelta: boolean) of object;
TDAProcessChangeEvent = procedure(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange; const aCommand: IDASQLCommand) of object;
TDARefreshDeltaChangeEvent = procedure(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange; const aRefreshDataSet: IDADataSet) of object;
TDAProcessErrorEvent = procedure(Sender: TDABusinessProcessor;
aChangeType: TDAChangeType;
aChange: TDADeltaChange;
const aCommand: IDASQLCommand;
var CanRemoveFromDelta: boolean;
Error: Exception) of object;
TDAGenerateSQLEvent = procedure(Sender: TDABusinessProcessor;
ChangeType: TDAChangeType;
const ReferencedStatement: TDAStatement;
const aDelta: IDADelta;
var SQL: string) of object;
{ Misc }
TDAProcessorOption = (poAutoGenerateInsert,
poAutoGenerateUpdate,
poAutoGenerateDelete,
poAutoGenerateRefreshDataset,
poPrepareCommands,
poIgnoreRowsAffected);
TDAProcessorOptions = set of TDAProcessorOption;
TDAUpdateMode = (updWhereKeyOnly, updWhereAll, updWhereKeyAndUserDefined, updWhereUserDefined);
{ TDADeltaStruct }
TDADeltaStruct = class
private
fDelta : IDADelta;
fBusinessProcessor : TDABusinessProcessor;
fDetailDeltas : TDADeltaList;
fRelationShips: TDADatasetRelationshipList;
public
constructor Create(const aDelta : IDADelta; aBusinessProcessor : TDABusinessProcessor);
destructor Destroy; override;
property Delta : IDADelta read fDelta;
property BusinessProcessor : TDABusinessProcessor read fBusinessProcessor;
property DetailDeltas : TDADeltaList read fDetailDeltas;
property RelationShips : TDADatasetRelationshipList read fRelationShips;
end;
{ TDADeltaStructList }
TDADeltaStructList = class(TObjectList)
private
function GetDADeltaStructs(Index: integer): TDADeltaStruct;
protected
public
function Add(const aDelta : IDADelta; aBusinessProcessor : TDABusinessProcessor): TDADeltaStruct;
function FindStruct(const aLogicalName : string) : TDADeltaStruct;
function StructByLogicalName(const aLogicalName : string) : TDADeltaStruct;
property DeltaStructs[Index : integer] : TDADeltaStruct read GetDADeltaStructs; default;
end;
IDABusinessProcessorScriptingProvider = interface(IDAScriptingProvider)
['{7BF0D886-51D7-4E91-8073-0FBA78CC11F3}']
procedure RunBusinessProcessorScript(aBusinessProcessor: TDABusinessProcessor; const aScript: string; const aMethod: string; aLanguage:TROSEScriptLanguage);
end;
{ IDASQLGenerator }
IDASQLGenerator = interface
['{EDE4E068-C300-4991-89CF-F9A81D207930}']
function GenerateSQL(aChangeType: TDAChangeType;
aChange: TDADeltaChange;
aDataset: TDADataset;
const aDelta: IDADelta;
aDatasetStatement: TDAStatement;
aConnection: IDAConnection): string;
procedure UpdateSQLForOracle(aChangeType: TDAChangeType;
aDataset: TDADataset; const aDelta: IDADelta;
aDatasetStatement: TDAStatement; aConnection: IOracleConnection;
var OriginalSQL: string);
function GenerateRefreshDataset(aDataset: TDADataset; const aDelta: IDADelta;
aDatasetStatement: TDAStatement; aConnection: IDAConnection): IDADataset;
end;
{ TDABusinessProcessor }
TDABusinessProcessor = class(TScriptableComponent, IDASQLGenerator)
private
fOnBeforeProcessChange: TDABeforeProcessChangeEvent;
fOnAfterProcessChange: TDAAfterProcessChangeEvent;
fInsertCommandName: string;
fDeleteCommandName: string;
fUpdateCommandName: string;
fSchema: TDASchema;
fOnAfterProcessDelta: TDAProcessDeltaEvent;
fOnBeforeProcessDelta: TDAProcessDeltaEvent;
fOnProcessChange: TDAProcessChangeEvent;
fOnProcessError: TDAProcessErrorEvent;
fOnRefreshDeltaChange: TDARefreshDeltaChangeEvent;
fReferencedDataset: string;
fProcessorOptions: TDAProcessorOptions;
fUserUpdateFields: TStringList;
fUpdateMode: TDAUpdateMode;
fOnGenerateSQL: TDAGenerateSQLEvent;
fBusinessRules: TDABusinessProcessorRules;
fCurrentChange: integer;
fCurrentDelta: TDADelta;
fBusinessRulesID: string;
fRefreshDataset: string;
FRaiseExceptionAtError: boolean;
fHasReducedDelta: Boolean;
FDynamicWhereInRefreshDataset: Boolean;
procedure SetSchema(const Value: TDASchema);
procedure SetDeleteCommandName(const Value: string);
procedure SetInsertCommandName(const Value: string);
procedure SetUpdateCommandName(const Value: string);
procedure SetReferencedDataset(const Value: string);
function GetUserUpdateFields: TStrings;
procedure SetUserUpdateFields(Value: TStrings);
function NeedsReferencedDataset: boolean;
function GetCurrentChange: TDADeltaChange;
procedure SetBusinessRulesID(const Value: string);
procedure SetupParameters(const aCommand: IDASQLCommand; aReferencedDataset : TDADataset);
procedure SetRefreshDataset(const Value: string);
procedure RefreshDeltaChange(const aConnection : IDAConnection; const aRefreshDataset: IDADataset;
const aDelta: IDADelta; aDeltaChange: TDADeltaChange; GenAutoIncValue : integer = -1);
protected
procedure SetupCommands(const aConnection: IDAConnection; const aDelta: IDADelta;
out anInsertCmd, anUpdateCmd, aDeleteCmd: IDASQLCommand;
out aRefreshDs : IDADataset); overload;dynamic;
procedure SetupCommands(const aConnection: IDAConnection; const aChange: TDADeltaChange;
out anCmd: IDASQLCommand); overload;dynamic;
// For unions
procedure SetupCommands(const aConnection: IDAConnection; const aDelta: IDADelta;
out aCommandsList : TDADeltaProcessorItemCollection); overload;dynamic;
procedure SetupCommandsWithMapping(const aConnection: IDAConnection; const aChange: TDADeltaChange;
out anCmd: IDASQLCommand; out aParamMapping: TDAParamMappingArray);
procedure CreateMappings(const aDelta: IDADelta; var MappingArray: TDAParamMappingArray; const aCommand: IDASQLCommand; lAdditionalMapping: TDAColumnMappingCollection = nil);
{ IDASQLGenerator }
function GenerateSQL(aChangeType: TDAChangeType;
aChange: TDADeltaChange;
aDataset: TDADataset;
const aDelta: IDADelta;
aDatasetStatement: TDAStatement;
aConnection: IDAConnection): string; dynamic;
procedure UpdateSQLForOracle(aChangeType: TDAChangeType;
aDataset: TDADataset; const aDelta: IDADelta;
aDatasetStatement: TDAStatement; aConnection: IOracleConnection;
var OriginalSQL: string);
function GenerateRefreshDataset(aDataset: TDADataset; const aDelta: IDADelta;
aDatasetStatement: TDAStatement; aConnection: IDAConnection): IDADataset; dynamic;
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
// IInterface
function QueryInterface(const IID: TGUID; out Obj): HResult; override;
public
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
procedure SynchronizeAutoIncs(const aMasterDelta, aDetailDelta : IDADelta;
const aRelationship : TDADatasetRelationship);
procedure ProcessDelta(const aConnection: IDAConnection;
const aDelta: IDADelta;
ChangeTypes: TDAChangeTypes = AllChanges); overload;
procedure ProcessDelta(aDataTable: TDADataTable;
ChangeTypes: TDAChangeTypes; const aConnection : IDAConnection = NIL); overload;
procedure ProcessDeltaForUnion(const aConnection: IDAConnection;
const aDelta: IDADelta; ChangeTypes: TDAChangeTypes = AllChanges);
property CurrentDelta: TDADelta read fCurrentDelta;
property CurrentChange: TDADeltaChange read GetCurrentChange;
property HasReducedDelta: Boolean read fHasReducedDelta write fHasReducedDelta;
procedure CheckProperties;
published
property OnBeforeProcessDelta: TDAProcessDeltaEvent read fOnBeforeProcessDelta write fOnBeforeProcessDelta;
property OnAfterProcessDelta: TDAProcessDeltaEvent read fOnAfterProcessDelta write fOnAfterProcessDelta;
property OnBeforeProcessChange: TDABeforeProcessChangeEvent read fOnBeforeProcessChange write fOnBeforeProcessChange;
property OnAfterProcessChange: TDAAfterProcessChangeEvent read fOnAfterProcessChange write fOnAfterProcessChange;
property OnProcessChange: TDAProcessChangeEvent read fOnProcessChange write fOnProcessChange;
property OnProcessError: TDAProcessErrorEvent read fOnProcessError write fOnProcessError;
property OnGenerateSQL: TDAGenerateSQLEvent read fOnGenerateSQL write fOnGenerateSQL;
property OnRefreshDeltaChange: TDARefreshDeltaChangeEvent read fOnRefreshDeltaChange write fOnRefreshDeltaChange;
property Schema: TDASchema read fSchema write SetSchema;
property InsertCommandName: string read fInsertCommandName write SetInsertCommandName;
property DeleteCommandName: string read fDeleteCommandName write SetDeleteCommandName;
property UpdateCommandName: string read fUpdateCommandName write SetUpdateCommandName;
property RefreshDatasetName: string read fRefreshDataset write SetRefreshDataset;
property ReferencedDataset: string read fReferencedDataset write SetReferencedDataset;
property ProcessorOptions: TDAProcessorOptions read fProcessorOptions write fProcessorOptions;
property UpdateMode: TDAUpdateMode read fUpdateMode write fUpdateMode;
property UserUpdateFields: TStrings read GetUserUpdateFields write SetUserUpdateFields;
property BusinessRulesID: string read fBusinessRulesID write SetBusinessRulesID;
property RaiseExceptionAtError: boolean read FRaiseExceptionAtError write FRaiseExceptionAtError default False;
end;
{ TDABusinessProcessorRules }
TDABusinessProcessorRules = class(TDABusinessRules, IDAStronglyTypedDataTable)
private
fBusinessProcessor: TDABusinessProcessor;
protected
property BusinessProcessor: TDABusinessProcessor read fBusinessProcessor;
// Misc
procedure Attach(aBusinessProcessor: TDABusinessProcessor); virtual;
procedure Detach(aBusinessProcessor: TDABusinessProcessor); virtual;
// Business events
procedure BeforeProcessDelta(Sender: TDABusinessProcessor; const aDelta: IDADelta); virtual;
procedure AfterProcessDelta(Sender: TDABusinessProcessor; const aDelta: IDADelta); virtual;
procedure BeforeProcessChange(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange; var ProcessChange: boolean); virtual;
procedure AfterProcessChange(Sender: TDABusinessProcessor; aChange: TDADeltaChange; Processed: boolean; var CanRemoveFromDelta: boolean); virtual;
procedure ProcessChange(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange; const aCommand: IDASQLCommand); virtual;
procedure ProcessError(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange;
const aCommand: IDASQLCommand; var CanRemoveFromDelta: boolean; Error: Exception); virtual;
procedure GenerateSQL(Sender: TDABusinessProcessor; ChangeType: TDAChangeType; const ReferencedStatement: TDAStatement;
const aDelta: IDADelta; var SQL: string); virtual;
procedure NotSupportedByBusinessProcessor;
procedure Open;
procedure Close;
function GetActive: boolean;
procedure SetActive(const Value: boolean);
procedure Append;
procedure Cancel;
procedure Delete;
procedure Edit;
procedure First;
procedure Insert;
procedure Last;
procedure Next;
procedure Post;
procedure Prior;
function GetBOF: Boolean;
function GetEOF: Boolean;
function GetRecordCount: Integer;
function Locate(const aKeyFields: String; const aKeyValues: Variant; aOptions: TLocateOptions = []): Boolean;
function Lookup(const KeyFields: string; const KeyValues: Variant; const ResultFields: string): Variant;
function GetMasterOptions : TDAMasterOptions;
procedure SetMasterOptions(Value : TDAMasterOptions);
function GetDetailOptions : TDADetailOptions;
procedure SetDetailOptions(Value : TDADetailOptions);
function GetState : TDatasetState;
function GetIsEmpty : boolean;
function IsFieldNull(const FieldIndexOrName : Variant) : boolean;
procedure ClearField(const FieldIndexOrName : Variant);
function GetDataTable : TDADataTable;
function GetRecNo: integer;
procedure SetRecNo(Value: integer);
public
constructor Create(aBusinessProcessor: TDABusinessProcessor); reintroduce; virtual;
end;
TDABusinessProcessorRulesClass = class of TDABusinessProcessorRules;
TDADeltaProcessorItem = class(TCollectionItem)
private
fName: String;
fRefreshDataset: IDADataset;
fInsertCommand: IDASQLCommand;
fUpdateCommand: IDASQLCommand;
fDeleteCommand: IDASQLCommand;
fInsertCommandMapping: TDAParamMappingArray;
fUpdateCommandMapping: TDAParamMappingArray;
fDeleteCommandMapping: TDAParamMappingArray;
public
property RefreshDataset: IDADataset read fRefreshDataset write fRefreshDataset;
property InsertCommand: IDASQLCommand read fInsertCommand write fInsertCommand;
property UpdateCommand: IDASQLCommand read fUpdateCommand write fUpdateCommand;
property DeleteCommand: IDASQLCommand read fDeleteCommand write fDeleteCommand;
property InsertCommandMapping: TDAParamMappingArray read fInsertCommandMapping write fInsertCommandMapping;
property UpdateCommandMapping: TDAParamMappingArray read fUpdateCommandMapping write fUpdateCommandMapping;
property DeleteCommandMapping: TDAParamMappingArray read fDeleteCommandMapping write fDeleteCommandMapping;
published
property Name: String read fName write fName;
end;
TDADeltaProcessorItemCollection = class(TSearcheableCollection)
private
function GetItem(Index: integer): TDADeltaProcessorItem;
procedure SetItem(Index: integer; const Value: TDADeltaProcessorItem);
public
constructor Create(aOwner: TComponent);
function Add: TDADeltaProcessorItem; reintroduce;
function ItemByName(const aName: String): TDADeltaProcessorItem;
property Items[Index: integer]: TDADeltaProcessorItem read GetItem write SetItem; default;
end;
// Registration routines
procedure RegisterBusinessProcessorRules(const anID: string; const aDeltaChangeClass: TDABusinessProcessorRulesClass);
function FindBusinessProcessorRules(const anID: string; out aDeltaChangeClass: TDABusinessProcessorRulesClass): boolean;
implementation
uses
{$IFDEF DEBUG_DATAABSTRACT_SQL}
eDebugServer,
{$ENDIF}
uROClasses, Variants, TypInfo, Types;
{$IFDEF DEBUG_DATAABSTRACT_SQL}
const
cat_SQL = 'SQL Generation';
{$ENDIF}
var
_bizdeltachanges: TStringList;
procedure RegisterBusinessProcessorRules(const anID: string; const aDeltaChangeClass: TDABusinessProcessorRulesClass);
var
idx: integer;
begin
idx := _bizdeltachanges.IndexOf(anID);
if (idx >= 0) then
_bizdeltachanges.Objects[idx] := TObject(aDeltaChangeClass)
else
_bizdeltachanges.AddObject(anID, TObject(aDeltaChangeClass));
end;
function FindBusinessProcessorRules(const anID: string; out aDeltaChangeClass: TDABusinessProcessorRulesClass): boolean;
var
idx: integer;
begin
result := FALSE;
idx := _bizdeltachanges.IndexOf(anID);
if (idx >= 0) then begin
aDeltaChangeClass := TDABusinessProcessorRulesClass(_bizdeltachanges.Objects[idx]);
result := TRUE;
end
else
aDeltaChangeClass := nil;
end;
function QuoteIdentifier(const aConnection : IDAConnection; const aFieldName: string): string;
begin
{if (Pos(' ', aFieldName) > 0) then
result := QuoteChars[0] + aFieldName + QuoteChars[1]
else
result := aFieldName;}
result := aConnection.QuoteIdentifierIfNeeded(aFieldName);
end;
function QuoteFieldName(const aConnection : IDAConnection; const aTableName,aFieldName: string): string;
begin
result := aConnection.QuoteFieldNameIfNeeded(aTableName, aFieldName);
end;
function QuoteParamName(const aConnection : IDAConnection; const aParamName: string): string;
begin
if aConnection.IdentifierNeedsQuoting(aParamName) then
result := AnsiQuotedStr(aParamName,'"')
else
Result:= aParamName;
end;
{ TDADeltaStruct }
constructor TDADeltaStruct.Create(const aDelta : IDADelta; aBusinessProcessor : TDABusinessProcessor);
begin
inherited Create;
fDelta := aDelta;
fBusinessProcessor := aBusinessProcessor;
fDetailDeltas := TDADeltaList.Create;
fRelationShips := TDADatasetRelationshipList.Create;
end;
destructor TDADeltaStruct.Destroy;
begin
inherited;
FreeAndNIL(fDetailDeltas);
FreeAndNIL(fRelationShips);
end;
{ TDADeltaStructList }
function TDADeltaStructList.Add(const aDelta : IDADelta; aBusinessProcessor : TDABusinessProcessor): TDADeltaStruct;
begin
result := TDADeltaStruct.Create(aDelta, aBusinessProcessor);
inherited Add(result);
end;
function TDADeltaStructList.FindStruct(
const aLogicalName: string): TDADeltaStruct;
var i : integer;
begin
result := NIL;
for i := 0 to (Count-1) do
if SameText(DeltaStructs[i].Delta.LogicalName, aLogicalName) then begin
result := DeltaStructs[i];
Exit;
end;
end;
function TDADeltaStructList.GetDADeltaStructs(
Index: integer): TDADeltaStruct;
begin
result := TDADeltaStruct(inherited Items[Index])
end;
function TDADeltaStructList.StructByLogicalName(
const aLogicalName: string): TDADeltaStruct;
begin
result := FindStruct(aLogicalName);
if result=NIL then raise Exception.Create('Cannot find struct '+aLogicalName);
end;
{ TDABusinessProcessor }
constructor TDABusinessProcessor.Create(aOwner: TComponent);
begin
inherited;
fUserUpdateFields := TStringList.Create;
fProcessorOptions := [poAutoGenerateInsert, poAutoGenerateUpdate, poAutoGenerateDelete, poPrepareCommands, poAutoGenerateRefreshDataset];
fUpdateMode := updWhereKeyOnly;
end;
destructor TDABusinessProcessor.Destroy;
begin
FreeAndNIL(fUserUpdateFields);
if (fBusinessRules <> nil) then begin
fBusinessRules.Detach(Self);
fBusinessRules.Free;
end;
inherited;
end;
function TDABusinessProcessor.GetUserUpdateFields: TStrings;
begin
result := fUserUpdateFields
end;
procedure TDABusinessProcessor.SetUserUpdateFields(Value: TStrings);
begin
fUserUpdateFields.Assign((Value));
end;
procedure TDABusinessProcessor.CreateMappings(const aDelta: IDADelta; var MappingArray: TDAParamMappingArray; const aCommand: IDASQLCommand; lAdditionalMapping: TDAColumnMappingCollection = nil);
var
i: integer;
lParamName : string;
lDeltaIndex : integer;
lFieldName: String;
begin
if aCommand = nil then Exit;
// The command is what determines how many mappings will be done
SetLength(MappingArray, aCommand.Params.Count);
for i := 0 to (aCommand.Params.Count - 1) do begin
MappingArray[i].CommandIndex := 0;
lParamName := UpperCase(aCommand.Params[i].Name);
// Determines the mapping type
if (Pos(MappingPrefix[mtOldValue], lParamName) = 1)
then MappingArray[i].MappingType := mtOldValue
{else if (Pos(MappingPrefix[mtNullCheck], lParamName) = 1)
then MappingArray[i].MappingType := mtNullCheck}
else MappingArray[i].MappingType := mtNewValue;
if (MappingArray[i].MappingType = mtOldValue) then
lFieldName := Copy(aCommand.Params[i].Name, 5, MaxInt)
else
lFieldName := aCommand.Params[i].Name;
// if lAdditionalMapping is assigned (usually incase delta for union table)
// then translate it
if Assigned(lAdditionalMapping) then begin
lFieldName := lAdditionalMapping.MappingByTableField(lFieldName).DatasetField;
end;
// Finds the index for this value in the delta
lDeltaIndex := aDelta.IndexOfLoggedField(lFieldName);
MappingArray[i].DeltaIndex := lDeltaIndex;
MappingArray[i].GeneratorName := aCommand.ParamByName(lParamName).GeneratorName;
MappingArray[i].GeneratorValue := -1;
end;
end;
function TDABusinessProcessor.GenerateRefreshDataset(
aDataset: TDADataset; const aDelta: IDADelta; aDatasetStatement: TDAStatement;
aConnection: IDAConnection): IDADataset;
var
i: integer;
namesstr,
fullsql,
fieldsstr,
keystr,
//remotename,
localname: string;
fld: TDAField;
begin
result := aConnection.NewDataset('');
fieldsstr := '';
namesstr := '';
keystr := '';
with aDataset do try
// Generates the SELECT
for i := 0 to Fields.Count-1 do begin
if (not Fields[i].ServerAutoRefresh) and (Fields[i].DataType <> datAutoInc)and (Fields[i].DataType <> datLargeAutoInc) then Continue;
localname := QuoteFieldName(aConnection, aDatasetStatement.TargetTable, aDatasetStatement.ColumnMappings.MappingByDatasetField(Fields[i].Name).TableField);
fieldsstr := fieldsstr+localname+','+#13;
result.Fields.Add.AssignField(Fields[i]);
end;
if (fieldsstr='') then Exit;
fieldsstr := Copy(fieldsstr,1, Length(fieldsstr)-2)+#13;
// Generates the WHERE using the primary key fields
for i := 0 to Fields.Count-1 do begin
if not Fields[i].InPrimaryKey then Continue;
localname := QuoteFieldName(aConnection,aDatasetStatement.TargetTable, aDatasetStatement.ColumnMappings.MappingByDatasetField(Fields[i].Name).TableField);
keystr := keystr+Format('%s=:%s', [localname, Fields[i].Name])+' AND '+#13;
end;
if (keystr='') then Exit;
keystr := Copy(keystr,1, Length(keystr)-5)+#13;
// Combines the two
fullsql := 'SELECT'#13+fieldsstr+'FROM '+ QuoteIdentifier(aConnection, aDatasetStatement.TargetTable) +#13+'WHERE'+#13+keystr;
result.SQL := fullsql;
{$IFDEF DEBUG_DATAABSTRACT_SQL}DebugServer.Write([cat_SQL], result.SQL);{$ENDIF}
with aDatasetStatement do
for i := 0 to (ColumnMappings.Count - 1) do begin
fld := result.FindField(ColumnMappings[i].DatasetField);
if Assigned(fld) then begin
fld.TableField := ColumnMappings[i].TableField;
fld.SQLOrigin := ColumnMappings[i].SQLOrigin;
end;
end;
finally
if (result.SQL='') then result := NIL;
end;
end;
function TDABusinessProcessor.GenerateSQL(aChangeType: TDAChangeType;
aChange: TDADeltaChange;
aDataset: TDADataset;
const aDelta: IDADelta;
aDatasetStatement: TDAStatement;
aConnection: IDAConnection): string;
var
i: integer;
namesstr,
valuesstr,
keystr,
remotename,
localname: string;
oraconn : IOracleConnection;
fld : TDAField;
usegenerators : boolean;
//lIsUnionTable : Boolean;
lUnionTable: TDAUnionDataTable;
lSrcTable: TDAUnionSourceTable;
begin
result := '';
valuesstr := '';
namesstr := '';
keystr := '';
lSrcTable := nil;
if aDatasetStatement.TargetTable = '' then raise Exception.Create(aDelta.LogicalName+'. Can''t generate a delta''s SQL. TargetTable isn''t assigned.');
// If passed dataset is a source table for uniontable then lSrcTable will be assigned (used for distinguish unionsourcetables)
lUnionTable := fSchema.UnionDataTables.FindItem(fReferencedDataset) as TDAUnionDataTable;
if assigned(lUnionTable) then begin
lSrcTable := lUnionTable.SourceTables.UnionSourceTableByName(aDataset.Name);
end;
usegenerators := Supports(aConnection, IDAUseGenerators);
with aDatasetStatement, aDelta do begin
// Generates the WHERE conditions. Done here because used by both deletes and updates
if (aChangeType <> ctInsert) then begin
case fUpdateMode of
updWhereKeyOnly, updWhereKeyAndUserDefined: begin
for i := 0 to (KeyFieldCount - 1) do begin
remotename := KeyFieldNames[i];
// If this is UnionSourceDataTable then we should do fields remapping
if Assigned(lSrcTable) then begin
if SameText(remotename, def_SourceTableFieldName) then Continue;
remotename := lSrcTable.ColumnMappings.MappingByDatasetField(remotename).TableField;
end;
localname := QuoteFieldName(aConnection,aDatasetStatement.TargetTable, ColumnMappings.MappingByDatasetField(remotename).TableField);
keystr := keystr + #13'(' + localname + '=:'+QuoteParamName(aConnection,'OLD_' + remotename)+ ') AND ';
end;
end;
updWhereAll: begin
for i := 0 to (LoggedFieldCount - 1) do begin
remotename := LoggedFieldNames[i];
// If this is UnionSourceDataTable then we should do fields remapping
if Assigned(lSrcTable) then begin
if SameText(remotename, def_SourceTableFieldName) then Continue;
remotename := lSrcTable.ColumnMappings.MappingByDatasetField(remotename).TableField;
end;
localname := QuoteFieldName(aConnection,aDatasetStatement.TargetTable, ColumnMappings.MappingByDatasetField(remotename).TableField);
if (aDataset.FieldByName(remotename).DataType in [datBlob, datMemo]) then Continue;
keystr := keystr + #13'((' + localname + '=:'+QuoteParamName(aConnection, 'OLD_' + remotename) + ') OR (:'+QuoteParamName(aConnection, 'OLD_' + remotename) + ' IS NULL AND ' + localname + ' IS NULL)) AND ';
end;
end;
end;
if (fUpdateMode in [updWhereKeyAndUserDefined, updWhereUserDefined]) then begin
for i := 0 to (fUserUpdateFields.Count - 1) do begin
remotename := fUserUpdateFields[i];
// If this is UnionSourceDataTable then we should do fields remapping
if Assigned(lSrcTable) then begin
if SameText(remotename, def_SourceTableFieldName) then Continue;
remotename := lSrcTable.ColumnMappings.MappingByDatasetField(remotename).TableField;
end;
localname := QuoteFieldName(aConnection, aDatasetStatement.TargetTable,ColumnMappings.MappingByDatasetField(remotename).TableField);
if assigned(aChange) and ROVariantsEqual(aChange.OldValueByName[remotename],aChange.NewValueByName[remotename]) then Continue;
keystr := keystr + #13'((' + localname + '=:'+QuoteParamName(aConnection, 'OLD_' + remotename) + ') OR (:'+QuoteParamName(aConnection,'OLD_' + remotename) + ' IS NULL AND ' + localname + ' IS NULL)) AND ';
end;
end;
keystr := Copy(keystr, 1, Length(keystr) - 5);
end;
// Remaining part of the SQL command
case aChangeType of
// Insert
ctInsert: begin
result := 'INSERT INTO ' + QuoteIdentifier(aConnection, aDatasetStatement.TargetTable) + ' ('#13;
for i := 0 to (LoggedFieldCount - 1) do begin
remotename := LoggedFieldNames[i];
// If this is UnionSourceDataTable then we should do fields remapping
if Assigned(lSrcTable) then begin
if SameText(remotename, def_SourceTableFieldName) then Continue;
remotename := lSrcTable.ColumnMappings.MappingByDatasetField(remotename).TableField;
end;
fld := aDataset.Fields.FieldByName(remotename);
if (((fld.DataType = datAutoInc) or (fld.DataType = datlargeAutoInc)) and not usegenerators) // Skips autoincs on DBs like MSSQL
or (fld.Calculated) or (fld.ReadOnly) or (fld.ServerCalculated)
then Continue;
if (Assigned(aChange) and VarIsNull(aChange.NewValues[i])) then Continue;
localname := QuoteFieldName(aConnection, aDatasetStatement.TargetTable,ColumnMappings.MappingByDatasetField(remotename).TableField);
namesstr := namesstr + localname + ', ';
valuesstr := valuesstr + ':' +QuoteParamName(aConnection, remotename) + ', ';
end;
namesstr := Copy(namesstr, 1, Length(namesstr) - 2) + ')';
valuesstr := Copy(valuesstr, 1, Length(valuesstr) - 2) + ')';
result := result + namesstr + #13' VALUES (' + valuesstr;
end;
// Delete
ctDelete: result := 'DELETE FROM ' + QuoteIdentifier(aConnection, aDatasetStatement.TargetTable) + #13' WHERE ' + keystr;
// Update
ctUpdate: begin
result := '';
for i := 0 to (LoggedFieldCount - 1) do begin
remotename := LoggedFieldNames[i];
// If this is UnionSourceDataTable then we should do fields remapping
if Assigned(lSrcTable) then begin
if SameText(remotename, def_SourceTableFieldName) then Continue;
remotename := lSrcTable.ColumnMappings.MappingByDatasetField(remotename).TableField;
end;
fld := aDataset.Fields.FieldByName(remotename);
if ((fld.DataType = datAutoInc) or (fld.DataType = datlargeAutoInc)) then Continue; // Skips autoincs
if (fld.InPrimaryKey and not fld.LogChanges) then Continue;
if (fld.Calculated) or (fld.ReadOnly) or (fld.ServerCalculated) then Continue;
if assigned(aChange) and ROVariantsEqual(aChange.OldValues[i],aChange.NewValues[i]) then Continue;
localname := QuoteFieldName(aConnection, aDatasetStatement.TargetTable,ColumnMappings.MappingByDatasetField(remotename).TableField);
if (result<>'') then result := result + ', ';
result := result + #13 + localname + '= :' + QuoteParamName(aConnection,remotename);
//if (i < LoggedFieldCount - 1) then result := result + ', ';
end;
result := 'UPDATE '+QuoteIdentifier(aConnection, aDatasetStatement.TargetTable)+' SET '+result+#13' WHERE '+keystr;
end;
end;
end;
// Exception for Oracle's SQL
if Supports(aConnection, IOracleConnection, oraconn)
then UpdateSQLForOracle(aChangeType, aDataset, aDelta, aDatasetStatement, oraconn, result);
// Events
if Assigned(fOnGenerateSQL) then
fOnGenerateSQL(Self, aChangeType, aDatasetStatement, aDelta, result)
else if Assigned(fBusinessRules) then
fBusinessRules.GenerateSQL(Self, aChangeType, aDatasetStatement, aDelta, result);
{$IFDEF DEBUG_DATAABSTRACT_SQL}DebugServer.Write([cat_SQL], Result);{$ENDIF}
end;
procedure TDABusinessProcessor.UpdateSQLForOracle(aChangeType: TDAChangeType;
aDataset: TDADataset;
const aDelta: IDADelta;
aDatasetStatement: TDAStatement;
aConnection: IOracleConnection;
var OriginalSQL: string);
var i : integer;
returningstr, intostr : string;
begin
returningstr := '';
intostr := '';
with aDataset do begin
for i := 0 to (Fields.Count-1) do begin
if not aDataset.Fields[i].LogChanges then Continue;
case Fields[i].BlobType of
dabtOraBlob : begin
OriginalSQL := StringReplace(OriginalSQL, ':'+Fields[i].Name, 'empty_blob()', [rfIgnoreCase])
end;
dabtOraClob : begin
OriginalSQL := StringReplace(OriginalSQL, ':'+Fields[i].Name, 'empty_clob()', [rfIgnoreCase])
end;
else Continue;
end;
returningstr := returningstr+Fields[i].Name+',';
intostr := intostr+':'+Fields[i].Name+',';
end;
end;
if (returningstr<>'') then begin
Delete(returningstr, Length(returningstr), 1);
returningstr := 'RETURNING '+#13#10+returningstr+#13#10;
Delete(intostr, Length(intostr), 1);
intostr := 'INTO '+#13#10+intostr;
OriginalSQL := OriginalSQL+#13#10+returningstr+intostr;
end;
{$IFDEF DEBUG_DATAABSTRACT_SQL}DebugServer.Write([cat_SQL], OriginalSQL);{$ENDIF}
end;
function TDABusinessProcessor.NeedsReferencedDataset: boolean;
begin
result :=
(
((poAutoGenerateInsert in fProcessorOptions) and (InsertCommandName = '')) or
((poAutoGenerateUpdate in fProcessorOptions) and (UpdateCommandName = '')) or
((poAutoGenerateDelete in fProcessorOptions) and (DeleteCommandName = '')) or
((poAutoGenerateRefreshDataset in fProcessorOptions) and (RefreshDatasetName = ''))
);
end;
procedure TDABusinessProcessor.SetupParameters(const aCommand : IDASQLCommand;
aReferencedDataset : TDADataset);
var lParams: TParams;
fldname, lSQL: string;
i: integer;
par: TDAParam;
fld : TDAField;
begin
lParams := TParams.Create;
try
{ Bug in ParseSQL modified passed in string; use UniqueString to prevent
corrupting the original! }
lSQL := aCommand.SQL;
UniqueString(lSQL);
lParams.ParseSQL(lSQL, TRUE);
with aCommand do begin
Params.Clear; // Just in case
for i := 0 to (lParams.Count - 1) do begin
fldname := lParams[i].Name;
// Checks if it's one of the autogenerated params
if (Pos(MappingPrefix[mtOldValue], fldname)=1)
then Delete(fldname, 1, Length(MappingPrefix[mtOldValue]));
{else if (Pos(MappingPrefix[mtNullCheck], fldname)=1)
then Delete(fldname, 1, Length(MappingPrefix[mtNullCheck]));}
// Looks up the field and completes the param definition
fld := aReferencedDataset.Fields.FieldByName(fldname);
par := aCommand.Params.Add;
par.Name := lParams[i].Name;
par.DataType := fld.DataType;
par.BlobType := fld.BlobType;
par.ParamType := daptInput; // ODAC Blobs require it and this is not covered by AssignField below
{par.Size := fld.Size;
par.GeneratorName := fld.GeneratorName;}
par.AssignField(fld);
par.Name := lParams[i].Name; // Leave this here! Must override the Assign
end;
end;
finally
lParams.Free;
end;
end;
procedure TDABusinessProcessor.SetupCommands(const aConnection: IDAConnection; const aDelta: IDADelta;
out anInsertCmd, anUpdateCmd, aDeleteCmd: IDASQLCommand; out aRefreshDs : IDADataset);
var
sql: string;
refstmt: TDAStatement;
ds: TDADataset;
needsref: boolean;
i: integer;
begin
anInsertCmd := nil;
aDeleteCmd := nil;
anUpdateCmd := nil;
ds := nil;
refstmt := nil;
CheckProperties;
// Looks for the referenced statement which contains field mappings and TargetTableName
// in case the user specifies any AutoGenerateXXX option
needsref := NeedsReferencedDataset;
if needsref then begin
ds := TDADataset(fSchema.Datasets.FindItem(fReferencedDataset));
if (ds <> nil) then begin
refstmt := fSchema.FindCommandStatement(aConnection,ds);
// refstmt := TDAStatement(ds.Statements.FindItem(aConnection.Name));
// if (refstmt = nil) then refstmt := ds.Statements.StatementByName(Schema.ConnectionManager.GetDefaultConnectionName);
end
else
RaiseError(Name + '''s referenced dataset is not speficied or does not exist. Cannot generate SQL');
end;
for i:= 0 to aDelta.Count-1 do
if aDelta.Changes[i].ChangeType = ctInsert then begin
// Tries to locate the specified commands
if (fInsertCommandName <> '') then anInsertCmd := fSchema.NewCommand(aConnection, fInsertCommandName);
// Auto generates the SQL for the undefined commands
if (anInsertCmd = nil) and (poAutoGenerateInsert in fProcessorOptions) then begin
sql := GenerateSQL(ctInsert, nil, ds, aDelta, refstmt, aConnection);
anInsertCmd := aConnection.NewCommand(sql, stSQL);
SetupParameters(anInsertCmd, ds);
end;
Break;
end;
for i:= 0 to aDelta.Count-1 do
if aDelta.Changes[i].ChangeType = ctUpdate then begin
// Tries to locate the specified commands
if (fUpdateCommandName <> '') then anUpdateCmd := fSchema.NewCommand(aConnection, fUpdateCommandName);
// Auto generates the SQL for the undefined commands
if (anUpdateCmd = nil) and (poAutoGenerateUpdate in fProcessorOptions) then begin
sql := GenerateSQL(ctUpdate, nil, ds, aDelta, refstmt, aConnection);
anUpdateCmd := aConnection.NewCommand(sql, stSQL);
SetupParameters(anUpdateCmd, ds);
end;
Break;
end;
for i:= 0 to aDelta.Count-1 do
if aDelta.Changes[i].ChangeType = ctDelete then begin
// Tries to locate the specified commands
if (fDeleteCommandName <> '') then aDeleteCmd := fSchema.NewCommand(aConnection, fDeleteCommandName);
// Auto generates the SQL for the undefined commands
if (aDeleteCmd = nil) and (poAutoGenerateDelete in fProcessorOptions) then begin
sql := GenerateSQL(ctDelete, nil, ds, aDelta, refstmt, aConnection);
aDeleteCmd := aConnection.NewCommand(sql, stSQL);
SetupParameters(aDeleteCmd, ds);
end;
Break;
end;
if (fRefreshDataset <> '')
then aRefreshDs := fSchema.NewDataset(aConnection, fRefreshDataset,[],'','',False,True);
if (aRefreshDs = nil) and (poAutoGenerateRefreshDataset in fProcessorOptions) then begin
aRefreshDs := GenerateRefreshDataset(ds, aDelta, refstmt, aConnection);
if (aRefreshDs<>NIL) then SetupParameters(aRefreshDs, ds);
end;
// Finally prepares them
if (poPrepareCommands in fProcessorOptions) then begin
if (anInsertCmd <> nil) then anInsertCmd.Prepared := TRUE;
if (anUpdateCmd <> nil) then anUpdateCmd.Prepared := TRUE;
if (aDeleteCmd <> nil) then aDeleteCmd.Prepared := TRUE;
if (aRefreshDs <> NIL) then aRefreshDs.Prepared := TRUE;
end;
end;
function TDABusinessProcessor.GetCurrentChange: TDADeltaChange;
begin
result := fCurrentDelta.Changes[fCurrentChange]
end;
const
lDynWhereParamPrefix = 'dynwhere';
procedure TDABusinessProcessor.RefreshDeltaChange(const aConnection : IDAConnection;
const aRefreshDataset : IDADataset; const aDelta : IDADelta; aDeltaChange : TDADeltaChange; GenAutoIncValue : integer = -1);
var i : integer;
par : TDAParam;
nam: string;
val : Variant;
fld: TDAField;
// genname : string;
begin
// Sets the parameters of the dataset
for i := 0 to aRefreshDataset.Params.Count-1 do begin
par := aRefreshDataset.Params[i];
if (aDelta.IndexOfLoggedField(par.Name) < 0) then
Continue;
if (aDeltaChange.ChangeType=ctInsert) then begin
if (par.DataType=datAutoInc) or (Par.DataType = datLargeAutoInc) then begin
if (GenAutoIncValue<>-1)
then val := GenAutoIncValue
else val := aConnection.GetLastAutoInc(par.GeneratorName);
end
else val := aDeltaChange.NewValueByName[par.Name]; // Fix for Schuff
end
else begin
val := aDeltaChange.NewValueByName[par.Name];
end;
par.Value := val;
end;
if FDynamicWhereInRefreshDataset then
for i := 0 to aDelta.KeyFieldCount - 1 do begin
par:=aRefreshDataset.ParamByName(lDynWhereParamPrefix+intToStr(i));
par.Value := aDeltaChange.NewValueByName[aDelta.KeyFieldNames[i]];
end;
if Assigned(fOnRefreshDeltaChange) then
fOnRefreshDeltaChange(Self, aDeltaChange.ChangeType, aDeltaChange, aRefreshDataset);
// Opens the dataset
aRefreshDataset.Open;
try
case aDeltaChange.ChangeType of
ctInsert, ctUpdate : begin
// ctInsert:
// Swaps the new values the client sent in the old values then updates the
// new values. This way the client can locate the record it sent and also
// read what's new. This could probabily be optimized
// ctUpdate:
// Leaves the old values alone because they are needed on the client
// for merge purposes. This could probabily be optimized
for I := 0 to aDelta.LoggedFieldCount - 1 do begin
nam := aDelta.LoggedFieldNames[i];
fld := aRefreshDataset.FindField(nam);
if fld = nil then Continue;
aDeltaChange.OldValueByName[nam] := aDeltaChange.NewValueByName[nam];
aDeltaChange.NewValueByName[nam] := fld.Value;
end;
end;
end;
finally
aRefreshDataset.Close;
end;
end;
procedure TDABusinessProcessor.SynchronizeAutoIncs(const aMasterDelta, aDetailDelta : IDADelta;
const aRelationship : TDADatasetRelationship);
var x, k, z: integer;
masterds : TDADataset;
masterfields, detailfields : TStringList;
oldmasterval, masterval, detailval : Variant;
begin
CheckProperties;
masterfields := TStringList.Create;
masterfields.Delimiter := ';';
detailfields := TStringList.Create;
detailfields.Delimiter := ';';
try
masterds := Schema.Datasets.DatasetByName(aMasterDelta.LogicalName);
masterfields.DelimitedText := aRelationship.MasterFields;
detailfields.DelimitedText := aRelationship.DetailFields;
for x := 0 to (aMasterDelta.Count-1) do begin
if not (aMasterDelta[x].Status=csResolved) then Continue;
for k := 0 to (masterfields.Count-1) do begin
if not (masterds.FieldByName(masterfields[k]).DataType in [datAutoInc, datLargeAutoInc, datInteger, datLargeInt]) then Continue;
masterval := aMasterDelta[x].NewValueByName[masterfields[k]];
oldmasterval := aMasterDelta[x].OldValueByName[masterfields[k]];
for z := 0 to (aDetailDelta.Count-1) do begin
if (aDetailDelta[z].ChangeType<>ctInsert) then Continue;
detailval := aDetailDelta[z].NewValueByName[detailfields[k]];
if (detailval<>oldmasterval) then Continue;
aDetailDelta[z].NewValueByName[detailfields[k]] := masterval;
aDetailDelta[z].RefreshedByServer := TRUE;
end;
end;
end;
finally
masterfields.Free;
detailfields.Free;
end;
end;
procedure TDABusinessProcessor.ProcessDelta(const aConnection: IDAConnection;
const aDelta: IDADelta;
ChangeTypes: TDAChangeTypes = AllChanges);
var
i, x, rowsaffected: integer;
canremove, ok: boolean;
currcmd, inscmd, delcmd, updcmd: IDASQLCommand;
refds : IDADataset;
insmap, delmap, updmap, refmap: TDAParamMappingArray;
mapptr: ^TDAParamMappingArray;
change: TDADeltaChange;
todelete: TList;
val : variant;
parname : string;
autoincvalue: integer;
usegenerators : boolean;
lexpr: TDAWhereExpression;
begin
Check(not Assigned(aDelta), 'Cannot process a NIL delta');
if (aDelta.Count=0) then Exit;
if Assigned(fSchema.UnionDataTables.FindItem(fReferencedDataset)) then begin
ProcessDeltaForUnion(aConnection, aDelta, ChangeTypes);
exit;
end;
fCurrentDelta := aDelta.GetDelta;
fCurrentChange := 0;
usegenerators := Supports(aConnection, IDAUseGenerators);
// Fires the "before" events
if Assigned(fOnBeforeProcessDelta)
then fOnBeforeProcessDelta(Self, aDelta)
else if Assigned(fBusinessRules)
then fBusinessRules.BeforeProcessDelta(Self, aDelta);
// Prepares the commands
if not fHasReducedDelta then begin
SetupCommands(aConnection, aDelta, inscmd, updcmd, delcmd, refds);
CreateMappings(aDelta, insmap, inscmd);
CreateMappings(aDelta, updmap, updcmd);
CreateMappings(aDelta, delmap, delcmd);
CreateMappings(aDelta, refmap, refds);
FDynamicWhereInRefreshDataset:=False;
// dynwhere
if (refds <> nil) and refds.SQLContainsDynamicWhere then begin
FDynamicWhereInRefreshDataset := True;
refds.DynamicWhere.Expression:=nil;
for i := 0 to aDelta.KeyFieldCount - 1 do begin
with refds.Params.Add do begin
ParamType:=daptInput;
Name:=lDynWhereParamPrefix+IntToStr(i);
end;
with refds.DynamicWhere do begin
lexpr:= NewBinaryExpression(NewField('',aDelta.KeyFieldNames[i]),NewParameter(lDynWhereParamPrefix+IntToStr(i)),dboEqual);
if Expression = nil then
Expression := lexpr
else
Expression:= NewBinaryExpression(Expression,lexpr,dboEqual);
end;
end;
end;
end;
// Processes the delta
todelete := TList.Create;
try
for i := 0 to (aDelta.Count - 1) do begin
change := aDelta[i];
fCurrentChange := i; // Do NOT remove!!!
canremove := false;
autoincvalue := -1;
ok := change.ChangeType in ChangeTypes; // Filters
try
// Even if there might not be a command associated, the user might want to do something with this
// We just give an override chance here
if Assigned(fOnBeforeProcessChange) then
fOnBeforeProcessChange(Self, change.ChangeType, aDelta[i], ok)
else if Assigned(fBusinessRules) then
fBusinessRules.BeforeProcessChange(Self, change.ChangeType, aDelta[i], ok);
if ok then begin
// Selects the right command
mapptr := nil;
if not fHasReducedDelta then begin
case change.ChangeType of
ctInsert: begin
currcmd := inscmd;
mapptr := @insmap;
end;
ctUpdate: begin
currcmd := updcmd;
mapptr := @updmap;
end;
ctDelete: begin
currcmd := delcmd;
mapptr := @delmap;
end;
end;
end else begin
SetupCommands(aConnection, Change, currCmd);
CreateMappings(aDelta, insmap, currCmd);
mapptr := @insmap;
end;
// Assigns the values of the current change
if (currcmd <> nil) then
for x := 0 to (currcmd.Params.Count - 1) do
if (mapptr^[x].DeltaIndex >= 0) then begin
case mapptr^[x].MappingType of
mtOldValue: val := change.OldValues[mapptr^[x].DeltaIndex];
else val := change.NewValues[mapptr^[x].DeltaIndex];
end;
if (currcmd.Params[x].DataType in [datAutoinc, datLargeAutoInc]) and (usegenerators) and (change.ChangeType=ctInsert) and (mapptr^[x].MappingType=mtNewValue) then begin
// Gets the next generator values from the DB. This is for DBs such as IB or Oracle which lack autoinc fields
if (autoincvalue<>-1) then raise Exception.Create('Multiple auto incremental fields not supported');
parname := currcmd.Params[x].Name;
change.OldValueByName[parname] := val;
autoincvalue := (aConnection as IDAUseGenerators).GetNextAutoinc(currcmd.Params[x].GeneratorName);
currcmd.Params[x].Value := autoincvalue;
change.RefreshedByServer := TRUE;
if not Assigned(refds) then begin
change.NewValueByName[parname] := autoincvalue;
end;
end
else currcmd.Params[x].Value := val;
end;
// Gives the user a chance to modify it before execution
if Assigned(fOnProcessChange) then
fOnProcessChange(Self, change.ChangeType, change, currcmd)
else if Assigned(fBusinessRules) then
fBusinessRules.ProcessChange(Self, change.ChangeType, change, currcmd);
// Executes it
if (currcmd <> nil)
then rowsaffected := currcmd.Execute
else rowsaffected := 0;
canremove := FALSE;
// IBX returns -1 even if updates are successful! This started to happen after I plugged the GetNextAutoinc call above.
// If records fail, an exception is usually generated so this check for <>0 should be sufficient for all cases...
// DO NOT CHANGE this to >0 !!!!
if (rowsaffected<>0) or (poIgnoreRowsAffected in fProcessorOptions) then begin
if (change.ChangeType<>ctDelete) and (refds<>NIL) then begin
RefreshDeltaChange(aConnection, refds, aDelta, change, autoincvalue);
change.RefreshedByServer := TRUE;
end;
canremove := not change.RefreshedByServer;
change.Status := csResolved;
end
else begin
canremove := FALSE;
change.Status := csFailed;
change.Message := 'No rows were affected by this update';
end;
// After processing gives the user a last chance to update the change and
// optionally set it so that it goes back to the client (i.e. updated values)
if Assigned(fOnAfterProcessChange)
then fOnAfterProcessChange(Self, change, ok, canremove)
else if Assigned(fBusinessRules)
then fBusinessRules.AfterProcessChange(Self, change, ok, canremove)
end;
except
on E: Exception do begin
change.Status := csFailed;
change.Message := E.Message;
canremove := FALSE;
if Assigned(fOnProcessError) then
fOnProcessError(Self, change.ChangeType, change, currcmd, canremove, E)
else if Assigned(fBusinessRules) then begin
fBusinessRules.ProcessError(Self, change.ChangeType, change, currcmd, canremove, E);
if FRaiseExceptionAtError then raise;
end
else
raise EDAApplyUpdateFailed.Create(change, E);
end;
end;
if canremove then todelete.Add(change);
end;
for i := 0 to todelete.Count - 1 do
aDelta.RemoveChange(TDADeltaChange(todelete[i]));
if Assigned(fOnAfterProcessDelta) then
fOnAfterProcessDelta(Self, aDelta)
else if Assigned(fBusinessRules) then
fBusinessRules.AfterProcessDelta(Self, aDelta)
finally
todelete.Free;
end;
end;
procedure TDABusinessProcessor.SetDeleteCommandName(const Value: string);
begin
fDeleteCommandName := Trim(Value);
end;
procedure TDABusinessProcessor.SetInsertCommandName(const Value: string);
begin
fInsertCommandName := Trim(Value);
end;
procedure TDABusinessProcessor.SetUpdateCommandName(const Value: string);
begin
fUpdateCommandName := Trim(Value);
end;
procedure TDABusinessProcessor.SetSchema(const Value: TDASchema);
begin
fSchema := Value;
if (Value <> nil) then fSchema.FreeNotification(Self);
end;
procedure TDABusinessProcessor.SetReferencedDataset(const Value: string);
begin
fReferencedDataset := Value;
end;
procedure TDABusinessProcessor.ProcessDelta(aDataTable: TDADataTable;
ChangeTypes: TDAChangeTypes; const aConnection : IDAConnection = NIL);
var
conn: IDAConnection;
begin
with aDataTable do begin
Check(LocalSchema = nil, 'Datatable doesn''t reference any schema');
Check(LocalSchema.ConnectionManager = nil, 'Datatable''s schema doesn''t reference a connection manager');
if aConnection<>NIL
then conn := aConnection
else conn := LocalSchema.ConnectionManager.NewConnection(LocalConnection);
ProcessDelta(conn, aDataTable.Delta, ChangeTypes);
end;
end;
function TDABusinessProcessor.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
result := inherited QueryInterface(IID, Obj);
if (result <> S_OK) and Assigned(fBusinessRules) then begin
// Users might introduce specific interfaces at the business rule level
// This allows to type cast the data table to any additional business oriented interface
// they decide to create.
result := fBusinessRules.QueryInterface(IID, Obj);
end;
end;
procedure TDABusinessProcessor.SetBusinessRulesID(const Value: string);
var
bizclass: TDABusinessProcessorRulesClass;
begin
if (Value = fBusinessRulesID) then Exit;
if Assigned(fBusinessRules) then begin
fBusinessRules.Detach(Self);
FreeAndNIL(fBusinessRules);
end;
fBusinessRulesID := Trim(Value);
if (fBusinessRulesID <> '') and not (csDesigning in ComponentState) then begin
Check(not FindBusinessProcessorRules(Value, bizclass), Name+'. Invalid BusinessRulesID "%s"', [Value]);
fBusinessRules := bizclass.Create(Self);
fBusinessRules.Attach(Self);
end;
end;
procedure TDABusinessProcessor.SetRefreshDataset(const Value: string);
begin
fRefreshDataset := Trim(Value);
end;
procedure TDABusinessProcessor.Notification(AComponent: TComponent;
Operation: TOperation);
begin
inherited;
if (Operation = opRemove) then begin
if (AComponent = fSchema) then fSchema := nil;
end;
end;
procedure TDABusinessProcessor.CheckProperties;
begin
Check(Schema = nil, Name + '.Schema must be assinged.');
end;
procedure TDABusinessProcessor.SetupCommandsWithMapping(
const aConnection: IDAConnection;
const aChange: TDADeltaChange;
out anCmd: IDASQLCommand;
out aParamMapping: TDAParamMappingArray);
var
lSql: string;
lDataset: TDADataset;
lRefStatement: TDAStatement;
lUnionTable: TDAUnionDataTable;
lVar: Variant;
lSourceTableIdx: Integer;
lUnionSourceTable : TDAUnionSourceTable;
lSourceTable : TDADataset;
lSourceTableName: String;
lSourceTableMapping: TDAColumnMappingCollection;
begin
anCmd := nil;
lRefStatement := nil;
lSourceTableMapping := nil;
CheckProperties;
lDataset := TDADataset(fSchema.FindDataset(fReferencedDataset));
// If Union table ...
if lDataset is TDAUnionDataTable then begin
lUnionTable := TDAUnionDataTable(lDataset);
lVar := aChange.NewValueByName[def_SourceTableFieldName];
if (VarIsNull(lVar)) then begin
lSourceTableName := lUnionTable.DefaultSourceTable;
lUnionSourceTable := TDAUnionSourceTable(lUnionTable.SourceTables.ItemByName(lSourceTableName));
end else begin
lSourceTableIdx := lVar;
lUnionSourceTable := lUnionTable.SourceTables[lSourceTableIdx];
lSourceTableName := lUnionSourceTable.Name;
end;
lSourceTableMapping := lUnionSourceTable.ColumnMappings;
lSourceTable := TDADataset(fSchema.Datasets.FindItem(lSourceTableName));
if Assigned(lSourceTable) then begin
lDataset := lSourceTable;
lRefStatement := TDAStatement(lSourceTable.Statements.FindItem(aConnection.Name));
if (lRefStatement = nil) then lRefStatement := lSourceTable.Statements.StatementByName(Schema.ConnectionManager.GetDefaultConnectionName);
end;
end else
// If plain table ...
if lDataset is TDADataset then begin
lRefStatement := TDAStatement(lDataset.Statements.FindItem(aConnection.Name));
if (lRefStatement = nil) then lRefStatement := lDataset.Statements.StatementByName(Schema.ConnectionManager.GetDefaultConnectionName);
// If no dataset found
end else
RaiseError(Name + '''s referenced dataset is not speficied or does not exist. Cannot generate SQL');
lSql := GenerateSQL(aChange.ChangeType, aChange, lDataset, aChange.Delta, lRefStatement, aConnection);
anCmd := aConnection.NewCommand(lSql, stSQL);
SetupParameters(anCmd, lDataset);
if anCmd <> nil then anCmd.Prepared:=True;
CreateMappings(aChange.Delta, aParamMapping, anCmd, lSourceTableMapping);
end;
procedure TDABusinessProcessor.SetupCommands(
const aConnection: IDAConnection; const aChange: TDADeltaChange;
out anCmd: IDASQLCommand);
var
sql: string;
ds: TDADataset;
refstmt: TDAStatement;
begin
anCmd:=nil;
refstmt := nil;
CheckProperties;
ds := TDADataset(fSchema.Datasets.FindItem(fReferencedDataset));
if (ds <> nil) then begin
refstmt := fSchema.FindCommandStatement(aConnection,ds,aConnection.Name);
// refstmt := TDAStatement(ds.Statements.FindItem(aConnection.Name));
// if (refstmt = nil) then refstmt := ds.Statements.StatementByName(Schema.ConnectionManager.GetDefaultConnectionName);
end
else
RaiseError(Name + '''s referenced dataset is not speficied or does not exist. Cannot generate SQL');
sql := GenerateSQL(aChange.ChangeType, aChange, ds,aChange.Delta ,refstmt, aConnection);
anCmd := aConnection.NewCommand(sql, stSQL);
SetupParameters(anCmd, ds);
if anCmd <> nil then anCmd.Prepared:=True;
end;
{ TDABusinessProcessorRules }
procedure TDABusinessProcessorRules.Attach(
aBusinessProcessor: TDABusinessProcessor);
begin
end;
constructor TDABusinessProcessorRules.Create(aBusinessProcessor: TDABusinessProcessor);
begin
inherited Create;
fBusinessProcessor := aBusinessProcessor;
end;
procedure TDABusinessProcessorRules.Detach(
aBusinessProcessor: TDABusinessProcessor);
begin
end;
procedure TDABusinessProcessorRules.AfterProcessChange(
Sender: TDABusinessProcessor; aChange: TDADeltaChange;
Processed: boolean; var CanRemoveFromDelta: boolean);
begin
end;
procedure TDABusinessProcessorRules.AfterProcessDelta(
Sender: TDABusinessProcessor; const aDelta: IDADelta);
begin
end;
procedure TDABusinessProcessorRules.BeforeProcessChange(
Sender: TDABusinessProcessor; aChangeType: TDAChangeType;
aChange: TDADeltaChange; var ProcessChange: boolean);
begin
end;
procedure TDABusinessProcessorRules.BeforeProcessDelta(
Sender: TDABusinessProcessor; const aDelta: IDADelta);
begin
end;
procedure TDABusinessProcessorRules.GenerateSQL(
Sender: TDABusinessProcessor; ChangeType: TDAChangeType;
const ReferencedStatement: TDAStatement; const aDelta: IDADelta;
var SQL: string);
begin
end;
procedure TDABusinessProcessorRules.ProcessChange(
Sender: TDABusinessProcessor; aChangeType: TDAChangeType;
aChange: TDADeltaChange; const aCommand: IDASQLCommand);
begin
end;
procedure TDABusinessProcessorRules.ProcessError(
Sender: TDABusinessProcessor; aChangeType: TDAChangeType;
aChange: TDADeltaChange; const aCommand: IDASQLCommand;
var CanRemoveFromDelta: boolean; Error: Exception);
begin
end;
//----------
procedure TDABusinessProcessorRules.NotSupportedByBusinessProcessor;
begin
RaiseError('This method is not supported on the Business Processor Rule, but only on the client.');
end;
procedure TDABusinessProcessorRules.Append;
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Cancel;
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Delete;
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Edit;
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.First;
begin
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.GetBOF: Boolean;
begin
result := false; { to avoid warning; }
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.GetEOF: Boolean;
begin
result := false; { to avoid warning; }
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.GetRecordCount: Integer;
begin
result := -1; { to avoid warning; }
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Insert;
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Last;
begin
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.Locate(const aKeyFields: String; const aKeyValues: Variant; aOptions: TLocateOptions): Boolean;
begin
result := false; { to avoid warning; }
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Next;
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Post;
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Prior;
begin
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.GetDetailOptions: TDADetailOptions;
begin
result := []
end;
function TDABusinessProcessorRules.GetMasterOptions: TDAMasterOptions;
begin
result := []
end;
procedure TDABusinessProcessorRules.SetDetailOptions(
Value: TDADetailOptions);
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.SetMasterOptions(
Value: TDAMasterOptions);
begin
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.GetRecNo: integer;
begin
result := -1; { to avoid warning; }
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.SetRecNo(Value: integer);
begin
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.GetIsEmpty: boolean;
begin
result := FALSE;
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.GetState: TDatasetState;
begin
result := dsBrowse
end;
function TDABusinessProcessorRules.Lookup(const KeyFields: string;
const KeyValues: Variant; const ResultFields: string): Variant;
begin
Result:=Null;
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.ClearField(
const FieldIndexOrName: Variant);
begin
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.IsFieldNull(
const FieldIndexOrName: Variant): boolean;
begin
result := FALSE;
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.GetDataTable: TDADataTable;
begin
result := NIL;
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Close;
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessorRules.Open;
begin
NotSupportedByBusinessProcessor();
end;
function TDABusinessProcessorRules.GetActive: boolean;
begin
NotSupportedByBusinessProcessor();
result:=FALSE
end;
procedure TDABusinessProcessorRules.SetActive(const Value: boolean);
begin
NotSupportedByBusinessProcessor();
end;
procedure TDABusinessProcessor.ProcessDeltaForUnion(const aConnection: IDAConnection;
const aDelta: IDADelta;
ChangeTypes: TDAChangeTypes = AllChanges);
var
i, x, rowsaffected: integer;
canremove, ok: boolean;
refds : IDADataset;
insmap: TDAParamMappingArray;
mapptr: ^TDAParamMappingArray;
change: TDADeltaChange;
todelete: TList;
val : variant;
parname : string;
autoincvalue: integer;
usegenerators : boolean;
currcmd: IDASQLCommand;
lCommands: TDADeltaProcessorItemCollection;
lUnionTable: TDAUnionDataTable;
lSourceTableName: String;
lProcessorItem: TDADeltaProcessorItem;
lVar: Variant;
begin
Check(not Assigned(aDelta), 'Cannot process a NIL delta');
if (aDelta.Count=0) then Exit;
fCurrentDelta := aDelta.GetDelta;
fCurrentChange := 0;
usegenerators := Supports(aConnection, IDAUseGenerators);
// Fires the "before" events
if Assigned(fOnBeforeProcessDelta)
then fOnBeforeProcessDelta(Self, aDelta)
else if Assigned(fBusinessRules)
then fBusinessRules.BeforeProcessDelta(Self, aDelta);
lUnionTable := fSchema.UnionDataTables.ItemByName(fReferencedDataset) as TDAUnionDataTable;
//lSourceTableFieldIdx := lUnionTable.Fields.FieldByName(def_SourceTableFieldName).Index;
try
// Prepares the commands
if not fHasReducedDelta then begin
SetupCommands(aConnection, aDelta, lCommands);
end;
// Processes the delta
todelete := TList.Create;
try
for i := 0 to (aDelta.Count - 1) do begin
change := aDelta[i];
fCurrentChange := i; // Do NOT remove!!!
canremove := false;
autoincvalue := -1;
ok := change.ChangeType in ChangeTypes; // Filters
try
// Even if there might not be a command associated, the user might want to do something with this
// We just give an override chance here
if Assigned(fOnBeforeProcessChange) then
fOnBeforeProcessChange(Self, change.ChangeType, aDelta[i], ok)
else if Assigned(fBusinessRules) then
fBusinessRules.BeforeProcessChange(Self, change.ChangeType, aDelta[i], ok);
if ok then begin
// Selects the right command
mapptr := nil;
if not fHasReducedDelta then begin
// Define appripriate source table and get its commands
//lVar := aDelta.Changes[i].NewValues[lSourceTableFieldIdx];
if (aDelta.Changes[i].ChangeType = ctInsert) then
lVar := aDelta.Changes[i].NewValueByName[def_SourceTableFieldName]
else
lVar := aDelta.Changes[i].OldValueByName[def_SourceTableFieldName];
if (VarIsNull(lVar)) then
lSourceTableName := lUnionTable.DefaultSourceTable
else
lSourceTableName := lUnionTable.SourceTables[lVar].Name;
lProcessorItem := TDADeltaProcessorItem(lCommands.FindItem(lSourceTableName));
case change.ChangeType of
ctInsert: begin
currcmd := lProcessorItem.fInsertCommand;
mapptr := @lProcessorItem.fInsertCommandMapping;
end;
ctUpdate: begin
currcmd := lProcessorItem.fUpdateCommand;
mapptr := @lProcessorItem.fUpdateCommandMapping;
end;
ctDelete: begin
currcmd := lProcessorItem.fDeleteCommand;
mapptr := @lProcessorItem.fDeleteCommandMapping;
end;
end;
end else begin
SetupCommandsWithMapping(aConnection, Change, currCmd, insmap);
mapptr := @insmap;
end;
// Assigns the values of the current change
if (currcmd <> nil) then
for x := 0 to (currcmd.Params.Count - 1) do
if (mapptr^[x].DeltaIndex >= 0) then begin
case mapptr^[x].MappingType of
mtOldValue: val := change.OldValues[mapptr^[x].DeltaIndex];
else val := change.NewValues[mapptr^[x].DeltaIndex];
end;
if (currcmd.Params[x].DataType in [datAutoinc, datLargeAutoInc]) and (usegenerators) and (change.ChangeType=ctInsert) and (mapptr^[x].MappingType=mtNewValue) then begin
// Gets the next generator values from the DB. This is for DBs such as IB or Oracle which lack autoinc fields
if (autoincvalue<>-1) then raise Exception.Create('Multiple auto incremental fields not supported');
parname := currcmd.Params[x].Name;
change.OldValueByName[parname] := val;
autoincvalue := (aConnection as IDAUseGenerators).GetNextAutoinc(currcmd.Params[x].GeneratorName);
currcmd.Params[x].Value := autoincvalue;
change.RefreshedByServer := TRUE;
if not Assigned(refds) then begin
change.NewValueByName[parname] := autoincvalue;
end;
end
else currcmd.Params[x].Value := val;
end;
// Gives the user a chance to modify it before execution
if Assigned(fOnProcessChange) then
fOnProcessChange(Self, change.ChangeType, change, currcmd)
else if Assigned(fBusinessRules) then
fBusinessRules.ProcessChange(Self, change.ChangeType, change, currcmd);
// Executes it
if (currcmd <> nil)
then rowsaffected := currcmd.Execute
else rowsaffected := 0;
canremove := FALSE;
// IBX returns -1 even if updates are successful! This started to happen after I plugged the GetNextAutoinc call above.
// If records fail, an exception is usually generated so this check for <>0 should be sufficient for all cases...
// DO NOT CHANGE this to >0 !!!!
if (rowsaffected<>0) or (poIgnoreRowsAffected in fProcessorOptions) then begin
if (change.ChangeType<>ctDelete) and (refds<>NIL) then begin
RefreshDeltaChange(aConnection, refds, aDelta, change, autoincvalue);
change.RefreshedByServer := TRUE;
end;
canremove := not change.RefreshedByServer;
change.Status := csResolved;
end
else begin
canremove := FALSE;
change.Status := csFailed;
change.Message := 'No rows were affected by this update';
end;
// After processing gives the user a last chance to update the change and
// optionally set it so that it goes back to the client (i.e. updated values)
if Assigned(fOnAfterProcessChange)
then fOnAfterProcessChange(Self, change, ok, canremove)
else if Assigned(fBusinessRules)
then fBusinessRules.AfterProcessChange(Self, change, ok, canremove)
end;
except
on E: Exception do begin
change.Status := csFailed;
change.Message := E.Message;
canremove := FALSE;
if Assigned(fOnProcessError) then
fOnProcessError(Self, change.ChangeType, change, currcmd, canremove, E)
else if Assigned(fBusinessRules) then begin
fBusinessRules.ProcessError(Self, change.ChangeType, change, currcmd, canremove, E);
if FRaiseExceptionAtError then raise;
end
else
raise EDAApplyUpdateFailed.Create(change, E);
end;
end;
if canremove then todelete.Add(change);
end;
for i := 0 to todelete.Count - 1 do
aDelta.RemoveChange(TDADeltaChange(todelete[i]));
if Assigned(fOnAfterProcessDelta) then
fOnAfterProcessDelta(Self, aDelta)
else if Assigned(fBusinessRules) then
fBusinessRules.AfterProcessDelta(Self, aDelta)
finally
todelete.Free;
end;
finally
lCommands.Free();
end;
end;
procedure TDABusinessProcessor.SetupCommands(const aConnection: IDAConnection;
const aDelta: IDADelta; out aCommandsList : TDADeltaProcessorItemCollection);
var i: Integer;
refstmt: TDAStatement;
lUnionTable: TDAUnionDataTable;
lSourceTable: TDADataset;
lSourceTableName: String;
lSourceTableIdx: integer;
lSourceTableMapping: TDAColumnMappingCollection;
lProcessorItem: TDADeltaProcessorItem;
lSql: String;
lVar: Variant;
begin
//lUnionTable := nil;
refstmt := nil;
CheckProperties;
aCommandsList := TDADeltaProcessorItemCollection.Create(Self);
lUnionTable := fSchema.UnionDataTables.ItemByName(fReferencedDataset) as TDAUnionDataTable;
if not Assigned(lUnionTable) then
RaiseError(Name + '''s referenced dataset is not speficied or does not exist. Cannot generate SQL');
// for each change in delta
for i:= 0 to aDelta.Count-1 do begin
case aDelta.Changes[i].ChangeType of
ctInsert: lVar := aDelta.Changes[i].NewValueByName[def_SourceTableFieldName];
ctUpdate, ctDelete: lVar := aDelta.Changes[i].OldValueByName[def_SourceTableFieldName];
end;
if (VarIsNull(lVar)) then begin
lSourceTableName := lUnionTable.DefaultSourceTable;
lSourceTableIdx := lUnionTable.SourceTables.ItemByName(lSourceTableName).Index;
end else begin
lSourceTableIdx := lVar;
lSourceTableName := lUnionTable.SourceTables[lSourceTableIdx].Name;
end;
lSourceTableMapping := lUnionTable.SourceTables[lSourceTableIdx].ColumnMappings;
lSourceTable := TDADataset(fSchema.Datasets.FindItem(lSourceTableName));
if Assigned(lSourceTable) then begin
refstmt := TDAStatement(lSourceTable.Statements.FindItem(aConnection.Name));
if (refstmt = nil) then refstmt := lSourceTable.Statements.StatementByName(Schema.ConnectionManager.GetDefaultConnectionName);
end;
lProcessorItem := TDADeltaProcessorItem(aCommandsList.FindItem(lSourceTableName));
if not Assigned(lProcessorItem) then begin
lProcessorItem := aCommandsList.Add();
lProcessorItem.fName := lSourceTableName;
end;
// Assemble Refresh dataset ...
if (fRefreshDataset <> '') and (not Assigned(lProcessorItem.fRefreshDataset)) then begin
lProcessorItem.fRefreshDataset := fSchema.NewDataset(aConnection, fRefreshDataset, [], [], FALSE);
if (lProcessorItem.fRefreshDataset = nil) and (poAutoGenerateRefreshDataset in fProcessorOptions) then begin
lProcessorItem.fRefreshDataset := GenerateRefreshDataset(lSourceTable, aDelta, refstmt, aConnection);
if (lProcessorItem.fRefreshDataset <> NIL) then SetupParameters(lProcessorItem.fRefreshDataset, lSourceTable);
end;
if Assigned(lProcessorItem.fRefreshDataset) then
lProcessorItem.fRefreshDataset.Prepared := True;
end;
// Assemble Insert command ...
if ((aDelta.Changes[i].ChangeType = ctInsert) and (not Assigned(lProcessorItem.fInsertCommand))) then begin
// Tries to locate the specified commands
if (fInsertCommandName <> '') then
lProcessorItem.fInsertCommand := fSchema.NewCommand(aConnection, fInsertCommandName);
// Auto generates the SQL for the undefined commands
if (lProcessorItem.fInsertCommand = nil) and (poAutoGenerateInsert in fProcessorOptions) then begin
lSql := GenerateSQL(ctInsert, nil, lSourceTable, aDelta, refstmt, aConnection);
lProcessorItem.fInsertCommand := aConnection.NewCommand(lSql, stSQL);
SetupParameters(lProcessorItem.fInsertCommand, lSourceTable);
end;
if Assigned(lProcessorItem.fInsertCommand) then begin
CreateMappings(aDelta, lProcessorItem.fInsertCommandMapping , lProcessorItem.fInsertCommand, lSourceTableMapping);
lProcessorItem.fInsertCommand.Prepared := True;
end;
end;
// Assemble Update command ...
if ((aDelta.Changes[i].ChangeType = ctUpdate) and (not Assigned(lProcessorItem.fUpdateCommand))) then begin
// Tries to locate the specified commands
if (fUpdateCommandName <> '') then
lProcessorItem.fUpdateCommand := fSchema.NewCommand(aConnection, fUpdateCommandName);
// Auto generates the SQL for the undefined commands
if (lProcessorItem.fUpdateCommand = nil) and (poAutoGenerateUpdate in fProcessorOptions) then begin
lSql := GenerateSQL(ctUpdate, nil, lSourceTable, aDelta, refstmt, aConnection);
lProcessorItem.fUpdateCommand := aConnection.NewCommand(lSql, stSQL);
SetupParameters(lProcessorItem.fUpdateCommand, lSourceTable);
end;
if Assigned(lProcessorItem.fUpdateCommand) then begin
CreateMappings(aDelta, lProcessorItem.fUpdateCommandMapping , lProcessorItem.fUpdateCommand, lSourceTableMapping);
lProcessorItem.fUpdateCommand.Prepared := True;
end;
end;
// Assemble Delete command ...
if ((aDelta.Changes[i].ChangeType = ctDelete) and (not Assigned(lProcessorItem.fDeleteCommand))) then begin
// Tries to locate the specified commands
if (fDeleteCommandName <> '') then
lProcessorItem.fDeleteCommand := fSchema.NewCommand(aConnection, fDeleteCommandName);
// Auto generates the SQL for the undefined commands
if (lProcessorItem.fDeleteCommand = nil) and (poAutoGenerateDelete in fProcessorOptions) then begin
lSql := GenerateSQL(ctDelete, nil, lSourceTable, aDelta, refstmt, aConnection);
lProcessorItem.fDeleteCommand := aConnection.NewCommand(lSql, stSQL);
SetupParameters(lProcessorItem.fDeleteCommand, lSourceTable);
end;
if Assigned(lProcessorItem.fDeleteCommand) then begin
CreateMappings(aDelta, lProcessorItem.fDeleteCommandMapping , lProcessorItem.fDeleteCommand, lSourceTableMapping);
lProcessorItem.fDeleteCommand.Prepared := True;
end;
end;
end;
end;
{ TDADeltaProcessorItemCollection }
constructor TDADeltaProcessorItemCollection.Create(aOwner: TComponent);
begin
inherited Create(aOwner, TDADeltaProcessorItem);
end;
function TDADeltaProcessorItemCollection.GetItem(Index: integer): TDADeltaProcessorItem;
begin
result := TDADeltaProcessorItem(inherited Items[Index])
end;
procedure TDADeltaProcessorItemCollection.SetItem(Index: integer; const Value: TDADeltaProcessorItem);
begin
Items[Index].Assign(Value);
end;
function TDADeltaProcessorItemCollection.Add: TDADeltaProcessorItem;
begin
result := TDADeltaProcessorItem(inherited Add);
end;
function TDADeltaProcessorItemCollection.ItemByName(const aName: String): TDADeltaProcessorItem;
begin
result := TDADeltaProcessorItem(inherited ItemByName(aName));
end;
initialization
_bizdeltachanges := TStringList.Create;
_bizdeltachanges.Sorted := TRUE;
finalization
_bizdeltachanges.Free;
end.