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.