Ver Mensaje Individual
  #7  
Antiguo 08-04-2015
Avatar de ecfisa
ecfisa ecfisa is offline
Moderador
 
Registrado: dic 2005
Ubicación: Tres Arroyos, Argentina
Posts: 10.508
Reputación: 36
ecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to beholdecfisa is a splendid one to behold
Hola Jere_84.

Si es un archivo de Texto no podes usar un registro, al menos del modo que lo estas usando con el procedimiento Readln.

Te hice un ejemplo rápido, sin mucho detalle (y que no funciona), tal como se esperaría en este foro .

Bueno, ahora en serio...
Código Delphi [-]
program Project2; {$APPTYPE CONSOLE}

uses
  SysUtils;

const
  PATH = 'C:\tmp\';
  SPC30 = '                              ';
var
  arch: Text;

procedure Initialize;
begin
  AssignFile (arch, PATH + 'ABM.TXT' );
  try
    Reset(arch);
  except
    Rewrite(arch);
  end;
  CloseFile (arch);
end;

function ExistsCode(const cod: string): Boolean;
var
  str: string;
begin
  Result := False;
  Reset ( arch );
  while not Eof ( arch ) and not Result do
  begin
    Readln ( arch, str );
    Result := Copy ( str, 1, 4 ) =  cod;
  end;
  CloseFile ( arch );
end;

procedure ReadCode(var cod: string);
begin
  Write('Codigo: ');
  Readln(cod);
  cod := Copy('0000', 1, 4 - Length(cod)) + cod;
end;

procedure ReadRest(var nom, dom, loc: string);
begin
  Write('Nombre: ');
  Readln(nom);
  Write('Domicilio: ');
  Readln(dom);
  Write('Localidad: ');
  Readln(loc);
  nom := nom + Copy(SPC30, 1, 30-Length(nom));
  dom := dom + Copy(SPC30, 1, 30-Length(dom));
  loc := loc + Copy(SPC30, 1, 30-Length(loc));
end;

procedure AddLine;
var
  cod, nom, dom, loc: string;
begin
  ReadCode ( cod );
  if not ExistsCode(cod) then
  begin
    ReadRest ( nom, dom, loc );
    Append ( arch );
    Writeln( arch, cod + nom + dom + loc );
    Close ( arch );
  end;
end;

procedure ModifyLine;
var
  aux: Text;
  cod, nom, dom, loc, str: string;
begin
  ReadCode ( cod );
  if (cod <> '') and ExistsCode ( cod ) then
  begin
    ReadRest(nom, dom, loc);
    Assign ( aux, PATH + 'AUXILIAR.TXT');
    Rewrite ( aux );
    Reset ( arch );
    while not Eof ( arch ) do
    begin
      Readln ( arch, str );
      if Copy(str, 1, 4) = cod then
        Writeln( aux, cod + nom + dom + loc )
      else
        Writeln( aux, str );
    end;
    CloseFile( arch );
    CloseFile ( aux );
    Erase ( arch );
    Rename ( aux, PATH + 'ABM.TXT' );
  end;
end;

procedure DeleteLine;
var
  aux: Text;
  cod, str: string;
begin
  ReadCode ( cod );
  if (cod <> '') and ExistsCode ( cod ) then
  begin
    Assign ( aux, PATH + 'AUXILIAR.TXT');
    Rewrite ( aux );
    Reset ( arch );
    while not Eof ( arch ) do
    begin
      Readln ( arch, str );
      if Copy(str, 1, 4) <> cod then
        Writeln( aux, str );
    end;
    CloseFile ( arch );
    CloseFile ( aux );
    Erase ( arch );
    Rename ( aux, PATH + 'ABM.TXT' );
  end;
end;

procedure ListLines;
var
  str: string;
begin
  Reset ( arch );
  while not Eof ( arch ) do
  begin
    Readln( arch, str);
    Writeln ( str);
  end;
  CloseFile ( arch );
end;


var
  op: Integer;
begin
  Initialize;
  repeat
    Writeln ( '-----------------' );
    Writeln ( '1.- Agregar linea' );
    Writeln ( '2.- Modificar linea' );
    Writeln ( '3.- Borrar linea' );
    Writeln ( '4.- Listar lineas' );
    Writeln ( '5.- Terminar' );
    Writeln ( '-----------------' );

    repeat
      op := 0;
      Readln(op);
    until op in [1..5];

    Writeln;
    case op of
      1: AddLine;
      2: ModifyLine;
      3: DeleteLine;
      4: ListLines;
    end;
    Writeln;
  until op = 5;
end.
Se puede simplificar usando otras librerias, pero lo hice ajustándome a las funciones y procedimientos estandar Pascal.

Saludos
__________________
Daniel Didriksen

Guía de estilo - Uso de las etiquetas - La otra guía de estilo ....
Responder Con Cita