david
e293699abf
git-svn-id: https://192.168.0.254/svn/Proyectos.LuisLeon_FactuGES2/trunk@246 b2cfbe5a-eba1-4a0c-8b32-7feea0a119f2
880 lines
32 KiB
ObjectPascal
880 lines
32 KiB
ObjectPascal
//
|
|
// 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
|
|
fGrpHdrInitgPtyId: String; // group header: initiator id
|
|
fPmtInf: array of TDirectDebitPaymentInformation;
|
|
|
|
function GetSchema: String;
|
|
procedure SetGrpHdrInitgPtyName(const str: String);
|
|
procedure SetGrpHdrInitgPtyId(const Value: 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;
|
|
|
|
property GrpHdrInitgPtyId: String read fGrpHdrInitgPtyId write SetGrpHdrInitgPtyId;
|
|
|
|
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, '<BtchBookg>false</BtchBookg>');
|
|
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.SetGrpHdrInitgPtyId(const Value: String);
|
|
begin
|
|
fGrpHdrInitgPtyId := SEPACleanString(Value);
|
|
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, '<Document'+
|
|
' xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"'+
|
|
' xmlns="urn:iso:std:iso:20022:tech:xsd:'+Schema+'">');
|
|
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>');
|
|
SEPAWriteLine(stream, '<Nm>'+SEPACleanString(GrpHdrInitgPtyName, INITG_PTY_NAME_MAX_LEN)+'</Nm>');
|
|
SEPAWriteLine(stream, '<Id><PrvtId><Othr><Id>');
|
|
SEPAWriteLine(stream, fGrpHdrInitgPtyId);
|
|
SEPAWriteLine(stream, '</Id></Othr></PrvtId></Id>');
|
|
SEPAWriteLine(stream, '</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.
|