Sujet : Dans un programme contenant un menu, ecrire des sous-programmes qui permettent :

1)de creer un fichier texte contenant des noms ecrits chacun sur une ligne

2)d'ajouter un nom en fin de fichier

3)de lire les mots contenus dans un fichier texte et de les classer dans l'ordre alphabétique

4)de creer un fichier où les mots sont classes par ordre alphabetique

5)de rechercher si 3 fichiers de telle struture, classés ou non dans l'ordre alphabétique, contiennent un élément commun. Ce dernier sous programme doit rendre un booléen et le nom commun s'il existe.

Alors voilà ce que j'ai fait :

--------

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
program EX11TD11;
uses crt;
 
const max = 5;
var fichier:string;
type t_tab = array[1..max] of string[20];
 
procedure creation(fi:string); {question 1}
var F:TEXT;
    s:string;
    r:char;
 
begin
     assign(F,fi);
     rewrite(F);
     repeat
           writeln('nom : ');
           readln(s);
           writeln(F,s);
           writeln('encore un? (o/n)');
           readln(r);
     until r='n';
     close(F);
end;
 
procedure ajout(fi:string); {question 2}
var F:text;
    s:string;
 
begin
     assign(F,fi);
     append(F);
     writeln('entrez un nom : ');
     readln(s);
     writeln(F,s);
     close(F);
end;
 
procedure lire(var T:t_tab;var n:integer;fi:string); {question 3}
var F:TEXT;
    i:integer;
    s:string;
 
begin
     assign(F,fi);
     reset(F);
     i:=1;n:=0;
     while (not eof(F)) do
                                 begin
                                      read(F,s);
                                      T[i]:=s;
                                      n:=n+1;
                                 end;
     close(f);
end;
 
procedure classe(fi:string);
const max=5;
var F:TEXT;
    OK:boolean;
    s,mem:string[20];
    r:char;
    T:t_tab;
    i,j,n:integer;
 
begin
     writeln('classement');
     writeln;
     assign(F,fi);
     reset(F);
     while (not eof(F)) do
                          begin
                               readln(F,s);
                               lire(T,n,fi);
                               i:=1;OK:=false;
                               while ((i<=n) and (not OK)) do
                begin
                     if s<T[i] then OK:=true
                     else inc(i);
                end;
 
                               n:=n+1;
                               for j:=i to n do
                                               begin
                                                    mem:=T[j];
                                                    T[j]:=s;
                                                    s:=mem;
                                               end;
                          end;
     close(F);
     assign(F,fi);
     rewrite(F);
 
     for i:=1 to n do
                     begin
                          writeln(F,T[i]);
                     end;
     close(F);
end;
 
procedure creeclasse(fi:string); {question 4}
var F:TEXT;
    s,nom,mem:string[20];
    r:char;
    T:array[1..100] of string[20];
    i,j,n:integer;
    OK:boolean;
 
begin
     n:=0;
     repeat
           writeln('nom : ');
           readln(nom);
           i:=1; OK:=false;
           while ((i<=n) AND (not OK)) do
                                         begin
                                              if s<T[i] then OK:=true
                                              else inc(i);
                                         end;
           n:=n+1;
           for j:=i to n do
                           begin
                                mem:=T[j];
                                T[j]:=s;
                                s:=mem;
                           end;
           writeln('un autre ?(o/n)');
           readln(r);
     until(r='n');
 
     assign(F,fi);
     rewrite(F);
 
     for i:=1 to n do
                     begin
                          writeln(F,T[i]);
                     end;
     close(F);
end;
 
function verifpour3(s1,s2,s3:string;var nom:string):boolean; {question 5}
var res:boolean;
    F1,F2,F3:TEXT;
    r,s,t:string[20];
 
begin
     assign(F1,s1);reset(F1);
     assign(F2,s2);reset(F2);
     assign(F3,s3);reset(F3);
     res:=false;
     while (not eof(F1) and (not res)) do
                                         begin
                                              readln(F1,s);reset(F2);
                                              while (not eof(F2) and (not res)) do
                    begin
                         readln(F2,r);
                         if s=r then
                                    begin
                                         reset(F3);
                                         while (not eof(F3) and (not res)) do
           begin
                readln(F3,t);
                if (r=t) then res:=true;
           end;
                    end;
                                    end;
                                         end;
     nom:=r;
     close(F3);
     close(F2);
     close(F1);
     verifpour3:=res;
end;
 
BEGIN
clrscr;
 
creation(fichier);
writeln;
ajout(fichier);
writeln;
classe(fichier);
writeln;
creeclasse(fichier);
writeln;
 
end.
---------

A priori mes sous programmes en réponse à la question 1 et 2 ont l'air d'être corrects, mais pour le reste, le compilateur n'a pas l'air d'apprécier mes codes !

Si vous pouviez me venir en aide... Merci d'avance !