Problème: Traitement des enregistrements dans un fichier

Les informations relatives à un film sont :

Titre :chaine
Code :chaine
Nombre de sorties de films :entier


Ecrire un programme modulaire qui permet de :

Remplir un tableau T par N films ( 1 ≤ N ≤ 100 ).
* Trier les films par ordre décroissant selon leurs nombres de sortie.
* Afficher le contenu de tableau avant le tri puis après le tri.
* Transférer les films qui sont sortis au moins une seule fois vers un fichier intitulé « acceptable.dat » qui sera créé sous la racine C:
* Transférer les codes des films qui ne sont jamais sortie vers un fichier texte intitulé « Mauvais.doc » qui sera créé sous la racine C:
* Chercher et afficher le nom de film qui à sorti le plus grand nombre de fois ( Remarque : Il est possible qu’on trouve plus qu’un film ayant le même nombre maximal !! ) .
* Supprimer définitivement (à partir de fichier ) les films portant un nombre de sorties inférieur à une valeur vf saisie au clavier. On pourra exploiter la procédure standard TRONQUER ( F ) puisque notre fichier est trié en ordre décroissant !!
* Afficher de nouveau le contenu de fichier.

Extrait du forum tunisien: http://i3lameya.meilleurforum.com

Je n'ai pas personnellement testé la fonction.

Code:

program Exercice;

uses wincrt;

type

film=record

titre,code:string;

NBS:integer;

End;

F_films=file of film;

TAB=array[1..100] of film;

var

F:F_films;

G:text;

T:TAB;

N:integer;

{ ============ CORPS DE LA PROCEDURE CREATION ============== }



procedure creation( VAR F : F_films);

begin

assign (F,' C:/clinique.dat');

rewrite(F);

End;

{ ============ CORPS DE LA PROCEDURE REMPLIR ============== }



procedure remplir (Var T: TAB ; var N:integer);

var

i:integer;

begin

repeat

writeln('saisir le nombre de films: ');

readln(N);

until N in [1..100];

for i:=1 to N do

with t do

begin

write('Titre ....................... : ');Readln(Titre);

write('Code ........................ : ');Readln(Code);

write('Nombre de sorties ........... : ');Readln(NBS);

End;

End;



[i]{ ============ CORPS DE LA PROCEDURE AFFICHER ============== }



procedure Afficher(Var T: TAB ; var N:integer);

var

i:integer;

begin

for i:=1 to N do

with t do

begin

write('Titre ....................... : ');writeln(Titre);

write('Code ........................ : ');writeln(Code);

write('nombre de sorties ........... : ');writeln(NBS);

End;

End;

[i]{ ============ CORPS DE LA PROCEDURE TRIER ============== }



procedure trier(Var T:TAB ; N:integer);

var

i,j:integer;

P,temp:film;



begin

for i:= 2 to N do

if t.NBS < t[i].NBS then[/i][i][/i][i][/i][i]

begin

Temp := t[i];

j:=i-1;

while (j>=1) AND (t[j].NBS > temp.NBS) do

begin

t[j+1]:= t[j];

j:=j-1;

End;

t[j+1] := temp;

End;

End;

[i]{ ============ CORPS DE LA PROCEDURE TRANSFERT_1 ============== }



procedure transfert_1 (Var T:TAB ; N:integer;Var F:F_films);

var

i:integer;

begin

assign (F,' C:/acceptable.dat');

rewrite(F);

for i:=1 to N do

if (t.NBS > 0) then

write(F,t);

End;



{ ============ CORPS DE LA PROCEDURE TRANSFERT_2 ============== }[/i]



procedure transfert_2 (Var T:TAB ; N:integer; Var G:text);

var

i:integer;

begin

assign (G,' C:/mauvais.doc');

rewrite(G);

for i:=1 to N do

if (t.NBS = 0) then

write(G,t.Code);

End;



{ ============ CORPS DE LA PROCEDURE AFFICHAGE ============== }[/i]



procedure Affichage (Var F:F_films);

var

Enr:film;

begin

while NOT (eof(F)) do

begin

with Enr do

begin

write('Titre ....................... : ');writeln(Titre);

write('Code ........................ : ');writeln(Code);

write('nombre de sorties ........... : ');writeln(NBS);

End;

End;

End;

{ ============ CORPS DE LA PROCEDURE RECHERCHE ============== }[/i]



procedure recherche (T:TAB ; N:integer);

var

i,MAX:integer;

begin

MAX:=t[1].NBS;

for i:=2 to N do

if (t.NBS > MAX) then

MAX:=t.NBS;

for i:=1 to N do

if (t.NBS = MAX) then

writeln('Titre de film .......... : ',t.titre);

End;



{ ============ CORPS DE LA PROCEDURE SUPPRIMER ============== }[/i]



procedure supprimer (Var F:F_films);

var

Enr:film;

vf,p:integer;

trouve:boolean;

begin

writeln('saisir une valeur........: ');

readln(vf);

trouve:=false;

while NOT (eof(F)) do

begin

p:=filepos(F);

read(F,Enr);

if (Enr.NBS < vf) then

begin

trouve:=true;

p:=p-1;

End;

End;

seek(F,p);

truncate(F);

End;



{ ============ CORPS DE PROGRAMME PRINCIPAL ============== }[/i]



begin

remplir (t,N);

writeln('contenu de tableau avant le tri');

Afficher(t,N);

Trier (t,N);

writeln('contenu de tableau aprés le tri');

Afficher (t,N);

transfert_1(t,N,F);

transfert_2(t,N,G);

recherche(t,N);

supprimer (F);

Affichage (F);

End.