Adaptación a normativa SEPA XML - Terminado pero sin probar con banco.
git-svn-id: https://192.168.0.254/svn/Proyectos.LuisLeon_FactuGES2/trunk@244 b2cfbe5a-eba1-4a0c-8b32-7feea0a119f2
This commit is contained in:
parent
b5508059d2
commit
a80cf72851
67
Source/Base/Utiles/uDisplayUtils.pas
Normal file
67
Source/Base/Utiles/uDisplayUtils.pas
Normal file
@ -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.
|
||||
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
@ -54,6 +54,7 @@
|
||||
<DCCReference Include="..\Utiles\CVBNorma1958CSB.pas" />
|
||||
<DCCReference Include="..\Utiles\CVBNorma19CSB.pas" />
|
||||
<DCCReference Include="..\Utiles\CVBNorma19SEPA.pas" />
|
||||
<DCCReference Include="..\Utiles\CVBNorma19SEPAXML.pas" />
|
||||
<DCCReference Include="..\Utiles\CVBNorma32CSB.pas" />
|
||||
<DCCReference Include="..\Utiles\CVBNorma34CSB.pas" />
|
||||
<DCCReference Include="..\Utiles\CVBUtils.pas" />
|
||||
@ -61,10 +62,14 @@
|
||||
<DCCReference Include="..\Utiles\RemesasCliente_controller.dcp" />
|
||||
<DCCReference Include="..\Utiles\RemesasCliente_model.dcp" />
|
||||
<DCCReference Include="..\Utiles\rtl.dcp" />
|
||||
<DCCReference Include="..\Utiles\SEPAUnit\SEPACommon.pas" />
|
||||
<DCCReference Include="..\Utiles\SEPAUnit\SEPACreditTransfer.pas" />
|
||||
<DCCReference Include="..\Utiles\SEPAUnit\SEPADirectDebit.pas" />
|
||||
<DCCReference Include="..\Utiles\vcl.dcp" />
|
||||
<DCCReference Include="uBancaElectronicaController.pas" />
|
||||
<DCCReference Include="View\uIEditorExportacionNorma19.pas" />
|
||||
<DCCReference Include="View\uIEditorExportacionNorma19SEPA.pas" />
|
||||
<DCCReference Include="View\uIEditorExportacionNorma19SEPAXML.pas" />
|
||||
<DCCReference Include="View\uIEditorExportacionNorma32.pas" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
|
||||
@ -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.
|
||||
@ -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;
|
||||
|
||||
428
Source/Modulos/Banca electronica/Utiles/CVBNorma19SEPAXML.pas
Normal file
428
Source/Modulos/Banca electronica/Utiles/CVBNorma19SEPAXML.pas
Normal file
@ -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.
|
||||
@ -64,8 +64,6 @@ end;
|
||||
|
||||
|
||||
function Trim(const cString: string): string;
|
||||
var
|
||||
I: integer;
|
||||
begin
|
||||
Result := TrimLeft(TrimRight(cString));
|
||||
end;
|
||||
|
||||
BIN
Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.dcu
Normal file
BIN
Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.dcu
Normal file
Binary file not shown.
587
Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.pas
Normal file
587
Source/Modulos/Banca electronica/Utiles/SEPAUnit/SEPACommon.pas
Normal file
@ -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, '<FinInstnId><Othr><Id>'+SEPACleanString(OthrID)+'</Id></Othr></FinInstnId>')
|
||||
else
|
||||
SEPAWriteLine(stream, '<FinInstnId><BIC>'+SEPACleanString(BIC)+'</BIC></FinInstnId>');
|
||||
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, '<Id><IBAN>'+SEPACleanString(IBAN)+'</IBAN></Id>');
|
||||
end;
|
||||
|
||||
{$IFDEF FormatSettings}
|
||||
initialization
|
||||
// initialize format settings variable with correct decimal separator
|
||||
SEPAFormatSettings := DefaultFormatSettings;
|
||||
SEPAFormatSettings.DecimalSeparator := '.';
|
||||
{$ENDIF}
|
||||
|
||||
end.
|
||||
Binary file not shown.
@ -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
|
||||
// ---------------------------------------------------------------------------
|
||||
// <Document> TCreditTransferInitiation
|
||||
// <CstmrCdtTrfInitn> TCreditTransferInitiation
|
||||
// <PmtInf> TCreditTransferPaymentInformation
|
||||
// <CdtTrfTxInf> TCreditTransferTransactionInformation
|
||||
// <CdtTrfTxInf> ...
|
||||
// ...
|
||||
// <PmtInf>
|
||||
// ...
|
||||
//
|
||||
// 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 <CdtrAgt> 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, '<CdtTrfTxInf>');
|
||||
|
||||
SEPAWriteLine(stream, '<PmtId><EndToEndId>'+SEPACleanString(PmtIdEndToEndId)+'</EndToEndId></PmtId>');
|
||||
SEPAWriteLine(stream, '<Amt><InstdAmt Ccy="'+SEPACleanString(InstdAmtCcy)+'">'+SEPAFormatAmount(InstdAmt)+'</InstdAmt></Amt>');
|
||||
|
||||
if CdtrAgt.BIC <> '' then // note: do not write <CdtrAgt> block to the file if IBAN-only
|
||||
begin // is required, see also comment in method Validate
|
||||
SEPAWriteLine(stream, '<CdtrAgt>');
|
||||
CdtrAgt.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</CdtrAgt>');
|
||||
end;
|
||||
|
||||
SEPAWriteLine(stream, '<Cdtr><Nm>'+SEPACleanString(CdtrNm, DBTR_NM_MAX_LEN)+'</Nm></Cdtr>');
|
||||
|
||||
SEPAWriteLine(stream, '<CdtrAcct>');
|
||||
CdtrAcct.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</CdtrAcct>');
|
||||
|
||||
SEPAWriteLine(stream, '<RmtInf><Ustrd>'+SEPACleanString(RmtInfUstrd, RMT_INF_USTRD_MAX_LEN)+'</Ustrd></RmtInf>');
|
||||
|
||||
SEPAWriteLine(stream, '</CdtTrfTxInf>');
|
||||
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, '<PmtInf>');
|
||||
|
||||
SEPAWriteLine(stream, '<PmtInfId>'+SEPACleanString(PmtInfId)+'</PmtInfId>');
|
||||
SEPAWriteLine(stream, '<PmtMtd>'+SEPACleanString(PmtMtd)+'</PmtMtd>');
|
||||
SEPAWriteLine(stream, '<NbOfTxs>'+IntToStr(NbOfTxs)+'</NbOfTxs>');
|
||||
SEPAWriteLine(stream, '<CtrlSum>'+SEPAFormatAmount(CtrlSum)+'</CtrlSum>');
|
||||
|
||||
SEPAWriteLine(stream, '<PmtTpInf>');
|
||||
if PmtTpInfInstrPrty <> '' then
|
||||
SEPAWriteLine(stream, '<InstrPrty>'+SEPACleanString(PmtTpInfInstrPrty)+'</InstrPrty>');
|
||||
SEPAWriteLine(stream, '<SvcLvl><Cd>'+SEPACleanString(PmtTpInfSvcLvlCd)+'</Cd></SvcLvl>');
|
||||
SEPAWriteLine(stream, '</PmtTpInf>');
|
||||
|
||||
SEPAWriteLine(stream, '<ReqdExctnDt>'+SEPAFormatDate(ReqdExctnDt)+'</ReqdExctnDt>');
|
||||
SEPAWriteLine(stream, '<Dbtr><Nm>'+SEPACleanString(DbtrNm, DBTR_NM_MAX_LEN)+'</Nm></Dbtr>');
|
||||
|
||||
SEPAWriteLine(stream, '<DbtrAcct>');
|
||||
DbtrAcct.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</DbtrAcct>');
|
||||
|
||||
SEPAWriteLine(stream, '<DbtrAgt>');
|
||||
DbtrAgt.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</DbtrAgt>');
|
||||
|
||||
SEPAWriteLine(stream, '<ChrgBr>'+SEPACleanString(ChrgBr)+'</ChrgBr>');
|
||||
|
||||
for i := 0 to CdtTrfTxInfCount-1 do
|
||||
CdtTrfTxInfEntry[i].SaveToStream(stream, schema);
|
||||
|
||||
SEPAWriteLine(stream, '</PmtInf>');
|
||||
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, '<?xml version="1.0" encoding="UTF-8"?>');
|
||||
SEPAWriteLine(stream, '<Document xmlns="urn:iso:std:iso:20022:tech:xsd:'+Schema+'"'+
|
||||
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"'+
|
||||
' xsi:schemaLocation="urn:iso:std:iso:20022:tech:xsd:'+Schema+' '+Schema+'.xsd">');
|
||||
SEPAWriteLine(stream, '<CstmrCdtTrfInitn>');
|
||||
|
||||
SEPAWriteLine(stream, '<GrpHdr>');
|
||||
SEPAWriteLine(stream, '<MsgId>'+SEPACleanString(GrpHdrMsgId)+'</MsgId>');
|
||||
SEPAWriteLine(stream, '<CreDtTm>'+SEPAFormatDateTime(GrpHdrCreDtTm)+'</CreDtTm>');
|
||||
SEPAWriteLine(stream, '<NbOfTxs>'+IntToStr(GrpHdrNbOfTxs)+'</NbOfTxs>');
|
||||
SEPAWriteLine(stream, '<InitgPty><Nm>'+SEPACleanString(GrpHdrInitgPtyName, INITG_PTY_NAME_MAX_LEN)+'</Nm></InitgPty>');
|
||||
SEPAWriteLine(stream, '</GrpHdr>');
|
||||
|
||||
for i := 0 to PmtInfCount-1 do
|
||||
if PmtInfEntry[i].NbOfTxs > 0 then
|
||||
PmtInfEntry[i].SaveToStream(stream, Schema);
|
||||
|
||||
SEPAWriteLine(stream, '</CstmrCdtTrfInitn>');
|
||||
SEPAWriteLine(stream, '</Document>');
|
||||
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.
|
||||
Binary file not shown.
@ -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
|
||||
// ---------------------------------------------------------------------------
|
||||
// <Document> TDirectDebitInitiation
|
||||
// <CstmrDrctDbtInitn> TDirectDebitInitiation
|
||||
// <PmtInf> TDirectDebitPaymentInformation
|
||||
// <DrctDbtTxInf> TDirectDebitTransactionInformation
|
||||
// <MndtRltdInf> TMandateRelatedInformation
|
||||
// <AmdmntInfDtls> TAmendmentInformationDetails
|
||||
// <DrctDbtTxInf> ...
|
||||
// ...
|
||||
// <PmtInf>
|
||||
// ...
|
||||
//
|
||||
// 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, '<AmdmntInfDtls>');
|
||||
|
||||
if OrgnlMndtId <> '' then
|
||||
SEPAWriteLine(stream, '<OrgnlMndtId>'+SEPACleanString(OrgnlMndtId)+'</OrgnlMndtId>');
|
||||
|
||||
if (OrgnlCdtrSchmeIdNm <> '') or (OrgnlCdtrSchmeIdIdPrvtIdOthrId <> '') then
|
||||
begin
|
||||
SEPAWriteLine(stream, '<OrgnlCdtrSchmeId>');
|
||||
if OrgnlCdtrSchmeIdNm <> '' then
|
||||
SEPAWriteLine(stream, '<Nm>'+SEPACleanString(OrgnlCdtrSchmeIdNm, CDTR_NM_MAX_LEN)+'</Nm>');
|
||||
if OrgnlCdtrSchmeIdIdPrvtIdOthrId <> '' then
|
||||
SEPAWriteLine(stream, '<Id><PrvtId><Othr>'+
|
||||
'<Id>'+SEPACleanString(OrgnlCdtrSchmeIdIdPrvtIdOthrId)+'</Id>'+
|
||||
'<SchmeNm><Prtry>'+SEPACleanString(OrgnlCdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry)+'</Prtry></SchmeNm>'+
|
||||
'</Othr></PrvtId></Id>');
|
||||
SEPAWriteLine(stream, '</OrgnlCdtrSchmeId>');
|
||||
end;
|
||||
|
||||
if OrgnlDbtrAcct.IBAN <> '' then
|
||||
begin
|
||||
SEPAWriteLine(stream, '<OrgnlDbtrAcct>');
|
||||
OrgnlDbtrAcct.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</OrgnlDbtrAcct>');
|
||||
end;
|
||||
|
||||
if OrgnlDbtrAgtFinInstIdOthrId <> '' then
|
||||
SEPAWriteLine(stream, '<OrgnlDbtrAgt><FinInstnId><Othr><Id>'+SEPACleanString(OrgnlDbtrAgtFinInstIdOthrId)+'</Id></Othr></FinInstnId></OrgnlDbtrAgt>');
|
||||
|
||||
SEPAWriteLine(stream, '</AmdmntInfDtls>');
|
||||
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, '<MndtRltdInf>');
|
||||
SEPAWriteLine(stream, '<MndtId>'+SEPACleanString(MndtId, MNDT_ID_MAX_LEN)+'</MndtId>');
|
||||
SEPAWriteLine(stream, '<DtOfSgntr>'+SEPAFormatDate(DtOfSgntr)+'</DtOfSgntr>');
|
||||
SEPAWriteLine(stream, '<AmdmntInd>'+SEPAFormatBoolean(AmdmntInd)+'</AmdmntInd>');
|
||||
if AmdmntInd then
|
||||
AmdmntInfDtls.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</MndtRltdInf>');
|
||||
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, '<DrctDbtTxInf>');
|
||||
|
||||
SEPAWriteLine(stream, '<PmtId><EndToEndId>'+SEPACleanString(PmtIdEndToEndId)+'</EndToEndId></PmtId>');
|
||||
SEPAWriteLine(stream, '<InstdAmt Ccy="'+SEPACleanString(InstdAmtCcy)+'">'+SEPAFormatAmount(InstdAmt)+'</InstdAmt>');
|
||||
|
||||
SEPAWriteLine(stream, '<DrctDbtTx>');
|
||||
DrctDbtTxMndtRltdInf.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</DrctDbtTx>');
|
||||
|
||||
SEPAWriteLine(stream, '<DbtrAgt>');
|
||||
DbtrAgt.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</DbtrAgt>');
|
||||
|
||||
SEPAWriteLine(stream, '<Dbtr><Nm>'+SEPACleanString(DbtrNm, DBTR_NM_MAX_LEN)+'</Nm></Dbtr>');
|
||||
|
||||
SEPAWriteLine(stream, '<DbtrAcct>');
|
||||
DbtrAcct.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</DbtrAcct>');
|
||||
|
||||
if UltmtDbtrNm <> '' then
|
||||
SEPAWriteLine(stream, '<UltmtDbtr><Nm>'+SEPACleanString(UltmtDbtrNm, DBTR_NM_MAX_LEN)+'</Nm></UltmtDbtr>');
|
||||
|
||||
SEPAWriteLine(stream, '<RmtInf><Ustrd>'+SEPACleanString(RmtInfUstrd, RMT_INF_USTRD_MAX_LEN)+'</Ustrd></RmtInf>');
|
||||
|
||||
SEPAWriteLine(stream, '</DrctDbtTxInf>');
|
||||
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, '<PmtInf>');
|
||||
|
||||
SEPAWriteLine(stream, '<PmtInfId>'+SEPACleanString(PmtInfId)+'</PmtInfId>');
|
||||
SEPAWriteLine(stream, '<PmtMtd>'+SEPACleanString(PmtMtd)+'</PmtMtd>');
|
||||
SEPAWriteLine(stream, '<NbOfTxs>'+IntToStr(NbOfTxs)+'</NbOfTxs>');
|
||||
SEPAWriteLine(stream, '<CtrlSum>'+SEPAFormatAmount(CtrlSum)+'</CtrlSum>');
|
||||
|
||||
SEPAWriteLine(stream, '<PmtTpInf>');
|
||||
SEPAWriteLine(stream, '<SvcLvl><Cd>'+SEPACleanString(PmtTpInfSvcLvlCd)+'</Cd></SvcLvl>');
|
||||
SEPAWriteLine(stream, '<LclInstrm><Cd>'+SEPACleanString(PmtTpInfLclInstrmCd)+'</Cd></LclInstrm>');
|
||||
SEPAWriteLine(stream, '<SeqTp>'+SEPACleanString(fPmtTpInfSeqTp)+'</SeqTp>');
|
||||
SEPAWriteLine(stream, '</PmtTpInf>');
|
||||
|
||||
SEPAWriteLine(stream, '<ReqdColltnDt>'+SEPAFormatDate(ReqdColltnDt)+'</ReqdColltnDt>');
|
||||
SEPAWriteLine(stream, '<Cdtr><Nm>'+SEPACleanString(CdtrNm, CDTR_NM_MAX_LEN)+'</Nm></Cdtr>');
|
||||
|
||||
SEPAWriteLine(stream, '<CdtrAcct>');
|
||||
CdtrAcct.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</CdtrAcct>');
|
||||
|
||||
SEPAWriteLine(stream, '<CdtrAgt>');
|
||||
CdtrAgt.SaveToStream(stream, schema);
|
||||
SEPAWriteLine(stream, '</CdtrAgt>');
|
||||
|
||||
SEPAWriteLine(stream, '<ChrgBr>'+SEPACleanString(ChrgBr)+'</ChrgBr>');
|
||||
|
||||
SEPAWriteLine(stream, '<CdtrSchmeId><Id><PrvtId><Othr>');
|
||||
SEPAWriteLine(stream, '<Id>'+SEPACleanString(CdtrSchmeIdIdPrvtIdOthrId)+'</Id>');
|
||||
SEPAWriteLine(stream, '<SchmeNm><Prtry>'+SEPACleanString(CdtrSchmeIdIdPrvtIdOthrSchmeNmPrtry)+'</Prtry></SchmeNm>');
|
||||
SEPAWriteLine(stream, '</Othr></PrvtId></Id></CdtrSchmeId>');
|
||||
|
||||
for i := 0 to DrctDbtTxInfCount-1 do
|
||||
DrctDbtTxInfEntry[i].SaveToStream(stream, schema);
|
||||
|
||||
SEPAWriteLine(stream, '</PmtInf>');
|
||||
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, '<?xml version="1.0" encoding="UTF-8"?>');
|
||||
SEPAWriteLine(stream, '<Document xmlns="urn:iso:std:iso:20022:tech:xsd:'+Schema+'"'+
|
||||
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"'+
|
||||
' xsi:schemaLocation="urn:iso:std:iso:20022:tech:xsd:'+Schema+' '+Schema+'.xsd">');
|
||||
SEPAWriteLine(stream, '<CstmrDrctDbtInitn>');
|
||||
|
||||
SEPAWriteLine(stream, '<GrpHdr>');
|
||||
SEPAWriteLine(stream, '<MsgId>'+SEPACleanString(GrpHdrMsgId)+'</MsgId>');
|
||||
SEPAWriteLine(stream, '<CreDtTm>'+SEPAFormatDateTime(GrpHdrCreDtTm)+'</CreDtTm>');
|
||||
SEPAWriteLine(stream, '<NbOfTxs>'+IntToStr(GrpHdrNbOfTxs)+'</NbOfTxs>');
|
||||
SEPAWriteLine(stream, '<InitgPty><Nm>'+SEPACleanString(GrpHdrInitgPtyName, INITG_PTY_NAME_MAX_LEN)+'</Nm></InitgPty>');
|
||||
SEPAWriteLine(stream, '</GrpHdr>');
|
||||
|
||||
for i := 0 to PmtInfCount-1 do
|
||||
if PmtInfEntry[i].NbOfTxs > 0 then
|
||||
PmtInfEntry[i].SaveToStream(stream, Schema);
|
||||
|
||||
SEPAWriteLine(stream, '</CstmrDrctDbtInitn>');
|
||||
SEPAWriteLine(stream, '</Document>');
|
||||
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.
|
||||
357
Source/Modulos/Banca electronica/Utiles/SEPAUnit/gpl.txt
Normal file
357
Source/Modulos/Banca electronica/Utiles/SEPAUnit/gpl.txt
Normal file
@ -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.
|
||||
@ -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".
|
||||
@ -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.
|
||||
|
||||
@ -47,29 +47,25 @@
|
||||
<DelphiCompile Include="BancaElectronica_view.dpk">
|
||||
<MainSource>MainSource</MainSource>
|
||||
</DelphiCompile>
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\BancaElectronica_controller.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\bdertl.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\cxDataD11.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\cxEditorsD11.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\cxLibraryD11.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\dbrtl.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\dxCoreD11.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\dxGDIPlusD11.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\dxThemeD11.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\Jcl.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\JclVcl.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\JvCoreD11R.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\JvCustomD11R.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\JvDlgsD11R.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\JvGlobusD11R.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\JvStdCtrlsD11R.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\JvSystemD11R.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\PNG_D10.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\rtl.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\vcl.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\vcldb.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\vcljpg.dcp" />
|
||||
<DCCReference Include="C:\Documents and Settings\Usuario\vclx.dcp" />
|
||||
<DCCReference Include="BancaElectronica_controller.dcp" />
|
||||
<DCCReference Include="bdertl.dcp" />
|
||||
<DCCReference Include="cxDataD11.dcp" />
|
||||
<DCCReference Include="cxEditorsD11.dcp" />
|
||||
<DCCReference Include="cxLibraryD11.dcp" />
|
||||
<DCCReference Include="dbrtl.dcp" />
|
||||
<DCCReference Include="dxCoreD11.dcp" />
|
||||
<DCCReference Include="dxGDIPlusD11.dcp" />
|
||||
<DCCReference Include="dxThemeD11.dcp" />
|
||||
<DCCReference Include="Jcl.dcp" />
|
||||
<DCCReference Include="JclVcl.dcp" />
|
||||
<DCCReference Include="JvCoreD11R.dcp" />
|
||||
<DCCReference Include="JvCustomD11R.dcp" />
|
||||
<DCCReference Include="JvDlgsD11R.dcp" />
|
||||
<DCCReference Include="JvGlobusD11R.dcp" />
|
||||
<DCCReference Include="JvStdCtrlsD11R.dcp" />
|
||||
<DCCReference Include="JvSystemD11R.dcp" />
|
||||
<DCCReference Include="PNG_D10.dcp" />
|
||||
<DCCReference Include="rtl.dcp" />
|
||||
<DCCReference Include="uBancaElectronicaViewRegister.pas" />
|
||||
<DCCReference Include="uEditorExportacionNorma19.pas">
|
||||
<Form>fEditorExportacionNorma19</Form>
|
||||
@ -77,9 +73,16 @@
|
||||
<DCCReference Include="uEditorExportacionNorma19SEPA.pas">
|
||||
<Form>fEditorExportacionNorma19SEPA</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uEditorExportacionNorma19SEPAXML.pas">
|
||||
<Form>fEditorExportacionNorma19SEPAXM</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="uEditorExportacionNorma32.pas">
|
||||
<Form>fEditorExportacionNorma32</Form>
|
||||
</DCCReference>
|
||||
<DCCReference Include="vcl.dcp" />
|
||||
<DCCReference Include="vcldb.dcp" />
|
||||
<DCCReference Include="vcljpg.dcp" />
|
||||
<DCCReference Include="vclx.dcp" />
|
||||
</ItemGroup>
|
||||
</Project>
|
||||
<!-- EurekaLog First Line
|
||||
|
||||
@ -32,19 +32,21 @@ implementation
|
||||
|
||||
uses
|
||||
uEditorRegistryUtils, uEditorExportacionNorma19, uEditorExportacionNorma19SEPA,
|
||||
uEditorExportacionNorma32;
|
||||
uEditorExportacionNorma19SEPAXML, uEditorExportacionNorma32;
|
||||
|
||||
procedure RegisterViews;
|
||||
begin
|
||||
EditorRegistry.RegisterClass(TfEditorExportacionNorma19, 'EditorExportacionNorma19');
|
||||
EditorRegistry.RegisterClass(TfEditorExportacionNorma19SEPA, 'EditorExportacionNorma19SEPA');
|
||||
EditorRegistry.RegisterClass(TfEditorExportacionNorma19SEPA, 'EditorExportacionNorma19SEPA');
|
||||
EditorRegistry.RegisterClass(TfEditorExportacionNorma19SEPAXML, 'EditorExportacionNorma19SEPAXML');
|
||||
EditorRegistry.RegisterClass(TfEditorExportacionNorma32, 'EditorExportacionNorma32');
|
||||
end;
|
||||
|
||||
procedure UnregisterViews;
|
||||
begin
|
||||
EditorRegistry.UnRegisterClass(TfEditorExportacionNorma19);
|
||||
EditorRegistry.UnRegisterClass(TfEditorExportacionNorma19SEPA);
|
||||
EditorRegistry.UnRegisterClass(TfEditorExportacionNorma19SEPA);
|
||||
EditorRegistry.UnRegisterClass(TfEditorExportacionNorma19SEPAXML);
|
||||
EditorRegistry.UnRegisterClass(TfEditorExportacionNorma32);
|
||||
end;
|
||||
|
||||
|
||||
@ -0,0 +1,234 @@
|
||||
object fEditorExportacionNorma19SEPAXML: TfEditorExportacionNorma19SEPAXML
|
||||
Left = 0
|
||||
Top = 0
|
||||
ActiveControl = edtCodEntidad
|
||||
BorderStyle = bsDialog
|
||||
Caption = 'Volcado de remesas a disco (Norma 19 SEPA XML)'
|
||||
ClientHeight = 265
|
||||
ClientWidth = 389
|
||||
Color = clBtnFace
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
Font.Color = clWindowText
|
||||
Font.Height = -11
|
||||
Font.Name = 'Tahoma'
|
||||
Font.Style = []
|
||||
OldCreateOrder = False
|
||||
Position = poMainFormCenter
|
||||
OnCreate = FormCreate
|
||||
DesignSize = (
|
||||
389
|
||||
265)
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
object Label2: TLabel
|
||||
Left = 24
|
||||
Top = 51
|
||||
Width = 90
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Entidad receptora:'
|
||||
end
|
||||
object Label3: TLabel
|
||||
Left = 24
|
||||
Top = 78
|
||||
Width = 42
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Agencia:'
|
||||
end
|
||||
object Image1: TImage
|
||||
Left = 345
|
||||
Top = 15
|
||||
Width = 28
|
||||
Height = 28
|
||||
AutoSize = True
|
||||
Picture.Data = {
|
||||
0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001C00
|
||||
00001C0806000000720DDF940000000970485973000017120000171201679FD2
|
||||
520000000467414D410000B18E7CFB5193000002CA4944415478DAADD55F4853
|
||||
511C07F0DF25C49012DA8B1085A14581E46EAD19A3D05885CA8CA251D04325BD
|
||||
D89342BEF5B087E8CD0C7AA90916E5F0A558C8989935872C866C63EE4F5BB9A8
|
||||
508CB27AB01552F3EE4F3BBFED1E76B7BBED8E7B7F2078CFBDDCCF39BF73EE77
|
||||
8CF575280312CA785ACD4879AE5A31043C7FAABDE243CF1D61B87DC70C81D907
|
||||
B2D1AA603A9D86296704548D0D70C3745780AAAFD833A189BE9A265111241897
|
||||
4CC3B4EB1DE8D816887D5EA32862E12F00C1EBCA80630C03FD090E382E05AF16
|
||||
62D8523A91260318BB59308DD89501138718A81FBE07639787E0E2AF8DEC2A53
|
||||
F0F4851BEF8D3B5288C5FFFC8551F35CAEB5EDBB406A6B4B401E4B8C0EE1F5E3
|
||||
2040DFDA3AB6F6DCCD058A91499031D201DFDB1590DA5E01588CF14550FDF20F
|
||||
B860F2E27557C75E8AE5E014FEFFCCB65815A520D9B3014B295688721333D852
|
||||
52DA83CD303EE9A6F7CFF6AA21B199849773D18A2882674EB4E10C2D0DF5D0CF
|
||||
8A631DD15570FB23F068D286878694A08DAC39A3EFDC8FE8269704DFC35EA62C
|
||||
D873EC00DD13AB6A9B00E53172DF1B7A8F60D9CF228B6A35CDE0F3AF945D2582
|
||||
278FEECBED497E3F6676AA102DC4C85F20FA8182783A8B3EFC9EE137996F3FE3
|
||||
150F10829D9A56FAD2647EA5F32D4D028C8C45621F05A0580EDFB2AC22681DD1
|
||||
D1B1C21C4650A7DE23C004A72F3F464A0C2CFE86D9ABD308660203785D9CC308
|
||||
1E69DB0D368707A4542DA0580E2358185B52AA1A187C62289BC3B27E6E447338
|
||||
BE08E9ED2CDD9AE21C5616CC62B034082EA71B0E0FFEA36780CF61B21DCA829E
|
||||
E3008DB997C7B2B9BEE3D26F7AE8EC4EAFC2607E753CE89A0268BDB64EBFEF59
|
||||
975F3990BCB0CEDF4531BEC82AC1F01DF772DE13520624395CB71112AC8E2FB2
|
||||
4A95F12B4E88CF61D920C9E186B0BE042B44B71A96690ECB6FA93609AEFB9A8A
|
||||
CF6DE9FE447358362896C362D1C8C7A26CB0D61C960DD69AC3B2C15A73F83F42
|
||||
0A9D9B19DC72610000000049454E44AE426082}
|
||||
end
|
||||
object Bevel1: TBevel
|
||||
Left = 7
|
||||
Top = 223
|
||||
Width = 373
|
||||
Height = 3
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
Shape = bsBottomLine
|
||||
ExplicitTop = 321
|
||||
end
|
||||
object Label1: TLabel
|
||||
Left = 24
|
||||
Top = 171
|
||||
Width = 71
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Guardar como:'
|
||||
end
|
||||
object Bevel2: TBevel
|
||||
Left = 24
|
||||
Top = 152
|
||||
Width = 349
|
||||
Height = 3
|
||||
Anchors = [akLeft, akTop, akRight]
|
||||
Shape = bsBottomLine
|
||||
end
|
||||
object Label5: TLabel
|
||||
Left = 202
|
||||
Top = 51
|
||||
Width = 48
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = '(4 d'#237'gitos)'
|
||||
end
|
||||
object Label6: TLabel
|
||||
Left = 202
|
||||
Top = 78
|
||||
Width = 48
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = '(4 d'#237'gitos)'
|
||||
end
|
||||
object Label4: TLabel
|
||||
Left = 24
|
||||
Top = 108
|
||||
Width = 78
|
||||
Height = 13
|
||||
Margins.Bottom = 0
|
||||
Caption = 'Fecha de cargo:'
|
||||
end
|
||||
object edtCodEntidad: TcxMaskEdit
|
||||
Left = 120
|
||||
Top = 48
|
||||
Properties.BeepOnError = True
|
||||
Properties.MaxLength = 4
|
||||
Style.LookAndFeel.Kind = lfStandard
|
||||
Style.LookAndFeel.NativeStyle = True
|
||||
StyleDisabled.LookAndFeel.Kind = lfStandard
|
||||
StyleDisabled.LookAndFeel.NativeStyle = True
|
||||
StyleFocused.LookAndFeel.Kind = lfStandard
|
||||
StyleFocused.LookAndFeel.NativeStyle = True
|
||||
StyleHot.LookAndFeel.Kind = lfStandard
|
||||
StyleHot.LookAndFeel.NativeStyle = True
|
||||
TabOrder = 0
|
||||
Text = ' '
|
||||
Width = 73
|
||||
end
|
||||
object edtCodAgencia: TcxMaskEdit
|
||||
Left = 120
|
||||
Top = 75
|
||||
Properties.BeepOnError = True
|
||||
Properties.MaxLength = 4
|
||||
Style.LookAndFeel.Kind = lfStandard
|
||||
Style.LookAndFeel.NativeStyle = True
|
||||
StyleDisabled.LookAndFeel.Kind = lfStandard
|
||||
StyleDisabled.LookAndFeel.NativeStyle = True
|
||||
StyleFocused.LookAndFeel.Kind = lfStandard
|
||||
StyleFocused.LookAndFeel.NativeStyle = True
|
||||
StyleHot.LookAndFeel.Kind = lfStandard
|
||||
StyleHot.LookAndFeel.NativeStyle = True
|
||||
TabOrder = 1
|
||||
Text = ' '
|
||||
Width = 73
|
||||
end
|
||||
object CancelBtn: TButton
|
||||
Left = 300
|
||||
Top = 232
|
||||
Width = 75
|
||||
Height = 25
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
Cancel = True
|
||||
Caption = '&Cancelar'
|
||||
ModalResult = 2
|
||||
TabOrder = 5
|
||||
OnClick = CancelBtnClick
|
||||
ExplicitTop = 330
|
||||
end
|
||||
object OKBtn: TButton
|
||||
Left = 201
|
||||
Top = 232
|
||||
Width = 85
|
||||
Height = 25
|
||||
Action = actVolcar
|
||||
Anchors = [akLeft, akRight, akBottom]
|
||||
TabOrder = 4
|
||||
ExplicitTop = 330
|
||||
end
|
||||
object JvFilenameEdit1: TJvFilenameEdit
|
||||
Left = 24
|
||||
Top = 190
|
||||
Width = 349
|
||||
Height = 21
|
||||
Flat = False
|
||||
ParentFlat = False
|
||||
Filter = 'Ficheros de norma 32 (*.C32)|*.C32'
|
||||
DialogOptions = [ofOverwritePrompt, ofHideReadOnly, ofPathMustExist]
|
||||
DialogTitle = 'Volcar a disco la remesa'
|
||||
TabOrder = 3
|
||||
end
|
||||
object edtFechaCargo: TcxDateEdit
|
||||
Left = 120
|
||||
Top = 105
|
||||
Properties.DateButtons = [btnToday]
|
||||
Properties.ImmediatePost = True
|
||||
Properties.SaveTime = False
|
||||
Properties.ShowTime = False
|
||||
Style.LookAndFeel.Kind = lfStandard
|
||||
Style.LookAndFeel.NativeStyle = True
|
||||
StyleDisabled.LookAndFeel.Kind = lfStandard
|
||||
StyleDisabled.LookAndFeel.NativeStyle = True
|
||||
StyleFocused.LookAndFeel.Kind = lfStandard
|
||||
StyleFocused.LookAndFeel.NativeStyle = True
|
||||
StyleHot.LookAndFeel.Kind = lfStandard
|
||||
StyleHot.LookAndFeel.NativeStyle = True
|
||||
TabOrder = 2
|
||||
Width = 167
|
||||
end
|
||||
object JvFormStorage: TJvFormStorage
|
||||
AppStorage = JvAppRegistryStorage
|
||||
AppStoragePath = 'fEditorBase\'
|
||||
VersionCheck = fpvcNocheck
|
||||
StoredValues = <>
|
||||
Left = 80
|
||||
Top = 32
|
||||
end
|
||||
object JvAppRegistryStorage: TJvAppRegistryStorage
|
||||
StorageOptions.BooleanStringTrueValues = 'TRUE, YES, Y'
|
||||
StorageOptions.BooleanStringFalseValues = 'FALSE, NO, N'
|
||||
Root = 'Software\FactuGES'
|
||||
SubStorages = <>
|
||||
Left = 112
|
||||
Top = 32
|
||||
end
|
||||
object ActionList1: TActionList
|
||||
Left = 144
|
||||
Top = 32
|
||||
object actVolcar: TAction
|
||||
Caption = 'Volcar a disco'
|
||||
OnExecute = actVolcarExecute
|
||||
OnUpdate = actVolcarUpdate
|
||||
end
|
||||
end
|
||||
end
|
||||
@ -0,0 +1,166 @@
|
||||
unit uEditorExportacionNorma19SEPAXML;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
|
||||
Dialogs, ExtCtrls, StdCtrls, pngimage, cxControls, cxContainer, cxEdit,
|
||||
cxTextEdit, cxMaskEdit, cxDropDownEdit, cxCalendar,
|
||||
uIEditorExportacionNorma19SEPAXML, JvExControls, JvComponent, JvgWizardHeader,
|
||||
JvAppStorage, JvAppRegistryStorage, JvComponentBase, JvFormPlacement,
|
||||
JvDialogs, Mask, JvExMask, JvToolEdit, ActnList;
|
||||
|
||||
type
|
||||
TfEditorExportacionNorma19SEPAXML = class(TForm, IEditorExportacionNorma19SEPAXML)
|
||||
OKBtn: TButton;
|
||||
CancelBtn: TButton;
|
||||
Image1: TImage;
|
||||
Label2: TLabel;
|
||||
Label3: TLabel;
|
||||
edtCodEntidad: TcxMaskEdit;
|
||||
edtCodAgencia: TcxMaskEdit;
|
||||
Bevel1: TBevel;
|
||||
JvFormStorage: TJvFormStorage;
|
||||
JvAppRegistryStorage: TJvAppRegistryStorage;
|
||||
Label1: TLabel;
|
||||
Bevel2: TBevel;
|
||||
JvFilenameEdit1: TJvFilenameEdit;
|
||||
ActionList1: TActionList;
|
||||
actVolcar: TAction;
|
||||
Label5: TLabel;
|
||||
Label6: TLabel;
|
||||
Label4: TLabel;
|
||||
edtFechaCargo: TcxDateEdit;
|
||||
procedure OKBtnClick(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure CancelBtnClick(Sender: TObject);
|
||||
procedure actVolcarUpdate(Sender: TObject);
|
||||
procedure actVolcarExecute(Sender: TObject);
|
||||
private
|
||||
FFichero : String;
|
||||
protected
|
||||
procedure SetCodigoEntidad(const AValue: String);
|
||||
function GetCodigoEntidad : String;
|
||||
|
||||
procedure SetCodigoAgencia(const AValue: String);
|
||||
function GetCodigoAgencia : String;
|
||||
|
||||
procedure SetFechaCargo(const AValue: TDateTime);
|
||||
function GetFechaCargo : TDateTime;
|
||||
|
||||
procedure SetFichero(const AValue: String);
|
||||
function GetFichero : String;
|
||||
public
|
||||
property CodigoEntidad : String read GetCodigoEntidad write SetCodigoEntidad;
|
||||
property CodigoAgencia : String read GetCodigoAgencia write SetCodigoAgencia;
|
||||
property FechaCargo : TDateTime read GetFechaCargo write SetFechaCargo;
|
||||
property Fichero : String read GetFichero write SetFichero;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.dfm}
|
||||
|
||||
uses
|
||||
uDialogUtils;
|
||||
|
||||
{ TfEditorExportacionNorma32 }
|
||||
|
||||
procedure TfEditorExportacionNorma19SEPAXML.actVolcarExecute(Sender: TObject);
|
||||
begin
|
||||
FFichero := JvFilenameEdit1.FileName;
|
||||
ModalResult := mrOk;
|
||||
end;
|
||||
|
||||
procedure TfEditorExportacionNorma19SEPAXML.actVolcarUpdate(Sender: TObject);
|
||||
begin
|
||||
(Sender as TAction).Enabled :=
|
||||
(Length(edtCodEntidad.Text) = 4) and
|
||||
(Length(edtCodAgencia.Text) = 4) and
|
||||
(Length(JvFilenameEdit1.Text) > 0)
|
||||
end;
|
||||
|
||||
procedure TfEditorExportacionNorma19SEPAXML.CancelBtnClick(Sender: TObject);
|
||||
begin
|
||||
Close;
|
||||
end;
|
||||
|
||||
procedure TfEditorExportacionNorma19SEPAXML.FormCreate(Sender: TObject);
|
||||
var
|
||||
APath : String;
|
||||
begin
|
||||
inherited;
|
||||
with JvFormStorage do
|
||||
begin
|
||||
if Pos('_', Self.Name) = 0 then
|
||||
APath := Self.Name
|
||||
else
|
||||
APath := Copy(Self.Name, 0, (Pos('_', Self.Name)-1));
|
||||
AppStoragePath := APath;
|
||||
end;
|
||||
edtFechaCargo.Date := Now;
|
||||
end;
|
||||
|
||||
function TfEditorExportacionNorma19SEPAXML.GetCodigoAgencia: String;
|
||||
begin
|
||||
Result := edtCodAgencia.Text;
|
||||
end;
|
||||
|
||||
function TfEditorExportacionNorma19SEPAXML.GetCodigoEntidad: String;
|
||||
begin
|
||||
Result := edtCodEntidad.Text;
|
||||
end;
|
||||
|
||||
function TfEditorExportacionNorma19SEPAXML.GetFechaCargo: TDateTime;
|
||||
begin
|
||||
Result := edtFechaCargo.Date;
|
||||
end;
|
||||
|
||||
function TfEditorExportacionNorma19SEPAXML.GetFichero: String;
|
||||
begin
|
||||
Result := FFichero;
|
||||
end;
|
||||
|
||||
procedure TfEditorExportacionNorma19SEPAXML.OKBtnClick(Sender: TObject);
|
||||
var
|
||||
ASaveDialog : TSaveDialog; // Save dialog variable
|
||||
AArchivo : string;
|
||||
ARuta : String;
|
||||
begin
|
||||
AArchivo := FFichero;
|
||||
ARuta := ExtractFilePath(Application.ExeName);
|
||||
|
||||
{ if SaveFileDialog(Application.Handle, 'C19', 'Ficheros de norma 19 (*.C19)|*.C19',
|
||||
'c:\', 'Volcar a disco la remesa', FFichero) then}
|
||||
if SaveFileDialog(Application.Handle, 'XML', 'Ficheros de norma 19 (*.XML)|*.XML',
|
||||
ARuta, 'Volcar a disco la remesa', AArchivo) then
|
||||
ModalResult := mrOk
|
||||
else
|
||||
ModalResult := mrCancel;
|
||||
|
||||
end;
|
||||
|
||||
procedure TfEditorExportacionNorma19SEPAXML.SetCodigoAgencia(const AValue: String);
|
||||
begin
|
||||
edtCodAgencia.Text := AValue;
|
||||
end;
|
||||
|
||||
procedure TfEditorExportacionNorma19SEPAXML.SetCodigoEntidad(const AValue: String);
|
||||
begin
|
||||
edtCodEntidad.Text := AValue;
|
||||
end;
|
||||
|
||||
procedure TfEditorExportacionNorma19SEPAXML.SetFechaCargo(const AValue: TDateTime);
|
||||
begin
|
||||
edtFechaCargo.Date := AValue;
|
||||
end;
|
||||
|
||||
procedure TfEditorExportacionNorma19SEPAXML.SetFichero(const AValue: String);
|
||||
begin
|
||||
FFichero := AValue;
|
||||
JvFilenameEdit1.InitialDir := ExtractFilePath(Application.ExeName);
|
||||
JvFilenameEdit1.FileName := JvFilenameEdit1.InitialDir + PathDelim + FFichero;
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -5,19 +5,19 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
VertScrollBar.Visible = False
|
||||
Caption = 'Ficha de remesa de cobro'
|
||||
ClientHeight = 583
|
||||
ClientWidth = 676
|
||||
ClientWidth = 893
|
||||
Scaled = False
|
||||
OnClose = CustomEditorClose
|
||||
ExplicitWidth = 684
|
||||
ExplicitWidth = 901
|
||||
ExplicitHeight = 617
|
||||
PixelsPerInch = 96
|
||||
TextHeight = 13
|
||||
inherited JvNavPanelHeader: TJvNavPanelHeader
|
||||
Width = 676
|
||||
Width = 893
|
||||
Caption = 'Remesa de cobro'
|
||||
ExplicitWidth = 676
|
||||
ExplicitWidth = 893
|
||||
inherited Image1: TImage
|
||||
Left = 543
|
||||
Left = 760
|
||||
Picture.Data = {
|
||||
0A54504E474F626A65637489504E470D0A1A0A0000000D494844520000001800
|
||||
0000180806000000E0773DF80000000970485973000017120000171201679FD2
|
||||
@ -45,15 +45,15 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
ExplicitLeft = 607
|
||||
end
|
||||
inherited lblDesbloquear: TcxLabel
|
||||
Left = 578
|
||||
ExplicitLeft = 578
|
||||
AnchorX = 623
|
||||
Left = 795
|
||||
ExplicitLeft = 795
|
||||
AnchorX = 840
|
||||
AnchorY = 14
|
||||
end
|
||||
end
|
||||
inherited TBXDock: TTBXDock
|
||||
Width = 676
|
||||
ExplicitWidth = 676
|
||||
Width = 893
|
||||
ExplicitWidth = 893
|
||||
inherited tbxMain: TTBXToolbar
|
||||
ExplicitWidth = 586
|
||||
inherited TBXItem2: TTBXItem
|
||||
@ -68,6 +68,9 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
Caption = 'Volcar a disco'
|
||||
DisplayMode = nbdmImageAndText
|
||||
ImageIndex = 22
|
||||
object TBXItem36: TTBXItem
|
||||
Action = actNormal19SEPAXML
|
||||
end
|
||||
object TBXItem35: TTBXItem
|
||||
Action = actNorma19SEPA
|
||||
end
|
||||
@ -81,7 +84,7 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
end
|
||||
inherited tbxMenu: TTBXToolbar
|
||||
DockPos = 0
|
||||
ExplicitWidth = 676
|
||||
ExplicitWidth = 893
|
||||
inherited TBXSubmenuItem4: TTBXSubmenuItem
|
||||
inherited TBXItem8: TTBXItem
|
||||
Visible = False
|
||||
@ -115,27 +118,39 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
end
|
||||
object TBXSubmenuItem2: TTBXSubmenuItem [4]
|
||||
Caption = 'A&cciones'
|
||||
object TBXItem7: TTBXItem
|
||||
object TBXSubmenuItem8: TTBXSubmenuItem
|
||||
Action = actVolcarDisco
|
||||
object TBXItem37: TTBXItem
|
||||
Action = actNormal19SEPAXML
|
||||
end
|
||||
object TBXItem7: TTBXItem
|
||||
Action = actNorma19SEPA
|
||||
end
|
||||
object TBXItem38: TTBXItem
|
||||
Action = actNorma19
|
||||
end
|
||||
object TBXItem39: TTBXItem
|
||||
Action = actNorma32
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
inherited pgPaginas: TPageControl
|
||||
Width = 670
|
||||
Width = 887
|
||||
Height = 436
|
||||
MultiLine = True
|
||||
ExplicitWidth = 670
|
||||
ExplicitWidth = 887
|
||||
ExplicitHeight = 436
|
||||
inherited pagGeneral: TTabSheet
|
||||
ExplicitLeft = 4
|
||||
ExplicitTop = 24
|
||||
ExplicitWidth = 662
|
||||
ExplicitWidth = 879
|
||||
ExplicitHeight = 408
|
||||
inline frViewRemesaCliente1: TfrViewRemesaCliente
|
||||
Left = 0
|
||||
Top = 0
|
||||
Width = 662
|
||||
Width = 879
|
||||
Height = 145
|
||||
Align = alTop
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
@ -146,16 +161,16 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
ParentFont = False
|
||||
TabOrder = 0
|
||||
ReadOnly = False
|
||||
ExplicitWidth = 662
|
||||
ExplicitWidth = 879
|
||||
ExplicitHeight = 145
|
||||
inherited dxLayoutControlRemesaCliente: TdxLayoutControl
|
||||
Width = 662
|
||||
Width = 879
|
||||
Height = 160
|
||||
Align = alTop
|
||||
ExplicitWidth = 662
|
||||
ExplicitWidth = 879
|
||||
ExplicitHeight = 160
|
||||
DesignSize = (
|
||||
662
|
||||
879
|
||||
160)
|
||||
inherited eReferencia: TcxDBTextEdit
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
@ -174,12 +189,12 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
Width = 530
|
||||
end
|
||||
inherited edtFechaRemesa: TcxDBDateEdit
|
||||
Left = 491
|
||||
Left = 626
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
StyleDisabled.LookAndFeel.SkinName = ''
|
||||
StyleFocused.LookAndFeel.SkinName = ''
|
||||
StyleHot.LookAndFeel.SkinName = ''
|
||||
ExplicitLeft = 491
|
||||
ExplicitLeft = 626
|
||||
ExplicitWidth = 149
|
||||
Width = 149
|
||||
end
|
||||
@ -211,7 +226,7 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
inline frViewRecibosRemesaCliente1: TfrViewRecibosRemesaCliente
|
||||
Left = 0
|
||||
Top = 145
|
||||
Width = 662
|
||||
Width = 879
|
||||
Height = 263
|
||||
Align = alClient
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
@ -226,14 +241,14 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
TabOrder = 1
|
||||
ReadOnly = False
|
||||
ExplicitTop = 145
|
||||
ExplicitWidth = 662
|
||||
ExplicitWidth = 879
|
||||
ExplicitHeight = 263
|
||||
inherited cxGrid: TcxGrid
|
||||
Left = 15
|
||||
Width = 632
|
||||
Width = 849
|
||||
Height = 223
|
||||
ExplicitLeft = 15
|
||||
ExplicitWidth = 632
|
||||
ExplicitWidth = 849
|
||||
ExplicitHeight = 223
|
||||
inherited cxGridView: TcxGridDBTableView
|
||||
DataController.Summary.FooterSummaryItems = <
|
||||
@ -255,27 +270,27 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
end
|
||||
inherited ToolBar1: TToolBar
|
||||
Left = 15
|
||||
Width = 632
|
||||
Width = 849
|
||||
ExplicitLeft = 15
|
||||
ExplicitWidth = 632
|
||||
ExplicitWidth = 849
|
||||
end
|
||||
end
|
||||
end
|
||||
end
|
||||
inherited StatusBar: TJvStatusBar
|
||||
Top = 564
|
||||
Width = 676
|
||||
Width = 893
|
||||
Panels = <
|
||||
item
|
||||
Width = 200
|
||||
end>
|
||||
ExplicitTop = 564
|
||||
ExplicitWidth = 676
|
||||
ExplicitWidth = 893
|
||||
end
|
||||
inline frViewTotales1: TfrViewTotales [4]
|
||||
Left = 0
|
||||
Top = 518
|
||||
Width = 676
|
||||
Width = 893
|
||||
Height = 46
|
||||
Align = alBottom
|
||||
Font.Charset = DEFAULT_CHARSET
|
||||
@ -287,34 +302,34 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
TabOrder = 4
|
||||
ReadOnly = False
|
||||
ExplicitTop = 518
|
||||
ExplicitWidth = 676
|
||||
ExplicitWidth = 893
|
||||
ExplicitHeight = 46
|
||||
inherited dxLayoutControl1: TdxLayoutControl
|
||||
Width = 676
|
||||
Width = 893
|
||||
Height = 46
|
||||
ExplicitWidth = 676
|
||||
ExplicitWidth = 893
|
||||
ExplicitHeight = 46
|
||||
inherited Bevel3: TBevel
|
||||
Left = 381
|
||||
Left = 503
|
||||
Top = 10
|
||||
Height = 30
|
||||
ExplicitLeft = 381
|
||||
ExplicitLeft = 503
|
||||
ExplicitTop = 10
|
||||
ExplicitHeight = 30
|
||||
end
|
||||
inherited Bevel4: TBevel
|
||||
Left = 493
|
||||
Left = 615
|
||||
Top = 52
|
||||
Width = 192
|
||||
ExplicitLeft = 493
|
||||
ExplicitLeft = 615
|
||||
ExplicitTop = 52
|
||||
ExplicitWidth = 192
|
||||
end
|
||||
inherited Bevel1: TBevel
|
||||
Left = 493
|
||||
Left = 615
|
||||
Top = 168
|
||||
Width = 73
|
||||
ExplicitLeft = 493
|
||||
ExplicitLeft = 615
|
||||
ExplicitTop = 168
|
||||
ExplicitWidth = 73
|
||||
end
|
||||
@ -341,7 +356,7 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
Width = 157
|
||||
end
|
||||
inherited ImporteIVA: TcxDBCurrencyEdit
|
||||
Left = 564
|
||||
Left = 686
|
||||
Top = 87
|
||||
DataBinding.DataField = ''
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
@ -349,20 +364,20 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
StyleDisabled.LookAndFeel.SkinName = ''
|
||||
StyleFocused.LookAndFeel.SkinName = ''
|
||||
StyleHot.LookAndFeel.SkinName = ''
|
||||
ExplicitLeft = 564
|
||||
ExplicitLeft = 686
|
||||
ExplicitTop = 87
|
||||
ExplicitWidth = 147
|
||||
Width = 147
|
||||
end
|
||||
inherited ImporteTotal: TcxDBCurrencyEdit
|
||||
Left = 494
|
||||
Left = 616
|
||||
Top = 141
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
Style.IsFontAssigned = True
|
||||
StyleDisabled.LookAndFeel.SkinName = ''
|
||||
StyleFocused.LookAndFeel.SkinName = ''
|
||||
StyleHot.LookAndFeel.SkinName = ''
|
||||
ExplicitLeft = 494
|
||||
ExplicitLeft = 616
|
||||
ExplicitTop = 141
|
||||
ExplicitWidth = 217
|
||||
Width = 217
|
||||
@ -380,7 +395,7 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
ExplicitTop = 37
|
||||
end
|
||||
inherited edtIVA: TcxDBSpinEdit
|
||||
Left = 493
|
||||
Left = 615
|
||||
Top = 87
|
||||
DataBinding.DataField = ''
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
@ -388,11 +403,11 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
StyleDisabled.LookAndFeel.SkinName = ''
|
||||
StyleFocused.LookAndFeel.SkinName = ''
|
||||
StyleHot.LookAndFeel.SkinName = ''
|
||||
ExplicitLeft = 493
|
||||
ExplicitLeft = 615
|
||||
ExplicitTop = 87
|
||||
end
|
||||
inherited ImporteBase: TcxDBCurrencyEdit
|
||||
Left = 493
|
||||
Left = 615
|
||||
Top = 10
|
||||
DataBinding.DataField = ''
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
@ -400,13 +415,13 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
StyleDisabled.LookAndFeel.SkinName = ''
|
||||
StyleFocused.LookAndFeel.SkinName = ''
|
||||
StyleHot.LookAndFeel.SkinName = ''
|
||||
ExplicitLeft = 493
|
||||
ExplicitLeft = 615
|
||||
ExplicitTop = 10
|
||||
ExplicitWidth = 218
|
||||
Width = 218
|
||||
end
|
||||
inherited edtRE: TcxDBSpinEdit
|
||||
Left = 493
|
||||
Left = 615
|
||||
Top = 114
|
||||
DataBinding.DataField = ''
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
@ -414,11 +429,11 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
StyleDisabled.LookAndFeel.SkinName = ''
|
||||
StyleFocused.LookAndFeel.SkinName = ''
|
||||
StyleHot.LookAndFeel.SkinName = ''
|
||||
ExplicitLeft = 493
|
||||
ExplicitLeft = 615
|
||||
ExplicitTop = 114
|
||||
end
|
||||
inherited ImporteRE: TcxDBCurrencyEdit
|
||||
Left = 564
|
||||
Left = 686
|
||||
Top = 114
|
||||
DataBinding.DataField = ''
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
@ -426,7 +441,7 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
StyleDisabled.LookAndFeel.SkinName = ''
|
||||
StyleFocused.LookAndFeel.SkinName = ''
|
||||
StyleHot.LookAndFeel.SkinName = ''
|
||||
ExplicitLeft = 564
|
||||
ExplicitLeft = 686
|
||||
ExplicitTop = 114
|
||||
ExplicitWidth = 147
|
||||
Width = 147
|
||||
@ -473,9 +488,9 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
Width = 90
|
||||
end
|
||||
inherited bTiposIVA: TButton
|
||||
Left = 233
|
||||
Left = 355
|
||||
Top = 91
|
||||
ExplicitLeft = 233
|
||||
ExplicitLeft = 355
|
||||
ExplicitTop = 91
|
||||
end
|
||||
inherited cbRecargoEquivalencia: TcxDBCheckBox
|
||||
@ -492,25 +507,25 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
Width = 228
|
||||
end
|
||||
inherited edtRetencion: TcxDBSpinEdit
|
||||
Left = 493
|
||||
Left = 615
|
||||
Top = 188
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
Style.IsFontAssigned = True
|
||||
StyleDisabled.LookAndFeel.SkinName = ''
|
||||
StyleFocused.LookAndFeel.SkinName = ''
|
||||
StyleHot.LookAndFeel.SkinName = ''
|
||||
ExplicitLeft = 493
|
||||
ExplicitLeft = 615
|
||||
ExplicitTop = 188
|
||||
end
|
||||
inherited edtImporteRetencion: TcxDBCurrencyEdit
|
||||
Left = 564
|
||||
Left = 686
|
||||
Top = 188
|
||||
Style.LookAndFeel.SkinName = ''
|
||||
Style.IsFontAssigned = True
|
||||
StyleDisabled.LookAndFeel.SkinName = ''
|
||||
StyleFocused.LookAndFeel.SkinName = ''
|
||||
StyleHot.LookAndFeel.SkinName = ''
|
||||
ExplicitLeft = 564
|
||||
ExplicitLeft = 686
|
||||
ExplicitTop = 188
|
||||
ExplicitWidth = 180
|
||||
Width = 180
|
||||
@ -590,6 +605,12 @@ inherited fEditorRemesaCliente: TfEditorRemesaCliente
|
||||
OnExecute = actNorma19SEPAExecute
|
||||
OnUpdate = actNorma19SEPAUpdate
|
||||
end
|
||||
object actNormal19SEPAXML: TAction
|
||||
Category = 'Acciones'
|
||||
Caption = 'Norma 19 SEPA XML'
|
||||
OnExecute = actNormal19SEPAXMLExecute
|
||||
OnUpdate = actNormal19SEPAXMLUpdate
|
||||
end
|
||||
end
|
||||
inherited SmallImages: TPngImageList [6]
|
||||
PngImages = <
|
||||
|
||||
@ -26,7 +26,6 @@ type
|
||||
frViewRecibosRemesaCliente1: TfrViewRecibosRemesaCliente;
|
||||
actVolcarDisco: TAction;
|
||||
TBXSubmenuItem2: TTBXSubmenuItem;
|
||||
TBXItem7: TTBXItem;
|
||||
TBXSeparatorItem6: TTBXSeparatorItem;
|
||||
actNorma19: TAction;
|
||||
actNorma32: TAction;
|
||||
@ -35,6 +34,13 @@ type
|
||||
TBXItem34: TTBXItem;
|
||||
actNorma19SEPA: TAction;
|
||||
TBXItem35: TTBXItem;
|
||||
TBXItem36: TTBXItem;
|
||||
actNormal19SEPAXML: TAction;
|
||||
TBXSubmenuItem8: TTBXSubmenuItem;
|
||||
TBXItem7: TTBXItem;
|
||||
TBXItem37: TTBXItem;
|
||||
TBXItem38: TTBXItem;
|
||||
TBXItem39: TTBXItem;
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure CustomEditorClose(Sender: TObject; var Action: TCloseAction);
|
||||
|
||||
@ -51,6 +57,8 @@ type
|
||||
procedure actNorma32Update(Sender: TObject);
|
||||
procedure actNorma19SEPAExecute(Sender: TObject);
|
||||
procedure actNorma19SEPAUpdate(Sender: TObject);
|
||||
procedure actNormal19SEPAXMLExecute(Sender: TObject);
|
||||
procedure actNormal19SEPAXMLUpdate(Sender: TObject);
|
||||
private
|
||||
procedure OnRecibosChanged(Sender: TObject);
|
||||
protected
|
||||
@ -357,6 +365,25 @@ begin
|
||||
(Sender as TAction).Enabled := HayDatos and (not FRemesaCliente.EsNuevo);
|
||||
end;
|
||||
|
||||
procedure TfEditorRemesaCliente.actNormal19SEPAXMLExecute(Sender: TObject);
|
||||
var
|
||||
ABancaController : IBancaElectronicaController;
|
||||
begin
|
||||
inherited;
|
||||
ABancaController := TBancaElectronicaController.Create;
|
||||
try
|
||||
ABancaController.GenerarFicheroNorma19SEPAXML(FRemesaCliente.ID);
|
||||
finally
|
||||
ABancaController := NIL;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TfEditorRemesaCliente.actNormal19SEPAXMLUpdate(Sender: TObject);
|
||||
begin
|
||||
inherited;
|
||||
(Sender as TAction).Enabled := HayDatos and (not FRemesaCliente.EsNuevo);
|
||||
end;
|
||||
|
||||
procedure TfEditorRemesaCliente.actVolcarDiscoUpdate(Sender: TObject);
|
||||
begin
|
||||
(Sender as TAction).Enabled := HayDatos and (not FRemesaCliente.EsNuevo);
|
||||
|
||||
Binary file not shown.
@ -14,7 +14,7 @@ BEGIN
|
||||
BEGIN
|
||||
VALUE "FileVersion", "4.4.6.0\0"
|
||||
VALUE "ProductVersion", "4.4.6.0\0"
|
||||
VALUE "CompileDate", "viernes, 06 de noviembre de 2015 11:40\0"
|
||||
VALUE "CompileDate", "lunes, 11 de enero de 2016 17:38\0"
|
||||
END
|
||||
END
|
||||
BLOCK "VarFileInfo"
|
||||
|
||||
Reference in New Issue
Block a user