• Domingo 18 de Agosto de 2019, 06:36

Autor Tema:  ej con archivos  (Leído 917 veces)

tomas_sauron

  • Miembro activo
  • **
  • Mensajes: 56
    • Ver Perfil
ej con archivos
« en: Viernes 28 de Enero de 2011, 20:57 »
0
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.

DriverOp

  • Miembro MUY activo
  • ***
  • Mensajes: 201
    • Ver Perfil
Re: ej con archivos
« Respuesta #1 en: Domingo 30 de Enero de 2011, 14:52 »
0
Cambia el "or" por "and" en la condición del while principal.

tomas_sauron

  • Miembro activo
  • **
  • Mensajes: 56
    • Ver Perfil
Re: ej con archivos
« Respuesta #2 en: Domingo 30 de Enero de 2011, 20:31 »
0
gracias che!!!...pero no ya lo habia probado ants d subir mi inquietud al foro pero no paso nada sigue = ....
gracias =!!