Agenda con archivos secuenciales en pascal
{Te corrijo algunas cosas pero te explico por que primero el tratamiento de archivos de registros
no funciona como los archivos de texto por lo tanto no sirve el tratamiento que le as dado,
cuando tengas 100 datos por ejemplo entrados si esta como texto como localizas cada uno
imagina que por ejemplo que tienes 3 personas que se llaman pedro como presentas los
datos de pedro 2, presentando primero pedro 1 y luego pedro 2 y si es el 3 lo mismo no
tiene sentido para eso son los registros cada bloque sus datos al poner el nombre y apellido
te buscara el registro de esa persona no los demás, ala hora de modificar o borrar lo mismo,
por ese motivo los archivos de registro se manejan de la forma que te pongo pero tu puedes
continuar como quieras yo solo te informo y espero que quien te este dando clases haya echo
lo mismo sino mal.
En la búsqueda si solo controlas el primer carácter siempre te presentara el archivo que encuentre
en primer lugar no otro de los que tengas.
Program Agenda;
uses
crt;
const
ubicacion='d:\bp\bin\datos.txt';
type
datos_personales = record
nombre : string;
apellido : string;
edad : integer;
numero_telefonico : string[8];
numero_celular : string[8];
direccion : string;
fecha_cumpleanos : string;
email : string;
end;
var
opcion : char;
info : datos_personales;
arch : file of datos_personales;
nombreABuscar : string;
subNombre : string;
entro : boolean;
Procedure Imprimir;
var
i : integer;
begin
assign(arch,ubicacion);
reset(arch);
clrscr;
i := 0;
while i <> filesize(arch) - 1 do
begin
seek(arch,i);
{while not eof (arch) do
begin}
read(arch,info);
with info do
begin
{readln(arch,nombre);
readln(arch,apellido);
readln(arch,edad);
readln(arch,numero_telefonico);
readln(arch,numero_celular);
readln(arch,direccion);
readln(arch,fecha_cumpleanos);
readln(arch,email);}
writeln; writeln;
writeln(nombre,' ',apellido);
writeln('Tiene ',edad,'a¤os');
writeln('Tel‚fono: ',numero_telefonico);
writeln('Celular: ',numero_celular);
writeln('Direcci¢n: ',direccion);
writeln('Fecha de Cumplea¤os: ',fecha_cumpleanos);
writeln('E-mail: ',email);
writeln('Pulse Tecla [enter]');
readln;
i := i + 1;
end;
end;
close(arch);
end;
Procedure Ingresar;
begin
assign(arch,ubicacion);
{$I-} reset(arch); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
seek(arch,filesize(arch));
end;
with info do
begin
writeln; writeln;
write('Digite el nombre: '); readln(nombre);
write('Digite el apellido: '); readln(apellido);
write('Digite la edad: '); readln(edad);
write('Digite el n£mero telef¢nico: '); readln(numero_telefonico);
write('Digite el n£mero celular: '); readln(numero_celular);
write('Digite la direcci¢n: '); readln(direccion);
write('Digite la fecha de cumplea¤os: '); readln(fecha_cumpleanos);
write('Digite el e-mail: '); readln(email);
{writeln(arch,nombre);
writeln(arch,apellido);
writeln(arch,edad);
writeln(arch,numero_telefonico);
writeln(arch,numero_celular);
writeln(arch,direccion);
writeln(arch,fecha_cumpleanos);
writeln(arch,email);}
write(arch,info);
end;
close(arch);
end;
Procedure Buscar;
var
t, i : longint;
begin
assign(arch,ubicacion);
{$I-} reset(arch); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
t := filesize(arch) - 1;
i := 0;
entro:=false;
writeln; writeln;
write('Digite una letra: ');
nombreABuscar:=readkey;
clrscr;
while entro <> true do
begin
seek(arch,i);
read(arch,info);
with info do
begin
{readln(arch,nombre);
readln(arch,apellido);
readln(arch,edad);
readln(arch,numero_telefonico);
readln(arch,numero_celular);
readln(arch,direccion);
readln(arch,fecha_cumpleanos);
readln(arch,email);}
subNombre:=Copy(nombre,1,length(nombreABuscar));
if(subNombre=nombreABuscar) then
begin
entro:=true;
writeln; writeln;
writeln(nombre,' ',apellido);
writeln('Tiene ',edad,'a¤os');
writeln('Tel‚fono: ',numero_telefonico);
writeln('Celular: ',numero_celular);
writeln('Direcci¢n: ',direccion);
writeln('Fecha de Cumplea¤os: ',fecha_cumpleanos);
writeln('E-mail: ',email);
writeln;
end;
end;
i := i + 1;
if i > t then
entro := true;
end;
if(not entro) then
writeln('No se encontraron resultados para esta busqueda');
readkey;
close(arch);
end;
end;
procedure eliminar;
var
tec : char;
nomb, ape : string;
i, borra, cont : longint;
encontrado : boolean;
ten : file of datos_personales;
p : integer;
begin
assign(arch,ubicacion);
{$I-} reset(arch); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
clrscr;
write('Entre Nonbre : ');
readln(nomb);
write('Entre Apellido : ');
readln(ape);
cont := 0;
encontrado := false;
repeat
seek(arch,cont);
read(arch,info);
for p := 1 to length(info.nombre) do
info.nombre[p] := upcase(info.nombre[p]);
for p := 1 to length(info.apellido) do
info.apellido[p] := upcase(info.apellido[p]);
for p := 1 to length(nomb) do
nomb[p] := upcase(nomb[p]);
for p := 1 to length(ape) do
ape[p] := upcase(ape[p]);
if (info.nombre = nomb) and (info.apellido = ape) then
begin
encontrado := true;
end
else
begin
cont := cont + 1;
end;
until (encontrado = true) or (cont > filesize(arch) - 1);
if encontrado = true then
begin
borra := cont;
clrscr;
with info do
begin
writeln(nombre,' ',apellido);
writeln('Tiene ',edad,'a¤os');
writeln('Tel‚fono: ',numero_telefonico);
writeln('Celular: ',numero_celular);
writeln('Direcci¢n: ',direccion);
writeln('Fecha de Cumplea¤os: ',fecha_cumpleanos);
writeln('E-mail: ',email);
end;
writeln;
writeln('Desea Eliminar Estos Datos [S/N]');
repeat
tec := readkey;
until tec in['s','S','n','N'];
if tec in['s','S'] then
begin
assign(ten,'d:\bp\bin\Temporal.tem');
rewrite(ten);
cont := 0;
i := 0;
repeat
seek(arch,i);
read(arch,info);
if i <> borra then
begin
seek(ten,cont);
write(ten,info);
cont := cont + 1;
end;
i := i + 1;
until i > filesize(arch) - 1;
close(arch);
erase(arch);
close(ten);
rename(ten,ubicacion);
end;
end;
end;
end;
procedure modificar;
var
deci, toma : char;
nomb, ape : string;
modifi, cont : longint;
salir, sal : boolean;
p : integer;
begin
assign(arch,ubicacion);
{$I-} reset(arch); {$I+}
if ioresult <> 0 then
begin
exit;
end
else
begin
clrscr;
write('Entre Nombre : ');
readln(nomb);
write('Entre Apellido : ');
readln(ape);
cont := 0;
sal := false;
repeat
seek(arch,cont);
read(arch,info);
for p := 1 to length(info.nombre) do
info.nombre[p] := upcase(info.nombre[p]);
for p := 1 to length(info.apellido) do
info.apellido[p] := upcase(info.apellido[p]);
for p := 1 to length(nomb) do
nomb[p] := upcase(nomb[p]);
for p := 1 to length(ape) do
ape[p] := upcase(ape[p]);
if (info.nombre = nomb) and (info.apellido = ape) then
begin
sal := true;
end
else
begin
cont := cont + 1;
end;
until (sal = true) or (cont > filesize(arch) - 1);
if sal = true then
begin
clrscr;
modifi := cont;
repeat
with info do
begin
writeln(nombre,' ',apellido);
writeln('Tiene ',edad,'a¤os');
writeln('Tel‚fono: ',numero_telefonico);
writeln('Celular: ',numero_celular);
writeln('Direcci¢n: ',direccion);
writeln('Fecha de Cumplea¤os: ',fecha_cumpleanos);
writeln('E-mail: ',email);
end;
writeln;
writeln('MODIFICACION DE DATOS CUAL ');
writeln(' 1 = Nombre');
writeln(' 2 = apellido');
writeln(' 3 = edad');
writeln(' 4 = Tel‚fono');
writeln(' 5 = Celular');
writeln(' 6 = Direcci¢n');
writeln(' 7 = Cumplea¤os');
writeln(' 8 = E-mail');
writeln(' 9 = Nada');
writeln;
writeln('Elije Opcion');
toma := readkey;
case toma of
'1': begin write('Nombre : ');readln(info.nombre); end;
'2': begin write('Apellido : ');readln(info.apellido); end;
'3': begin write('Edad : ');readln(info.edad); end;
'4': begin write('Telefono : ');readln(info.numero_telefonico); end;
'5': begin write('Celular : ');readln(info.numero_celular); end;
'6': begin write('Direccion : ');readln(info.Direccion); end;
'7': begin write('Cumplea¤os : ');readln(info.fecha_cumpleanos); end;
'8': begin write('E-Mail : ');readln(info.email); end;
'9': begin salir := true; end;
end;
if salir = false then
begin
clrscr;
writeln('Desea Realizar Mas Cambios [S/N]');
salir := false;
seek(arch,modifi);
write(arch,info);
repeat
deci := readkey;
until deci in['s','S','n','N'];
if deci in['n','N'] then
salir := true;
end;
until salir = true;
close(arch);
end;
end;
end;
Procedure Inicializar;
begin
assign(arch,ubicacion);
{$I-} reset(arch); {$I+}
if ioresult <> 0 then
begin
rewrite (arch);
close(arch);
end
else
begin
close(arch);
end;
end;
Procedure Seleccion;
begin
case opcion of
'1': Ingresar;
'2': Buscar;
'3': Imprimir;
'4': Inicializar;
'5': eliminar;
'6': modificar;
end;
end;
Procedure Menu;
begin
clrscr;
writeln;
writeln;
gotoxy(35,6);write('MENU DE AGENDA');
gotoxy(25,7);write('1. Agregar Contactos');
gotoxy(25,9);write('2. Buscar Contactos');
gotoxy(25,11);write('3. Observar Contactos');
gotoxy(25,13);write('4. Inicializar Lista de Contactos');
gotoxy(25,15);write('5. Eliminar Registro');
gotoxy(25,17);write('6. Modificar');
gotoxy(25,19);write('7. Salir');
gotoxy(20,21);write('Escoja una opci¢n: ');
opcion:=readkey;
end;
Procedure Ciclo;
begin
Repeat
Menu;
Seleccion;
Until (opcion='7');
end;
Begin
clrscr;
Ciclo;
End.
