Code:
const
TEXT = 'TestesTESTTestest test TEST Test Test.';
FIND_STR = 'test';
type
TMatchMethod = (mmAll, mmBackward, mmIgnoreCase, mmOverlap, mmWholeWords, mmStrictWW);
TMatchMethods = set of TMatchMethod;
function Find(Text, FindStr: string; Methods: TMatchMethods; Offset: Integer): TIntArray;
var
tL, fsL, d, i, t: Integer;
rgx_fs: string;
r: TRegexMatchArray;
begin
fsL := Length(FindStr);
tL := Length(Text);
if ((tL < 1) or (Length(FindStr) > tL) or (FindStr = '')) then
Exit;
if (Offset < 1) then
Offset := 1;
FindStr := PregQuote(FindStr);
if (mmWholeWords in Methods) then
begin
if (mmStrictWW in Methods) then
rgx_fs := '/(?<!\S)' + FindStr + '(?!\S)/'
else
rgx_fs := '/(^|\b|(?<=\s))' + FindStr + '((?=\s)|\b|$)/';
end else
rgx_fs := '/' + FindStr + '/';
if (mmIgnoreCase in Methods) then
rgx_fs := (rgx_fs + 'i');
rgx_fs := (rgx_fs + 'm');
if (mmOverlap in Methods) then
SetLength(Result, (tL - (fsL - 1)))
else
SetLength(Result, ((tL div fsL) + 1));
case (mmBackward in Methods) of
True:
begin
Text := Copy(Text, 1, Offset);
while PregMatchEx(rgx_fs, Text, r) do
begin
Result[d] := (r[0].Offset + d);
Inc(d);
Delete(Text, r[0].Offset, 1);
SetLength(r, 0);
end;
SetLength(Result, d);
if (mmAll in Methods) then
ReverseTIA(Result)
else
if (d > 0) then
Result := [Result[(d - 1)]];
if (mmAll in Methods) then
if not (mmOverlap in Methods) then
if (d > 1) then
for i := (0 + t) to ((d - 2) - t) do
if ((Result[i] - Result[(i + 1)]) <= fsL) then
begin
Result[(i + 1)] := Result[i];
Delete(Result, i, 1);
Inc(t);
end;
end;
False:
begin
if (Offset > 1) then
Delete(Text, 1, (Offset - 1));
if (mmAll in Methods) then
begin
while PregMatchEx(rgx_fs, Text, r) do
begin
Result[d] := ((r[0].Offset + d) + (Offset - 1));
Inc(d);
Delete(Text, r[0].Offset, 1);
SetLength(r, 0);
end;
SetLength(Result, d);
if (mmAll in Methods) then
if not (mmOverlap in Methods) then
if (d > 1) then
for i := (0 + t) to ((d - 2) - t) do
if ((Result[(i + 1)] - Result[i]) <= fsL) then
begin
Result[(i + 1)] := Result[i];
Delete(Result, i, 1);
Inc(t);
end;
end else
if PregMatchEx(rgx_fs, Text, r) then
begin
Result := [((r[0].Offset + d) + (Offset - 1))];
SetLength(r, 0);
end;
end;
end;
TIAUnique(Result);
end;
var
l, h, i, i2, s, o: Integer;
TIA: TIntArray;
m_sets: array of TMatchMethods;
TSA: TStrArray;
procedure BuildSets(find_method: (fmBackward, fmForward));
begin
case find_method of
fmForward:
begin
TSA := ['[]', '[mmIgnoreCase]', '[mmIgnoreCase, mmAll]', '[mmIgnoreCase, mmAll, mmOverlap]', '[mmIgnoreCase, mmAll, mmOverlap, mmWholeWords]', '[mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW]'];
l := Length(FIND_STR);
o := 1;
s := High(TSA);
SetLength(m_sets, (s + 1));
m_sets[0] := [];
m_sets[1] := [mmIgnoreCase];
m_sets[2] := [mmIgnoreCase, mmAll];
m_sets[3] := [mmIgnoreCase, mmAll, mmOverlap];
m_sets[4] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords];
m_sets[5] := [mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW];
end;
fmBackward:
begin
TSA := ['[mmBackward]', '[mmBackward, mmIgnoreCase]', '[mmBackward, mmIgnoreCase, mmAll]', '[mmBackward, mmIgnoreCase, mmAll, mmOverlap]', '[mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords]', '[mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW]'];
l := Length(FIND_STR);
o := Length(TEXT);
s := High(TSA);
SetLength(m_sets, (s + 1));
m_sets[0] := [mmBackward];
m_sets[1] := [mmBackward, mmIgnoreCase];
m_sets[2] := [mmBackward, mmIgnoreCase, mmAll];
m_sets[3] := [mmBackward, mmIgnoreCase, mmAll, mmOverlap];
m_sets[4] := [mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords];
m_sets[5] := [mmBackward, mmIgnoreCase, mmAll, mmOverlap, mmWholeWords, mmStrictWW];
end;
end;
end;
begin
ClearDebug;
BuildSets(fmForward);
WriteLn('FORWARD:');
for i := 0 to s do
begin
TIA := Find(TEXT, FIND_STR, m_sets[i], o);
h := High(TIA);
WriteLn('Find(''' + FIND_STR + ''', ''' + TEXT + ''', ' + TSA[i] + ', ' + IntToStr(o) + ')')
for i2 := 0 to h do
WriteLn('Match[' + IntToStr(i2 + 1) + ']: ' + Copy(TEXT, TIA[i2], l) + ' (@POS.' + IntToStr(TIA[i2]) + ')');
WriteLn('');
SetLength(TIA, 0);
end;
BuildSets(fmBackward)
WriteLn('BACKWARD:');
for i := 0 to s do
begin
TIA := Find(TEXT, FIND_STR, m_sets[i], o);
h := High(TIA);
WriteLn('Find(''' + FIND_STR + ''', ''' + TEXT + ''', ' + TSA[i] + ', ' + IntToStr(o) + ')')
for i2 := 0 to h do
WriteLn('Match[' + IntToStr(i2 + 1) + ']: ' + Copy(TEXT, TIA[i2], l) + ' (@POS.' + IntToStr(TIA[i2]) + ')');
if (i < s) then
WriteLn('');
SetLength(TIA, 0);
end;
SetLength(m_sets, 0);
SetLength(TSA, 0);
end.
Regards,