Gestión de una liga de baloncesto

Autor: Santiago Márquez

Programa de gestión que permite realizar altas, bajas y modificaciones de equipos, jugadores y récords de una liga de baloncesto.

program final;
uses crt;
type
    reg_jugadores = record
                idjugador,idequipo,fechanac:string[10];
                nomyap:string[30];
                baja:boolean
    end;

reg_equipos = record
               idequipo:string[10];
               nombre,dt:string[15];
               baja:boolean
    end;

reg_records = record
               idrecord,idjugador:string[15];
               titulo:string[20];
               baja:boolean
    end;

arch_jug =file of reg_jugadores;
    arch_eq =file of reg_equipos;
    arch_records = file of reg_records;

var
   a_j : arch_jug;
   a_e: arch_eq;
   a_r : arch_records;
   s: char;

procedure abrir(var a:arch_jug; var b:arch_eq; var c:arch_records);
   begin
        assign(a,\'jugadores.dat\');
        assign(b,\'equipos.dat\');
        assign(c,\'records.dat\');
        {$I-};
        reset(a);
        {$I+};
        if ioresult <> 0 then
           rewrite(a);
        close(a);
        {$I-};
        reset(b);
        {$I+};
        if ioresult <> 0 then
           rewrite(b);
        close(b);
        {$I-};
        reset(c);
        {$I+};
        if ioresult <> 0 then
           rewrite(c);
        close(c)
   end;

function buscareq(var a:arch_eq;c:string): integer;
  var
     enc:boolean;
     r:reg_equipos;
     pos:integer;
  begin
       reset(a);
       enc:=false;
       pos:=-1;
       while (not enc) and (not eof(a)) do
       begin
              read(a,r);
              if (r.idequipo= c) and (not r.baja) then
              begin
                   pos:=filepos(a) - 1;
                   enc:=true
              end
       end;
       close(a);
       buscareq:=pos
  end;

function buscarjug(var a:arch_jug;c:string): integer;
  var
     enc:boolean;
     r:reg_jugadores;
     pos:integer;
  begin
       reset(a);
       enc:=false;
       pos:=-1;
       while (not enc) and (not eof(a)) do
       begin
              read(a,r);
              if (r.idjugador= c) and (not r.baja) then
              begin
                   pos:=filepos(a) - 1;
                   enc:=true
              end
       end;
       close(a);
       buscarjug:=pos
  end;

function buscarrec(var a:arch_records; c:string): integer;
  var
     enc:boolean;
     r:reg_records;
     pos:integer;
  begin
       reset(a);
       enc:=false;
       pos:=-1;
       while (not enc) and (not eof(a)) do
       begin
              read(a,r);
              if (r.idrecord= c) and (not r.baja) then
              begin
                   pos:=filepos(a) - 1;
                   enc:=true
              end
       end;
       close(a);
       buscarrec:=pos
  end;

procedure crea_libres (var a:arch_eq);
var
   r: reg_equipos;
   p:integer;
begin
     p:= buscareq(a,\'libres\');
     if p=-1 then
     begin
          r.idequipo:=\'libres\';
          r.nombre:=\'Agentes libres\';
          r.dt:=\'[ninguno]\';
          r.baja:= false;
          reset(a);
          seek(a,filesize(a));
          write(a,r);
          close(a)
     end
end;

function valida_s_n(c:char): char;
begin
     while (upcase(c) <> \'S\') and (upcase(c) <> \'N\') do
           c := readkey;
     valida_s_n := upcase(c)
end;

function valida_j_e_r(c:char): char;
begin
     while (upcase(c) <> \'J\') and (upcase(c) <> \'E\') and (upcase(c) <> \'R\') do
           c := readkey;
     valida_j_e_r := upcase(c)
end;

function valida_e_l_c(c:char): char;
begin
     while (upcase(c) <> \'E\') and (upcase(c) <> \'L\') and (upcase(c) <> \'C\') do
           c := readkey;
     valida_e_l_c := upcase(c)
end;

function valida_a_b_m_l_s(c:char): char;
begin
     while (upcase(c) <> \'A\') and (upcase(c) <> \'B\') and (upcase(c) <> \'M\') and (upcase(c) <> \'L\') and (upcase(c) <> \'S\') do
           c := readkey;
     valida_a_b_m_l_s := upcase(c)
end;

procedure alta (var a:arch_eq; var b:arch_jug; var c:arch_records);
  var
     s:char;
     rjug:reg_jugadores;
     rrec:reg_records;
     req:reg_equipos;
     p:integer;
  begin
     clrscr;
     writeln(\'Dar de alta\');
     write(\'(J)ugadores / (E)quipos / (R)ecords\');
     s:= valida_j_e_r(readkey);
     if s=\'E\' then
     repeat
          clrscr;
          writeln(\'Alta equipos\');
          write(\'ID del equipo: \');
          readln(req.idequipo);
          p:= buscareq(a,req.idequipo);
          if p<> -1 then
             write(\'El ID ya existe\')
          else
          begin
                   write(\'Nombre: \');
                   readln(req.nombre);
                   write(\'DT: \');
                   readln(req.dt);
                   req.baja:=false;
                   reset(a);
                   seek(a,filesize(a));
                   write(a,req);
                   close(a)
           end;
          gotoxy(1,25);
          write(\'¨Ingresar otro equipo? (s/n)\');
          s := valida_s_n(readkey)
     until (s=\'N\')
     else if s=\'J\' then
     repeat
          clrscr;
          writeln(\'Alta jugadores\');
          write(\'ID del jugador: \');
          readln(rjug.idjugador);
          p:= buscarjug(b,rjug.idjugador);
          if p<> -1 then
             write(\'El ID ya existe\')
          else
          begin
                   write(\'ID de su equipo: \');
                   readln(rjug.idequipo);
                   if buscareq(a,rjug.idequipo) = -1 then
                      write(\'El equipo no existe\')
                   else
                   begin
                        write(\'Nombre y apellido: \');
                        readln(rjug.nomyap);
                        write(\'Fecha nacimiento: \');
                        readln(rjug.fechanac);
                        rjug.baja:=false;
                        reset(b);
                        seek(b,filesize(b));
                        write(b,rjug);
                        close(b)
                   end
          end;
          gotoxy(1,25);
          write(\'¨Ingresar otro jugador? (s/n)\');
          s := valida_s_n(readkey)
     until (s=\'N\')
     else if s=\'R\' then
     repeat
          clrscr;
          writeln(\'Alta records\');
          write(\'ID del record: \');
          readln(rrec.idrecord);
          p:= buscarrec(c,rrec.idrecord);
          if p<> -1 then
             write(\'El ID ya existe\')
          else
          begin
                   write(\'T¡tulo: \');
                   readln(rrec.titulo);
                   write(\'ID del jugador: \');
                   readln(rrec.idjugador);
                   if buscarjug(b,rrec.idjugador) = -1 then
                        write(\'El jugador no existe\')
                   else
                   begin
                        rrec.baja:=false;
                        reset(c);
                        seek(c,filesize(c));
                        write(c,rrec);
                        close(c)
                   end
          end;
          gotoxy(1,25);
          write(\'¨Ingresar otro record? (s/n)\');
          s := valida_s_n(readkey)
     until (s=\'N\')
  end;

procedure liberajugadores(var a:arch_jug; equipo:string);
var
   reg:reg_jugadores;
begin
     reset(a);
     while (not eof(a)) do
     begin
          read(a,reg);
          if (reg.idequipo=equipo) and (not reg.baja) then
          begin
               reg.idequipo := \'libres\';
               seek(a,filepos(a)-1);
               write(a,reg)
          end
     end;
     close(a)
end;

procedure eliminarecords(var a:arch_records; jug:string);
var
   reg:reg_records;
begin
     reset(a);
     while (not eof(a)) do
     begin
          read(a,reg);
          if (reg.idjugador = jug) and (not reg.baja) then
          begin
               reg.baja:= true;
               seek(a,filepos(a)-1);
               write(a,reg)
          end
     end;
     close(a)
end;

procedure baja (var a:arch_jug;var b:arch_eq;var c:arch_records);
var
   s:char;
   p,p2:integer;
   req:reg_equipos;
   rjug:reg_jugadores;
   rrec:reg_records;
begin
     clrscr;
     writeln(\'Dar de baja\');
     write(\'(E)quipos / (J)ugadores / (R)ecords\');
     s := valida_j_e_r(readkey);
     if s=\'E\' then
     begin
          repeat
                clrscr;
                write(\'ID del equipo a eliminar: \');
                readln(req.idequipo);
                if (req.idequipo <> \'libres\') then
                begin
                     p:= buscareq(b,req.idequipo);
                     if p=-1 then
                        write(\'El equipo no existe\')
                     else
                     begin
                          reset(b);
                          seek(b,p);
                          read(b,req);
                          writeln(\'Equipo: \',req.nombre);
                          writeln(\'DT: \',req.dt);
                          writeln;
                          writeln(\'Si elimina este equipo, sus jugadores ser n agentes libres\');
                          write(\'¨Eliminar? (s/n)\');
                          s := valida_s_n(readkey);
                          if s=\'S\' then
                          begin
                               liberajugadores(a,req.idequipo);
                               req.baja:=true;
                               seek(b,p);
                               write(b,req);
                               gotoxy(1,24);
                               writeln(\'Baja realizada\')
                          end
                          else
                          begin
                               gotoxy(1,24);
                               writeln(\'Baja cancelada\')
                          end;
                          close(b)
                     end
                end
                else
                begin
                     gotoxy(1,25);
                     write(\'Los agentes libres deben ser eliminados uno por uno\')
                end;
                gotoxy(1,25);
                write(\'¨Eliminar otro? (s/n)\');
                s := valida_s_n(readkey);
          until(s=\'N\')
     end
     else if s=\'J\' then
     begin
          repeat
                clrscr;
                write(\'ID del jugador a eliminar: \');
                readln(rjug.idjugador);
                p:= buscarjug(a,rjug.idjugador);
                if p=-1 then
                   write(\'El jugador no existe\')
                else
                begin
                     reset(a);
                     seek(a,p);
                     read(a,rjug);
                     writeln(\'Nombre: \',rjug.nomyap);
                     p2:=buscareq(b,rjug.idequipo);
                     reset(b);
                     seek(b,p2);
                     read(b,req);
                     close(b);
                     writeln(\'Equipo: \',req.nombre);
                     writeln(\'Fecha nacimiento: \',rjug.fechanac);
                     writeln;
                     if (rjug.idequipo= \'libres\') then
                     begin
                          write(\'¨Eliminar? (s/n)\');
                          s:= valida_s_n(readkey)
                     end
                     else
                     begin
                          write(\'(E)liminar / (L)iberar / (C)ancelar\');
                          s := valida_e_l_c(readkey)
                     end;
                     if s=\'E\' then
                     begin
                          rjug.baja:=true;
                          seek(a,p);
                          write(a,rjug);
                          eliminarecords(c,rjug.idjugador);
                          gotoxy(1,24);
                          writeln(\'Baja realizada\')
                     end
                     else if (s=\'L\') then
                     begin
                          rjug.idequipo:=\'libres\';
                          seek(a,filepos(a)-1);
                          write(a,rjug);
                          eliminarecords(c,rjug.idjugador);
                          gotoxy(1,24);
                          write(\'El jugador es ahora agente libre\')
                     end
                     else
                     begin
                          gotoxy(1,24);
                          writeln(\'Baja cancelada\')
                     end;
                     close(a)
                end;
                gotoxy(1,25);
                write(\'¨Eliminar otro? (s/n)\');
                s := valida_s_n(readkey)
          until(s=\'N\')
     end
     else if (s=\'R\') then
     begin
          repeat
                clrscr;
                write(\'ID del record a eliminar: \');
                readln(rrec.idrecord);
                p:= buscarrec(c,rrec.idrecord);
                if p=-1 then
                   write(\'El record no existe\')
                else
                begin
                     reset(c);
                     seek(c,p);
                     read(c,rrec);
                     writeln(\'T¡tulo: \',rrec.titulo);
                     p2:=buscarjug(a,rrec.idjugador);
                     reset(a);
                     seek(a,p2);
                     read(a,rjug);
                     close(a);
                     writeln(\'Jugador: \',rjug.nomyap);
                     p2:=buscareq(b,rjug.idequipo);
                     reset(b);
                     seek(b,p2);
                     read(b,req);
                     close(b);
                     writeln(\'Equipo: \',req.nombre);
                     writeln;
                     write(\'¨Eliminar? (s/n)\');
                     s := valida_s_n(readkey);
                     if s=\'S\' then
                        begin
                             rrec.baja:=true;
                             seek(c,p);
                             write(c,rrec);
                             gotoxy(1,24);
                             writeln(\'Baja realizada\')
                        end
                        else
                        begin
                             gotoxy(1,24);
                             writeln(\'Baja cancelada\')
                        end;
                        close(c)
                end;
                gotoxy(1,25);
                write(\'¨Eliminar otro? (s/n)\');
                s := valida_s_n(readkey)
          until (s=\'N\')
     end
end;

procedure modificar(var a:arch_jug; var b:arch_eq; var c:arch_records);
var
   req: reg_equipos;
   rjug: reg_jugadores;
   rrec: reg_records;
   s: char;
   p: integer;
begin
     clrscr;
     writeln(\'Modificar\');
     write(\'(J)ugadores / (E)quipos / (R)ecords\');
     s := valida_j_e_r(readkey);
     if s=\'J\' then
     begin
       repeat
          clrscr;
          writeln(\'Modificar jugadores\');
          write(\'ID del jugador: \');
          readln(rjug.idjugador);
          p:= buscarjug(a,rjug.idjugador);
          if p=-1 then
             write(\'El jugador no existe\')
          else
          begin
               write(\'ID de su equipo: \');
               readln(rjug.idequipo);
               p:=buscareq(b,rjug.idequipo);
               if p=-1 then
                  write(\'El equipo no existe\')
               else
               begin
                    write(\'Nombre y apellido: \');
                    readln(rjug.nomyap);
                    write(\'Fecha nacimiento: \');
                    readln(rjug.fechanac);
                    rjug.baja:=false;
                    reset(a);
                    seek(a,p);
                    write(a,rjug);
                    close(a)
               end
          end;
          gotoxy(1,25);
          write(\'¨Modificar otro jugador? (s/n)\');
          s := valida_s_n(readkey);
       until (s=\'N\')
     end
     else if s=\'E\' then
     begin
       repeat
          clrscr;
          writeln(\'Modificar equipos\');
          write(\'ID del equipo: \');
          readln(req.idequipo);
          p:= buscareq(b,req.idequipo);
          if p=-1 then
             write(\'El equipo no existe\')
          else
          begin
               write(\'Nombre: \');
               readln(req.nombre);
               write(\'DT: \');
               readln(req.dt);
               req.baja:=false;
               reset(b);
               seek(b,p);
               write(b,req);
               close(b)
          end;
          gotoxy(1,25);
          write(\'Modificar otro equipo? (s/n)\');
          s := valida_s_n(readkey);
       until (s=\'N\')
     end
     else if s=\'R\' then
     begin
       repeat
          clrscr;
          writeln(\'Modificar records\');
          write(\'ID del record: \');
          readln(rrec.idrecord);
          p:= buscarrec(c,rrec.idrecord);
          if p=-1 then
             write(\'El record no existe\')
          else
          begin
               write(\'T¡tulo: \');
               readln(rrec.titulo);
               write(\'ID del jugador: \');
               readln(rrec.idjugador);
               if buscarjug(a,rrec.idjugador) = -1 then
                  write(\'El jugador no existe\')
               else
               begin
                    rrec.baja:=false;
                    reset(c);
                    seek(c,p);
                    write(c,rrec);
                    close(c)
               end
          end;
          gotoxy(1,25);
          write(\'¨Modificar otro record? (s/n)\');
          s := valida_s_n(readkey)
       until (s=\'N\')
     end
end;

procedure listar(var a:arch_eq; var b:arch_jug; var c:arch_records);
var
   req: reg_equipos;
   rjug: reg_jugadores;
   rrec: reg_records;
   p,i,cuantos: integer;
   s: char;
begin
     repeat
           cuantos:=0;
           clrscr;
           writeln(\'Listar\');
           write(\'(E)quipos / (J)ugadores / (R)ecords\');
           s := valida_j_e_r(readkey);
           if s= \'E\' then
           begin
                clrscr;
                reset(a);
                while (not eof(a)) do
                if cuantos < 7 then
                begin
                     read(a,req);
                     if (not req.baja) then
                     begin
                          cuantos:= cuantos +1;
                          writeln(\'ID del equipo: \',req.idequipo);
                          writeln(\'Equipo: \',req.nombre);
                          writeln(\'DT: \',req.dt);
                          for i:= 1 to 80 do
                              write(\'-\')
                     end
                end
                else
                begin
                     gotoxy(1,25);
                     write(\'Presione una tecla para continuar\');
                     readkey;
                     cuantos:=0
                end;
                close(a);
           end
           else if s= \'J\' then
           begin
                clrscr;
                reset(b);
                while (not eof(b)) do
                if cuantos < 5 then
                begin
                     read(b,rjug);
                     if (not rjug.baja) then
                     begin
                          cuantos:= cuantos +1;
                          writeln(\'ID del jugador: \',rjug.idjugador);
                          writeln(\'Nombre y apellido: \',rjug.nomyap);
                          p:=buscareq(a,rjug.idequipo);
                          reset(a);
                          seek(a,p);
                          read(a,req);
                          close(a);
                          writeln(\'Equipo: \',req.nombre);
                          writeln(\'Fecha nacimiento: \',rjug.fechanac);
                          for i:= 1 to 80 do
                              write(\'-\')
                     end
                end
                else
                begin
                     gotoxy(1,25);
                     write(\'Presione una tecla para continuar\');
                     readkey;
                     cuantos:=0
                end;
                close(b)
           end
           else if s= \'R\' then
           begin
                clrscr;
                reset(c);
                while (not eof(c)) do
                if cuantos < 5 then
                begin
                     read(c,rrec);
                     if (not rrec.baja) then
                     begin
                          cuantos:= cuantos +1;
                          writeln(\'ID del record: \',rrec.idrecord);
                          writeln(\'T¡tulo: \',rrec.titulo);
                          p:= buscarjug(b,rrec.idjugador);
                          reset(b);
                          seek(b,p);
                          read(b,rjug);
                          close(b);
                          writeln(\'Jugador: \',rjug.nomyap);
                          p:= buscareq(a,rjug.idequipo);
                          reset(a);
                          seek(a,p);
                          read(a,req);
                          close(a);
                          writeln(\'Equipo: \',req.nombre);
                          for i:= 1 to 80 do
                              write(\'-\')
                     end;
                end
                else
                begin
                     gotoxy(1,25);
                     write(\'Presione una tecla para continuar\');
                     readkey;
                     cuantos:=0
                end;
                close(c)
           end;
           gotoxy(1,25);
           write(\'¨Desea listar algo m s? (s/n)\');
           s := valida_s_n(readkey);
     until (s = \'N\')
end;

begin {PP}
      abrir(a_j,a_e,a_r);
      crea_libres(a_e);
      repeat
            clrscr;
            writeln(\'¨Qu‚ desea hacer?\');
            write(\'(A)ltas / (B)ajas / (M)odificaciones / (L)istados / (S)alir\');
            s := valida_a_b_m_l_s(readkey);
            if s =\'A\' then
               alta(a_e,a_j,a_r)
            else if s=\'B\' then
                 baja(a_j,a_e,a_r)
            else if s =\'M\' then
                 modificar(a_j,a_e,a_r)
            else if s=\'L\' then
                 listar(a_e,a_j,a_r)
      until (s=\'S\')
end.

Utilidades

	Leer comentarios (2)
	Escribir comentario
	Puntuación: No disponible
	Votar
	Recomendar este código
	Estadísticas

Patrocinados

Hospedaje web y servidores dedicados linux por Ferca Network