version2

function StrMaskMatch(expression, str: string; mask: Char; Sensitive: Boolean; var match: string): Boolean;
var
  a: TStrArray;
  s, h, i, l, w, z, f, p, o, m: Integer;
  e: string;
  x, y: Boolean;
begin
  match := '';
  Result := False;
  l := Length(expression);
  z := Length(str);
  if ((l > 0) and (z > 0)) then
  begin
    l := (l - 1);
    for i := 1 to l do
      if not ((expression[i] = mask) and (expression[(i + 1)] = mask)) then
        e := (e + expression[i]);
    e := (e + expression[(l + 1)]);
    a := Explode(mask, e);
    h := High(a);
    s := 0;
    w := 0;
    for i := 0 to h do
      if (a[i] <> '') then
      begin
        a[s] := a[i];
        w := (w + Length(a[s]));
        s := (s + 1);
      end;
    Result := (s = 0);
    case Result of
      False:
      begin
        x := (e[1] = mask);
        y := (e[Length(e)] = mask);
        case (s > 1) of
          True:
          begin
            SetLength(a, s);
            h := (s - 1);
            s := Length(e);
            if ((x or y) and (w > z)) then
              Exit;
            case Sensitive of
              True:
              begin
                case x of
                  True:
                  begin
                    f := 2;
                    m := 1;
                  end;
                  False:
                  begin
                    f := 1;
                    m := z;
                  end;
                end;
                p := f;
                o := 0;
                for i := 0 to h do
                begin
                  p := PosEx(a[i], str, p);
                  if (p < 1) then
                    Exit;
                  if (p < m) then
                    m := p;
                  p := ((p + Length(a[i])) + 1);
                end;
                Result := not y;
                case Result of
                  False:
                  begin
                    Result := ((p - 1) <= z);
                    if Result then
                      match := Copy(str, m, ((z - m) + 1));
                  end;
                  True: match := Copy(str, m, (p - m) - 1);
                end;
              end;
              False:
              begin
                if x then
                  f := PosEx(a[0], str, 2)
                else
                  f := Pos(a[0], str);
                if (f > 0) then
                begin
                  m := (f + Length(a[0]));
                  if y then
                    p := (z - 1)
                  else
                    p := z;
                  l := LastPosEx(a[h], str, p);
                  if (l > 0) then
                  begin
                    if (h > 1) then
                    for i := (h - 1) downto 1 do
                    begin
                      p := LastPosEx(a[i], str, p);
                      if (p < 1) then
                        Exit;
                      p := ((p - Length(a[i])) + 1);
                    end;
                    Result := True;
                    case (x or y) of
                      True:
                      case (x and y) of
                        False:
                        if y then
                          match := Copy(str, f, ((z - f) + 1))
                        else
                          match := Copy(str, 1, ((l + Length(a[h])) - 1));
                        True: match := str;
                      end;
                      False: match := Copy(str, f, (l - f) + Length(a[h]));
                    end;
                  end;
                end;
              end;
            end;
          end;
          False:
          begin
            if x then
              p := PosEx(a[0], str, 2)
            else
              p := Pos(a[0], str);
            if (p > 0) then
              Result := ((((p - 1) + Length(a[0])) < z) or not y);
            if Result then
            case not (x or y) of
              False:
              case (x and y) of
                False:
                if not x then
                  match := (Copy(str, p, (z - p) + 1))
                else
                  match := (Copy(str, 1, (p - 1)) + a[0]);
                True: match := str;
              end;
              True: match := a[0];
            end;
          end;
        end;
      end;
      True: match := str;
    end;
  end;
end;

function StrMaskMatch(expression, str: string; mask: Char; Sensitive: Boolean; var match: string): Boolean;
var
  a: TStrArray;
  s, h, i, l, w, z, f, p, o, m: Integer;
  e: string;
  x, y: Boolean;
begin
  match := '';
  Result := False;
  l := Length(expression);
  z := Length(str);
  if ((l > 0) and (z > 0)) then
  begin
    l := (l - 1);
    for i := 1 to l do
      if not ((expression[i] = mask) and (expression[(i + 1)] = mask)) then
        e := (e + expression[i]);
    e := (e + expression[(l + 1)]);
    a := Explode(mask, e);
    h := High(a);
    s := 0;
    w := 0;
    for i := 0 to h do
      if (a[i] <> '') then
      begin
        a[s] := a[i];
        w := (w + Length(a[s]));
        s := (s + 1);
      end;
    Result := (s = 0);
    case Result of
      False:
      begin
        x := (e[1] = mask);
        y := (e[Length(e)] = mask);
        case (s > 1) of
          True:
          begin
            SetLength(a, s);
            h := (s - 1);
            s := Length(e);
            if ((x or y) and (w > z)) then
              Exit;
            case Sensitive of
              True:
              begin
                case x of
                  True:
                  begin
                    f := 2;
                    m := 1;
                  end;
                  False:
                  begin
                    f := 1;
                    m := z;
                  end;
                end;
                p := f;
                o := 0;
                for i := 0 to h do
                begin
                  p := PosEx(a[i], str, p);
                  if (p < 1) then
                    Exit;
                  if (p < m) then
                    m := p;
                  p := ((p + Length(a[i])) + 1);
                end;
                Result := not y;
                case Result of
                  False:
                  begin
                    Result := ((p - 1) <= z);
                    if Result then
                      match := Copy(str, m, ((z - m) + 1));
                  end;
                  True: match := Copy(str, m, (p - m) - 1);
                end;
              end;
              False:
              begin
                if x then
                  f := PosEx(a[0], str, 2)
                else
                  f := Pos(a[0], str);
                if (f > 0) then
                begin
                  m := (f + Length(a[0]));
                  if y then
                    p := (z - 1)
                  else
                    p := z;
                  l := LastPosEx(a[h], str, p);
                  if (l > 0) then
                  begin
                    if (h > 1) then
                    for i := (h - 1) downto 1 do
                    begin
                      p := LastPosEx(a[i], str, p);
                      if (p < 1) then
                        Exit;
                      p := ((p - Length(a[i])) + 1);
                    end;
                    Result := True;
                    case (x or y) of
                      True:
                      case (x and y) of
                        False:
                        if y then
                          match := Copy(str, f, ((z - f) + 1))
                        else
                          match := Copy(str, 1, ((l - Length(a[h])) + f));
                        True: match := str;
                      end;
                      False: match := Copy(str, f, (l - f) + Length(a[h]));
                    end;
                  end;
                end;
              end;
            end;
          end;
          False:
          begin
            if x then
              p := PosEx(a[0], str, 2)
            else
              p := Pos(a[0], str);
            if (p > 0) then
              Result := ((((p - 1) + Length(a[0])) < z) or not y);
            if Result then
            case not (x or y) of
              False:
              case (x and y) of
                False:
                if not x then
                  match := (Copy(str, p, (z - p) + 1))
                else
                  match := (Copy(str, 1, (p - 1)) + a[0]);
                True: match := str;
              end;
              True: match := a[0];
            end;
          end;
        end;
      end;
      True: match := str;
    end;
  end;
end;

var
  Str, expression, Match: string;

begin
  ClearDebug;
  expression := 'This* * here*!! ';
  Str := 'This... This is text text right here!!! here is something!?';
  if StrMaskMatch(expression, Str, '*', False, Match) then
    WriteLn('Matched: "' + Match + '"');
end.

function StrMaskMatch(expression, str: string; mask: Char; var match: string): Boolean;
var
  a: TStrArray;
  s, h, i, l, w, z, f, p, o, m: Integer;
  e: string;
  x, y: Boolean;
begin
  match := '';
  Result := False;
  l := Length(expression);
  z := Length(str);
  if ((l > 0) and (z > 0)) then
  begin
    l := (l - 1);
    for i := 1 to l do
      if not ((expression[i] = mask) and (expression[(i + 1)] = mask)) then
        e := (e + expression[i]);
    e := (e + expression[(l + 1)]);
    a := Explode(mask, e);
    h := High(a);
    s := 0;
    w := 0;
    for i := 0 to h do
      if (a[i] <> '') then
      begin
        a[s] := a[i];
        w := (w + Length(a[s]));
        s := (s + 1);
      end;
    Result := (s = 0);
    case Result of
      False:
      begin
        x := (e[1] = mask);
        y := (e[Length(e)] = mask);
        case (s > 1) of
          True:
          begin
            SetLength(a, s);
            h := (s - 1);
            s := Length(e);
            if ((x or y) and (w > z)) then
              Exit;
            case x of
              True:
              begin
                f := 2;
                m := 1;
              end;
              False:
              begin
                f := 1;
                m := z;
              end;
            end;
            p := f;
            o := 0;
            for i := 0 to h do
            begin
              p := PosEx(a[i], str, p);
              if (p < 1) then
                Exit;
              if (p < m) then
                m := p;
              p := ((p + Length(a[i])) + 1);
            end;
            Result := not y;
            case Result of
              False:
              begin
                Result := ((p - 1) <= z);
                if Result then
                  match := Copy(str, m, ((z - m) + 1));
              end;
              True: match := Copy(str, m, (p - m) - 1);
            end;
          end;
          False:
          begin
            if x then
              p := PosEx(a[0], str, 2)
            else
              p := Pos(a[0], str);
            if (p > 0) then
              Result := ((((p - 1) + Length(a[0])) < z) or not y);
            if Result then
            case not (x or y) of
              False:
              case (x and y) of
                False:
                if not x then
                  match := (Copy(str, p, (z - p) + 1))
                else
                  match := (Copy(str, 1, (p - 1)) + a[0]);
                True: match := str;
              end;
              True: match := a[0];
            end;
          end;
        end;
      end;
      True: match := str;
    end;
  end;
end;

var
  Str, expression, Match: string;

begin
  ClearDebug;
  expression := 'text * here';
  Str := 'a ggThis is text text right here here!!! stet f';
  if StrMaskMatch(expression, Str, '*', Match) then
    WriteLn('Matched: "' + Match + '"');
end.