unit uBizContratosClienteServer; interface uses uDAInterfaces, uDADelta, uDABusinessProcessor, schContratosClienteServer_Intf; const BIZ_SERVER_CONTRATOS_CLIENTE = 'Server.ContratosCliente'; type TBizContratosClienteServer = class(TContratosClienteBusinessProcessorRules) private FReferenciaAutomatica : Boolean; function DarReferencia : String; function IncrementarReferencia : Boolean; procedure LiberarPresupuestosDelContrato(aChange: TDADeltaChange); protected procedure BeforeProcessDelta(Sender: TDABusinessProcessor; const aDelta: IDADelta); override; procedure AfterProcessChange(Sender: TDABusinessProcessor; aChange: TDADeltaChange; Processed: Boolean; var CanRemoveFromDelta: Boolean); override; end; implementation uses Variants, uDAClasses, uReferenciasUtils, uBusinessUtils, uROClasses, uDataModuleServer, schContratosClienteClient_Intf, FactuGES_Intf, uROServer, SysUtils; const REF_CONTRATOS_CLIENTE = 'REF_CONTRATOS_CLIENTE'; { TBizContratosClienteServer } procedure TBizContratosClienteServer.AfterProcessChange( Sender: TDABusinessProcessor; aChange: TDADeltaChange; Processed: Boolean; var CanRemoveFromDelta: Boolean); begin inherited; { Por defecto, mantenemos los deltas por si alguna tabla hija los necesita } CanRemoveFromDelta := False; case aChange.ChangeType of ctInsert, ctUpdate: begin if FReferenciaAutomatica then begin IncrementarReferencia; FReferenciaAutomatica := False; end; end; ctDelete: begin LiberarPresupuestosDelContrato(aChange); end; end; end; procedure TBizContratosClienteServer.BeforeProcessDelta( Sender: TDABusinessProcessor; const aDelta: IDADelta); begin inherited; FReferenciaAutomatica := False; case Sender.CurrentChange.ChangeType of ctInsert, ctUpdate: begin //Si la referencia no ha sido asignada le asignamos una nosotros if REFERENCIAIsNull or (Length(REFERENCIA) = 0) then begin FReferenciaAutomatica := True; REFERENCIA := DarReferencia; end; end; end; end; function TBizContratosClienteServer.DarReferencia: String; var AReferenciasService : IsrvReferencias; Intf : IInterface; AClientID : TGUID; ACodigoReferencia : String; begin ACodigoReferencia := REF_CONTRATOS_CLIENTE; CreateGUID(AClientID); GetClassFactory('srvReferencias').CreateInstance(AClientID, Intf); AReferenciasService := Intf as IsrvReferencias; Result := AReferenciasService.DarNuevaReferencia(ACodigoReferencia, ID_EMPRESA, ID_TIENDA) end; function TBizContratosClienteServer.IncrementarReferencia: Boolean; var AReferenciasService : IsrvReferencias; Intf : IInterface; AClientID : TGUID; ACodigoReferencia : String; begin ACodigoReferencia := REF_CONTRATOS_CLIENTE; CreateGUID(AClientID); GetClassFactory('srvReferencias').CreateInstance(AClientID, Intf); AReferenciasService := Intf as IsrvReferencias; Result := AReferenciasService.IncrementarValorReferencia(ACodigoReferencia, Self.REFERENCIA, ID_EMPRESA, ID_TIENDA) end; procedure TBizContratosClienteServer.LiberarPresupuestosDelContrato(aChange: TDADeltaChange); var ASchema : TDASchema; ACurrentConn : IDAConnection; ACommand : IDASQLCommand; begin ASchema := BusinessProcessor.Schema; ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor); //En el caso de borrar un contrato se comprueban los presupuestos asociados para liberarlos para generar otro contrato. ACommand := ASchema.NewCommand(ACurrentConn, 'LiberarPresupuestosDelContrato'); try with ACommand do begin ParamByName('ID_CONTRATO').Value := aChange.OldValueByName[fld_ContratosClienteID]; Execute; end; finally ACommand := NIL; end; end; initialization RegisterBusinessProcessorRules(BIZ_SERVER_CONTRATOS_CLIENTE, TBizContratosClienteServer); end.