mask match

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;
    if (s > 0) then
    begin
      SetLength(a, s);
      h := (s - 1);
      s := Length(e);
      x := (e[1] = mask);
      y := (e[s] = mask);
      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;
  end;
end;

var
  Str, expression, Match: string;

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