Uecko/AbetoDesign_FactuGES2
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
8a2e48e40d
AbetoDesign_FactuGES2/Source/Modulos/Banca electronica/Utiles/CVBNorma19CSB.pas

1010 lines
32 KiB
ObjectPascal
Raw Blame History

unit CVBNorma19CSB;
interface
uses
Messages, SysUtils, Classes, Dialogs, CVBUtils;
const
CVBVerNorma19CSB = 'D2 - V 1.0.1';
// primera version 01 de Febrero de 1999
type
TProcedimiento = (prPrimero, prSegundo);
TCVBNorma19CSB = class(TComponent)
private
pReg: array[0..164] of char; // Un digito más por el /0
prProced: TProcedimiento;
HayError: boolean;
FTotOrd: integer;
FTotRem: integer;
FEuro: boolean;
FDepura: boolean;
sPrimerosDigitos: string;
NFic: file;
iTotImpOrdEu: double;
iTotImpOrdPts: integer;
iTotDomOrd: integer;
iTotRegOrd: integer;
iTotImpCinEu: double;
iTotImpCinPts: double;
iTotDomCin: integer;
iTotRegCin: integer;
FEnCasoError: TNotifyEvent;
sReg: string;
_19_, _58_: integer;
{ Private declarations }
protected
procedure ChequearDatos(iParte: integer);
procedure Error(iErr: integer); dynamic;
{ Protected declarations }
public
// Impresion19: Procedure (O: TCVBNorma19CSB; Ordenante,NomCliOrd:String;Importe:String);
(* Intento reutilizar esta norma para generar también la norma 58
Norma = 19 = recibos al cobro
norma = 58 = recibos al descuento
*)
_NORMA_: integer;
NrError: integer;
CRLF: string;
{ El PRESENTADOR (el que físicamente hace la presentación del soporte magnético
a la Entidad de Deposito. Puede ser el mismo Cliente Ordenante, pero no necesariamente
y a su vez ser una persona física o jurídica }
FNomFic: string; // Nombre del archivo en disco
Presentador: string; //9
SufijoPres: string; //3
NomCliPres: string; //40
EntRecepPres: string; //4
OfiRecepPres: string; //4
{ El ordenante (El que emite y en nombre del cual se adeudan las domiciliaciones. Puede ser
una persona física o jurídica}
// el que cobra
Ordenante: string; //9
SufijoOrd: string; //3
NomCliOrd: string; //40
EntOrde: string; //4
OfiOrde: string; //4
DcOrde: string; //2
CcOrde: string; //2
// Datos Generales
FecCargo: TDateTime;
FecSoporte: TDateTime;
TProc: string; //2
// el que paga
Referencia: string; //12
NomTitDom: string; //40
EntTitDom: string; //4
OfiTitDom: string; //4
DcTitDom: string; //2
CcTitDom: string; //10
NomTitCta: string; //40
DomTitCta: string; //40
PlzTitCta: string; //35
CPtTitCta: string; //5
ImportePts: double;
ImporteEu: double;
CodDevol: string; // 6
CodRefInt: string; // 10
CampConc: string; //40
CampConc1: string; //40
CampConc2: string; //40
CampConc3: string; //40
CampConc4: string; //40
CampConc5: string; //40
CampConc6: string; //40
CampConc7: string; //40
CampConc8: string; //40
CampConc9: string; //40
CampConc10: string; //40
CampConc11: string; //40
CampConc12: string; //40
CampConc13: string; //40
CampConc14: string; //40
CampConc15: string; //40
CampConc16: string; //40
constructor Create(AOwner: TComponent); override;
//destructor free;
procedure Abrir;
procedure IniOrdenan;
procedure IniRegistro;
procedure CompCabecera;
procedure CompOrdenante;
procedure CompRegistro;
procedure FinOrdenan;
procedure Cerrar;
property TotOrd: integer Read FTotOrd;
property TotRem: integer Read FTotRem;
{ Public declarations }
published
property NomFichero: string Read FNomFic Write FNomFic;
property Procedimiento: TProcedimiento
Read prProced Write prProced default prPrimero;
property Euros: boolean Read FEuro Write FEuro default False;
property Depura: boolean Read FDepura Write FDepura default False;
property EnCasoError: TNotifyEvent Read FEnCasoError Write FEnCasoError;
{ Published declarations }
end;
procedure Register;
implementation
constructor TCVBNorma19CSB.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{Asignar la propiedades por defecto}
_19_ := 19;
_58_ := 58;
end;
//*******************************************************************************
procedure TCVBNorma19CSB.Abrir;
begin
HayError := False;
AssignFile(NFic, FNomFic);
{$I+}
rewrite(Nfic, 164);
{$I-}
if IOResult <> 0 then
error(0);
iTotImpOrdEu := 0;
iTotImpOrdPts := 0;
iTotDomOrd := 0;
iTotRegOrd := 0;
iTotImpCinEu := 0;
iTotImpCinPts := 0;
iTotDomCin := 0;
iTotRegCin := 0;
IniOrdenan;
IniRegistro;
if CRLF = '' then
CRLF := #13 + #10;
if FEuro = False then
sPrimerosDigitos := '01'
else
sPrimerosDigitos := '51';
end;
procedure TCVBNorma19CSB.IniOrdenan;
begin
iTotImpOrdEu := 0;
iTotImpOrdPts := 0;
iTotDomOrd := 0;
iTotRegOrd := 0;
Ordenante := '';
NomCliOrd := '';
EntOrde := '';
OfiOrde := '';
DcOrde := '';
CcOrde := '';
if _NORMA_ = _19_ then
TProc := '01'
else
if _NORMA_ = _58_ then
TProc := '06';
end;
procedure TCVBNorma19CSB.IniRegistro;
begin
NomTitDom := ''; //40
EntTitDom := ''; //4
OfiTitDom := ''; //4
DcTitDom := ''; //2
CcTitDom := ''; //10
ImportePts := 0;
ImporteEu := 0;
CodDevol := ''; //6
CodRefInt := ''; //10
CampConc1 := ''; //40
CampConc2 := ''; //40
CampConc3 := ''; //40
CampConc4 := ''; //40
CampConc5 := ''; //40
CampConc6 := ''; //40
CampConc7 := ''; //40
CampConc8 := ''; //40
CampConc9 := ''; //40
CampConc10 := ''; //40
CampConc11 := ''; //40
CampConc12 := ''; //40
CampConc13 := ''; //40
CampConc14 := ''; //40
CampConc15 := ''; //40
CampConc16 := ''; //40
NomTitCta := ''; //40
DomTitCta := ''; //40
PlzTitCta := ''; //35
CPtTitCta := ''; //5
end;
procedure TCVBNorma19CSB.CompCabecera;
var
iX: integer;
cT, cIT: string;
begin
HayError := False;
sReg := '';
ChequearDatos(1);
(*
if Presentador='' then Error(1);
if NomCliPres='' then Error(2);
if EntRecepPres='' then Error(4);
if OfiRecepPres='' then Error(5);
*)
if _NORMA_ = _19_ then
sReg := sPrimerosDigitos + '80'
else
if _NORMA_ = _58_ then
sReg := sPrimerosDigitos + '70';
Presentador := AjustaCIF(Presentador);
sReg := sReg + Ajusta(Presentador, 'I', 9, '0'); //9
sReg := sReg + Ajusta(SufijoPres, 'I', 3, '0'); //3
sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecSoporte), 'I', 6, ' '); //6
sReg := sReg + Ajusta('', 'I', 6, ' '); //6
sReg := sReg + Ajusta(NomCliPres, 'D', 40, ' '); //40
sReg := sReg + Ajusta('', 'I', 20, ' '); //20
sReg := sReg + Ajusta(EntRecepPres, 'I', 4, '0'); //4
sReg := sReg + Ajusta(OfiRecepPres, 'I', 4, '0'); //4
sReg := sReg + Ajusta('', 'I', 12, ' '); //12
sReg := sReg + Ajusta('', 'I', 40, ' '); //40
sReg := sReg + Ajusta('', 'I', 14, ' '); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(6);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegCin);
end;
procedure TCVBNorma19CSB.CompOrdenante;
begin
HayError := False;
sReg := '';
ChequearDatos(2);
(*
if Ordenante='' then Error(10);
if NomCliOrd='' then Error(13);
if EntOrde='' then Error(14);
if OfiOrde='' then Error(15);
if CcOrde='' then Error(17);
*)
// Código de Dato
if FEuro = False then
sPrimerosDigitos := '03'
else
sPrimerosDigitos := '53';
if _NORMA_ = _19_ then
sReg := sPrimerosDigitos + '80'
else
if _NORMA_ = _58_ then
sReg := sPrimerosDigitos + '70';
Ordenante := AjustaCIF(Ordenante);
sReg := sReg + Ajusta(Ordenante, 'I', 9, '0'); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecSoporte), 'I', 6, ' '); //6
if _NORMA_ = _19_ then
sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecCargo), 'I', 6, '0') //6
else
if _NORMA_ = _58_ then
sReg := sReg + Ajusta('', 'I', 6, ' '); //6
sReg := sReg + Ajusta(NomCliOrd, 'D', 40, ' '); //40
sReg := sReg + Ajusta(EntOrde, 'I', 4, '0'); //4
sReg := sReg + Ajusta(OfiOrde, 'I', 4, '0'); // 4
sReg := sReg + Ajusta(DcOrde, 'I', 2, '0'); // 2
sReg := sReg + Ajusta(CcOrde, 'I', 10, '0'); // 10
sReg := sReg + Ajusta('', 'I', 8, ' '); // 8
if _NORMA_ = _19_ then
TProc := '01'
else
if _NORMA_ = _58_ then
TProc := '06';
sReg := sReg + Ajusta(TProc, 'I', 2, ' '); // Norma 19="01", norma 58="06" // 2
sReg := sReg + Ajusta('', 'I', 10, ' '); // 10
sReg := sReg + Ajusta('', 'I', 40, ' '); // 40
if _NORMA_ = _58_ then
begin
sReg := sReg + Ajusta('', 'I', 2, ' ');
sReg := sReg + Ajusta('', 'I', 9, ' '); // provincia 9 caracteres
sReg := sReg + Ajusta('', 'I', 3, ' ');
end
else
if _NORMA_ = _19_ then
sReg := sReg + Ajusta('', 'I', 14, ' '); // 14
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(18);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
procedure TCVBNorma19CSB.CompRegistro;
var
sImporteEu, cT, cIT: string;
iP: integer;
begin
HayError := False;
sReg := '';
ChequearDatos(3);
(*
if Referencia='' then Error(21);
if NomTitDom='' then Error(22);
if EntTitDom='' then Error(23);
if OfiTitDom='' then Error(24);
if CcTitDom='' then Error(26);
if (ImportePts=0) and (FEuro=False) then Error(27);
if (ImporteEu=0) and (FEuro=True) then Error(28);
*)
if (prProced = prSegundo) and ((CampConc1 <> '') or
(CampConc2 <> '') or (CampConc3 <> '') or
(CampConc4 <> '') or (CampConc5 <> '') or
(CampConc6 <> '') or (CampConc7 <> '') or
(CampConc8 <> '') or (CampConc9 <> '') or
(CampConc10 <> '') or (CampConc11 <> '') or
(CampConc12 <> '') or (CampConc13 <> '') or
(CampConc14 <> '') or (CampConc15 <> '') or (CampConc16 <> '')) then
Error(210);
if (prProced = prPrimero) and ((NomTitCta <> '') or
(DomTitCta <> '') or (PlzTitCta <> '') or (CPtTitCta <> '')) then
Error(211);
if prProced = prPrimero then
begin
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
if _NORMA_ = _19_ then
sReg := sPrimerosDigitos + '80'
else
if _NORMA_ = _58_ then
sReg := sPrimerosDigitos + '70';
sReg := sReg + Ajusta(Ordenante, 'I', 9, '0'); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, '0'); //12
sReg := sReg + Ajusta(NomTitDom, 'D', 40, ' '); //40
sReg := sReg + Ajusta(EntTitDom, 'I', 4, '0'); //4
sReg := sReg + Ajusta(OfiTitDom, 'I', 4, '0'); //4
sReg := sReg + Ajusta(DcTitDom, 'I', 2, '0'); // Creo que es:** //2
sReg := sReg + Ajusta(CcTitDom, 'I', 10, '0'); //10
cT := EntTitDom + OfiTitDom + DcTitDom + CcTitDom;
if pos('0000000000', cT) > 0 then
if not (_NORMA_ = _58_) then
ChequearDatos(4);
if FEuro = False then {float}
begin
cIT := FormatFloat('0000000000', ImportePts);
// sReg := sReg + Ajusta (IntToStr(ImportePts),'I',10,'0') //10
sReg := sReg + Ajusta(cIT, 'I', 10, '0'); //10
end
else
begin
(* Creo que en Euros deben de ir los 2 decimales siempre, pero
no debe salir el punto decimal. O sea, los 2 últimos dígitos son
siempre los decimales. Repito: Creo.
*)
Str(ImporteEu: 10: 2, sImporteEu);
iP := pos(',', sImporteEu);
if iP < 1 then
iP := pos('.', sImporteEu);
cT := copy(sImporteEu, 1, iP - 1);
sImporteEu := cT + copy(sImporteEu, iP + 1, 2);
sReg := sReg + Ajusta(sImporteEu, 'I', 10, '0'); //10
end;
sReg := sReg + Ajusta(CodDevol, 'D', 6, ' '); //6
sReg := sReg + Ajusta(CodRefInt, 'D', 10, ' '); //10
sReg := sReg + Ajusta(CampConc1, 'D', 40, ' '); //40
if _NORMA_ = _58_ then
sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecCargo), 'D', 8, ' ')
else
if _NORMA_ = _19_ then
sReg := sReg + Ajusta('', 'I', 8, ' '); // 8
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(200);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
Inc(iTotDomOrd); ///////////////-----------------
Inc(iTotDomCin); ///////////////-----------------
iTotImpOrdPts := iTotImpOrdPts + StrToInt(cIT); //ImportePts;
iTotImpCinPts := iTotImpCinPts + ImportePts;
iTotImpOrdEu := iTotImpOrdEu + ImporteEu;
iTotImpCinEu := iTotImpCinEu + ImporteEu;
if (CampConc2 <> '') or (CampConc3 <> '') or (CampConc4 <> '') then
begin
sReg := '';
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
sReg := sPrimerosDigitos + '81';
sReg := sReg + Ajusta(Ordenante, 'I', 9, ' '); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, ' '); //12
sReg := sReg + Ajusta(CampConc2, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc3, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc4, 'D', 40, ' '); //40
sReg := sReg + Ajusta('', 'I', 14, ' '); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(201);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
if (CampConc5 <> '') or (CampConc6 <> '') or (CampConc7 <> '') then
begin
sReg := '';
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
sReg := sPrimerosDigitos + '82';
sReg := sReg + Ajusta(Ordenante, 'I', 9, ' '); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, ' '); //12
sReg := sReg + Ajusta(CampConc5, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc6, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc7, 'D', 40, ' '); //40
sReg := sReg + Ajusta('', 'I', 14, ' '); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(202);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
if (CampConc8 <> '') or (CampConc9 <> '') or (CampConc10 <> '') then
begin
sReg := '';
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
sReg := sPrimerosDigitos + '83';
sReg := sReg + Ajusta(Ordenante, 'I', 9, ' '); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, ' '); //12
sReg := sReg + Ajusta(CampConc8, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc9, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc10, 'D', 40, ' '); //40
sReg := sReg + Ajusta('', 'I', 14, ' '); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(203);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
if (CampConc11 <> '') or (CampConc12 <> '') or (CampConc13 <> '') then
begin
sReg := '';
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
sReg := sPrimerosDigitos + '84';
sReg := sReg + Ajusta(Ordenante, 'I', 9, ' '); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, ' '); //12
sReg := sReg + Ajusta(CampConc11, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc12, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc13, 'D', 40, ' '); //40
sReg := sReg + Ajusta('', 'I', 14, ' '); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(204);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
if (CampConc14 <> '') or (CampConc15 <> '') or (CampConc16 <> '') then
begin
sReg := '';
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
sReg := sPrimerosDigitos + '85';
sReg := sReg + Ajusta(Ordenante, 'I', 9, ' '); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, ' '); //12
sReg := sReg + Ajusta(CampConc14, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc15, 'D', 40, ' '); //40
sReg := sReg + Ajusta(CampConc16, 'D', 40, ' '); //40
sReg := sReg + Ajusta('', 'I', 14, ' '); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(205);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
if (NomTitCta <> '') or (DomTitCta <> '') or (PlzTitCta <> '') or (CPtTitCta <> '') then
begin
sReg := '';
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
sReg := sPrimerosDigitos + '86';
sReg := sReg + Ajusta(Ordenante, 'I', 9, ' '); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, ' '); //12
sReg := sReg + Ajusta(NomTitCta, 'D', 40, ' '); //40
sReg := sReg + Ajusta(DomTitCta, 'D', 40, ' '); //40
sReg := sReg + Ajusta(PlzTitCta, 'D', 35, ' '); //35
sReg := sReg + Ajusta(CPtTitCta, 'D', 5, ' '); //5
sReg := sReg + Ajusta('', 'I', 14, ' '); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(206);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
end;
if prProced = prSegundo then
begin
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
sReg := sPrimerosDigitos + '80';
sReg := sReg + Ajusta(Ordenante, 'I', 9, ' '); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, ' '); //12
sReg := sReg + Ajusta(NomTitDom, 'D', 40, ' '); //40
sReg := sReg + Ajusta(EntTitDom, 'I', 4, '0'); //4
sReg := sReg + Ajusta(OfiTitDom, 'I', 4, '0'); //4
sReg := sReg + Ajusta(DcTitDom, 'I', 2, '0'); //2
sReg := sReg + Ajusta(CcTitDom, 'I', 10, '0'); //10
if FEuro = False then {float}
begin
cIT := FormatFloat('0000000000', ImportePts);
// sReg := sReg + Ajusta (IntToStr(ImportePts),'I',10,'0') //10
sReg := sReg + Ajusta(cIT, 'I', 10, '0'); //10
end
else
begin
(* Creo que en Euros deben de ir los 2 decimales siempre, pero
no debe salir el punto decimal. O sea, los 2 últimos dígitos son
siempre los decimales. Repito: Creo.
*)
Str(ImporteEu: 10: 2, sImporteEu);
iP := pos(',', sImporteEu);
if iP < 1 then
iP := pos('.', sImporteEu);
cT := copy(sImporteEu, 1, iP - 1);
sImporteEu := cT + copy(sImporteEu, iP + 1, 2);
sReg := sReg + Ajusta(sImporteEu, 'I', 10, '0'); //10
end;
sReg := sReg + Ajusta(CodDevol, 'D', 6, ' '); //6
sReg := sReg + Ajusta(CodRefInt, 'D', 10, ' '); //10
sReg := sReg + Ajusta(CampConc, 'D', 17, ' '); //17
sReg := sReg + Ajusta('', 'I', 23, ' '); //23
sReg := sReg + Ajusta('', 'I', 8, ' '); //8
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(207);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
iTotImpOrdPts := iTotImpOrdPts + StrToInt(cIT); //ImportePts;
iTotImpCinPts := iTotImpCinPts + ImportePts;
iTotImpOrdEu := iTotImpOrdEu + ImporteEu;
iTotImpCinEu := iTotImpCinEu + ImporteEu;
if (NomTitCta <> '') or (DomTitCta <> '') or (PlzTitCta <> '') or (CPtTitCta <> '') then
begin
sReg := '';
if NomTitCta = '' then
error(210);
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
sReg := sPrimerosDigitos + '86';
sReg := sReg + Ajusta(Ordenante, 'I', 9, ' '); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, ' '); //12
sReg := sReg + Ajusta(NomTitCta, 'D', 40, ' '); //40
sReg := sReg + Ajusta(DomTitCta, 'D', 40, ' '); //40
sReg := sReg + Ajusta(PlzTitCta, 'D', 35, ' '); //35
sReg := sReg + Ajusta(CPtTitCta, 'D', 5, ' '); //5
sReg := sReg + Ajusta('', 'I', 14, ' '); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(208);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
end;
IniRegistro;
end;
procedure TCVBNorma19CSB.FinOrdenan;
var
sTotImpOrdEu, cT: string;
iP: integer;
begin
HayError := False;
sReg := '';
Inc(iTotRegOrd);
Inc(iTotRegCin);
if FEuro = False then
sPrimerosDigitos := '08' // Ptas
else
sPrimerosDigitos := '58'; // Euros
if _NORMA_ = _19_ then
sReg := sPrimerosDigitos + '80' // Norma 19 / Norma 58=70
else
if _NORMA_ = _58_ then
sReg := sPrimerosDigitos + '70';
Ordenante := AjustaCif(Ordenante);
sReg := sReg + Ajusta(Ordenante, 'I', 9, '0'); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, '0'); //3
sReg := sReg + Ajusta('', 'D', 12, ' '); //12
sReg := sReg + Ajusta('', 'D', 40, ' '); //40
sReg := sReg + Ajusta('', 'D', 20, ' '); //20
if FEuro = False then {float}
sReg := sReg + Ajusta(IntToStr(iTotImpOrdPts), 'I', 10, '0') //10
else
begin
(* Creo que en Euros deben de ir los 2 decimales siempre, pero
no debe salir el punto decimal. O sea, los 2 últimos dígitos son
siempre los decimales. Repito: Creo.
*)
Str(iTotImpOrdEu: 10: 2, sTotImpOrdEu);
iP := pos(',', sTotImpOrdEu);
if iP < 1 then
iP := pos('.', sTotImpOrdEu);
cT := copy(sTotImpOrdEu, 1, iP - 1);
sTotImpOrdEu := cT + copy(sTotImpOrdEu, iP + 1, 2);
sReg := sReg + Ajusta(sTotImpOrdEu, 'I', 10, '0'); //10
end;
sReg := sReg + Ajusta('', 'D', 6, ' '); //6
sReg := sReg + Ajusta(IntToStr(iTotDomOrd), 'I', 10, '0'); //10
sReg := sReg + Ajusta(IntToStr(iTotRegOrd), 'I', 10, '0'); //10
sReg := sReg + Ajusta('', 'I', 20, ' '); //20
sReg := sReg + Ajusta('', 'I', 18, ' '); //18
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(30);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
(*
if Assigned (Impresion19) then
if FEuro=False
then Impresion19 (Self,Ordenante,NomCliOrd,IntToStr(iTotImpOrdPts))
else Impresion19 (Self,Ordenante,NomCliOrd,sTotImpOrdEu);
*)
IniOrdenan;
end;
procedure TCVBNorma19CSB.Cerrar;
var
sTotImpCinEu, cT, cIT: string;
iP: integer;
begin
HayError := False;
sReg := '';
Inc(iTotRegCin);
if FEuro = False then
sPrimerosDigitos := '09'
else
sPrimerosDigitos := '59';
if _NORMA_ = _19_ then
sReg := sPrimerosDigitos + '80' // 70 en norma 58
else
if _NORMA_ = _58_ then
sReg := sPrimerosDigitos + '70';
Presentador := AjustaCIF(Presentador);
sReg := sReg + Ajusta(Presentador, 'I', 9, '0'); //9
sReg := sReg + Ajusta(SufijoPres, 'I', 3, '0'); //3
sReg := sReg + Ajusta('', 'D', 12, ' '); //12
sReg := sReg + Ajusta('', 'D', 40, ' '); //40
sReg := sReg + Ajusta('1', 'I', 4, '0');
// Ordenantes. En este programa será siempre = 1 // 4
sReg := sReg + Ajusta('', 'D', 16, ' '); //16
if FEuro = False then {float}
begin
cIT := FormatFloat('0000000000', iTotImpCinPts);
// sReg := sReg + Ajusta (intToStr(iTotImpCinPts),'I',10,'0') //10
sReg := sReg + Ajusta(cIT, 'I', 10, '0'); //10
end
else
begin
(* Creo que en Euros deben de ir los 2 decimales siempre, pero
no debe salir el punto decimal. O sea, los 2 últimos dígitos son
siempre los decimales. Repito: Creo. No tengo aquí las normas actualizadas para el euro.
*)
Str(iTotImpCinEu: 10: 2, sTotImpCinEu);
iP := pos(',', sTotImpCinEu);
if iP < 1 then
iP := pos('.', sTotImpCinEu);
cT := copy(sTotImpCinEu, 1, iP - 1);
sTotImpCinEu := cT + copy(sTotImpCinEu, iP + 1, 2);
sReg := sReg + Ajusta(sTotImpCinEu, 'I', 10, '0'); //10
end;
sReg := sReg + Ajusta('', 'I', 6, ' '); //6
sReg := sReg + Ajusta(IntToStr(iTotDomCin), 'I', 10, '0'); //10
sReg := sReg + Ajusta(IntToStr(iTotRegCin), 'I', 10, '0'); //10
sReg := sReg + Ajusta('', 'D', 20, ' '); //20
sReg := sReg + Ajusta('', 'D', 18, ' '); //18
sReg := sReg + CRLF; //2
if not (length(sReg) = 164) then
Error(40);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
CloseFile(NFic);
end;
procedure TCVBNorma19CSB.Error(iErr: integer);
begin
NrError := iErr;
HayError := True;
if Assigned(FEnCasoError) then
FEnCasoError(Self)
else
if FDepura = False then
begin
CloseFile(NFic);
raise Exception.Create('Error en la generación del fichero');
end;
end;
procedure TCVBNorma19CSB.ChequearDatos(iParte: integer);
var
bError: boolean;
begin
bError := False;
if iParte = 1 then
begin
if ((Presentador = '') or (NomCliPres = '') or
(EntRecepPres = '') or (OfiRecepPres = '')) then
begin
if Presentador = '' then
Presentador := '<--';
if NomCliPres = '' then
NomCliPres := '<--';
if EntRecepPres = '' then
EntRecepPres := '<--';
if OfiRecepPres = '' then
OfiRecepPres := '<--';
bError := True;
end;
end
else
if iParte = 2 then
begin
if ((Ordenante = '') or (NomCliOrd = '') or
(EntOrde = '') or (OfiOrde = '') or
(CcOrde = '')) then
begin
if Ordenante = '' then
Ordenante := '<--';
if NomCliOrd = '' then
NomCliOrd := '<--';
if EntOrde = '' then
EntOrde := '<--';
if OfiOrde = '' then
OfiOrde := '<--';
if CcOrde = '' then
CcOrde := '<--';
bError := True;
end;
end
else
if (iParte = 3) or (iParte = 4) then
begin
if ((Referencia = '') or (NomTitDom = '') or
(EntTitDom = '') or (OfiTitDom = '') or
(ccTitDom = '')) then
begin
if Referencia = '' then
Referencia := '<--';
if NomTitDom = '' then
NomTitDom := '<--';
if EntTitDom = '' then
EntTitDom := '<--';
if OfiTitDom = '' then
OfiTitDom := '<--';
if ccTitDom = '' then
ccTitDom := '<--';
bError := True;
end;
end;
if bError then
ShowMessage('' + CRLF +
'Faltan datos al procesar el siguiente registro: ' + CRLF + CRLF +
'Código Cli/Pro: ' + Referencia + CRLF +
'Nombre Titular: ' + NomTitDom + CRLF +
'Entidad Domiciliar: ' + EntTitDom + CRLF +
'Oficina Domiciliar: ' + OfiTitDom + CRLF +
'Cuenta Domiciliar: ' + ccTitDom + CRLF +
'Presentador: ' + Presentador + CRLF +
'Nombre Cliente Pres:' + NomCliPres + CRLF +
'Entidad Receptora P:' + EntRecepPres + CRLF +
'Oficina Receptora P:' + OfiRecepPres + CRLF +
'Ordenante: ' + Ordenante + CRLF +
'Nombre Cliente Ord.:' + NomCliOrd + CRLF +
'Entidad Ordenante: ' + EntOrde + CRLF +
'Oficina Ordenante: ' + OfiOrde + CRLF +
'Cuenta Ordenante: ' + CcOrde
);
if iParte = 3 then
begin
if bError then
begin
if ((ImportePts = 0) and (FEuro = False)) or
((ImporteEu = 0) and (FEuro = True)) then
begin
ShowMessage('¡¡¡ El importe no puede ser cero !!!');
Error(27);
end;
end;
end;
end;
procedure Register;
begin
RegisterComponents('CVB', [TCVBNORMA19CSB]);
end;
end.
Reference in New Issue View Git Blame Copy Permalink