Pascal/Turbo Pascal - archivos

 
Vista:

archivos

Publicado por roberto (1 intervención) el 31/01/2011 01:56:03
buenas estimados programadores !!
acudo a usd ya q ando dando tumbos con un programa sobre archivos y no puedo
resolver el problema ojala me puedan ayudar ya q soy 1 principiant
y no c me ocurre mas eh intentado varias maneras pero el problema persist
bueno el tema es tengo dos archivos socios.dat y pagos.dat debo acr un programa para actualizar el socios.dat con el pagos.dat
tngo elprograma terminado y compilado pero al ejecutar qeda tildado en la parte actualizar el archivo


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:\archivospascal\socio.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[i])
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:\archivospascal\pago.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:\archivospascal\socio.dat');
assign(pago,'c:\archivospascal\pago.dat');
assign(socion,'c:\archivospascal\socion.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[i]+aux;

suma:=aux

end;

procedure morosos(var socion:tsocio;var moroso:tmoroso);

var
rsoc:reg1;
rmoroso:reg3;


begin
assign(socion,'c:\archivospascal\socion.dat');
assign(moroso,'c:\archivospascal\moroso.dat');
reset(socion);
rewrite(moroso);
read(socion,rsoc);
while(not eof(socion))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:\archivospascal\moroso.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.
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

RE:archivos

Publicado por ramon (2158 intervenciones) el 18/02/2011 14:17:18
Prueba las correcciones marcadas .

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:\socio.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[i])
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:\pago.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;} {Se repiten las variables puede dar lugar a confusiones}

begin
assign(socio,'c:\socio.dat');
reset(socio);

assign(pago,'c:\pago.dat');
reset(pago);
assign(socion,'c:\socion.dat');
rewrite(socion);
{read(socio,rsoc);} {Lectura Incorrecta de Fichero }
{read(pago,rpago);} {Lectura Incorrecta de Fichero }
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[i]+aux;

suma:=aux

end;

procedure morosos(var socion:tsocio;var moroso:tmoroso);

var
rsoc:reg1;
rmoroso:reg3;

begin
assign(socion,'c:\socion.dat');
assign(moroso,'c:\moroso.dat');
reset(socion);
rewrite(moroso);
{read(socion,rsoc);} {Lectura Incorrecta de Fichero }
while(not eof(socion))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:\moroso.dat');
reset(moroso);
{read(moroso,rmoroso);} {Lectura Incorrecta de Fichero }
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.

Espero te valga .
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