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
| program chaine_caracteres;
var
s1,s1SousChaine,s2souschaine:string;
procedure saisirChaine(var s:string);
begin
repeat
writeln('entrez une chaine de caracteres inférieure à 255');
readln(s);
until (length(s)<=255)and (length(s)<>0);
end;
procedure ecrireChaine (var s:string);
begin
writeln(s);
end;
function SousChaine (var s,sSousChaine:string):boolean;
begin
repeat
writeln('entrez une sous chaine de ',s);
readln(sSousChaine);
until length(sSousChaine)<>0;
if pos(sSouschaine, s)<>0 then
SousChaine:=true
else Souschaine:=false;
writeln(souschaine);
end;
function nbOccurences (s,sSousChaine:string):integer;
var
temp:integer;
begin
nbOccurences:=0;
repeat
writeln('entrez une sous chaine de ',s,'pour en connaitre le nbr d''occurences');
readln(sSousChaine);
until length(sSousChaine)<>0;
if pos(sSouschaine, s)<>0 then
begin
nbOccurences:=nbOccurences+1;
repeat
temp:= pos(sSouschaine, s);
delete (s,1,temp + length (ssouschaine) );
if pos(sSouschaine, s)<>0 then
nbOccurences:=nbOccurences+1;
until pos(sSouschaine, s)=0;
end;
writeln (nbOccurences);
readln;
end;
function suppressionSousChaine(var s,sSousChaine:string):string;
var
nbrSuppression:integer;
begin
repeat
writeln('entrez la sous chaine de ',s,' que vous souhaitez supprimer');
readln(ssouschaine);
until length(ssouschaine)<>0;
nbrsuppression:=0;
repeat
delete(s,pos(sSousChaine,s),length(ssousChaine));
nbrSuppression:=nbrSuppression+1;
until
pos(sSousChaine,s)=0;
writeln('la nouvelle chaine de caracteres est: ',s,' et ',ssousChaine,' a ete supprimé ',nbrsuppression,' fois ');
readln;
end;
function remplaceSousChaine(var s,sSousChaine1,sSousChaine2:string):string;
var
i,temp,long:integer;
prefixe,suffixe:string;
begin
repeat
writeln('entrez la sous chaine de ',s,' que vous souhaitez remplacer');
readln(ssouschaine1);
until length(ssouschaine1)<>0;
i:=0;
repeat
i:=i+1;
temp:=pos(sSousChaine1,s);
long:= length(ssousChaine1);
prefixe:=copy(s,1,temp-1);
suffixe:=copy(s,temp+long,length(s)-temp-long+1);
delete(s,temp,long);
repeat
writeln('entrez la ',i,' souschaine de remplacement');
readln(ssouschaine2);
until length(ssouschaine2)<>0;
s:=prefixe+ssouschaine2+Suffixe;
until pos(sSousChaine1,s)=0;
remplacesouschaine:=s;
writeln('la nouvelle chaine de caracteres est: ',remplacesouschaine);
readln;
end;
function menu:integer;
begin
repeat
writeln('entrez l''action désirée:1 pour saisie d''une chaine, 2 pour écriture d''une chaine, 3 pour recherche d''une sous chaine,4 pour nombre d''occurences,5 pour suppression d''une sous chaine,et 6 pour remplacement d''une souschaine');
readln(menu);
until (menu=1) or (menu=2) or (menu=3) or (menu=4) or (menu=5) or (menu=6);
case menu of
1: saisirChaine(s1);
2: ecrireChaine(s1);
3: writeln (souschaine);
4: writeln(nbOccurences);
5: writeln(suppressionSousChaine);
6: writeln (remplaceSousChaine);
end;
end;
begin
menu;
readln;
end. |
Partager