TP sur la notion de fichier

Version imprimable

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:

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 !

02/05/2009, 11h58
supersnail

Bonjour,

1°) :tagcode:
2°) Quel messages d'erreur as-tu?
02/05/2009, 12h07
sofpower

Eh bien en fait, ça ne m'affiche pas de messages d'erreur ; une fois que j'ai procédé à la saisie des prénoms, il ne m'affiche plus rien...
02/05/2009, 12h47
darrylsite

Je crois que tu n'a meme pas initialisé la chaine fichier. Tu utilise une chaine nom initialisée pour creer, lire et ecrire dans un fichier.Un fichier sans non n'existe pas.
02/05/2009, 14h10
sofpower

c'est possible, mais qu'est ce que vous entendez par initialiser la chaine?
02/05/2009, 14h47
M.Dlb

La variable "fichier" est vide, donc il ne trouve pas de fichier à lire/écrire...

Bao,

Certains diront que j'insiste trop souvent, mais la présentation du code est importante, et il faut en prendre l'habitude le plus tôt possible.

Voici ton code remis en forme, sans autre modification :

Code:

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
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
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.