david
5c861bb24f
git-svn-id: https://192.168.0.254/svn/Proyectos.LuisLeon_FactuGES2/trunk@248 b2cfbe5a-eba1-4a0c-8b32-7feea0a119f2
452 lines
13 KiB
ObjectPascal
452 lines
13 KiB
ObjectPascal
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.
|