129 lines
4.5 KiB
ObjectPascal
129 lines
4.5 KiB
ObjectPascal
unit BizSchemaServer;
|
|
|
|
interface
|
|
|
|
uses Classes, SysUtils, uDADataTable, uDABusinessProcessor,
|
|
SchemaServer_Intf, BizSchemaClient, uDADelta, uDAInterfaces;
|
|
|
|
type
|
|
TBizCustomersServerRules = class(TCustomersBusinessProcessorRules)
|
|
protected
|
|
// Business events
|
|
procedure BeforeProcessChange(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange; var ProcessChange: boolean); override;
|
|
procedure ProcessError(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange;
|
|
const aCommand: IDASQLCommand; var CanRemoveFromDelta: boolean; Error: Exception); override;
|
|
end;
|
|
|
|
TBizOrdersServerRules = class(TOrdersBusinessProcessorRules)
|
|
protected
|
|
// Business events
|
|
procedure BeforeProcessChange(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange; var ProcessChange: boolean); override;
|
|
procedure ProcessError(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange;
|
|
const aCommand: IDASQLCommand; var CanRemoveFromDelta: boolean; Error: Exception); override;
|
|
|
|
end;
|
|
|
|
implementation
|
|
uses
|
|
ServerGlobal, dialogs;
|
|
{ TBizCustomersServerRules }
|
|
|
|
function CheckCustomer(CustID: string): boolean;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := False;
|
|
if Length(CustID) <> 5 then Exit;
|
|
for i := 1 to Length(CustID) do
|
|
if not (CustID[i] in ['A'..'Z', 'a'..'z']) then Exit;
|
|
Result := True;
|
|
end;
|
|
|
|
procedure TBizCustomersServerRules.BeforeProcessChange(Sender: TDABusinessProcessor;
|
|
aChangeType: TDAChangeType; aChange: TDADeltaChange; var ProcessChange: boolean);
|
|
begin
|
|
inherited;
|
|
aChange.Message := '';
|
|
if (aChangeType = ctInsert) then begin
|
|
with TBizErrorMessage.Create do try
|
|
if gCheckCustomerID and not checkCustomer(CustomerID) then
|
|
Add('CustomerID', 'CustomerID needs at least 5 characters');
|
|
if gCompanyCheck and not SameText(CompanyName, gCompany) then
|
|
Add('CompanyName', 'Company name should be ' + gCompany);
|
|
finally
|
|
if ItemCount > 0 then begin
|
|
Message := 'Cannot process an insert ' + sLineBreak +
|
|
'(Customer = ''' + CustomerID + ''')';
|
|
aChange.Message := asString;
|
|
end;
|
|
Free;
|
|
end;
|
|
end;
|
|
|
|
if (aChangeType = ctDelete) and gDeclineDeleteCustomers then begin
|
|
with TBizErrorMessage.Create do try
|
|
Message := 'Deleting of customers is not allowed ' + sLineBreak +
|
|
'(Customer = ''' + OldCustomerID + ''')';
|
|
aChange.Message := asString;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
ProcessChange := aChange.Message = '';
|
|
if not ProcessChange then aChange.Status := csFailed;
|
|
end;
|
|
|
|
procedure TBizCustomersServerRules.ProcessError(
|
|
Sender: TDABusinessProcessor; aChangeType: TDAChangeType;
|
|
aChange: TDADeltaChange; const aCommand: IDASQLCommand;
|
|
var CanRemoveFromDelta: boolean; Error: Exception);
|
|
begin
|
|
aChange.Message := Error.Message;
|
|
end;
|
|
|
|
{ TBizOrdersServerRules }
|
|
|
|
procedure TBizOrdersServerRules.BeforeProcessChange(
|
|
Sender: TDABusinessProcessor; aChangeType: TDAChangeType;
|
|
aChange: TDADeltaChange; var ProcessChange: boolean);
|
|
begin
|
|
inherited;
|
|
aChange.Message := '';
|
|
if aChangeType <> ctDelete then
|
|
if gFreightCheck and (Freight < gFreight) then begin
|
|
with TBizErrorMessage.Create do try
|
|
Message := 'Cannot process operation ' + sLineBreak + '(OrderID = ' + intToStr(OrderID) + ')';
|
|
Add('Freight', 'Freight should be greater than ' + IntToStr(gFreight));
|
|
aChange.Message := asString;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
if (aChangeType = ctDelete) and gDeclineDeleteOrders then begin
|
|
with TBizErrorMessage.Create do try
|
|
Message := 'Deleting of orders is not allowed ' + sLineBreak +
|
|
'(OrderID = ''' + IntToStr(OldOrderID) + ''')';
|
|
aChange.Message := asString;
|
|
finally
|
|
Free;
|
|
end;
|
|
end;
|
|
ProcessChange := aChange.Message = '';
|
|
if not ProcessChange then aChange.Status := csFailed;
|
|
end;
|
|
|
|
procedure TBizOrdersServerRules.ProcessError(Sender: TDABusinessProcessor;
|
|
aChangeType: TDAChangeType; aChange: TDADeltaChange;
|
|
const aCommand: IDASQLCommand; var CanRemoveFromDelta: boolean;
|
|
Error: Exception);
|
|
begin
|
|
aChange.Message := Error.Message;
|
|
aChange.Status := csFailed;
|
|
end;
|
|
|
|
initialization
|
|
RegisterBusinessProcessorRules('Customers.ServerRules', TBizCustomersServerRules);
|
|
RegisterBusinessProcessorRules('Orders.ServerRules', TBizOrdersServerRules);
|
|
end.
|
|
|