unit CVBNorma19SEPAXML;

interface

uses
  Messages, SysUtils, Classes, Dialogs, SEPACommon, SEPADirectDebit;

type
  TSEPAXMLPresentador = record
    Nombre : string;
    NIFCIF : string;
    Sufijo : string;
    Pais: string;
  end;

  TSEPAXMLFichero = record
    Fecha : TDateTime;
    Identificador : string;
  end;

  TSEPAXMLReceptor = record
    Oficina : string;
    Entidad : string;
  end;

  TSEPAXMLAcreedor = record
    Nombre : string;
    Direccion1 : string;
    Direccion2 : string;
    Direccion3 : string;
    Pais : string;
    CuentaIBAN : string;
    Sufijo : string;
    NIFCIF : string;
  end;

  TSEPAXMLDeudor = record
    Nombre : string;
    Direccion1 : string;
    Direccion2 : string;
    Direccion3 : string;
    Pais : string;
    CuentaIBAN : string;
    CodigoBIC : string;
  end;

  TSEPAXMLAdeudo = record
    Referencia : string;
    Importe : Currency;
  end;



  TCVBNorma19SEPAXML = class(TComponent)
  private
    pReg: array[0..602] of char; // 2 digitos más por el #13 #10

    _LL_: integer;  // Longitud Línea. Aquí almacenamos el valor 164 para usarlo
    // en el resto del componente.

    _INDICA_: string;

    _CERO_, _SPCE_: char;

    _MSK_EU_: string;

    _PAIS_DEFECTO_ : string;

    HayError: boolean;

    FDepura: boolean;


    FEnCasoError: TNotifyEvent;
    CRLF:    string;


    cSumaImportesTotalesAdeudos : Currency; // Suma de los importes (campo 8) en los registros 003 (adeudos)
    iNumeroRegistrosAdeudos: integer; // Número de registros individuales '003', adeudos
    iNumeroRegistrosAcreedor : integer; // Número de registros de un bloque de acreedor (002, 003 y 004)

    iNumeroRegistros: integer;  // Nº de registros individuales (tipo '003')
    iTotalRegistros: integer; // Total de registros del fichero incluida el registro cabecera y el registro de totales generales 


    FDDInit: TDirectDebitInitiation;
    FDDPayInfo: TDirectDebitPaymentInformation;
    FDDTransInfo: TDirectDebitTransactionInformation;

    procedure ComprobarDatos(sParte: string);
    function IdentificadorAcreedorSEPA(): String;
    function IdentificadorPresentadorSEPA(): String;
  protected
    procedure Error(iErr: integer); dynamic;
  public
    NrError: integer;
    FNomFic: string; // Nombre del archivo en disco

    Presentador : TSEPAXMLPresentador;
    Fichero : TSEPAXMLFichero;
    Receptor : TSEPAXMLReceptor;
    Acreedor : TSEPAXMLAcreedor;
    Deudor : TSEPAXMLDeudor;
    Adeudo : TSEPAXMLAdeudo;

    FecAbono: TDateTime;
    
    FechaCobro : TDateTime;

    constructor Create(AOwner: TComponent); override;

    procedure Abrir;
    procedure GenerarCabeceraPresentador;
    procedure GenerarCabeceraAcreedor;
    procedure GenerarRegistroAdeudo;
    procedure GenerarTotalAcreedor;
    procedure Cerrar;
    destructor Destroy; override;
  published
    property NomFichero: string Read FNomFic Write FNomFic;
    property Depura: boolean Read FDepura Write FDepura default False;
    property EnCasoError: TNotifyEvent Read FEnCasoError Write FEnCasoError;
    { Published declarations }
  end;

implementation

uses
  Windows, uStringsUtils, CVBUtils;

constructor TCVBNorma19SEPAXML.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  {Asignar la propiedades por defecto}

  _LL_ := high(pReg);

  _INDICA_ := '<--';
  _CERO_   := '0';
  _SPCE_   := ' ';

  _MSK_EU_ := '00000000.00';

  _PAIS_DEFECTO_ := 'ES';

  FDDInit := TDirectDebitInitiation.Create;
  FDDInit.Schema := SCHEMA_PAIN_008_001_02;
end;

destructor TCVBNorma19SEPAXML.Destroy;
begin
//  FreeAndNil(FDDTransInfo);
//  FreeAndNil(FDDPayInfo);
  FreeAndNil(FDDInit);
  inherited;
end;

//*******************************************************************************

procedure TCVBNorma19SEPAXML.Abrir;
begin
  HayError := False;

  //AssignFile(NFic, FNomFic);
{$I+}
  ///rewrite(Nfic, _LL_);
{$I-}
{  if IOResult <> 0 then
    Error(0);

  iNumeroRegistros := 0;
  iTotalRegistros  := 0;

  CRLF := #13 + #10;}

end;


procedure TCVBNorma19SEPAXML.GenerarCabeceraPresentador;
begin
  HayError := False;
  FDDInit.GrpHdrInitgPtyName := Presentador.Nombre;
  FDDInit.GrpHdrInitgPtyId := IdentificadorPresentadorSEPA();
end;

procedure TCVBNorma19SEPAXML.GenerarRegistroAdeudo;
var
  auxCadena : string;
begin
  HayError := False;

  auxCadena := Adeudo.Referencia;
  auxCadena := auxCadena + FormatDateTime('yyyymmddhhnnsszzz', Now);

// direct debit transaction (including mandate details)
  FDDTransInfo := TDirectDebitTransactionInformation.Create;
  FDDTransInfo.PmtIdEndToEndId := auxCadena;
  FDDTransInfo.InstdAmt        := Adeudo.Importe;
  FDDTransInfo.DbtrNm          := Deudor.Nombre;
  FDDTransInfo.DbtrAcct.IBAN   := Deudor.CuentaIBAN;
  FDDTransInfo.DbtrAgt.BIC     := Deudor.CodigoBIC;
  FDDTransInfo.DbtrAgt.OthrID  := FIN_INSTN_NOTPROVIDED;
  FDDTransInfo.RmtInfUstrd     := Adeudo.Referencia;
  FDDTransInfo.DrctDbtTxMndtRltdInf.MndtId    := Adeudo.Referencia;
  FDDTransInfo.DrctDbtTxMndtRltdInf.DtOfSgntr := Now;
  {FDDTransInfo.DrctDbtTxMndtRltdInf.AmdmntInd := DD_MandateAmendmentInformationDetails_CheckBox.Checked;
  FDDTransInfo.DrctDbtTxMndtRltdInf.AmdmntInfDtls.OrgnlMndtId                    := DD_OriginalMandateId_Edit.Text;
  FDDTransInfo.DrctDbtTxMndtRltdInf.AmdmntInfDtls.OrgnlCdtrSchmeIdNm             := DD_OriginalCreditorName_Edit.Text;
  FDDTransInfo.DrctDbtTxMndtRltdInf.AmdmntInfDtls.OrgnlCdtrSchmeIdIdPrvtIdOthrId := DD_OriginalCreditorIdentifier_Edit.Text;
  FDDTransInfo.DrctDbtTxMndtRltdInf.AmdmntInfDtls.OrgnlDbtrAcct.IBAN             := DD_OriginalDebtorAccountIBAN_Edit.Text;
  FDDTransInfo.DrctDbtTxMndtRltdInf.AmdmntInfDtls.OrgnlDbtrAgtFinInstIdOthrId    := IfThen(DD_OriginalDebtorFinInstSMNDA_CheckBox.Checked, ORGNL_DBTR_AGT_SMNDA, '');}
  FDDPayInfo.AppendDrctDbtTxInfEntry(FDDTransInfo);

end;

procedure TCVBNorma19SEPAXML.GenerarTotalAcreedor;
begin
end;

function TCVBNorma19SEPAXML.IdentificadorAcreedorSEPA(): String;
var
  dcstr : String;
  dc: integer;
begin
  dcstr := Acreedor.NIFCIF;
  dcstr := Trim(StringReplace(AnsiUpperCase(dcstr), ' ', '', [rfReplaceAll]));
  dcstr := dcstr + Acreedor.Pais + '00';
  dc := 98 - SEPAModulo97(dcstr);
  result := Acreedor.Pais + Format('%.2d', [dc]) + Acreedor.Sufijo + Acreedor.NIFCIF;
end;

function TCVBNorma19SEPAXML.IdentificadorPresentadorSEPA: String;
var
  dcstr : String;
  dc: integer;
begin
  dcstr := Presentador.NIFCIF;
  dcstr := Trim(StringReplace(AnsiUpperCase(dcstr), ' ', '', [rfReplaceAll]));
  dcstr := dcstr + Presentador.Pais + '00';
  dc := 98 - SEPAModulo97(dcstr);
  result := Presentador.Pais + Format('%.2d', [dc]) + Presentador.Sufijo + Presentador.NIFCIF;
end;

procedure TCVBNorma19SEPAXML.GenerarCabeceraAcreedor;
begin
  HayError := False;

  FDDPayInfo := TDirectDebitPaymentInformation.Create;
  FDDPayInfo.PmtTpInfLclInstrmCd       := LCL_INSTRM_CD_CORE;
  FDDPayInfo.PmtTpInfSeqTp             := SEQ_TP_OOFF;
  FDDPayInfo.ReqdColltnDt              := FechaCobro;
  FDDPayInfo.CdtrNm                    := Acreedor.Nombre;
  FDDPayInfo.CdtrAcct.IBAN             := Acreedor.CuentaIBAN;
  FDDPayInfo.CdtrAgt.BIC               := '';
  FDDPayInfo.CdtrAgt.OthrID            := FIN_INSTN_NOTPROVIDED;
  FDDPayInfo.CdtrSchmeIdIdPrvtIdOthrId := IdentificadorAcreedorSEPA();
  FDDInit.AppendPmtInfEntry(FDDPayInfo);
end;

procedure TCVBNorma19SEPAXML.ComprobarDatos(sParte: string);
var
  bError: boolean;
begin
  bError := False;

  if sParte = '01' then // cabecera / presentador
  begin
    if EsCadenaVacia(Presentador.NIFCIF) then
    begin
      Presentador.NIFCIF := _INDICA_;
      bError := True;
    end
    else
      Presentador.NIFCIF := UpperCase(Presentador.NIFCIF);

    if EsCadenaVacia(Presentador.Sufijo) then
    begin
      Presentador.Sufijo := _INDICA_;
      bError := True;
    end;

    if EsCadenaVacia(Presentador.Nombre) then
    begin
      Presentador.Nombre := _INDICA_;
      bError := True;
    end
    else
      Presentador.Nombre := UpperCase(ReplaceAccents(Presentador.Nombre));

    if EsCadenaVacia(Fichero.Identificador) then
    begin
      Fichero.Identificador := _INDICA_;
      bError := True;
    end;

    if EsCadenaVacia(Receptor.Entidad) then
    begin
      Receptor.Entidad := _INDICA_;
      bError := True;
    end;

    if EsCadenaVacia(Receptor.Oficina) then
    begin
      Receptor.Oficina := _INDICA_;
      bError := True;
    end;

    if bError then
      ShowMessage('Faltan datos al procesar el registro 01: ' + CRLF + CRLF +
        'NIF/CIF del presentador:     ' + Presentador.NIFCIF + CRLF +
        'Sufijo del presentador:      ' + Presentador.Sufijo + CRLF +
        'Nombre del presentador:      ' + Presentador.Nombre + CRLF +
        'Identificador del fichero:   ' + Fichero.Identificador + CRLF +
        'Cód. entidad del receptor:   ' + Receptor.Entidad + CRLF +
        'Cód. oficina del receptor:   ' + Receptor.Oficina + CRLF
      );
  end;

  if sParte = '02' then // acreedor
  begin
    if EsCadenaVacia(Acreedor.NIFCIF) then
    begin
      Acreedor.NIFCIF := _INDICA_;
      bError := True;
    end
    else
      Acreedor.NIFCIF := UpperCase(Acreedor.NIFCIF);

    if EsCadenaVacia(Acreedor.Nombre) then
    begin
      Acreedor.Nombre := _INDICA_;
      bError := True;
    end
    else
      Acreedor.Nombre := UpperCase(ReplaceAccents(Acreedor.Nombre));

    if EsCadenaVacia(Acreedor.Direccion1) then
    begin
      Acreedor.Direccion1 := _INDICA_;
      bError := True;
    end
    else
      Acreedor.Direccion1 := UpperCase(ReplaceAccents(Acreedor.Direccion1));

    Acreedor.Direccion2 := UpperCase(ReplaceAccents(Acreedor.Direccion2));
    Acreedor.Direccion3 := UpperCase(ReplaceAccents(Acreedor.Direccion3));
    Acreedor.Pais := UpperCase(ReplaceAccents(Acreedor.Pais));

    if EsCadenaVacia(Acreedor.CuentaIBAN) then
    begin
      Acreedor.CuentaIBAN := _INDICA_;
      bError := True;
    end;

    if EsCadenaVacia(Acreedor.Sufijo) then
    begin
      Acreedor.Sufijo := _INDICA_;
      bError := True;
    end;

    if bError then
      ShowMessage('Faltan datos al procesar el registro 02: ' + CRLF + CRLF +
        'NIF/CIF del acreedor:     ' + Acreedor.NIFCIF + CRLF +
        'Sufijo del acreedor:      ' + Acreedor.Sufijo + CRLF +
        'Nombre del acreedor:      ' + Acreedor.Nombre + CRLF +
        'Cuenta IBAN del acreedor: ' + Acreedor.CuentaIBAN + CRLF +
        'Dirección 1 del acreedor: ' + Acreedor.Direccion1 + CRLF
      );
  end;


  if sParte = '03' then // deudor
  begin
    // Quitar espacios y caracteres no estándar
    Adeudo.Referencia := StringReplace(UpperCase(ReplaceAccents(Adeudo.Referencia)), ' ', '', [rfReplaceAll]);

    if EsCadenaVacia(Deudor.Nombre) then
    begin
      Deudor.Nombre := _INDICA_;
      bError := True;
    end
    else
      Deudor.Nombre := UpperCase(ReplaceAccents(Deudor.Nombre));

    if EsCadenaVacia(Deudor.Direccion1) then
    begin
      Deudor.Direccion1 := _INDICA_;
      bError := True;
    end
    else
      Deudor.Direccion1 := UpperCase(ReplaceAccents(Deudor.Direccion1));

    Deudor.Direccion2 := UpperCase(ReplaceAccents(Deudor.Direccion2));
    Deudor.Direccion3 := UpperCase(ReplaceAccents(Deudor.Direccion3));
    Deudor.Pais := UpperCase(ReplaceAccents(Deudor.Pais));

    if EsCadenaVacia(Deudor.CuentaIBAN) then
    begin
      Deudor.CuentaIBAN := _INDICA_;
      bError := True;
    end;

    // No obligar a tener código BIC/SWIFT
    {if EsCadenaVacia(Deudor.CodigoBIC) then
    begin
      Deudor.CodigoBIC := _INDICA_;
      bError := True;
    end;}


    if bError then
      ShowMessage('Faltan datos al procesar el registro 03: ' + CRLF + CRLF +
        'Nombre del deudor:      ' + Deudor.Nombre + CRLF +
        'Dirección 1 del deudor: ' + Deudor.Direccion1 + CRLF +
        'Cuenta IBAN del deudor: ' + Deudor.CuentaIBAN + CRLF +
        'Código BIC del deudor: ' + Deudor.CodigoBIC
      );
  end;

end;


procedure TCVBNorma19SEPAXML.Cerrar;
var
  messages :  TStringList;
begin

  messages := FDDInit.Validate;
  {if ((messages.Count = 0) or (MessageDlg(messages.Text, mtError, [mbOk, mbIgnore], 0) = mrIgnore)) and
      SaveDialog.Execute then}
    FDDInit.SaveToDisk(FNomFic);
end;


procedure TCVBNorma19SEPAXML.Error(iErr: integer);
begin
  {NrError  := iErr;
  HayError := True;

  if Assigned(FEnCasoError) then
    FEnCasoError(Self)
  else
    CloseFile(NFic);
    if NrError = _LL_ then
      raise Exception.Create('Error en la longitud de la línea')
    else
      raise Exception.Create('Error en la generación del fichero');}
end;


end.