Componentes.Terceros.RemObjects/internal/5.0.23.613/1/Data Abstract for Delphi/Samples/Business Processor/BizSchemaServer.pas

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.