Bonjour,
SVP je voudrais la correction de ce programme :
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
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
program application;
uses wincrt,windos,winprocs;
const
DayStr:array[0..6] of string[3]=('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
MonthStr:array[1..12] of string[3]=('Jan','Feb','Mar','Apr','May','Jun',
'Jul','Aug','Sep','Oct','Nov','Dec');
 
Type
    mot=record
      fr:string[15];
      ag:string[15];
    end;
      dictionnaire=file of mot;
 
{Declaration des Variables global}
var d:dictionnaire;
Hour,Min,Sec,HSec : word;
Year,Month,Day,WDay : word;
 
{Procedure Saisir}
procedure saisir(var d:dictionnaire);
var m:mot; rep:char;
  begin
       repeat
          with m do
             begin
                writeln('mot en françai');
                readln(fr);
                writeln('mot en anglais');
                readln(ag);                              
             end;
             write (d,m);
                repeat
                  writeln('Ajoute un autre mot(O/N)');
                  readln(rep);
                until upcase(rep) in ['O','N'];
       until(upcase(rep)='O');
  end;
 
{Procedure Recherch}
procedure recherch(var d:dictionnaire);
var m:mot;
f:string;
  begin
      reset(d);
      read(d,m);
      writeln('donner un mot en français: ');
      readln(f);
        while not(eof(d)) and (m.fr<>f) do
           begin
             read(d,m);
           end;
              if m.fr=f then
                writeln('mot en anglais :',m.ag)
              else
                writeln('mot interouvable');
  end;
 
{Procedure Ajout}
procedure ajoute(var d : dictionnaire);
var p:integer; m:mot;rep:char;
  begin
      p:=filesize(d);
      seek(d,p);
      writeln('Donner le mot a ajouter');
        repeat
           with m do
             begin
                writeln('mot en françai');
                readln(fr);
                writeln('mot en anglais');
                readln(ag);
                writeln('Ajout effectué avec succès');
             end;
           write (d,m);
             repeat
                writeln('Ajoute un autre mot (O/N)');
                readln(rep);
             until upcase(rep) in ['O','N'];
        until(upcase(rep)='O');           
  end;
 
{Procedure Supprime Des Mot}
procedure supprimer1(var d:dictionnaire);
var p,n:integer; m:mot;
   begin
     p:=filesize(d);
       repeat
          writeln('entrer le rang de l''élève à supprimé : [0 --> ',p,']');
          readln(n);
       until (n in [0..p]);
       p:=p-n;
         if p<= 0 then
           erase(d)
         else        
            seek(d,p);
            truncate(d);
            write('L''enregistrement n° : ',n,' a été supprimé avec succès !');
   end;
 
{Procedure Supprime Le fichier Completement}
procedure supprimer2(var d:dictionnaire);
       begin
         {$I-}
           reset (d);
           erase(d);
           If IOresult <> 0 then write('Le fichier est inexistant !')
           else writeln('#Le fichier a été supprimé #');
         {$I+}
        end;
 
{Procedure Criation}
 
 
 
 
{Procedure Affiche}
procedure afficher(var d:dictionnaire);
var 
m:mot;
chemin : string;
   begin
     reset(d);
     writeln('Contenu du fichier ');
       while not(eof(d)) do
         begin
           read(d,m);
             with m do
               begin
                 write('mot en français : ',fr);
                 writeln(' = mot en anglais : ',ag);
               end;
         end;
   end;
 
{Fonction du Time}
Function L0(w:word):string;
var
s : string;
   begin
     Str(w,s);
     if w<10 then
       L0:='0'+s
     else
       L0:=s;
   end;
 
procedure quite;
 
var t0,t:real;i:integer;
c:char; 
begin
c:='.';
i:=0;
t0:=getcurrenttime;
writeln('Merci Lappliction va se fermer dans un environ de 10 seconds ');
   while t<=10 do
      begin
      t:=(getcurrenttime-t0)/1000;
      if (t-i)>1 then begin
      write(c);                       
      i:=i+1;                              
      end;      
      end;
   DoneWinCrt;
end;
{Procedure Menu \\ Apeller tous les Procedure}
Procedure menu(var P:dictionnaire); 
var
rep,k:char;
 
   Begin
        GetDate(Year,Month,Day,WDay);
        GetTime(Hour,Min,Sec,HSec);
 
        writeln('         *******************************************************');
        writeln('         *           HICHEM BENBELGACEM BAC INFO 2012          *');
        writeln('         *******************************************************');
        WriteLn('         *      Date >=>  ',DayStr[WDay],', ',Day,' ',MonthStr[Month],' ',Year,'                     *');
        Writeln('         *      Time >=>  ',L0(Hour),':',L0(Min),':',L0(Sec), '                             *');
        writeln('         *******************************************************');
        writeln('         * 1 -> Remplir Votre Dictionnaire                     *');
        writeln('         * 2 -> Ajouter Des Mots                               *');
        writeln('         * 3 -> Supprimer Des Mots                             *');
        writeln('         * 4 -> Recherche De Mots Dans Le Dictionnaire         *');
        writeln('         * 5 -> Afficher Tous Les Mots                         *');
        writeln('         * 6 -> Supprimer Le Fichier Completement              *');
        writeln('         * 7 -> Quitter l''exécution completement               *');
        writeln('         *******************************************************');
        writeln;
        repeat
          write('Votre Choix> ');
          k:=readkey;
          writeln;
        until(k in ['1'..'7']);
             if (k='1') then
               saisir(d)
             else if (k='2') then
               ajoute(d)
             else if (k='3') then
               supprimer1(d)
             else if (k='4') then
               recherch(d)
             else if (k='5') then
               afficher(d)
             else if (k='6') then
               supprimer2(d)
             else if (k='7') then
               quite;
 
              begin
                 writeln;
                 writeln('Appuyer sur n''importe touch pour retourner au Menu ??????? ');
                 readkey;
                 clrscr;
                 menu(d);
              end;
          end;
 
{Programme Principal}                                     
Begin
assign(d,'C:\Dictionnair.fch');
rewrite(d);
menu(d);
end.