Ficheros texto II
 

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:

y en mi fichero destino me salen asi:

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

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

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

Copy(xx,10,AnchoRestanteCadena);

Un Saludo.

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));

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

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):
Resultado (DESTINO.KCL):
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.

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.

Espero que esta vez vaya el fichero.

Saludos

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
DESTINO.KCL
Saludos.

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:)

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.