00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { Regular Expressions }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZMatchPattern;
00055 {
00056 Author: Kevin Boylan
00057 Ported By: Sergey Seroukhov
00058
00059 This code is meant to allow wildcard pattern matches.
00060 It is VERY useful for matching filename wildcard patterns.
00061 It allows unix grep-like pattern comparisons, for instance:
00062
00063 ? Matches any single characer
00064 * Matches any contiguous characters
00065 [abc] Matches a or b or c at that position
00066 [^abc] Matches anything but a or b or c at that position
00067 [!abc] Ditto
00068 [a-e] Matches a through e at that position
00069
00070 'ma?ch.*' -Would match match.exe, mavch.dat, march.on, etc
00071 'this [e-n]s a [!zy]est' - Would match 'this is a test',
00072 but would not match 'this as a yest'
00073
00074 This is a Delphi VCL translation from C code that was downloaded from CIS.
00075 C code was written by J. Kerceval and released to public domain 02/20/1991.
00076 This code is ofcourse also public domain. I would appreciate it if you would
00077 let me know if you find any bugs. I would also appreciate any notes sent my
00078 way letting me know if you find it useful.
00079 }
00080
00081 {$I ZCore.inc}
00082
00083 interface
00084
00085 uses SysUtils;
00086
00087 { Check if Text equal to pattern }
00088 function IsMatch(const Pattern, Text: string): Boolean;
00089
00090 implementation
00091
00092 const
00093 { Match defines }
00094 MATCH_PATTERN = 6;
00095 MATCH_LITERAL = 5;
00096 MATCH_RANGE = 4;
00097 MATCH_ABORT = 3;
00098 MATCH_END = 2;
00099 MATCH_VALID = 1;
00100 { Pattern defines }
00101 { PATTERN_VALID = 0;
00102 PATTERN_ESC = -1;
00103 PATTERN_RANGE = -2;
00104 PATTERN_CLOSE = -3;
00105 PATTERN_EMPTY = -4;
00106 }{ Character defines }
00107 MATCH_CHAR_SINGLE = '?';
00108 MATCH_CHAR_KLEENE_CLOSURE = '*';
00109 MATCH_CHAR_RANGE_OPEN = '[';
00110 MATCH_CHAR_RANGE = '-';
00111 MATCH_CHAR_RANGE_CLOSE = ']';
00112 MATCH_CHAR_CARET_NEGATE = '^';
00113 MATCH_CHAR_EXCLAMATION_NEGATE = '!';
00114
00115 function Matche(Pattern, Text: string): Integer; forward;
00116 function MatchAfterStar(Pattern, Text: string): Integer; forward;
00117
00118
00119 function IsMatch(const Pattern, Text: string): Boolean;
00120 begin
00121 Result := (Matche(Pattern, Text) = 1);
00122 end;
00123
00124 function Matche(Pattern, Text: string): Integer;
00125 var
00126 RangeStart, RangeEnd, P, T, PLen, TLen: Integer;
00127 Invert, MemberMatch, Loop: Boolean;
00128 begin
00129 P := 1;
00130 T := 1;
00131 Pattern := AnsiLowerCase(pattern);
00132 Text := AnsiLowerCase(Text);
00133 PLen := Length(pattern);
00134 TLen := Length(text);
00135 Result := 0;
00136 while ((Result = 0) and (P <= PLen)) do
00137 begin
00138 if T > TLen then
00139 begin
00140 if (Pattern[P] = MATCH_CHAR_KLEENE_CLOSURE) and (P+1 > PLen) then
00141 Result := MATCH_VALID
00142 else
00143 Result := MATCH_ABORT;
00144 Exit;
00145 end else
00146 case (Pattern[P]) of
00147 MATCH_CHAR_KLEENE_CLOSURE:
00148 Result := MatchAfterStar(Copy(Pattern,P,PLen),Copy(Text,T,TLen));
00149 MATCH_CHAR_RANGE_OPEN:
00150 begin
00151 Inc(P);
00152 Invert := False;
00153 if (Pattern[P] = MATCH_CHAR_EXCLAMATION_NEGATE) or
00154 (Pattern[P] = MATCH_CHAR_CARET_NEGATE) then
00155 begin
00156 Invert := True;
00157 Inc(P);
00158 end;
00159 if (Pattern[P] = MATCH_CHAR_RANGE_CLOSE) then
00160 begin
00161 Result := MATCH_PATTERN;
00162 Exit;
00163 end;
00164 MemberMatch := False;
00165 Loop := True;
00166 while (Loop and (Pattern[P] <> MATCH_CHAR_RANGE_CLOSE)) do
00167 begin
00168 RangeStart := P;
00169 RangeEnd := P;
00170 Inc(P);
00171 if P > PLen then
00172 begin
00173 Result := MATCH_PATTERN;
00174 Exit;
00175 end;
00176 if Pattern[P] = MATCH_CHAR_RANGE then
00177 begin
00178 Inc(P);
00179 RangeEnd := P;
00180 if (P > PLen) or (Pattern[RangeEnd] = MATCH_CHAR_RANGE_CLOSE) then
00181 begin
00182 Result := MATCH_PATTERN;
00183 Exit;
00184 end;
00185 Inc(P);
00186 end;
00187 if P > PLen then
00188 begin
00189 Result := MATCH_PATTERN;
00190 Exit;
00191 end;
00192 if RangeStart < RangeEnd then
00193 begin
00194 if (Text[T] >= Pattern[RangeStart]) and
00195 (Text[T] <= Pattern[RangeEnd]) then
00196 begin
00197 MemberMatch := True;
00198 Loop := False;
00199 end;
00200 end
00201 else
00202 begin
00203 if (Text[T] >= Pattern[RangeEnd]) and
00204 (Text[T] <= Pattern[RangeStart]) then
00205 begin
00206 MemberMatch := True;
00207 Loop := False;
00208 end;
00209 end;
00210 end;
00211 if (Invert and MemberMatch) or (not (Invert or MemberMatch)) then
00212 begin
00213 Result := MATCH_RANGE;
00214 Exit;
00215 end;
00216 if MemberMatch then
00217 while (P <= PLen) and (Pattern[P] <> MATCH_CHAR_RANGE_CLOSE) do
00218 Inc(P);
00219 if P > PLen then
00220 begin
00221 Result := MATCH_PATTERN;
00222 Exit;
00223 end;
00224 end;
00225 else
00226 if Pattern[P] <> MATCH_CHAR_SINGLE then
00227 if Pattern[P] <> Text[T] then
00228 Result := MATCH_LITERAL;
00229 end;
00230 Inc(P);
00231 Inc(T);
00232 end;
00233 if Result = 0 then
00234 if T <= TLen then
00235 Result := MATCH_END
00236 else
00237 Result := MATCH_VALID;
00238 end;
00239
00240 function MatchAfterStar(Pattern, Text: string): Integer;
00241 var
00242 P, T, PLen, TLen: Integer;
00243 begin
00244 Result := 0;
00245 P := 1;
00246 T := 1;
00247 PLen := Length(Pattern);
00248 TLen := Length(Text);
00249 if TLen = 1 then
00250 begin
00251 Result := MATCH_VALID;
00252 Exit;
00253 end;
00254 if (PLen = 0) or (TLen = 0) then
00255 begin
00256 Result := MATCH_ABORT;
00257 Exit;
00258 end;
00259 while ((T <= TLen) and (P < PLen)) and ((Pattern[P] = MATCH_CHAR_SINGLE) or
00260 (Pattern[P] = MATCH_CHAR_KLEENE_CLOSURE)) do
00261 begin
00262 if Pattern[P] = MATCH_CHAR_SINGLE then Inc(T);
00263 Inc(P);
00264 end;
00265 if T >= TLen then
00266 begin
00267 Result := MATCH_ABORT;
00268 Exit;
00269 end;
00270 if P >= PLen then
00271 begin
00272 Result := MATCH_VALID;
00273 Exit;
00274 end;
00275 repeat
00276 if (Pattern[P] = Text[T]) or (Pattern[P] = MATCH_CHAR_RANGE_OPEN) then
00277 begin
00278 Pattern := Copy(Pattern, P, PLen);
00279 Text := Copy(Text, T, TLen);
00280 PLen := Length(Pattern);
00281 TLen := Length(Text);
00282 p := 1;
00283 t := 1;
00284 Result := Matche(Pattern, Text);
00285 if Result <> MATCH_VALID then
00286 Result := 0;
00287 end;
00288 Inc(T);
00289 if (T > TLen) or (P > PLen) then
00290 begin
00291 Result := MATCH_ABORT;
00292 Exit;
00293 end;
00294 until Result <> 0;
00295 end;
00296
00297 (*
00298 function IsPattern(const Pattern: string): Boolean;
00299 var
00300 I: Integer;
00301 begin
00302 Result := False;
00303 for I := 1 to Length(Pattern) do
00304 if Pos(Pattern[I], '[]?*') > 0 then
00305 begin
00306 Result := True;
00307 Exit;
00308 end;
00309 end;
00310 *)
00311
00312 end.
00313
00314