Janilabo | Find() DEV [Simba]

const
  TEXT = 'TEST! Test, Test1 test? test TeSt testest testtest test.';
  STR = 'test';

{==============================================================================]
  Explanation: Important types for Find() function! Contains the string matching methods.
[==============================================================================}
type
  TMatchMethod = (mmAll, mmIgnoreCase, mmOverlap, mmWholeWords, mmStrictWW);
  TMatchMethods = set of TMatchMethod;

{==============================================================================]
  Explanation: Returns a TIA that contains all the value from start value (aStart) to finishing value (aFinish)..
[==============================================================================}
function TIAByRange(aStart, aFinish: Integer): TIntegerArray;
var
  i, s, f: Integer;
begin
  if (aStart <> aFinish) then
  begin
    s := Integer(aStart);
    f := Integer(aFinish);
    SetLength(Result, (IAbs(aStart - aFinish) + 1));
    case (aStart > aFinish) of
      True:
      for i := s downto f do
        Result[(s - i)] := i;
      False:
      for i := s to f do
        Result[(i - s)] := i;
    end;
  end else
    Result := [Integer(aStart)];
end;

{==============================================================================]
  Explanation: Merges T2DIntegerArray (ATIA) to TIntegerArray.
               Example: [[1, 2], [3, 4]] => [1, 2, 3, 4]
[==============================================================================}
function ATIAMerge(ATIA: T2DIntegerArray): TIntegerArray;
var
  i, i2, h, h2, r: Integer;
begin
  h := High(ATIA);
  if (h > -1) then
  begin
    for i := 0 to h do
      IncEx(r, (High(ATIA[i]) + 1));
    SetLength(Result, r);
    r := 0;
    for i := 0 to h do
    begin
      h2 := High(ATIA[i]);
      for i2 := 0 to h2 do
      begin
        Result[r] := Integer(ATIA[i][i2]);
        Inc(r);
      end;
    end;
  end else
    SetLength(Result, 0);
end;

{==============================================================================]
  Explanation: Returns the string that is behind the position in data, size being the length for result that is copied from position.
[==============================================================================}
function Behind(data: string; position, size: Integer): string;
var
  l, r: Integer;
begin
  l := Length(data);
  case ((l > 0) and (position > 1) and (size > 0)) of
    True:
    begin
      if ((position - size) < 1) then
        size := ((position - size) + (size - 1));
      if (position > (l + 1)) then
      begin
        r := ((position - l) - 1);
        size := (size - r);
      end;
      Result := Copy(data, ((position - size) - r), size);
    end;
    False: Result := '';
  end;
end;

{==============================================================================]
  Explanation: Returns the string that is ahead from position in data, size being the length for result that is copied from position.
[==============================================================================}
function Ahead(data: string; position, size: Integer): string;
var
  l: Integer;
begin
  l := Length(data);
  case ((l > 0) and (position <= l) and (size > 0)) of
    True:
    begin
      if (position < 1) then
      begin
        size := (size - iAbs(position - 1));
        position := 1;
      end;
      if ((size > 0) and ((position + size) > l)) then
        size := (size - (((position + size) - l) - 1));
      Result := Copy(data, position, size);
    end;
    False: Result := '';
  end;
end;

{==============================================================================]
  Explanation: Returns all the positions of found/matching strings (findStr) in text.
               Uses a set of TMatchMethod (methods) for string matching.
               Contains field for offset.
[==============================================================================}
function FindEx(text, findStr: string; methods: TMatchMethods; offset: Integer): TIntegerArray;
var
  sb, sa: string;
  r, l, f, o, p, d, x, y: Integer;
  re: TRegExp;
  ma, mb, a, s, ol: Boolean;
  c: TIntegerArray;
begin
  l := Length(text);
  f := Length(findStr);
  if ((l > 0) and (f > 0) and (offset <= (l - f))) then
  begin
    if (offset < 1) then
      offset := 1;
    SetLength(Result, l);
    re := TRegExp.Create;
    re.InputString := text;
    re.Expression := findStr;
    if (mmIgnoreCase in methods) then
      re.ModifierI := True;
    a := (mmAll in methods);
    case a of
      False: re.ModifierG := True;
      True: re.ModifierG := False;
    end;
    ol := (mmOverlap in methods);
    if not ol then
      o := (Length(findStr) - 1);
    Inc(o);
    p := Offset;
    if re.ExecPos(p) then
    repeat
      if (re.Match[0] <> '') then
      begin
        Result[r] := re.MatchPos[0];
        p := (Result[r] + o);
        Inc(r);
      end;
    until not re.ExecPos(p);
    re.Free;
    SetLength(Result, r);
    if ((r > 0) and (mmWholeWords in methods)) then
    begin
      s := (mmStrictWW in methods);
      if not s then
        c := ATIAMerge([TIAByRange(Ord('A'), Ord('Z')), TIAByRange(Ord('a'), Ord('z')), TIAByRange(Ord('0'), Ord('9'))]);
      for x := (r - 1) downto 0 do
      begin
        sb := Behind(text, Result[x], 1);
        sa := Ahead(text, (Result[x] + f), 1);
        case s of
          True:
          begin
            case ol of
              True:
              case (x > 0) of
                True:
                case ((r - 1) > x) of
                  True: mb := ((((Result[(x + 1)] - Result[x]) <= f) or ((Result[x] - Result[(x - 1)]) <= f)) or ((sb = ' ') or (sb = '')));
                  False: mb := (((Result[x] - Result[(x - 1)]) <= f) or ((sb = ' ') or (sb = '')));
                end;
                False:
                case ((r - 1) > x) of
                  True: mb := (((Result[(x + 1)] - Result[x]) <= f) or ((sb = ' ') or (sb = '')));
                  False: mb := ((sb = ' ') or (sb = ''));
                end;
              end;
              False: mb := ((sb = ' ') or (sb = ''));
            end;
            case ol of
              True:
              case (x > 0) of
                True:
                case ((r - 1) > x) of
                  True: ma := ((((Result[(x + 1)] - Result[x]) <= f) or ((Result[x] - Result[(x - 1)]) <= f)) or ((sa = ' ') or (sa = '')));
                  False: ma := (((Result[x] - Result[(x - 1)]) <= f) or ((sa = ' ') or (sa = '')));
                end;
                False:
                case ((r - 1) > x) of
                  True: ma := (((Result[(x + 1)] - Result[x]) <= f) or ((sa = ' ') or (sa = '')));
                  False: ma := ((sa = ' ') or (sa = ''));
                end;
              end;
              False: ma := ((sa = ' ') or (sa = ''));
            end;
          end;
          False:
          begin
            case (sb <> '') of
              True:
              case ol of
                True:
                case (x > 0) of
                  True:
                  case ((r - 1) > x) of
                    True: mb := ((((Result[(x + 1)] - Result[x]) <= f) or ((Result[x] - Result[(x - 1)]) <= f)) or not InIntArray(c, Ord(sb[1])));
                    False: mb := (((Result[x] - Result[(x - 1)]) <= f) or not InIntArray(c, Ord(sb[1])));
                  end;
                  False:
                  case ((r - 1) > x) of
                    True: mb := (((Result[(x + 1)] - Result[x]) <= f) or not InIntArray(c, Ord(sb[1])));
                    False: mb := not InIntArray(c, Ord(sb[1]));
                  end;
                end;
                False: mb := not InIntArray(c, Ord(sb[1]));
              end;
              False: mb := True;
            end;
            case (sa <> '') of
              True:
              case ol of
                True:
                case (x > 0) of
                  True:
                  case ((r - 1) > x) of
                    True: ma := ((((Result[(x + 1)] - Result[x]) <= f) or ((Result[x] - Result[(x - 1)]) <= f)) or not InIntArray(c, Ord(sa[1])));
                    False: ma := (((Result[x] - Result[(x - 1)]) <= f) or not InIntArray(c, Ord(sa[1])));
                  end;
                  False:
                  case ((r - 1) > x) of
                    True: ma := (((Result[(x + 1)] - Result[x]) <= f) or not InIntArray(c, Ord(sa[1])));
                    False: ma := not InIntArray(c, Ord(sa[1]));
                  end;
                end;
                False: ma := not InIntArray(c, Ord(sa[1]));
              end;
              False: ma := True;
            end;
          end;
        end;
        if not (mb and ma) then
        begin
          y := (r - 1);
          for d := x to (y - 1) do
            Result[d] := Result[(d + 1)];
          SetLength(Result, y);
          Dec(r);
        end;
      end;
    end;
    if (not a and (r > 0)) then
      SetLength(Result, 1);
  end else
    SetLength(Result, 0);
end;

{==============================================================================]
  Explanation: Returns all the positions of found/matching strings (findStr) in text.
               Uses a set of TMatchMethod (methods) for string matching.
               Without offset field.
[==============================================================================}
function Find(text, findStr: string; methods: TMatchMethods): TIntegerArray;
begin
  Result := FindEx(text, findStr, methods, 1);
end;

begin
  ClearDebug;
  WriteLn(ToStr(Find(TEXT, STR, [mmIgnoreCase, mmWholeWords, mmStrictWW])) + ' Find(TEXT, STR, [mmIgnoreCase, mmWholeWords, mmStrictWW])');
  WriteLn(ToStr(Find(TEXT, STR, [mmIgnoreCase, mmWholeWords])) + ' Find(TEXT, STR, [mmIgnoreCase, mmWholeWords])');
  WriteLn(ToStr(Find(TEXT, STR, [mmIgnoreCase])) + ' Find(TEXT, STR, [mmIgnoreCase])');
  WriteLn(ToStr(Find(TEXT, STR, [])) + ' Find(TEXT, STR, [])');
  WriteLn(ToStr(Find(TEXT, STR, [mmAll])) + ' Find(TEXT, STR, [mmAll])');
  WriteLn(ToStr(Find(TEXT, STR, [mmAll, mmIgnoreCase])) + ' Find(TEXT, STR, [mmAll, mmIgnoreCase])');
  WriteLn(ToStr(Find(TEXT, STR, [mmAll, mmIgnoreCase, mmWholeWords])) + ' Find(TEXT, STR, [mmAll, mmIgnoreCase, mmWholeWords])');
  WriteLn(ToStr(Find(TEXT, STR, [mmAll, mmIgnoreCase, mmWholeWords, mmStrictWW])) + ' Find(TEXT, STR, [mmAll, mmIgnoreCase, mmWholeWords, mmStrictWW])');
end.