Pascal/Turbo Pascal - Ayuda con archivos binarios en PASCAL, no encuentro la vuelta

 
Vista:

Ayuda con archivos binarios en PASCAL, no encuentro la vuelta

Publicado por Andrés (1 intervención) el 28/09/2013 23:16:58
Hola como estan? Recurro al foro por un problema que tengo en Pascal, he intentado de muchas formas, pero no logro conseguir que el programa funcione bien..
Lo que quiero es que el programa maneje estructurados (usuarios) de cada usuario se guarda nombre y edad.. La idea es que permita por un lado agregar un nuevo usuario al archivo, y por otro listar los ya ingresados.

Intente de muchas formas posibles, muchos errores obtenidos, lo más cercano a la solución, es el codigo que mostrare a continuación, pero si abro el programa otra vez, ya tira cualquier error y se cuelga..
Desde ya muchisimas gracias!:

program prueba;

uses crt;

type user = record
nombre: String;
edad: integer;
end;

var fichero: file of user;
aux: file of user;
a, b : user;
opc, i : Byte;

BEGIN
assign(fichero, 'usuarios.dat');
assign(aux, 'auxiliar.dat');
repeat
BEGIN
clrscr();
writeln('1-Nuevo usuario');
writeln('2-Listar usuarios');
readln(opc);
case opc of
1:
begin
writeln('Ingrese el nombre');
readln(b.nombre);
writeln('Ingrese la edad');
readln(b.edad);
{$I-}
reset(fichero);
{$I+}
if (ioResult = 0) then begin
rewrite(aux);
i := 0;
while not eof(fichero) do begin
seek(fichero, i);
read(fichero, a);
write(aux, a);
i := i + 1;
end;
write(aux, b);
close(aux);
close(fichero);
reset(aux);
rewrite(fichero);
i := 0;
while not eof(aux) do begin
seek(aux, i);
read(aux, a);
write(fichero, a);
i := i + 1;
end;
close(aux);
close(fichero);
end
else begin
rewrite(fichero);
write(fichero, b);
close(fichero);
end;

end;
2:
begin
reset(fichero);
i := 0;
while not eof(fichero) do
begin
seek(fichero, i);
read(fichero, a);
writeln('Nombre: ', a.nombre, 'Edad: ', a.edad);
i := i + 1;
readln;
end;
close(fichero);
end
else writeln('No ingresaste una opcion valida');
readln;
end;
END;
until (opc = 0);
END.
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

Ayuda con archivos binarios en PASCAL, no encuentro la vuelta

Publicado por ramon (2158 intervenciones) el 29/09/2013 21:56:22
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
{A ver si esto te aclara algo}
 
 program prueba;
 uses
   crt;
 
type
    user = record
      nombre : String;
        edad : integer;
    end;
 
  var
    fichero: file of user;
    b : user;
    ocp : char;
 
 
 
  procedure guarda_registro(re : user);
  begin
     assign(fichero,'usuarios.dat');
  {$I-} reset(fichero); {$I+}
   if ioresult <> 0 then
   begin
      rewrite(fichero);
      seek(fichero,0);
      write(fichero,re);
      close(fichero);
   end
 else
     begin
        seek(fichero,filesize(fichero));
        write(fichero,re);
        close(fichero);
     end;
  end;
 
  procedure entrada_registros;
  begin
     clrscr;
     writeln('***** Entrada Datos Registro *****');
     write('   Entre Nombre : ');
     readln(b.nombre);
     write('   Entre Edad   : ');
     readln(b.edad);
     guarda_registro(b);
  end;
 
  procedure presenta_registros;
  var
    cu : longint;
    p : integer;
  begin
     clrscr;
     assign(fichero,'usuarios.dat');
  {$I-} reset(fichero); {$I+}
     if ioresult <> 0 then
      begin
         writeln('Error El Archivo No Existe Pulse Una Tecla');
         readkey;
      end
    else
       begin
         cu := 0;
         p := 1;
      repeat
          seek(fichero,cu);
          read(fichero,b);
          writeln('  Nombre : ',b.nombre,'    Edad : ',b.edad);
          cu := cu + 1;
          p := p + 1;
          if p > 23 then
          begin
            writeln('  Pulse Una Tecla ');
            readkey;
            clrscr;
            p := 1;
          end;
      until cu > filesize(fichero) - 1;
       writeln;
       writeln('  Fin De Fichero Pulse Una Tecla ');
       readkey;
       end;
  end;
 
  procedure menu;
  var
    sal : boolean;
  begin
     sal := false;
   repeat
      clrscr;
      writeln(' **** Menu General ****');
      writeln;
      writeln('   1 = Entrada Datos');
      writeln('   2 = Ver Datos');
      writeln('   3 = Salir');
      repeat
          ocp := readkey;
      until ocp in['1','2','3'];
   case ocp of
 '1' : entrada_registros;
 '2' : presenta_registros;
 '3' : sal := true;
   end;
   until sal = true;
  end;
 
  begin
     menu;
  end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar