// 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.