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. |
Programme de gestion d'un dictionnaire
Répondre avec citation
Partager