corte de control ejercicio 1

program Ejercicio1;

{Se tiene registrada la información de los exámenes finales de los alumnos de la Facultad.
De cada alumno se conoce número de libreta, código de materia y nota obtenida, en un archivo
 ordenado ascendentemente por número de libreta. Liste un renglón por alumno con el promedio
  de notas e informe el total de alumnos.}
uses
  uses,crt;
type
     Tnotas = array[1..5] of real;
    TMat = array[1..5] of string[12];
    RAlumno = record
        numLib : integer;
      codMat : 1..5;
      nota : Tnotas;
    end;
    FAlumno = file of RAlumno;

    Tarray = array[1..500] of RAlumno;

procedure inicializarMaterias(var v:TMat);
begin
    v[1] := 'Matematica';
    v[2] := 'Lengua';
    v[3] := 'Historia';
    v[4] := 'Quimica';
    v[5] := 'Fisica';

end;

procedure leerRegistro(var reg:RAlumno
                      ;v1:TMat);
var opc:char;len:integer;
begin
     clrscr;
    write('Numero de libreta: ');
    readln(reg.numLib);
    len :=0;
    repeat
        repeat
            write('Codigo de materia: ');
            readln(reg.codMat);
        until (reg.codMat in [1..5]);
        writeln('Materia: ',v1[reg.codMat]);
        write('Nota obtenida: ');
        readln(reg.nota[reg.codMat]);
      len := len + 1;
      repeat
        writeln('Desea agregar otra materia S/N: ');
        readln(opc);
         opc := upcase(opc);
      until (opc in ['S','N']);
    until (len > 5) or (opc = 'N');;
end;

procedure carga(var a:FAlumno;var v1:TMat);
var reg:RAlumno;opc : char;
begin
     rewrite(a);
    repeat
            clrscr;
         inicializarMaterias(v1);
            writeln('***Ingrese los datos de los alumnos***');
            leerRegistro(reg,v1);
         write(a,reg);
         repeat
            write('Desea agregar otro alumno S/N : ');
            readln(opc);
            opc := upcase(opc);
         until (opc in ['S','N']);
    until (opc = 'N');
     close(a);
    writeln('Presione ENTER para continuar');
    readkey;
end;

function leer(var a:FAlumno;var reg:RAlumno):boolean;
begin
    if eof (a) then begin
          leer := true;
    end else begin
          read(a,reg);
        leer:= false;
    end;
end;

function subirArch(var a:FAlumno
                         ;var v:Tarray):integer;
var  reg:RAlumno;i:integer;fin:boolean;
begin
      i := 0;
     {$I-}reset(a);{$I+}
     fin := leer(a,reg);
     while (not fin)  do begin
         i := i + 1;
         v[i] := reg;
         fin := leer(a,reg);
     end;
     close(a);
     subirArch := i;
end;

procedure ordenar(var v:Tarray;len:integer);
var aux:RAlumno;i:integer;ordenado:boolean;
begin
     ordenado := false;
     while not ordenado do begin
            ordenado := true;
            for i:=1 to len-1 do begin
             if (v[i].numLib > v[i+1].numLib) then begin
                 aux := v[i+1];
                 v[i+1] := v[i];
                 v[i] := aux;
                 ordenado := false;
             end;
         end;
     end;
end;

procedure bajaArch(var a:FAlumno;v:Tarray;len:integer);
var i:integer;
begin
    rewrite(a);
    i := 1;
    while (i <= len) do begin
          write(a,v[i]);
        i := i + 1;
    end;
    close(a);
end;


procedure listado(var a:FAlumno);
var totAlum : integer;prom,total :real;fin  :boolean;
var reg:RAlumno;nroAnt:integer;cantNotas :integer;
begin
      clrscr;
      {$I-}reset(a);{$I+}
     if ioresult <> 0 then begin
            writeln('El archivo no existe');
         writeln('Presione ENTER para continuar');
         readkey;
     end else begin
         writeln('***Listado de notas***');
         fin := leer(a,reg);
         totAlum := 0;
         while not fin do begin
             nroAnt := reg.numLib;
             write('Alumno: ',reg.numLib);
             total := 0;
             cantNotas :=0;
             prom := 0;
             while (nroAnt = reg.numLib) and (not fin) do begin
                    total := total + reg.nota[reg.codMat];
                  cantNotas := cantNotas + 1;
                  fin := leer(a,reg);
             end;
             prom := total / cantNotas;
             write(', con promedio de notas de: ',prom:4:2);
             writeln;
             writeln('------------------------------------');
             totAlum := totAlum + 1;
         end;
         writeln('Cantidad total de alumnos: ',totAlum);
     end;
     close(a);
     writeln('Presione ENTER para continuar');
     readkey;
end;

procedure asignacion(var a:FAlumno);
begin
    assign(a,'Alumnos.dat');
end;

procedure menu(var a:FAlumno;v1:TMat);
var  salir:boolean;len:integer;v:Tarray;opc:char;
begin
        len :=0;
      asignacion(a);
     repeat
     clrscr;
     salir := false;
     writeln('----MENU GENERAL---');
     writeln('1) Crear Archivo (sobreescribe)');
     writeln('2) Listado de Notas');
     writeln('3) Salir');
     writeln;
     repeat
            write('Escoja una opcion: ');
            readln(opc);
     until (opc in ['1','2','3']);
     case opc of
            '1' :  begin
                carga(a,v1);
                 len := subirArch(a,v);
                ordenar(v,len);
                bajaArch(a,v,len);
                end;
         '2' : listado(a);
         '3' : salir := true;
     end;
     until (salir);

end;
// programa principal
var  Alumnos : FAlumno;materias:TMat;
begin
     menu(Alumnos,materias);
end.