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
| 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
saisirchaine(s);
writeln('la chaine de caracteres est: ',s);
end;
function SousChaine (var s,sSousChaine:STRING):boolean;
begin
repeat
ecrireChaine (s);
writeln('entrez une sous chaine de ',s);
readln(sSousChaine);
until length(sSousChaine)<>0;
{ if pos(sSouschaine, s)<>0 then
SousChaine:=TRUE
else Souschaine:=FALSE; }
SousChaine:= pos(sSouschaine, s)<>0;
end;
function nbOccurences (s,sSousChaine:STRING):INTEGER;
var
resu ,
temp : INTEGER;
begin
resu:= 0;
saisirChaine(s);
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
resu:= resu+1;
repeat
temp:= pos(sSouschaine, s);
delete (s,1,temp + length (ssouschaine) );
if pos(sSouschaine, s)<>0 then
resu:= resu+1;
until pos(sSouschaine, s)=0;
end;
nbOccurences:= resu;
end;
function suppressionSousChaine(var s,sSousChaine:STRING):STRING;
var
nbrSuppression:INTEGER;
begin
saisirchaine(s);
repeat
writeln('entrez la sous chaine de ',s,' que vous souhaitez supprimer');
readln(ssouschaine);
until (length(ssouschaine)<>0) and (pos(ssouschaine,s)<>0);
nbrsuppression:=0;
repeat
delete(s,pos(sSousChaine,s),length(ssousChaine));
nbrSuppression:=nbrSuppression+1;
until
pos(sSousChaine,s)=0;
suppressionSousChaine:=s;
writeln(ssousChaine,' a ete supprimé ',nbrsuppression,' fois ');
end;
function remplaceSousChaine(var s,sSousChaine1,sSousChaine2:STRING):STRING;
var
i,temp,long:INTEGER;
prefixe,suffixe:STRING;
begin
saisirchaine(s);
repeat
writeln('entrez la sous chaine de ',s,' que vous souhaitez remplacer');
readln(ssouschaine1);
until (length(ssouschaine1)<>0) and (pos(sSousChaine1,s)<>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;
readln;
end;
function menu : INTEGER;
var
resu : INTEGER;
begin
repeat
writeln('entrez l''action désirée:'); // retour à la ligne pour
writeln(' 1 pour saisie d''une chaine,'); // une meilleure lisibilité
writeln(' 2 pour écriture d''une chaine,');
writeln(' 3 pour recherche d''une sous chaine,');
writeln(' 4 pour nombre d''occurences,');
writeln(' 5 pour suppression d''une sous chaine,');
writeln(' 6 pour remplacement d''une souschaine,');
writeln(' 0 pour sortir');
readln(resu);
until resu in [0..6];
case resu of
{ 0: begin // de toute façon on quitte la fonction
menu:= resu;
exit;
end; }
1: saisirChaine(s1);
2: ecrireChaine(s1);
3: writeln (souschaine(S1,s1souschaine));
4: writeln(nbOccurences(s1,s1SousChaine));
5: writeln(suppressionSousChaine(s1,s1SousChaine),' est la nouvelle chaine de caracteres');
6: writeln(remplaceSousChaine(s1,s1SousChaine,s2SousChaine),' est la nouvelle chaine de caracteres');
end;
menu:= resu;
end;
var choix : INTEGER;
begin
repeat
choix:= menu; // On enregistre le choix de l'utilateur.
until (choix=0);
{ Autre possibilité : (On n'enregistre pas le choix)
repeat
until menu = 0;
}
writeln('A bientot');
readln;
end. |
