Extract multiple substring

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;

You're adding text to your memo regardless what `PosEx` returns (at the last iteration it returns offset 0 but you add text from that offset). — Victoria, Jan 26 '18 at 03:39
You miss the first occurrence, and copy a bogus one right at the end. Solve this by placing the call to PosEx that you make inside the loop, after the line that adds to the memo. I suggest that you consider using the debugger to understand what your program is doing. — David Heffernan, Jan 26 '18 at 03:42
Use a regular expression, instead of looping. Let the regex do it, and iterate through the matches. — Ken White, Jan 26 '18 at 04:12
It seems you did not follow my advice from your last question. Debugging is an important skill to learn. See my answer, where the solution already was given in the first question. — LU RD, Jan 26 '18 at 08:32
You had a similar question a few days ago. Didn't that answer your previous question? — Rudy Velthuis, Jan 26 '18 at 10:51
@Rudy, I cannot find it. Where is that question, please? (RegEx is an overkill here, I must add to Ken White's idea). — Victoria, Jan 26 '18 at 23:34

LU RD · Accepted Answer · 2018-01-26T08:27:38.630

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;

It took me a while to understand what is really happening with the loop. I now understand. Well done sir, thank you so much. — Bianca, Jan 26 '18 at 15:59

score 1 · Answer 2 · answered Jan 26 '18 at 07:55

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;

This code is working, thank you for the help. I pick the first answer, mr. LURD was guide me yesterday on my previous question. Thanks again. — Bianca, Jan 26 '18 at 16:02

zeus · Answer 3 · 2018-01-26T14:53:25.523

0

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;

edited Jan 26 '18 at 14:53

answered Jan 26 '18 at 08:19

zeus

12,173
9
63
184

Did you test that? – Rudy Velthuis Jan 26 '18 at 10:53
no, but i think their is no raison it's will not work (maybe need to check if Copy(aList[i], 1, 2) will not make an exception if an empty string, i thnik not – zeus Jan 26 '18 at 11:18
What if `'MAMAMIA'` is at the end of the text? – Rudy Velthuis Jan 26 '18 at 11:29
Then try with `'x' + '123HEREWEGOMAMAMIAGOWILLYOULETMEGOMAMAMIATOLOVEYOUSOMAMAMIASOIHATEYOUMAMAMIAHEYMAMAMIAM'`. It will list `'MAMAMIAM'` as result too, but that is wrong. – Rudy Velthuis Jan 26 '18 at 14:02
why MAMAMIAM is wrong ? it's what he want + 2 chars (here their is only 1 but he didn't say it's MUST have at least 2 chars) ... else add if length(aList[i]) >= 2 then .. – zeus Jan 26 '18 at 14:37
There should be 2 following chars. MAMAMIAM has only one extra char, and should not qualify. You forgot to check if the string you add has the correct length (`Length('MAMAMIA') + 2`) – Rudy Velthuis Jan 26 '18 at 14:51

Extract multiple substring

3 Answers3