Tecsitel_FactuGES/Libreria/RdxGestorContadores.pas

{
===============================================================================
  Copyright (©) 2004. Rodax Software.
===============================================================================
  Los contenidos de este fichero son propiedad de Rodax Software titular del
  copyright. Este fichero sólo podrá ser copiado, distribuido y utilizado,
  en su totalidad o en parte, con el permiso escrito de Rodax Software, o de
  acuerdo con los términos y condiciones establecidas en el acuerdo/contrato
  bajo el que se suministra.
  -----------------------------------------------------------------------------
  Web:  www.rodax-software.com
===============================================================================
  Fecha primera versión: 09-05-2004
  Versión actual: 1.0.1
  Fecha versión actual: 24-06-2004
===============================================================================
  Modificaciones:

    Fecha         Comentarios
    ---------------------------------------------------------------------------
    24-06-2004    Error con el tratamiento de 'LONGITUD'.
===============================================================================
}
unit RdxGestorContadores;

{$INCLUDE COMPILE.INC}

interface

uses
  IBDatabase, Contadores;

type
  TTipoOperacion = (toIncrementar, toDecrementar);

  TRdxGestorContadores = class(TObject)
  private
    FDatabase : TIBDatabase;
    FTransaction : TIBTransaction;
    FCodigoEmpresa : variant;

    procedure SetCodigoEmpresa(const Value: variant);
    function DarNuevoCodigoTabla: Variant;
    function DarDatosContador(Contador: TContador;
                              var RegistroContador: TRegistroContador) : Boolean;
    function InsertarCabeceraContador(Contador : TContador; RegistroContador : TRegistroContador) : Boolean;
    function InsertarDetallesContador(Contador : TContador; RegistroContador : TRegistroContador) : Boolean;
    function DarDetallesContador(Contador: TContador; var ObjContador: TRegistroContador): Boolean;
    function ModificarContador(Contador: TContador; pvContador: Integer; pvSerie: Variant): Boolean; overload;
    function ModificarContador(Contador: TContador; Operacion: TTipoOperacion; Cantidad: Integer): Boolean; overload;
    procedure ComprobarContadores;
    function RecogerContador(Contador: TContador): TRegistroContador;
    function FormatearContador(Contador: TRegistroContador): String;
    function ValidarContador(Contador: TContador; Codigo: Variant): Boolean;
  public
    property BD : TIBDatabase read FDatabase write FDatabase;
    property Transaccion : TIBTransaction read FTransaction write FTransaction;
    property CodigoEmpresa : variant read FCodigoEmpresa write SetCodigoEmpresa;
    class function NewInstance: TObject; override;
    procedure FreeInstance; override;

    function DarNuevoCodigo(Contador: TContador): Variant;
    function IncrementarValor(Contador: TContador): Boolean;
    function DecrementarValor(Contador: TContador): Boolean;
    function ValidarCodigo(Contador: TContador; Codigo: Variant) : Boolean;
    function AsignarContador(Contador: TContador; Valor: Integer; Serie: Variant): Boolean;
    function FormatearCodigo(Contador: TContador; Codigo: variant): variant;
    function InsertarContador(Contador: TContador): Boolean;
    function DarValorContador(Contador: TContador): Variant;
    function DarSeriadoContador(Contador: TContador): Variant;
  end;

var
  GestorContadores : TRdxGestorContadores = nil;

implementation

uses
  SysUtils, IBSQL, StrFunc, DateFunc, IB, Mensajes
  {$IFDEF RDX_D7}, Variants{$ENDIF};

Const
  lsMensajeUnit = 'RdxGestorContadores: Método ';
  lsSeparador = '/';

{ TGestorContadores }

function TRdxGestorContadores.DarNuevoCodigoTabla: Variant;
//Recoge el siguiente codigo de tabla disponible
var
  oSQL : TIBSQL;
begin
  Result := '0';
  oSQL := TIBSQL.Create(nil);
  with oSQL do
  begin
    Database := FDatabase;
    Transaction := FTransaction;
    SQL.Add('select MAX(CODIGOTABLA) + 1 from CONTADORES ');
    try
      Prepare;
      ExecQuery;
      if not EsCadenaVacia(Fields[0].AsString) then
        Result := Fields[0].AsString;
    finally
      Close;
      Transaction := NIL;
      Free;
    end;
  end;
end;

function TRdxGestorContadores.DarDatosContador(Contador: TContador;
  var RegistroContador: TRegistroContador) : Boolean;
//Comprueba si ya existe el contador
var
  oSQL : TIBSQL;
begin
  Result := False;
  oSQL := TIBSQL.Create(nil);
  with oSQL do
  begin
    Database := FDatabase;
    Transaction := FTransaction;
    SQL.Add('select CODIGOTABLA, TABLA, LONGITUD, COMUN ');
    SQL.Add('from CONTADORES');
    SQL.Add('where TABLA = :TABLA');
    try
      ParamByName('TABLA').AsString := NombreTablasContadores[Contador];
      Prepare;
      ExecQuery;
      if (RecordCount <> 0) then begin
        RegistroContador.CodigoTabla := FieldByName('CODIGOTABLA').AsString;
        RegistroContador.Tabla := FieldByName('TABLA').AsString;

        RegistroContador.Longitud := FieldByName('LONGITUD').AsVariant;
        RegistroContador.EsComun := (FieldByName('COMUN').AsInteger = 1);
        Result := True;
      end;
    finally
      Close;
      Transaction := NIL;
      Free;
    end;
  end;
end;

function TRdxGestorContadores.FormatearContador(Contador: TRegistroContador): String;
//Formatea el codigo con la estructura SERIADOAAMMDD/XXX, siempre adaptandose al tamaño del contador
var
  Codigo: String;
  LongAux: Integer;
begin
  LongAux := Contador.Longitud;
  if (not esCadenaVacia(Contador.Seriado)) then begin
    Codigo := Contador.Seriado;
    LongAux := LongAux - length(Contador.Seriado);
  end;

  if (Contador.Ano) then begin
    Codigo := Codigo + Contador.ContAno;
    LongAux := LongAux - 2;
  end;

  if (Contador.Mes) then begin
    Codigo := Codigo + Contador.ContMes;
    LongAux := LongAux - 2;
  end;

  if (Contador.Dia) then begin
    Codigo := Codigo + Contador.ContMes;
    LongAux := LongAux - 2;
  end;

  if (not esCadenaVacia(Contador.Seriado)) then begin
    Codigo := Codigo + lsSeparador;
    LongAux := LongAux - 1;
  end;

  Codigo := Codigo + format('%.' + IntToStr(LongAux) + 'd', [Contador.Contador]);
  result := Codigo;
end;

procedure TRdxGestorContadores.FreeInstance;
begin
  if GestorContadores = Self then
  begin
    GestorContadores := NIL;
    inherited FreeInstance;
  end;
end;

class function TRdxGestorContadores.NewInstance: TObject;
begin
  if Assigned(GestorContadores) then
    Exception.Create('No se puede tener mas de una instancia')
  else begin
    Result := inherited NewInstance;
    with TRdxGestorContadores(Result) do
    begin
      FDatabase := NIL;
      FTransaction := NIL;
      FCodigoEmpresa := NULL;
    end;
  end;
end;

function TRdxGestorContadores.RecogerContador(Contador: TContador): TRegistroContador;
{ Función recursiva que devuelve una instancia del contador pasado por parametro.
  En el caso de no existir lo creara, tanto la cabecera como el detalle, es decir,
  que cada vez que se entre con una empresa diferente se creara una linea de detalle
  nueva en todos los contadores multiempresa. }
var
  lCont : TRegistroContador;
begin
  if not DarDatosContador(Contador, lCont) then
  begin
    InicializarContador(Contador, lCont);
    InsertarCabeceraContador(Contador, lCont);
    Result := RecogerContador(Contador);
  end
  else begin
    if not DarDetallesContador(Contador, lCont) then
    begin
      InicializarContador(Contador, lCont);
      InsertarDetallesContador(Contador, lCont);
      Result := RecogerContador(Contador);
    end
    else
    begin
      Result := lCont;
    end
  end;
end;

procedure TRdxGestorContadores.SetCodigoEmpresa(const Value: variant);
begin
  if FCodigoEmpresa <> Value then
  begin
    FCodigoEmpresa := Value;
    ComprobarContadores;
  end;
end;

function TRdxGestorContadores.InsertarCabeceraContador(Contador : TContador; RegistroContador : TRegistroContador) : Boolean;
// Inserta los datos del contador
var
  oSQL : TIBSQL;
begin
  Result := False;

  oSQL := TIBSQL.Create(nil);
  with oSQL do
  begin
    Database := FDatabase;
    Transaction := FTransaction;
    SQL.Add('insert into CONTADORES ');
    SQL.Add('(CODIGOTABLA, TABLA, LONGITUD, COMUN) ');
    SQL.Add('values (:CODIGOTABLA, :TABLA, :LONGITUD, :COMUN)');
    try
      ParamByName('CODIGOTABLA').AsVariant := DarNuevoCodigoTabla;
      ParamByName('TABLA').AsVariant := NombreTablasContadores[Contador];
      if (RegistroContador.EsComun) then
        ParamByName('COMUN').AsInteger := 1
      else
        ParamByName('COMUN').AsInteger := 0;

      ParamByName('LONGITUD').AsVariant := RegistroContador.Longitud;
      Prepare;
      ExecQuery;
      Result := True;
    except
      on E : EIBError do begin
        //LOG
        VerMensaje(lsMensajeUnit + 'anadirContador, ' + E.Message);
      end;
      on E : Exception do begin
        //LOG
        VerMensaje(lsMensajeUnit + 'anadirContador, ' + E.Message);
      end;
    end;
    Close;
    Transaction := NIL;
    Free;
  end;
end;

function TRdxGestorContadores.InsertarDetallesContador(
  Contador : TContador; RegistroContador : TRegistroContador) : Boolean;
// Insertar el detalle del nuevo contador
var
  oSQL : TIBSQL;
begin
  Result := False;
  oSQL := TIBSQL.Create(nil);
  with oSQL do
  begin
    Database := FDatabase;
    Transaction := FTransaction;

    SQL.Add('insert into DETALLECONTADORES (CODIGOTABLA');

    if not RegistroContador.EsComun then
       SQL.Add(', CODIGOEMPRESA');

    SQL.Add(', SERIADO, DIA, MES, ANO, CONTADOR');

    if (RegistroContador.Ano) then
      SQL.Add(', CONTANO');
    if (RegistroContador.Mes) then
      SQL.Add(', CONTMES');
    if (RegistroContador.Dia) then
      SQL.Add(', CONTDIA');

    SQL.Add(') values (:CODIGOTABLA');
    if not RegistroContador.EsComun then
       SQL.Add(', :CODIGOEMPRESA');

    SQL.Add(', :SERIADO, :DIA, :MES, :ANO, :CONTADOR');

    if (RegistroContador.Ano) then
      SQL.Add(', substr(CURRENT_DATE, 3, 4)');
    if (RegistroContador.Mes) then
      SQL.Add(', substr(CURRENT_DATE, 6, 7)');
    if (RegistroContador.Dia) then
      SQL.Add(', substr(CURRENT_DATE, 9, 10)');
    SQL.Add(')');

    try
      if not RegistroContador.EsComun then
         ParamByName('CODIGOEMPRESA').AsVariant := CodigoEmpresa;
      ParamByName('CODIGOTABLA').AsVariant := RegistroContador.CodigoTabla;
      ParamByName('SERIADO').AsVariant := RegistroContador.Seriado;

      if (RegistroContador.Dia) then
        ParamByName('DIA').AsInteger := 1
      else
        ParamByName('DIA').AsInteger := 0;

      if (RegistroContador.Mes) then
        ParamByName('MES').AsInteger := 1
      else
        ParamByName('MES').AsInteger := 0;

      if (RegistroContador.Ano) then
        ParamByName('ANO').AsInteger := 1
      else
        ParamByName('ANO').AsInteger := 0;

      ParamByName('CONTADOR').AsInteger := RegistroContador.Contador;
      Prepare;
      ExecQuery;
      Result := True;
    except
      on E : EIBError do begin
        //LOG
        verMensaje(lsMensajeUnit + 'anadirDetalles, ' + E.Message);
      end;
      on E : Exception do begin
        //LOG
        verMensaje(lsMensajeUnit + 'anadirDetalles, ' + E.Message);
      end;
    end;
    Close;
    Transaction := NIL;
    Free;
  end;
end;

function TRdxGestorContadores.DarDetallesContador(Contador: TContador;
  var ObjContador: TRegistroContador): Boolean;
{ Comprueba si existen detalles del contador pasado por parametro.
  Si es así, los rellena y devuelve true. }
var
  oSQL : TIBSQL;
begin
  Result := False;
  oSQL := TIBSQL.Create(nil);
  with oSQL do begin
    Database := FDatabase;
    Transaction := FTransaction;
    SQL.Add('select CODIGOEMPRESA, CODIGOTABLA, SERIADO, DIA, MES, ANO, CONTDIA, CONTMES, CONTANO, CONTADOR ');
    SQL.Add('from DETALLECONTADORES');
    SQL.Add('where CODIGOTABLA = :CODIGOTABLA');
    SQL.Add('and ((CODIGOEMPRESA = :CODIGOEMPRESA) OR (CODIGOEMPRESA IS NULL))');
    SQL.Add('and (CONTANO = SUBSTR(CURRENT_DATE, 3, 4) or CONTANO IS NULL) ');
    SQL.Add('and (CONTMES = SUBSTR(CURRENT_DATE, 6, 7) or CONTMES IS NULL) ');
    SQL.Add('and (CONTDIA = SUBSTR(CURRENT_DATE, 9, 10) or CONTDIA IS NULL)');

    try
      ParamByName('CODIGOEMPRESA').AsVariant := CodigoEmpresa;
      ParamByName('CODIGOTABLA').AsVariant := ObjContador.CodigoTabla;
      Prepare;
      ExecQuery;

      if (RecordCount <> 0) then
      begin
        ObjContador.Seriado := FieldByName('SERIADO').AsVariant;
        ObjContador.Dia := FieldByName('DIA').AsInteger = 1;
        ObjContador.Mes := FieldByName('MES').AsInteger = 1;
        ObjContador.Ano := FieldByName('ANO').AsInteger = 1;
        ObjContador.ContDia := FieldByName('CONTDIA').AsVariant;
        ObjContador.ContMes := FieldByName('CONTMES').AsVariant;
        ObjContador.ContAno := FieldByName('CONTANO').AsVariant;
        ObjContador.Contador := FieldByName('CONTADOR').AsInteger;
        Result := True;
      end
      else begin
        oSQL.Close;
        SQL.Clear;
        SQL.Add('select SERIADO');
        SQL.Add('from DETALLECONTADORES');
        SQL.Add('where CODIGOTABLA = :CODIGOTABLA');
        SQL.Add('and ((CODIGOEMPRESA = :CODIGOEMPRESA) OR (CODIGOEMPRESA IS NULL))');
        SQL.Add('ORDER BY CAST(DETALLECONTADORES.CONTANO as INTEGER) desc,');
        SQL.Add('CAST(DETALLECONTADORES.CONTMES as INTEGER) desc,');
        SQL.Add('CAST(DETALLECONTADORES.CONTDIA as INTEGER) desc');
        ParamByName('CODIGOEMPRESA').AsVariant := CodigoEmpresa;
        ParamByName('CODIGOTABLA').AsVariant := ObjContador.CodigoTabla;
        Prepare;
        ExecQuery;
        if (RecordCount <> 0) then
           ObjContador.Seriado := FieldByName('SERIADO').AsVariant;
      end;
    finally
      Close;
      Transaction := NIL;
      Free;
    end;
  end;
end;

function TRdxGestorContadores.ModificarContador(Contador: TContador; pvContador: Integer; pvSerie: Variant): Boolean;
var
  oSQL : TIBSQL;
  lCont : TRegistroContador;
begin
  Result := False;
  lCont := RecogerContador(Contador);

  oSQL := TIBSQL.Create(nil);
  with oSQL do
  begin
    Database := FDatabase;
    Transaction := FTransaction;
    SQL.Add('update DETALLECONTADORES ');
    SQL.Add('set CONTADOR = :CONTADOR ');

    if (not VarIsNull(pvSerie)) then
       SQL.Add(', SERIADO = :SERIADO ');

    SQL.Add('where CODIGOTABLA = :CODIGOTABLA ');

    if not (lCont.EsComun) then
      SQL.Add('and CODIGOEMPRESA = :CODIGOEMPRESA ');

    SQL.Add('and (CONTANO = SUBSTR(CURRENT_DATE, 3, 4) or CONTANO IS NULL) ');
    SQL.Add('and (CONTMES = SUBSTR(CURRENT_DATE, 6, 7) or CONTMES IS NULL)');

    try
      if not (lCont.EsComun) then
         ParamByName('CODIGOEMPRESA').AsVariant := CodigoEmpresa;
      ParamByName('CODIGOTABLA').AsVariant := lCont.CodigoTabla;
      ParamByName('CONTADOR').AsInteger := pvContador;

      if (not VarIsNull(pvSerie)) then
         ParamByName('SERIADO').AsVariant := pvSerie;

      Prepare;
      ExecQuery;
      if (RowsAffected = 0) then
        //LOG
        VerMensaje(lsMensajeUnit + 'asigContador, ' + 'No se ha podido asignar el contador');
      Result := True;
    finally
      Close;
      Transaction := NIL;
      Free;
    end;
  end;
end;

function TRdxGestorContadores.ModificarContador(Contador: TContador;
  Operacion: TTipoOperacion; Cantidad: Integer): Boolean;
var
  oSQL : TIBSQL;
  lCont : TRegistroContador;
  lsAux : String;
begin
  Result := False;

  if not DarDatosContador(Contador, lCont) then
    exit;

  if (Operacion = toDecrementar) then
    lsAux := '- ' + IntToStr(Cantidad)
  else begin
    if (Operacion = toIncrementar) then
      lsAux := '+ ' + IntToStr(Cantidad)
    else
      exit;
  end;

  oSQL := TIBSQL.Create(nil);
  with oSQL do
  begin
    Database := FDatabase;
    Transaction := FTransaction;
    SQL.Add('update DETALLECONTADORES ');
    SQL.Add('set CONTADOR = CONTADOR ' + lsAux);
    SQL.Add('where CODIGOTABLA = :CODIGOTABLA');

    if not (lCont.EsComun) then
       SQL.Add(' and CODIGOEMPRESA = :CODIGOEMPRESA');

    SQL.Add('and (CONTANO = SUBSTR(CURRENT_DATE, 3, 4) or CONTANO IS NULL)');
    SQL.Add('and (CONTMES = SUBSTR(CURRENT_DATE, 6, 7) or CONTMES IS NULL)');
    try
      if not (lCont.EsComun) then
         ParamByName('CODIGOEMPRESA').AsVariant := CodigoEmpresa;
      ParamByName('CODIGOTABLA').AsVariant := lCont.CodigoTabla;

      Prepare;
      ExecQuery;
      if (RowsAffected = 0) then
        //LOG
        VerMensaje(lsMensajeUnit + 'incdecCodigo, ' + 'No se ha podido incrementar el contador');
      Result := True;
    finally
      Close;
      Transaction := NIL;
      Free;
    end;
  end;
end;

function TRdxGestorContadores.ValidarContador(Contador: TContador;
  Codigo: Variant): Boolean;
var
  Long : Integer;
  LongAux : Integer;
  lCont : TRegistroContador;
begin
  Result := False;

  lCont := RecogerContador(Contador);
  if VarIsNull(lCont.Longitud) then
  begin
    Result := EsNumerico(Codigo);
    Exit;
  end;

  Long := lCont.Longitud;
  LongAux := 1;

  if (not EsCadenaVacia(lCont.Seriado)) then begin
    if (Pos(lCont.Seriado, UpperCase(Codigo)) = 0) then
      exit;
    LongAux := LongAux + length(lCont.Seriado);
  end;

  if (lCont.Ano) then begin
    if not EsNumerico(Copy(Codigo, LongAux, 2)) then
      exit;
    LongAux := LongAux + 2;
  end;

  if (lCont.Mes) then begin
    if not EsMes(Copy(Codigo, LongAux, 2)) then
      exit;
    LongAux := LongAux + 2;
  end;

  if (lCont.Dia) then begin
    if not EsDia(Copy(Codigo, LongAux, 2)) then
      exit;
    LongAux := LongAux + 2;
  end;

  if (not EsCadenaVacia(lCont.Seriado)) then begin
    if (Pos(lsSeparador, Copy(Codigo, LongAux, 1)) = 0) then
      exit;
    LongAux := LongAux + 1;
  end;

  if (not EsNumerico(Copy(Codigo, LongAux, (Long - LongAux + 1)))) then
    exit;
  Result := True;
end;

function TRdxGestorContadores.DarNuevoCodigo(
  Contador: TContador): Variant;
{ Función llamada por todos los dmTabla de la aplicación, devuelve el código
  siguiente del contador pasado por parámetro. }
var
  lCont : TRegistroContador;
begin
  lCont := RecogerContador(Contador);
  if not VarIsNull(lCont.Longitud) then
    Result := FormatearContador(lCont)
  else
    Result := lCont.Contador;
end;

function TRdxGestorContadores.FormatearCodigo(Contador: TContador; Codigo: variant): variant;
// Formatea el código rellenando la parte contador XXX del código a ceros.
var
  lCont : TRegistroContador;
  lInd1 : Integer;

begin
  lCont := RecogerContador(Contador);
  if VarIsNull(lCont.Longitud) then
    Result := Contador;

  // Extraer los valores del contador
  lInd1 := Pos(lsSeparador, Codigo);
  lCont.Contador := StrToInt(Copy(Codigo, (lInd1+1), (Length(Codigo) - lInd1)));
  if (lCont.Ano) then
    lCont.ContAno := Copy(Codigo, 4, 2);
  if (lCont.Mes) then
    lCont.ContMes := Copy(Codigo, 6, 2);
  if (lCont.Dia) then
    lCont.ContDia := Copy(Codigo, 8, 2);

  Result := FormatearContador(lCont);
end;

function TRdxGestorContadores.DecrementarValor(Contador: TContador): Boolean;
begin
  Result := ModificarContador(Contador, toDecrementar, 1);
end;

function TRdxGestorContadores.IncrementarValor(Contador: TContador): Boolean;
begin
  Result := ModificarContador(Contador, toIncrementar, 1);
end;

function TRdxGestorContadores.ValidarCodigo(Contador: TContador;
  Codigo: Variant): Boolean;
begin
  Result := ValidarContador(Contador, Codigo);
end;

function TRdxGestorContadores.AsignarContador(Contador: TContador;
  Valor: Integer; Serie: Variant): Boolean;
begin
  Result := ModificarContador(Contador, Valor, Serie);
end;

function TRdxGestorContadores.DarSeriadoContador(
  Contador: TContador): Variant;
var
  lCont : TRegistroContador;
begin
  lCont := RecogerContador(Contador);
  Result := lCont.Seriado;
end;

function TRdxGestorContadores.DarValorContador(Contador: TContador): Variant;
var
  lCont : TRegistroContador;
begin
  lCont := RecogerContador(Contador);
  Result := lCont.Contador;
end;

function TRdxGestorContadores.InsertarContador(Contador: TContador): Boolean;
var
  lCont : TRegistroContador;
begin
  lCont := RecogerContador(Contador);
  Result := (lCont.Tabla <> NULL);
end;

procedure TRdxGestorContadores.ComprobarContadores;
var
  i : TContador;
begin
  for i := Low(TContador) to High(TContador) do
    DarNuevoCodigo(i);
  if FTransaction.InTransaction then
    FTransaction.CommitRetaining;
end;

procedure LiberarGestorContadores; far;
Begin
  if Assigned(GestorContadores) then
    FreeAndNil(GestorContadores);
end;

initialization
  GestorContadores := TRdxGestorContadores.Create;
  SysUtils.AddExitProc(LiberarGestorContadores);
end.

end.