AcotaCocinas/AlonsoYSal_FactuGES2
2
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
master
AlonsoYSal_FactuGES2/Source/Modulos/Banca electronica/Utiles/CVBNorma1958CSB.pas
roberto 6a0c10c5e6 subida inicial 
git-svn-id: https://192.168.0.254/svn/Proyectos.AlonsoYSal_FactuGES2/trunk@6 40301925-124e-1c4e-b97d-170ad7a8785b
2019-11-18 10:36:42 +00:00

1075 lines
33 KiB
ObjectPascal
Raw Permalink Blame History

// Modificado sobre la base de: CVBNorma19CSB
// Unificadas ambas normas ( 19 y 58 )
unit CVBNorma1958CSB;
interface
uses
Messages, SysUtils, Classes, Dialogs, CVBUtils;
type
TProcedimiento = (prPrimero, prSegundo);
TCVBNorma1958CSB = class(TComponent)
private
pReg: array[0..164] of char; // Un digito más por el /0
_LL_: integer; // Longitud Línea. Aquí almacenamos el valor 164 para usarlo
// en el resto del componente.
_INDICA_: string;
_CERO_, _SPCE_: char;
_MSK_PT_, _MSK_EU_: string;
prProced: TProcedimiento;
HayError: boolean;
iTotOrd: integer;
iTotRem: integer;
FEuro: boolean;
FDepura: boolean;
sPrimerosDigitos: string;
NFic: file;
fTotImpOrdEu: double;
iTotImpOrdPts: integer;
iTotDomOrd: integer;
iTotRegOrd: integer;
fTotImpCinEu: double;
iTotImpCinPts: integer;
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
(* 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
LocalidadOrd: string; // 38
CodLocalOrd: string; // 2
FecOrigFormCred: TDateTime; // 6
// Datos Generales
// FecSoporte: TDateTime; // En pantalla pone 'Fecha'. Fecha creación remesa
FecCargo: TDateTime; // En pantalla pone 'Fecha entrega'
FecAbono: TDateTime;
// En pantalla pone 'Fecha abono'. Fecha para cobrarlos
FecVcto: 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
fImportePts: double;
fImporteEu: 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 iTotOrd;
property TotRem: integer Read iTotRem;
{ 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 TCVBNorma1958CSB.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
{Asignar la propiedades por defecto}
_19_ := 19;
_58_ := 58;
_LL_ := high(pReg);
_INDICA_ := '<--';
_CERO_ := '0';
_SPCE_ := ' ';
_MSK_PT_ := '0000000000';
_MSK_EU_ := '00000000.00';
end;
//*******************************************************************************
procedure TCVBNorma1958CSB.Abrir;
begin
HayError := False;
AssignFile(NFic, FNomFic);
{$I+}
rewrite(Nfic, _LL_);
{$I-}
if IOResult <> 0 then
error(0);
fTotImpOrdEu := 0;
iTotImpOrdPts := 0;
iTotDomOrd := 0;
iTotRegOrd := 0;
fTotImpCinEu := 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 TCVBNorma1958CSB.IniOrdenan;
begin
fTotImpOrdEu := 0;
iTotImpOrdPts := 0;
iTotDomOrd := 0;
iTotRegOrd := 0;
Ordenante := '';
NomCliOrd := '';
EntOrde := '';
OfiOrde := '';
DcOrde := '';
CcOrde := '';
LocalidadOrd := '';
CodLocalOrd := '';
if _NORMA_ = _19_ then
TProc := '01'
else
if _NORMA_ = _58_ then
TProc := '06';
end;
procedure TCVBNorma1958CSB.IniRegistro;
begin
NomTitDom := ''; //40
EntTitDom := ''; //4
OfiTitDom := ''; //4
DcTitDom := ''; //2
CcTitDom := ''; //10
fImportePts := 0;
fImporteEu := 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 TCVBNorma1958CSB.CompCabecera;
var
cT, cIT: string;
begin
HayError := False;
sReg := '';
ChequearDatos(1);
(*
Presentador
NomCliPres
EntRecepPres
OfiRecepPres
*)
if _NORMA_ = _19_ then
sReg := sPrimerosDigitos + '80'
else
if _NORMA_ = _58_ then
sReg := sPrimerosDigitos + '70';
Presentador := AjustaCIF(Presentador);
sReg := sReg + Ajusta(Presentador, 'I', 9, _CERO_); //9
sReg := sReg + Ajusta(SufijoPres, 'I', 3, _CERO_); //3
// if FecSoporte = 0 then
// FecSoporte := now;
sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecCargo), 'I', 6, _SPCE_); //6
sReg := sReg + Ajusta('', 'I', 6, _SPCE_); //6
sReg := sReg + Ajusta(NomCliPres, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta('', 'I', 20, _SPCE_); //20
sReg := sReg + Ajusta(EntRecepPres, 'I', 4, _CERO_); //4
sReg := sReg + Ajusta(OfiRecepPres, 'I', 4, _CERO_); //4
sReg := sReg + Ajusta('', 'I', 12, _SPCE_); //12
sReg := sReg + Ajusta('', 'I', 40, _SPCE_); //40
sReg := sReg + Ajusta('', 'I', 14, _SPCE_); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegCin);
end;
procedure TCVBNorma1958CSB.CompOrdenante;
var
cT: string;
begin
HayError := False;
sReg := '';
ChequearDatos(2);
(*
Ordenante
NomCliOrd
EntOrde
OfiOrde
CcOrde
*)
// 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, _CERO_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
if FecCargo = 0 then
FecCargo := now; // Fecha entrega soporte
if FecAbono = 0 then
FecAbono := now; // Fecha para cobrar
sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecCargo), 'I', 6, _CERO_); // 6
if _NORMA_ = _19_ then
sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecAbono), 'I', 6, _CERO_) //6
else
if _NORMA_ = _58_ then
sReg := sReg + Ajusta('', 'I', 6, _SPCE_); //6
sReg := sReg + Ajusta(NomCliOrd, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(EntOrde, 'I', 4, _CERO_); //4
sReg := sReg + Ajusta(OfiOrde, 'I', 4, _CERO_); // 4
sReg := sReg + Ajusta(DcOrde, 'I', 2, _CERO_); // 2
sReg := sReg + Ajusta(CcOrde, 'I', 10, _CERO_); // 10
sReg := sReg + Ajusta('', 'I', 8, _SPCE_); // 8
if _NORMA_ = _19_ then
TProc := '01'
else
if _NORMA_ = _58_ then
TProc := '06';
sReg := sReg + Ajusta(TProc, 'I', 2, _SPCE_);
// Norma 19="01", norma 58="06" // 2
sReg := sReg + Ajusta('', 'I', 10, _SPCE_); // 10
sReg := sReg + Ajusta('', 'I', 40, _SPCE_); // 40
if _NORMA_ = _58_ then
begin
sReg := sReg + Ajusta('', 'I', 2, _SPCE_);
sReg := sReg + Ajusta('', 'I', 9, _SPCE_); // provincia 9 caracteres
sReg := sReg + Ajusta('', 'I', 3, _SPCE_);
end
else
if _NORMA_ = _19_ then
sReg := sReg + Ajusta('', 'I', 14, _SPCE_); // 14
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
procedure TCVBNorma1958CSB.CompRegistro;
var
sImporteEu, cT, cIT: string;
iP: integer;
bTieneCuentaBanco: boolean;
begin
HayError := False;
sReg := '';
bTieneCuentaBanco := True;
ChequearDatos(3);
(*
Referencia
NomTitDom
EntTitDom
OfiTitDom
CcTitDom
(fImportePts=0) and (FEuro=False)
(fImporteEu=0) and (FEuro=True)
*)
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';
ChequearDatos(4);
cT := EntTitDom + OfiTitDom + DcTitDom + CcTitDom;
if pos(_INDICA_, cT) > 0 then
begin
bTieneCuentaBanco := False;
EntTitDom := ''; // Si no va domiciliado, entonces debe ir todo a blanco.
OfiTitDom := '';
DcTitDom := '';
CcTitDom := '';
end;
sReg := sReg + Ajusta(Ordenante, 'I', 9, _CERO_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, _CERO_); //12
sReg := sReg + Ajusta(NomTitDom, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(EntTitDom, 'I', 4, _CERO_); //4
sReg := sReg + Ajusta(OfiTitDom, 'I', 4, _CERO_); //4
sReg := sReg + Ajusta(DcTitDom, 'I', 2, _CERO_);
// Creo que es:** //2
sReg := sReg + Ajusta(CcTitDom, 'I', 10, _CERO_); //10
if FEuro = False then
begin
cIT := FormatFloat(_MSK_PT_, fImportePts);
sReg := sReg + Ajusta(cIT, 'I', 10, _CERO_); //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.
*)
sImporteEu := FormatFloat(_MSK_EU_, fImporteEu);
iP := pos(',', sImporteEu);
if iP < 1 then
iP := pos('.', sImporteEu);
cIT := copy(sImporteEu, 1, iP - 1);
sImporteEu := cIT + copy(sImporteEu, iP + 1, 2);
sReg := sReg + Ajusta(sImporteEu, 'I', 10, _CERO_); //10
end;
sReg := sReg + Ajusta(CodDevol, 'I', 6, _SPCE_); //6
sReg := sReg + Ajusta(CodRefInt, 'I', 10, _SPCE_); //10
sReg := sReg + Ajusta(CampConc1, 'D', 40, _SPCE_); //40
if _NORMA_ = _58_ then
sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecVcto), 'D', 8, _SPCE_)
else
if _NORMA_ = _19_ then
sReg := sReg + Ajusta('', 'I', 8, _SPCE_); // 8
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd); // Registros Ordenantes
Inc(iTotRegCin); // Registros Disco
Inc(iTotDomOrd); // Recibos Ordenante
Inc(iTotDomCin); // Recibos Disco
if FEuro = False then
begin
iTotImpOrdPts := iTotImpOrdPts + StrToInt(cIT); //fImportePts;
iTotImpCinPts := iTotImpCinPts + StrToInt(FloatToStr(fImportePts));
end
else
begin
fTotImpOrdEu := fTotImpOrdEu + fImporteEu;
fTotImpCinEu := fTotImpCinEu + fImporteEu;
end;
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, _SPCE_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, _SPCE_); //12
sReg := sReg + Ajusta(CampConc2, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc3, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc4, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta('', 'I', 14, _SPCE_); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
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, _SPCE_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, _SPCE_); //12
sReg := sReg + Ajusta(CampConc5, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc6, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc7, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta('', 'I', 14, _SPCE_); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
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, _SPCE_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, _SPCE_); //12
sReg := sReg + Ajusta(CampConc8, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc9, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc10, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta('', 'I', 14, _SPCE_); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
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, _SPCE_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, _SPCE_); //12
sReg := sReg + Ajusta(CampConc11, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc12, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc13, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta('', 'I', 14, _SPCE_); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
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, _SPCE_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, _SPCE_); //12
sReg := sReg + Ajusta(CampConc14, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc15, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(CampConc16, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta('', 'I', 14, _SPCE_); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
if (_NORMA_ = _58_) and (bTieneCuentaBanco = False) then
begin
// if (NomTitCta<>'') or (DomTitCta<>'') or (PlzTitCta<>'') or (CPtTitCta<>'') then
begin
sReg := '';
if FEuro = False then
sPrimerosDigitos := '06' // Ptas
else
sPrimerosDigitos := '56'; // Euros
sReg := sPrimerosDigitos + '76';
sReg := sReg + Ajusta(Ordenante, 'I', 9, _SPCE_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, _CERO_); //12
sReg := sReg + Ajusta(DomTitCta, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(PlzTitCta, 'D', 35, _SPCE_); //35
sReg := sReg + Ajusta(CPtTitCta, 'D', 5, _SPCE_); //5
sReg := sReg + Ajusta(LocalidadOrd, 'D', 38, _SPCE_); // 38
sReg := sReg + Ajusta(CodLocalOrd, 'I', 2, _CERO_); // 2
sReg := sReg +
Ajusta(FormatDateTime('ddmmyy', FecOrigFormCred), 'I', 6, _SPCE_);
sReg := sReg + Ajusta('', 'I', 8, _SPCE_); // 8
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
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, _SPCE_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, _SPCE_); //12
sReg := sReg + Ajusta(NomTitDom, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(EntTitDom, 'I', 4, _CERO_); //4
sReg := sReg + Ajusta(OfiTitDom, 'I', 4, _CERO_); //4
sReg := sReg + Ajusta(DcTitDom, 'I', 2, _CERO_); //2
sReg := sReg + Ajusta(CcTitDom, 'I', 10, _CERO_); //10
if FEuro = False then
begin
cIT := FormatFloat(_MSK_PT_, fImportePts);
sReg := sReg + Ajusta(cIT, 'I', 10, _CERO_); //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.
*)
sImporteEu := FormatFloat(_MSK_EU_, fImporteEu);
iP := pos(',', sImporteEu);
if iP < 1 then
iP := pos('.', sImporteEu);
cIT := copy(sImporteEu, 1, iP - 1);
sImporteEu := cIT + copy(sImporteEu, iP + 1, 2);
sReg := sReg + Ajusta(sImporteEu, 'I', 10, _CERO_); //10
end;
sReg := sReg + Ajusta(CodDevol, 'D', 6, _SPCE_); //6
sReg := sReg + Ajusta(CodRefInt, 'D', 10, _SPCE_); //10
sReg := sReg + Ajusta(CampConc, 'D', 17, _SPCE_); //17
sReg := sReg + Ajusta('', 'I', 23, _SPCE_); //23
sReg := sReg + Ajusta('', 'I', 8, _SPCE_); //8
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
if FEuro = False then
begin
iTotImpOrdPts := iTotImpOrdPts + StrToInt(cIT); //fImportePts;
iTotImpCinPts := iTotImpCinPts + StrToInt(FloaTtoStr(fImportePts));
end
else
begin
fTotImpOrdEu := fTotImpOrdEu + fImporteEu;
fTotImpCinEu := fTotImpCinEu + fImporteEu;
end;
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, _SPCE_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta(Referencia, 'D', 12, _SPCE_); //12
sReg := sReg + Ajusta(NomTitCta, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(DomTitCta, 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta(PlzTitCta, 'D', 35, _SPCE_); //35
sReg := sReg + Ajusta(CPtTitCta, 'D', 5, _SPCE_); //5
sReg := sReg + Ajusta('', 'I', 14, _SPCE_); //14
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
Inc(iTotRegOrd);
Inc(iTotRegCin);
end;
end;
IniRegistro;
end;
procedure TCVBNorma1958CSB.FinOrdenan;
var
sTotImpOrdEu, cT, cIT: 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, _CERO_); //9
sReg := sReg + Ajusta(SufijoOrd, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta('', 'D', 12, _SPCE_); //12
sReg := sReg + Ajusta('', 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta('', 'D', 20, _SPCE_); //20
if FEuro = False then {float}
sReg := sReg + Ajusta(IntToStr(iTotImpOrdPts), 'I', 10, _CERO_) //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.
*)
sTotImpOrdEu := FormatFloat(_MSK_EU_, fTotImpOrdEu);
iP := pos(',', sTotImpOrdEu);
if iP < 1 then
iP := pos('.', sTotImpOrdEu);
cIT := copy(sTotImpOrdEu, 1, iP - 1);
sTotImpOrdEu := cIT + copy(sTotImpOrdEu, iP + 1, 2);
sReg := sReg + Ajusta(sTotImpOrdEu, 'I', 10, _CERO_); //10
end;
sReg := sReg + Ajusta('', 'D', 6, _SPCE_); //6
sReg := sReg + Ajusta(IntToStr(iTotDomOrd), 'I', 10, _CERO_); //10
sReg := sReg + Ajusta(IntToStr(iTotRegOrd), 'I', 10, _CERO_); //10
sReg := sReg + Ajusta('', 'I', 20, _SPCE_); //20
sReg := sReg + Ajusta('', 'I', 18, _SPCE_); //18
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
IniOrdenan;
end;
procedure TCVBNorma1958CSB.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, _CERO_); //9
sReg := sReg + Ajusta(SufijoPres, 'I', 3, _CERO_); //3
sReg := sReg + Ajusta('', 'D', 12, _SPCE_); //12
sReg := sReg + Ajusta('', 'D', 40, _SPCE_); //40
sReg := sReg + Ajusta('1', 'I', 4, _CERO_);
// Ordenantes. En este programa será siempre = 1 // 4
sReg := sReg + Ajusta('', 'D', 16, _SPCE_); //16
if FEuro = False then
begin
cIT := FormatFloat(_MSK_PT_, iTotImpCinPts);
sReg := sReg + Ajusta(cIT, 'I', 10, _CERO_); //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.
*)
sTotImpCinEu := FormatFloat(_MSK_EU_, fTotImpCinEu);
iP := pos(',', sTotImpCinEu);
if iP < 1 then
iP := pos('.', sTotImpCinEu);
cIT := copy(sTotImpCinEu, 1, iP - 1);
sTotImpCinEu := cIT + copy(sTotImpCinEu, iP + 1, 2);
sReg := sReg + Ajusta(sTotImpCinEu, 'I', 10, _CERO_); //10
end;
sReg := sReg + Ajusta('', 'I', 6, _SPCE_); //6
sReg := sReg + Ajusta(IntToStr(iTotDomCin), 'I', 10, _CERO_); //10
sReg := sReg + Ajusta(IntToStr(iTotRegCin), 'I', 10, _CERO_); //10
sReg := sReg + Ajusta('', 'D', 20, _SPCE_); //20
sReg := sReg + Ajusta('', 'D', 18, _SPCE_); //18
sReg := sReg + CRLF; //2
if not (length(sReg) = _LL_) then
Error(_LL_);
StrPCopy(@pReg, sReg);
BlockWrite(NFic, pReg, 1);
CloseFile(NFic);
end;
procedure TCVBNorma1958CSB.Error(iErr: integer);
begin
NrError := iErr;
HayError := True;
if Assigned(FEnCasoError) then
FEnCasoError(Self)
else
if FDepura = False then
begin
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;
procedure TCVBNorma1958CSB.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 := _INDICA_;
if NomCliPres = '' then
NomCliPres := _INDICA_;
if EntRecepPres = '' then
EntRecepPres := _INDICA_;
if OfiRecepPres = '' then
OfiRecepPres := _INDICA_;
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 := _INDICA_;
if NomCliOrd = '' then
NomCliOrd := _INDICA_;
if EntOrde = '' then
EntOrde := _INDICA_;
if OfiOrde = '' then
OfiOrde := _INDICA_;
if CcOrde = '' then
CcOrde := _INDICA_;
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 := _INDICA_;
if NomTitDom = '' then
NomTitDom := _INDICA_;
if EntTitDom = '' then
EntTitDom := _INDICA_;
if OfiTitDom = '' then
OfiTitDom := _INDICA_;
if ccTitDom = '' then
ccTitDom := _INDICA_;
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 ((fImportePts = 0) and (FEuro = False)) or
((fImporteEu = 0) and (FEuro = True)) then
begin
ShowMessage('¡¡¡ El importe no puede ser cero !!!');
Error(27);
end;
end;
end;
end;
procedure Register;
begin
RegisterComponents('CVB', [TCVBNORMA1958CSB]);
end;
end.
Reference in New Issue View Git Blame Copy Permalink