Necesito ayuda con las Listas en pascal
Ya casi lo termino pero el punto c del enunciado no hace lo que tiene que hacer o lo hace pero el programa nunca termina(bucle infinito). Este es el enunciado:"Un coro municipal tiene que realizar una serie de presentaciones en distintos lugares del pais. Los datos conocidos son: provincia, localidad, nombre, nombre del lugar donde se llevara a cabo el evento, direccion, telefono y fecha. Se desea obtener un menú que permita realizar lo siguiente:
a) Cargar datos en el archivo
b)Agregar datos a los ya existentes
C)Generar una lista ordenada por nombre de las localidades en las que se llevara a cabo el evento, también deben figurar la provincia y la fecha de la presentacion
d)modificar la fecha de alguna presentación en el archivo
e)Imprimir el archivo y la lista "
Mi codigo hasta ahora es´:
program coro;
uses crt,dos;
type
lista=^reg;
reg=record
prov,loc,noml,dir:string;
tel:string[7];
fech:string[8];
ps:lista;
end;
var
regis:reg;
arc,auxarc:file of reg;
a,op,op5:integer;
sn,s1:string[1];
l:lista;
ar:string;
procedure menu;{Muestra el Menu en pantalla}
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('PROGRAMA CORO MUNICIPAL');end;
end;
writeln('');writeln('');
writeln(' MENU');
writeln('1) Cargar Datos en el Archivo');
writeln('2) Agregar Datos a los ya Existentes');
writeln('3) Generar una lista');
writeln('4) Modificar la fecha de presentaci¢n');
writeln('5) Imprimir archivo y lista');
writeln('6) Salir');
end;
procedure opc1;{Carga el archivo}
var
f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 1'); end;
end;
writeln;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('El archivo fue creado correctamente');writeln;
rewrite(arc);end
else begin
a:=filesize(arc);
writeln('El archivo fue abierto posee ',a,' Registros');
writeln('Si no desea sobreescribirlos ingrese 0');writeln;
end;
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
writeln;writeln;
close(arc);
end;
procedure opc2; {A¤ade otro registro en el archivo}
var
b,f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 2: Agregando Datos'); end;
end;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
rewrite(arc);
end;
b:=filesize(arc);
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
seek(arc,b);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
close(arc);
writeln;
end;
procedure opc3;{Crea una lista ordenada por localidad}
var
nue,act,ant:lista;
fx,f:integer;
m:string;
begin
clrscr;
if op5<>1 then begin
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 3'); end;
end;
end;
writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
fx:=filesize(arc);
l:=nil;
for f:=0 to fx do begin
if f<fx then begin
seek(arc,f);
read(arc,regis);
new(nue);writeln;
nue^.prov:=regis.prov;writeln('Provincia: ',nue^.prov);
nue^.loc:=regis.loc;writeln('Localidad: ',nue^.loc);
nue^.noml:=regis.noml;writeln('Nombre del lugar: ',nue^.noml);
nue^.fech:=regis.fech;writeln('Fecha del Evento: ',nue^.fech);
nue^.ps:=l;
l:=nue;
end else begin nue^.ps:=nil end;
end;writeln;
writeln(' La lista se creo correctamente');readln(m);
if op5<>1 then begin
for a:=1 to 40 do begin write('*');
if a=20 then begin write('OPCION 3: Ordenando por localidad'); end;
end;writeln;
end;
ant:=nil;
act:=l;
seek(arc,0);read(arc,regis);
m:=regis.loc;
for f:=0 to fx-1 do begin
while (act<>nil) and (m=act^.loc) do begin
ant:=act;
act:=act^.ps;
end;
end;
seek(arc,0);read(arc,regis);
while (l<>nil) do begin
writeln(l^.loc);
writeln(l^.prov);
writeln(l^.noml);
writeln(l^.fech);
end;
close(arc);
end;
end;
procedure opc4;{Modifica la fecha de alguna presentaci¢n}
var ax:reg;
fx,f,cod,m:integer;
begin
if op5<>1 then begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4'); end;
end;
writeln;
end;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
seek(arc,0);
fx:=filesize(arc);
writeln('Presentaciones guardadas:');
for f:=1 to fx do begin
read(arc,regis);
writeln;
writeln(' Presentacion: ',f);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Direcci¢n:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
end;
writeln;write(' ');
writeln('Cantidad de presentaciones: ',fx);writeln;
if op5<>1 then begin
write('¨Que presentaci¢n desea modificar? ');
{$I-}
readln(m);
{$I+}
if (m>fx) or (IOResult<>0) then begin
writeln('Introdujo un numero mayor al registro o un caracter invalido');
end else begin
assign(auxarc,'C:\proyec.txt');
rewrite(auxarc);
seek(arc,m-1);
read(arc,regis);
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4: Modificando Fecha'); end;
end;writeln;
writeln('Registro Actual:');
writeln(' Presentacion: ',m);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Dirección:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
ax:=regis;
write('Ingrese nueva fecha: ');readln(ax.fech);
val(ax.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(ax.fech);
end;
for f:=0 to filesize(arc)-1 do...
a) Cargar datos en el archivo
b)Agregar datos a los ya existentes
C)Generar una lista ordenada por nombre de las localidades en las que se llevara a cabo el evento, también deben figurar la provincia y la fecha de la presentacion
d)modificar la fecha de alguna presentación en el archivo
e)Imprimir el archivo y la lista "
Mi codigo hasta ahora es´:
program coro;
uses crt,dos;
type
lista=^reg;
reg=record
prov,loc,noml,dir:string;
tel:string[7];
fech:string[8];
ps:lista;
end;
var
regis:reg;
arc,auxarc:file of reg;
a,op,op5:integer;
sn,s1:string[1];
l:lista;
ar:string;
procedure menu;{Muestra el Menu en pantalla}
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('PROGRAMA CORO MUNICIPAL');end;
end;
writeln('');writeln('');
writeln(' MENU');
writeln('1) Cargar Datos en el Archivo');
writeln('2) Agregar Datos a los ya Existentes');
writeln('3) Generar una lista');
writeln('4) Modificar la fecha de presentaci¢n');
writeln('5) Imprimir archivo y lista');
writeln('6) Salir');
end;
procedure opc1;{Carga el archivo}
var
f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 1'); end;
end;
writeln;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('El archivo fue creado correctamente');writeln;
rewrite(arc);end
else begin
a:=filesize(arc);
writeln('El archivo fue abierto posee ',a,' Registros');
writeln('Si no desea sobreescribirlos ingrese 0');writeln;
end;
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
writeln;writeln;
close(arc);
end;
procedure opc2; {A¤ade otro registro en el archivo}
var
b,f,cod:integer;
begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 2: Agregando Datos'); end;
end;
writeln;writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
rewrite(arc);
end;
b:=filesize(arc);
write('¨Cuantas Entradas desea a¤adir al archivo? ');readln(a);
seek(arc,b);
for a:=a downto 1 do begin
writeln('Introduzca la informaci¢n de la presentaci¢n');writeln;
write('Provincia: ');readln(regis.prov);
write('Localidad: ');readln(regis.loc);
write('Nombre del lugar: ');readln(regis.noml);
write('Direcci¢n: ');readln(regis.dir);
write('Telefono: ');readln(regis.tel);
write('Fecha(dd/mm/aaaa): ');readln(regis.fech);
val(regis.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(regis.fech);
end;
write(arc,regis);writeln;
end;
close(arc);
writeln;
end;
procedure opc3;{Crea una lista ordenada por localidad}
var
nue,act,ant:lista;
fx,f:integer;
m:string;
begin
clrscr;
if op5<>1 then begin
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 3'); end;
end;
end;
writeln;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
fx:=filesize(arc);
l:=nil;
for f:=0 to fx do begin
if f<fx then begin
seek(arc,f);
read(arc,regis);
new(nue);writeln;
nue^.prov:=regis.prov;writeln('Provincia: ',nue^.prov);
nue^.loc:=regis.loc;writeln('Localidad: ',nue^.loc);
nue^.noml:=regis.noml;writeln('Nombre del lugar: ',nue^.noml);
nue^.fech:=regis.fech;writeln('Fecha del Evento: ',nue^.fech);
nue^.ps:=l;
l:=nue;
end else begin nue^.ps:=nil end;
end;writeln;
writeln(' La lista se creo correctamente');readln(m);
if op5<>1 then begin
for a:=1 to 40 do begin write('*');
if a=20 then begin write('OPCION 3: Ordenando por localidad'); end;
end;writeln;
end;
ant:=nil;
act:=l;
seek(arc,0);read(arc,regis);
m:=regis.loc;
for f:=0 to fx-1 do begin
while (act<>nil) and (m=act^.loc) do begin
ant:=act;
act:=act^.ps;
end;
end;
seek(arc,0);read(arc,regis);
while (l<>nil) do begin
writeln(l^.loc);
writeln(l^.prov);
writeln(l^.noml);
writeln(l^.fech);
end;
close(arc);
end;
end;
procedure opc4;{Modifica la fecha de alguna presentaci¢n}
var ax:reg;
fx,f,cod,m:integer;
begin
if op5<>1 then begin
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4'); end;
end;
writeln;
end;
{$I-}
reset(arc);
{$I+}
if IOResult<>0 then begin
writeln('No existe el archivo no puede realizar la opci¢n') end
else begin
seek(arc,0);
fx:=filesize(arc);
writeln('Presentaciones guardadas:');
for f:=1 to fx do begin
read(arc,regis);
writeln;
writeln(' Presentacion: ',f);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Direcci¢n:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
end;
writeln;write(' ');
writeln('Cantidad de presentaciones: ',fx);writeln;
if op5<>1 then begin
write('¨Que presentaci¢n desea modificar? ');
{$I-}
readln(m);
{$I+}
if (m>fx) or (IOResult<>0) then begin
writeln('Introdujo un numero mayor al registro o un caracter invalido');
end else begin
assign(auxarc,'C:\proyec.txt');
rewrite(auxarc);
seek(arc,m-1);
read(arc,regis);
clrscr;
for a:=1 to 50 do begin write('*');
if a=20 then begin write('OPCION 4: Modificando Fecha'); end;
end;writeln;
writeln('Registro Actual:');
writeln(' Presentacion: ',m);
writeln('Fecha: ',regis.fech);
write(' Provincia:',regis.prov);writeln(' Localidad:',regis.loc);
write(' Nombre del lugar: ',regis.noml);write(' Dirección:',regis.dir);
writeln(' Telefono: ',regis.tel);writeln;
ax:=regis;
write('Ingrese nueva fecha: ');readln(ax.fech);
val(ax.fech,f,cod);
if cod<>0 then begin
writeln('Solo puede ingresar numeros');
write('Debe ingresar de nuevo la nueva fecha: ');readln(ax.fech);
end;
for f:=0 to filesize(arc)-1 do...
1 Respuesta
Respuesta
1