probleme en pascal

Dj khalil

عضو فعال
إنضم
31 أكتوبر 2009
المشاركات
371
مستوى التفاعل
212
:besmellah2:

السلام عليكم

خدمت الdevoir اللي في المرفقات أما عندي أغلاط صلحولي يرحم والديكم

program devoir;
uses wincrt;

type
fiche=file of string ;
{procédure de création**
procedure creation (var f:fiche);
begin
assign(f,'c:\bac2009\mot.txt');
rewrite(f);
writeln('fichier crée avec succés !');
close(f);
end;

{procedure remplissag**
procedure remplir (var f:fiche);
var
k,b:string;
rep:char;
begin
reset(f);
b:=',';
repeat
writeln('donner un mot');
readln(k);
write (f,k);
write(f,b);
writeln('ajouter un mot ? o=oui , n=non');
readln(rep);
until (rep='n') or (rep='N');
close(f);
end;

{procedure calcul**
procedure nombre(var f:fiche);
var
nb:byte;
aux:string;
begin
reset(f);
nb:=0;
while not Eof(f) do
begin
read(f,aux);
nb:=nb+1;
end;
writeln('le nombre des mots saisie est ',nb);
close(f);
end;

{fonction test palindrome**
function pailindrome (ch:string):Boolean;
var
i:integer;
test:boolean;
begin
i:=0;
repeat
i:=i+1;
if ch=ch[length(ch)-i+1] then
test:=true
until (test=false) or (i=length(ch)div 2);
pailindrome:=test;
end;

{procedure calcul de mot palindrome**
procedure calcp(var f:fiche);
var
k:string;
n:integer;
begin
n:=0;
reset(f);
while not eof(f) do
begin
read(f,k);
if k<>',' then
begin
if pailindrome(k)=true then
n:=n+1;
end;
end;
writeln('le nombre des mots palindrome dans le fichier est ',n);
end;

{procedure recherche**
procedure recherche(var f:fiche);
var
m,l:string;
begin
writeln('donner le mot a chercher');
readln(m);
reset(f);
while not Eof(f) do
begin
read(f,l);
end;
if l<>',' then
begin
if l=m then
writeln('le mot se trouve dans le fichier')
else
writeln('le mon ne se trouve pas dans le fichier');
end;
end;








{programme principale **
var
f:fiche;
begin
creation(f);
remplir(f);
calcp(f);
recherche(f);
end.

 

المرفقات

مواضيع مماثلة

الردود
2
المشاهدات
238
tunisalafy
T
الردود
4
المشاهدات
357
F
الردود
5
المشاهدات
671
W
أعلى