SoloCodigo
Programación General => Pascal => Mensaje iniciado por: armandopiner en Viernes 26 de Junio de 2009, 02:04
-
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 *************************)
-
uPS.. SORRY.. ACA ESTA EL ARCHIVO CON SU RESPECTIVA TABUILACION