unit uBizContactosServer; interface uses SysUtils, schContactosServer_Intf, uDAInterfaces, uDADataTable, uDABusinessProcessor, uDADelta; const BIZ_SERVER_CONTACTO = 'Server.Contacto'; type TBizContactosServer = class(TContactosBusinessProcessorRules) protected function _DarReferenciaInterna(const ATipo: String) : String; function _IncrementarReferenciaInterna(const ATipo: String) : Boolean; procedure Insert_Datos_Contacto(aChange: TDADeltaChange); virtual; procedure Update_Datos_Contacto(aChange: TDADeltaChange); virtual; procedure Delete_Datos_Contacto(aChange: TDADeltaChange); virtual; procedure Insert_Categoria_Contacto(aChange: TDADeltaChange); virtual; procedure Update_Categoria_Contacto(aChange: TDADeltaChange); virtual; procedure Delete_Categoria_Contacto(aChange: TDADeltaChange); virtual; procedure AfterProcessChange(Sender: TDABusinessProcessor; aChange: TDADeltaChange; Processed: Boolean; var CanRemoveFromDelta: Boolean); override; procedure ProcessError(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange; const aCommand: IDASQLCommand; var CanRemoveFromDelta: Boolean; Error: Exception); override; end; implementation uses Dialogs, uDataModuleServer, uDAClasses, schContactosClient_Intf, uBusinessUtils, FactuGES_Intf, uROServer; { TBizContactosServer } procedure TBizContactosServer.AfterProcessChange(Sender: TDABusinessProcessor; aChange: TDADeltaChange; Processed: Boolean; var CanRemoveFromDelta: Boolean); begin inherited; case aChange.ChangeType of ctInsert: begin Insert_Categoria_Contacto(aChange); Insert_Datos_Contacto(aChange); end; ctUpdate: begin Update_Categoria_Contacto(aChange); Update_Datos_Contacto(aChange); end; ctDelete: begin Delete_Categoria_Contacto(aChange); Delete_Datos_Contacto(aChange); end; end; // No hay que quitar los deltas para que los datos del contacto se // mantengan por si alguna tabla detalle lo necesita // (por ejemplo, DireccionesContacto) CanRemoveFromDelta := False; end; procedure TBizContactosServer.Delete_Categoria_Contacto( aChange: TDADeltaChange); var ASchema : TDASchema; ACurrentConn : IDAConnection; ACommand : IDASQLCommand; begin ASchema := BusinessProcessor.Schema; ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor); ACommand := ASchema.NewCommand(ACurrentConn, 'Delete_ContactosCategorias'); try with ACommand do begin ParamByName('OLD_ID_CONTACTO').Value := aChange.OldValueByName[fld_ContactosID]; ParamByName('OLD_ID_CATEGORIA').Value := aChange.OldValueByName[fld_ContactosID_CATEGORIA]; Execute; end; finally ACommand := NIL; end; end; procedure TBizContactosServer.Delete_Datos_Contacto(aChange: TDADeltaChange); var ASchema : TDASchema; ACurrentConn : IDAConnection; ACommand : IDASQLCommand; begin ASchema := BusinessProcessor.Schema; ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor); //En el caso de querer tener los contactos separados por empresas en lugar de tenerlos en común ACommand := ASchema.NewCommand(ACurrentConn, 'Delete_ContactoEmpresa'); //En el caso de querer tener los contactos en común para todas las empresas // ACommand := ASchema.NewCommand(ACurrentConn, 'Delete_ContactoEmpresas'); try with ACommand do begin ParamByName('OLD_ID_CONTACTO').Value := aChange.OldValueByName[fld_ContactosID]; ParamByName('OLD_ID_EMPRESA').Value := aChange.OldValueByName[fld_ContactosID_EMPRESA]; Execute; end; finally ACommand := NIL; end; end; procedure TBizContactosServer.Insert_Categoria_Contacto( aChange: TDADeltaChange); var ASchema : TDASchema; ACurrentConn : IDAConnection; ACommand : IDASQLCommand; begin ASchema := BusinessProcessor.Schema; ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor); ACommand := ASchema.NewCommand(ACurrentConn, 'Insert_ContactosCategorias'); try with ACommand do begin ParamByName('ID_CONTACTO').Value := aChange.NewValueByName[fld_ContactosID]; ParamByName('ID_CATEGORIA').Value := aChange.NewValueByName[fld_ContactosID_CATEGORIA]; Execute; end; finally ACommand := NIL; end; end; procedure TBizContactosServer.Insert_Datos_Contacto(aChange: TDADeltaChange); var ASchema : TDASchema; ACurrentConn : IDAConnection; ACommand : IDASQLCommand; begin ASchema := BusinessProcessor.Schema; ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor); //En el caso de querer tener los contactos separados por empresas en lugar de tenerlos en común ACommand := ASchema.NewCommand(ACurrentConn, 'Insert_ContactoEmpresa'); //En el caso de querer tener los contactos en común para todas las empresas // ACommand := ASchema.NewCommand(ACurrentConn, 'Insert_ContactoEmpresas'); try with ACommand do begin ParamByName('ID_CONTACTO').Value := aChange.NewValueByName[fld_ContactosID]; ParamByName('ID_EMPRESA').Value := aChange.NewValueByName[fld_ContactosID_EMPRESA]; Execute; end; finally ACommand := NIL; end; end; procedure TBizContactosServer.ProcessError(Sender: TDABusinessProcessor; aChangeType: TDAChangeType; aChange: TDADeltaChange; const aCommand: IDASQLCommand; var CanRemoveFromDelta: Boolean; Error: Exception); begin inherited; //IMPORTANTE ESTO HACE QUE EL CLIENTE SE ENTERE DEL ERROR Y LOS BP ASOCIADOS EN EL //SCHEMA HAGAN ROLLBACK TAMBIEN CanRemoveFromDelta := True; raise Exception.Create(Error.Message); end; procedure TBizContactosServer.Update_Categoria_Contacto( aChange: TDADeltaChange); var ASchema : TDASchema; ACurrentConn : IDAConnection; ACommand : IDASQLCommand; begin ASchema := BusinessProcessor.Schema; ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor); //En el caso update nos da igual lo que se quiera modificar así que se queda igual ACommand := ASchema.NewCommand(ACurrentConn, 'Update_ContactosCategorias'); try with ACommand do begin ParamByName('ID_CONTACTO').Value := aChange.NewValueByName[fld_ContactosID]; ParamByName('OLD_ID_CONTACTO').Value := aChange.OldValueByName[fld_ContactosID]; ParamByName('ID_CATEGORIA').Value := aChange.NewValueByName[fld_ContactosID_CATEGORIA]; ParamByName('OLD_ID_CATEGORIA').Value := aChange.OldValueByName[fld_ContactosID_CATEGORIA]; Execute; end; finally ACommand := NIL; end; end; procedure TBizContactosServer.Update_Datos_Contacto(aChange: TDADeltaChange); var ASchema : TDASchema; ACurrentConn : IDAConnection; ACommand : IDASQLCommand; begin ASchema := BusinessProcessor.Schema; ACurrentConn := GetBusinessProcessorConnection(BusinessProcessor); //En el caso update nos da igual lo que se quiera modificar así que se queda igual ACommand := ASchema.NewCommand(ACurrentConn, 'Update_ContactoEmpresa'); try with ACommand do begin ParamByName('ID_CONTACTO').Value := aChange.NewValueByName[fld_ContactosID]; ParamByName('OLD_ID_CONTACTO').Value := aChange.OldValueByName[fld_ContactosID]; ParamByName('ID_EMPRESA').Value := aChange.NewValueByName[fld_ContactosID_EMPRESA]; ParamByName('OLD_ID_EMPRESA').Value := aChange.OldValueByName[fld_ContactosID_EMPRESA]; Execute; end; finally ACommand := NIL; end; end; function TBizContactosServer._DarReferenciaInterna( const ATipo: String): String; var AReferenciasService : IsrvReferencias; Intf : IInterface; AClientID : TGUID; begin CreateGUID(AClientID); GetClassFactory('srvReferencias').CreateInstance(AClientID, Intf); AReferenciasService := Intf as IsrvReferencias; Result := AReferenciasService.DarNuevaReferencia(ATipo, -1, ID_TIENDA) end; function TBizContactosServer._IncrementarReferenciaInterna( const ATipo: String): Boolean; var AReferenciasService : IsrvReferencias; Intf : IInterface; AClientID : TGUID; begin CreateGUID(AClientID); GetClassFactory('srvReferencias').CreateInstance(AClientID, Intf); AReferenciasService := Intf as IsrvReferencias; Result := AReferenciasService.IncrementarValorReferencia(ATipo, Self.REFERENCIA, -1, ID_TIENDA) end; initialization RegisterBusinessProcessorRules(BIZ_SERVER_CONTACTO, TBizContactosServer); end.