Ficheros texto II

Taburiente · #1 23-09-2011

Hola de nuevo,

En unos post anteriores prometí a ecfisa ponerme las pilas en el tratamiento de ficheros planos y en ello estoy.

Os cuento mi nuevo problema y que no se como solventar. Partiendo de un fichero origen necesito extraer entre otras, las lineas que contenga la palabra "L_CODE" sin las comillas, en origen estan asi:

Código:

#MSG_3 L_CODE 7 193407869 4e7b50cb	22/09/2011_17:14:00
#MSG_5 L_CODE 9 193418949 4e7b50cf	22/09/2011_17:14:00
#MSG_6 L_CODE 8 193409660 4e7b50d2	22/09/2011_17:14:00

y en mi fichero destino me salen asi:

Código:

L_CODE 7 193407869 4e7b50cb	22/09/2011_17:14:00
L_CODE 9 193418949 4e7b50cf	22/09/2011_17:14:00
L_CODE 8 193409660 4e7b50d2	22/09/2011_17:14:00

y yo lo que necesito es que me salga de esta manera:

Código:

193407869 	22/09/2011_17:14:00
193418949 	22/09/2011_17:14:00
193409660 	22/09/2011_17:14:00

Y mi codigo hasta ahora es:

Código Delphi [-]procedure GenerarArchivos(const Ruta: string; const Nombre: string);
var
  p: integer;
  i: integer;
  Str: String;
  Origen, Destino: TextFile;
  Linea: string;

begin
     AssignFile(Origen,Ruta+Nombre);
     Reset(Origen);
     AssignFile(Destino,Ruta+Copy(ExtractFileName(Linea),1,Length(Linea)-3)+'.kcl');
  {$I-}
    Reset(Origen);
  {$I+}
  if IOResult = 0 then
  begin
     Rewrite(Destino);
    {$I+}
    if IOResult = 0 then
    begin
      while not Eof(Origen) do
      begin
       Readln(Origen,Str);
        //Readln(Origen,Linea);

        i:= Pos('M_COUNT',Uppercase(Str));
         p:= Pos('L_CODE',Uppercase(Str));
        if i > 0 then
          Writeln(Destino,Copy(Str,i,MAXINT));
           if p > 0 then
          Writeln(Destino,Copy(Str,p,MAXINT));
      end;
      CloseFile(Destino);
    end;
     CloseFile(Origen);
     ShowMessage('PROCESO TERMINADO'+#13+#13+'Ficheros generados en...'+#13+Ruta);
  end;
end;

BEGIN
 Button1.Enabled := false;
  try
  OpenDialog.InitialDir := ExtractFilePath(Application.ExeName);
  if OpenDialog.Execute then
  begin
    if FileExists(OpenDialog.FileName) then
    begin
      Screen.Cursor := crHourGlass;
      try
        GenerarArchivos(ExtractFilePath(OpenDialog.FileName), ExtractFileName(OpenDialog.FileName));
      finally
        Screen.Cursor := crDefault;
      end;
    end;
  end
  else
    ShowMessage('Cancelado por el usuario');
  finally
  Button1.Enabled := true;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Close;
end;

end.

Por favor, podría decirme alguien como conseguir lo que necesito.

Gracias anticipadas

Saludos

marcoszorrilla · #2 23-09-2011

Busca si contiene la palabra y si las líneas son homogeneas como veo utilza:

Copy(xx,10,AnchoRestanteCadena);

Un Saludo.

[oscarac] · #3 23-09-2011

si la cantidad de caracteres desde LCODE hasta el siguiente numero es la misma podrias agregar la cantidad de caracteres de diferencia para extraer la cadena

algo asi

Código Delphi [-] 
 p:= Pos('L_CODE',Uppercase(Str));
           if p > 0 then
          Writeln(Destino,Copy(Str,p+4,MAXINT));

[oscarac] · #4 23-09-2011

oph no habia reparado que hay una cadena intermedia..
dejame pensar

ecfisa · #5 23-09-2011

Hola de Taburiente.

Te hice un ejemplo muy simplificado que hace lo que buscas.

Código Delphi [-]procedure GenerarArchivos(const Ruta: string; const Nombre: string);
const
  SEPARADOR = '     ';
var
  Origen, Destino: TextFile;
  Linea: string;
begin
  AssignFile(Origen, Ruta + Nombre);
  AssignFile(Destino, Ruta + 'DESTINO.KCL');
  Reset(Origen);
  Rewrite(Destino);
  try
    while not Eof(Origen) do
    begin
      Readln(Origen, Linea);
      Writeln(Destino,Copy(Linea,17,9) + SEPARADOR + Copy(Linea,36,MaxInt));
    end
  finally
    CloseFile(Origen);
    CloseFile(Destino);
  end;
end;

Llamada de prueba:

Código Delphi [-] GenerarArchivos('C:\TEMP\','ORIGEN.TXT');

Archivo origen (ORIGEN.TXT):

Código:

#MSG_3 L_CODE 7 193407869 4e7b50cb	22/09/2011_17:14:00
#MSG_5 L_CODE 9 193418949 4e7b50cf	22/09/2011_17:14:00
#MSG_6 L_CODE 8 193409660 4e7b50d2	22/09/2011_17:14:00

Resultado (DESTINO.KCL):

Código:

193407869     22/09/2011_17:14:00
193418949     22/09/2011_17:14:00
193409660     22/09/2011_17:14:00

Tendrías que hacer algunos ajustes como las rutas y nombres de archivo que correspondan a tu caso y la cantidad de espacios que deseas que tenga la constante SEPARADOR.

Un saludo.

Taburiente · #6 23-09-2011

Hola y gracias a todos por vuestra colaboración sois magnifico.

Para ecfisa:

He empleado tu codigo ( ver debajo), he hecho un copy y paste sin modificar nada ya que como podrás ver tengo un opendialogo para seleccionar el fichero requerido y me sigue generando los ficheros con la misma estructura que puse en mi primer post.

Por favor podrias chequear el fichero que adjunto, quizas asi puedas expresarme mejor lo que necesito

Gracias

Código Delphi [-]procedure TForm1.Button1Click(Sender: TObject);

 procedure GenerarArchivos(const Ruta: string; const Nombre: string);
const
  SEPARADOR = '     ';
var
  Origen, Destino: TextFile;
  Linea: string;
begin
  AssignFile(Origen, Ruta + Nombre);
  AssignFile(Destino, Ruta + 'DESTINO.KCL');
  Reset(Origen);
  Rewrite(Destino);
  try
    while not Eof(Origen) do
    begin
      Readln(Origen, Linea);
      Writeln(Destino,Copy(Linea,17,9) + SEPARADOR + Copy(Linea,36,MaxInt));
    end
  finally
    CloseFile(Origen);
    CloseFile(Destino);
  end;
end;
     
     ShowMessage('PROCESO TERMINADO'+#13+#13+'Ficheros generados en...'+#13+Ruta);
  end;
end;

BEGIN
 Button1.Enabled := false;
  try

  OpenDialog.InitialDir := ExtractFilePath(Application.ExeName);
  if OpenDialog.Execute then
  begin
    if FileExists(OpenDialog.FileName) then
    begin
      Screen.Cursor := crHourGlass;
      try

      GenerarArchivos(ExtractFilePath(OpenDialog.FileName), ExtractFileName(OpenDialog.FileName));

      finally
      Screen.Cursor := crDefault;
      end;
    end;
  end
  else
    ShowMessage('Cancelado por el usuario');

  finally
  Button1.Enabled := true;
  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 Close;
end;

end.

Taburiente · #7 23-09-2011

Espero que esta vez vaya el fichero.

Saludos

ecfisa · #8 23-09-2011

Hola Taburiente.

Si, ahora creo que está más claro

, fijate si te sirve de este modo:

Código Delphi [-]procedure GenerarArchivos(const Ruta: string; const Nombre: string);
const
  SEPARADOR = '     ';
var
  Origen, Destino: TextFile;
  Linea: string;
  TS: TStrings;
begin
  AssignFile(Origen, Ruta + Nombre);
  AssignFile(Destino, Ruta + 'DESTINO.KCL');
  Reset(Origen);
  Rewrite(Destino);
  try
    TS:= TstringList.Create;
    while not Eof(Origen) do
    begin
      Readln(Origen, Linea);
      if Pos('M_COUNT', Linea) <> 0 then
        Writeln(Destino, Linea)
      else if Pos('L_CODE', Linea) <> 0 then
      begin
        TS.Clear;
        TS.Delimiter:= ' ';
        TS.DelimitedText:= Linea;
        Writeln(Destino, TS[3] + SEPARADOR + TS[5]);
      end;
    end
  finally
    TS.Free;
    CloseFile(Origen);
    CloseFile(Destino);
  end;
end;

Resultado de la prueba:
ORIGEN.TXT

Código:

#MSG_1 M_COUNT 50_JAZZ_PAGO11M15_12C3DS1_PP001_a00_afp TT14 GD0 BM0 BC0 DB0 EJ0 INS0 DEL0	22/09/2011_17:14:00
#MSG_3 L_CODE 7 193407869 4e7b50cb	22/09/2011_17:14:00
#MSG_5 L_CODE 9 193418949 4e7b50cf	22/09/2011_17:14:00
#MSG_6 L_CODE 8 193409660 4e7b50d2	22/09/2011_17:14:00
#MSG_7 L_CODE 12 193305710 4e7b50d4	22/09/2011_17:14:00
#MSG_9 L_CODE 13 193410268 4e7b50d8	22/09/2011_17:14:00
#MSG_10 L_CODE 14 193409560 4e7b50db	22/09/2011_17:14:00
#MSG_11 L_ERROR 14 DOUBLE 193409560 4e7b50df	22/09/2011_17:14:00
#MSG_12 M_ACT STOP_MACHINE 1 50_JAZZTEL_PAGO11M15_12C3DS1_PP001_a00_afp 4e7b50df	22/09/2011_17:14:00
#MSG_14 L_ERROR 10 BAD_IMAGE 4e7b50e7	22/09/2011_17:14:00
#MSG_15 M_ACT STOP_MACHINE 1 50_JAZZTEL_PAGO11M15_12C3DS1_PP001_a00_afp 4e7b50e7	22/09/2011_17:14:00
#MSG_16 L_ERROR 10 BAD_IMAGE 4e7b50e8	22/09/2011_17:14:00
#MSG_17 M_ACT STOP_MACHINE 1 50_JAZZTEL_PAGO11M15_12C3DS1_PP001_a00_afp 4e7b50e8	22/09/2011_17:14:00
#MSG_19 L_CODE 10 193409476 4e7b50ed	22/09/2011_17:14:00
#MSG_21 M_COUNT 50_JAZZ_PAGO11M15_12C3DS1_PP001_a00_afp TT14 GD7 BM2 BC0 DB1 EJ0 INS0 DEL0	22/09/2011_17:15:00

DESTINO.KCL

Código:

#MSG_1 M_COUNT 50_JAZZ_PAGO11M15_12C3DS1_PP001_a00_afp TT14 GD0 BM0 BC0 DB0 EJ0 INS0 DEL0	22/09/2011_17:14:00
193407869     22/09/2011_17:14:00
193418949     22/09/2011_17:14:00
193409660     22/09/2011_17:14:00
193305710     22/09/2011_17:14:00
193410268     22/09/2011_17:14:00
193409560     22/09/2011_17:14:00
193409476     22/09/2011_17:14:00
#MSG_21 M_COUNT 50_JAZZ_PAGO11M15_12C3DS1_PP001_a00_afp TT14 GD7 BM2 BC0 DB1 EJ0 INS0 DEL0	22/09/2011_17:15:00

Saludos.

Taburiente · #9 23-09-2011

ecfisa, eso es, perfecto, eso es lo que quería, gracias...muchas gracias.

Solo una pregunta mas, crees tu que con este código podría manejar agilmente ficheros con unas 60.000 lineas? lo comento porque veo que utilizas un Tstrings.

Desde ya muchas gracias y si estas por Madrid te invito a unas cervezas por tu tiempo y por lo que me estas enseñando

ecfisa · #10 23-09-2011

Cita:

Solo una pregunta mas, crees tu que con este código podría manejar agilmente ficheros con unas 60.000 lineas? lo comento porque veo que utilizas un Tstrings.

No vas a tener ningún problema de memoria por que la variable TS sólo almacena la cadena leída, sobreescribiendo la propiedad Text en cada lectura.

Si algún día pudiera viajar allá... encantadísimo

Un saludo.

Temas Similares
Tema	Autor	Foro	Respuestas	Último mensaje
Ficheros texto	Taburiente	Varios	7	14-09-2011 18:34:17
Ficheros de texto !!!	Ledian_Fdez	C++ Builder	4	17-02-2010 09:06:06
Comandos especiales {$H} en ficheros de texto	morodo	Lazarus, FreePascal, Kylix, etc.	0	27-01-2007 22:10:17
Correo Web y Ficheros de Texto.	marcoszorrilla	Varios	29	06-09-2006 22:51:55
Tema: Ficheros de texto	Tonio	Varios	5	07-05-2003 15:56:24