---------------------------------------------------------------- -- Cours : INF2110 -- Auteur : Normand Seguin, Guillaume Huet -- Date : Janvier 2004 -- Sujet : Exemple de manipulation de fichier direct_io ---------------------------------------------------------------- With Direct_IO; -- Entree-sortie fichier direct With Text_IO; Procedure ExFicDir IS -- Instanciation des modules generiques Package ES_Entiers is New Text_IO.Integer_IO (Num => Integer); Package ES_Reels is New Text_IO.Float_IO (Num => Float); -- Declarations des constantes Version : Constant String(1..10) := "20/01/2004"; -- Declarations des types Type T_Produit IS Record -- Enregistrement de produit Code : Natural; -- Code du produit Prix : Float; -- Prix du produit Qte : Natural; -- Quantite en stock End Record; -- transmettre au module generique Sequential_IO la structure de l'element du fichier Package Es_Produits Is New Direct_IO (Element_Type => T_Produit); -- Declarations des variables Choix : Character; -- Reponse de l'utilisateur Fic_Erreur : Boolean; -- Indicateur de succes sur l'ouverture ou creation du fichier FicProduits : Es_Produits.File_Type; -- Lien logique avec le fichier Fin_Traitement : Boolean; -- Marque la fin du mode ajout de produit Interruption : Exception; -- Exception afin de terminer le programme promtement Un_Produit : T_Produit; -- Une variable permettant de contenir un produit ------------------------------------------------------------------ -- *** Fonction utilitaire pour lire un entier *** FUNCTION LireEntier(invite : String; min : Integer; max : Integer) RETURN Integer IS entier : Integer; ok : Boolean; BEGIN LOOP ok := True; BEGIN Text_IO.Put(invite & " : "); Es_Entiers.Get(entier); EXCEPTION WHEN OTHERS => ok := False; END; Text_IO.Skip_Line; EXIT WHEN ok AND entier IN min..max; Text_IO.Put("Erreur, le nombre entre doit etre entre"); Es_Entiers.Put(min); Text_IO.Put(" et "); Es_Entiers.Put(max); Text_IO.New_Line; END LOOP; RETURN entier; END LireEntier; -- *** Fonction utilitaire pour lire un réel *** FUNCTION LireReel(invite : String; min : Float; max : Float) RETURN Float IS reel : Float; ok : Boolean; BEGIN LOOP ok := True; BEGIN Text_IO.Put(invite & " : "); Es_Reels.Get(reel); EXCEPTION WHEN OTHERS => ok := False; END; Text_IO.Skip_Line; EXIT WHEN ok AND reel IN min..max; Text_IO.Put("Erreur, le nombre entre doit etre entre"); Es_Reels.Put(min, 1, 2, 0); Text_IO.Put(" et "); Es_Reels.Put(max, 1, 2, 0); Text_IO.New_Line; END LOOP; RETURN reel; END LireReel; Function Majuscule (Caractere : In Character) Return Character IS -- Conversion en majuscule du caractere parametre Begin If Caractere In 'a'..'z' Then Return character'Val (Character'Pos(caractere) - 32); Else Return Caractere; End If; End Majuscule; ------------------------------------------------------------------ Procedure Message_Erreur (Numero : in Natural) is Begin Case Numero is When 10 => Text_IO.Put_Line ("choix non-valide . . ."); When 11 => Text_IO.Put_Line ("Impossible de creer le fichier Produits.dat . . ."); When others => Text_IO.Put_Line ("erreur indefinie . . ."); End Case; End Message_Erreur; ------------------------------------------------------------------ Procedure Lire_Info_Produits (Un_Produit : Out T_Produit; -- un enregistrement de produit Fin_Ajout : Out Boolean) IS -- si code produit = 0 -- Lecture des informations sur les produits au clavier -- aucune validation de faite pour cet exemple Code_Tmp : Integer; -- Variable locale pour la lecture du code produit Begin Fin_Ajout := False; Text_IO.New_Line; Text_io.Put_Line ("option "); Text_IO.New_Line; -- Text_IO.Put ("Entrer le code du produit (0 pour terminer) : "); -- Es_Entiers.Get (Code_Tmp); -- Text_io.Skip_line; Code_tmp := LireEntier("Entrer le code du produit (0 pour terminer)", 0, Integer'Last); -- *** Lire le code du produit *** If Code_Tmp <= 0 -- Verifier si on arrete de lire Then Fin_Ajout := True; Text_IO.Put_Line ("Fin de l'entree des produits"); Else Un_Produit.Code := Code_Tmp; --Text_IO.Put ("Entrer le prix du produit : "); --Es_Reels.Get (Un_Produit.Prix); --Text_io.Skip_line; Un_Produit.Prix := LireReel("Entrer le prix du produit", 0.0, Float'Last); -- *** Lire le prix *** --Text_IO.Put ("Entrer la quantite du produit : "); --Es_Entiers.Get (Un_Produit.Qte); --Text_io.Skip_line; Un_produit.Qte := LireEntier("Entrer la qte du produit", 0, Integer'Last); -- *** Lire la qte du produit *** End If; Text_IO.New_Line; End Lire_Info_Produits; --------------------------------------------------------- Procedure Afficher_Produit (Num_Rec : In Natural; Un_Produit : in T_Produit) IS -- afficher les informations sur chacun des produits Begin Es_Entiers.Put (Num_Rec,2); Text_IO.Set_Col (10); Es_Entiers.Put (Un_Produit.Code,4); Text_IO.Set_Col (22); Es_Reels.Put (Un_Produit.Prix,4,2,0); Text_IO.Put ('$'); Text_IO.Set_Col (33); Es_Entiers.Put (Un_Produit.Qte,4); Text_IO.New_Line; End Afficher_Produit; ---------------------------------------------------------------------- Procedure Creer_Fichier (File : In Out Es_Produits.File_Type; Mode : In Es_Produits.File_Mode; Name : In String; Erreur : Out Boolean) Is Begin Erreur := False; -- *** Plante avec un constraint_error lorsqu'on initialise pas la variable OUT *** Es_Produits.Create (File, Mode, Name ); Text_IO.Put_Line ("Creation d'un nouveau fichier produits. . ."); Exception When Es_Produits.Name_Error => Erreur := True; -- retourner une erreur End Creer_Fichier; ---------------------------------------------------------------------- Procedure Ouvrir_Fichier (File : In Out Es_Produits.File_Type; Mode : In Es_Produits.File_Mode; Name : In String; Erreur : Out Boolean) Is Begin Erreur := False; Es_Produits.Open (File, Mode, Name); Text_IO.Put_Line ("Ouverture du fichier produits . . ."); Exception -- s'il n'existe pas tenter d'en creer un nouveau When Es_Produits.Name_Error => Creer_Fichier (File, Mode, Name, Erreur); End Ouvrir_Fichier; ---------------------------------------------------------------------- Procedure Lister_Produits (FicProduits : In Out Es_Produits.File_Type) Is Num_Rec : Natural; -- Numero de l'enregistrement du produit dans le fichier Un_Produit : T_Produit; -- Une variable permettant de contenir un produit Begin Text_IO.New_Line (2); Text_IO.Put_Line ("Lister les informations sur les produits"); Text_IO.New_Line; Es_Produits.Reset (File => FicProduits); -- se repositionner au debut du fichier Text_IO.Put_Line ("No. Code produit Prix Quantite"); -- Afficher entete While Not Es_Produits.End_Of_File (FicProduits) Loop Num_Rec := Integer(Es_Produits.index (FicProduits)); -- aller chercher le numero de l'enregistrement courant Es_Produits.Read (FicProduits,Un_Produit); -- Lecture des enregistrements produits Afficher_Produit (Num_Rec,Un_Produit); -- Afficher l'information a l'ecran End Loop; End Lister_Produits; ---------------------------------------------------------------------- Procedure Ajouter_Produits (FicProduits : In Out Es_Produits.File_Type) Is Fin_Ajout : Boolean; Nb_Produits: Natural; Num_Rec : Es_Produits.Positive_Count; -- une variable du type du numero d'enregistrement Un_Produit : T_Produit; -- Une variable permettant de contenir un produit Begin Loop Lire_Info_Produits (Un_Produit,Fin_Ajout); -- lire les infos au clavier If Not Fin_Ajout Then Text_IO.Put_Line ("Ecriture du produit dans le fichier"); Nb_Produits := Integer(Es_Produits.Size (FicProduits)); If Nb_Produits = 0 Then Text_IO.Put_LIne (" "); Es_Produits.Write (FicProduits,Un_Produit); -- Ecriture du 1er record au debut Else Nb_Produits := Nb_Produits + 1; Num_Rec := Es_Produits.Positive_Count(Nb_Produits); Text_IO.Put ("enregistrer le produit a la position : "); -- afficher une trace Es_Entiers.Put (Integer(Num_Rec),3); -- numero de l'index Text_IO.New_Line; Es_Produits.Write (FicProduits,Un_Produit,Num_Rec); -- Ecriture du record a la position Num_Rec End If; Else Exit; End If; End Loop; End Ajouter_Produits; ---------------------------------------------------------------------- Procedure Afficher_Menu Is Begin Text_IO.New_line (2); Text_IO.Put_Line (" Menu principal"); Text_IO.New_line (2); Text_IO.Put_Line (" A -> Ajouter des produits"); Text_IO.Put_Line (" L -> Lister les produits"); Text_IO.Put_Line (" C -> Consulter un produit"); -- *** Le nouvel item dans le menu *** Text_IO.New_line; Text_IO.Put_Line (" Q -> Quitter"); Text_IO.New_line (2); End Afficher_Menu; ---------------------------------------------------------------------- Procedure Lire_Choix (Choix : Out Character) Is -- Lecture et validation du choix de menu Begin Loop Text_IO.Put ("entrer votre choix : "); Text_IO.Get (Choix); Text_IO.Skip_line; Choix := Majuscule (Choix); Case Choix Is When 'A'|'L'|'Q'|'C' => Exit; -- *** Considérer le nouvel item 'C' comme un choix valide *** When Others => Text_IO.Put (Ascii.Bel); Message_Erreur (10); End Case; End Loop; End Lire_Choix; ---------------------------------------------------------------------- -- *** Consulter un produit en particulier *** PROCEDURE Consulter_Produit(FicProduits : IN Es_Produits.File_Type) IS -- *** Nouvelle fonction qui permet de consulter un produit *** noProd : Integer; nbProd : Natural; prod : T_Produit; BEGIN -- Afficher le nombre de produits dans le fichier nbProd := Natural(Es_Produits.Size(FicProduits)); Text_IO.Put("Presentement "); Es_Entiers.Put(nbProd); Text_IO.Put_Line(" produits dans le fichier."); IF nbProd > 0 THEN -- Lire no produit noProd := LireEntier("No produit a consulter (0 pour annuler)", 0, nbProd); IF noProd > 0 THEN -- Placer le filepointer au produit désiré -- ex : si noProd vaut 3, le filepointer sera placé au début du 3e enregistrement dans le fichier Es_Produits.Set_Index(FicProduits, Es_Produits.Positive_Count(noProd)); -- Lire le produit Es_Produits.Read(FicProduits, prod); -- Afficher le produit Text_IO.New_Line(2); Text_IO.Put_Line ("No. Code produit Prix Quantite"); -- Afficher entete Afficher_Produit(noProd, prod); END IF; END IF; END Consulter_Produit; ---------------------------------------------------------------------- ---------------------------------------------------------------------- Begin Text_IO.Put_Line ("E X F I C D I R - Universite du Quebec a Montreal"); Text_IO.Put_Line (" Exemple fichier acces direct"); Text_IO.Put (" Version du "); Text_IO.Put_Line (Version); Text_IO.New_Line (2); -- Verifier si un fichier produits existe deja Ouvrir_Fichier (File => FicProduits, -- Lien logique du fichier Mode => Es_Produits.InOut_File, -- Mode lecture/ecriture Name => "Produits.dat", -- Nom du fichier (dos) Erreur=> Fic_Erreur); -- Erreur d'ouverture If Fic_Erreur -- si erreur, le fichier n'existe pas Then Text_IO.New_Line; Message_Erreur (11); Raise interruption; End If; Fin_Traitement := False; While Not Fin_Traitement Loop Afficher_Menu; -- Afficher le menu Lire_Choix (Choix); -- Lire le choix Case Choix Is When 'A' => Ajouter_Produits (FicProduits); When 'L' => Lister_Produits (FicProduits); When 'C' => Consulter_Produit(FicProduits); -- *** Ajouter le traitement du choix 'C' dans le menu *** When 'Q' => Fin_Traitement := True; When Others => Raise Interruption; End Case; End Loop; -- Fermeture du fichier Es_Produits.Close (File => FicProduits); End ExFicDir;