HOLA GENTE DEL FORO ESTOY PRACTICANDO EJERCICIOS CON ARCHIVOS Y SOY NUEVO EN ESTO PERO DENTRO DE TODO VOY BIEN HASTA AHORA NECESITO SI ME PUEDEN AYUDAR
EL PROBLEMA ES UN CLUB POSEE DOS ARCHIVOS SECUENCIALES SOCIOS.DAT Y OTRO PAGOS .DAT HAY Q ACTUALIZAR EL DE SOCIOS.DAT CON LOS DATOS DE PAGOS.DAT
HICE EL PROGRAMA PERO TNGO UN PROBLEMA POR LO Q VI EN EL PROCEDURE ACT() ES HAY Q AL EJECUTARLO QEDA TILDADO EL PROGRAMA
BUSQE D MIL MANERAS PERO NO LOGRO VER EL PROBLEMA SI ME AYUDAN LO AGRADECERE MUCHO!!!!
AQUI EL CODIGO
program archivos;
uses crt;
type
tmes=1..12;
tdeuda=array[tmes]of real;
reg1=record
cod:integer;
nomape:string;
dir:string;
deuda:tdeuda
end;
reg2=record
cod:integer;
mes:tmes;
monto:real
end;
reg3=record
cod:integer;
nomape:string;
totdeuda:real
end;
tsocio=file of reg1;
tpago=file of reg2;
tmoroso=file of reg3;
var
socio:tsocio;rsoc:reg1;
pago:tpago;rpago:reg2;
moroso:tmoroso;rmoroso:reg3;
socion:tsocio;
procedure ingrsoc(var socio:tsocio;var rsoc:reg1);
var
tecla:char;
i:tmes;
begin
assign(socio,'c:archivospascalsocio.dat');
rewrite(socio);
writeln('ingresa datos al archivo socios(s/n)' );
readln(tecla);
while(tecla='s')do
begin
writeln('ingrese cod soc');readln(rsoc.cod);
writeln('ingrese nom apell');readln(rsoc.nomape);
writeln('ingrese dir');readln(rsoc.dir);
for i :=1 to 12do
begin
writeln('ingrese deuda mes',i);
readln(rsoc.deuda
)
end;
write(socio,rsoc);
writeln('ingresa mas datos (s/n)' );
readln(tecla)
end;
close(socio)
end;
procedure ingpago(var pago:tpago;var rpago:reg2);
var
tecla:char;
begin
assign(pago,'c:archivospascalpago.dat');
rewrite(pago);
writeln('ingresa datos al archivo pagos(s/n)');
readln(tecla);
while(tecla='s')do
begin
writeln('ingrese cod soc');readln(rpago.cod);
writeln('ingrese mes abonado');readln(rpago.mes);
writeln('ingrese monto');readln(rpago.monto);
write(pago,rpago);
writeln('ingresa mas datos (s/n)');readln(tecla)
end;
close(pago)
end;
procedure act(var socio:tsocio;var pago:tpago;var socion:tsocio);
var
rsoc:reg1;
rpago:reg2;
begin
assign(socio,'c:archivospascalsocio.dat');
assign(pago,'c:archivospascalpago.dat');
assign(socion,'c:archivospascalsocion.dat');
reset(socio);
reset(pago);
rewrite(socion);
read(socio,rsoc);
read(pago,rpago);
while(not eof(socio))or(not eof(pago))do
begin
if rsoc.cod=rpago.cod then
begin
rsoc.deuda[rpago.mes]:=0;
write(socion,rsoc);
read(socio,rsoc);
read(pago,rpago)
end
else
if rsoc.cod<rpago.cod then
read(socio,rsoc)
else
read(pago,rpago)
end;
close(socio);
close(pago);
close(socion)
end;
function suma(vector:tdeuda):real;
var
i:tmes;
aux:real;
begin
suma:=0;
for i :=1 to 12 do
aux:=vector+aux;
suma:=aux
end;
procedure morosos(var socion:tsocio;var moroso:tmoroso);
var
rsoc:reg1;
rmoroso:reg3;
begin
assign(socion,'c:archivospascalsocion.dat');
assign(moroso,'c:archivospascalmoroso.dat');
reset(socion);
rewrite(moroso);
read(socion,rsoc);
while(rsoc.cod<=clave_max)do
begin
rmoroso.cod:=rsoc.cod;
rmoroso.nomape:=rsoc.nomape;
rmoroso.totdeuda:=suma(rsoc.deuda);
write(moroso,rmoroso);
read(socion,rsoc)
end;
close(socion);
close(moroso)
end;
procedure mostrar_moroso(var moroso:tmoroso);
var
rmorso:reg3;
begin
assign(moroso,'c:archivospascalmoroso.dat');
reset(moroso);
read(moroso,rmoroso);
while(not(eof(moroso)))do
begin
if rmoroso.totdeuda<>0 then
writeln(rmoroso.cod:5,rmoroso.nomape:5,rmoroso.totdeuda:10:2);
read(moroso,rmoroso)
end;
close(moroso)
end;
begin//bloqe ppal.//
clrscr;
ingrsoc( socio, rsoc);
ingpago(pago,rpago);
act(socio,pago,socion);
morosos(socion,moroso);
mostrar_moroso(moroso);
readkey
end.
