TP3/Resources/DESASS/COMMENTA.PAS

(* programme comment‚ et expliqu‚ dans le livre *)
(* LE DESASSEMBLEUR 8086 COLIBRI, publi‚ par    *)
(*           L'INSTITUT PASCAL:                 *)
(*      26 Rue Lamartine, 75009 PARIS           *)
(*           Tel: (1) 42.85.10.82               *)


(*$r+*)
program gestion_des_commentaires;
  type string2= string[2];
       string4= string[4];
       string64= string[64];
       string127= string[127];
       set_of_char= set of char;

       t_fiche= record
                  adresse: integer;
                  position_commentaire: char;
                  commentaire: string127;
                end;

  var choix, choix1: char;

      nom_fichier: string64;
      fiche: t_fiche;
      fichier: file of t_fiche;
      resultat_entree_sortie: byte;

  function f_octet_hexadecimal(p_octet: byte): string2;
    const kt_hexa: array[0..15] of char= '0123456789ABCDEF';
    begin
      f_octet_hexadecimal:= concat(kt_hexa[p_octet div 16],
                                      kt_hexa[p_octet mod 16]);
    end; 

  function f_entier_hexadecimal(p_entier: integer): string4;
    begin
      f_entier_hexadecimal:= concat(f_octet_hexadecimal(hi(p_entier)),
                                    f_octet_hexadecimal(lo(p_entier)));
    end; 

  function f_lis_commande(p_ensemble_ok: set_of_char): char;
    var l_touche: char;
    begin
      repeat
        read(kbd, l_touche);
        l_touche:= upcase(l_touche); write(l_touche);
      until l_touche in p_ensemble_ok;
      f_lis_commande:= l_touche;
    end; 

  function f_fichier_existe(p_nom_fichier: string64): boolean;
    begin
      assign(fichier, p_nom_fichier);
      (*$i-*)
      reset(fichier);
      (*$i+*)
      f_fichier_existe:= ioresult= 0;
      close(fichier);
    end; 

  procedure change_nom_fichier;
    begin
      write('nom <a:zones.dta> ? '); readln(nom_fichier);
    end; 

  procedure cree_fichier;
    begin
      if f_fichier_existe(nom_fichier)
        then begin
            writeln;
            write('le fichier existe d‚j…. D‚truire, Quitter ? ');
            if f_lis_commande(['D', 'Q'])<> 'D'
              then exit;
          end;

      assign(fichier, nom_fichier);
      rewrite(fichier);
      close(fichier);
    end; 

  procedure ouvre_fichier;
    begin
      assign(fichier, nom_fichier);
      (*$i-*)
      reset(fichier);
      (*$i+*)
      resultat_entree_sortie:= ioresult;
      if resultat_entree_sortie<> 0
        then writeln('le fichier ', nom_fichier, ' n''a pas ‚t‚ ouvert');
    end; 

  procedure affiche_fiche(p_numero, p_adresse: integer;
                          p_position_commentaire: char; p_commentaire: string127);
    begin
      write(p_numero: 5);
      write(' $', f_entier_hexadecimal(p_adresse));
      write(p_position_commentaire: 2, ' ');
      write(p_commentaire);
    end; 

  procedure liste_fichier;
    var l_numero_fiche: integer;
        l_dernier_numero: integer;
    begin
      ouvre_fichier;
      if resultat_entree_sortie<> 0
        then exit;

      repeat
        write('num‚ro d‚but <0> ? '); readln(l_numero_fiche);
      until (l_numero_fiche>= 0) and (l_numero_fiche< filesize(fichier));
      write('num‚ro fin  <', filesize(fichier), '> ? '); readln(l_dernier_numero);
      seek(fichier, l_numero_fiche);

      while not eof(fichier) and (l_numero_fiche<= l_dernier_numero) do
      begin
        read(fichier, fiche);

        with fiche do
          affiche_fiche(l_numero_fiche, adresse, position_commentaire, commentaire);
        writeln;

        l_numero_fiche:= l_numero_fiche+ 1;
      end;

      close(fichier);
    end; 

  procedure ajoute_fichier;
    begin
      ouvre_fichier;
      if resultat_entree_sortie<> 0
        then exit;

      seek(fichier, filesize(fichier));

      repeat
        writeln;
        writeln('ajoute la fiche: ', filepos(fichier));

        write('adresse <$1234> ? '); readln(fiche.adresse);
        write('D‚but, Milieu, Fin ? ');
        fiche.position_commentaire:= f_lis_commande(['D', 'M', 'F']);
        writeln;
        write('commentaire  <; calcul> ? '); readln(fiche.commentaire);

        write(fichier, fiche);

        write('Continuer, Quitter ? ');
        read(kbd, choix1); writeln(choix1);
      until upcase(choix1)= 'Q';

      close(fichier);
    end; 

  procedure modifie_fichier;
    var l_numero_fiche: integer;
    begin
      ouvre_fichier;
      if resultat_entree_sortie<> 0
        then exit;

      repeat
        writeln;
        repeat
          write('modifie la fiche fiche num‚ro <0..', filesize(fichier)- 1, '> ? ');
          readln(l_numero_fiche);
        until (l_numero_fiche>= 0) and (l_numero_fiche< filesize(fichier));

        seek(fichier, l_numero_fiche); read(fichier, fiche);

        with fiche do
          affiche_fiche(l_numero_fiche, adresse, position_commentaire, commentaire);
        writeln;

        write('adresse        ? '); readln(fiche.adresse);
        write('D‚but, Milieu, Fin ? ');
        fiche.position_commentaire:= f_lis_commande(['D', 'M', 'F']);
        writeln;
        write('commentaire <; calcul> ? '); readln(fiche.commentaire);

        seek(fichier, l_numero_fiche); write(fichier, fiche);

        write('Continuer, Quitter ? ');
        read(kbd, choix1); writeln(choix1);
      until upcase(choix1)= 'Q';

      close(fichier);
    end; 

  procedure supprime_fiche;
    var l_numero_fiche: integer;
    begin
      ouvre_fichier;
      if resultat_entree_sortie<> 0
        then exit;

      repeat
        writeln;
        repeat
          write('supprime la fiche fiche num‚ro <0..', filesize(fichier)- 1, '> ? ');
          readln(l_numero_fiche);
        until (l_numero_fiche>= 0) and (l_numero_fiche< filesize(fichier));

        seek(fichier, l_numero_fiche); read(fichier, fiche);

        with fiche do
          affiche_fiche(l_numero_fiche, adresse, position_commentaire, commentaire);
        writeln;

        write('Supprime ? '); read(kbd, choix1); writeln(choix1);
        if upcase(choix1)= 'S'
          then begin
              fiche.position_commentaire:= '?';
              seek(fichier, l_numero_fiche); write(fichier, fiche);
            end;

        write('Continuer, Quitter ? ');
        read(kbd, choix1); writeln(choix1);
      until upcase(choix1)= 'Q';

      close(fichier);
    end; 

  procedure initialise;
    begin
      nom_fichier:= 'commenta.dta';
    end; 

  begin 
    initialise;
    repeat
      writeln;
      writeln(nom_fichier);
      write('Cr‚e, Ajoute, Liste, Modifie, Supprime, Nom, Quitte ?');

      read(kbd, choix); writeln(choix); choix:= upcase(choix);

      case choix of
       'A' : ajoute_fichier;
       'C' : cree_fichier;
       'L' : liste_fichier;
       'M' : modifie_fichier;
       'N' : change_nom_fichier;
       'R' : supprime_fiche;
       'S' : supprime_fiche;
      end;
    until choix= 'Q';
  end.