david
2a98435b14
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@68 b6239004-a887-0f4b-9937-50029ccdca16
403 lines
15 KiB
ObjectPascal
403 lines
15 KiB
ObjectPascal
unit DASampleService_Impl;
|
|
|
|
interface
|
|
|
|
uses
|
|
{vcl:} Classes, SysUtils,
|
|
{RemObjects:} uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions, uRORemoteDataModule,
|
|
{Data Abstract:} uDAClasses, uDADataTable, uDABin2DataStreamer, uDAInterfaces, uDABusinessProcessor,
|
|
{Ancestor Implementation:} DataAbstractService_Impl,
|
|
{Used RODLs:} DataAbstract4_Intf,
|
|
{Generated:} DASampleLibrary_Intf, uROClient, uDADataStreamer,
|
|
uDAScriptingProvider, uDADelta;
|
|
|
|
type
|
|
{ TDASampleService }
|
|
TDASampleService = class(TDataAbstractService, IDASampleService)
|
|
DataStreamer: TDABin2DataStreamer;
|
|
bpBPWorkers: TDABusinessProcessor;
|
|
bpBPClients: TDABusinessProcessor;
|
|
bpBPProviders: TDABusinessProcessor;
|
|
bpClients: TDABusinessProcessor;
|
|
bpDealers: TDABusinessProcessor;
|
|
bpGroups: TDABusinessProcessor;
|
|
bpOrderDetails: TDABusinessProcessor;
|
|
bpOrders: TDABusinessProcessor;
|
|
bpPrices: TDABusinessProcessor;
|
|
bpProducts: TDABusinessProcessor;
|
|
bpProviders: TDABusinessProcessor;
|
|
bpSellers: TDABusinessProcessor;
|
|
bpWorkers: TDABusinessProcessor;
|
|
Schema: TDASchema;
|
|
procedure DataAbstractServiceValidateDatasetAccess(Sender: TObject;
|
|
const aConnection: IDAConnection; const aDatasetName: string;
|
|
const aParamNames: array of string; const aParamValues: array of Variant;
|
|
aSchema: TDASchema; var Allowed: Boolean);
|
|
procedure DataAbstractServiceValidateCommandExecution(Sender: TObject;
|
|
const aConnection: IDAConnection; const aDatasetName: string;
|
|
const aParamNames: array of string; const aParamValues: array of Variant;
|
|
aSchema: TDASchema; var Allowed: Boolean);
|
|
procedure DataAbstractServiceBeforeExecuteCommand(aSender: TObject;
|
|
const aCommand: IDASQLCommand);
|
|
procedure SchemaGetSQL(Sender: TDASchema; const ElementName: string;
|
|
ElementType: TDASchemaElementType; var SQL: string);
|
|
procedure DataAbstractServiceAfterGetDatasetData(aSender: TObject;
|
|
const aDataset: IDADataset; const aIncludeSchema: Boolean;
|
|
const aMaxRecords: Integer);
|
|
procedure bpBPClientsBeforeProcessChange(Sender: TDABusinessProcessor;
|
|
aChangeType: TDAChangeType; aChange: TDADeltaChange;
|
|
var ProcessChange: Boolean);
|
|
procedure DataAbstractServiceBeforeProcessDeltas(aSender: TObject;
|
|
aDeltaStructs: TDADeltaStructList);
|
|
procedure DataAbstractServiceAfterProcessDeltas(aSender: TObject;
|
|
aDeltaStructs: TDADeltaStructList);
|
|
procedure DataAbstractServiceValidateDirectSQLAccess(Sender: TObject;
|
|
const aConnection: IDAConnection; const aSQLText: string;
|
|
const aParamNames: array of string; const aParamValues: array of Variant;
|
|
var Allowed: Boolean);
|
|
procedure BusinessProcessorGenerateSQL(Sender: TDABusinessProcessor;
|
|
ChangeType: TDAChangeType; const ReferencedStatement: TDAStatement;
|
|
const aDelta: IDADelta; var SQL: string);
|
|
procedure BusinessProcessorBeforeProcessDelta(Sender: TDABusinessProcessor;
|
|
const aDelta: IDADelta);
|
|
private
|
|
function ChangeTypeToString(aChangeType: TDAChangeType): string;
|
|
procedure DescribeMapping(aMappings: TDAColumnMappingCollection);
|
|
procedure DescribeDeltaChange(aChange: TDADeltaChange);
|
|
function ShowEmptyNull(aValue: Variant): string;
|
|
function GetBPProvidersCustomSQL(aChangeType: TDAChangeType): string;
|
|
protected
|
|
{ IDASampleService methods }
|
|
procedure Login(const aPlatform: PlatformEnum; const aName: Widestring);
|
|
procedure BlockRow(const pkField: AnsiString);
|
|
procedure UnblockRow(const pkField: AnsiString; const IsReadRow: Boolean);
|
|
procedure BlockSetOfRows;
|
|
procedure Subscribe(const aSubscribe: Boolean);
|
|
end;
|
|
|
|
implementation
|
|
|
|
{$R *.dfm}
|
|
uses
|
|
{Generated:} DASampleLibrary_Invk, fServerDataModule, fServerForm, uROClasses,
|
|
Variants, uDAEngine;
|
|
|
|
procedure Create_DASampleService(out anInstance: IUnknown);
|
|
begin
|
|
anInstance := TDASampleService.Create(nil);
|
|
end;
|
|
|
|
var
|
|
fClassFactory: IROClassFactory;
|
|
|
|
procedure TDASampleService.BlockRow(const pkField: AnsiString);
|
|
var
|
|
ev: IUpdateEvent_Writer;
|
|
begin
|
|
with ServerDataModule do
|
|
if BlockedRows.IndexOf(AnsiStringToWideString(pkField)) < 0
|
|
then BlockedRows.Add(AnsiStringToWideString(pkField));
|
|
ev := EventRepository as IUpdateEvent_Writer;
|
|
ev.ExcludeSender := true;
|
|
ev.OnUpdateBlock(ClientID, pkField, GUIDToString(ClientID));
|
|
end;
|
|
|
|
procedure TDASampleService.BlockSetOfRows;
|
|
var
|
|
ev: IUpdateEvent_Writer;
|
|
i: integer;
|
|
arr: AnsiStringArray;
|
|
begin
|
|
arr := AnsiStringArray.Create;
|
|
with ServerDataModule do begin
|
|
arr.Resize(BlockedRows.Count);
|
|
for i := 0 to BlockedRows.Count - 1 do
|
|
arr.Add(WideStringToAnsiString(BlockedRows.Strings[i]));
|
|
end;
|
|
ev := EventRepository as IUpdateEvent_Writer;
|
|
ev.ExcludeSender := false;
|
|
ev.OnUpdateAllBlock(ClientID, arr);
|
|
arr.Free;
|
|
end;
|
|
|
|
procedure TDASampleService.bpBPClientsBeforeProcessChange(
|
|
Sender: TDABusinessProcessor; aChangeType: TDAChangeType;
|
|
aChange: TDADeltaChange; var ProcessChange: Boolean);
|
|
var
|
|
discount: double;
|
|
begin
|
|
ServerForm.LogMessage(#9'Checking business rules for Clients dataset');
|
|
|
|
if aChangeType = ctDelete then begin
|
|
ServerForm.LogMessage(#9#9'Forbiding to delete the client "' +
|
|
VarToStr(aChange.OldValueByName['Name']) + '"');
|
|
raise EDAException.Create('Client deletion is forbiden!');
|
|
end;
|
|
|
|
discount := aChange.NewValueByName['Discount'];
|
|
if (discount < 0.0) or (discount > 50.0) then begin
|
|
ServerForm.LogMessage(#9#9'Forbiding discount out of [0;50] range: ' +
|
|
FloatToStr(discount));
|
|
raise EDAException.Create('Discount out of range!');
|
|
end;
|
|
end;
|
|
|
|
procedure TDASampleService.BusinessProcessorBeforeProcessDelta(
|
|
Sender: TDABusinessProcessor; const aDelta: IDADelta);
|
|
var
|
|
i: integer;
|
|
begin
|
|
ServerForm.LogMessage(#9'Preparing to process delta to the dataset: ' + aDelta.LogicalName);
|
|
ServerForm.LogMessage(#9#9'Changes count: ' + IntToStr(aDelta.Count));
|
|
ServerForm.LogMessage(' ');
|
|
for i := 0 to aDelta.Count - 1 do begin
|
|
ServerForm.LogMessage(#9'Delta change #' + IntToStr(i + 1) + ', change type: ' +
|
|
ChangeTypeToString(aDelta.Changes[i].ChangeType));
|
|
ServerForm.LogMessage(#9'---------------');
|
|
DescribeDeltaChange(aDelta.Changes[i]);
|
|
end;
|
|
ServerForm.LogMessage(' ');
|
|
end;
|
|
|
|
procedure TDASampleService.BusinessProcessorGenerateSQL(
|
|
Sender: TDABusinessProcessor; ChangeType: TDAChangeType;
|
|
const ReferencedStatement: TDAStatement; const aDelta: IDADelta;
|
|
var SQL: string);
|
|
begin
|
|
ServerForm.LogMessage(#9'Column mappings');
|
|
ServerForm.LogMessage(#9'---------------');
|
|
DescribeMapping(ReferencedStatement.ColumnMappings);
|
|
ServerForm.LogMessage(' ');
|
|
if Sender = bpBPProviders then begin
|
|
ServerForm.LogMessage(#9'Preparing CUSTOM SQL statement for BPProviders dataset:');
|
|
SQL := GetBPProvidersCustomSQL(ChangeType);
|
|
end
|
|
else ServerForm.LogMessage(#9'Preparing SQL statement:');
|
|
ServerForm.LogMessage(#9'------------------------');
|
|
ServerForm.LogMessage(SQL);
|
|
ServerForm.LogMessage(' ');
|
|
end;
|
|
|
|
function TDASampleService.ChangeTypeToString(
|
|
aChangeType: TDAChangeType): string;
|
|
begin
|
|
Result := '';
|
|
case aChangeType of
|
|
ctInsert: Result := 'Insert';
|
|
ctUpdate: Result := 'Update';
|
|
ctDelete: Result := 'Delete';
|
|
end;
|
|
end;
|
|
|
|
procedure TDASampleService.DataAbstractServiceAfterGetDatasetData(
|
|
aSender: TObject; const aDataset: IDADataset; const aIncludeSchema: Boolean;
|
|
const aMaxRecords: Integer);
|
|
var
|
|
s: string;
|
|
begin
|
|
ServerForm.LogMessage(#9'Sending data to the client.');
|
|
s := #9'Sending ';
|
|
if aMaxRecords = -1 then s := s + 'all records'
|
|
else s := s + IntToStr(aMaxRecords) + ' record(s)';
|
|
ServerForm.LogMessage(s);
|
|
s := #9'Sending schema: ';
|
|
if aIncludeSchema then s := s + 'yes' else s := s + 'no';
|
|
ServerForm.LogMessage(s);
|
|
ServerForm.LogMessage(' ');
|
|
ServerForm.LogMessage('Request completed');
|
|
ServerForm.LogMessage('=================');
|
|
end;
|
|
|
|
procedure TDASampleService.DataAbstractServiceAfterProcessDeltas(
|
|
aSender: TObject; aDeltaStructs: TDADeltaStructList);
|
|
begin
|
|
ServerForm.LogMessage('Request completed');
|
|
ServerForm.LogMessage('=================');
|
|
end;
|
|
|
|
procedure TDASampleService.DataAbstractServiceBeforeExecuteCommand(
|
|
aSender: TObject; const aCommand: IDASQLCommand);
|
|
begin
|
|
// TODO:
|
|
ServerForm.LogMessage('DataAbstractServiceBeforeExecuteCommand');
|
|
end;
|
|
|
|
procedure TDASampleService.DataAbstractServiceBeforeProcessDeltas(
|
|
aSender: TObject; aDeltaStructs: TDADeltaStructList);
|
|
begin
|
|
ServerForm.LogMessage(' ');
|
|
ServerForm.LogMessage(DateTimeToStr(Now) + ' - Going to process deltas');
|
|
ServerForm.LogMessage(#9'Session ID: ' + GUIDToString(ClientID));
|
|
ServerForm.LogMessage(#9'Deltas count: ' + IntToStr(aDeltaStructs.Count));
|
|
ServerForm.LogMessage(' ');
|
|
end;
|
|
|
|
procedure TDASampleService.DataAbstractServiceValidateCommandExecution(
|
|
Sender: TObject; const aConnection: IDAConnection; const aDatasetName: string;
|
|
const aParamNames: array of string; const aParamValues: array of Variant;
|
|
aSchema: TDASchema; var Allowed: Boolean);
|
|
begin
|
|
// TODO:
|
|
ServerForm.LogMessage('DataAbstractServiceValidateCommandExecution');
|
|
end;
|
|
|
|
procedure TDASampleService.DataAbstractServiceValidateDatasetAccess(
|
|
Sender: TObject; const aConnection: IDAConnection; const aDatasetName: string;
|
|
const aParamNames: array of string; const aParamValues: array of Variant;
|
|
aSchema: TDASchema; var Allowed: Boolean);
|
|
var
|
|
s: string;
|
|
begin
|
|
ServerForm.LogMessage(' ');
|
|
ServerForm.LogMessage(DateTimeToStr(Now) + ' - Dataset access requested');
|
|
ServerForm.LogMessage(#9'Session ID: ' + GUIDToString(ClientID));
|
|
ServerForm.LogMessage(#9'Dataset name: ' + aDatasetName);
|
|
s := #9'Parameters: ';
|
|
if Length(aParamNames) = 0 then s := s + 'none'
|
|
else begin
|
|
// TODO:
|
|
s := s + 'some';
|
|
end;
|
|
ServerForm.LogMessage(s);
|
|
end;
|
|
|
|
procedure TDASampleService.DataAbstractServiceValidateDirectSQLAccess(
|
|
Sender: TObject; const aConnection: IDAConnection; const aSQLText: string;
|
|
const aParamNames: array of string; const aParamValues: array of Variant;
|
|
var Allowed: Boolean);
|
|
begin
|
|
// TODO:
|
|
ServerForm.LogMessage('DataAbstractServiceValidateDirectSQLAccess');
|
|
end;
|
|
|
|
procedure TDASampleService.DescribeDeltaChange(aChange: TDADeltaChange);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to aChange.Delta.LoggedFieldCount - 1 do
|
|
ServerForm.LogMessage(#9 + aChange.Delta.LoggedFieldNames[i] + ': ' +
|
|
ShowEmptyNull(aChange.OldValues[i]) + #9'->'#9 +
|
|
ShowEmptyNull(aChange.NewValues[i]));
|
|
end;
|
|
|
|
procedure TDASampleService.DescribeMapping(aMappings: TDAColumnMappingCollection);
|
|
var
|
|
i: integer;
|
|
begin
|
|
for i := 0 to aMappings.Count - 1 do
|
|
with aMappings[i] do
|
|
ServerForm.LogMessage(#9'DatasetField: ' + DatasetField +
|
|
' TableField: ' + TableField + ' SQLOrigin:' + SQLOrigin);
|
|
end;
|
|
|
|
function TDASampleService.GetBPProvidersCustomSQL(aChangeType: TDAChangeType): string;
|
|
var
|
|
sl: TStringList;
|
|
begin
|
|
sl := TStringList.Create;
|
|
sl.Add('/* My Custom overridden SQL */');
|
|
if Connection.ConnectionType = 'MSSQL' then
|
|
case aChangeType of
|
|
ctInsert: begin
|
|
sl.Add('INSERT INTO [Suppliers]([Id], [Name], [Phone], [Address])');
|
|
sl.Add('VALUES (:Id, :Name, :Phone, :Address)');
|
|
end;
|
|
ctUpdate: begin
|
|
sl.Add('UPDATE [Suppliers] SET [Id] = :Id, [Name] = :Name, [Phone] = :Phone, [Address] = :Address');
|
|
sl.Add('WHERE ([Id] = :OLD_Id)');
|
|
end;
|
|
ctDelete: sl.Add('DELETE FROM [Suppliers] WHERE ([Id] = :OLD_Id)');
|
|
end
|
|
else if Connection.ConnectionType = 'Interbase' then
|
|
case aChangeType of
|
|
ctInsert: begin
|
|
sl.Add('INSERT INTO "SUPPLIERS" ("SUPP_ID", "SUPP_NAME", "SUPP_PHONE", "SUPP_ADDRESS")');
|
|
sl.Add('VALUES (:Id, :Name, :Phone, :Address)');
|
|
end;
|
|
ctUpdate: begin
|
|
sl.Add('UPDATE "SUPPLIERS" SET "SUPP_ID" = :Id, "SUPP_NAME" = :Name, "SUPP_PHONE" = :Phone, "SUPP_ADDRESS" = :Address');
|
|
sl.Add('WHERE ("SUPP_ID" = :OLD_Id)');
|
|
end;
|
|
ctDelete: sl.Add('DELETE FROM "SUPPLIERS" WHERE ("SUPP_ID" = :OLD_Id)');
|
|
end
|
|
else if Connection.ConnectionType = 'SQLite' then
|
|
case aChangeType of
|
|
ctInsert: begin
|
|
sl.Add('INSERT INTO "SUPPLIER" ("Id", "Name", "Phone", "Address")');
|
|
sl.Add('VALUES (:Id, :Name, :Phone, :Address)');
|
|
end;
|
|
ctUpdate: begin
|
|
sl.Add('UPDATE "SUPPLIER" SET "Id" = :Id, "Name" = :Name, "Phone" = :Phone, "Address" = :Address');
|
|
sl.Add('WHERE ("Id" = :OLD_Id)');
|
|
end;
|
|
ctDelete: sl.Add('DELETE FROM "SUPPLIER" WHERE ("Id" = :OLD_Id)');
|
|
end
|
|
else raise Exception.Create('Unsupported connection name!');
|
|
Result := sl.Text;
|
|
sl.Free;
|
|
end;
|
|
|
|
procedure TDASampleService.Login(const aPlatform: PlatformEnum;
|
|
const aName: Widestring);
|
|
begin
|
|
// TODO: More info
|
|
ServerForm.LogMessage('New client logged in: ' + aName);
|
|
end;
|
|
|
|
procedure TDASampleService.SchemaGetSQL(Sender: TDASchema;
|
|
const ElementName: string; ElementType: TDASchemaElementType;
|
|
var SQL: string);
|
|
begin
|
|
ServerForm.LogMessage(' ');
|
|
case ElementType of
|
|
setDataset: begin
|
|
ServerForm.LogMessage(#9'Executing SQL:');
|
|
ServerForm.LogMessage(#9'--------------');
|
|
ServerForm.LogMessage(SQL);
|
|
end;
|
|
setCommand: begin
|
|
ServerForm.LogMessage(#9'Executing Schema command: ' + ElementName);
|
|
ServerForm.LogMessage(SQL);
|
|
end;
|
|
end;
|
|
ServerForm.LogMessage(' ');
|
|
end;
|
|
|
|
function TDASampleService.ShowEmptyNull(aValue: Variant): string;
|
|
begin
|
|
if aValue = Null then Result := '<NULL>'
|
|
else Result := VarToStr(aValue);
|
|
if Result = '' then Result := '<EMPTY>';
|
|
end;
|
|
|
|
procedure TDASampleService.Subscribe(const aSubscribe: Boolean);
|
|
begin
|
|
if aSubscribe then
|
|
RegisterEventClient(WideStringToAnsiString(GUIDToString(ClientID)), EID_UpdateEvent)
|
|
else UnregisterEventClient(WideStringToAnsiString(GUIDToString(ClientID)), EID_UpdateEvent);
|
|
end;
|
|
|
|
procedure TDASampleService.UnblockRow(const pkField: AnsiString;
|
|
const IsReadRow: Boolean);
|
|
var
|
|
ev: IUpdateEvent_Writer;
|
|
i: integer;
|
|
begin
|
|
with ServerDataModule do begin
|
|
i := BlockedRows.IndexOf(AnsiStringToWideString(pkField));
|
|
if i >= 0 then BlockedRows.Delete(i);
|
|
end;
|
|
|
|
ev := EventRepository as IUpdateEvent_Writer;
|
|
ev.ExcludeSender := true;
|
|
ev.OnUpdateUnblock(ClientID, pkField, GUIDToString(ClientID), true);
|
|
end;
|
|
|
|
initialization
|
|
fClassFactory := TROClassFactory.Create('DASampleService', Create_DASampleService, TDASampleService_Invoker);
|
|
RegisterForZeroConf(fClassFactory,'_DASampleService_rosdk._tcp.');
|
|
finalization
|
|
UnRegisterClassFactory(fClassFactory);
|
|
fClassFactory := nil;
|
|
end.
|