Bonjour chers Ada Programmeurs.

Suite à une petite formation sur OpenClassroom, je suis sorti avec ce petit programme qui simule le fonctionnement d'un logiciel de gestion de ressources.

Code:

Maktaba_Types.ads

quote: with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Strings.Unbounded, Ada.Directories, Ada.Sequential_IO; use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Strings.Unbounded, Ada.Directories; package Maktaba_Types is   -----------------   -- CONSTANTES ---   -----------------       TAILLE_TITRE : Constant := 33;   TAILLE_NOM_AUTEUR_DIVERS : Constant := 23;   --HOME_PATH : constant Unbounded_String := To_Unbounded_String(Current_Directory);   -------------------------------------   -- DECLARATION DES TYPES COMPOSITES--   -------------------------------------   type T_oeuvre;   type T_categorie;   type T_support;   type T_grade;     type T_categorie is (LIVRE, FILM, JEU, ALBUM, DEVICE, LAPTOP, DESKTOP, PRINTER, MOBILE);   type T_support is (PAPIER, CD, DVD, VHS, BLURAY, MACHINE);   type T_grade is (A, B, C);   type t_Morceaux is array(integer range 1..TAILLE_NOM_AUTEUR_DIVERS) of string(1..TAILLE_NOM_AUTEUR_DIVERS);       -- parametrage de l'oeuvre   --Polymorphisme de type avec un discrimant   type T_oeuvre(categorie : T_categorie := LIVRE) is      record         titre : string(1..TAILLE_TITRE);         --categorie etant défini par défaut pour un livre pas besoin d'une composante         grade : T_grade;         support : T_support := PAPIER;         --date : T_date;         case categorie is            when LIVRE =>               auteur : string(1..TAILLE_NOM_AUTEUR_DIVERS);               editeur : string(1..TAILLE_NOM_AUTEUR_DIVERS);               ISBN : string(1..TAILLE_NOM_AUTEUR_DIVERS);            when FILM =>               realisateur : string(1..TAILLE_NOM_AUTEUR_DIVERS);               si_VF : Boolean := True;            when JEU =>               console : String(1..TAILLE_NOM_AUTEUR_DIVERS);               status : Boolean := False;            when ALBUM =>               artiste_nom : string(1..TAILLE_NOM_AUTEUR_DIVERS);               --Morceaux : t_Morceaux;                                               -- parametrage d'un équipement            when LAPTOP | DESKTOP =>               taille_ecran : string(1..TAILLE_NOM_AUTEUR_DIVERS);               processeur : string(1..TAILLE_NOM_AUTEUR_DIVERS);               RAM : string(1..TAILLE_NOM_AUTEUR_DIVERS);               stockage : String(1..TAILLE_NOM_AUTEUR_DIVERS);               OS : String(1..TAILLE_NOM_AUTEUR_DIVERS);            when PRINTER =>               format : string(1..TAILLE_NOM_AUTEUR_DIVERS);               RAM_printer : string(1..TAILLE_NOM_AUTEUR_DIVERS);               resolution : string(1..TAILLE_NOM_AUTEUR_DIVERS);               vitesse : string(1..TAILLE_NOM_AUTEUR_DIVERS);               dimension : string(1..TAILLE_NOM_AUTEUR_DIVERS);               poids : string(1..TAILLE_NOM_AUTEUR_DIVERS);            when MOBILE =>               Modele : string(1..TAILLE_NOM_AUTEUR_DIVERS);               ecran : string(1..TAILLE_NOM_AUTEUR_DIVERS);               ram_mobile : string(1..TAILLE_NOM_AUTEUR_DIVERS);               connectivite : string(1..TAILLE_NOM_AUTEUR_DIVERS);            when others =>               null;         end case;                end record;     ---------------------------------------------------------------------   --- Package enumerate pour visibilité sur les types composites ---   ---------------------------------------------------------------------     package categorie_io is new Enumeration_IO(T_categorie);   package grade_io is new Enumeration_IO(T_grade);   package support_io is new Enumeration_IO(T_support);   package File_seq is new Ada.Sequential_IO(T_oeuvre);     -----------------------------------------   -- clause d'accès aux types composites --   ------------------------------------------   use categorie_io;   use support_io;   use grade_io;   use File_seq;     ---------------------------------------   -- Types Composites secondaires      --   -- type de fichier à accès sequentiel -   ---------------------------------------   type File_Oeuvre is new File_seq.File_Type;       end Maktaba_Types;

Maktaba_Functions.ads

quote: with Maktaba_Types, Ada.Text_IO; use Maktaba_Types, Ada.Text_IO; package Maktaba_functions is     ---------------------   -- SPECIFICATIONS ---   ---------------------   function Check_Oeuvre(O : T_oeuvre) return Boolean;   function Create_Oeuvre(categorie : T_categorie) return T_oeuvre;   function get_text(taille : natural) return string;   function Get_categorie return T_categorie;   procedure Affiche_Manuel;  -- procedure Lire(fichier : In File_type);   procedure Create_Manual(fichier : Out File_Type);   procedure Affiche_oeuvre(O : T_oeuvre);   Procedure MENU;   Procedure Main;     end Maktaba_functions;

Suite du programme

Maktaba_Functions.adb

quote: with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Strings.Unbounded,Ada.Characters.Handling, Ada.Directories, Maktaba_Types, Maktaba_Functions_DB; use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Strings.Unbounded,Ada.Characters.Handling, Ada.Directories, Maktaba_Types, Maktaba_Functions_DB; package body Maktaba_functions is         --------------------------   -- FONCTIONS DE SAISIE ---   ---------------------------     ----------------------------------------------   -- FONCTION QUI PERMET DE SAISIR DU TEXTE ----   -- FOCNTION CLEE                            --   -----------------------------------------------       function get_text(taille : natural) return string is      long: Natural;      nom1 : string(1..taille) := (others => ' ');      tmp : Unbounded_String := Null_unbounded_string;   begin      put("  >");      tmp := To_Unbounded_string(get_line);new_line;      long := length(tmp);              if long > taille then           nom1 := To_string(tmp)(1..taille);      else         --- Au dela de la taille par défaut on affiche pas le reste         nom1(1..long) := To_string(tmp);         for i in long+1..taille loop            nom1(i) := ' ';         end loop;      end if;            return nom1;           end get_text;        ----------------------------------------------   -- FONCTION QUI PERMET DE CREER UNE OEUVRE ----   -----------------------------------------------   function Create_Oeuvre(categorie : T_categorie) return T_oeuvre is      O : T_oeuvre(categorie);      choix : String(1..TAILLE_NOM_AUTEUR_DIVERS);      choix2 : Character;      note : Character;   begin      Set_Col(10);Put_Line("  ************** ENREGISTREMENT DE "&T_categorie'image(categorie)&" ****************** ");New_Line;            -- Enrégistrement du titre --------      put("  TITRE: ");O.titre := get_text(TAILLE_TITRE);            -- Enrégistrement de la note --------      Set_Col(10);Put_Line("  Quel note donneriez-vous ? ( A / B / C )");      loop         new_line;         Put("  >");Get_Immediate(note);skip_line;         note := To_Upper(note);         new_line;         case note is            when 'A' =>               O.grade := A; Exit;               when 'B' =>               O.grade := B; Exit;               when 'C' =>               O.grade := C; exit;               when others =>               Set_Col(10);Put_Line("  [Error] .......grade inconnu");Exit;         end case;      end loop;            -------- Enrégistrement du support ---------------------      Set_Col(10);Put_Line("  Sur quel support l'oeuvre est-elle enrégistrée ? ");      new_line;      for i in T_support'range loop         Set_Col(10);put("  | ");put(T_support'Image(T_support(i)));      end loop;            loop         new_line;New_Line;         choix := get_text(TAILLE_NOM_AUTEUR_DIVERS);         choix := To_Upper(choix);New_Line;         case choix(1) is            when 'P' =>               O.support := PAPIER;Exit;            when 'C' =>               O.support := CD;exit;            when 'D' =>               O.support := DVD;exit;            when 'V' =>               O.support := VHS;exit;            when 'B' =>               O.support := BLURAY;exit;               when 'M' =>               O.support := MACHINE;exit;            when others =>               Set_Col(10);Put_Line("  [Error] ........Support inconnu ");         end case;         New_Line;      end loop;                  --- POLYMORPHISME DU TYPE OEUVRE --------      case Categorie is         when LIVRE =>            Put("  AUTEUR: ");O.auteur := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  EDITEUR: ");O.editeur := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  ISBN: ");O.ISBN := get_text(TAILLE_NOM_AUTEUR_DIVERS);                     when FILM =>            Put("  REALISATEUR: ");            O.realisateur := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Set_Col(10);Put_Line("  Le film est-il en Version francaise ? (O:Oui / N:Non)");            loop               new_line;               Put(">");Get_Immediate(choix2);skip_line;               choix2 := To_Upper(choix2);               case choix2 is                  when 'O' =>                     O.si_VF := true; Exit;                  when 'N' =>                     O.si_VF := False; Exit;                  when others =>                     O.si_VF := False;Exit;               end case;            end loop;                 when JEU =>            Put("  CONSOLE: ");O.console := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Set_Col(10);Put_Line("  Avez-vous fini le jeu ? (O:Oui / N:Non)");            loop               new_line;               Put(">");Get_Immediate(choix2);skip_line;               choix2 := To_Upper(choix2);               case choix2 is                  when 'O' =>                     O.status := true; Exit;                  when 'N' =>                     O.status := False; Exit;                  when others =>                     O.status := False;Exit;               end case;            end loop;         when ALBUM =>            Put("  ARTISTE: ");O.artiste_nom := get_text(TAILLE_NOM_AUTEUR_DIVERS);            --Morceaux : t_Morceaux;         when DEVICE =>            null;         when LAPTOP | DESKTOP =>            Put("  TAILLE ECRAN: "); O.taille_ecran := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  PROCESSEUR: "); O.processeur := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  RAM: ");O.RAM := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  STOCKAGE: ");O.stockage := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  OS: ");O.OS := get_text(TAILLE_NOM_AUTEUR_DIVERS);                     when PRINTER =>            Put("  FORMAT: ");O.format := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  RAM PRINTER: ");O.RAM_printer := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  RESOLUTION: ");O.resolution := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  VITESSE: ");O.vitesse := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  Lxl ");O.dimension := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  POIDS(kg) : ");O.poids := get_text(TAILLE_NOM_AUTEUR_DIVERS);                     when MOBILE =>            Put("  MODELE: ");O.Modele := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  TAILLE ECRAN: "); O.ecran := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  RAM MOBILE: ");O.ram_mobile := get_text(TAILLE_NOM_AUTEUR_DIVERS);            Put("  CONNECTIVITE: ");O.connectivite := get_text(TAILLE_NOM_AUTEUR_DIVERS);                 when others =>            Set_Col(10);Put_Line("  [Error] .......Categorie inconnue");      end case;      new_line;      return O;   end Create_Oeuvre;     -------------------   --- PROCEDURES ----   -------------------     procedure Create_Manual(fichier : Out File_Type) is         begin      Put_Line(fichier, " ************************************************************");      Put_line(fichier, "| Auteur : BINYOUM BAYEMI JOSEPH                            |");      Put_Line(fichier, "| Description: Logiciel de gestion de ressources diverses   |");      Put_Line(fichier, "| Licence: GPL sous reserves d'accords communs.             |");      Put_Line(fichier, "|                                                           |");      Put_Line(fichier, " ************************************************************");            Put_Line(fichier, " ");Put_Line(fichier, " ");Put_Line(fichier, "");      Put_Line(fichier, " Commandes de base: ");      Put_Line(fichier, "");      Put_Line(fichier, " Manual      |   Pour lire le manuel");      Put_Line(fichier, " Print       |   Pour afficher une base de donnée ");      Put_Line(fichier, " New         |   Pour créer une nouvelle ressource");      Put_Line(fichier, " Delete      |   Pour supprimer ");      Put_Line(fichier, " ");Put_Line(fichier, " ");Put_Line(fichier, "");      Put_Line(fichier, " ");Put_Line(fichier, " ");Put_Line(fichier, "");      Put_Line(fichier, " ");Put_Line(fichier, " ");Put_Line(fichier, "");      Put_Line(fichier, " **************************");      Put_Line(fichier, " Enjoy the experience (:0)");      Put_Line(fichier, " ");Put_Line(fichier, "");         end Create_Manual;       procedure Affiche_Manuel is      fichier : File_type;      Home : Unbounded_String := Null_Unbounded_String;     begin      home := To_Unbounded_String(Current_Directory);      If Exists("DATA") then         Set_Directory(To_String(Home)&"/"&"DATA");         if Exists("MANUEL.txt") then            Open(fichier, In_File, "MANUEL.txt");            while not End_Of_File(fichier) loop               put_Line(get_line(fichier));            end loop;            Close(fichier);         else            Set_Col(10);            Put_Line("  Le manuel d'utilisation n'existe pas..");            Set_Col(10);            Put_Line("  Creation d'un nouveau fichier MANUEL ...");            Create(fichier, Out_File, "MANUEL.txt");            Create_Manual(fichier);            close(fichier);                      -- Affichage du manuel  apres création ---                          New_Line;New_Line;New_Line;New_Line;            Open(fichier, In_File, "MANUEL.txt");            while not End_Of_File(fichier) loop               put_Line(get_line(fichier));            end loop;            Close(fichier);           end if;      else         Set_Col(10);         Put_Line("  Le dossier de sauvegarde n'existe pas encore.");         Set_Col(10);         Put_Line("  Creation d'un nouveau dossier 'DATA' ");         Create_Directory("DATA");         Set_Directory(To_String(Home)&"/"&"DATA");         --Ensuite d'un nouveau fichier manuel         Set_Col(10);         Put_Line("  Creation d'un nouveau fichier MANUEL ...");         Create(fichier, Out_File, "MANUEL.txt");         Create_Manual(fichier);         close(fichier);         Set_Col(10);Put_Line("  MANUEL cree avec succes .....");      end if;            Set_Directory(To_String(home));      New_Line;New_Line;New_Line;New_Line;   end Affiche_Manuel;     ------------------------------------------------------------------------   --- affiche toutes les categorie d'oeuvre qu'il est possible de créer ---   --  ensuite l'utilisateur fait un choix ---------------------------------   -------------------------------------------------------------------------     procedure Affiche_oeuvre(O : T_oeuvre) is       begin            New_Line;New_Line;      Set_Col(10);Put_Line("  *********** OEUVRE ENREGISTREE ********

Maktaba_Functions_DB.ads

quote: with Maktaba_Types; use Maktaba_Types; package Maktaba_Functions_DB is   ---------------------   -- SPECIFICATIONS ---   ---------------------     --function Search_Oeuvre(O : T_oeuvre) return Boolean;   procedure Search_Oeuvre(cat : T_categorie);   procedure save_Oeuvre( O : T_oeuvre);   procedure Edit_DB;   procedure System_Check_Up(O : T_oeuvre); end Maktaba_Functions_DB;

Maktaba_Functions_DB.adb

quote: with Ada.Text_IO, Ada.Integer_Text_IO, Ada.Strings.Unbounded,Ada.Characters.Handling, Ada.Directories, Maktaba_Types, Maktaba_Functions; use Ada.Text_IO, Ada.Integer_Text_IO, Ada.Strings.Unbounded,Ada.Characters.Handling, Ada.Directories, Maktaba_Types, Maktaba_Functions; package body Maktaba_Functions_DB is     procedure Save_Oeuvre(O : T_oeuvre) is      file : File_Oeuvre;   begin            ---- PARTIE ENREGISTREMENT DE DONNEE -------------------      create(file, File_seq.Out_File, O.titre(1..10)&".bdd");      Set_Col(10);Put_Line("  Sauvegarde en cours.....");      Write(file, O);      close(file);      New_Line;      Set_Col(10);Put_Line("  "&T_categorie'image(O.categorie)&" ENREGISTRE(E) AVEC SUCCES....");      Set_Col(10);New_Line;New_Line;Set_Col(10);      Menu;   end Save_Oeuvre;       ------------------------------------------   -- Sous programme d'acces à la BD --   -----------------------------------------   procedure System_Check_Up(O : T_oeuvre ) is         -- Cette procedure doit effectuée des verifications dans l'ordre suivant :        folder : String(1..4) := "DATA";      Home : Unbounded_String := Null_Unbounded_String;      file : File_Oeuvre;         begin      Home := To_Unbounded_String(Current_Directory);      Set_Col(10);      Put(Current_Directory);      if Exists(folder) then                 ---- PARTIE MECANIQUE INTERNE CREATION / DEPLACEMENT             Set_Directory(folder);         if Exists(T_categorie'Image(O.categorie)) then                        ---- PARTIE MECANIQUE INTERNE CREATION / DEPLACEMENT            Set_Directory(T_categorie'Image(O.categorie));            Save_Oeuvre(O);         else                        ---- PARTIE MECANIQUE INTERNE CREATION / DEPLACEMENT            Create_Directory(T_categorie'Image(O.categorie));            Set_Directory(T_categorie'Image(O.categorie));            Save_Oeuvre(O);         end if;                     -- 2) Sinon le dossier "DATA" n'existe pas alors      else         ---- PARTIE MECANIQUE INTERNE CREATION / DEPLACEMENT         Create_Directory(folder);         Set_Directory(folder);         Set_Col(10);         Put("  Path: \"&Current_Directory);         if Exists(T_categorie'image(O.categorie)) then          Save_Oeuvre(O);         else             ---- PARTIE MECANIQUE INTERNE CREATION / DEPLACEMENT            Create_Directory(T_categorie'Image(O.categorie));            Set_Directory(T_categorie'Image(O.categorie));            save_Oeuvre(O);         end if;      end if;     end System_Check_Up;     ------------------------------------------   -- Sous programme d'écriture dans la BD --   -----------------------------------------     -------------------------------------------   -- Programme de recherche d'une oeuvre ----   -------------------------------------------     procedure Search_Oeuvre(cat : T_categorie) is          data, choix : String(1..TAILLE_NOM_AUTEUR_DIVERS);      home : Unbounded_String;      file : File_Oeuvre;      O : T_oeuvre(cat);      c : Character := 'N';   begin            --PARTIE CHANGEMENT DE REPERTOIRE      home := To_Unbounded_String(Current_Directory);        Set_Col(10);            Set_Directory(T_categorie'image(cat));      Put(Current_Directory);   New_Line;      --PARTIE RECHERCHE INFORMATION      Set_Col(10);put("  Quel est le titre de "&T_categorie'image(cat)&" que vous recherchez ?");New_Line;      new_line;      data := get_text(TAILLE_NOM_AUTEUR_DIVERS);New_Line;      Set_Col(10);Put("  Patienter je demande à G (:o) (:o) GLE..."); new_line;New_Line;            if Exists(data(1..10)&".bdd") then         Set_Col(10);Put_line("  Message: ce fichier existe...");New_Line;                 ---PARTIE LECTURE DU FICHIER         Open(file, File_seq.In_File, data(1..10)&".bdd");         while not End_Of_File(file) loop            Read(File, O);         end loop;         New_Line;         close(file);         Affiche_oeuvre(O);         Set_Col(10);Put_Line("  Faites:  ");New_Line;         Set_Col(10);Put_Line("  MODIFY    |  Pour Modifier l'oeuvre ");New_Line;         Set_Col(10);Put_Line("  DELETE    |  Pour supprimer l'oeuvre ");New_Line;         loop            choix := get_text(TAILLE_NOM_AUTEUR_DIVERS);            choix := To_Upper(choix);New_Line;                        --PARTIE MODIFICATION DE L'INFORMATION            if choix(1..6) = "MODIFY" then               Set_Col(10);               put("  Modification en attente");               exit;                          --PARTIE SUPPRESSION DE L'INFORMATION            elsif choix(1..6) = "DELETE" then               Set_Col(10);Put_Line("  Etes-vous sur de vouloir supprimer ? (Y:Yes / N:No) ");New_Line;                   put("  >");Get_Immediate(c);Skip_Line;               c := To_Upper(c);               case c is                  when 'Y' =>                     Delete_File(data(1..10)&".bdd");                     Set_Col(10);Put_Line("  Suppression terminée.... ");New_Line;                  when 'N' =>                     Set_Col(10);Put_Line("  Suppression annulée.... ");New_Line;exit;                     when others =>                     Set_Col(10);Put_Line("  Mauvais choix, suppression annulée.... ");New_Line;exit;               end case;               exit;                      end if;         end loop;        else         Set_Col(10);Put("  [Message] ce fichier n'existe pas...");New_Line;      end if;     end Search_Oeuvre;       ------------------------------------------   -- Sous programme d'écriture dans la BD --   -----------------------------------------     procedure Edit_DB is      cat : T_categorie;   begin        Set_Col(10);Put_Line("  Quel type d'oeuvre recherchez vous ? ");new_line;      cat := Get_categorie;      Search_Oeuvre(cat);New_Line;   end Edit_DB;   end Maktaba_Functions_DB;

Et enfin le programme principal

Maktaba.adb

quote: -------------------------------- --- PROCEDURE PRINCIPALE ------- -------------------------------- with Maktaba_Types, Maktaba_functions; use Maktaba_Types, Maktaba_functions; With Ada.Text_IO; use Ada.Text_IO; procedure Maktaba is begin   while True  loop      Main;   end loop; end Maktaba;