[Lazarus-es] Problema con archivos

Hetor S. Ponce hectorsponce en gmail.com
Mie Oct 28 23:58:08 CET 2009


En el codigo:        ReadLn(f, s);     // aca da el error*

dentro del ide da el error:
 Project psfsvr raised exception class RunError(103)

fuera del ide:
"File not open"

uso lazarus 0.9.28 con fpc 2.2.4 revision 21921

el tema es que cada vez que se usa la función las variables son nuevas y
los archivos existen...

debe ser un bug...

este es el codigo que da error:
*
procedure Tmain.a_scandatosExecute(Sender: TObject);
var
   k, copias: integer;
   f: TextFile;
   job, equipo, recurso,
   archivo_formulario, archivo_datos,
   tarea, impresora, formulario, sql, ts, mensaje: string;
   yy, mm, dd, hh, mi, ss, ms : word;
   p: TProcess;


   Function get_firstline(fname: string): string;
   var
     f: TextFile;
     s: String;
   begin
     if FileExists(fname) then
     begin
       AssignFile(f, fname);
       Reset(f);

       ReadLn(f, s);     // aca da el error

       result:=s;
       CloseFile(f);
     end;
   end;


begin
  t_scan.Enabled:=false;
  mem_servidor.Append('Buscando nuevas tareas de impresión...
('+inttostr(t_scan.Interval div 1000)+' segs)');
 
sl_cola:=FindFile(sl_props.values['rutadatos']+'\*.'+sl_props.values['extdatos']);
  mem_servidor.Append(sl_cola[0]);
  for k:=0 to sl_cola.Count-1 do
  begin
    if FileExists(sl_cola[k]) then
    begin
     
      job:=get_firstline(sl_cola[k]);

      archivo_datos:=ExtractFileName(sl_cola[k]);
      if copy(job, 1, 4) = '^job' then
      begin
        tarea:=copy(job, 6, 6);
        impresora:=copy(job, 12, 2);
     




*sin embargo este codigo no da error:*

program Project1;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, sysutils
  { you can add units after this };

{$IFDEF WINDOWS}{$R project1.rc}{$ENDIF}

 Function get_firstline(fname: string): string;
   var
     f: TextFile;
     s: String;
   begin
     if FileExists(fname) then
     begin
       AssignFile(f, fname);
       Reset(f);
       ReadLn(f, s);
       CloseFile(f);
       result:=s;
     end;
   end;
var
  f1, f2, f3: string;

begin
  f1:='G:\sis\pascal\lazarus\PServer\RTO01123.DAT';
  writeln(get_firstline(f1));

  f2:='G:\sis\pascal\lazarus\PServer\RTO01188.DAT';
  writeln(get_firstline(f2));

  f3:='G:\sis\pascal\lazarus\PServer\RTO01199.DAT';
  writeln(get_firstline(f3));

  readln;

end.


------------ próxima parte ------------
Se ha borrado un adjunto en formato HTML...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus-es/attachments/20091028/4425e8cf/attachment-0002.html>


More information about the Lazarus-es mailing list