Program sujet2 ;
Uses crt;
Var
ft,ftc : text;
//*****************************************
Procedure creation(Var ft:text);
Var
ligne : string;
Begin
assign(ft,'c:\bac2008\phrases.txt');
rewrite(ft);
append(ft);
write('Pour terminer la saisie donner un chaîne vide: ');
readln(ligne);
While (ligne<>'') Do
Begin
writeln(ft,ligne);
write('Pour terminer la saisie donner un chaîne vide: ');
readln(ligne);
End;
close(ft);
End;
//*****************************************
Function nombre_mots(ch:String) : integer;
Var
nb : integer;
Begin
nb := 0;
While (pos(' ',ch)<>0) Do
Begin
nb := nb+1;
delete(ch,pos(' ',ch),1);
End;
nombre_mots := nb+1;
End;
//*****************************************
Procedure affiche(Var f:text);
Var
ligne : string;
s,k,nbmots : integer;
Begin
reset(f);
s := 0;
k := 0;
While (Not(seekeof(f))) Do
Begin
readln(f,ligne);
k := k+1;
nbmots := nombre_mots(ligne);
s := s+nbmots;
writeln(ligne,' et elle comporte ',nbmots,' mots.');
writeln;
End;
writeln;
writeln('------------------------------------------');
writeln;
writeln('La moyenne des nombres de mots dans ce fichier est: ',s Div k);
close(f);
End;
//*****************************************
Function enleve_esp_deb(ch:String) : string;
Begin
While (pos(' ',ch)=1) Do
delete(ch,1,1);
enleve_esp_deb := ch;
End;
//*****************************************
Function enleve_esp_fin(ch:String) : string;
Begin
While (pos(' ',ch)=length(ch)) Do
delete(ch,length(ch),1);
enleve_esp_fin := ch;
End;
//*****************************************
Function enleve_esp(ch:String) : string;
Var
i : integer;
Begin
i := 1;
While (i<length(ch)) Do
If (ch[i]=' ')And (ch[i+1]=' ') Then
delete(ch,i,1)
Else
i := i+1;
enleve_esp := ch;
End;
//*****************************************
Function ajout_point(ch:String) : string;
Begin
If (ch[length(ch)]<>'.') Then
ch := ch+'.';
ajout_point := ch;
End;
//*****************************************
Procedure correction(Var ft,ftc:text);
Var
ligne : string;
Begin
assign(ftc,'c:\bac2008\phr_cor.txt');
rewrite(ftc);
append(ftc);
reset(ft);
While (Not(seekeof(ft))) Do
Begin
readln(ft,ligne);
ligne := enleve_esp_deb(ligne);
ligne := enleve_esp_fin(ligne);
ligne := enleve_esp(ligne);
ligne := ajout_point(ligne);
writeln(ftc,ligne);
End;
close(ftc);
close(ft);
End;
//*****************************************
Begin
writeln('---------------- AVANT CORRECTION ----------------');
creation(ft);
writeln;
correction(ft,ftc);
writeln('---------------- APRES CORRECTION -----------------');
affiche(ftc);
End.
Inscription à :
Publier les commentaires (Atom)
