AbetoDesign_FactuGES2/Source/Modulos/Contactos/Model/uBizContactosServer.pas
2022-10-21 09:41:20 +00:00

266 lines
8.6 KiB
ObjectPascal
Raw Blame History

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<6F>n
ACommand := ASchema.NewCommand(ACurrentConn, 'Delete_ContactoEmpresa');
//En el caso de querer tener los contactos en com<6F>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<6F>n
ACommand := ASchema.NewCommand(ACurrentConn, 'Insert_ContactoEmpresa');
//En el caso de querer tener los contactos en com<6F>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<61> 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<61> 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, ID_EMPRESA, -1)
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, ID_EMPRESA, -1)
end;
initialization
RegisterBusinessProcessorRules(BIZ_SERVER_CONTACTO, TBizContactosServer);
end.