• Miércoles 11 de Diciembre de 2019, 01:40

Autor Tema:  PROBLEMA GRANDISIMO... PROGRAMA CON ERROR FATAL  (Leído 574 veces)

armandopiner

  • Nuevo Miembro
  • *
  • Mensajes: 2
    • Ver Perfil
PROBLEMA GRANDISIMO... PROGRAMA CON ERROR FATAL
« en: Viernes 26 de Junio de 2009, 02:04 »
0
Hola.. tengo un problema con este programa.... al mostrar la lista de contratos, lo que muestra sons carcateres aleatorios ascii.. en vez de lo que deberia.. por favor.. mañana presento proyecto.. una ayuda seria muy agradecida.... el problema esta en el procedure "Listado_contratos" por fa ayuda



       Program SICU;

       uses DOS , crt;

       type
           Tipo_aula = (T1,T2,T3);

           tcarrera = record
                 numero_Carrera : longint ;
                 Direccion      : string [15];
                 fecha        : dateTime;
                 Cupos_Libres : byte;
                 Aula : Tipo_aula;
                 Nombre_Carrera : string [14];
                 Preparacion : string [14];

           end;

             tipo_Inscripcio = record
                   nombre_Alumno :string[25];
                   CED            :longint;
                   direccion      :string [20];
                   telefono       :string [9];
             End;

             TContrato = Record
                      Nombre_Profesor :String[25];
                      CI : Longint;
                      Direccion : String[25];
                      NivelAca: String[16];
                      Edad : String[3];
                      Sexo : String[10];
                end;

             tipo_fichero_Carrera   = file of tcarrera;
             tipo_fichero_Inscripcio = file of tipo_Inscripcio;
             Tipo_Fichero_Contrato = File of Tcontrato;

       Var
          Carreras:tipo_fichero_Carrera;
          Inscripcion:tipo_fichero_Inscripcio;
          Contratados:Tipo_fichero_Contrato;
          tecla : char;



       Function hash_Carrera (var fich_Carrera:tipo_fichero_Carrera; clave: longint;
                           palabra:longint):longint;

         Var
           registro_Carrera : tcarrera;
           llave : integer;
           llave_aux : integer;
           seguir : boolean;

         begin
            clrscr;
            assign (fich_Carrera,'.Carreras.jai');



            llave := (clave mod 50) ;
            llave_aux := llave;


            seguir := true;
            while (seguir) do
              begin
                 clrscr;
                 reset (fich_Carrera);
                 seek (fich_Carrera,llave_aux);
                 read (fich_Carrera,registro_Carrera);
                 clrscr;
                 if (registro_Carrera.numero_Carrera = palabra) then
                    seguir := false
                 else
                    begin
                       IF ((llave = 0) and (llave_aux = 49))  or
                        (llave_aux + 1 = llave) then
                       begin
                          seguir := false;
                          llave_aux := -1;
                       end
                     else
                       begin
                         llave_aux := llave_aux + 1;
                         if llave_aux > 49 then llave_aux :=0;
                       end;
                    end;



                 hash_Carrera := llave_aux;
                 close (fich_Carrera);
              end;
         end;



       function hash_Inscripcio (nomb:string ; tamanio:integer;
                             CED:longint; buscado:longint) : longint;
       var
          fichero_cupos   : tipo_fichero_Inscripcio;
          llave, llave_aux : longint;
          registro_Inscripcio : tipo_Inscripcio;
          seguir           : boolean;
       begin
            llave := CED mod tamanio;
            llave_aux := llave;
            assign (fichero_cupos,nomb);
            reset (fichero_cupos);
            seguir := true;
            while (seguir)  do
              begin
                 seek (fichero_cupos,llave_aux);
                 read (fichero_cupos,registro_Inscripcio);
                 if registro_Inscripcio.CED = buscado
                    then seguir := false
                 else
                    Begin
                       If ( (llave = 0) and (llave_aux = tamanio - 1) )  or
                       (llave_aux + 1 = llave) then
                        begin
                          seguir := false;
                          llave_aux := -1;
                        end
                      else begin
                          llave_aux := llave_aux + 1;
                          if llave_aux = tamanio then llave_aux :=0;
                        end;
                    end;
              end;
            hash_Inscripcio := llave_aux;
            close (fichero_cupos);
       end;       (* Fin del procedimiento *)


        function hash_contrato (nomb:string ; tamanio:integer;
                             CI:longint; buscado:longint) : longint;
       var
          fichero_vacantes   : tipo_fichero_contrato;
          llave, llave_aux : longint;
          registro_contrato : tcontrato;
          seguir           : boolean;
       begin
            llave := CI mod tamanio;
            llave_aux := llave;
            assign (fichero_vacantes,nomb);
            reset (fichero_vacantes);
            seguir := true;
            while (seguir)  do
              begin
                 seek (fichero_vacantes,llave_aux);
                 read (fichero_vacantes,registro_contrato);
                 if registro_contrato.CI = buscado
                    then seguir := false
                 else
                    Begin
                       If ( (llave = 0) and (llave_aux = tamanio - 1) )  or
                       (llave_aux + 1 = llave) then
                        begin
                          seguir := false;
                          llave_aux := -1;
                        end
                      else begin
                          llave_aux := llave_aux + 1;
                          if llave_aux = tamanio then llave_aux :=0;
                        end;
                    end;
              end;
            hash_Contrato := llave_aux;
            close (fichero_vacantes);
       end;       (* Fin del procedimiento *)





       procedure Introducir_datos_Carrera (var datos : tcarrera);
       var
            tec : char;
            que_Aula : char;
            seguir : boolean;

       begin
       textcolor(0);
            clrscr;

            writeln('                             DATOS DE LA NUEVA CARRERA                              ');
            writeln;
            writeln;

            seguir := false;
            while not (seguir) do
              begin
                 gotoxy(12,8);
                 write('úN£mero de Carrera .................. : ');
                 {$I-}
                      readln (datos.numero_Carrera);
                 {$I+}
                 if (IOResult = 0) and (datos.numero_Carrera > 9999 ) and
                    (datos.numero_Carrera <= 99999)
                     then seguir := true
                 else begin
                          gotoxy(12,9);
                          write ('Entrada err¢nea, pulse una tecla');
                          tec := readkey;
                          gotoxy (12,7);
                          write('                                        ');
                          gotoxy (12,9);
                          write('                                          ');
                      end;
              end;

            seguir := false;
            while not (seguir) do
             begin
              gotoxy (12,10);
              write ('úFecha inicio ....................... :         ');
              gotoxy (53,10);
              {$I-}
              readln (datos.fecha.day);
              {$I+}
              if (IOResult=0) and (datos.fecha.day > 0) and
                 (datos.fecha.day < 32)
                 then seguir := true
              else
                 begin
                     gotoxy(12,10);
                     write('Entrada err¢nea, pulse una tecla');
                     tec := readkey;
                     gotoxy(12,10);
                     write ('                                              ');
                     gotoxy(12,9);
                     write('                                               ');
                 end;
             end;

            seguir := false;
            while not (seguir) do
              begin
                gotoxy (55,10); write('/');
                {$I-}
                readln (datos.fecha.month);
                {$I+}
                if (IOResult = 0) and (datos.fecha.Month > 0)
                   and (datos.fecha.Month < 13)
                  then seguir := true
                else begin
                       gotoxy(12,11);
                       write('Entrada err¢nea, pulse una tecla');
                       tec := readkey;
                       gotoxy(57,10);
                       write ('                                            ');
                       gotoxy(12,11);
                       write('                                             ');
                  end;
              end;

            seguir := false;
            while not (seguir) do
              begin
                gotoxy(58,10); write('/');
                {$I-}
                readln (datos.fecha.Year);
                if (IOResult=0) and (datos.fecha.Year > 1990)
                   and (datos.fecha.Year < 2100)
                  then seguir := true
                else begin
                       gotoxy (12,11);
                       write ('Entrada err¢nea, pulse una tecla');
                       tec := readkey;
                       gotoxy (60,10);
                       write ('                                            ');
                       gotoxy (12,11);
                       write ('                                            ');
                     end;
              end;

            seguir := false;
            while not (seguir) do
              begin
                gotoxy(12,12);
                write('úTipo de Aula (1-T1) (2-T2) (3-T3)... : ');
                que_Aula:=readkey;
                case que_Aula of
                 '1' : begin
                          datos.Aula := T1;
                          datos.Cupos_Libres := 30;
                          seguir:=true;
                    end;
                 '2' : begin
                          datos.Aula := T2;
                          datos.Cupos_Libres := 40;
                          seguir:=true;
                    end;
                 '3' : begin
                          datos.Aula := T3;
                          datos.Cupos_Libres := 60;
                          seguir:=true;
                          end;
                 else
                    begin
                     gotoxy(12,13);
                     write('Entrada err¢nea, pulse una tecla');
                     tec := readkey;
                     gotoxy(62,12);
                     write ('                                              ');
                     gotoxy (12,13);
                     write('                                               ');
                    end;
                 end;
              end;

            gotoxy(12,14);
            write ('úCupos Libres........................ : ',
                  datos.Cupos_Libres);
            tec:=readkey;
            gotoxy (12,16);
            write ('úNombre de la Carrera................ : ');
            readln (datos.nombre_Carrera);

            gotoxy (12,18);
            write ('úPreparacion......................... : ');
            readln (datos.Preparacion);

            gotoxy(12,20);
            write ('úCiudad.............................. : ');
            readln (datos.Direccion);

       end;        (* Fin del procedimiento *)



       function  existe (var fich_Carrera:tipo_fichero_Carrera; num_Carrera:longint)
                        :boolean;

       var
          reg_Carrera : tcarrera;
          exist : boolean;
          posic : longint;
       begin
            assign (fich_Carrera,'.Carreras.jai');
            reset (fich_Carrera);
            exist := false;
            posic := 0;
            seek (fich_Carrera,posic);
            while not (eof(fich_Carrera)) and (not exist) do
              begin
                 seek (fich_Carrera,posic);
                 read (fich_Carrera,reg_Carrera);
                 if reg_Carrera.numero_Carrera = num_Carrera
                    then exist := true;
                 posic := posic +1;
              end;
            existe := exist;
            close (fich_Carrera);
       end;       (* Fin del procedimiento *)



       procedure Crear_Fichero_cupos (nomb:string ; cupos: integer);

       var
          fichero_cupos :tipo_fichero_Inscripcio;
          reg_Inscripcio    :tipo_Inscripcio;
          x              :integer;
       begin

            assign (fichero_cupos,nomb);
            rewrite (fichero_cupos);
            reg_Inscripcio.CED := -1;
            for x := 0 to (cupos -1) do
              begin
                 seek (fichero_cupos,x);
                 write (fichero_cupos,reg_Inscripcio);
              end;
            close (fichero_cupos);
       end;       (* Fin del procedimiento *)



       procedure Introducir (var fich_Carrera:tipo_fichero_Carrera);


       var
          reg_Carrera : tcarrera;
          reg_aux_Carrera : tcarrera;
          posicion : integer;
          palabra_posicion : integer;
          tamanio : integer;
          nombre : String [20];
          nomb_Carrera : String [20];
       begin
            assign (fich_Carrera,'.Carreras.jai');
            palabra_posicion := -1;
            clrscr;
            introducir_datos_Carrera (reg_aux_Carrera);
            if not ( existe (fich_Carrera,reg_aux_Carrera.numero_Carrera) )
             then begin
                posicion := hash_Carrera (fich_Carrera,reg_aux_Carrera.numero_Carrera,
                                       palabra_posicion);
                 if (posicion > -1) then
                   begin
                       reset (fich_Carrera);
                       seek (fich_Carrera,posicion);
                       write (fich_Carrera,reg_aux_Carrera);
                       close (fich_Carrera);



                       tamanio := reg_aux_Carrera.Cupos_Libres;
                       STR (reg_aux_Carrera.numero_Carrera,nomb_Carrera);
                       nombre := '.p' + nomb_Carrera + '.jai';
                       Crear_fichero_cupos (nombre,tamanio);
                     end
                   else begin
                       clrscr;
                       write ('No queda espacio en el fichero de Carreras.');
                   end;
                end
              else begin
                     clrscr;
                     gotoxy(10,10); write (' La Carrera ya est  asignada ');
                     readln;
                   end;

       end;        (* Fin del procedimiento *)


        procedure Cancelar_Carrera (var fich_Carrera: tipo_fichero_Carrera);

        var
          reg_Carrera : tcarrera;
          numero_Carrera : longint;
          posicion : integer;
          nombre : String [20];
          fichero_cupos : tipo_fichero_Inscripcio;
          nomb_Carrera : String [20];

        begin
        textcolor(0);
            repeat
                  {$I-}
                  clrscr;
                  writeln('Introduce el n£mero de Carrera:');
                  readln (numero_Carrera);
                  {$I+}
            until (IOResult = 0) and (numero_Carrera > 9999)
                  and (numero_Carrera <= 99999);

            posicion := hash_Carrera (fich_Carrera,numero_Carrera,numero_Carrera);
            if (posicion > -1)  {Esto quiere decir que ha encontrado el Carrera}
              then begin
                  assign (fich_Carrera,'.Carreras.jai');
                  reset (fich_Carrera);

                  {Primero borramos el fichero de cupos relacionado}
                  str (numero_Carrera,nomb_Carrera);
                  nombre := '.p' + nomb_Carrera + '.jai';
                  assign (fichero_cupos,nombre);
                  erase (fichero_cupos);


                  seek (fich_Carrera,posicion);
                  reg_Carrera.numero_Carrera := -1;
                  seek (fich_Carrera,posicion);
                  write (fich_Carrera,reg_Carrera);
                  close (fich_Carrera);
            end
            else begin
                 clrscr;
                 write ('Carrera no encontrado.');
            end;

        end;     (* Fin del procedimiento *)



        Procedure Listado_Carreras (var fich_Carrera:tipo_fichero_Carrera);


        var
          reg_Carrera: tcarrera;
          k: longint;
          fila: longint;
          tecla: char;
          posicion: integer;
        begin
        textcolor(0);
            clrscr;
            assign (fich_Carrera,'.Carreras.jai');
            reset (fich_Carrera);
            fila:=3;
            k := 0;
            tecla:= 'q';
            gotoxy(1,1); write('N§ Carrera');
            gotoxy(12,1); write ('Ciudad');
            gotoxy(25,1); write('Fec.Ini');
            gotoxy(36,1); write('Cupos');
            gotoxy(46,1); write('Aula');
            gotoxy(51,1); write('Nombre');
            gotoxy(66,1); write('Preparacion');
            seek (fich_Carrera,k);
            while  not ( eof(fich_Carrera) ) do
              begin
                  seek (fich_Carrera,k);
                  read (fich_Carrera,reg_Carrera);
                  if (reg_Carrera.numero_Carrera > -1) then
                    begin
                       gotoxy (1,fila); write(reg_Carrera.numero_Carrera);
                       gotoxy (12,fila); write(reg_Carrera.Direccion);
                       gotoxy (25,fila); write(reg_Carrera.fecha.day,'/');
                       gotoxy (28,fila); write(reg_Carrera.fecha.month,'/');
                       gotoxy (30,fila); write(reg_Carrera.fecha.year);
                       gotoxy (38,fila);write(reg_Carrera.Cupos_Libres);
                       case (reg_Carrera.Aula) of
                            T1: begin
                                  gotoxy(46,fila); write('T1');
                                 end;

                            T2: begin
                                  gotoxy(46,fila); write('T2');
                                 end;

                            T3: begin
                                  gotoxy(46,fila); write('T3');
                                 end;
                       end;

                       gotoxy (51,fila); write(reg_Carrera.Nombre_Carrera);
                       gotoxy (66,fila); write(reg_Carrera.Preparacion);
                       fila := fila + 1;
                       If fila > 23 then
                         begin
                            gotoxy(1,24);
                            write ('Pulsa una tecla para listar');
                            write (' el resto de Carreras');
                            tecla := readkey;
                            for fila := 3 to 24 do
                            begin
                                 gotoxy (1,fila);
                                 write ('                                  ');
                            end;
                            fila :=3;
                         end;
                    end;
                  k:= k + 1;
              end;

            close (fich_Carrera);
            tecla:=readkey;
       end;       (* Fin del procedimiento *)



       procedure Inscripcio_de_cupo (var fich_res : tipo_fichero_Inscripcio;
                                   var fich_carr: tipo_fichero_Carrera);

       var
          reg_aux_carr : tcarrera;
          reg_aux_res : tipo_Inscripcio;
          seguir : boolean;
          pos_Carrera : integer;
          pos_res : integer;
          entrada_Carrera : longint;
          palabra_clave : longint;
          tec : char;
          nomb_Carrera : String [20];
          nombre : String [20];
          tamanio: byte;
       begin
       textcolor(0);
            clrscr;
            assign(fich_carr,'.Carreras.jai');
            seguir := false;
            while not(seguir) do
            begin
                 gotoxy(1,3);
                 write('Introduzca el n£mero de Carrera  : ');
                 {$I-}
                 readln (entrada_Carrera);
                 if (IOResult=0) and (entrada_Carrera > 9999)
                    and (entrada_Carrera<=99999)
                   then seguir := true
                 else begin
                        gotoxy(1,4);
                        write ('Entrada err¢nea, pulse una tecla');
                        tec := readkey;
                        gotoxy(1,3);write('                                ');
                        gotoxy(1,4);write('                                ');
                      end;
            end;


            pos_Carrera := hash_Carrera(fich_carr,entrada_Carrera,entrada_Carrera);
            if pos_Carrera > -1 then
              begin
                 reset (fich_carr);
                 seek (fich_carr,pos_Carrera);
                 read (fich_carr,reg_aux_carr);

                 gotoxy(1,5); write ('Nombre del Alumno: ');
                 readln (reg_aux_res.nombre_Alumno);

                 repeat
                       {$I-}
                       gotoxy(1,6);write('                                 ');
                       gotoxy(1,6);
                       write ('Introduzca su CED : ');
                       readln (reg_aux_res.CED);
                       {$I+}
                 until (IOResult = 0) and (reg_aux_res.CED > 999999)
                       and (reg_aux_res.CED < 100000000);
            {para que tenga 8 d¡gitos}

                 gotoxy(1,7); write('Introduzca la direccion del Alumno: ');
                 readln (reg_aux_res.direccion);
                 gotoxy(1,8);
                 write ('Introduzca el tel‚fono del Alumno: ');
                 readln (reg_aux_res.telefono);
                 case reg_aux_carr.Aula of
                      T1 : tamanio := 30;
                      T2 : tamanio := 40;
                      T3 : tamanio := 60;
                 end;

                 palabra_clave := -1;
                 str (reg_aux_carr.numero_Carrera,nomb_Carrera);
                 nombre := '.p' + nomb_Carrera + '.jai';

                 pos_res := hash_Inscripcio (nombre ,tamanio, reg_aux_res.CED,
                                         palabra_clave);

                 If pos_res > -1 then
                   begin
                     assign (fich_res,nombre);
                     reset (fich_res);
                     seek (fich_res,pos_res);
                     write (fich_res,reg_aux_res);
                     seek (fich_carr,pos_Carrera);
                     reg_aux_carr.Cupos_Libres :=
                            reg_aux_carr.Cupos_Libres - 1;
                     write(fich_carr,reg_aux_carr);
                     close(fich_res);
                   end
                 else begin
                    clrscr;
                    write ('Lo siento, no quedan cupos libres');
                    tec:=readkey;
                   end;
                 close(fich_carr);

              end
                 else
                   begin
                      clrscr;
                      gotoxy(10,10);
                      Write ('El Carrera no existe ');
                      readln;
                   end;
       end;       (* Fin del procedimiento *)




       procedure Contratar (var fich_X : tipo_fichero_Contrato;
                                   var fich_carr: tipo_fichero_Carrera);

       var
          reg_aux_carr : tcarrera;
          reg_aux_x : Tcontrato;
          seguir : boolean;
          pos_Carrera : integer;
          pos_res : integer;
          entrada_Carrera : longint;
          palabra_clave : longint;
          tec : char;
          nomb_Carrera : String [20];
          nombre : String [20];
          tamanio: byte;
       begin
       textcolor(0);
            clrscr;
            assign(fich_carr,'.Carreras.jai');
            seguir := false;
            while not(seguir) do
            begin
                 gotoxy(1,3);
                 write('Introduzca el n£mero de Carrera  : ');
                 {$I-}
                 readln (entrada_Carrera);
                 if (IOResult=0) and (entrada_Carrera > 9999)
                    and (entrada_Carrera<=99999)
                   then seguir := true
                 else begin
                        gotoxy(1,4);
                        write ('Entrada err¢nea, pulse una tecla');
                        tec := readkey;
                        gotoxy(1,3);write('                                ');
                        gotoxy(1,4);write('                                ');
                      end;
            end;


            pos_Carrera := hash_Carrera(fich_carr,entrada_Carrera,entrada_Carrera);
            if pos_Carrera > -1 then
              begin
                 reset (fich_carr);
                 seek (fich_carr,pos_Carrera);
                 read (fich_carr,reg_aux_carr);

                 gotoxy(1,5); write ('Nombre del Profesor: ');
                 readln (reg_aux_x.nombre_Profesor);

                 repeat
                       {$I-}
                       gotoxy(1,6);write('                                 ');
                       gotoxy(1,6);
                       write ('Introduzca su CI : ');
                       readln (reg_aux_X.CI);
                       {$I+}
                 until (IOResult = 0) and (reg_aux_x.CI > 999999)
                       and (reg_aux_X.CI < 100000000);
            {para que tenga 8 d¡gitos}

                 gotoxy(1,7); write('Introduzca la direccion del Profesor: ');
                 readln (reg_aux_x.direccion);
                 gotoxy(1,8);

                 write ('Introduzca el Nivel Academico: ');
                 readln (reg_aux_x.NivelAca);

                 Write ('Introduzca la Edad del Profesor: ');
                 Readln (Reg_Aux_x.Edad);

                 Write ('Introduzca el Sexo: ');
                 Readln(Reg_aux_x.sexo);






                  close(fich_x);
                  Close(fich_carr);


                  end;       (* Fin del procedimiento *)

       End;

       Procedure cancelar_Inscripcio (var fich_res:tipo_fichero_Inscripcio;
                                   var fich_carr:tipo_fichero_Carrera);
       var
          aux_res : tipo_Inscripcio;
          aux_carr : tcarrera;
          entrada_Carrera : longint;
          entrada_CED   : longint;
          seguir  : boolean;
          posi_Carrera : integer;
          posi_res : integer;
          nomb_Carrera : String [20];
          nombre : String [20];
          tamanio : integer;
          tec : char;

       begin
       textcolor(0);
            clrscr;
            seguir := false;
            while not(seguir) do
            begin
                 gotoxy(1,3);
                 write('Introduzca el n£mero de Carrera  : ');
                 {$I-}
                 readln(entrada_Carrera);
                 {$I+}
                 if (IOResult=0) and (entrada_Carrera > 9999)
                    and (entrada_Carrera <= 99999)
                   then seguir := true
                 else begin
                        gotoxy(1,4);
                        write ('Entrada err¢nea, pulse una tecla');
                        tec := readkey;
                        gotoxy(1,3);
                        write('                                            ');
                        gotoxy(1,4);
                        write('                                            ');
                      end;
            end;



            assign (fich_carr,'.Carreras.jai');
            posi_Carrera := hash_Carrera (fich_carr,entrada_Carrera,entrada_Carrera);
            if posi_Carrera > -1 then
            begin

                 reset(fich_carr);
                 seek(fich_carr,posi_Carrera);
                 read(fich_carr,aux_carr);
                 case aux_carr.Aula of
                      T1 : tamanio := 30;
                      T2 : tamanio := 40;
                      T3 : tamanio := 60;
                 end;

                 repeat
                       {$I-}
                       gotoxy(1,6);
                       write('                                             ');
                       gotoxy(1,6);
                       write('Introduzca su CED : ');
                       readln(entrada_CED);
                       {$I+}
                 until (IOResult = 0) and (entrada_CED < 100000000)
                       and (entrada_CED > 999999);

                 str (entrada_Carrera,nomb_Carrera);
                 nombre := '.p' + nomb_Carrera + '.jai';

                 posi_res := hash_Inscripcio (nombre ,tamanio,entrada_CED,
                             entrada_CED);



                 if posi_res > -1 then
                 begin

                      assign (fich_res,nombre);
                      reset (fich_res);
                      seek (fich_res,posi_res);
                      read (fich_res,aux_res);
                      aux_res.CED := -1;
                      seek (fich_res,posi_res);
                      write (fich_res,aux_res);
                      close (fich_res);

                      aux_carr.Cupos_Libres :=
                                        aux_carr.Cupos_Libres +1;
                      seek(fich_carr,posi_Carrera);
                      write(fich_carr,aux_carr);
                      close(fich_carr);
                 end
                 else begin
                      clrscr;
                      write('El CED no existe.');
                      tec:=readkey;
                 end;{fin del else}

            end
            else begin
                 clrscr;
                 write('El Carrera no existe.');
                 tec:=readkey;
            end;

       end;            (* Fin del procedimiento *)





       Procedure Despedir (var fich_x:tipo_fichero_contrato;
                                   var fich_carr:tipo_fichero_Carrera);
       var
          aux_x : tcontrato;
          aux_carr : tcarrera;
          entrada_Carrera : longint;
          entrada_CED   : longint;
          seguir  : boolean;
          posi_Carrera : integer;
          posi_res : integer;
          nomb_Carrera : String [20];
          nombre : String [20];
          tamanio : integer;
          tec : char;

       begin
       textcolor(0);
            clrscr;
            seguir := false;
            while not(seguir) do
            begin
                 gotoxy(1,3);
                 write('Introduzca el n£mero de Carrera  : ');
                 {$I-}
                 readln(entrada_Carrera);
                 {$I+}
                 if (IOResult=0) and (entrada_Carrera > 9999)
                    and (entrada_Carrera <= 99999)
                   then seguir := true
                 else begin
                        gotoxy(1,4);
                        write ('Entrada err¢nea, pulse una tecla');
                        tec := readkey;
                        gotoxy(1,3);
                        write('                                            ');
                        gotoxy(1,4);
                        write('                                            ');
                      end;
            end;



            assign (fich_carr,'.Carreras.jai');
            posi_Carrera := hash_Carrera (fich_carr,entrada_Carrera,entrada_Carrera);
            if posi_Carrera > -1 then
            begin

                 reset(fich_carr);
                 seek(fich_carr,posi_Carrera);
                 read(fich_carr,aux_carr);


                 repeat
                       {$I-}
                       gotoxy(1,6);
                       write('                                             ');
                       gotoxy(1,6);
                       write('Introduzca su CED : ');
                       readln(entrada_CED);
                       {$I+}
                 until (IOResult = 0) and (entrada_CED < 100000000)
                       and (entrada_CED > 999999);

                 str (entrada_Carrera,nomb_Carrera);
                 nombre := '.p' + nomb_Carrera + '.jai';

                 posi_res := hash_Inscripcio (nombre ,tamanio,entrada_CED,
                             entrada_CED);



                 if posi_res > -1 then
                 begin

                      assign (fich_X,nombre);
                      reset (fich_X);
                      seek (fich_X,posi_res);
                      read (fich_X,aux_X);
                      aux_X.CI := -1;
                      seek (fich_X,posi_res);
                      write (fich_X,aux_X);
                      close (fich_X);

                      aux_carr.Cupos_Libres :=
                                        aux_carr.Cupos_Libres +1;
                      seek(fich_carr,posi_Carrera);
                      write(fich_carr,aux_carr);
                      close(fich_carr);
                 end
                 else begin
                      clrscr;
                      write('El CED no existe.');
                      tec:=readkey;
                 end;{fin del else}

            end
            else begin
                 clrscr;
                 write('La Carrera no existe.');
                 tec:=readkey;
            end;

       end;            (* Fin del procedimiento *)





       Procedure Listado_Inscripcion (var fich_res:tipo_fichero_Inscripcio;
                                   var fich_carr : tipo_fichero_Carrera);


       var
          entrada_Carrera   : longint;
          aux_res         : tipo_Inscripcio;
          posicion        : longint;
          x               : integer;
          k               : integer;
          nombre          : String [20];
          nomb_Carrera    : String [20];
          tec             : char;
          seguir          : boolean;
          fila            : longint;
          tecla           : char;

       begin
            clrscr;
            seguir := false;
            while not(seguir) do

              begin
              textcolor(0);
                 gotoxy(1,3);
                 write('Introduzca el n£mero de Carrera  : ');
                 {$I-}
                 readln(entrada_Carrera);
                 {comprobamos la entrada}
                 if (IOResult=0) and (entrada_Carrera > 9999 )
                    and (entrada_Carrera <= 99999)
                 then seguir := true
                 else begin
                       gotoxy(1,4);
                       write ('Entrada err¢nea, pulse una tecla');
                       tec := readkey;
                       gotoxy(1,3);
                       write('                                             ');
                       gotoxy(1,4);
                       write('                                             ');
                      end;
            end;



            assign (fich_carr,'.Carreras.jai');
            posicion := hash_Carrera (fich_carr,entrada_Carrera,entrada_Carrera);
            if posicion > -1 then
            begin
                 clrscr;
                 gotoxy(1,1);write('N§ Carrera');
                 gotoxy(13,1);write('C.I ');
                 gotoxy(21,1);write('Silla#');
                 gotoxy(31,1);write('Tfno');
                 gotoxy(40,1);write('Nombre/Apellido');
                 gotoxy(60,1);write('Direccion');

                 str (entrada_Carrera,nomb_Carrera);
                 nombre := '.p' + nomb_Carrera + '.jai';
                 assign(fich_res,nombre);
                 reset(fich_res);
                 x := 0;
                 fila := 3;
                 seek (fich_res,x);
                 while (not (eof (fich_res))) do
                 begin
                      seek(fich_res,x);
                      read(fich_res,aux_res);

                      if (aux_res.CED <> -1)  then
                      begin
                           gotoxy(1,fila); write(entrada_Carrera);
                           gotoxy(13,fila);write (aux_res.CED );
                           gotoxy(23,fila);write(x);
                           gotoxy(30,fila);write(aux_res.telefono);
                           gotoxy(40,fila);write(aux_res.Nombre_Alumno);
                           gotoxy(60,fila);write(aux_res.direccion);
                           fila := fila + 1;

                           if (fila > 22) then
                           begin
                                gotoxy(1,24);
                                write ('Pulsa una tecla para ver el resto');
                                Write (' de Inscripcion');
                                tecla := readkey;
                                for fila :=3 to 24 do
                                begin
                                     gotoxy(2,fila);
                                     write('                               ');
                                     write('                               ');
                                end;
                                fila := 3;
                           end;
                      end;
                      x := x + 1;
                 end;   {fin del while}
                 tec:=readkey;
                 close(fich_res);
            end
            else begin
                 gotoxy (10,10);
                 write('No existe el Carrera con el n£mero ',entrada_Carrera);
                 readln;
            end;
       end;             (* Fin del procedimiento *)



       Procedure Listado_Contratos (Var fich_carr : tipo_fichero_Carrera;
                                    Var Fich_x : Tipo_fichero_Contrato);


       var
          entrada_Carrera   : longint;
          aux_x             : tcontrato;
          posicion          : longint;
          x                 : integer;
          g                 : integer;
          nomb              : String [20];
          nomb_C            : String [20];
          tec               : char;
          seguir            : boolean;
          fila              : longint;
          tecla             : char;

       begin
            clrscr;
            seguir := false;
            while not(seguir) do

              begin
              textcolor(0);
                 gotoxy(1,3);
                 write('Introduzca el n£mero de Carrera  : ');
                 {$I-}
                 readln(entrada_Carrera);
                 {comprobamos la entrada}
                 if (IOResult=0) and (entrada_Carrera > 9999 )
                    and (entrada_Carrera <= 99999)
                 then seguir := true
                 else begin
                       gotoxy(1,4);
                       write ('Entrada err¢nea, pulse una tecla');
                       tec := readkey;
                       gotoxy(1,3);
                       write('                                             ');
                       gotoxy(1,4);
                       write('                                             ');
                      end;
            end;



            assign (fich_carr,'.Carreras.jai');
            posicion := hash_Carrera (fich_carr,entrada_Carrera,entrada_Carrera);
            if posicion > -1 then
            begin
                 clrscr;
                 gotoxy(1,1);write('N§ Carrera');
                 gotoxy(14,1);write('Cedula');
                 gotoxy(23,1);write('Edad');
                 gotoxy(30,1);write('Nombre/Apellido');
                 gotoxy(49,1);write('Direccion');
                 Gotoxy(62,1);Write('Nivel Acad.');

                 str (entrada_Carrera,nomb_C);
                 nomb := '.p' + nomb_C + '.jai';
                 assign(fich_x,nomb);
                 reset(fich_x);
                 x := 0;
                 fila := 3;
                 seek (fich_x,x);
                 while (not (eof (fich_x))) do
                 begin
                      seek(fich_x,x);
                      read(fich_x,aux_x);

                      if (aux_x.CI <> -1)  then
                      begin
                           gotoxy(1,fila); write(entrada_Carrera);
                           gotoxy(13,fila);write (aux_x.CI );
                           gotoxy(24,fila);write(aux_x.Edad);
                           gotoxy(29,fila);write(aux_x.nombre_Profesor);
                           gotoxy(49,fila);write(aux_x.Direccion);
                           gotoxy(62,fila);write(aux_x.NivelAca);
                           fila := fila + 1;

                           if (fila > 22) then
                           begin
                                gotoxy(1,24);
                                write ('Pulsa una tecla para ver el resto');
                                Write (' de Inscripcion');
                                tecla := readkey;
                                for fila :=3 to 24 do
                                begin
                                     gotoxy(2,fila);
                                     write('                               ');
                                     write('                               ');
                                end;
                                fila := 3;
                           end;
                      end;
                      x := x + 1;
                 end;   {fin del while}
                 tec:=readkey;
                 close(fich_x);
            end
            else begin
                 gotoxy (10,10);
                 write('No existe el Carrera con el n£mero ',entrada_Carrera);
                 readln;
            end;
       end;             (* Fin del procedimiento *)





       procedure Inicializa (Var fich_carr : tipo_fichero_Carrera;
                             Var fich_res  : tipo_fichero_Inscripcio;
                             Var Fich_X    : Tipo_Fichero_contrato);
       var
          tecla:char;
          posicion : longint;
          aux_Carrera : tcarrera;
          aux_Inscripcio :tipo_Inscripcio;
          Aux_Contrato : Tcontrato;
       begin
       textcolor(0);
            clrscr;
            gotoxy (10,15);
            write(' BIENVENIDO POR PRIMERA VEZ A NUESTRO PROGRAMA ');
            tecla:=readkey;

            assign (fich_carr,'.Carreras.jai');
            rewrite (fich_carr);

            for posicion:= 0 to 49 do
              begin
                 aux_Carrera.numero_Carrera := -1;
                 seek(fich_carr,posicion);
                 write(fich_carr,aux_Carrera);
              end;
            Assign(Fich_X,'.Contrato.jai');
            assign(fich_res,'.Inscripcion.jai');
            rewrite(fich_res);
            Rewrite(Fich_x);

            Close(Fich_X);
            close(fich_res);
            close(fich_carr);

       end;       (* Fin del procedimiento *)




       procedure Comprobar_Ficheros (Var fich_Carrera:tipo_fichero_Carrera;
                                     Var fich_res:tipo_fichero_Inscripcio;
                                     Var Fich_X:Tipo_Fichero_contrato);
       begin
            assign(Fich_x,'.Contrato.jai');
            assign(fich_Carrera,'.Carreras.jai');
            assign(fich_res,'.Inscripcion.jai');
       {$I-}
            reset(Fich_x);
            reset(fich_Carrera);
            reset(fich_res);
       {$I+}

            if IOResult <> 0 then
            Inicializa (fich_Carrera,fich_res,fich_x);

       end;           (* Fin del procedimiento *)



       procedure Vaciar_Ficheros(var fich_Carrera  : Tipo_Fichero_Carrera;
                                 var fich_res      : Tipo_Fichero_Inscripcio;
                                 var Fich_x        : Tipo_fichero_Contrato);

       var
          eleccion : char;
          pos_carr : integer;
          reg_Carrera : tcarrera;
          posicion: integer;

       begin
       textcolor(0);
            clrscr;
            writeln('******************************************************');
            writeln('                       VACIADO DE FICHEROS                     ');
            writeln('******************************************************');
            assign (fich_Carrera,'.Carreras.jai');

            eleccion:='q';
            writeln;    writeln;     writeln;
            writeln('Est s seguro de vaciar el fichero de CarreraS S/N: ');
            while (eleccion <> 'S') and (eleccion <> 'N') do
            begin
                 eleccion := upcase(readkey);
                 if (eleccion= 'S') then
                 begin
                      reset(fich_Carrera);
                      pos_carr:=0;
                      seek(fich_Carrera,pos_carr);
                      while (not(eof(fich_Carrera)))  do
                      begin
                           seek (fich_Carrera,pos_carr);
                           read (fich_Carrera,reg_Carrera);
                           reg_Carrera.numero_Carrera:= -1;
                           seek (fich_Carrera,pos_carr);
                           write (fich_Carrera,reg_Carrera);
                           pos_carr:=pos_carr + 1;
                      end;{fin del while}
                      close(fich_Carrera);

                 end;{fin del if de eleccion}

            end;{fin del while de eleccion}

       end;    (* Fin del procedimiento *)


       (*********************************************************************)

       (************************* PRINCIPAL *********************************)

       begin
            Comprobar_Ficheros(Carreras,Inscripcion,Contratados);

            tecla := 'j';
            while tecla <> 'X' do

            begin
            textbackground(15);
            Textcolor(0);
            clrscr;
            gotoxy(8,3);

            Write('BIENVENIDOS AL SISTEMA INFFORMATICO DE CONTR0L UNIVERSITARIO');
            gotoxy(3,5);
            write('    M E N U  P R I N C I P A L  F A C U L T A D  I N G E N I E R I A');

            gotoxy(23, 10);
            write(' A :INSERTAR UNA CARRERA');

            gotoxy(23, 12);
            write(' B :ELIMINAR UNA CARERA.');

            gotoxy(23, 14);
            write(' C :EMITIR REPORTES DE CARRERAS.');

            gotoxy(23, 16);
            write(' D :INSCRIBIR ALUMNOS');

            gotoxy(23, 18);
            write(' E :ELIMINAR ALUMNO');

            gotoxy(23,20);
            write(' F :EMITIR REPORTES DE ALUMNOS');

            gotoxy(23,22);
            write(' G :BORRADO GENERAL');

            Gotoxy(23,24);
            Write(' H :CONTRATAR PROFESOR');

            Gotoxy(23,26);
            Write(' I :DESPEDIR PROFESOR');

            Gotoxy(23,28);
            Write(' J :EMITIR REPORTES PROFESORES');

            gotoxy(23,38); writeln (' Quieres salir? Pulsa (x) Y ya..! ');
            textcolor(8+blink);
            gotoxy(62,49); Write('MP ');
            textcolor(1+blink);
            Write('Pr');
            textcolor(19+blink);
            Write('odu');
            textcolor(6+blink);
            write('ctio');
            textcolor(13+blink);
            Write('ns');
            Textcolor(15);
            Gotoxy(2,49); Write('S.I.C.U');
            Gotoxy(1,1);

            tecla := readkey;
              case  tecla of
                'A' : Introducir(Carreras);
                'B' : Cancelar_Carrera(Carreras);
                'C' : Listado_Carreras(Carreras);
                'D' : Inscripcio_de_cupo(Inscripcion,Carreras);
                'E' : Cancelar_Inscripcio(Inscripcion,Carreras);
                'F' : Listado_Inscripcion(Inscripcion,Carreras);
                'G' : Vaciar_Ficheros(Carreras,Inscripcion,contratados);
                'H' : Contratar(Contratados,carreras);
                'I' : Despedir(Contratados,Carreras);
                'J' : Listado_contratos(carreras,Contratados);

              end;
            end;
            textcolor (88);
            Clrscr;
            Gotoxy (27,18);
            Write ('GRACIAS POR USAR S.I.C.U');
            gotoxy(1,1);
            tecla:=readkey;
            textcolor (7);
            clrscr;
       end.

       (**************** FIN DEL PROGRAMA PRINCIPAL *************************)

armandopiner

  • Nuevo Miembro
  • *
  • Mensajes: 2
    • Ver Perfil
Re: PROBLEMA GRANDISIMO... PROGRAMA CON ERROR FATAL
« Respuesta #1 en: Viernes 26 de Junio de 2009, 02:10 »
0
uPS.. SORRY.. ACA ESTA EL ARCHIVO CON SU RESPECTIVA TABUILACION
El mensaje contiene 1 archivo adjunto. Debes ingresar o registrarte para poder verlo y descargarlo.