строки ...

← →
кондратий (2002-10-01 20:48) [0]

Hi All!

как узнать сколько раз в строке S имеетса слово word

к примеру ...
если

S = "Добавить свой вопрос в форум"
word = "во"
Result = 2

а если
word = "о"
Result = 5

← →
TTCustomDelphiMaster (2002-10-01 21:02) [1]

F1 - Pos, Delete

← →
кондратий (2002-10-01 21:05) [2]

да знаю я это ...
хотелось готовое решение ...

← →
TTCustomDelphiMaster (2002-10-01 21:12) [3]

http://delphibase.endimus.com/?action=viewtopic&topic=strsearch

← →
Smithson (2002-10-01 21:19) [4]

var arSubStrFound: Array of Integer;

Function substr(Pattern, S: String; Num: Integer = 1; UpperChars: Boolean = false): Integer;
var Lambda: array[char] of integer;
PatternLen: Integer;
fIndex, q, I, J, N: Integer;
arFound: Array of Integer;
Begin
{ Расчитать переходы при заданых стоп-символах }
fillchar(Lambda, SizeOF(lambda), 0);
PatternLen := length(Pattern);
if UpperChars then begin
S := AnsiUpperCase(S);
Pattern := AnsiUpperCase(Pattern);
end;
for I := 1 to PatternLen do lambda[Pattern[I]] := I;

N := length(S);
fIndex := 0;
if Num <> 1 then begin
SetLength(arFound, N);
fillchar(arFound[0], SizeOF(arFound), 0);
end;
q := 0;
while q <= N-PatternLen do begin
J := PatternLen;
while (j > 0) and (Pattern[J] = S[q+J]) do Dec(J);
if J = 0 then begin // Совпадение
if Num = 1 then begin // Нужно только первое совпадение
Result := Q+1;
exit
end;
arFound[fIndex] := Q+1; Inc(fIndex);
Q := Q+(PatternLen+1-Lambda[S[Q+PatternLen+1]]); // Смещение на новую позицию
end
else begin // Облом
if j - Lambda[S[Q+J]] <= 0 then Inc(Q)
else Q := Q+J-Lambda[S[Q+J]];
end;
end;

if Num = 0 then begin // нужен весь массив вхождений
SetLength(arSubStrFound, fIndex-1);
for I := 0 to fIndex-1 do arSubStrFound[i] := arFound[i];
Result := fIndex;
exit
end;
if Num < 0 then begin // надо найти n-ое вхождение с конца
J := fIndex+Num;
if J < 0 then Result := 0 // Не такого
else Result := arFound[J];
end
else begin// надо n-ое вхождение с начала
if Num-1 > fIndex-1 then Result := 0 // Нет такого вхождения
else Result := arFound[Num-1];
end;

arFound := nil;
End;

Этот алгоритм существено быстрее, чем Pos/Delete, если размер строки велик

строки ... Найти похожие ветки