{
Le programme qui suit 
- ouvre un fichier existant ( fichier créé par le programme précédent)
- rajoute des articles en fin de fichier
- suppression logiquement certains articles
- ferme le fichier
- réorganise le fichier par la construction d'un autre.

Les résultats de ce programme sont également fournis.
}

PROGRAM Fichier2;
  CONST
    B = 10;
  TYPE
    Typecle = INTEGER  ;
    Typeqq = STRING[20] ;
    Nature = (Inf, Table);
    Typearticle = RECORD
      Cle : Typecle;
      Info : Typeqq
    END;
    Typebloc = RECORD
      CASE Diff : Nature OF
        1 : (   Nombre : INTEGER;
                Tab : ARRAY[1..B] OF Typearticle );
        2 : (   Nombre_elements, Efface, Dernierblocseq, Dernierseq: INTEGER )
      END;

  VAR
    Fs : TEXT;
    Efface, Nombre_elements : INTEGER;
    F : File OF Typebloc;
    Dernierseq,Dernierblocseq : INTEGER;
    Bloc : Typebloc;

  { Ouverture du fichier }

  PROCEDURE Ouvrir;
    BEGIN
      Bloc.Diff := Inf;
      RESET(F);
      SEEK(F, 0);
      READ(F, Bloc);
      Efface := Bloc.Efface;
      Nombre_elements := Bloc.Nombre_elements;
      Dernierblocseq := Bloc.Dernierblocseq;
      Dernierseq := Bloc.Dernierseq;
    END;

  { Fermeture du fichier }

  PROCEDURE Fermer;
    BEGIN
      Bloc.Diff := Inf;
      Bloc.Nombre_elements := Nombre_elements;
      Bloc.Efface := Efface;
      Bloc.Dernierblocseq := Dernierblocseq;
      Bloc.Dernierseq := Dernierseq;
      RESET(F);
      SEEK(F, 0);
      WRITE(F, Bloc);
    END;

  { Parcours séquentiel du fichier et listage de ses éléments sur un fichier TEXT }

  PROCEDURE Impseq;
    VAR
      I, J : INTEGER;
    BEGIN
      RESET(F);
      { Les caractéristiques }
      WRITELN(Fs, '* * * Caractéristiques du fichier : ');
      WRITELN(Fs);
      WRITELN(Fs, '- Nombre d''articles : ', Nombre_elements );
      WRITELN(Fs, '- Nombre d''articles effacés :', Efface);
      WRITELN(Fs, '- Dernier bloc :', Dernierblocseq);
      WRITELN(Fs, '- Dernier indice dans le dernier bloc :', Dernierseq);
      WRITELN(Fs);
      WRITELN(Fs, '* * * Contenu du fichier : ');

      FOR I:=2 TO Dernierblocseq DO
        BEGIN
          SEEK(F, I-1);
          READ(F, Bloc);
          WRITELN(Fs);
          WRITELN(Fs, 'Bloc ',I, ' :');
          FOR J:=1 TO Bloc.Nombre DO
            WRITE(Fs, Bloc.Tab[J].Cle, '  ' );
          WRITELN(Fs);
        END;
      END;

  { Recherche séquentielle d'un article de clé donnée }

  FUNCTION Recherche (Clef : INTEGER) : BOOLEAN;
    VAR
      I, J : INTEGER;
      Trouv : BOOLEAN;
    BEGIN
      RESET(F);
      I:= 2;
      Trouv := FALSE;
      WHILE  (I <= Dernierblocseq ) AND NOT Trouv DO
        BEGIN
          SEEK(F, I-1);
          READ(F, Bloc);
          J:= 1;
          WHILE (J <=Bloc.Nombre) AND NOT Trouv DO
            IF Bloc.Tab[J].Cle = Clef
            THEN Trouv := TRUE
            ELSE J := J + 1;
          I := I + 1
        END;
        Recherche := Trouv;
    END;

  { Ajouter un article à un fichier }

  PROCEDURE Ajouter (Cle : INTEGER);
    BEGIN
      WRITELN(Fs, 'Ajout de l''article ', Cle, '...');
      Nombre_elements := Nombre_elements + 1 ;
      Inc(Dernierseq);
      IF Dernierseq <= B
      THEN
        BEGIN
          SEEK(F, Dernierblocseq - 1);
          READ(F, Bloc);
          Bloc.Tab[Dernierseq].Cle:= Cle;
          Inc(Bloc.Nombre);
          SEEK(F, Dernierblocseq - 1);
          WRITE(F, Bloc);
        END
      ELSE
        BEGIN
          Inc(Dernierblocseq);
          Bloc.Tab[1].Cle := Cle;
          Bloc.Nombre := 1;
          Dernierseq := 1;
          SEEK(F, Dernierblocseq - 1);
          WRITE(F, Bloc);
        END;
    END;

  { Suppression d'un article de clé donnée }

  PROCEDURE Supprimer (Clef : INTEGER) ;
    VAR
      I, J : INTEGER;
      Trouv : BOOLEAN;
    BEGIN
      WRITELN(Fs, 'Supprimer l''article ', Clef, ' ...');
      RESET(F);
      I:= 2;
      Trouv := FALSE;
      WHILE  (I <= Dernierblocseq ) AND NOT Trouv DO
        BEGIN
          SEEK(F, I-1);
          READ(F, Bloc);
          J:= 1;
          WHILE (J <=Bloc.Nombre) AND NOT Trouv DO
            IF Bloc.Tab[J].Cle = Clef
            THEN
              BEGIN
                Bloc.Tab[J].Cle := - 1;
                SEEK(F, I-1);
                WRITE(F, Bloc);
                Efface := Efface + 1;
                Trouv := TRUE
              END
            ELSE J := J + 1;
          I := I + 1
        END;
      IF NOT Trouv THEN WRITELN(Fs, 'Article inexistant');
    END;

  { Réorganisation }

  PROCEDURE Reorganiser;
    VAR
      I, J : INTEGER;
      Dernierbloc, Dernier : INTEGER;
      Fnouv : File OF Typebloc;
      Blocnouv : Typebloc;

      PROCEDURE Add (Cle : INTEGER);
        BEGIN
          Inc(Dernier);
          IF Dernier <= B
          THEN
            BEGIN
              Blocnouv.Tab[Dernier].Cle:= Cle;
              Inc(Blocnouv.Nombre)
            END
          ELSE
            BEGIN
              Inc(Dernierbloc);
              SEEK(Fnouv, Dernierbloc - 1);
              WRITE(Fnouv, Blocnouv);
              Blocnouv.Tab[1].Cle := Cle;
              Blocnouv.Nombre := 1;
              Dernier := 1;
            END;
        END;

    BEGIN
      Blocnouv.Diff := Table;
      Blocnouv.Nombre := 0;
      Dernierbloc := 1;
      Dernier := 0;
      ASSIGN(Fnouv, 'Fnouveau');
      REWRITE(Fnouv);

      RESET(F);
      FOR I:=2 TO Dernierblocseq DO
        BEGIN
          SEEK(F, I-1);
          READ(F, Bloc);
          FOR J:=1 TO Bloc.Nombre DO
            IF Bloc.Tab[J].Cle <> - 1
            THEN  Add ( Bloc.Tab[J].Cle )
        END;

      { Ecriture Dernier Bloc }
      IF Dernier > 0
      THEN
        BEGIN
          Inc(Dernierbloc);
          SEEK(Fnouv, Dernierbloc - 1);
          WRITE(Fnouv, Blocnouv);
        END;
      Blocnouv.Diff := Inf;
      Blocnouv.Dernierseq := Dernier;
      Blocnouv.Dernierblocseq := Dernierbloc;
      Blocnouv.Efface := 0;
      Blocnouv. Nombre_elements :=  Nombre_elements  - Efface;

      WRITELN(Fs);
      WRITELN(Fs, '* * * Caractéristiques du nouveau fichier : ');
      WRITELN(Fs);
      WRITELN(Fs, '- Nombre d''articles : ', Blocnouv.Nombre_elements );
      WRITELN(Fs, '- Nombre d''articles Effacés :', Blocnouv.Efface);
      WRITELN(Fs, '- Dernier bloc :', Blocnouv.Dernierblocseq);
      WRITELN(Fs, '- Dernier indice dans le dernier bloc :', Blocnouv.Dernierseq);
      WRITELN(Fs);
      WRITELN(Fs, '* * * Contenu du nouveau fichier : ');

      SEEK(Fnouv, 0);
      WRITE(Fnouv, Blocnouv);
      CLOSE(Fnouv);
      RESET(Fnouv);

      FOR I:=2 TO Dernierbloc DO
        BEGIN
          SEEK(Fnouv, I-1);
          READ(Fnouv, Blocnouv);
          WRITELN(Fs, 'Bloc ',I, ' :');

          FOR J:=1 TO Blocnouv.Nombre DO
            WRITE(Fs, Blocnouv.Tab[J].Cle, '  ' );
          WRITELN(Fs);
        END;
    END;

  BEGIN
    ASSIGN(Fs, 'R_F2.Pas');
    REWRITE(Fs);
    ASSIGN(F, 'Fichier');
    WRITELN(Fs, 'Ouverture du fichier...');
    WRITELN(Fs);
    Ouvrir;
    Bloc.Diff := Table;

    WRITELN(Fs, 'Rajout d''articles en fin de fichier...');

    IF NOT( Recherche(333) ) THEN Ajouter(333);
    IF NOT( Recherche(444)) THEN  Ajouter(444);
    WRITELN(Fs);

    WRITELN(FS, 'Parcours séquentiel du fichier et listage de ses éléments...');
    WRITELN(Fs);
    Impseq;

    WRITELN(Fs);
    WRITELN(Fs, 'Suppression d''articles...');
    WRITELN(Fs);

    Supprimer(993);
    Supprimer(374);
    Supprimer(164);
    Supprimer(858);
    Supprimer(402);
    Supprimer(616);

    WRITELN(Fs);
    WRITELN(FS, 'Parcours séquentiel du fichier et listage de ses éléments...');
    WRITELN(Fs);
    Impseq;
    WRITELN(Fs, 'Fermeture du fichier...');
    WRITELN(Fs);
    Fermer;

    WRITELN(Fs, 'Reorganisation...');
    Reorganiser;
    WRITELN(Fs);
    CLOSE(Fs)
  END.

	Contenu du fichier R_F2.PAS :

Ouverture du fichier...

Rajout d'articles en fin de fichier...
Ajout de l'article 333...
Ajout de l'article 444...

Parcours séquentiel du fichier et listage de ses éléments...

* * * Caractéristiques du fichier : 

- Nombre d'articles : 57
- Nombre d'articles effacés :0
- Dernier bloc :7
- Dernier indice dans le dernier bloc :7

* * * Contenu du fichier : 

Bloc 2 :
0  56  429  276  886  17  885  603  395  896  

Bloc 3 :
374  116  624  106  914  221  115  111  768  490  

Bloc 4 :
722  323  53  96  657  593  541  164  111  286  

Bloc 5 :
573  776  300  828  643  993  278  191  216  330  

Bloc 6 :
244  404  820  420  858  632  756  641  494  406  

Bloc 7 :
536  502  635  853  616  333  444  

Suppression d'articles...

Supprimer l'article 993 ...
Supprimer l'article 374 ...
Supprimer l'article 164 ...
Supprimer l'article 858 ...
Supprimer l'article 402 ...
Article inexistant
Supprimer l'article 616 ...

Parcours séquentiel du fichier et listage de ses éléments...

* * * Caractéristiques du fichier : 

- Nombre d'articles : 57
- Nombre d'articles effacés :5
- Dernier bloc :7
- Dernier indice dans le dernier bloc :7
* * * Contenu du fichier : 

Bloc 2 :
0  56  429  276  886  17  885  603  395  896  

Bloc 3 :
-1  116  624  106  914  221  115  111  768  490  

Bloc 4 :
722  323  53  96  657  593  541  -1  111  286  

Bloc 5 :
573  776  300  828  643  -1  278  191  216  330  

Bloc 6 :
244  404  820  420  -1  632  756  641  494  406  

Bloc 7 :
536  502  635  853  -1  333  444  
Fermeture du fichier...

Reorganisation...

* * * Caractéristiques du nouveau fichier : 

- Nombre d'articles : 52
- Nombre d'articles Effacés :0
- Dernier bloc :7
- Dernier indice dans le dernier bloc :2

* * * Contenu du nouveau fichier : 
Bloc 2 :
0  56  429  276  886  17  885  603  395  896  
Bloc 3 :
116  624  106  914  221  115  111  768  490  722  
Bloc 4 :
323  53  96  657  593  541  111  286  573  776  
Bloc 5 :
300  828  643  278  191  216  330  244  404  820  
Bloc 6 :
420  632  756  641  494  406  536  502  635  853  
Bloc 7 :
333  444