Componentes.Terceros.RemObj.../official/5.0.23.613/Data Abstract for Delphi/Source/DARemoteService_Impl.pas

1088 lines
41 KiB
ObjectPascal

unit DARemoteService_Impl {$IFNDEF FPC}deprecated{$ENDIF};
{----------------------------------------------------------------------------}
{ 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. }
{----------------------------------------------------------------------------}
{----------------------------------------------------------------------------}
{ LEGACY NOTE: }
{ As of v4.0, future development of this unit has been discontinued, and }
{ new featureswill be impleentd in DataAbstractService_Impl.pas, instead. }
{ }
{ When applying fixes to this unit, please propagate them to the new unit }
{ as well, where needed. }
{----------------------------------------------------------------------------}
{$I DataAbstract.inc}
interface
uses
Classes, SysUtils,
{$IFDEF DELPHI5}Forms, {$ENDIF}
uRORemoteDataModule, uROClientIntf, uROSessions, uROClasses, uROTypes,
uDAClasses, uDAInterfaces, uDADataTable, uDABusinessProcessor, uDACache, uDADelta, uDADataStreamer,
uDADataTableReferenceCollection, DataAbstract3_Intf;
type
{ Types }
TDARemoteService = class;
{ Events }
TDAAcquireConnectionEvent = procedure(Sender: TDARemoteService; var ConnectionName: string) of object;
TDAConnectionAcquiredEvent = procedure(Sender: TDARemoteService; const ConnectionName: string; const AcquiredConnection: IDAConnection) of object;
TDAAcquireConnectionFailureEvent = procedure(Sender: TDARemoteService; const ConnectionName: string; Error: Exception) of object;
TDAGetDatasetSchemaEvent = procedure(const Dataset: IDADataset) of object;
TDAGetDatasetDataEvent = procedure(const Dataset: IDADataset; const IncludeSchema: Boolean; const MaxRecords: Integer) of object;
TDAOnBusinessProcessorAutoCreated = procedure(Sender : TRORemoteDataModule; BusinessProcessor : TDABusinessProcessor) of object;
TDABeforeExecuteCommandEvent = procedure(Sender : TDARemoteService; const aCommand : IDASQLCommand) of object;
TDAAfterExecuteCommandEvent = procedure(Sender : TDARemoteService; const aCommand : IDASQLCommand; RowsAffacted : integer) of object;
TDAConnectionReleasedEvent = procedure(Sender: TDARemoteService; const ConnectionName: string) of object;
TDAGetSchemaAsXMLEvent = procedure(Sender: TDARemoteService; var SchemaXML : string) of object;
TDAProcessDeltasEvent = procedure(Sender : TDARemoteService; DeltaStructs : TDADeltaStructList) of object;
TDAProcessDeltasErrorEvent = procedure(Sender : TDARemoteService; DeltaStructs : TDADeltaStructList; Error : Exception; var DoRaise : boolean) of object;
TDAOnGetCachedDataset = procedure(Sender : TDARemoteService; const aDatasetName : string; aDataStream : TStream) of object;
TDAGetDatasetDataValidationEvent = procedure(Sender: TDARemoteService;
const aConnection: IDAConnection;
const aDatasetName: string;
const aParamNames: array of string;
const aParamValues : array of variant;
aSchema: TDASchema;
var Allowed : boolean) of object;
TDAUpdateDataTransactionEvent = procedure(Sender: TDARemoteService; var UseDefaultTransactionLogic: Boolean) of object;
TDAAfterProcessTransactionAction = (pptaNone, pptaRollback, pptaCommit);
{ TDARemoteService }
TDARemoteServiceOption = (rsoProcessDeltasWithoutUpdateRules);
TDARemoteServiceOptions = set of TDARemoteServiceOption;
TDARemoteService = class(TRORemoteDataModule, IDARemoteService)
private
fServiceSchema: TDASchema;
fStreamedAcquireConnection,
fAcquireConnection: boolean;
fConnectionName: string;
fOnBeforeAcquireConnection: TDAAcquireConnectionEvent;
fOnAfterAcquireConnection: TDAConnectionAcquiredEvent;
fOnAfterReleaseConnection: TDAConnectionReleasedEvent;
fOnBeforeReleaseConnection: TDAConnectionAcquiredEvent;
fConnection: IDAConnection;
fServiceAdapter: TDADataStreamer;
fOnAcquireConnectionFailure: TDAAcquireConnectionFailureEvent;
fOnAfterGetDatasetData: TDAGetDatasetDataEvent;
fOnBeforeGetDatasetData: TDAGetDatasetDataEvent;
fOnAfterGetDatasetSchema: TDAGetDatasetSchemaEvent;
fOnBeforeGetDatasetSchema: TDAGetDatasetSchemaEvent;
fAutoCreateBusinessProcessors: boolean;
fAllowExecuteSQLCommand: boolean;
fAllowWhereSQL: boolean;
fOnBusinessProcessorAutoCreated: TDAOnBusinessProcessorAutoCreated;
fOnBeforeExecuteCommand: TDABeforeExecuteCommandEvent;
fOnAfterExecuteCommand: TDAAfterExecuteCommandEvent;
fOnGetSchemaAsXML: TDAGetSchemaAsXMLEvent;
fGetDatasetDataValidation: TDAGetDatasetDataValidationEvent;
fAfterProcessTransactionAction: TDAAfterProcessTransactionAction;
fOnUpdateDataBeginTransaction : TDAUpdateDataTransactionEvent;
fOnUpdateDataCommitTransaction : TDAUpdateDataTransactionEvent;
fOnUpdateDataRollBackTransaction : TDAUpdateDataTransactionEvent;
fOnBeforeProcessDeltas : TDAProcessDeltasEvent;
fOnAfterProcessDeltas: TDAProcessDeltasEvent;
fOnProcessDeltasError: TDAProcessDeltasErrorEvent;
fExportedDataTables: TDADataTableReferenceCollection;
fCache: TDACache;
fCacheElements: TDACacheElementCollection;
fOnGetCachedDataset: TDAOnGetCachedDataset;
fOptions: TDARemoteServiceOptions;
function TriggerTransactionEvent(aEvent: TDAUpdateDataTransactionEvent): Boolean;
procedure SetServiceSchema(const Value: TDASchema);
procedure SetAcquireConnection(const Value: boolean);
procedure SetConnectionName(const Value: string);
procedure SetServiceAdapter(const Value: TDADataAdapter);
function UnpackDeltas(const DeltaStream: Binary; DeltaStructList : TDADeltaStructList): integer;
procedure SetExportedDataTables(const Value: TDADataTableReferenceCollection);
procedure MergeDatatablesToSchema(aList : TList);
procedure SetCache(const Value: TDACache);
procedure SetCacheElements(const Value: TDACacheElementCollection);
procedure SetConnection(const aValue: IDAConnection);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
procedure Loaded; override;
procedure CheckObjects(const aConnection: IDAConnection;
aSchema: TDASchema; anAdapter: TDADataAdapter;
CheckConnection : boolean = TRUE;
CheckSchema : boolean = TRUE;
CheckAdapter : boolean = TRUE);
{ Internal }
procedure DoOnActivate(aClientID: TGUID; const aMessage: IROMessage); override;
procedure DoOnDeactivate(aClientID: TGUID); override;
function DoGetDatasetData(const Stream: TStream;
const aConnection: IDAConnection;
const aDatasetName: string;
const aParamNames: array of string;
const aParamValues : array of variant;
const UserFilter : string;
aSchema: TDASchema;
anAdapter: TDADataAdapter;
someOptions: TDAWriteOptions;
MaxRecords: integer): integer; virtual;
function CreateParamString(const ParamNames: array of string; const ParamValues: array of Variant): string;
function GetDatasetData(const DatasetName: string;
const ParamNames: array of string;
const ParamValues: array of Variant;
const IncludeSchema: Boolean = FALSE;
const MaxRecords: Integer = -1): Binary; overload;
function GetDatasetData(const DatasetName: string;
const IncludeSchema: Boolean = FALSE;
const MaxRecords: Integer = -1): Binary; overload;
{ IDARemoteService }
function GetDatasetSchema(const aDatasetName: string): Binary; virtual;
function GetDatasetData(const DatasetName: string;
const Params: string;
const IncludeSchema: Boolean;
const MaxRecords: Integer): Binary; overload; virtual;
function UpdateData(const Delta: Binary): Binary; virtual;
function ExecuteSQLCommand(const SQL: string): Integer; virtual;
function GetSchemaAsXML: String; virtual;
function GetDatasetDataEx(const DatasetName: String;
const Params: TDADatasetParamArray;
const UserFilter: String;
const IncludeSchema: Boolean;
const MaxRecords: Integer): Binary;
function GetMultipleDatasets(const DatasetRequestInfoArray: TDADatasetRequestInfoArray): TROBinaryMemoryStream;
function GetDatasetScripts(const DatasetNames: String): String;
function ExecuteSQLCommandEx(const CommandName: String; const Params: TDADatasetParamArray): Integer;
public
constructor Create(aOwner : TComponent); override;
destructor Destroy; override;
property Connection: IDAConnection read fConnection write SetConnection;
published
property AcquireConnection: boolean read fAcquireConnection write SetAcquireConnection default false;
property ConnectionName: string read fConnectionName write SetConnectionName;
property ServiceSchema: TDASchema read fServiceSchema write SetServiceSchema;
property ServiceAdapter: TDADataAdapter read fServiceAdapter write SetServiceAdapter;
property AutoCreateBusinessProcessors : boolean read fAutoCreateBusinessProcessors write fAutoCreateBusinessProcessors default true;
property AllowExecuteSQLCommand: boolean read fAllowExecuteSQLCommand write fAllowExecuteSQLCommand default false;
property AllowWhereSQL: boolean read fAllowWhereSQL write fAllowWhereSQL default true;
property OnAfterProcessTransactionAction: TDAAfterProcessTransactionAction read fAfterProcessTransactionAction write fAfterProcessTransactionAction default pptaCommit;
property OnBeforeAcquireConnection: TDAAcquireConnectionEvent read fOnBeforeAcquireConnection write fOnBeforeAcquireConnection;
property OnAfterAcquireConnection: TDAConnectionAcquiredEvent read fOnAfterAcquireConnection write fOnAfterAcquireConnection;
property OnBeforeReleaseConnection: TDAConnectionAcquiredEvent read fOnBeforeReleaseConnection write fOnBeforeReleaseConnection;
property OnAfterReleaseConnection: TDAConnectionReleasedEvent read fOnAfterReleaseConnection write fOnAfterReleaseConnection;
property OnAcquireConnectionFailure: TDAAcquireConnectionFailureEvent read fOnAcquireConnectionFailure write fOnAcquireConnectionFailure;
property OnBeforeProcessDeltas : TDAProcessDeltasEvent read fOnBeforeProcessDeltas write fOnBeforeProcessDeltas;
property OnAfterProcessDeltas: TDAProcessDeltasEvent read fOnAfterProcessDeltas write fOnAfterProcessDeltas;
property OnProcessDeltasError: TDAProcessDeltasErrorEvent read fOnProcessDeltasError write fOnProcessDeltasError;
property OnBeforeGetDatasetSchema: TDAGetDatasetSchemaEvent read fOnBeforeGetDatasetSchema write fOnBeforeGetDatasetSchema;
property OnBeforeGetDatasetData: TDAGetDatasetDataEvent read fOnBeforeGetDatasetData write fOnBeforeGetDatasetData;
property OnAfterGetDatasetSchema: TDAGetDatasetSchemaEvent read fOnAfterGetDatasetSchema write fOnAfterGetDatasetSchema;
property OnAfterGetDatasetData: TDAGetDatasetDataEvent read fOnAfterGetDatasetData write fOnAfterGetDatasetData;
property OnBusinessProcessorAutoCreated: TDAOnBusinessProcessorAutoCreated read fOnBusinessProcessorAutoCreated write fOnBusinessProcessorAutoCreated;
property OnBeforeExecuteCommand: TDABeforeExecuteCommandEvent read fOnBeforeExecuteCommand write fOnBeforeExecuteCommand;
property OnAfterExecuteCommand: TDAAfterExecuteCommandEvent read fOnAfterExecuteCommand write fOnAfterExecuteCommand;
property OnGetSchemaAsXMLEvent: TDAGetSchemaAsXMLEvent read fOnGetSchemaAsXML write fOnGetSchemaAsXML;
property GetDatasetDataValidation: TDAGetDatasetDataValidationEvent read fGetDatasetDataValidation write fGetDatasetDataValidation;
property OnUpdateDataBeginTransaction : TDAUpdateDataTransactionEvent read fOnUpdateDataBeginTransaction write fOnUpdateDataBeginTransaction;
property OnUpdateDataCommitTransaction : TDAUpdateDataTransactionEvent read fOnUpdateDataCommitTransaction write fOnUpdateDataCommitTransaction;
property OnUpdateDataRollBackTransaction : TDAUpdateDataTransactionEvent read fOnUpdateDataRollBackTransaction write fOnUpdateDataRollBackTransaction;
property ExportedDataTables : TDADataTableReferenceCollection read fExportedDataTables write SetExportedDataTables;
property Cache : TDACache read fCache write SetCache;
property CacheElements : TDACacheElementCollection read fCacheElements write SetCacheElements;
property OnGetCachedDataset : TDAOnGetCachedDataset read fOnGetCachedDataset write fOnGetCachedDataset;
property Options : TDARemoteServiceOptions read fOptions write fOptions;
end deprecated;
implementation
uses
Contnrs, Variants, TypInfo,
uROClient,
uDARes, uDAExceptions;
{ TDARemoteService }
constructor TDARemoteService.Create(aOwner: TComponent);
begin
fExportedDataTables := TDADataTableReferenceCollection.Create(Self);
fCacheElements := TDACacheElementCollection.Create();
fOptions := [rsoProcessDeltasWithoutUpdateRules];
fAllowWhereSQL := true;
inherited;
fAutoCreateBusinessProcessors := TRUE;
end;
destructor TDARemoteService.Destroy;
begin
inherited;
FreeAndNIL(fExportedDataTables);
FreeAndNIL(fCacheElements);
end;
procedure TDARemoteService.DoOnActivate(aClientID: TGUID; const aMessage: IROMessage);
var
connname: string;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if AcquireConnection then try
// Acquires a DA connection automatically
if (fServiceSchema = nil) or (fServiceSchema.ConnectionManager = nil) then RaiseError(err_DARDMInvalidSchema);
connname := fConnectionName;
if Assigned(fOnBeforeAcquireConnection) then fOnBeforeAcquireConnection(Self, connname);
fConnection := ServiceSchema.ConnectionManager.NewConnection(connname);
if Supports(fConnection, IDAHETConnection) then
raise Exception.Create(err_HETConnectionNotSupportedInV3);
if Assigned(fOnAfterAcquireConnection) then fOnAfterAcquireConnection(Self, connname, fConnection);
except
on E: Exception do begin
if Assigned(fOnAcquireConnectionFailure) then fOnAcquireConnectionFailure(Self, connname, E);
raise;
end;
end;
end;
procedure TDARemoteService.DoOnDeactivate(aClientID: TGUID);
var connname : string;
begin
inherited;
if (csDesigning in ComponentState) then Exit;
if assigned(fConnection) then begin
connname := fConnection.Name;
if Assigned(fOnBeforeReleaseConnection)
then fOnBeforeReleaseConnection(Self, connname, fConnection);
fConnection := nil;
if Assigned(fOnAfterReleaseConnection)
then fOnAfterReleaseConnection(Self, connname);
end;
end;
procedure TDARemoteService.Loaded;
begin
inherited;
AcquireConnection := fStreamedAcquireConnection;
end;
procedure TDARemoteService.CheckObjects(const aConnection: IDAConnection;
aSchema: TDASchema; anAdapter: TDADataAdapter;
CheckConnection : boolean = TRUE;
CheckSchema : boolean = TRUE;
CheckAdapter : boolean = TRUE);
begin
if CheckConnection and not Assigned(aConnection) then RaiseError(err_DARDMConnectionIsNotAssigned);
if CheckSchema and not Assigned(aSchema) then RaiseError(err_DARDMInvalidSchema);
if CheckAdapter and not Assigned(anAdapter) then RaiseError(err_DARDMUnassignedAdapter);
end;
procedure TDARemoteService.Notification(AComponent: TComponent;
Operation: TOperation);
var ref : TDADataTableReference;
begin
inherited;
if (Operation = opRemove) then begin
if (aComponent = fServiceSchema) then ServiceSchema := nil
else if (AComponent=fCache) then fCache := NIL
else if (aComponent = fServiceAdapter) then ServiceAdapter := nil
else if (AComponent is TDADataTable) and (fExportedDataTables<>NIL) then begin
ref := fExportedDataTables.FindByDataTable(TDADataTable(aComponent));
if (ref<>NIL) then ref.DataTable := NIL;
end;
end
else if (Operation = opInsert) then begin
if not (csLoading in ComponentState) and (AComponent is TDASchema) and (fServiceSchema = nil) and (AComponent.Owner = Self) then ServiceSchema := TDASchema(aComponent);
end;
end;
procedure TDARemoteService.SetAcquireConnection(const Value: boolean);
begin
if (csLoading in ComponentState) then
fStreamedAcquireConnection := Value
else begin
if Value then begin
if (fServiceSchema = nil) then raise Exception.Create(err_DARDMInvalidSchema);
end;
fAcquireConnection := Value;
end;
end;
procedure TDARemoteService.SetConnection(const aValue: IDAConnection);
begin
if assigned(fConnection) and Supports(fConnection, IDAHETConnection) then
raise Exception.Create(err_HETConnectionNotSupportedInV3);
fConnection := aValue;
end;
procedure TDARemoteService.SetConnectionName(const Value: string);
begin
fConnectionName := Trim(Value);
if (fConnectionName = '') then fAcquireConnection := FALSE;
end;
procedure TDARemoteService.SetServiceSchema(const Value: TDASchema);
begin
fServiceSchema := Value;
if (fServiceSchema <> nil) then
fServiceSchema.FreeNotification(Self)
else
fAcquireConnection := FALSE;
end;
procedure TDARemoteService.SetServiceAdapter(const Value: TDADataAdapter);
begin
fServiceAdapter := Value;
if (fServiceAdapter <> nil) then fServiceAdapter.FreeNotification(Self);
end;
function TDARemoteService.TriggerTransactionEvent(aEvent: TDAUpdateDataTransactionEvent): Boolean;
begin
result := true;
if assigned(aEvent) then aEvent(self, result);
end;
function TDARemoteService.DoGetDatasetData(
const Stream: TStream;
const aConnection: IDAConnection;
const aDatasetName: string;
const aParamNames: array of string;
const aParamValues : array of variant;
const UserFilter : string;
aSchema: TDASchema;
anAdapter: TDADataAdapter;
someOptions: TDAWriteOptions;
MaxRecords: integer): integer;
var
ds: IDADataset;
i, cnt: integer;
paramname: string;
paramvalue: variant;
inclrows,
inclschema: boolean;
allow : boolean;
ref : TDADataTableReference;
cachedentry : IDACacheEntry;
cacheelement : TDACacheElement;
begin
// Misc
cachedentry := NIL;
inclschema := (woSchema in someOptions);
inclrows := (woRows in someOptions);
ref := NIL;
if (fCache<>NIL) then begin
// If the service is connected to a cache, then it searches the cache for this dataset
cachedentry := fCache.Get(Self.Name+'.'+aDatasetName);
end;
if (cachedentry=NIL) then begin
// New: searches for a datatable reference that matches the request, if any are present
// This allows the user to return in memory datasets or other custom data
if (fExportedDataTables.Count>0) then begin
ref := fExportedDataTables.FindByName(aDatasetName); // Already checks the datatable is not NIL
if (ref<>NIL) then begin
ds := ref.Dataset;
end;
end;
end;
// Checks for connection, schema and adapter to be assigned since it will need to query the DB in this case
if (ref=NIL) and (cachedentry=NIL)
then CheckObjects(aConnection, aSchema, anAdapter);
// Security check, common to every case
allow := TRUE;
if Assigned(fGetDatasetDataValidation)
then fGetDatasetDataValidation(Self, aConnection, aDatasetName, aParamNames, aParamValues, aSchema, allow);
if not allow
then raise EDADatasetNotAccessible.CreateFmt(err_DatasetNotAccessible, [aDatasetName]);
// Returns the actual data. Cached and non-cached data follow two different paths (some events are not triggered in the
// case of cached data, since we don't have an actual IDADataset to reference)
if (cachedentry<>NIL) then begin
if Assigned(fOnGetCachedDataset) then fOnGetCachedDataset(Self, aDatasetName, cachedentry.Data);
result := cachedentry.RecordCount;
Stream.CopyFrom(cachedentry.Data, 0);
end
else begin
if TriggerTransactionEvent(fOnUpdateDataBeginTransaction) then Connection.BeginTransaction;
try
// Gets a reference to the dataset if it couldn't find a datatable to match the request...
if (ref=NIL) then
ds := aSchema.NewDataset(aConnection, aDatasetName);
// Fills the parameters (if any are specified)
cnt := Length(aParamNames);
if (cnt>0) then begin
for i := 0 to (cnt-1) do begin
paramname := aParamNames[i];
paramvalue := aParamValues[i];
ds.ParamByName(paramname).Value := paramvalue;
end;
end;
// Applies the UserFilter, if any specified
if (Trim(UserFilter)<>'') then begin
if not AllowWhereSQL then
raise Exception.Create('Passing of clear text WHERE clauses has been disabled (GetData)');
ds.Where.AddText(UserFilter);
end;
// ...and writes the data fireing the right events
if inclschema and Assigned(fOnBeforeGetDatasetSchema) then fOnBeforeGetDatasetSchema(ds);
if inclrows and Assigned(fOnBeforeGetDatasetData) then fOnBeforeGetDatasetData(ds, inclschema, MaxRecords);
result := anAdapter.WriteDataset(stream, ds, someOptions, MaxRecords);
if inclschema and Assigned(fOnAfterGetDatasetSchema) then fOnAfterGetDatasetSchema(ds);
if inclrows and Assigned(fOnAfterGetDatasetData) then fOnAfterGetDatasetData(ds, inclschema, MaxRecords);
if Connection.InTransaction and TriggerTransactionEvent(fOnUpdateDataCommitTransaction) then Connection.CommitTransaction;
except
if Connection.InTransaction and TriggerTransactionEvent(fOnUpdateDataRollBackTransaction) then Connection.RollbackTransaction;
raise;
end;
// Checks if it needs to stored it in the cache
if (fCache<>NIL) then begin
cacheelement := fCacheElements.FindByDatasetName(aDatasetName);
if (cacheelement=NIL) or not cacheelement.Enabled then Exit;
fCache.Store(Self.Name+'.'+aDatasetName, stream, TRUE, result, cacheelement.MaxReads, cacheelement.Duration);
end;
end;
end;
function TDARemoteService.GetDatasetSchema(
const aDatasetName: string): Binary;
var tempds : IDADataset;
schemads : TDADataset;
dummyrefs : TObjectList;
begin
dummyrefs := NIL;
CheckObjects(Connection, ServiceSchema, ServiceAdapter);
result := Binary.Create;
try
try
// New: merges the data tables references by the service
if (fExportedDataTables.Count>0) then begin
dummyrefs := TObjectList.Create;
MergeDatatablesToSchema(dummyrefs);
end;
// Improved this method: now it is not necessary to have statements associated to a dataset
// thus allowing for the definition of in memory datasets inside a schema
schemads := ServiceSchema.Datasets.DatasetByName(aDatasetName);
tempds := Connection.NewDataset('', aDatasetName);
// Copies the schema
tempds.Fields.AssignFieldCollection(schemads.Fields);
tempds.Params.AssignParamCollection(schemads.Params);
ServiceAdapter.WriteDataset(result, tempds, [woSchema], 0);
except
FreeAndNIL(result);
raise;
end;
finally
dummyrefs.Free;
end;
end;
type
TBizProcessorReference = class(TObject)
private
end;
function TDARemoteService.UnpackDeltas(const DeltaStream: Binary;
DeltaStructList : TDADeltaStructList): integer;
var x, i: integer;
deltaname: string;
bizproc: TDABusinessProcessor;
details : TDADatasetRelationshipList;
found: boolean;
struct : TDADeltaStruct;
begin
result := 0;
with ServiceAdapter do begin
// Reads the deltas.
Initialize(DeltaStream, aiReadFromBeginning);
try
if (DeltaCount = 0) then Exit;
for i := 0 to (DeltaCount - 1) do begin
deltaname := DeltaNames[i];
found := FALSE;
{ Tries to locate a user-defined business processor }
for x := 0 to (Self.ComponentCount - 1) do
if (Self.Components[x] is TDABusinessProcessor) then begin
bizproc := TDABusinessProcessor(Self.Components[x]);
if SameText(bizproc.ReferencedDataset, deltaname) then begin
struct := DeltaStructList.Add(NewDelta(deltaname), bizproc);
ReadDelta(deltaname, struct.Delta);
found := TRUE;
Break;
end;
end;
{ Either creates one or aborts raising an exception }
if not found then begin
if not AutoCreateBusinessProcessors then RaiseError(err_DARDMCannotFindProxessorForDelta, [deltaname]);
bizproc := TDABusinessProcessor.Create(Self);
bizproc.ReferencedDataset := deltaname;
bizproc.Schema := ServiceSchema;
struct := DeltaStructList.Add(NewDelta(deltaname), bizproc);
ReadDelta(deltaname, struct.Delta);
if Assigned(fOnBusinessProcessorAutoCreated)
then fOnBusinessProcessorAutoCreated(Self, bizproc);
end;
Inc(result);
end;
if (result=0) then Exit; // Cannot process anything!
{ Sets the master/detail relationships }
with ServiceSchema do
if (RelationShips.Count>0) then begin
details := TDADatasetRelationshipList.Create;
try
for i := 0 to DeltaStructList.Count-1 do begin
RelationShips.GetDetails(DeltaStructList[i].BusinessProcessor.ReferencedDataset, details);
if (details.Count=0) then Continue;
{ Prepares an array with the references to the detail deltas that will be used later on to adjust
autoincs, etc. }
for x := 0 to details.Count-1 do begin
struct := DeltaStructList.FindStruct(details[x].DetailDatasetName);
if (struct<>NIL) then begin
DeltaStructList[i].DetailDeltas.Add(struct.Delta);
DeltaStructList[i].RelationShips.Add(details[x]);
end;
end;
end;
finally
details.Free;
end;
end;
finally
Finalize;
end;
end;
end;
function TDARemoteService.UpdateData(const Delta: Binary): Binary;
var
deltastructs : TDADeltaStructList;
struct : TDADeltaStruct;
k, i: integer;
doraise : boolean;
processeddeltas : TStringList;
function ProceedDefaultTransactionLogic(aEvent: TDAUpdateDataTransactionEvent): Boolean;
begin
Result := True;
if Assigned(aEvent)
then aEvent(Self, Result);
end;
procedure FlushCache(const aDatasetName : string);
var element : TDACacheElement;
begin
if (fCache=NIL) or (fCacheElements.Count=0) then Exit;
element := fCacheElements.FindByDatasetName(aDatasetName);
if (element=NIL) then Exit;
if (ceoFlushOnUpdate in element.Options)
then fCache.Flush(Self.Name+'.'+aDatasetName);
end;
begin
result := NIL;
processeddeltas := NIL;
CheckObjects(Connection, ServiceSchema, ServiceAdapter);
deltastructs := TDADeltaStructList.Create;
with ServiceAdapter do try
try
// Reads the deltas. The order in which the are put in the stream indicates
// the order in which updates are being made
if not (UnpackDeltas(Delta, deltastructs)>0) then Exit;
// Applies the updates
if ProceedDefaultTransactionLogic(fOnUpdateDataBeginTransaction)
then Connection.BeginTransaction;
if Assigned(fOnBeforeProcessDeltas) then fOnBeforeProcessDeltas(Self, deltastructs);
if (ServiceSchema.UpdateRules.Count=0) and (rsoProcessDeltasWithoutUpdateRules in Options) then begin
// Processes them in order, from first to last delta sent
for i := 0 to deltastructs.Count-1 do begin
// Flushes the cache for the given dataset
FlushCache(deltastructs[i].Delta.LogicalName);
deltastructs[i].BusinessProcessor.ProcessDelta(Connection, deltastructs[i].Delta, AllChanges);
end;
end
else try
processeddeltas := TStringList.Create;
for i := 0 to (ServiceSchema.UpdateRules.Count-1) do begin
// Processes them in the order defined in the schema
struct := deltastructs.FindStruct(ServiceSchema.UpdateRules[i].DatasetName);
if (struct<>NIL) then begin
// Adds the dataset name to the list of processed deltas. Those that don't have update rules will be processed later
processeddeltas.Add(struct.Delta.LogicalName);
// Flushes the cache for the given dataset
FlushCache(struct.Delta.LogicalName);
// Processes the delta
struct.BusinessProcessor.ProcessDelta(Connection, struct.Delta, ServiceSchema.UpdateRules[i].ChangeTypes);
if (ctInsert in ServiceSchema.UpdateRules[i].ChangeTypes) then begin
for k := 0 to (struct.DetailDeltas.Count-1) do
struct.BusinessProcessor.SynchronizeAutoIncs(struct.Delta, struct.DetailDeltas[k], struct.RelationShips[k]);
end;
end;
end;
// Processes the deltas for which update rules were not defined
if (rsoProcessDeltasWithoutUpdateRules in Options) then begin
for i := 0 to deltastructs.Count-1 do begin
// Skips if already processed
if (processeddeltas.IndexOf(deltastructs[i].Delta.LogicalName)>=0) then Continue;
// Flushes the cache for the given dataset
FlushCache(deltastructs[i].Delta.LogicalName);
deltastructs[i].BusinessProcessor.ProcessDelta(Connection, deltastructs[i].Delta, AllChanges);
end;
end;
finally
processeddeltas.Free;
end;
if Assigned(fOnAfterProcessDeltas) then fOnAfterProcessDeltas(Self, deltastructs);
if Connection.InTransaction and ProceedDefaultTransactionLogic(fOnUpdateDataCommitTransaction)
then Connection.CommitTransaction;
// Prepares the response
result := Binary.Create;
ServiceAdapter.Initialize(result, aiWrite);
for i := 0 to deltastructs.Count-1 do
WriteDelta(deltastructs[i].Delta);
ServiceAdapter.Finalize;
except
on E:Exception do begin
doraise := TRUE;
try
if Assigned(fOnProcessDeltasError)
then fOnProcessDeltasError(Self, deltastructs, E, doraise);
finally
if Connection.InTransaction and ProceedDefaultTransactionLogic(fOnUpdateDataRollBackTransaction)
then Connection.RollbackTransaction;
end;
if doraise then raise;
end;
end;
finally
deltastructs.Free;
end;
end;
function TDARemoteService.ExecuteSQLCommand(const SQL: string): Integer;
begin
if not AllowExecuteSQLCommand then
RaiseError(err_ExecuteSQLCommandNotAllowed);
CheckObjects(Connection, ServiceSchema, NIL, TRUE, TRUE, FALSE);
if TriggerTransactionEvent(fOnUpdateDataBeginTransaction) then Connection.BeginTransaction;
try
result := Connection.NewCommand(SQL, stSQL).Execute;
if Connection.InTransaction and TriggerTransactionEvent(fOnUpdateDataCommitTransaction) then Connection.CommitTransaction;
except
if Connection.InTransaction and TriggerTransactionEvent(fOnUpdateDataRollBackTransaction) then Connection.RollbackTransaction;
raise;
end;
end;
function TDARemoteService.GetDatasetData(const DatasetName: string; const Params: string;
const IncludeSchema: Boolean; const MaxRecords: Integer): Binary;
var
parnames: array of string;
parvalues: array of Variant;
options: TDAWriteOptions;
pars: TStringList;
i : integer;
begin
pars := TStringList.Create;
result := Binary.Create;
try
try
pars.Text := Params;
SetLength(parnames, pars.Count);
SetLength(parvalues, pars.Count);
for i := 0 to (pars.Count-1) do begin
parnames[i] := pars.Names[i];
parvalues[i] := pars.Values[pars.Names[i]];
end;
if IncludeSchema
then options := [woSchema, woRows]
else options := [woRows];
DoGetDatasetData(result, Connection, DatasetName, parnames, parvalues, '', ServiceSchema, ServiceAdapter, options, MaxRecords);
except
FreeAndNIL(result);
raise;
end;
finally
pars.Free;
end;
end;
function TDARemoteService.CreateParamString(
const ParamNames: array of string;
const ParamValues: array of Variant): string;
var
i: integer;
begin
result := '';
for i := 0 to High(ParamNames) do
result := result + ParamNames[i] + '=' + VarToStr(ParamValues[i]) + #13;
end;
function TDARemoteService.GetDatasetData(const DatasetName: string;
const ParamNames: array of string; const ParamValues: array of Variant;
const IncludeSchema: Boolean; const MaxRecords: Integer): Binary;
var
options: TDAWriteOptions;
begin
{result := GetDatasetData(DatasetName, CreateParamString(ParamNames, ParamValues), IncludeSchema, MaxRecords);}
result := Binary.Create;
try
if IncludeSchema
then options := [woSchema, woRows]
else options := [woRows];
DoGetDatasetData(result, Connection, DatasetName, ParamNames, ParamValues, '', ServiceSchema, ServiceAdapter, options, MaxRecords);
except
FreeAndNIL(result);
raise;
end;
end;
function TDARemoteService.GetDatasetData(const DatasetName: string;
const IncludeSchema: Boolean = FALSE;
const MaxRecords: Integer = -1): Binary;
begin
result := GetDatasetData(DatasetName, '', IncludeSchema, MaxRecords);
end;
procedure TDARemoteService.MergeDatatablesToSchema(aList : TList);
var i : integer;
ref : TDADataset;
dt : IDADataset;
begin
if (fExportedDataTables.Count>0) then begin
for i := 0 to fExportedDataTables.Count-1 do
if fExportedDataTables[i].IsValidReference {and fExportedDataTables[i].ExportAsPartOfSchema} then begin
dt := fExportedDataTables[i].Dataset;
ref := ServiceSchema.Datasets.Add;
ref.Name := dt.LogicalName;
ref.Fields.AssignFieldCollection(dt.Fields);
ref.Params.AssignParamCollection(dt.Params);
aList.Add(ref);
end;
end;
end;
function TDARemoteService.GetSchemaAsXML: String;
var xml : TStringStream;
dummyrefs : TObjectList;
begin
result := '';
dummyrefs := NIL;
if not Assigned(ServiceSchema) then Exit;
try
// New: merges the data tables references by the service
if (fExportedDataTables.Count>0) then begin
dummyrefs := TObjectList.Create;
MergeDatatablesToSchema(dummyrefs);
end;
// Returns the schema
xml := TStringStream.Create('');
try
ServiceSchema.SaveToStream(xml);
result := xml.DataString;
if Assigned(fOnGetSchemaAsXML)
then fOnGetSchemaAsXML(Self, result);
finally
xml.Free;
end;
finally
dummyrefs.Free; // automatically removes the datatables from the schema again
end;
end;
function TDARemoteService.GetDatasetDataEx(const DatasetName: String;
const Params: TDADatasetParamArray;
const UserFilter: String;
const IncludeSchema: Boolean;
const MaxRecords: Integer): Binary;
var parnames : array of string;
parvalues : array of variant;
i : integer;
options : TDAWriteOptions;
begin
result := Binary.Create;
try
{ Prepares the parameter arrays}
if (Params<>NIL) then begin
SetLength(parnames, Params.Count);
SetLength(parvalues, Params.Count);
for i := 0 to (Params.Count-1) do begin
parnames[i] := Params[i].Name;
parvalues[i] := Params[i].Value;
end;
end
else begin
SetLength(parnames, 0);
SetLength(parvalues, 0);
end;
{ Other options }
if IncludeSchema
then options := [woSchema, woRows]
else options := [woRows];
{ Reads the data }
DoGetDatasetData(result, Connection, DatasetName, parnames, parvalues, UserFilter, ServiceSchema, ServiceAdapter, options, MaxRecords);
except
FreeAndNIL(result);
raise;
end;
end;
function TDARemoteService.GetMultipleDatasets(const DatasetRequestInfoArray: TDADatasetRequestInfoArray): TROBinaryMemoryStream;
var i : integer;
ds : IDADataset;
parnames : array of string;
parvalues : array of variant;
x : integer;
opt : TDAWriteOptions;
allow : boolean;
begin
result := NIL;
if (DatasetRequestInfoArray=NIL) or (DatasetRequestInfoArray.Count=0) then exit;
result := Binary.Create;
try
ServiceAdapter.Initialize(result, aiWrite);
try
for i := 0 to (DatasetRequestInfoArray.Count-1) do begin
with DatasetRequestInfoArray[i] do begin
SetLength(parnames, Params.Count);
SetLength(parvalues, Params.Count);
for x := 0 to (Params.Count-1) do begin
parnames[x] := Params[x].Name;
parvalues[x] := Params[x].Value;
end;
opt := [woRows];
if DatasetRequestInfoArray[i].IncludeSchema then opt := opt+[woSchema];
// Security check
allow := TRUE;
if Assigned(fGetDatasetDataValidation)
then fGetDatasetDataValidation(Self, Connection, DatasetName, parnames, parvalues, ServiceSchema, allow);
if not allow
then raise EDADatasetNotAccessible.CreateFmt(err_DatasetNotAccessible, [DatasetName]);
// Proceeds
ds := ServiceSchema.NewDataset(Connection, DatasetName, parnames, parvalues, TRUE);
ServiceAdapter.WriteDataset(ds, opt, MaxRecords);
end;
end;
finally
ServiceAdapter.Finalize();
end;
except
FreeAndNIL(result);
raise
end;
end;
function TDARemoteService.GetDatasetScripts(const DatasetNames: String): String;
var names : TStringList;
i : integer;
ds : TDADataset;
begin
result := '';
names := TStringList.Create;
try
CheckObjects(NIL, fServiceSchema, NIL, FALSE, TRUE, FALSE);
names.CommaText := DatasetNames;
result := '<Scripts>';
for i := 0 to (names.Count-1) do begin
ds := fServiceSchema.Datasets.DatasetByName(names[i]);
result := result+Format('<%s Language="%s"><![CDATA[%s]]></%s>', [
names[i],
GetEnumName(TypeInfo(TROSEScriptLanguage), Ord(ds.BusinessRulesClient.ScriptLanguage)),
UTF8Encode(ds.BusinessRulesClient.Script),
names[i]]);
end;
result := result+'</Scripts>';
finally
FreeAndNIL(names);
end;
end;
function TDARemoteService.ExecuteSQLCommandEx(const CommandName: String;
const Params: TDADatasetParamArray): Integer;
var cmd : IDASQLCommand;
i : integer;
begin
if not AllowExecuteSQLCommand then
RaiseError(err_ExecuteSQLCommandNotAllowed);
CheckObjects(Connection, ServiceSchema, NIL, TRUE, TRUE, FALSE);
cmd := ServiceSchema.NewCommand(Connection, CommandName);
for i := 0 to (Params.Count-1) do
cmd.ParamByName(Params[i].Name).Value := Params[i].Value;
if Assigned(fOnBeforeExecuteCommand)
then fOnBeforeExecuteCommand(Self, cmd);
if TriggerTransactionEvent(fOnUpdateDataBeginTransaction) then Connection.BeginTransaction;
try
result := cmd.Execute;
if Connection.InTransaction and TriggerTransactionEvent(fOnUpdateDataCommitTransaction) then Connection.CommitTransaction;
except
if Connection.InTransaction and TriggerTransactionEvent(fOnUpdateDataRollBackTransaction) then Connection.RollbackTransaction;
raise;
end;
if Assigned(fOnAfterExecuteCommand)
then fOnAfterExecuteCommand(Self, cmd, result);
end;
procedure TDARemoteService.SetExportedDataTables(const Value: TDADataTableReferenceCollection);
begin
fExportedDataTables.Assign(Value);
end;
procedure TDARemoteService.SetCache(const Value: TDACache);
begin
fCache := Value;
if (fCache<>NIL)
then fCache.FreeNotification(Self);
end;
procedure TDARemoteService.SetCacheElements(
const Value: TDACacheElementCollection);
begin
fCacheElements.Assign(Value);
end;
end.