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. |
Partager