1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:

{ Like prüft die Übereinstimmung eines Strings mit einem Muster. 
  So liefert Like('Delphi', 'D*p?i') true. 
  Der Vergleich berücksichtigt Klein- und Großschreibung. 
  Ist das nicht gewünscht, muss statt dessen 
  Like(AnsiUpperCase(AString), AnsiUpperCase(APattern)) benutzt werden: 
  Von Michael Winter
  GPo: ordentliche und schnelle Routine.
}

function Like(const AString, APattern: String): Boolean;
var
  StringPtr, PatternPtr: PChar;
  StringRes, PatternRes: PChar;
begin
  Result:=false;
  StringPtr:=PChar(AString);
  PatternPtr:=PChar(APattern);
  StringRes:=nil;
  PatternRes:=nil;
  repeat
    repeat // ohne vorangegangenes "*"
      case PatternPtr^ of
        #0: begin
          Result:=StringPtr^=#0;
          if Result or (StringRes=nil) or (PatternRes=nil) then
            Exit;
          StringPtr:=StringRes;
          PatternPtr:=PatternRes;
          Break;
        end;
        '*': begin
          inc(PatternPtr);
          PatternRes:=PatternPtr;
          Break;
        end;
        '?': begin
          if StringPtr^=#0 then
            Exit;
          inc(StringPtr);
          inc(PatternPtr);
        end;
        else begin
          if StringPtr^=#0 then
            Exit;
          if StringPtr^<>PatternPtr^ then begin
            if (StringRes=nil) or (PatternRes=nil) then
              Exit;
            StringPtr:=StringRes;
            PatternPtr:=PatternRes;
            Break;
          end
          else begin
            inc(StringPtr);
            inc(PatternPtr);
          end;
        end;
      end;
    until false;
    repeat // mit vorangegangenem "*"
      case PatternPtr^ of
        #0: begin
          Result:=true;
          Exit;
        end;
        '*': begin
          inc(PatternPtr);
          PatternRes:=PatternPtr;
        end;
        '?': begin
          if StringPtr^=#0 then
            Exit;
          inc(StringPtr);
          inc(PatternPtr);
        end;
        else begin
          repeat
            if StringPtr^=#0 then
              Exit;
            if StringPtr^=PatternPtr^ then
              Break;
            inc(StringPtr);
          until false;
          inc(StringPtr);
          StringRes:=StringPtr;
          inc(PatternPtr);
          Break;
        end;
      end;
    until false;
  until false;
end; 


{ von unbekannt
  GPo: nicht empfehlenswert. Mit berüchtigter Goto Anweisung!
}

function CompareWildString(const wild, Name : string) : Boolean;
label goback;
var
   w : PChar;
   n : PChar;

   back : array[0..MAXB-1, 0..1] of PChar;
   s1, s2 : char;
   bi : integer;
begin
   w := PChar(wild);
   n := PChar(Name);
   bi := 0;

   while (n^ <> #0) or (w^ <> #0) do
   begin
      case w^ of

         '*':
         begin
            if bi = MAXB then
            begin
               raise Exception.CreateFmt('CompareWildString(%s, %s)'#13#10+
                  'too many levels of ''*''', [wild, Name]);
            end;
            back[bi, 0] := w;
            back[bi, 1] := n;

            Inc(bi);
            Inc(w);
            continue;


goback:
            Dec(bi);

            while (bi >= 0) and (back[bi,1]^ = #0) do
               Dec(bi);
            if bi < 0 then
            begin
               Result := False;
               Exit;
            end;

            w := back[bi,0];
            Inc(w);
            Inc(back[bi,1]);
            n := back[bi,1];
            Inc(bi);
            continue;
         end;

         '?':
         begin
            if n^ = #0 then
            begin
               if bi > 0 then
                  goto goback;
               Result := False;
               Exit;
            end;
         end;

      else
      // default
      begin
         s1 := n^;
         s2 := w^;

         if s1 <> s2 then
         begin
            if bi > 0 then
               goto goback;
            Result := False;
            Exit;
         end;
      end; // default
      end; // case ...

      if n^ > #0 then
         Inc(n);
      if w^ > #0 then
         Inc(w);
   end;
   Result := True;
end;					

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:

{*****************************************************************}
{* This function implements a subset of regular expression based *}
{* search and is based on the translation of PattenMatch() API   *}
{* of common.c in MSDN Samples\VC98\sdk\sdktools\tlist           *}
{*****************************************************************}
{* MetaChars are  :                                              *}
{*            '*' : Zero or more chars.                          *}
{*            '?' : Any one char.                                *}
{*         [adgj] : Individual chars (inclusion).                *}
{*        [^adgj] : Individual chars (exclusion).                *}
{*          [a-d] : Range (inclusion).                           *}
{*         [^a-d] : Range (exclusion).                           *}
{*       [a-dg-j] : Multiple ranges (inclusion).                 *}
{*      [^a-dg-j] : Multiple ranges (exclusion).                 *}
{*  [ad-fhjnv-xz] : Mix of range & individual chars (inclusion). *}
{* [^ad-fhjnv-xz] : Mix of range & individual chars (exclusion). *}
{*****************************************************************}
{
1. Removed bug wherein InputString="ab" is rejected by Pattern="a*b".
2. Optimization has been incorporated for trailing wildcard "*" in the Pattern string. 
   For such cases, there is a very significant speed increase which is directly propotional
   to the number of chars in the InputString that match the trailing Pattern wildcard. e.g. 
   this function is 20 times faster for Pattern="a*" and InputString="abbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb".
   The speed difference becomes even more on increasing the number of "b" characters in the InputString.
3. Added new functionality of set exclusion. e.g. [^a-d] matches true if the InputString character is not a,b,c or d.
4. Discarded local variables in the original translation. Used array notation instead.
5. Added plenty of comments!
6. This implementation is on an average 20% faster than the original translation.
}

function MatchPattern(InpStr,Pattern: PChar): Boolean;
begin
  Result:= True;
  while(True) do
  begin
    case Pattern[0] of
      #0 :begin //End of pattern reached.
            Result := (InpStr[0] = #0); //TRUE if end of InpStr.
            Exit;
          end;

      '*':begin //Match zero or more occurances of any char.
            if(Pattern[1] = #0)then
            begin //Match any number of trailing chars.
              Result := True;
              Exit;
            end else Inc(Pattern);

            while(InpStr[0] <> #0)do
            begin //Try to match any substring of InpStr.
              if(MatchPattern(InpStr,Pattern))then
              begin
                Result := True;
                Exit;
              end;

              //Continue testing next char...
              Inc(InpStr);
            end;
          end;

      '?':begin //Match any one char.
            if(InpStr[0] = #0)then
            begin
              Result := False;
              Exit;
            end;

            //Continue testing next char...
            Inc(InpStr);
            Inc(Pattern);
          end;

      '[':begin //Match given set of chars.
            if(Pattern[1] in [#0,'[',']']) then
            begin //Invalid Set - So no match.
              Result := False;
              Exit;
            end;

            if(Pattern[1] = '^')then
            begin //Match for exclusion of given set...
              Inc(Pattern,2);
              Result := True;
              while(Pattern[0] <> ']')do
              begin
                if(Pattern[1] = '-')then
                begin //Match char exclusion range.
                  if(InpStr[0] >= Pattern[0])and(InpStr[0] <= Pattern[2])then
                  begin //Given char failed set exclusion range.
                    Result := False;
                    Break;
                  end else Inc(Pattern,3);
                end else
                begin //Match individual char exclusion.
                  if(InpStr[0] = Pattern[0])then
                  begin //Given char failed set element exclusion.
                    Result := False;
                    Break;
                  end else Inc(Pattern);
                end;
              end;
            end else
            begin //Match for inclusion of given set...
              Inc(Pattern);
              Result := False;
              while(Pattern[0] <> ']')do
              begin
                if(Pattern[1] = '-')then
                begin //Match char inclusion range.
                  if(InpStr[0] >= Pattern[0])and(InpStr[0] <= Pattern[2])then
                  begin //Given char matched set range inclusion. Continue testing...
                    Result := True;
                    Break;
                  end else Inc(Pattern,3);
                end else
                begin //Match individual char inclusion.
                  if(InpStr[0] = Pattern[0])then
                  begin //Given char matched set element inclusion. Continue testing...
                    Result := True;
                    Break;
                  end else Inc(Pattern);
                end;
              end;
            end;

            if(Result)then
            begin //Match was found. Continue further.
              Inc(InpStr);

              //Position Pattern to char after "]"
              while(Pattern[0] <> ']')and(Pattern[0] <> #0)do Inc(Pattern);

              if(Pattern[0] = #0)then
              begin //Invalid Pattern - missing "]"
                  Result := False;
                  Exit;
              end else Inc(Pattern);
            end else Exit;
          end;

     else begin //Match given single char.
            if(InpStr[0] <> Pattern[0])then
            begin
              Result := False;
              Break;
            end;

            //Continue testing next char...
            Inc(InpStr);
            Inc(Pattern);
          end;
    end;
  end;
end;