Extract multiple substring - string

Question

I have a string 123HEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEY How can i get all available MAMAMIA+ 2 string length ? I need : MAMAMIAGO, MAMAMIASO, etc.
My problem, on last substring found give me wrong output. It render the begining of string with length of substring given : 123HEREWE instead of MAMAMIAGO.
I am using this function:
function Occurrences(const Substring, Text: string): Integer;
var
offset: Integer;
begin
Result := 0;
offset := PosEx(Substring, Text, 1);
while offset <> 0 do
begin
inc(Result);
offset := PosEx(Substring, Text, offset + Length(Substring));
memo1.Lines.Add(Copy(Text, offset, Length(Substring)+2));
end;
end;
my procedure
procedure TFH129.btn1Click(Sender: TObject);
var
s: string;
i: Integer;
begin
s := '123HEREWEGOHEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEY00';
i := Occurrences('MAMAMIA', s);
end;

Answer 1

You are adding the matching text in the wrong place, without checking if the added match exceeds the string length.
When entering the while loop, first thing to do is to check if the added match does not exceed the search string length. Then you can add the match before starting a new search.
procedure ExtractSubStringsPlus2(const SubString, SearchString: string; list: TStringList);
// Extract found sub strings together with the next two characters into a list
// Use StrUtils.PosEx if Delphi version is older than XE3
var
offset,len: integer;
begin
list.Clear;
len := Length(SubString);
offset := Pos(Substring, SearchString, 1);
while offset <> 0 do
begin
// Test if added length is past length of search string
if (offset + len + 1 > Length(SearchString))
then break;
// Copy found match
list.Add(Copy(SearchString,offset,len+2));
// Continue search
offset := Pos(Substring, SearchString, offset + len);
end;
end;

Answer 2

Your problem is as described below in the added comment:
function Occurrences(const Substring, Text: string): Integer;
var
offset: Integer;
begin
Result := 0;
offset := PosEx(Substring, Text, 1);
while offset <> 0 do
begin
inc(Result);
offset := PosEx(Substring, Text, offset + Length(Substring));
// If the string isn't found any more, offset becomes 0, but
// you still add a new string to the memo...
memo1.Lines.Add(Copy(Text, offset, Length(Substring)+2));
end;
end;
Use this instead:
FUNCTION Occurrences(CONST SubString,Text : STRING): Cardinal;
CONST
HellFreezesOver = FALSE;
VAR
OFS : Cardinal;
BEGIN
Result:=0; OFS:=0;
REPEAT
OFS:=PosEx(SubString,Text,OFS+1);
// Here I terminate the loop, in case the string isn't found any more.
IF OFS=0 THEN BREAK;
INC(Result);
Memo1.Lines.Add(COPY(Text,OFS,LENGTH(SubString)+2))
UNTIL HellFreezesOver
END;

Answer 3

One very simple way using TstringList :
Var aList: TstringList;
i: integer;
begin
aList := TstringList.create;
try
aList.lineBreak := 'MAMAMIA';
aList.text := 'x' + '123HEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEY';
For I := 1 to aList.count-1 do
if length(aList[i]) >=2 then memo1.Lines.Add(aList.lineBreak + Copy(aList[i], 1, 2));
finally
aList.free;
end;
end;