Dhifallah Fethi
Admin
Messages : 74
Date d'inscription : 02/03/2011
 | Sujet: Exercice 1 (Enregistrement et fichiers)  Sam 26 Mar - 2:08 | |
| Exercice 1 (Enregistrement et fichiers) 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. Correction - 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;
{ ============ 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;
{ ============ 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.NBS then
begin
Temp := t;
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;
{ ============ 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 ============== }
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 ============== }
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 ============== }
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 ============== }
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 ============== }
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.   | |
|
Calendrier
