diff --git a/Source/Base/Utiles/uDisplayUtils.pas b/Source/Base/Utiles/uDisplayUtils.pas
new file mode 100644
index 0000000..4228e49
--- /dev/null
+++ b/Source/Base/Utiles/uDisplayUtils.pas
@@ -0,0 +1,67 @@
+unit uDisplayUtils;
+
+interface
+
+
+uses
+ Windows, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ uGUIBase, uCustomEditor;
+
+procedure ScaleFormFont(AForm : TForm);
+
+implementation
+
+uses
+ TypInfo;
+
+procedure SetFontProperties(Control: TControl; Name: TFontName; Size: Integer; Styles: TFontStyles);
+// Set font properties
+var
+ Index: Integer;
+ Font: TFont;
+ AnObject: TObject;
+ ChildControl: TControl;
+begin
+ // Set font properties
+ try
+ AnObject := GetObjectProp(Control, 'Font', nil);
+ if AnObject is TFont then
+ begin
+ // Set properties
+ Font := TFont(AnObject);
+ Font.Name := Name;
+ Font.Size := Size;
+ Font.Style := Styles;
+ end;
+ except
+ // ignorar las excepciones EPropertyError por no encontrar la propiedad
+
+ end;
+
+ // Set child font properties
+ if Control is TWinControl then
+ begin
+ // Set
+ for Index := 0 to TWinControl(Control).ControlCount - 1 do
+ begin
+ // Child control
+ ChildControl := TWinControl(Control).Controls[Index];
+
+ // Set font properties
+ try
+ SetFontProperties(ChildControl, Name, Size, Styles);
+ except
+ // ignorar las excepciones EPropertyError por no encontrar la propiedad
+ end;
+ end;
+ end;
+end;
+
+procedure ScaleFormFont(AForm : TForm);
+begin
+ AForm.ScaleBy(Screen.PixelsPerInch, 96);
+ SetFontProperties(AForm, Screen.IconFont.Name, Screen.IconFont.Size, Screen.IconFont.Style);
+end;
+
+end.
+
diff --git a/Source/Cliente/FactuGES.identcache b/Source/Cliente/FactuGES.identcache
index fd9914e..6193afd 100644
Binary files a/Source/Cliente/FactuGES.identcache and b/Source/Cliente/FactuGES.identcache differ
diff --git a/Source/Cliente/FactuGES.res b/Source/Cliente/FactuGES.res
index d4c2052..e37ce5c 100644
Binary files a/Source/Cliente/FactuGES.res and b/Source/Cliente/FactuGES.res differ
diff --git a/Source/Modulos/Banca electronica/Controller/BancaElectronica_controller.dpk b/Source/Modulos/Banca electronica/Controller/BancaElectronica_controller.dpk
index dec9a44..93846c3 100644
Binary files a/Source/Modulos/Banca electronica/Controller/BancaElectronica_controller.dpk and b/Source/Modulos/Banca electronica/Controller/BancaElectronica_controller.dpk differ
diff --git a/Source/Modulos/Banca electronica/Controller/BancaElectronica_controller.dproj b/Source/Modulos/Banca electronica/Controller/BancaElectronica_controller.dproj
index d19a7ce..ee78423 100644
--- a/Source/Modulos/Banca electronica/Controller/BancaElectronica_controller.dproj
+++ b/Source/Modulos/Banca electronica/Controller/BancaElectronica_controller.dproj
@@ -54,6 +54,7 @@
+
@@ -61,10 +62,14 @@
+
+
+
+
diff --git a/Source/Modulos/Banca electronica/Controller/View/uIEditorExportacionNorma19SEPAXML.pas b/Source/Modulos/Banca electronica/Controller/View/uIEditorExportacionNorma19SEPAXML.pas
new file mode 100644
index 0000000..fb5d799
--- /dev/null
+++ b/Source/Modulos/Banca electronica/Controller/View/uIEditorExportacionNorma19SEPAXML.pas
@@ -0,0 +1,32 @@
+unit uIEditorExportacionNorma19SEPAXML;
+
+interface
+
+type
+ IEditorExportacionNorma19SEPAXML = interface
+ ['{AE5B7884-D53B-4384-821E-72A968A9CC8C}']
+
+ procedure SetCodigoEntidad(const AValue: String);
+ function GetCodigoEntidad : String;
+ property CodigoEntidad : String read GetCodigoEntidad write SetCodigoEntidad;
+
+ procedure SetCodigoAgencia(const AValue: String);
+ function GetCodigoAgencia : String;
+ property CodigoAgencia : String read GetCodigoAgencia write SetCodigoAgencia;
+
+ procedure SetFechaCargo(const AValue: TDateTime);
+ function GetFechaCargo : TDateTime;
+ property FechaCargo : TDateTime read GetFechaCargo write SetFechaCargo;
+
+ procedure SetFichero(const AValue: String);
+ function GetFichero : String;
+ property Fichero : String read GetFichero write SetFichero;
+
+ function ShowModal : Integer;
+ procedure Release;
+ end;
+
+
+implementation
+
+end.
diff --git a/Source/Modulos/Banca electronica/Controller/uBancaElectronicaController.pas b/Source/Modulos/Banca electronica/Controller/uBancaElectronicaController.pas
index 731d077..799b476 100644
--- a/Source/Modulos/Banca electronica/Controller/uBancaElectronicaController.pas
+++ b/Source/Modulos/Banca electronica/Controller/uBancaElectronicaController.pas
@@ -34,6 +34,7 @@ type
['{8C646A34-AFDF-4F09-A8BA-D6D40B5A91B8}']
procedure GenerarFicheroNorma19 (const IDRemesa : Integer);
procedure GenerarFicheroNorma19SEPA (const IDRemesa : Integer);
+ procedure GenerarFicheroNorma19SEPAXML (const IDRemesa : Integer);
procedure GenerarFicheroNorma32 (const IDRemesa : Integer);
end;
@@ -43,6 +44,8 @@ type
var AFechaCargo : TDateTime; var AFileName : String): Boolean;
function VerEditorNorma19SEPA(var Entidad : String; var Oficina : String;
var AFechaCargo : TDateTime; var AFileName : String): Boolean;
+ function VerEditorNorma19SEPAXML(var Entidad : String; var Oficina : String;
+ var AFechaCargo : TDateTime; var AFileName : String): Boolean;
function VerEditorNorma32(var Identificador : String;
var ACodigoINE : String; var Entidad : String; var Oficina : String;
var AFileName : String): Boolean;
@@ -50,7 +53,8 @@ type
function ValidarEmpresaParaSEPA(AEmpresa : IBizEmpresa) : Boolean;
public
procedure GenerarFicheroNorma19 (const IDRemesa : Integer);
- procedure GenerarFicheroNorma19SEPA (const IDRemesa : Integer);
+ procedure GenerarFicheroNorma19SEPA (const IDRemesa : Integer);
+ procedure GenerarFicheroNorma19SEPAXML (const IDRemesa : Integer);
procedure GenerarFicheroNorma32 (const IDRemesa : Integer);
end;
@@ -67,7 +71,9 @@ uses
schRecibosClienteClient_Intf, Dialogs,
uIEditorExportacionNorma19, uIEditorExportacionNorma32, uBizRecibosCliente,
schContactosClient_Intf, schEmpresasClient_Intf,
- uIEditorExportacionNorma19SEPA, CVBNorma19SEPA;
+ uIEditorExportacionNorma19SEPA, CVBNorma19SEPA,
+ uIEditorExportacionNorma19SEPAXML,
+ CVBNorma19SEPAXML;
{ TBancaElectronicaController }
@@ -350,6 +356,156 @@ begin
end;
end;
+procedure TBancaElectronicaController.GenerarFicheroNorma19SEPAXML(
+ const IDRemesa: Integer);
+var
+ ARemesasController : IRemesasClienteController;
+ AEmpresasController : IEmpresasController;
+ AClientesController : IClientesController;
+
+ ARemesa : IBizRemesaCliente;
+ AEmpresa : IBizEmpresa;
+ ACliente : IBizCliente;
+
+ I: integer;
+ AEntidad : String;
+ AOficina : String;
+
+ ANorma19 : TCVBNorma19SEPAXML;
+begin
+ ARemesasController := TRemesasClienteController.Create;
+ AEmpresasController := TEmpresasController.Create;
+ AClientesController := TClientesController.Create;
+
+ try
+ ARemesa := ARemesasController.Buscar(IDRemesa);
+ ARemesa.DataTable.Active := True;
+ ARemesasController.RecuperarRecibos(ARemesa);
+
+ if ARemesa.ID <> IDRemesa then
+ raise Exception.CreateFmt('No existe la remesa con ID %d', [IDRemesa]);
+
+ AEmpresa := AEmpresasController.Buscar(ARemesa.ID_EMPRESA);
+ AEmpresa.DataTable.Active := True;
+
+ if AEmpresa.ID <> ARemesa.ID_EMPRESA then
+ raise Exception.CreateFmt('No existe la empresa con ID %d', [ARemesa.ID_EMPRESA]);
+
+ ANorma19 := TCVBNorma19SEPAXML.Create(NIL);
+
+ ANorma19.FNomFic := 'REM' + ARemesa.REFERENCIA + '.XML';
+ ANorma19.Fichero.Fecha := Date;
+ ANorma19.Fichero.Identificador := AEmpresa.NIF_CIF + ARemesa.REFERENCIA;
+ ANorma19.FechaCobro := Date;
+
+ // Buscar los datos bancarios
+ with AEmpresa.DatosBancarios do
+ begin
+ First;
+ if Locate('ID', ARemesa.ID_DATOS_BANCO, []) then
+ begin
+ AEntidad := ENTIDAD;
+ AOficina := SUCURSAL;
+ end;
+ end;
+
+ ValidarEmpresaParaSEPA(AEmpresa);
+
+ ValidarRemesaParaSEPA(ARemesa);
+
+ if not VerEditorNorma19SEPAXML(AEntidad, AOficina, ANorma19.FechaCobro, ANorma19.FNomFic) then
+ Exit;
+
+ ShowHourglassCursor;
+
+ ANorma19.Receptor.Entidad := AEntidad;
+ ANorma19.Receptor.Oficina := AOficina;
+
+ with ANorma19 do
+ begin
+ Depura := True;
+
+ Abrir;
+
+ // PRESENTADOR
+ if AEmpresa.DatosBancarios.NIF_CIF_PRESENTADORIsNull then
+ Presentador.NIFCIF := AEmpresa.NIF_CIF
+ else
+ Presentador.NIFCIF := AEmpresa.DatosBancarios.NIF_CIF_PRESENTADOR;
+
+ if AEmpresa.DatosBancarios.SUFIJO_PRESENTADORIsNull then
+ Presentador.Sufijo := AEmpresa.DatosBancarios.SUFIJO_ACREEDOR
+ else
+ Presentador.Sufijo := AEmpresa.DatosBancarios.SUFIJO_PRESENTADOR;
+
+ if AEmpresa.DatosBancarios.NOMBRE_PRESENTADORIsNull then
+ Presentador.Nombre := AEmpresa.NOMBRE
+ else
+ Presentador.Nombre := AEmpresa.DatosBancarios.NOMBRE_PRESENTADOR;
+
+ GenerarCabeceraPresentador;
+
+
+ // ACREEDOR
+ Acreedor.NIFCIF := AEmpresa.NIF_CIF;
+ Acreedor.Nombre := AEmpresa.NOMBRE;
+ Acreedor.Direccion1 := AEmpresa.CALLE;
+
+ if not AEmpresa.CODIGO_POSTALIsNull then
+ Acreedor.Direccion2 := AEmpresa.CODIGO_POSTAL + ' ';
+
+ Acreedor.Direccion2 := Acreedor.Direccion2 + AEmpresa.POBLACION;
+ Acreedor.Direccion3 := AEmpresa.PROVINCIA;
+ Acreedor.Pais := 'ES';
+ Acreedor.Sufijo := AEmpresa.DatosBancarios.SUFIJO_ACREEDOR;
+ Acreedor.CuentaIBAN := AEmpresa.DatosBancarios.IBAN;
+
+ GenerarCabeceraAcreedor;
+
+ ARemesa.Recibos.DataTable.First;
+ for I := 0 to (ARemesa.Recibos.DataTable.RecordCount - 1) do
+ begin
+ //ACliente := (AClientesController.Buscar(ARemesa.Recibos.ID_CLIENTE) as IBizCliente);
+ //ACliente.Open;
+
+ // DEUDOR
+ Deudor.Nombre := ARemesa.Recibos.NOMBRE_CLIENTE;
+ Deudor.Direccion1 := ARemesa.Recibos.CALLE_CLIENTE;
+
+ if not ARemesa.Recibos.CODIGO_POSTAL_CLIENTEIsNull then
+ Deudor.Direccion2 := ARemesa.Recibos.CODIGO_POSTAL_CLIENTE + ' ';
+
+ Deudor.Direccion2 := Deudor.Direccion2 + ARemesa.Recibos.POBLACION_CLIENTE;
+ Deudor.Direccion3 := ARemesa.Recibos.PROVINCIA_CLIENTE;
+ Deudor.Pais := 'ES';
+ Deudor.CuentaIBAN := ARemesa.Recibos.IBAN_CLIENTE;
+ Deudor.CodigoBIC := ARemesa.Recibos.SWIFT_CLIENTE;
+
+ Adeudo.Referencia := ARemesa.Recibos.REFERENCIA;
+ Adeudo.Importe := ARemesa.Recibos.IMPORTE_TOTAL;
+
+ GenerarRegistroAdeudo;
+
+ ARemesa.Recibos.DataTable.Next;
+ end;
+
+ GenerarTotalAcreedor;
+ Cerrar;
+
+ ShowMessage('Se ha generado el fichero');
+ end;
+ finally
+ HideHourglassCursor;
+ ARemesasController := NIL;
+ AEmpresasController := NIL;
+ AClientesController := NIL;
+
+ AEmpresa := NIL;
+
+ FreeAndNil(ANorma19);
+ end;
+end;
+
procedure TBancaElectronicaController.GenerarFicheroNorma32(
const IDRemesa: Integer);
var
@@ -638,6 +794,43 @@ begin
end;
+function TBancaElectronicaController.VerEditorNorma19SEPAXML(var Entidad,
+ Oficina: String; var AFechaCargo: TDateTime; var AFileName: String): Boolean;
+var
+ AEditor : IEditorExportacionNorma19SEPAXML;
+begin
+ Result := False;
+ AEditor := NIL;
+ ShowHourglassCursor;
+ try
+ CreateEditor('EditorExportacionNorma19SEPAXML', IEditorExportacionNorma19SEPAXML, AEditor);
+ with AEditor do
+ begin
+ CodigoEntidad := Entidad;
+ CodigoAgencia := Oficina;
+ FechaCargo := AFechaCargo;
+ Fichero := AFileName;
+ end;
+ finally
+ HideHourglassCursor;
+ end;
+
+ if Assigned(AEditor) then
+ try
+ if (AEditor.ShowModal = mrOk) then
+ begin
+ Entidad := AEditor.CodigoEntidad;
+ Oficina := AEditor.CodigoAgencia;
+ AFechaCargo := AEditor.FechaCargo;
+ AFileName := AEditor.Fichero;
+ Result := True;
+ end;
+ AEditor.Release;
+ finally
+ AEditor := NIL;
+ end;
+end;
+
function TBancaElectronicaController.VerEditorNorma32(var Identificador,
ACodigoINE: String; var Entidad, Oficina: String;
var AFileName: String): Boolean;
diff --git a/Source/Modulos/Banca electronica/Utiles/CVBNorma19SEPAXML.pas b/Source/Modulos/Banca electronica/Utiles/CVBNorma19SEPAXML.pas
new file mode 100644
index 0000000..ba1d172
--- /dev/null
+++ b/Source/Modulos/Banca electronica/Utiles/CVBNorma19SEPAXML.pas
@@ -0,0 +1,428 @@
+unit CVBNorma19SEPAXML;
+
+interface
+
+uses
+ Messages, SysUtils, Classes, Dialogs, SEPACommon, SEPADirectDebit;
+
+type
+ TSEPAXMLPresentador = record
+ Nombre : string;
+ NIFCIF : string;
+ Sufijo : 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);
+ 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_002_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;
+end;
+
+procedure TCVBNorma19SEPAXML.GenerarRegistroAdeudo;
+var
+ auxDC : integer;
+ 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 := '';
+ FDDTransInfo.RmtInfUstrd := '';
+ 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;
+
+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 := Acreedor.CuentaIBAN;
+ 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.
diff --git a/Source/Modulos/Banca electronica/Utiles/CVBUtils.pas b/Source/Modulos/Banca electronica/Utiles/CVBUtils.pas
index 23ca799..a8b406e 100644
--- a/Source/Modulos/Banca electronica/Utiles/CVBUtils.pas
+++ b/Source/Modulos/Banca electronica/Utiles/CVBUtils.pas
@@ -64,8 +64,6 @@ end;
function Trim(const cString: string): string;
-var
- I: integer;
begin
Result := TrimLeft(TrimRight(cString));
end;
diff --git a/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.dcu b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.dcu
new file mode 100644
index 0000000..9985bb2
Binary files /dev/null and b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.dcu differ
diff --git a/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.pas b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.pas
new file mode 100644
index 0000000..7e14f6c
--- /dev/null
+++ b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.pas
@@ -0,0 +1,587 @@
+//
+// Delphi unit with helper methods etc. for SEPA XML file creation
+// (beta version 0.2.2, 2014-02-27)
+//
+// Copyright (C) 2013-2014 by Aaron Spettl
+//
+// This program is free software; you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation; either version 2 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program; if not, write to the Free Software
+// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+//
+// Author: Aaron Spettl
+// Virchowstr. 26
+// 89075 Ulm
+// Germany
+// E-mail: aaron@spettl.de
+//
+unit SEPACommon;
+
+{$IFDEF FPC} // Lazarus: set compiler mode and file encoding
+{%encoding CP1252}
+{$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ SysUtils, StrUtils, Math, Classes, DateUtils;
+
+const
+ SCHEMA_PAIN_001_002_03 = 'pain.001.002.03';
+ SCHEMA_PAIN_001_003_03 = 'pain.001.003.03';
+ SCHEMA_PAIN_008_002_02 = 'pain.008.002.02';
+ SCHEMA_PAIN_008_003_02 = 'pain.008.003.02';
+
+ SEPA = 'SEPA';
+ FIN_INSTN_NOTPROVIDED = 'NOTPROVIDED';
+ END_TO_END_ID_NOTPROVIDED = 'NOTPROVIDED';
+ CCY_EUR = 'EUR';
+ PMT_MTD_CREDIT_TRANSFER = 'TRF';
+ PMT_MTD_DIRECT_DEBIT = 'DD';
+ LCL_INSTRM_CD_CORE = 'CORE';
+ LCL_INSTRM_CD_COR1 = 'COR1';
+ LCL_INSTRM_CD_B2B = 'B2B';
+ SEQ_TP_FRST = 'FRST';
+ SEQ_TP_RCUR = 'RCUR';
+ SEQ_TP_OOFF = 'OOFF';
+ SEQ_TP_FNAL = 'FNAL';
+ INSTR_PRTY_NORM = 'NORM';
+ INSTR_PRTY_HIGH = 'HIGH';
+ CHRG_BR_SLEV = 'SLEV';
+ ORGNL_DBTR_AGT_SMNDA = 'SMNDA';
+ SEPA_FALSE = 'false';
+ SEPA_TRUE = 'true';
+
+ COUNTRY_CODE_DE = 'DE';
+
+ ID_MAX_LEN = 35;
+ INITG_PTY_NAME_MAX_LEN = 70;
+ CDTR_NM_MAX_LEN = 70;
+ END_TO_END_ID_MAX_LEN = 35;
+ DBTR_NM_MAX_LEN = 70;
+ MNDT_ID_MAX_LEN = 35;
+ RMT_INF_USTRD_MAX_LEN = 140;
+
+resourcestring
+ EMPTY_BIC_OTHR_ID = 'BIC required (or OthrID = NOTPROVIDED must be given).';
+ BOTH_BIC_OTHR_ID = 'BIC and OthrID must not be both given at the same time.';
+ INVALID_BIC = 'BIC "%s" not valid.';
+ INVALID_OTHR_ID = 'OthrID "%s" not valid (valid: empty or NOTPROVIDED).';
+ IBAN_ONLY_NOT_ALLOWED = 'IBAN-only is not allowed (or not yet allowed, before 2014-02-01) for this schema.';
+ EMPTY_IBAN = 'IBAN required.';
+ INVALID_IBAN = 'IBAN "%s" not valid.';
+ EMPTY_AMDMNT_INF_DTLS = 'Not all fields of mandate amendment information details may be empty at once.';
+ INVALID_ORGNL_MNDT_ID = 'OrgnlMndtId "%s" not valid.';
+ INVALID_ORGNL_CRDTR_NM = 'OrgnlCdtrSchmeIdNm "%s" not valid.';
+ INVALID_ORGNL_CRDTR_ID = 'OrgnlCdtrSchmeIdIdPrvtIdOthrId "%s" not valid.';
+ INVALID_ORGNL_CRDTR_PRTRY = 'OrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry "%s" not valid (valid: SEPA).';
+ INVALID_ORGNL_FIN_INST_ID = 'OrgnlDbtrAgtFinInstIdOthrId "%s" not valid (valid: SMNDA).';
+ EMPTY_MNDT_ID = 'MndtId required.';
+ EMPTY_DT_OF_SGNTR = 'DtOfSgntr required.';
+ INVALID_MNDT_ID = 'MndtId "%s" not valid.';
+ INVALID_DT_OF_SGNTR = 'DtOfSgntr "%s" not valid (may not be in the future).';
+ EMPTY_END_TO_END_ID = 'PmtIdEndToEndId required, set to NOTPROVIDED if necessary.';
+ EMPTY_INSTD_AMT_CCY = 'InstdAmtCcy required.';
+ EMPTY_DBTR_NM = 'DbtrNm required.';
+ EMPTY_RMT_INF_USTRD = 'RmtInfUstrd required.';
+ INVALID_END_TO_END_ID = 'PmtIdEndToEndId "%s" not valid.';
+ INVALID_INSTD_AMT = 'InstdAmt "%s" not valid, positive value with at most 2 decimal places required.';
+ INVALID_DBTR_NM = 'DbtrNm "%s" not valid.';
+ INVALID_ULTMT_DBTR_NM = 'UltmtDbtrNm "%s" not valid.';
+ INVALID_RMT_INF_USTRD = 'RmtInfUstrd "%s" not valid.';
+ INVALID_IBAN_NOT_DE = 'Only German bank accounts are allowed for IBAN-only (no BIC given).';
+ EMPTY_PMT_INF_ID = 'PmtInfId required.';
+ EMPTY_CDTR_NM = 'CdtrNm required.';
+ EMPTY_CDTR_ID = 'CdtrSchmeIdIdPrvtIdOthrId required.';
+ INVALID_PMT_INF_ID = 'PmtInfId "%s" not valid.';
+ INVALID_PMT_MTD = 'PmtMtd "%s" not valid (valid: DD).';
+ INVALID_LCL_INSTRM_CD = 'PmtTpInfLclInstrmCd "%s" not valid (valid: CORE, COR1, B2B).';
+ INVALID_LCL_INSTRM_CD_COR1= 'PmtTpInfLclInstrmCd "COR1" only valid with schema "pain.008.003.02".';
+ INVALID_SEQ_TP = 'PmtTpInfSeqTp "%s" not valid (valid: FRST, RCUR, OOFF, FNAL).';
+ INVALID_REQD_EXCTN_DT = 'ReqdExctnDt "%s" too early.';
+ INVALID_REQD_COLLTN_DT = 'ReqdColltnDt "%s" too early.';
+ INVALID_SVC_LVL_CD = 'PmtTpInfSvcLvlCd "%s" not valid (valid: SEPA).';
+ INVALID_INSTR_PRTY = 'PmtTpInfInstrPrty "%s" not valid (valid: NORM, HIGH).';
+ INVALID_CHRG_BR = 'ChrgBr "%s" not valid (valid: SLEV).';
+ INVALID_CDTR_NM = 'CdtrNm "%s" not valid.';
+ INVALID_CDTR_ID = 'CdtrSchmeIdIdPrvtIdOthrId "%s" not valid.';
+ INVALID_CDTR_PRTRY = 'CdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry "%s" not valid (valid: SEPA).';
+ INVALID_DBTR_ACCT_NOT_DE = 'Debtor bank account should be of a German bank.';
+ INVALID_CDTR_ACCT_NOT_DE = 'Creditor bank account should be of a German bank.';
+ INVALID_SEQ_TP_FRST_SMNDA1= 'PmtTpInfSeqTp is "FRST", but there is a transaction with mandate amendment details, which is not marked "SMNDA" (same mandate, new debtor agent).';
+ INVALID_SEQ_TP_FRST_SMNDA2= 'PmtTpInfSeqTp is not "FRST", but there is a transaction with mandate amendment details marked "SMNDA" (same mandate, new debtor agent), which implies "FRST".';
+ UNKNOWN_SCHEMA = 'ISO schema "%s" not known or invalid for this type of XML file.';
+ EMPTY_GRP_HDR_MSG_ID = 'GrpHdrMsgId required.';
+ EMPTY_INITG_PTY_NAME = 'GrpHdrInitgPtyName required.';
+ INVALID_GRP_HDR_MSG_ID = 'GrpHdrMsgId "%s" not valid.';
+ INVALID_INITG_PTY_NAME = 'GrpHdrInitgPtyName "%s" not valid.';
+ INVALID_NB_OF_TXS = 'No transactions contained.';
+ INVALID_PMT_INF_MIXING = 'One file may only contain payment instructions with the same PmtTpInfLclInstrmCd.';
+
+type
+ // TAccountIdentification and TFinancialInstitution are used for IBAN and BIC
+ // for identification of debtor/creditor accounts and financial institutions,
+ // see respective units for credit transfer and direct debit transactions.
+ //
+ // Note that all strings in these units are interpreted with respect to the
+ // default behavior of the development environment, i.e.,
+ // a) for Delphi < 2009: ANSI strings
+ // b) for Delphi >= 2009: Unicode strings
+ // c) for Lazarus: no encoding specified, ANSI is assumed
+
+ TFinancialInstitution = class
+ private
+ fBIC: String; // financial institution identification: BIC (8 or 11 characters)
+ fOthrID: String; // other identification: used for IBAN-only ("NOTPROVIDED")
+
+ procedure SetBIC(const str: String);
+ public
+ property BIC: String read fBIC write SetBIC;
+ property OthrID: String read fOthrID write fOthrID;
+
+ function Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream; const schema: String);
+ end;
+
+ TAccountIdentification = class
+ private
+ fIBAN: String; // account identification: IBAN
+
+ procedure SetIBAN(const str: String);
+ public
+ property IBAN: String read fIBAN write SetIBAN;
+
+ function Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream; const schema: String);
+ end;
+
+function SEPAGenerateUUID: String;
+
+function SEPACleanIBANorBICorCI(s: String): String;
+function SEPAModulo97(const str: String): Integer;
+function SEPACheckIBAN(const iban: String): Boolean;
+function SEPACheckBIC(const bic: String): Boolean;
+function SEPACheckCI(const ci: String): Boolean;
+function SEPAIsGermanIBAN(const iban: String): Boolean;
+
+function SEPACleanString(const s: String; const maxlen: Integer = -1): String;
+function SEPACheckString(const s: String; const maxlen: Integer = -1): Boolean;
+
+function SEPACheckRounded(const d: Currency): Boolean;
+function SEPAFormatAmount(const d: Currency; const digits: Integer = 2): String;
+function SEPAFormatBoolean(const b: Boolean): String;
+function SEPAFormatDate(const d: TDateTime): String;
+function SEPAFormatDateTime(const d: TDateTime): String;
+
+procedure SEPAWriteLine(const stream: TStream; const line: String);
+
+var
+ SEPASupportSpecialChars: Boolean = false; // support for German special characters,
+ // only allowed in "pain.001.003.03" and
+ // in "pain.008.003.02"
+
+implementation
+
+// private methods and code for better compiler compatibility
+
+{$IFNDEF FPC}
+{$IF CompilerVersion >= 15}
+{$IF CompilerVersion <= 21} // Delphi 7 to 2010:
+uses // include unit Windows for the constant
+ Windows; // LOCALE_SYSTEM_DEFAULT
+{$IFEND}
+{$IFEND}
+{$ENDIF}
+
+{$IFDEF FPC}
+type UTF8String = String; // just use the usual strings in Lazarus
+{$ELSE}
+{$IF CompilerVersion < 11} // also use the usual strings in Delphi < 2007
+type UTF8String = String; // (same definition as in Delphi 2007)
+{$IFEND}
+{$ENDIF}
+
+function StringToUTF8(const str: String): UTF8String;
+begin
+ // note: just use conversion from Unicode to UTF-8 (in Unicode-based
+ // Delphi 2009 and higher), or conversion from ANSI to UTF-8 (for older
+ // Delphi versions and Lazarus).
+ Result := {$IFDEF Unicode}UTF8Encode{$ELSE}AnsiToUtf8{$ENDIF}(str);
+end;
+
+{$IFDEF FPC} // Lazarus supports TFormatSettings and has
+{$DEFINE FormatSettings} // a method "DefaultFormatSettings"
+{$ELSE}
+{$IF CompilerVersion >= 15} // Delphi 7 and higher supports TFormatSettings,
+{$DEFINE FormatSettings} // but DefaultFormatSettings is not known
+function DefaultFormatSettings: TFormatSettings;
+begin
+{$IF CompilerVersion >= 22} // Delphi XE and later
+ Result := TFormatSettings.Create;
+{$ELSE} // Delphi 2010 and before
+ GetLocaleFormatSettings(LOCALE_SYSTEM_DEFAULT, Result);
+{$IFEND}
+end;
+{$IFEND}
+{$ENDIF}
+
+{$IFDEF FormatSettings} // format settings variable with correct
+var // decimal separator, initialized in unit
+ SEPAFormatSettings: TFormatSettings; // "initialization" block below
+{$ENDIF}
+
+function CharIsInInterval(const c: Char; const i1: Char; const i2: Char): Boolean;
+begin
+ Result := ((Ord(c) >= Ord(i1)) and (Ord(c) <= Ord(i2)));
+end;
+
+function CharIsSEPAWhitelisted(const c: Char): Boolean;
+begin
+ // note: we do not use "c in [...]" syntax because that's only correct
+ // for strings with single-byte characters
+ Result := CharIsInInterval(c, 'A', 'Z') or
+ CharIsInInterval(c, 'a', 'z') or
+ CharIsInInterval(c, '0', '9') or
+ (c = '''') or (c = ':') or (c = '?') or
+ (c = ',') or (c = '-') or (c = ' ') or
+ (c = '(') or (c = '+') or (c = '.') or
+ (c = ')') or (c = '/');
+end;
+
+function CharIsGermanSpecialChar(const c: Char): Boolean;
+begin
+ Result := (c = 'Ä') or (c = 'Ö') or (c = 'Ü') or
+ (c = 'ä') or (c = 'ö') or (c = 'ü') or
+ (c = 'ß') or (c = '&') or (c = '*') or
+ (c = '$') or (c = '%');
+end;
+
+function ConvertAlphaToNumber(const s: String): String;
+var
+ i: Integer;
+begin
+ Result := '';
+ for i := 1 to Length(s) do
+ begin
+ if CharIsInInterval(s[i], '0', '9') then
+ Result := Result + s[i]
+ else if CharIsInInterval(s[i], 'A', 'Z') then
+ Result := Result + IntToStr(10 + Ord(s[i]) - Ord('A'))
+ else
+ raise Exception.Create('Invalid character!');
+ end;
+end;
+
+function Modulo97(const n: String): Integer;
+begin
+ // note: the number stored in "n" may be very large, therefore we cannot
+ // use the standard modulo methods; see also (German):
+ // http://www.pruefziffernberechnung.de/Originaldokumente/IBAN/Prufziffer_07.00.pdf
+ if Length(n) > 9 then
+ Result := Modulo97(IntToStr(Modulo97(Copy(n, 1, 9))) + Copy(n, 10, Length(n)-9))
+ else
+ Result := StrToInt(n) mod 97;
+end;
+
+function CheckCleanIBAN(const cleanIBAN: String): Boolean;
+begin
+ // check length
+ if Length(cleanIBAN) > 34 then
+ begin
+ Result := false;
+ Exit;
+ end;
+
+ // correct check digits?
+ try
+ Result := (SEPAModulo97(Copy(cleanIBAN, 5, Length(cleanIBAN)) + Copy(cleanIBAN, 1, 4)) = 1);
+ except
+ // invalid characters detected
+ Result := false;
+ end;
+end;
+
+function CheckCleanBIC(const cleanBIC: String): Boolean;
+var
+ i: Integer;
+begin
+ // check length
+ Result := (Length(cleanBIC) = 8) or (Length(cleanBIC) = 11);
+
+ // check characters
+ if Result then
+ begin
+ for i := 1 to Length(cleanBIC) do
+ begin
+ if not CharIsInInterval(cleanBIC[i], '0', '9') and
+ not CharIsInInterval(cleanBIC[i], 'A', 'Z') then
+ begin
+ Result := false;
+ Break;
+ end;
+ end;
+ end;
+end;
+
+function CheckCleanCI(const cleanCI: String): Boolean;
+begin
+ // check length
+ if Length(cleanCI) > 35 then
+ begin
+ Result := false;
+ Exit;
+ end;
+
+ // correct check digits?
+ try
+ Result := (SEPAModulo97(Copy(cleanCI, 8, Length(cleanCI)) + Copy(cleanCI, 1, 4)) = 1);
+ except
+ // invalid characters detected
+ Result := false;
+ end;
+end;
+
+function IsGermanIBAN(const cleanIBAN: String): Boolean;
+begin
+ Result := (Copy(cleanIBAN, 1, 2) = COUNTRY_CODE_DE);
+end;
+
+procedure WriteString(const stream: TStream; const str: String);
+var
+ utf8: UTF8String;
+begin
+ utf8 := StringToUTF8(str);
+ stream.WriteBuffer(utf8[1], Length(utf8));
+end;
+
+// commonly used (public) methods
+
+function SEPAGenerateUUID: String;
+var
+ uid: TGuid;
+ res: HResult;
+begin
+ res := CreateGuid(Uid);
+ if res = S_OK then
+ begin
+ Result := GuidToString(uid);
+ Result := StringReplace(Result, '-', '', [rfReplaceAll]);
+ Result := StringReplace(Result, '{', '', [rfReplaceAll]);
+ Result := StringReplace(Result, '}', '', [rfReplaceAll]);
+ end
+ else
+ Result := IntToStr(RandomRange(10000, High(Integer))); // fallback to simple random number
+end;
+
+function SEPACleanIBANorBICorCI(s: String): String;
+begin
+ // note: AnsiUpperCase works on Unicode strings since Delphi 2009
+ Result := Trim(StringReplace(AnsiUpperCase(s), ' ', '', [rfReplaceAll]));
+end;
+
+function SEPAModulo97(const str: String): Integer;
+var
+ n: String;
+begin
+ n := ConvertAlphaToNumber(str);
+ if n = '' then
+ Result := 0
+ else
+ Result := Modulo97(n);
+end;
+
+function SEPACheckIBAN(const iban: String): Boolean;
+begin
+ Result := CheckCleanIBAN(SEPACleanIBANorBICorCI(iban));
+end;
+
+function SEPACheckBIC(const bic: String): Boolean;
+begin
+ Result := CheckCleanBIC(SEPACleanIBANorBICorCI(bic));
+end;
+
+function SEPACheckCI(const ci: String): Boolean;
+begin
+ Result := CheckCleanCI(SEPACleanIBANorBICorCI(ci));
+end;
+
+function SEPAIsGermanIBAN(const iban: String): Boolean;
+begin
+ Result := IsGermanIBAN(SEPACleanIBANorBICorCI(iban));
+end;
+
+function SEPACleanString(const s: String; const maxlen: Integer = -1): String;
+var
+ i: Integer;
+begin
+ Result := s;
+ for i := 1 to Length(Result) do
+ begin
+ if not CharIsSEPAWhitelisted(Result[i]) then
+ begin
+ if (SEPASupportSpecialChars and CharIsGermanSpecialChar(Result[i])) then
+ begin
+ // some special characters are allowed in "pain.008.003.02", do not convert
+ // them if "SupportGermanSpecialChars" is set
+ end
+ else
+ begin
+ // use "EPC Best Practices" to convert characters that were allowed in
+ // the old DTAUS files
+ if Result[i] = 'Ä' then Result[i] := 'A'
+ else if Result[i] = 'Ö' then Result[i] := 'O'
+ else if Result[i] = 'Ü' then Result[i] := 'U'
+ else if Result[i] = 'ä' then Result[i] := 'a'
+ else if Result[i] = 'ö' then Result[i] := 'o'
+ else if Result[i] = 'ü' then Result[i] := 'u'
+ else if Result[i] = 'ß' then Result[i] := 's'
+ else if Result[i] = '&' then Result[i] := '+'
+ else if Result[i] = '*' then Result[i] := '.'
+ else if Result[i] = '$' then Result[i] := '.'
+ else if Result[i] = '%' then Result[i] := '.'
+ else Result[i] := ' ';
+ end;
+ end;
+ end;
+ if (maxlen >= 0) and (Length(Result) > maxlen) then
+ Result := Copy(Result, 1, maxlen);
+end;
+
+function SEPACheckString(const s: String; const maxlen: Integer = -1): Boolean;
+begin
+ Result := (SEPACleanString(s, maxlen) = s);
+end;
+
+function SEPACheckRounded(const d: Currency): Boolean;
+begin
+ // check that the given value is rounded to two decimal places;
+ // currency values have exactly four decimal places, just use a string
+ // comparison after formatting (once after rounding) - not exactly
+ // elegant, but works
+ Result := (CurrToStrF(d, ffFixed, 4) = CurrToStrF(SimpleRoundTo(d, -2), ffFixed, 2)+'00');
+end;
+
+function SEPAFormatAmount(const d: Currency; const digits: Integer = 2): String;
+{$IFDEF FormatSettings}
+begin
+ Result := CurrToStrF(d, ffFixed, digits, SEPAFormatSettings);
+end;
+{$ELSE}
+var
+ OldDecimalSeparator: Char;
+begin
+ OldDecimalSeparator := DecimalSeparator; // note: not thread-safe
+ DecimalSeparator := '.';
+ Result := CurrToStrF(d, ffFixed, digits);
+ DecimalSeparator := OldDecimalSeparator;
+end;
+{$ENDIF}
+
+function SEPAFormatBoolean(const b: Boolean): String;
+begin
+ Result := IfThen(b, SEPA_TRUE, SEPA_FALSE);
+end;
+
+function SEPAFormatDate(const d: TDateTime): String;
+begin
+ Result := FormatDateTime('yyyy"-"mm"-"dd', d);
+end;
+
+function SEPAFormatDateTime(const d: TDateTime): String;
+begin
+ Result := FormatDateTime('yyyy"-"mm"-"dd"T"hh":"nn":"ss"."zzz"Z"', d);
+end;
+
+procedure SEPAWriteLine(const stream: TStream; const line: String);
+begin
+ WriteString(stream, line);
+ WriteString(stream, sLineBreak);
+end;
+
+// TFinancialInstitution
+
+procedure TFinancialInstitution.SetBIC(const str: String);
+begin
+ fBIC := SEPACleanIBANorBICorCI(str);
+end;
+
+function TFinancialInstitution.Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ if (BIC = '') and (OthrID = '') then
+ Result.Append(EMPTY_BIC_OTHR_ID);
+
+ if (BIC <> '') and (OthrID <> '') then
+ Result.Append(BOTH_BIC_OTHR_ID);
+
+ if (BIC <> '') and not SEPACheckBIC(BIC) then
+ Result.Append(Format(INVALID_BIC, [BIC]));
+
+ if (OthrID <> '') and (OthrID <> FIN_INSTN_NOTPROVIDED) then
+ Result.Append(INVALID_OTHR_ID);
+
+ if (schema = SCHEMA_PAIN_001_002_03) or (schema = SCHEMA_PAIN_008_002_02) then
+ begin
+ // IBAN-only not oallowed:
+
+ if (BIC = '') and (OthrID <> '') then
+ Result.Append(IBAN_ONLY_NOT_ALLOWED);
+ end;
+end;
+
+procedure TFinancialInstitution.SaveToStream(const stream: TStream; const schema: String);
+begin
+ if (BIC = '') and (OthrID <> '') then
+ SEPAWriteLine(stream, ''+SEPACleanString(OthrID)+'')
+ else
+ SEPAWriteLine(stream, ''+SEPACleanString(BIC)+'');
+end;
+
+// TAccountIdentification
+
+procedure TAccountIdentification.SetIBAN(const str: String);
+begin
+ fIBAN := SEPACleanIBANorBICorCI(str);
+end;
+
+function TAccountIdentification.Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ if IBAN = '' then
+ Result.Append(EMPTY_IBAN);
+
+ if (IBAN <> '') and not SEPACheckIBAN(IBAN) then
+ Result.Append(Format(INVALID_IBAN, [IBAN]));
+end;
+
+procedure TAccountIdentification.SaveToStream(const stream: TStream; const schema: String);
+begin
+ SEPAWriteLine(stream, ''+SEPACleanString(IBAN)+'');
+end;
+
+{$IFDEF FormatSettings}
+initialization
+ // initialize format settings variable with correct decimal separator
+ SEPAFormatSettings := DefaultFormatSettings;
+ SEPAFormatSettings.DecimalSeparator := '.';
+{$ENDIF}
+
+end.
diff --git a/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACreditTransfer.dcu b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACreditTransfer.dcu
new file mode 100644
index 0000000..2b6bdaf
Binary files /dev/null and b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACreditTransfer.dcu differ
diff --git a/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACreditTransfer.pas b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACreditTransfer.pas
new file mode 100644
index 0000000..f9d35aa
--- /dev/null
+++ b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACreditTransfer.pas
@@ -0,0 +1,565 @@
+//
+// Delphi unit for SEPA credit transfer XML file creation
+// (beta version 0.2.2, 2014-02-27)
+//
+// Copyright (C) 2013-2014 by Aaron Spettl
+//
+// This program is free software; you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation; either version 2 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program; if not, write to the Free Software
+// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+//
+// Author: Aaron Spettl
+// Virchowstr. 26
+// 89075 Ulm
+// Germany
+// E-mail: aaron@spettl.de
+//
+unit SEPACreditTransfer;
+
+{$IFDEF FPC} // Lazarus: set compiler mode and file encoding
+{%encoding CP1252}
+{$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ SysUtils, Classes, DateUtils, SEPACommon;
+
+type
+ // In the following, all necessary classes to create credit transfers for
+ // SEPA XML files are introduced. Please have a look at the specification of
+ // the XML data format at
+ // http://www.ebics.de/index.php?id=77
+ // (section 2.2.2, "Anlage3_Datenformate_V2.7.pdf" by EBICS, Die Deutsche Kreditwirtschaft).
+ //
+ // Short explanation of XML file for credit transfers:
+ //
+ // XML tags corresponding class
+ // ---------------------------------------------------------------------------
+ // TCreditTransferInitiation
+ // TCreditTransferInitiation
+ // TCreditTransferPaymentInformation
+ // TCreditTransferTransactionInformation
+ // ...
+ // ...
+ //
+ // ...
+ //
+ // Note that all strings in these units are interpreted with respect to the
+ // default behavior of the development environment, i.e.,
+ // a) for Delphi < 2009: ANSI strings
+ // b) for Delphi >= 2009: Unicode strings
+ // c) for Lazarus: no encoding specified, ANSI is assumed
+
+ TCreditTransferTransactionInformation = class
+ private
+ fPmtIdEndToEndId: String; // end-to-end identification of this payment (by default "NOTPROVIDED")
+ fInstdAmtCcy: String; // instructed amount, currency (always "EUR")
+ fInstdAmt: Currency; // instructed amount
+ fCdtrAgt: TFinancialInstitution; // creditor agent
+ fCdtrNm: String; // creditor name
+ fCdtrAcct: TAccountIdentification; // creditor account identification
+ fRmtInfUstrd: String; // unstructured remittance information
+
+ procedure SetCdtrNm(const str: String);
+ procedure SetRmtInfUstrd(const str: String);
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ property PmtIdEndToEndId: String read fPmtIdEndToEndId write fPmtIdEndToEndId;
+ property InstdAmtCcy: String read fInstdAmtCcy write fInstdAmtCcy;
+ property InstdAmt: Currency read fInstdAmt write fInstdAmt;
+ property CdtrAgt: TFinancialInstitution read fCdtrAgt;
+ property CdtrNm: String read fCdtrNm write SetCdtrNm;
+ property CdtrAcct: TAccountIdentification read fCdtrAcct;
+ property RmtInfUstrd: String read fRmtInfUstrd write SetRmtInfUstrd;
+
+ function Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream; const schema: String);
+ end;
+
+ TCreditTransferPaymentInformation = class
+ private
+ fPmtInfId: String; // payment information identification
+ fPmtMtd: String; // payment method (always "TRF")
+ fPmtTpInfSvcLvlCd: String; // payment type, service level code (always "SEPA")
+ fPmtTpInfInstrPrty: String; // payment type, instruction priority ("NORM" or "HIGH")
+ fReqdExctnDt: TDateTime; // requested execution date
+ fDbtrNm: String; // creditor name
+ fDbtrAcct: TAccountIdentification; // creditor account identification
+ fDbtrAgt: TFinancialInstitution; // creditor agent
+ fChrgBr: String; // charge bearer (always "SLEV")
+ fCdtTrfTxInf: array of TCreditTransferTransactionInformation;
+
+ procedure SetDbtrNm(const str: String);
+
+ function GetCtrlSum: Currency;
+ function GetCdtTrfTxInfEntry(const i: Integer): TCreditTransferTransactionInformation;
+ function GetCdtTrfTxInfCount: Integer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ property PmtInfId: String read fPmtInfId write fPmtInfId;
+ property PmtMtd: String read fPmtMtd write fPmtMtd;
+ property NbOfTxs: Integer read GetCdtTrfTxInfCount;
+ property CtrlSum: Currency read GetCtrlSum;
+ property PmtTpInfSvcLvlCd: String read fPmtTpInfSvcLvlCd write fPmtTpInfSvcLvlCd;
+ property PmtTpInfInstrPrty: String read fPmtTpInfInstrPrty write fPmtTpInfInstrPrty;
+ property ReqdExctnDt: TDateTime read fReqdExctnDt write fReqdExctnDt;
+ property DbtrNm: String read fDbtrNm write SetDbtrNm;
+ property DbtrAcct: TAccountIdentification read fDbtrAcct;
+ property DbtrAgt: TFinancialInstitution read fDbtrAgt;
+ property ChrgBr: String read fChrgBr write fChrgBr;
+
+ procedure AppendCdtTrfTxInfEntry(const transaction: TCreditTransferTransactionInformation);
+ property CdtTrfTxInfEntry[const i: Integer]: TCreditTransferTransactionInformation read GetCdtTrfTxInfEntry;
+ property CdtTrfTxInfCount: Integer read GetCdtTrfTxInfCount;
+
+ function Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream; const schema: String);
+ end;
+
+ TCreditTransferInitiation = class
+ private
+ fSchema: String; // ISO schema, e.g. "pain.001.002.03", empty means auto-select based on date
+ fGrpHdrMsgId: String; // group header: message identification
+ fGrpHdrCreDtTm: TDateTime; // group header: time of file creation
+ fGrpHdrInitgPtyName: String; // group header: initiator name
+ fPmtInf: array of TCreditTransferPaymentInformation;
+
+ function GetSchema: String;
+ procedure SetGrpHdrInitgPtyName(const str: String);
+
+ function GetGrpHdrNbOfTxs: Integer;
+ function GetPmtInfEntry(const i: Integer): TCreditTransferPaymentInformation;
+ function GetPmtInfCount: Integer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ property Schema: String read GetSchema write fSchema;
+
+ property GrpHdrMsgId: String read fGrpHdrMsgId write fGrpHdrMsgId;
+ property GrpHdrCreDtTm: TDateTime read fGrpHdrCreDtTm write fGrpHdrCreDtTm;
+ property GrpHdrNbOfTxs: Integer read GetGrpHdrNbOfTxs;
+ property GrpHdrInitgPtyName: String read fGrpHdrInitgPtyName write SetGrpHdrInitgPtyName;
+
+ procedure AppendPmtInfEntry(const instruction: TCreditTransferPaymentInformation);
+ property PmtInfEntry[const i: Integer]: TCreditTransferPaymentInformation read GetPmtInfEntry;
+ property PmtInfCount: Integer read GetPmtInfCount;
+
+ function Validate(const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream);
+ procedure SaveToDisk(const FileName: String);
+ end;
+
+implementation
+
+// TCreditTransferTransactionInformation
+
+constructor TCreditTransferTransactionInformation.Create;
+begin
+ inherited;
+ fPmtIdEndToEndId := END_TO_END_ID_NOTPROVIDED;
+ fInstdAmtCcy := CCY_EUR;
+ fCdtrAgt := TFinancialInstitution.Create;
+ fCdtrAcct := TAccountIdentification.Create;
+end;
+
+destructor TCreditTransferTransactionInformation.Destroy;
+begin
+ FreeAndNil(fCdtrAgt);
+ FreeAndNil(fCdtrAcct);
+ inherited;
+end;
+
+procedure TCreditTransferTransactionInformation.SetCdtrNm(const str: String);
+begin
+ fCdtrNm := SEPACleanString(str);
+end;
+
+procedure TCreditTransferTransactionInformation.SetRmtInfUstrd(const str: String);
+begin
+ fRmtInfUstrd := SEPACleanString(str);
+end;
+
+function TCreditTransferTransactionInformation.Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ // check for empty fields
+
+ if PmtIdEndToEndId = '' then
+ Result.Append(EMPTY_END_TO_END_ID);
+
+ if InstdAmtCcy = '' then
+ Result.Append(EMPTY_INSTD_AMT_CCY);
+
+ if CdtrNm = '' then
+ Result.Append(EMPTY_CDTR_NM);
+
+ if RmtInfUstrd = '' then
+ Result.Append(EMPTY_RMT_INF_USTRD);
+
+ // check for invalid fields
+
+ if not SEPACheckString(PmtIdEndToEndId, END_TO_END_ID_MAX_LEN) then
+ Result.Append(Format(INVALID_END_TO_END_ID, [PmtIdEndToEndId]));
+
+ if (InstdAmt <= 0.0) or not SEPACheckRounded(InstdAmt) then
+ Result.Append(Format(INVALID_INSTD_AMT, [SEPAFormatAmount(InstdAmt, 4)]));
+
+ if not SEPACheckString(CdtrNm, CDTR_NM_MAX_LEN) then
+ Result.Append(Format(INVALID_CDTR_NM, [CdtrNm]));
+
+ if not SEPACheckString(RmtInfUstrd, RMT_INF_USTRD_MAX_LEN) then
+ Result.Append(Format(INVALID_RMT_INF_USTRD, [RmtInfUstrd]));
+
+ // delegate validations where possible
+
+ // note: for IBAN-only, according to the specification the creditor agent
+ // has to be left out completely; not even NOTPROVIDED is allowed - yet, we
+ // handle this the same way and just do not write this block
+ // to the file if no BIC is given (corresponds to NOTPROVIDED flag), see also
+ // method SaveToStream
+ CdtrAgt.Validate(schema, Result);
+
+ CdtrAcct.Validate(schema, Result);
+
+ // plausibility checks
+
+ if (CdtrAgt.OthrID = FIN_INSTN_NOTPROVIDED) and not SEPAIsGermanIBAN(CdtrAcct.IBAN) then
+ Result.Append(INVALID_IBAN_NOT_DE);
+end;
+
+procedure TCreditTransferTransactionInformation.SaveToStream(const stream: TStream; const schema: String);
+begin
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtIdEndToEndId)+'');
+ SEPAWriteLine(stream, ''+SEPAFormatAmount(InstdAmt)+'');
+
+ if CdtrAgt.BIC <> '' then // note: do not write block to the file if IBAN-only
+ begin // is required, see also comment in method Validate
+ SEPAWriteLine(stream, '');
+ CdtrAgt.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+ end;
+
+ SEPAWriteLine(stream, ''+SEPACleanString(CdtrNm, DBTR_NM_MAX_LEN)+'');
+
+ SEPAWriteLine(stream, '');
+ CdtrAcct.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPACleanString(RmtInfUstrd, RMT_INF_USTRD_MAX_LEN)+'');
+
+ SEPAWriteLine(stream, '');
+end;
+
+// TCreditTransferPaymentInformation
+
+constructor TCreditTransferPaymentInformation.Create;
+begin
+ inherited;
+ fPmtInfId := SEPAGenerateUUID;
+ fPmtMtd := PMT_MTD_CREDIT_TRANSFER;
+ fPmtTpInfSvcLvlCd := SEPA;
+ fChrgBr := CHRG_BR_SLEV;
+ fDbtrAcct := TAccountIdentification.Create;
+ fDbtrAgt := TFinancialInstitution.Create;
+end;
+
+destructor TCreditTransferPaymentInformation.Destroy;
+var
+ i: Integer;
+begin
+ FreeAndNil(fDbtrAcct);
+ FreeAndNil(fDbtrAgt);
+ for i := Low(fCdtTrfTxInf) to High(fCdtTrfTxInf) do
+ FreeAndNil(fCdtTrfTxInf[i]);
+ inherited;
+end;
+
+procedure TCreditTransferPaymentInformation.SetDbtrNm(const str: String);
+begin
+ fDbtrNm := SEPACleanString(str);
+end;
+
+function TCreditTransferPaymentInformation.GetCtrlSum: Currency;
+var
+ i: Integer;
+begin
+ Result := 0.0;
+ for i := 0 to CdtTrfTxInfCount-1 do
+ Result := Result + CdtTrfTxInfEntry[i].InstdAmt;
+end;
+
+procedure TCreditTransferPaymentInformation.AppendCdtTrfTxInfEntry(const transaction: TCreditTransferTransactionInformation);
+var
+ i: Integer;
+begin
+ i := Length(fCdtTrfTxInf);
+ SetLength(fCdtTrfTxInf, i+1);
+ fCdtTrfTxInf[i] := transaction;
+end;
+
+function TCreditTransferPaymentInformation.GetCdtTrfTxInfEntry(const i: Integer): TCreditTransferTransactionInformation;
+begin
+ Result := fCdtTrfTxInf[i];
+end;
+
+function TCreditTransferPaymentInformation.GetCdtTrfTxInfCount: Integer;
+begin
+ Result := Length(fCdtTrfTxInf);
+end;
+
+function TCreditTransferPaymentInformation.Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+var
+ i: Integer;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ // check for empty fields
+
+ if PmtInfId = '' then
+ Result.Append(EMPTY_PMT_INF_ID);
+
+ if DbtrNm = '' then
+ Result.Append(EMPTY_DBTR_NM);
+
+ // check for invalid fields
+
+ if not SEPACheckString(PmtInfId, ID_MAX_LEN) then
+ Result.Append(Format(INVALID_PMT_INF_ID, [PmtInfId]));
+
+ if PmtMtd <> PMT_MTD_CREDIT_TRANSFER then
+ Result.Append(Format(INVALID_PMT_MTD, [PmtMtd]));
+
+ if Trunc(ReqdExctnDt) < Today then
+ Result.Append(Format(INVALID_REQD_EXCTN_DT, [DateToStr(ReqdExctnDt)]));
+
+ if PmtTpInfSvcLvlCd <> SEPA then
+ Result.Append(Format(INVALID_SVC_LVL_CD, [PmtTpInfSvcLvlCd]));
+
+ if (PmtTpInfInstrPrty <> '') and (PmtTpInfInstrPrty <> INSTR_PRTY_NORM) and (PmtTpInfInstrPrty <> INSTR_PRTY_HIGH) then
+ Result.Append(Format(INVALID_INSTR_PRTY, [PmtTpInfInstrPrty]));
+
+ if ChrgBr <> CHRG_BR_SLEV then
+ Result.Append(Format(INVALID_CHRG_BR, [ChrgBr]));
+
+ if not SEPACheckString(DbtrNm, DBTR_NM_MAX_LEN) then
+ Result.Append(Format(INVALID_DBTR_NM, [DbtrNm]));
+
+ // delegate validations where possible
+
+ DbtrAcct.Validate(schema, Result);
+ DbtrAgt.Validate(schema, Result);
+
+ for i := 0 to CdtTrfTxInfCount-1 do
+ CdtTrfTxInfEntry[i].Validate(schema, Result);
+
+ // plausibility checks
+
+ if not SEPAIsGermanIBAN(DbtrAcct.IBAN) then
+ Result.Append(INVALID_DBTR_ACCT_NOT_DE);
+
+ // note: number of objects in DrctDbtTxInf is not checked - if empty, then this
+ // object will be ignored by TCreditTransferInitiation; and TCreditTransferInitiation
+ // ensures in its validation that it has some transactions
+end;
+
+procedure TCreditTransferPaymentInformation.SaveToStream(const stream: TStream; const schema: String);
+var
+ i: Integer;
+begin
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtInfId)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtMtd)+'');
+ SEPAWriteLine(stream, ''+IntToStr(NbOfTxs)+'');
+ SEPAWriteLine(stream, ''+SEPAFormatAmount(CtrlSum)+'');
+
+ SEPAWriteLine(stream, '');
+ if PmtTpInfInstrPrty <> '' then
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtTpInfInstrPrty)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtTpInfSvcLvlCd)+'');
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPAFormatDate(ReqdExctnDt)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(DbtrNm, DBTR_NM_MAX_LEN)+'');
+
+ SEPAWriteLine(stream, '');
+ DbtrAcct.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, '');
+ DbtrAgt.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPACleanString(ChrgBr)+'');
+
+ for i := 0 to CdtTrfTxInfCount-1 do
+ CdtTrfTxInfEntry[i].SaveToStream(stream, schema);
+
+ SEPAWriteLine(stream, '');
+end;
+
+// TCreditTransferInitiation
+
+constructor TCreditTransferInitiation.Create;
+begin
+ inherited;
+ fSchema := ''; // empty = auto-select
+ fGrpHdrMsgId := SEPAGenerateUUID;
+ fGrpHdrCreDtTm := Now;
+end;
+
+destructor TCreditTransferInitiation.Destroy;
+var
+ i: Integer;
+begin
+ for i := Low(fPmtInf) to High(fPmtInf) do
+ FreeAndNil(fPmtInf[i]);
+ inherited;
+end;
+
+function TCreditTransferInitiation.GetSchema: String;
+begin
+ Result := fSchema;
+ if Result = '' then
+ Result := SCHEMA_PAIN_001_003_03
+end;
+
+procedure TCreditTransferInitiation.SetGrpHdrInitgPtyName(const str: String);
+begin
+ fGrpHdrInitgPtyName := SEPACleanString(str);
+end;
+
+function TCreditTransferInitiation.GetGrpHdrNbOfTxs: Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to PmtInfCount-1 do
+ Inc(Result, PmtInfEntry[i].NbOfTxs);
+end;
+
+procedure TCreditTransferInitiation.AppendPmtInfEntry(const instruction: TCreditTransferPaymentInformation);
+var
+ i: Integer;
+begin
+ i := Length(fPmtInf);
+ SetLength(fPmtInf, i+1);
+ fPmtInf[i] := instruction;
+end;
+
+function TCreditTransferInitiation.GetPmtInfEntry(const i: Integer): TCreditTransferPaymentInformation;
+begin
+ Result := fPmtInf[i];
+end;
+
+function TCreditTransferInitiation.GetPmtInfCount: Integer;
+begin
+ Result := Length(fPmtInf);
+end;
+
+function TCreditTransferInitiation.Validate(const appendTo: TStringList = nil): TStringList;
+var
+ i: Integer;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ // check ISO schema
+
+ if (Schema <> SCHEMA_PAIN_001_002_03) and (Schema <> SCHEMA_PAIN_001_003_03) then
+ Result.Append(Format(UNKNOWN_SCHEMA, [Schema]));
+
+ // check for empty fields
+
+ if GrpHdrMsgId = '' then
+ Result.Append(EMPTY_GRP_HDR_MSG_ID);
+
+ if GrpHdrInitgPtyName = '' then
+ Result.Append(EMPTY_INITG_PTY_NAME);
+
+ // check for invalid fields
+
+ if not SEPACheckString(GrpHdrMsgId, ID_MAX_LEN) then
+ Result.Append(Format(INVALID_GRP_HDR_MSG_ID, [GrpHdrMsgId]));
+
+ if not SEPACheckString(GrpHdrInitgPtyName, INITG_PTY_NAME_MAX_LEN) then
+ Result.Append(Format(INVALID_INITG_PTY_NAME, [GrpHdrInitgPtyName]));
+
+ // delegate validations where possible
+
+ for i := 0 to PmtInfCount-1 do
+ PmtInfEntry[i].Validate(Schema, Result);
+
+ // plausibility checks
+
+ if GrpHdrNbOfTxs = 0 then
+ Result.Append(INVALID_NB_OF_TXS);
+end;
+
+procedure TCreditTransferInitiation.SaveToStream(const stream: TStream);
+var
+ i: Integer;
+begin
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, ''+SEPACleanString(GrpHdrMsgId)+'');
+ SEPAWriteLine(stream, ''+SEPAFormatDateTime(GrpHdrCreDtTm)+'');
+ SEPAWriteLine(stream, ''+IntToStr(GrpHdrNbOfTxs)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(GrpHdrInitgPtyName, INITG_PTY_NAME_MAX_LEN)+'');
+ SEPAWriteLine(stream, '');
+
+ for i := 0 to PmtInfCount-1 do
+ if PmtInfEntry[i].NbOfTxs > 0 then
+ PmtInfEntry[i].SaveToStream(stream, Schema);
+
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, '');
+end;
+
+procedure TCreditTransferInitiation.SaveToDisk(const FileName: String);
+var
+ stream: TMemoryStream;
+begin
+ stream := TMemoryStream.Create;
+ try
+ SaveToStream(stream);
+ stream.SaveToFile(FileName);
+ finally
+ stream.Free;
+ end;
+end;
+
+end.
diff --git a/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPADirectDebit.dcu b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPADirectDebit.dcu
new file mode 100644
index 0000000..19d02e6
Binary files /dev/null and b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPADirectDebit.dcu differ
diff --git a/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPADirectDebit.pas b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPADirectDebit.pas
new file mode 100644
index 0000000..b368639
--- /dev/null
+++ b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPADirectDebit.pas
@@ -0,0 +1,861 @@
+//
+// Delphi unit for SEPA direct debit XML file creation
+// (beta version 0.2.2, 2014-02-27)
+//
+// Copyright (C) 2013-2014 by Aaron Spettl
+//
+// This program is free software; you can redistribute it and/or modify
+// it under the terms of the GNU General Public License as published by
+// the Free Software Foundation; either version 2 of the License, or
+// (at your option) any later version.
+//
+// This program is distributed in the hope that it will be useful,
+// but WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with this program; if not, write to the Free Software
+// Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+//
+// Author: Aaron Spettl
+// Virchowstr. 26
+// 89075 Ulm
+// Germany
+// E-mail: aaron@spettl.de
+//
+unit SEPADirectDebit;
+
+{$IFDEF FPC} // Lazarus: set compiler mode and file encoding
+{%encoding CP1252}
+{$mode objfpc}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ SysUtils, Classes, DateUtils, SEPACommon;
+
+type
+ // In the following, all necessary classes to create direct debit transactions
+ // for SEPA XML files are introduced. Please have a look at the specification
+ // of the XML data format at
+ // http://www.ebics.de/index.php?id=77
+ // (section 2.2.2, "Anlage3_Datenformate_V2.7.pdf" by EBICS, Die Deutsche Kreditwirtschaft).
+ //
+ // Short explanation of XML file for direct debit transactions:
+ //
+ // XML tags corresponding class
+ // ---------------------------------------------------------------------------
+ // TDirectDebitInitiation
+ // TDirectDebitInitiation
+ // TDirectDebitPaymentInformation
+ // TDirectDebitTransactionInformation
+ // TMandateRelatedInformation
+ // TAmendmentInformationDetails
+ // ...
+ // ...
+ //
+ // ...
+ //
+ // Note that all strings in these units are interpreted with respect to the
+ // default behavior of the development environment, i.e.,
+ // a) for Delphi < 2009: ANSI strings
+ // b) for Delphi >= 2009: Unicode strings
+ // c) for Lazarus: no encoding specified, ANSI is assumed
+
+ TAmendmentInformationDetails = class
+ private
+ fOrgnlMndtId: String; // original mandate identification
+ fOrgnlCdtrSchmeIdNm: String; // original creditor name
+ fOrgnlCdtrSchmeIdIdPrvtIdOthrId: String; // original creditor identifier
+ fOrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry: String; // (always "SEPA")
+ fOrgnlDbtrAcct: TAccountIdentification; // original debtor account identification
+ fOrgnlDbtrAgtFinInstIdOthrId: String; // "SMNDA" if same mandate + new debtor agent
+
+ procedure SetOrgnlCdtrSchmeIdIdPrvtIdOthrId(const str: String);
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ property OrgnlMndtId: String read fOrgnlMndtId write fOrgnlMndtId;
+ property OrgnlCdtrSchmeIdNm: String read fOrgnlCdtrSchmeIdNm write fOrgnlCdtrSchmeIdNm;
+ property OrgnlCdtrSchmeIdIdPrvtIdOthrId: String read fOrgnlCdtrSchmeIdIdPrvtIdOthrId write SetOrgnlCdtrSchmeIdIdPrvtIdOthrId;
+ property OrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry: String read fOrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry write fOrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry;
+ property OrgnlDbtrAcct: TAccountIdentification read fOrgnlDbtrAcct;
+ property OrgnlDbtrAgtFinInstIdOthrId: String read fOrgnlDbtrAgtFinInstIdOthrId write fOrgnlDbtrAgtFinInstIdOthrId;
+
+ function Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream; const schema: String);
+ end;
+
+ TMandateRelatedInformation = class
+ private
+ fMndtId: String; // mandate identification
+ fDtOfSgntr: TDateTime; // date of signature
+ fAmdmntInd: Boolean; // amendment indicator ("false" or "true")
+ fAmdmntInfDtls: TAmendmentInformationDetails;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ property MndtId: String read fMndtId write fMndtId;
+ property DtOfSgntr: TDateTime read fDtOfSgntr write fDtOfSgntr;
+ property AmdmntInd: Boolean read fAmdmntInd write fAmdmntInd;
+ property AmdmntInfDtls: TAmendmentInformationDetails read fAmdmntInfDtls;
+
+ function Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream; const schema: String);
+ end;
+
+ TDirectDebitTransactionInformation = class
+ private
+ fPmtIdEndToEndId: String; // end-to-end identification of this payment (by default "NOTPROVIDED")
+ fInstdAmtCcy: String; // instructed amount, currency (always "EUR")
+ fInstdAmt: Currency; // instructed amount
+ fDrctDbtTxMndtRltdInf: TMandateRelatedInformation;
+ fDbtrAgt: TFinancialInstitution; // debtor agent
+ fDbtrNm: String; // debtor name
+ fDbtrAcct: TAccountIdentification; // debtor account identification
+ fUltmtDbtrNm: String; // ultimate debtor name (optional)
+ fRmtInfUstrd: String; // unstructured remittance information
+
+ procedure SetDbtrNm(const str: String);
+ procedure SetUltmtDbtrNm(const str: String);
+ procedure SetRmtInfUstrd(const str: String);
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ property PmtIdEndToEndId: String read fPmtIdEndToEndId write fPmtIdEndToEndId;
+ property InstdAmtCcy: String read fInstdAmtCcy write fInstdAmtCcy;
+ property InstdAmt: Currency read fInstdAmt write fInstdAmt;
+ property DrctDbtTxMndtRltdInf: TMandateRelatedInformation read fDrctDbtTxMndtRltdInf;
+ property DbtrAgt: TFinancialInstitution read fDbtrAgt;
+ property DbtrNm: String read fDbtrNm write SetDbtrNm;
+ property DbtrAcct: TAccountIdentification read fDbtrAcct;
+ property UltmtDbtrNm: String read fUltmtDbtrNm write SetUltmtDbtrNm;
+ property RmtInfUstrd: String read fRmtInfUstrd write SetRmtInfUstrd;
+
+ function Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream; const schema: String);
+ end;
+
+ TDirectDebitPaymentInformation = class
+ private
+ fPmtInfId: String; // payment information identification
+ fPmtMtd: String; // payment method (always "DD")
+ fPmtTpInfSvcLvlCd: String; // payment type, service level code (always "SEPA")
+ fPmtTpInfLclInstrmCd: String; // payment type, local instrument code ("CORE", "COR1" or "B2B")
+ fPmtTpInfSeqTp: String; // payment type, sequence type ("FRST", "RCUR", "OOFF" or "FNAL")
+ fReqdColltnDt: TDateTime; // requested collection date
+ fCdtrNm: String; // creditor name
+ fCdtrAcct: TAccountIdentification; // creditor account identification
+ fCdtrAgt: TFinancialInstitution; // creditor agent
+ fChrgBr: String; // charge bearer (always "SLEV")
+ fCdtrSchmeIdIdPrvtIdOthrId: String; // creditor identifier
+ fCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry: String; // proprietary (always "SEPA")
+ fDrctDbtTxInf: array of TDirectDebitTransactionInformation;
+
+ procedure SetCdtrNm(const str: String);
+ procedure SetCdtrSchmeIdIdPrvtIdOthrId(const str: String);
+
+ function GetCtrlSum: Currency;
+ function GetDrctDbtTxInfEntry(const i: Integer): TDirectDebitTransactionInformation;
+ function GetDrctDbtTxInfCount: Integer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ property PmtInfId: String read fPmtInfId write fPmtInfId;
+ property PmtMtd: String read fPmtMtd write fPmtMtd;
+ property NbOfTxs: Integer read GetDrctDbtTxInfCount;
+ property CtrlSum: Currency read GetCtrlSum;
+ property PmtTpInfSvcLvlCd: String read fPmtTpInfSvcLvlCd write fPmtTpInfSvcLvlCd;
+ property PmtTpInfLclInstrmCd: String read fPmtTpInfLclInstrmCd write fPmtTpInfLclInstrmCd;
+ property PmtTpInfSeqTp: String read fPmtTpInfSeqTp write fPmtTpInfSeqTp;
+ property ReqdColltnDt: TDateTime read fReqdColltnDt write fReqdColltnDt;
+ property CdtrNm: String read fCdtrNm write SetCdtrNm;
+ property CdtrAcct: TAccountIdentification read fCdtrAcct;
+ property CdtrAgt: TFinancialInstitution read fCdtrAgt;
+ property ChrgBr: String read fChrgBr write fChrgBr;
+ property CdtrSchmeIdIdPrvtIdOthrId: String read fCdtrSchmeIdIdPrvtIdOthrId write SetCdtrSchmeIdIdPrvtIdOthrId;
+ property CdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry: String read fCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry write fCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry;
+
+ procedure AppendDrctDbtTxInfEntry(const transaction: TDirectDebitTransactionInformation);
+ property DrctDbtTxInfEntry[const i: Integer]: TDirectDebitTransactionInformation read GetDrctDbtTxInfEntry;
+ property DrctDbtTxInfCount: Integer read GetDrctDbtTxInfCount;
+
+ function Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream; const schema: String);
+ end;
+
+ TDirectDebitInitiation = class
+ private
+ fSchema: String; // ISO schema, e.g. "pain.008.002.02", empty means auto-select based on date and COR1
+ fGrpHdrMsgId: String; // group header: message identification
+ fGrpHdrCreDtTm: TDateTime; // group header: time of file creation
+ fGrpHdrInitgPtyName: String; // group header: initiator name
+ fPmtInf: array of TDirectDebitPaymentInformation;
+
+ function GetSchema: String;
+ procedure SetGrpHdrInitgPtyName(const str: String);
+
+ function GetGrpHdrNbOfTxs: Integer;
+ function GetPmtInfEntry(const i: Integer): TDirectDebitPaymentInformation;
+ function GetPmtInfCount: Integer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+
+ property Schema: String read GetSchema write fSchema;
+
+ property GrpHdrMsgId: String read fGrpHdrMsgId write fGrpHdrMsgId;
+ property GrpHdrCreDtTm: TDateTime read fGrpHdrCreDtTm write fGrpHdrCreDtTm;
+ property GrpHdrNbOfTxs: Integer read GetGrpHdrNbOfTxs;
+ property GrpHdrInitgPtyName: String read fGrpHdrInitgPtyName write SetGrpHdrInitgPtyName;
+
+ procedure AppendPmtInfEntry(const instruction: TDirectDebitPaymentInformation);
+ property PmtInfEntry[const i: Integer]: TDirectDebitPaymentInformation read GetPmtInfEntry;
+ property PmtInfCount: Integer read GetPmtInfCount;
+
+ function Validate(const appendTo: TStringList = nil): TStringList;
+ procedure SaveToStream(const stream: TStream);
+ procedure SaveToDisk(const FileName: String);
+ end;
+
+implementation
+
+// TAmendmentInformationDetails
+
+constructor TAmendmentInformationDetails.Create;
+begin
+ inherited;
+ fOrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry := SEPA;
+ fOrgnlDbtrAcct := TAccountIdentification.Create;
+end;
+
+destructor TAmendmentInformationDetails.Destroy;
+begin
+ FreeAndNil(fOrgnlDbtrAcct);
+ inherited;
+end;
+
+procedure TAmendmentInformationDetails.SetOrgnlCdtrSchmeIdIdPrvtIdOthrId(const str: String);
+begin
+ fOrgnlCdtrSchmeIdIdPrvtIdOthrId := SEPACleanIBANorBICorCI(str);
+end;
+
+function TAmendmentInformationDetails.Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ // check for empty fields
+
+ if (OrgnlMndtId = '') and (OrgnlCdtrSchmeIdNm = '') and (OrgnlCdtrSchmeIdIdPrvtIdOthrId = '') and
+ (OrgnlDbtrAcct.IBAN = '') and (OrgnlDbtrAgtFinInstIdOthrId = '') then
+ Result.Append(EMPTY_AMDMNT_INF_DTLS);
+
+ // check for invalid fields
+
+ if not SEPACheckString(OrgnlMndtId, MNDT_ID_MAX_LEN) then
+ Result.Append(Format(INVALID_ORGNL_MNDT_ID, [OrgnlMndtId]));
+
+ if not SEPACheckString(OrgnlCdtrSchmeIdNm, CDTR_NM_MAX_LEN) then
+ Result.Append(Format(INVALID_ORGNL_CRDTR_NM, [OrgnlCdtrSchmeIdNm]));
+
+ if (OrgnlCdtrSchmeIdIdPrvtIdOthrId <> '') and not SEPACheckCI(OrgnlCdtrSchmeIdIdPrvtIdOthrId) then
+ Result.Append(Format(INVALID_ORGNL_CRDTR_ID, [OrgnlCdtrSchmeIdIdPrvtIdOthrId]));
+
+ if OrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry <> SEPA then
+ Result.Append(Format(INVALID_ORGNL_CRDTR_PRTRY, [OrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry]));
+
+ if (OrgnlDbtrAgtFinInstIdOthrId <> '') and (OrgnlDbtrAgtFinInstIdOthrId <> ORGNL_DBTR_AGT_SMNDA) then
+ Result.Append(Format(INVALID_ORGNL_FIN_INST_ID, [OrgnlDbtrAgtFinInstIdOthrId]));
+
+ // delegate validations where possible
+
+ if (OrgnlDbtrAcct.IBAN <> '') then
+ OrgnlDbtrAcct.Validate(schema, Result);
+end;
+
+procedure TAmendmentInformationDetails.SaveToStream(const stream: TStream; const schema: String);
+begin
+ SEPAWriteLine(stream, '');
+
+ if OrgnlMndtId <> '' then
+ SEPAWriteLine(stream, ''+SEPACleanString(OrgnlMndtId)+'');
+
+ if (OrgnlCdtrSchmeIdNm <> '') or (OrgnlCdtrSchmeIdIdPrvtIdOthrId <> '') then
+ begin
+ SEPAWriteLine(stream, '');
+ if OrgnlCdtrSchmeIdNm <> '' then
+ SEPAWriteLine(stream, ''+SEPACleanString(OrgnlCdtrSchmeIdNm, CDTR_NM_MAX_LEN)+'');
+ if OrgnlCdtrSchmeIdIdPrvtIdOthrId <> '' then
+ SEPAWriteLine(stream, ''+
+ ''+SEPACleanString(OrgnlCdtrSchmeIdIdPrvtIdOthrId)+''+
+ ''+SEPACleanString(OrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry)+''+
+ '');
+ SEPAWriteLine(stream, '');
+ end;
+
+ if OrgnlDbtrAcct.IBAN <> '' then
+ begin
+ SEPAWriteLine(stream, '');
+ OrgnlDbtrAcct.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+ end;
+
+ if OrgnlDbtrAgtFinInstIdOthrId <> '' then
+ SEPAWriteLine(stream, ''+SEPACleanString(OrgnlDbtrAgtFinInstIdOthrId)+'');
+
+ SEPAWriteLine(stream, '');
+end;
+
+// TMandateRelatedInformation
+
+constructor TMandateRelatedInformation.Create;
+begin
+ inherited;
+ fAmdmntInfDtls := TAmendmentInformationDetails.Create;
+end;
+
+destructor TMandateRelatedInformation.Destroy;
+begin
+ FreeAndNil(fAmdmntInfDtls);
+ inherited;
+end;
+
+function TMandateRelatedInformation.Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ // check for empty fields
+
+ if MndtId = '' then
+ Result.Append(EMPTY_MNDT_ID);
+
+ if Trunc(DtOfSgntr) = 0 then
+ Result.Append(EMPTY_DT_OF_SGNTR);
+
+ // check for invalid fields
+
+ if not SEPACheckString(MndtId, MNDT_ID_MAX_LEN) then
+ Result.Append(Format(INVALID_MNDT_ID, [MndtId]));
+
+ if Trunc(DtOfSgntr) > Trunc(Today) then
+ Result.Append(Format(INVALID_DT_OF_SGNTR, [DateToStr(DtOfSgntr)]));
+
+ // delegate validations where possible
+
+ if AmdmntInd then
+ AmdmntInfDtls.Validate(schema, Result);
+end;
+
+procedure TMandateRelatedInformation.SaveToStream(const stream: TStream; const schema: String);
+begin
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, ''+SEPACleanString(MndtId, MNDT_ID_MAX_LEN)+'');
+ SEPAWriteLine(stream, ''+SEPAFormatDate(DtOfSgntr)+'');
+ SEPAWriteLine(stream, ''+SEPAFormatBoolean(AmdmntInd)+'');
+ if AmdmntInd then
+ AmdmntInfDtls.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+end;
+
+// TDirectDebitTransactionInformation
+
+constructor TDirectDebitTransactionInformation.Create;
+begin
+ inherited;
+ fPmtIdEndToEndId := END_TO_END_ID_NOTPROVIDED;
+ fInstdAmtCcy := CCY_EUR;
+ fDrctDbtTxMndtRltdInf := TMandateRelatedInformation.Create;
+ fDbtrAgt := TFinancialInstitution.Create;
+ fDbtrAcct := TAccountIdentification.Create;
+end;
+
+destructor TDirectDebitTransactionInformation.Destroy;
+begin
+ FreeAndNil(fDrctDbtTxMndtRltdInf);
+ FreeAndNil(fDbtrAgt);
+ FreeAndNil(fDbtrAcct);
+ inherited;
+end;
+
+procedure TDirectDebitTransactionInformation.SetDbtrNm(const str: String);
+begin
+ fDbtrNm := SEPACleanString(str);
+end;
+
+procedure TDirectDebitTransactionInformation.SetUltmtDbtrNm(const str: String);
+begin
+ fUltmtDbtrNm := SEPACleanString(str);
+end;
+
+procedure TDirectDebitTransactionInformation.SetRmtInfUstrd(const str: String);
+begin
+ fRmtInfUstrd := SEPACleanString(str);
+end;
+
+function TDirectDebitTransactionInformation.Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ // check for empty fields
+
+ if PmtIdEndToEndId = '' then
+ Result.Append(EMPTY_END_TO_END_ID);
+
+ if InstdAmtCcy = '' then
+ Result.Append(EMPTY_INSTD_AMT_CCY);
+
+ if DbtrNm = '' then
+ Result.Append(EMPTY_DBTR_NM);
+
+ if RmtInfUstrd = '' then
+ Result.Append(EMPTY_RMT_INF_USTRD);
+
+ // check for invalid fields
+
+ if not SEPACheckString(PmtIdEndToEndId, END_TO_END_ID_MAX_LEN) then
+ Result.Append(Format(INVALID_END_TO_END_ID, [PmtIdEndToEndId]));
+
+ if (InstdAmt <= 0.0) or not SEPACheckRounded(InstdAmt) then
+ Result.Append(Format(INVALID_INSTD_AMT, [SEPAFormatAmount(InstdAmt, 4)]));
+
+ if not SEPACheckString(DbtrNm, DBTR_NM_MAX_LEN) then
+ Result.Append(Format(INVALID_DBTR_NM, [DbtrNm]));
+
+ if not SEPACheckString(UltmtDbtrNm, DBTR_NM_MAX_LEN) then
+ Result.Append(Format(INVALID_ULTMT_DBTR_NM, [UltmtDbtrNm]));
+
+ if not SEPACheckString(RmtInfUstrd, RMT_INF_USTRD_MAX_LEN) then
+ Result.Append(Format(INVALID_RMT_INF_USTRD, [RmtInfUstrd]));
+
+ // delegate validations where possible
+
+ DbtrAgt.Validate(schema, Result);
+ DbtrAcct.Validate(schema, Result);
+ DrctDbtTxMndtRltdInf.Validate(schema, Result);
+
+ // plausibility checks
+
+ if (DbtrAgt.OthrID = FIN_INSTN_NOTPROVIDED) and not SEPAIsGermanIBAN(DbtrAcct.IBAN) then
+ Result.Append(INVALID_IBAN_NOT_DE);
+end;
+
+procedure TDirectDebitTransactionInformation.SaveToStream(const stream: TStream; const schema: String);
+begin
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtIdEndToEndId)+'');
+ SEPAWriteLine(stream, ''+SEPAFormatAmount(InstdAmt)+'');
+
+ SEPAWriteLine(stream, '');
+ DrctDbtTxMndtRltdInf.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, '');
+ DbtrAgt.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPACleanString(DbtrNm, DBTR_NM_MAX_LEN)+'');
+
+ SEPAWriteLine(stream, '');
+ DbtrAcct.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+
+ if UltmtDbtrNm <> '' then
+ SEPAWriteLine(stream, ''+SEPACleanString(UltmtDbtrNm, DBTR_NM_MAX_LEN)+'');
+
+ SEPAWriteLine(stream, ''+SEPACleanString(RmtInfUstrd, RMT_INF_USTRD_MAX_LEN)+'');
+
+ SEPAWriteLine(stream, '');
+end;
+
+// TDirectDebitPaymentInformation
+
+constructor TDirectDebitPaymentInformation.Create;
+begin
+ inherited;
+ fPmtInfId := SEPAGenerateUUID;
+ fPmtMtd := PMT_MTD_DIRECT_DEBIT;
+ fPmtTpInfSvcLvlCd := SEPA;
+ fChrgBr := CHRG_BR_SLEV;
+ fCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry := SEPA;
+ fCdtrAcct := TAccountIdentification.Create;
+ fCdtrAgt := TFinancialInstitution.Create;
+end;
+
+destructor TDirectDebitPaymentInformation.Destroy;
+var
+ i: Integer;
+begin
+ FreeAndNil(fCdtrAcct);
+ FreeAndNil(fCdtrAgt);
+ for i := Low(fDrctDbtTxInf) to High(fDrctDbtTxInf) do
+ FreeAndNil(fDrctDbtTxInf[i]);
+ inherited;
+end;
+
+procedure TDirectDebitPaymentInformation.SetCdtrNm(const str: String);
+begin
+ fCdtrNm := SEPACleanString(str);
+end;
+
+procedure TDirectDebitPaymentInformation.SetCdtrSchmeIdIdPrvtIdOthrId(const str: String);
+begin
+ fCdtrSchmeIdIdPrvtIdOthrId := SEPACleanIBANorBICorCI(str);
+end;
+
+function TDirectDebitPaymentInformation.GetCtrlSum: Currency;
+var
+ i: Integer;
+begin
+ Result := 0.0;
+ for i := 0 to DrctDbtTxInfCount-1 do
+ Result := Result + DrctDbtTxInfEntry[i].InstdAmt;
+end;
+
+procedure TDirectDebitPaymentInformation.AppendDrctDbtTxInfEntry(const transaction: TDirectDebitTransactionInformation);
+var
+ i: Integer;
+begin
+ i := Length(fDrctDbtTxInf);
+ SetLength(fDrctDbtTxInf, i+1);
+ fDrctDbtTxInf[i] := transaction;
+end;
+
+function TDirectDebitPaymentInformation.GetDrctDbtTxInfEntry(const i: Integer): TDirectDebitTransactionInformation;
+begin
+ Result := fDrctDbtTxInf[i];
+end;
+
+function TDirectDebitPaymentInformation.GetDrctDbtTxInfCount: Integer;
+begin
+ Result := Length(fDrctDbtTxInf);
+end;
+
+function TDirectDebitPaymentInformation.Validate(const schema: String; const appendTo: TStringList = nil): TStringList;
+var
+ possible_reqd_colltn_dt: Cardinal;
+ add_days,i: Integer;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ // check for empty fields
+
+ if PmtInfId = '' then
+ Result.Append(EMPTY_PMT_INF_ID);
+
+ if CdtrNm = '' then
+ Result.Append(EMPTY_CDTR_NM);
+
+ if CdtrSchmeIdIdPrvtIdOthrId = '' then
+ Result.Append(EMPTY_CDTR_ID);
+
+ // check for invalid fields
+
+ if not SEPACheckString(PmtInfId, ID_MAX_LEN) then
+ Result.Append(Format(INVALID_PMT_INF_ID, [PmtInfId]));
+
+ if PmtMtd <> PMT_MTD_DIRECT_DEBIT then
+ Result.Append(Format(INVALID_PMT_MTD, [PmtMtd]));
+
+ if (PmtTpInfLclInstrmCd <> LCL_INSTRM_CD_CORE) and
+ (PmtTpInfLclInstrmCd <> LCL_INSTRM_CD_COR1) and
+ (PmtTpInfLclInstrmCd <> LCL_INSTRM_CD_B2B) then
+ Result.Append(Format(INVALID_LCL_INSTRM_CD, [PmtTpInfLclInstrmCd]));
+
+ if (PmtTpInfLclInstrmCd = LCL_INSTRM_CD_COR1) and (schema <> SCHEMA_PAIN_008_003_02) then
+ Result.Append(INVALID_LCL_INSTRM_CD_COR1);
+
+ if (PmtTpInfSeqTp <> SEQ_TP_FRST) and
+ (PmtTpInfSeqTp <> SEQ_TP_RCUR) and
+ (PmtTpInfSeqTp <> SEQ_TP_OOFF) and
+ (PmtTpInfSeqTp <> SEQ_TP_FNAL) then
+ Result.Append(Format(INVALID_SEQ_TP, [PmtTpInfSeqTp]));
+
+ // compute earliest possible date for collection (not precise: e.g. no holidays; always ask your bank for deadlines)
+ possible_reqd_colltn_dt := Trunc(Today);
+ if PmtTpInfLclInstrmCd = LCL_INSTRM_CD_CORE then
+ begin
+ if (PmtTpInfSeqTp = SEQ_TP_FRST) or (PmtTpInfSeqTp = SEQ_TP_OOFF) then
+ add_days := 5
+ else
+ add_days := 2;
+ end
+ else
+ add_days := 1;
+ for i := 1 to add_days do
+ begin
+ Inc(possible_reqd_colltn_dt);
+ while DayOfTheWeek(possible_reqd_colltn_dt) > 5 do
+ Inc(possible_reqd_colltn_dt);
+ end;
+ if Trunc(ReqdColltnDt) < possible_reqd_colltn_dt then
+ Result.Append(Format(INVALID_REQD_COLLTN_DT, [DateToStr(ReqdColltnDt)]));
+
+ if PmtTpInfSvcLvlCd <> SEPA then
+ Result.Append(Format(INVALID_SVC_LVL_CD, [PmtTpInfSvcLvlCd]));
+
+ if ChrgBr <> CHRG_BR_SLEV then
+ Result.Append(Format(INVALID_CHRG_BR, [ChrgBr]));
+
+ if not SEPACheckString(CdtrNm, CDTR_NM_MAX_LEN) then
+ Result.Append(Format(INVALID_CDTR_NM, [CdtrNm]));
+
+ if not SEPACheckCI(CdtrSchmeIdIdPrvtIdOthrId) then
+ Result.Append(Format(INVALID_CDTR_ID, [CdtrSchmeIdIdPrvtIdOthrId]));
+
+ if CdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry <> SEPA then
+ Result.Append(Format(INVALID_CDTR_PRTRY, [CdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry]));
+
+ // delegate validations where possible
+
+ CdtrAcct.Validate(schema, Result);
+ CdtrAgt.Validate(schema, Result);
+
+ for i := 0 to DrctDbtTxInfCount-1 do
+ DrctDbtTxInfEntry[i].Validate(schema, Result);
+
+ // plausibility checks
+
+ if not SEPAIsGermanIBAN(CdtrAcct.IBAN) then
+ Result.Append(INVALID_CDTR_ACCT_NOT_DE);
+
+ if PmtTpInfSeqTp = SEQ_TP_FRST then
+ begin
+ for i := 0 to DrctDbtTxInfCount-1 do
+ begin
+ if DrctDbtTxInfEntry[i].DrctDbtTxMndtRltdInf.AmdmntInd then
+ begin
+ if DrctDbtTxInfEntry[i].DrctDbtTxMndtRltdInf.AmdmntInfDtls.OrgnlDbtrAgtFinInstIdOthrId <> ORGNL_DBTR_AGT_SMNDA then
+ Result.Append(INVALID_SEQ_TP_FRST_SMNDA1);
+ end;
+ end;
+ end
+ else
+ begin
+ for i := 0 to DrctDbtTxInfCount-1 do
+ begin
+ if DrctDbtTxInfEntry[i].DrctDbtTxMndtRltdInf.AmdmntInd then
+ begin
+ if DrctDbtTxInfEntry[i].DrctDbtTxMndtRltdInf.AmdmntInfDtls.OrgnlDbtrAgtFinInstIdOthrId = ORGNL_DBTR_AGT_SMNDA then
+ Result.Append(INVALID_SEQ_TP_FRST_SMNDA2);
+ end;
+ end;
+ end;
+
+ // note: number of objects in DrctDbtTxInf is not checked - if empty, then this
+ // object will be ignored by TDirectDebitInitiation; and TDirectDebitInitiation
+ // ensures in its validation that it has some transactions
+end;
+
+procedure TDirectDebitPaymentInformation.SaveToStream(const stream: TStream; const schema: String);
+var
+ i: Integer;
+begin
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtInfId)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtMtd)+'');
+ SEPAWriteLine(stream, ''+IntToStr(NbOfTxs)+'');
+ SEPAWriteLine(stream, ''+SEPAFormatAmount(CtrlSum)+'');
+
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtTpInfSvcLvlCd)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(PmtTpInfLclInstrmCd)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(fPmtTpInfSeqTp)+'');
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPAFormatDate(ReqdColltnDt)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(CdtrNm, CDTR_NM_MAX_LEN)+'');
+
+ SEPAWriteLine(stream, '');
+ CdtrAcct.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, '');
+ CdtrAgt.SaveToStream(stream, schema);
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, ''+SEPACleanString(ChrgBr)+'');
+
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, ''+SEPACleanString(CdtrSchmeIdIdPrvtIdOthrId)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(CdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry)+'');
+ SEPAWriteLine(stream, '');
+
+ for i := 0 to DrctDbtTxInfCount-1 do
+ DrctDbtTxInfEntry[i].SaveToStream(stream, schema);
+
+ SEPAWriteLine(stream, '');
+end;
+
+// TDirectDebitInitiation
+
+constructor TDirectDebitInitiation.Create;
+begin
+ inherited;
+ fSchema := ''; // empty = auto-select
+ fGrpHdrMsgId := SEPAGenerateUUID;
+ fGrpHdrCreDtTm := Now;
+end;
+
+destructor TDirectDebitInitiation.Destroy;
+var
+ i: Integer;
+begin
+ for i := Low(fPmtInf) to High(fPmtInf) do
+ FreeAndNil(fPmtInf[i]);
+ inherited;
+end;
+
+function TDirectDebitInitiation.GetSchema: String;
+begin
+ Result := fSchema;
+ if Result = '' then
+ Result := SCHEMA_PAIN_008_003_02;
+end;
+
+procedure TDirectDebitInitiation.SetGrpHdrInitgPtyName(const str: String);
+begin
+ fGrpHdrInitgPtyName := SEPACleanString(str);
+end;
+
+function TDirectDebitInitiation.GetGrpHdrNbOfTxs: Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to PmtInfCount-1 do
+ Inc(Result, PmtInfEntry[i].NbOfTxs);
+end;
+
+procedure TDirectDebitInitiation.AppendPmtInfEntry(const instruction: TDirectDebitPaymentInformation);
+var
+ i: Integer;
+begin
+ i := Length(fPmtInf);
+ SetLength(fPmtInf, i+1);
+ fPmtInf[i] := instruction;
+end;
+
+function TDirectDebitInitiation.GetPmtInfEntry(const i: Integer): TDirectDebitPaymentInformation;
+begin
+ Result := fPmtInf[i];
+end;
+
+function TDirectDebitInitiation.GetPmtInfCount: Integer;
+begin
+ Result := Length(fPmtInf);
+end;
+
+function TDirectDebitInitiation.Validate(const appendTo: TStringList = nil): TStringList;
+var
+ FirstPmtTpInfLclInstrmCd: String;
+ i: Integer;
+begin
+ if appendTo <> nil then
+ Result := appendTo
+ else
+ Result := TStringList.Create;
+
+ // check ISO schema
+
+ if (Schema <> SCHEMA_PAIN_008_002_02) and (Schema <> SCHEMA_PAIN_008_003_02) then
+ Result.Append(Format(UNKNOWN_SCHEMA, [Schema]));
+
+ // check for empty fields
+
+ if GrpHdrMsgId = '' then
+ Result.Append(EMPTY_GRP_HDR_MSG_ID);
+
+ if GrpHdrInitgPtyName = '' then
+ Result.Append(EMPTY_INITG_PTY_NAME);
+
+ // check for invalid fields
+
+ if not SEPACheckString(GrpHdrMsgId, ID_MAX_LEN) then
+ Result.Append(Format(INVALID_GRP_HDR_MSG_ID, [GrpHdrMsgId]));
+
+ if not SEPACheckString(GrpHdrInitgPtyName, INITG_PTY_NAME_MAX_LEN) then
+ Result.Append(Format(INVALID_INITG_PTY_NAME, [GrpHdrInitgPtyName]));
+
+ // delegate validations where possible
+
+ for i := 0 to PmtInfCount-1 do
+ PmtInfEntry[i].Validate(Schema, Result);
+
+ // plausibility checks
+
+ if GrpHdrNbOfTxs = 0 then
+ Result.Append(INVALID_NB_OF_TXS);
+
+ if PmtInfCount > 0 then
+ begin
+ FirstPmtTpInfLclInstrmCd := PmtInfEntry[0].PmtTpInfLclInstrmCd;
+ for i := 1 to PmtInfCount-1 do
+ begin
+ if (PmtInfEntry[i].PmtTpInfLclInstrmCd <> FirstPmtTpInfLclInstrmCd) then
+ begin
+ Result.Append(INVALID_PMT_INF_MIXING);
+ Break;
+ end;
+ end;
+ end;
+end;
+
+procedure TDirectDebitInitiation.SaveToStream(const stream: TStream);
+var
+ i: Integer;
+begin
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, '');
+
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, ''+SEPACleanString(GrpHdrMsgId)+'');
+ SEPAWriteLine(stream, ''+SEPAFormatDateTime(GrpHdrCreDtTm)+'');
+ SEPAWriteLine(stream, ''+IntToStr(GrpHdrNbOfTxs)+'');
+ SEPAWriteLine(stream, ''+SEPACleanString(GrpHdrInitgPtyName, INITG_PTY_NAME_MAX_LEN)+'');
+ SEPAWriteLine(stream, '');
+
+ for i := 0 to PmtInfCount-1 do
+ if PmtInfEntry[i].NbOfTxs > 0 then
+ PmtInfEntry[i].SaveToStream(stream, Schema);
+
+ SEPAWriteLine(stream, '');
+ SEPAWriteLine(stream, '');
+end;
+
+procedure TDirectDebitInitiation.SaveToDisk(const FileName: String);
+var
+ stream: TMemoryStream;
+begin
+ stream := TMemoryStream.Create;
+ try
+ SaveToStream(stream);
+ stream.SaveToFile(FileName);
+ finally
+ stream.Free;
+ end;
+end;
+
+end.
diff --git a/Source/Modulos/Banca electronica/Utiles/SEPAUnit/gpl.txt b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/gpl.txt
new file mode 100644
index 0000000..4914014
--- /dev/null
+++ b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/gpl.txt
@@ -0,0 +1,357 @@
+GNU General Public License
+**************************
+
+ Version 2, June 1991
+
+ Copyright (C) 1989, 1991 Free Software Foundation, Inc.
+ 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
+
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+Preamble
+========
+
+The licenses for most software are designed to take away your freedom
+to share and change it. By contrast, the GNU General Public License is
+intended to guarantee your freedom to share and change free
+software--to make sure the software is free for all its users. This
+General Public License applies to most of the Free Software
+Foundation's software and to any other program whose authors commit to
+using it. (Some other Free Software Foundation software is covered by
+the GNU Library General Public License instead.) You can apply it to
+your programs, too.
+
+When we speak of free software, we are referring to freedom, not price.
+Our General Public Licenses are designed to make sure that you have
+the freedom to distribute copies of free software (and charge for this
+service if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs; and that you know you can do these things.
+
+To protect your rights, we need to make restrictions that forbid anyone
+to deny you these rights or to ask you to surrender the rights. These
+restrictions translate to certain responsibilities for you if you
+distribute copies of the software, or if you modify it.
+
+For example, if you distribute copies of such a program, whether gratis
+or for a fee, you must give the recipients all the rights that you
+have. You must make sure that they, too, receive or can get the source
+code. And you must show them these terms so they know their rights.
+
+We protect your rights with two steps: (1) copyright the software, and
+(2) offer you this license which gives you legal permission to copy,
+distribute and/or modify the software.
+
+Also, for each author's protection and ours, we want to make certain
+that everyone understands that there is no warranty for this free
+software. If the software is modified by someone else and passed on, we
+want its recipients to know that what they have is not the original, so
+that any problems introduced by others will not reflect on the original
+authors' reputations.
+
+Finally, any free program is threatened constantly by software patents.
+We wish to avoid the danger that redistributors of a free program will
+individually obtain patent licenses, in effect making the program
+proprietary. To prevent this, we have made it clear that any patent
+must be licensed for everyone's free use or not licensed at all.
+
+The precise terms and conditions for copying, distribution and
+modification follow.
+
+ GNU GENERAL PUBLIC LICENSE
+
+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
+
+ 0. This License applies to any program or other work which contains a
+ notice placed by the copyright holder saying it may be distributed
+ under the terms of this General Public License. The "Program",
+ below, refers to any such program or work, and a "work based on
+ the Program" means either the Program or any derivative work under
+ copyright law: that is to say, a work containing the Program or a
+ portion of it, either verbatim or with modifications and/or
+ translated into another language. (Hereinafter, translation is
+ included without limitation in the term "modification".) Each
+ licensee is addressed as "you".
+
+ Activities other than copying, distribution and modification are
+ not covered by this License; they are outside its scope. The act
+ of running the Program is not restricted, and the output from the
+ Program is covered only if its contents constitute a work based on
+ the Program (independent of having been made by running the
+ Program). Whether that is true depends on what the Program does.
+
+ 1. You may copy and distribute verbatim copies of the Program's
+ source code as you receive it, in any medium, provided that you
+ conspicuously and appropriately publish on each copy an appropriate
+ copyright notice and disclaimer of warranty; keep intact all the
+ notices that refer to this License and to the absence of any
+ warranty; and give any other recipients of the Program a copy of
+ this License along with the Program.
+
+ You may charge a fee for the physical act of transferring a copy,
+ and you may at your option offer warranty protection in exchange
+ for a fee.
+
+ 2. You may modify your copy or copies of the Program or any portion
+ of it, thus forming a work based on the Program, and copy and
+ distribute such modifications or work under the terms of Section 1
+ above, provided that you also meet all of these conditions:
+
+ a. You must cause the modified files to carry prominent notices
+ stating that you changed the files and the date of any change.
+
+ b. You must cause any work that you distribute or publish, that
+ in whole or in part contains or is derived from the Program
+ or any part thereof, to be licensed as a whole at no charge
+ to all third parties under the terms of this License.
+
+ c. If the modified program normally reads commands interactively
+ when run, you must cause it, when started running for such
+ interactive use in the most ordinary way, to print or display
+ an announcement including an appropriate copyright notice and
+ a notice that there is no warranty (or else, saying that you
+ provide a warranty) and that users may redistribute the
+ program under these conditions, and telling the user how to
+ view a copy of this License. (Exception: if the Program
+ itself is interactive but does not normally print such an
+ announcement, your work based on the Program is not required
+ to print an announcement.)
+
+ These requirements apply to the modified work as a whole. If
+ identifiable sections of that work are not derived from the
+ Program, and can be reasonably considered independent and separate
+ works in themselves, then this License, and its terms, do not
+ apply to those sections when you distribute them as separate
+ works. But when you distribute the same sections as part of a
+ whole which is a work based on the Program, the distribution of
+ the whole must be on the terms of this License, whose permissions
+ for other licensees extend to the entire whole, and thus to each
+ and every part regardless of who wrote it.
+
+ Thus, it is not the intent of this section to claim rights or
+ contest your rights to work written entirely by you; rather, the
+ intent is to exercise the right to control the distribution of
+ derivative or collective works based on the Program.
+
+ In addition, mere aggregation of another work not based on the
+ Program with the Program (or with a work based on the Program) on
+ a volume of a storage or distribution medium does not bring the
+ other work under the scope of this License.
+
+ 3. You may copy and distribute the Program (or a work based on it,
+ under Section 2) in object code or executable form under the terms
+ of Sections 1 and 2 above provided that you also do one of the
+ following:
+
+ a. Accompany it with the complete corresponding machine-readable
+ source code, which must be distributed under the terms of
+ Sections 1 and 2 above on a medium customarily used for
+ software interchange; or,
+
+ b. Accompany it with a written offer, valid for at least three
+ years, to give any third-party, for a charge no more than your
+ cost of physically performing source distribution, a complete
+ machine-readable copy of the corresponding source code, to be
+ distributed under the terms of Sections 1 and 2 above on a
+ medium customarily used for software interchange; or,
+
+ c. Accompany it with the information you received as to the offer
+ to distribute corresponding source code. (This alternative is
+ allowed only for noncommercial distribution and only if you
+ received the program in object code or executable form with
+ such an offer, in accord with Subsection b above.)
+
+ The source code for a work means the preferred form of the work for
+ making modifications to it. For an executable work, complete
+ source code means all the source code for all modules it contains,
+ plus any associated interface definition files, plus the scripts
+ used to control compilation and installation of the executable.
+ However, as a special exception, the source code distributed need
+ not include anything that is normally distributed (in either
+ source or binary form) with the major components (compiler,
+ kernel, and so on) of the operating system on which the executable
+ runs, unless that component itself accompanies the executable.
+
+ If distribution of executable or object code is made by offering
+ access to copy from a designated place, then offering equivalent
+ access to copy the source code from the same place counts as
+ distribution of the source code, even though third parties are not
+ compelled to copy the source along with the object code.
+
+ 4. You may not copy, modify, sublicense, or distribute the Program
+ except as expressly provided under this License. Any attempt
+ otherwise to copy, modify, sublicense or distribute the Program is
+ void, and will automatically terminate your rights under this
+ License. However, parties who have received copies, or rights,
+ from you under this License will not have their licenses
+ terminated so long as such parties remain in full compliance.
+
+ 5. You are not required to accept this License, since you have not
+ signed it. However, nothing else grants you permission to modify
+ or distribute the Program or its derivative works. These actions
+ are prohibited by law if you do not accept this License.
+ Therefore, by modifying or distributing the Program (or any work
+ based on the Program), you indicate your acceptance of this
+ License to do so, and all its terms and conditions for copying,
+ distributing or modifying the Program or works based on it.
+
+ 6. Each time you redistribute the Program (or any work based on the
+ Program), the recipient automatically receives a license from the
+ original licensor to copy, distribute or modify the Program
+ subject to these terms and conditions. You may not impose any
+ further restrictions on the recipients' exercise of the rights
+ granted herein. You are not responsible for enforcing compliance
+ by third parties to this License.
+
+ 7. If, as a consequence of a court judgment or allegation of patent
+ infringement or for any other reason (not limited to patent
+ issues), conditions are imposed on you (whether by court order,
+ agreement or otherwise) that contradict the conditions of this
+ License, they do not excuse you from the conditions of this
+ License. If you cannot distribute so as to satisfy simultaneously
+ your obligations under this License and any other pertinent
+ obligations, then as a consequence you may not distribute the
+ Program at all. For example, if a patent license would not permit
+ royalty-free redistribution of the Program by all those who
+ receive copies directly or indirectly through you, then the only
+ way you could satisfy both it and this License would be to refrain
+ entirely from distribution of the Program.
+
+ If any portion of this section is held invalid or unenforceable
+ under any particular circumstance, the balance of the section is
+ intended to apply and the section as a whole is intended to apply
+ in other circumstances.
+
+ It is not the purpose of this section to induce you to infringe any
+ patents or other property right claims or to contest validity of
+ any such claims; this section has the sole purpose of protecting
+ the integrity of the free software distribution system, which is
+ implemented by public license practices. Many people have made
+ generous contributions to the wide range of software distributed
+ through that system in reliance on consistent application of that
+ system; it is up to the author/donor to decide if he or she is
+ willing to distribute software through any other system and a
+ licensee cannot impose that choice.
+
+ This section is intended to make thoroughly clear what is believed
+ to be a consequence of the rest of this License.
+
+ 8. If the distribution and/or use of the Program is restricted in
+ certain countries either by patents or by copyrighted interfaces,
+ the original copyright holder who places the Program under this
+ License may add an explicit geographical distribution limitation
+ excluding those countries, so that distribution is permitted only
+ in or among countries not thus excluded. In such case, this
+ License incorporates the limitation as if written in the body of
+ this License.
+
+ 9. The Free Software Foundation may publish revised and/or new
+ versions of the General Public License from time to time. Such
+ new versions will be similar in spirit to the present version, but
+ may differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+ Program specifies a version number of this License which applies
+ to it and "any later version", you have the option of following
+ the terms and conditions either of that version or of any later
+ version published by the Free Software Foundation. If the Program
+ does not specify a version number of this License, you may choose
+ any version ever published by the Free Software Foundation.
+
+ 10. If you wish to incorporate parts of the Program into other free
+ programs whose distribution conditions are different, write to the
+ author to ask for permission. For software which is copyrighted
+ by the Free Software Foundation, write to the Free Software
+ Foundation; we sometimes make exceptions for this. Our decision
+ will be guided by the two goals of preserving the free status of
+ all derivatives of our free software and of promoting the sharing
+ and reuse of software generally.
+
+ NO WARRANTY
+
+ 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO
+ WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE
+ LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+ HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT
+ WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT
+ NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+ FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE
+ QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
+ PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY
+ SERVICING, REPAIR OR CORRECTION.
+
+ 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
+ WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY
+ MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE
+ LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL,
+ INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR
+ INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+ DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU
+ OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY
+ OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN
+ ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
+
+ END OF TERMS AND CONDITIONS
+
+How to Apply These Terms to Your New Programs
+=============================================
+
+If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these
+terms.
+
+To do so, attach the following notices to the program. It is safest to
+attach them to the start of each source file to most effectively convey
+the exclusion of warranty; and each file should have at least the
+"copyright" line and a pointer to where the full notice is found.
+
+ ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES.
+ Copyright (C) YYYY NAME OF AUTHOR
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 2 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+Also add information on how to contact you by electronic and paper mail.
+
+If the program is interactive, make it output a short notice like this
+when it starts in an interactive mode:
+
+ Gnomovision version 69, Copyright (C) 19YY NAME OF AUTHOR
+ Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the
+appropriate parts of the General Public License. Of course, the
+commands you use may be called something other than `show w' and `show
+c'; they could even be mouse-clicks or menu items--whatever suits your
+program.
+
+You should also get your employer (if you work as a programmer) or your
+school, if any, to sign a "copyright disclaimer" for the program, if
+necessary. Here is a sample; alter the names:
+
+ Yoyodyne, Inc., hereby disclaims all copyright interest in the program
+ `Gnomovision' (which makes passes at compilers) written by James Hacker.
+
+ SIGNATURE OF TY COON, 1 April 1989
+ Ty Coon, President of Vice
+
+This General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library,
+you may consider it more useful to permit linking proprietary
+applications with the library. If this is what you want to do, use the
+GNU Library General Public License instead of this License.
diff --git a/Source/Modulos/Banca electronica/Utiles/SEPAUnit/license.txt b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/license.txt
new file mode 100644
index 0000000..142b8dd
--- /dev/null
+++ b/Source/Modulos/Banca electronica/Utiles/SEPAUnit/license.txt
@@ -0,0 +1,3 @@
+The license under which this software is released is the GPLv2 (or
+later) from the Free Software Foundation. A copy of the GPLv2 license
+is included, see "gpl.txt".
\ No newline at end of file
diff --git a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dpk b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dpk
index 9a48a0c..87abb27 100644
--- a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dpk
+++ b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dpk
@@ -53,6 +53,7 @@ contains
uBancaElectronicaViewRegister in 'uBancaElectronicaViewRegister.pas',
uEditorExportacionNorma19 in 'uEditorExportacionNorma19.pas' {fEditorExportacionNorma19},
uEditorExportacionNorma19SEPA in 'uEditorExportacionNorma19SEPA.pas' {fEditorExportacionNorma19SEPA},
- uEditorExportacionNorma32 in 'uEditorExportacionNorma32.pas' {fEditorExportacionNorma32};
+ uEditorExportacionNorma32 in 'uEditorExportacionNorma32.pas' {fEditorExportacionNorma32},
+ uEditorExportacionNorma19SEPAXML in 'uEditorExportacionNorma19SEPAXML.pas' {fEditorExportacionNorma19SEPAXML};
end.
diff --git a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dproj b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dproj
index a24f16b..9ddcbd6 100644
--- a/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dproj
+++ b/Source/Modulos/Banca electronica/Views/BancaElectronica_view.dproj
@@ -47,29 +47,25 @@
MainSource
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
@@ -77,9 +73,16 @@
+
+
+
+
+
+
+