Program TRABAJO;
uses CRT, printer;
const
Max = 1000;
ubicacion='C:\TRABAJO.dat';
Type
Registro=Record
Nom:String [30];
Ced: String [8];
Carnet:String;
Sexo:String;
Edad: integer;
Dir:String;
Tel:String [11];
CentroEst: integer;
Muj: integer;
Homb: integer;
May: integer;
Capi: integer;
Bar: integer;
Meri: integer;
Zuli: integer;
NvaE: integer;
Falc: integer;
Eliminar:Boolean;
End;
ListaEstu = array [1..Max] of Registro;
Archivo= File of Registro;
Var
i, j, anio, c, entero, code, hombres, mujeres, mayores, numero, error, capital, barquisimeto, merida, zulia, nuevaesparta, falcon: integer;
sal: Char;
Lista : ListaEstu;
contadorlapso : byte;
lapso: string[6];
f: file of registro;
datos: registro;
Procedure SumaContadorHM;
var
hombres, mujeres: integer;
begin
hombres := 0;
mujeres := 0;
End;
Procedure contadoredad;
var
mayores, Edad: integer;
begin
mayores := 0;
End;
Procedure PulsarUnaTecla;
var
Car : char;
begin
GotoXY (25,23);
WriteLn ('pulsar cualquier tecla para continuar');Car := Readkey;
ClrScr
End; { PulsarUnaTecla }
Procedure ContadorCE;
begin
capital := 0;
barquisimeto := 0;
merida := 0;
zulia := 0;
nuevaesparta := 0;
falcon := 0;
End;
Procedure ordenaarchivo;
var
dato2, temp : registro;
v, n : longint;
begin
assign(f,ubicacion);
{$I-} reset(f); {$I+}if ioresult <> 0 then
begin
WriteLn(' PULSE [Enter]');readln;
End
else
begin
for v := 0 to filesize(f) - 1 do
for n := filesize(f) - 1 downto v + 1 do
begin
seek(f,v);
read(f,datos);
seek(f,n);
read(f,dato2);
if datos.Ced > dato2.Ced then
begin
temp := datos;
datos := dato2;
dato2 := temp;
seek(f,v);
write(f,datos);
seek(f,n);
write(f,dato2);
End;
End;
End;
close(f);
End;
Procedure Incluir(Var Arch:Archivo);
Var Reg:Registro;
c, u, i, j: integer;
Ced:String;
Encontre:Boolean;
Op:Char;
begin
i := c;
while contadorlapso < 1 do
begin
GotoXY(20,19); WriteLn('Introduzca Año de Estudio: ');GotoXY(20,20);readln(anio);
GotoXY(20,21); WriteLn('Introduzca Lapso Academico: ');GotoXY(20,22);readln(lapso);
contadorlapso:=contadorlapso+1;
End;
clrscr;
i:=i+1;
c:=i;
WriteLn('**************** UNIVERSIDAD ****************');WriteLn;
GotoXY (17, 3);WriteLn('******************** INCLUIR ********************');WriteLn;
Repeat
begin
CLRSCR;
Repeat
GotoXY (20, 5);Write('1º.- Verificar Cedula: ');ReadLn(Ced);
val (Ced[7], numero, error);
until error= 0;
GotoXY (10, 7);WriteLn('El numero de Cedula ' , Ced , ' parece que tiene un formato valido');Reset(Arch);
Encontre:=False;
While Not Eof(Arch) And (Not Encontre) Do
begin
Read(Arch, Reg);
If (Reg.Ced = Ced) And (Not Reg.Eliminar)
Then Encontre:=True;
End;
If Encontre
then begin
Seek(Arch, FilePos(Arch)-1);
GotoXY (20, 21);Write ('-------La Cedula ya fue Registrada-------');GotoXY (20, 23);WriteLn('***** Presione ENTER para continuar *****');ReadKey;
EXIT;
End;
Close(Arch);
End;
CLRSCR;
WriteLn('**************** LA UNIVERSIDAD NACIONAL EXPERIMENTAL ASUNCION ****************');WriteLn;
GotoXY (17, 3);WriteLn('******************** INCLUIR ********************');WriteLn;
GotoXY (25, 10); WriteLn('PROCEDA A REGISTRAR ESTUDIANTE');Repeat
WriteLn;
Write(' Ingrese Cedula: ');ReadLn(Reg.ced);
val (Reg.Ced[7], numero, error);
until error= 0;
WriteLn('El numero de Cedula ' , Reg.Ced , ' parece ser valida, presione Enter para continuar');readkey;
WriteLn;
Repeat
Write(' Ingrese Numero de Carnet: ');ReadLn(Reg.Carnet);
val (Reg.Carnet[5], numero, error);
until error= 0;
WriteLn('El numero de Carnet ' , Reg.Carnet , ' parece ser valido, presione Enter para continuar');readkey;
WriteLn;
Repeat
Write(' Ingrese Nombres y Apellidos: ');ReadLn(Reg.Nom);
if Reg.Nom= '' then
WriteLn('Debe Escribir el Nombre del Estudiante');until
Reg.Nom <> '';
Repeat
Write(' Ingrese Sexo del Estudiante (M/F, en MAYÚSCULA): ');ReadLn(Reg.Sexo);
Reg.Homb:=hombres;
Reg.Muj:=mujeres;
if (Reg.Sexo > 'M') or (Reg.Sexo < 'F') then
WriteLn ('Solo Indique M para Masculino o F para Femenino en MAYÚSCULA');until (Reg.Sexo = 'M') or (Reg.Sexo = 'F');
begin
SumaContadorHM;
End;
begin
if Upcase(Reg.sexo)='M' then
begin
hombres:= hombres + 1;
Reg.Homb:=hombres;
End;
if Upcase(Reg.Sexo)='F' then
begin
mujeres:= mujeres + 1;
Reg.Muj:=mujeres;
End;
End;
Write(' Ingrese Edad del Estudiante : ');{$I-} {Desactivacion de la directiva error en pascal}ReadLn(Reg.Edad);
WHILE IOResult <> 0 DO
begin
WriteLn('Debe Ingresar la Edad del Estudiante');Write('Ingrese Edad del Estudiante : ');ReadLn(Reg.Edad);
End;
{$I+} {Activacion de la directiva error en pascal}begin
contadoredad;
End;
begin
if ( Reg.Edad >= 30 ) then
begin
mayores:= mayores + 1;
Reg.May:=mayores;
End;
End;
Repeat
Write(' Ingrese Direccion : ');ReadLn(Reg.dir);
if Reg.dir= '' then
WriteLn('Debe Escribir la Direccion del Estudiante');until
(Reg.dir <> '');
Repeat
Write(' Ingrese Telefono : ');ReadLn(Reg.tel);
val (Reg.tel[11], numero, error);
until error= 0;
WriteLn('Telefono ' , Reg.tel , ' registrado, presione Enter para continuar');Repeat
Write(' Ingrese Centro de Estudio: ');Write('1.CAPITAL, 2.BARQUISIMETO, 3.MERIDA, 4.ZULIA, 5.NVA ESPARTA, 6.FALCON: ');readLn(Reg.CentroEst);
until Reg.CentroEst in [1..6];
case Reg.CentroEst of
1 : Write ('Capital');2 : Write ('Barquisimeto');3 : Write ('Merida');4 : Write ('Zulia');5 : Write ('Nueva Esparta');6 : Write ('Falcon');else
Write ('Opcion Invalida');End;
case Reg.CentroEst of
1 : capital:=capital+1;
2 : barquisimeto:=barquisimeto+1;
3 : merida:=merida+1;
4 : zulia:=zulia+1;
5 : nuevaesparta:=nuevaesparta+1;
6 : falcon:=falcon+1;
else
End;
Reg.Capi:=capital;
Reg.Bar:=barquisimeto;
Reg.Meri:=merida;
Reg.Zuli:=zulia;
Reg.NvaE:=nuevaesparta;
Reg.Falc:=falcon;
WriteLn;
Reg.Eliminar:=False;
Reset(Arch);
If FileSize(Arch)<>0
Then Seek(Arch, FileSize(Arch));
Write(Arch, Reg);
WriteLn(' Desea agregar otro Estudiante [S/N]');Repeat
sal := upcase(readkey);
until sal in['N','S'];
until sal = 'N';
clrscr;
Close(Arch);
WriteLn;
GotoXY(10,11); WriteLn('***** Presione ENTER para volver a Menu Principal *****');Readkey;
End;
Procedure Eliminar(Var Arch:Archivo);
Var
Reg:Registro;
Ced:String;
Encontre:Boolean;
begin
GotoXY(20,20);Write('Ingrese Cedula del estudiante a borrar : ');ReadLn(Ced);
Reset(Arch);
Encontre:=False;
While Not Eof(Arch) And (Not Encontre) Do
begin
Read(Arch, Reg);
If (Reg.Ced = Ced) And (Not Reg.Eliminar)
Then Encontre:=True;
End;
If Encontre
then begin
Seek(Arch, FilePos(Arch)-1);
Reg.Eliminar:=True;
begin
if Upcase(Reg.sexo)='M' then
begin
hombres:= hombres - 1;
Reg.Homb:=hombres;
End;
if Upcase(Reg.sexo)='F' then
begin
mujeres:= mujeres - 1;
Reg.Muj:=mujeres;
End;
End;
begin
if ( Reg.Edad >= 30 ) then
begin
mayores:= mayores - 1;
Reg.May:=mayores;
End;
End;
GotoXY (33, 22);
Write ('Registro Borrado');PulsarUnaTecla;
Write(Arch, Reg);
End;
Close(Arch);
End;
Procedure Modif(Var Arch:Archivo);
Var
Reg:Registro;
Ced:String;
Encontre:Boolean;
Op:Char;
j:integer;
begin
GotoXY(20,20); Write('Ingrese Cedula a Modificar : ');ReadLn(Ced);
Reset(Arch);
Encontre:=False;
While Not Eof(Arch) And (Not Encontre) Do
begin
Read(Arch, Reg);
If (Reg.Ced = Ced) And (Not Reg.Eliminar)
Then Encontre:=True;
End;
If Encontre
then begin
Seek(Arch, FilePos(Arch)-1);
GotoXY (33, 22);
Write ('Registro encontrado');PulsarUnaTecla;
Repeat
ClrScr;
WriteLn('******* MODIFICACION *******');WriteLn;
WriteLn('1-Cedula : ', Reg.Ced);WriteLn('2-Carnet : ', Reg.Carnet);WriteLn('3-Nombres : ', Reg.Nom);WriteLn('4-Sexo : ', Reg.Sexo);WriteLn('5-Edad : ', Reg.Edad);WriteLn('6-Direccion : ', Reg.Dir);WriteLn('7-Telefono : ', Reg.Tel);WriteLn('8-Centro Estudio : ', Reg.CentroEst);WriteLn('9-Finalizar');WriteLn('0-Cancelar');Repeat
Op:=ReadKey;
Until (Op >= '0') And (Op <= '9');
Case Op Of
'1':begin
Write('Ingrese Cedula :');ReadLn(Reg.Ced);
End;
'2':begin
Write('Ingrese nuevo Carnet :');ReadLn(Reg.Carnet);
End;
'3':begin
Write('Ingrese Nombres y Apellidos :');ReadLn(Reg.Nom);
End;
'4':begin
Write('Modifique Sexo Estudiante:');ReadLn(Reg.Sexo);
Reg.Homb:=hombres;
Reg.Muj:=mujeres;
begin
if Upcase(Reg.sexo)='M' then
begin
hombres:= hombres + 1;
Reg.Homb:=hombres;
mujeres:= mujeres - 1;
Reg.Muj:=mujeres;
End;
if Upcase(Reg.sexo)='F' then
begin
mujeres:= mujeres + 1;
Reg.Muj:=mujeres;
hombres:= hombres - 1;
Reg.Homb:=hombres;
End;
End;
End;
'5':begin
Write('Modifique Edad Estudiante:');ReadLn(Reg.Edad);
begin
if ( Reg.Edad >= 30 ) then
begin
mayores:= mayores + 1;
End;
begin
if ( Reg.Edad <= 29 ) then
begin
mayores:= mayores - 1;
End;
End;
End;
End;
'6':begin
Write('Ingrese nueva Direccion :');ReadLn(Reg.Dir);
End;
'7':begin
Write('Ingrese nuevo Telefono :');ReadLn(Reg.Tel);
End;
'8':begin
Repeat
Write('Ingrese nuevo Centro Estudio :');Write('1.CAPITAL, 2.BARQUISIMETO, 3.MERIDA, 4.ZULIA, 5.NVA ESPARTA, 6.FALCON : ');ReadLn(Reg.CentroEst);
until Reg.CentroEst in [1..6];
case Reg.CentroEst of
1 : WriteLn ('Capital');2 : WriteLn ('Barquisimeto');3 : WriteLn ('Merida');4 : WriteLn ('Zulia');5 : WriteLn ('Nueva Esparta');6 : WriteLn ('Falcon');else
WriteLn ('Opcion Invalida');End;
{DESDE AQUI PROCESO DE MODIFICAR....QUE RESTE 1 A UN CENTRO DE ESTUDIO Y SUME AL NUEVO CENTRO DONDE SE TRASLADA ESTUDIANTE}
Reg.Capi:=capital;
Reg.Bar:=barquisimeto;
Reg.Meri:=merida;
Reg.Zuli:=zulia;
Reg.NvaE:=nuevaesparta;
Reg.Falc:=falcon;
End;
End;
Until (Op = '0') Or (Op = '9');
If Op ='0'
then Exit;
If Op='9'
Then Write(Arch, Reg);
GotoXY (27, 14);
Write ('Edicion del Registro Finalizado');PulsarUnaTecla;
End;
Close(Arch);
End;
Procedure Consult(Var Arch:Archivo);
Var
Reg:Registro;
Ced:String;
Encontre:Boolean;
Op:Char;
begin
GotoXY(20,20); Write('Ingrese Cedula: ');ReadLn(Ced);
Reset(Arch);
Encontre:=False;
While Not Eof(Arch) And (Not Encontre) Do
begin
Read(Arch, Reg);
If (Reg.Ced = Ced) And (Not Reg.Eliminar)
Then Encontre:=True;
End;
If Encontre
then begin
Seek(Arch, FilePos(Arch)-1);
GotoXY (33, 22);
Write ('Registro encontrado');PulsarUnaTecla;
ClrScr;
GotoXY(28,3);WriteLn('******* CONSULTA *******');WriteLn;
GotoXY(28,5);WriteLn('Cedula : ', Reg.Ced);GotoXY(28,6);WriteLn('Carnet : ', Reg.Carnet);GotoXY(28,7);WriteLn('Nombre : ', Reg.Nom);GotoXY(28,8);WriteLn('Sexo : ', Reg.Sexo);GotoXY(28,9);WriteLn('Edad : ', Reg.Edad);GotoXY(28,10);WriteLn('Direccion : ', Reg.Dir);GotoXY(28,11);WriteLn('Telefono : ', Reg.Tel);GotoXY(28,12);WriteLn('Centro Estudio : ', Reg.CentroEst);GotoXY(7,13);WriteLn('1.CAPITAL, 2.BARQUISIMETO, 3.MERIDA, 4.ZULIA, 5.NVA ESPARTA, 6.FALCON');PulsarUnaTecla;
End;
Close(Arch);
End;
Procedure Listar(Var Arch:Archivo);
Var Reg:Registro;
j: longint;
begin
ordenaarchivo;
{$I-} Reset(Arch); {$I+}while Not Eof(Arch) Do
begin
Read(Arch, Reg);
If Reg.Eliminar = FALSE
then
begin
CLRSCR;
for j := 0 to filesize(Arch) - 1 do
begin
seek (Arch,j);
read (Arch,Reg);
If Reg.Eliminar = FALSE
then
WriteLn(Reg.ced,' ',Reg.carnet,' ',Reg.nom,' ',Reg.sexo,' ',Reg.edad);
End;
End;
End;
Close(Arch);
WriteLn;
WriteLn(' ***** Presione ENTER para continuar *****');ReadKey;
End;
Procedure Reporte(Var Arch:Archivo);
Var Reg:Registro;
begin
{$I-} Reset(Arch); {$I+}while Not Eof(Arch) Do
begin
Read(Arch, Reg);
If Reg.Eliminar = FALSE
then
begin
CLRSCR;
WriteLn('**************** UNIVERSIDAD ****************');WriteLn;
WriteLn(' *** RELACION DE ESTUDIANTES INSCRITOS ***');WriteLn;
WriteLn(' AÑO:',anio,'........................','LAPSO:',lapso);WriteLn;
WriteLn;
WriteLn(' LA CANTIDAD DE ESTUDIANTES MUJERES ES:.......................',Reg.muj);WriteLn;
WriteLn(' LA CANTIDAD DE ESTUDIANTES HOMBRES ES:.......................',Reg.homb);WriteLn;
WriteLn(' CANTIDAD DE ESTUDIANTES MAYORES DE 30 AÑOS:..................',Reg.may);WriteLn;
WriteLn(' NUMERO DE ESTUDIANTES DEL CENTRO ESTUDIO REGION CAPITAL:.....',Reg.capi);WriteLn;
WriteLn(' NUMERO DE ESTUDIANTES DEL CENTRO ESTUDIO BARQUISIMETO :.....',Reg.bar);WriteLn;
WriteLn(' NUMERO DE ESTUDIANTES DEL CENTRO ESTUDIO MERIDA :.....',Reg.meri);WriteLn;
WriteLn(' NUMERO DE ESTUDIANTES DEL CENTRO ESTUDIO ZULIA :.....',Reg.zuli);WriteLn;
WriteLn(' NUMERO DE ESTUDIANTES DEL CENTRO ESTUDIO NUEVA ESPARTA :.....',Reg.NvaE);WriteLn;
WriteLn(' NUMERO DE ESTUDIANTES DEL CENTRO ESTUDIO FALCON :.....',Reg.falc);
End;
End;
Close(Arch);
WriteLn;
WriteLn(' ***** Presione ENTER para continuar *****');ReadKey;
End;
Var
Arch:Archivo;
Opcion:Char;
begin
Assign(Arch, ubicacion);
{$i-}Reset(Arch);
{$I+}If IOResult <> 0
Then ReWrite(Arch);
Close(Arch);
Repeat
ClrScr;
WriteLn(' ************** UNIVERSIDAD **************');WriteLn;
WriteLn(' ************** MENU **************');WriteLn;
if contadorlapso= 1 then
begin
WriteLn(' AÑO: ',anio);WriteLn(' lapso: ',lapso);End;
WriteLn;
GotoXY(20,5); WriteLn('1 - Incluir');GotoXY(20,7); WriteLn('2 - Consultar');GotoXY(20,9); WriteLn('3 - Modificar');GotoXY(20,11); WriteLn('4 - Eliminar');GotoXY(20,13); WriteLn('5 - Listar');GotoXY(20,15); WriteLn('6 - Reporte (Relacion de Estudiantes Inscritos)');GotoXY(20,17); WriteLn('0 - Salir');WriteLn;
Repeat
Opcion:=ReadKey;
Until (Opcion >= '0') And (Opcion <= '6');
Case Opcion of
'1': Incluir(Arch);
'2': Consult(Arch);
'3': Modif(Arch);
'4': Eliminar(Arch);
'5': Listar(Arch);
'6': Reporte(Arch);
End;
Until Opcion = '0';
End.
