{Mira esto}
program archivoreg;
uses
crt;
const
max = 12;
archireg = 'datosreg.dat';
architext = 'textoreg.txt';
type
registro = record
dninumero : string[15];
nombre : string[70];
primapellido : string[70];
segundoapellido : string[70];
fechanacimiento : string[12];
end;
arreglodatos = array[1..max] of registro;
var
datos : arreglodatos;
f : file of registro;
t : text;
cont : integer;
salir : boolean;
tecla : char;
procedure entradaregistros;
begin
cont := 1;
salir := false;
repeat
clrscr;
writeln(' Entrada De Registro Num. ',cont); writeln;
write(' Entre DNI : '); readln(datos[cont].dninumero);
write(' Entre Nombre : '); readln(datos[cont].nombre);
write(' Entre 1. Apellido : '); readln(datos[cont].primapellido);
write(' Entre 2. Apellido : '); readln(datos[cont].segundoapellido);
write(' Entre Fecha Nacimiento : '); readln(datos[cont].fechanacimiento);
writeln;
writeln(' Desea Entrar Mas Datos [S/N]'); repeat
tecla := upcase(readkey);
until tecla in['S','N'];
if tecla = 'S' then
begin
cont := cont + 1;
if cont > max then
salir := true;
end
else
salir := true;
until salir = true;
end;
procedure guardaregistro;
var
h : integer;
tama : word;
begin
assign(f,archireg);
{$I-} reset(f); {$I+} if ioresult <> 0 then
begin
rewrite(f);
for h := 0 to cont do
begin
seek(f,h);
write(f,datos[h]);
end;
close(f);
end
else
begin
tama := filesize(f) - 1;
for h := 1 to cont do
begin
seek(f,tama + h);
end;
close(f);
end;
end;
procedure pasaregistroatexto;
var
kk : word;
begin
assign(f,archireg);
{$I-} reset(f); {$I+} if ioresult <> 0 then
begin
writeln(' Error De Archivo O No Existe Pulse Una Tecla'); readkey;
end
else
begin
assign(t,architext);
rewrite(t);
for kk := 0 to filesize(f) - 1 do
begin
seek(f,kk);
read(f,datos[1]);
writeln(t,datos[1].dninumero,' ',datos[1].nombre,' ',
datos[1].primapellido,' ',datos[1].segundoapellido,' ',
datos[1].fechanacimiento);
end;
close(f);
close(t);
end;
end;
procedure mostrartexto;
var
line : string;
begin
clrscr;
assign(t,architext);
{$I-} reset(t); {$I+} if ioresult = 0 then
begin
while not eof(t) do
begin
readln(t,line);
writeln(' ',line); end;
close(t);
writeln;
writeln(' Pulse Una Tecla'); readkey;
end
else
begin
writeln(' Error De Archivo O No Existe Pulse Una Tecla'); readkey;
end;
end;
begin
entradaregistros;
guardaregistro;
pasaregistroatexto;
mostrartexto;
end.
Crear cuenta