{------------------------------------------------------------------ * * Proyecto : * Unit : CVBNorma34CSB * Propósito: Solucionar múltiples problemas con este componente y * adaptarlo para la norma34 del BSCH * * * Autor : * Historia : * Fecha : * Notas : * ------------------------------------------------------------------} unit CVBNorma34CSB; interface uses Messages, SysUtils, Classes, Dialogs, CVBUtils; // const CVBVerNorma34CSB = 'D2 - V 1.0.0'; // primera version 01 de Febrero de 1999 type TModalidad = (moTransfer, moCheques); TTipoNorma = (tnEstandar, tnBSCH); TCVBNorma34CSB = class(TComponent) private pReg: array[0..73] of char; // 72 + CRLF moModalidad: TModalidad; tnTipoNorma: TTipoNorma; HayError: boolean; FTotOrd: integer; FEuro: boolean; FDepura: boolean; FNomFic: string; s1DigCodReg: string; // 1 s2DigCodReg: string; // 1 sCodOpera: string; // 2 NFic: file; sReg: string; _MSK_EU_: string; _LL_: integer; iTotImpCinEu: double; // iTotImpCinPts: Integer; iTot010Cin: integer; iTotRegCin: integer; FEnCasoError: TNotifyEvent; { Private declarations } protected procedure Error(iErr: integer); dynamic; { Protected declarations } public Impresion34: procedure(O: TCVBNorma34CSB; Ordenante, NomOrd: string; Importe: string); NrError: integer; FinRegistro: string; iLotes: integer; bEsPrimerLote: boolean; { El ordenante (El que emite y en nombre del cual se pagan las Transferencias. Puede ser una persona física o jurídica} // el que paga Ordenante: string; //10 FecEnvSoporte: TDateTime; FecEmiOrdenes: TDateTime; EntOrd: string; //4 SucOrd: string; //4 CtaOrd: string; //10 DetallCgo: string; //1 cccOrd: string; //2 NomOrd: string; //36 DomOrd: string; //36 PlzOrd: string; //36 Nom2Ord: string; //36 Dom2Ord: string; //36 Referencia: string; //12 // el que cobra Beneficiario: string; //12 // ImportePts: Integer; ImporteEu: double; EntBen: string; //4 SucBen: string; //4 CtaBen: string; //10 cccBen: string; //2 Gastos: string; //1 Concepto: string; //1 FecConcepto: TDateTime; // Fecha de libramiento del recibo // Lo uso en fechadelconcepto del BSCH 1º reg.de beneficiario NomBen: string; //36 DomBen1: string; //36 DomBen2: string; //36 CPTLPlzBen: string; //36 ProvBen: string; //36 ConcepBen1: string; //36 ConcepBen2: string; //36 DNIBen: string; //18 NIdBen: string; //18 constructor Create(AOwner: TComponent); override; //destructor free; procedure Abrir; procedure IniRegistro; procedure CompCabecera; procedure CompRegistro; procedure Cerrar; property TotOrd: integer Read FTotOrd; { Public declarations } published property NomFichero: string Read FNomFic Write FNomFic; property Modalidad: TModalidad Read moModalidad Write moModalidad default moTransfer; 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; property TipoNorma: TTipoNorma Read tnTipoNorma Write tnTipoNorma default tnEstandar; { Published declarations } end; procedure Register; implementation const _ESP_ = ' '; const _CERO_ = '0'; constructor TCVBNorma34CSB.Create(AOwner: TComponent); begin inherited Create(AOwner); {Asignar la propiedades por defecto} FNomFic := 'CSB34.TXT'; _MSK_EU_ := '0000000000.00'; _LL_ := 74; // 72 + CRLF end; //******************************************************************************* procedure TCVBNorma34CSB.Abrir; begin HayError := False; AssignFile(NFic, FNomFic); {$I+} rewrite(Nfic, _LL_); {$I-} if IOResult <> 0 then error(0); iTotImpCinEu := 0; // iTotImpCinPts:=0; iTotRegCin := 0; IniRegistro; if FinRegistro = '' then FinRegistro := #13 + #10; if FEuro = False then s1DigCodReg := _CERO_ else s1DigCodReg := '5'; end; procedure TCVBNorma34CSB.IniRegistro; begin Beneficiario := ''; //12 // ImportePts := 0; ImporteEu := 0; EntBen := ''; //4 SucBen := ''; //4 CtaBen := ''; //10 cccBen := ''; //2 Gastos := ''; //1 Concepto := ''; //1 DetallCgo := _ESP_; NomBen := ''; //36 DomBen1 := ''; //36 DomBen2 := ''; //36 CPTLPlzBen := ''; //36 ProvBen := ''; //36 ConcepBen1 := ''; //36 ConCepBen2 := ''; //36 DNIBen := ''; //18 NIdBen := ''; //18 end; procedure TCVBNorma34CSB.CompCabecera; begin iTotImpCinEu := 0; iTot010Cin := 0; iTotRegCin := 0; HayError := False; //0356 //Obligatorios if Ordenante = '' then Ordenante := _CERO_; if EntOrd = '' then EntOrd := _CERO_; if SucOrd = '' then SucOrd := _CERO_; if CtaOrd = '' then CtaOrd := _CERO_; if (DetallCgo <> _ESP_) and (DetallCgo <> _CERO_) and (DetallCgo <> '1') then Error(5); s2DigCodReg := '03'; sCodOpera := '56'; sReg := s2DigCodReg + sCodOpera; //4 Ordenante := AjustaCif(Ordenante); sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 case TipoNorma of tnEstandar: sReg := sReg + Ajusta('', 'I', 12, _ESP_); //12 tnBSCH: sReg := sReg + 'PAGOCTABANCO'; end; sReg := sReg + '001'; //3 sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecEnvSoporte), 'I', 6, _ESP_); //6 sReg := sReg + Ajusta(FormatDateTime('ddmmyy', FecEmiOrdenes), 'I', 6, _ESP_); //6 case TipoNorma of tnEstandar: sReg := sReg + Ajusta(EntOrd, 'I', 4, _CERO_); //4 tnBSCH: sReg := sReg + '0049'; end; sReg := sReg + Ajusta(SucOrd, 'I', 4, _CERO_); //4 sReg := sReg + Ajusta(CtaOrd, 'I', 10, _CERO_); //10 case TipoNorma of tnEstandar: sReg := sReg + Ajusta(DetallCgo, 'D', 1, _ESP_); //1 tnBSCH: sReg := sReg + Ajusta(DetallCgo, 'D', 1, _CERO_); end; case TipoNorma of tnEstandar: sReg := sReg + Ajusta('', 'I', 3, _ESP_); //3 tnBSCH: begin sReg := sReg + Ajusta('', 'I', 2, _ESP_); sReg := sReg + 'N'; end; end; sReg := sReg + Ajusta(cccOrd, 'I', 2, _ESP_); //2 case TipoNorma of tnEstandar: sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 tnBSCH: begin sReg := sReg + 'T 8'; // T--8 cuatro caracteres // /////////////////////////////////////////////////////////////////////////////////////// { if iLotes > 0 then begin if ((iLotes>1) and bEsPrimerLote) then sReg := sReg + Ajusta( IntToStr(iLotes), 'I', 2, _CERO_ ) else sReg := sReg + Ajusta( '', 'I', 2, _CERO_ ); end else sReg := sReg + Ajusta( '', 'I',2,_CERO_); } sReg := sReg + '01'; //Ajusta(IntToStr(iLotes),'I',2,_CERO_); // Esta línea de arriba sustituye a todo lo que hay en comentarios. Porque de momento // se vá a hacer un sólo vencimiento para todos los pagos. El día que se quiera enviar // distintos vencimientos, habrá que quitar esta línea, des'comentar' lo de arriba y // cambiar en Remesas para que haga bucles según las fechas de vencimientos y vaya // creando cabecera->cuerpo->pie por cada uno de los vencimientos. // /////////////////////////////////////////////////////////////////////////////////////// sReg := sReg + '3'; end; end; sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(6); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); sReg := s2DigCodReg + sCodOpera; sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 case TipoNorma of tnEstandar: sReg := sReg + Ajusta('', 'I', 12, _ESP_); //12 tnBSCH: sReg := sReg + 'PAGOCTABANCO'; end; sReg := sReg + '002'; //3 sReg := sReg + Ajusta(NomOrd, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(7); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); sReg := s2DigCodReg + sCodOpera; sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 case TipoNorma of tnEstandar: sReg := sReg + Ajusta('', 'I', 12, _ESP_); //12 tnBSCH: sReg := sReg + 'PAGOCTABANCO'; end; sReg := sReg + '003'; //3 sReg := sReg + Ajusta(DomOrd, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(8); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); sReg := s2DigCodReg + sCodOpera; sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 case TipoNorma of tnEstandar: sReg := sReg + Ajusta('', 'I', 12, _ESP_); //12 tnBSCH: sReg := sReg + 'PAGOCTABANCO'; end; sReg := sReg + '004'; //3 sReg := sReg + Ajusta(PlzOrd, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(9); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); if TipoNorma = tnEstandar then begin // Opcionales if (Nom2Ord = '') and (Dom2Ord <> '') then Error(12); if Nom2Ord <> '' then begin sReg := s2DigCodReg + sCodOpera; sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta('', 'D', 12, _ESP_); //12 sReg := sReg + '007'; //3 sReg := sReg + Ajusta(Nom2Ord, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(10); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); end; if Dom2Ord <> '' then begin sReg := s2DigCodReg + sCodOpera; sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta('', 'D', 12, _ESP_); //12 sReg := sReg + '008'; //3 sReg := sReg + Ajusta(Dom2Ord, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(11); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); end; end; end; procedure TCVBNorma34CSB.CompRegistro; var sImporteEu, cIT: string; iP: integer; begin HayError := False; sReg := ''; if Ordenante = '' then Ordenante := _CERO_; if Referencia = '' then Referencia := _CERO_; Referencia := AjustaCif(Referencia); DNIBen := AjustaCif(DNIBen); (* if (ImportePts=0) and (FEuro=False) then Error(23); *) if (ImporteEu = 0) and (FEuro = True) then Error(24); if (Gastos <> '1') and (Gastos <> '2') then Error(25); if (Concepto <> '1') and (Concepto <> '8') and (Concepto <> '9') then Error(26); s2DigCodReg := '06'; case TipoNorma of tnEstandar: begin if moModalidad = moTransfer then sCodOpera := '56' else if moModalidad = moCheques then sCodOpera := '57'; end; tnBSCH: sCodOpera := '57'; end; sReg := s2DigCodReg + sCodOpera; sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta(Referencia, 'D', 12, _ESP_); //12 sReg := sReg + '010'; //3 // if FEuro=False then // sReg := sReg + Ajusta (IntToStr(ImportePts),'D',12,_CERO_) //12 // else begin // Str(ImporteEu:12:2,sImporteEu); sImporteEu := FormatFloat(_MSK_EU_, ImporteEu); 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', 12, _CERO_); end; case TipoNorma of tnEstandar: begin sReg := sReg + Ajusta(EntBen, 'I', 4, _CERO_); //4 sReg := sReg + Ajusta(SucBen, 'I', 4, _CERO_); //4 sReg := sReg + Ajusta(CtaBen, 'I', 10, _CERO_); //10 end; tnBSCH: sReg := sReg + Ajusta('', 'I', 4 + 4 + 10, _ESP_); end; case TipoNorma of tnEstandar: sReg := sReg + Ajusta(Gastos, 'D', 1, _ESP_); //1 tnBSCH: sReg := sReg + '1'; end; case TipoNorma of tnEstandar: sReg := sReg + Ajusta(Concepto, 'D', 1, _ESP_); //1 tnBSCH: sReg := sReg + '9'; end; case TipoNorma of tnEstandar: sReg := sReg + Ajusta('', 'I', 2, _ESP_); //2 tnBSCH: begin if ImporteEu >= 0 then sReg := sReg + _CERO_ // si es positivo el importe else sReg := sReg + '1'; // si es negativo el importe sReg := sReg + _ESP_; end; end; case TipoNorma of tnEstandar: sReg := sReg + Ajusta(cccBen, 'D', 2, _CERO_); //2 tnBSCH: sReg := sReg + Ajusta('', 'D', 2, _ESP_); end; case TipoNorma of tnEstandar: sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 tnBSCH: begin sReg := sReg + FormatDateTime('ddmmyy', FecConcepto); sReg := sReg + _ESP_; end; end; sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(27); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTot010Cin); Inc(iTotRegCin); // iTotImpCinPts := iTotImpCinPts+ImportePts; iTotImpCinEu := iTotImpCinEu + StrToFloat(sImporteEu); sReg := s2DigCodReg + sCodOpera; //4 sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta(Referencia, 'D', 12, _ESP_); //12 sReg := sReg + '011'; //3 sReg := sReg + Ajusta(NomBen, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(28); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); //obligatorio en transferencias if (DomBen1 <> '') or (moModalidad = moTransfer) then begin sReg := s2DigCodReg + sCodOpera; //4 sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta(Referencia, 'D', 12, _ESP_); //12 sReg := sReg + '012'; //3 sReg := sReg + Ajusta(DomBen1, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(29); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); end; if DomBen2 <> '' then begin sReg := s2DigCodReg + sCodOpera; //4 sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta(Referencia, 'D', 12, _ESP_); //12 sReg := sReg + '013'; //3 sReg := sReg + Ajusta(DomBen2, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(200); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); end; // Obligatorio en transferencias if (DomBen1 <> '') or (moModalidad = moTransfer) then begin sReg := s2DigCodReg + sCodOpera; //4 sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta(Referencia, 'D', 12, _ESP_); //12 sReg := sReg + '014'; //3 sReg := sReg + Ajusta(CPTLPlzBen, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(201); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); end; if ProvBen <> '' then begin sReg := s2DigCodReg + sCodOpera; //4 sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta(Referencia, 'D', 12, _ESP_); //12 sReg := sReg + '015'; //3 sReg := sReg + Ajusta(ProvBen, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(202); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); end; if ConcepBen1 <> '' then begin sReg := s2DigCodReg + sCodOpera; //4 sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta(Referencia, 'D', 12, _ESP_); //12 sReg := sReg + '016'; //3 sReg := sReg + Ajusta(ConcepBen1, 'D', 36, _ESP_); //36 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(203); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); end; if (ConcepBen2 <> '') or (TipoNorma = tnBSCH) then begin sReg := s2DigCodReg + sCodOpera; //4 sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta(Referencia, 'D', 12, _ESP_); //12 sReg := sReg + '017'; //3 case TipoNorma of tnEstandar: sReg := sReg + Ajusta(ConcepBen2, 'D', 36, _ESP_); //36 tnBSCH: sReg := sReg + Ajusta(Referencia, 'D', 36, _ESP_); // ???????????????? aquí qué vá?????? end; sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(204); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); end; if TipoNorma = tnEstandar then begin if (DNIBen <> '') or (NIdBen <> '') then begin sReg := s2DigCodReg + sCodOpera; //4 sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //10 sReg := sReg + Ajusta(Referencia, 'D', 12, _ESP_); //12 sReg := sReg + '018'; //3 sReg := sReg + Ajusta(DNIBen, 'D', 18, _ESP_); //18 sReg := sReg + Ajusta(NIdBen, 'D', 18, _ESP_); //18 sReg := sReg + Ajusta('', 'I', 7, _ESP_); //7 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(205); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); Inc(iTotRegCin); end; end; IniRegistro; end; procedure TCVBNorma34CSB.Cerrar; var sTotImpCinEu, cIT: string; iP: integer; begin HayError := False; sReg := ''; Inc(iTotRegCin); case TipoNorma of tnEstandar: sReg := '0856'; //+ s1DigCodReg + s2DigCodReg + sCodOpera; //4 tnBSCH: sReg := '0856'; //'0356'; end; sReg := sReg + Ajusta(Ordenante, 'D', 10, _ESP_); //9 sReg := sReg + Ajusta('', 'D', 12, _ESP_); //3 sReg := sReg + Ajusta('', 'D', 3, _ESP_); //3 // if FEuro=False then // sReg := sReg + Ajusta (IntToStr(iTotImpCinPts),'I',12,_CERO_) //10 // else begin sTotImpCinEu := FormatFloat(_MSK_EU_, iTotImpCinEu); 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', 12, _CERO_); end; sReg := sReg + Ajusta(IntToStr(iTot010Cin), 'I', 8, _CERO_); //10 sReg := sReg + Ajusta(IntToStr(iTotRegCin), 'I', 10, _CERO_); //10 sReg := sReg + Ajusta('', 'D', 6, _ESP_); //20 sReg := sReg + Ajusta('', 'D', 7, _ESP_); //18 sReg := sReg + FinRegistro; //2 if not (length(sReg) = _LL_) then Error(30); StrPCopy(@pReg, sReg); BlockWrite(NFic, pReg, 1); if Assigned(Impresion34) then // if FEuro=False // then Impresion34 (Self,Ordenante,NomOrd,IntToStr(iTotImpCinPts)) // else Impresion34(Self, Ordenante, NomOrd, sTotImpCinEu); CloseFile(NFic); end; procedure TCVBNorma34CSB.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 Register; begin RegisterComponents('CVB', [TCVBNORMA34CSB]); end; end.