function Matchstrings ( Source , pattern : string ): Boolean ;
var
pSource : array [ 0 .. 255 ] of Char ;
pPattern : array [ 0 .. 255 ] of Char ;
function MatchPattern ( element , pattern : PChar ): Boolean ;
function IsPatternWild ( pattern : PChar ): Boolean ;
var
t : Integer ;
begin
Result := StrScan ( pattern , '*' ) <> nil ;
if not Result then Result := StrScan ( pattern , '?' ) <> nil ;
end ;
begin
if 0 = StrComp ( pattern , '*' ) then
Result := True
else if ( element ^ = Chr ( 0 )) and ( pattern ^ <> Chr ( 0 )) then
Result := False
else if element ^ = Chr ( 0 ) then
Result := True
else
begin
case pattern ^ of
'*' :
if MatchPattern ( element , @ pattern [ 1 ]) then
Result := True
else
Result := MatchPattern (@ element [ 1 ], pattern );
'?' : Result := MatchPattern (@ element [ 1 ], @ pattern [ 1 ]);
else
if element ^ = pattern ^ then
Result := MatchPattern (@ element [ 1 ], @ pattern [ 1 ])
else
Result := False ;
end ;
end ;
end ;
begin
StrPCopy ( pSource , Source );
StrPCopy ( pPattern , pattern );
Result := MatchPattern ( pSource , pPattern );
end ;
procedure TForm1 . Button2Click ( Sender : TObject );
begin
if Matchstrings ( 'Sean Stanley' , 'Sean*' ) then ShowMessage ( 'strings match!' );
if Matchstrings ( 'Sean' , 'Se?n' ) then ShowMessage ( 'strings match!' );
if not Matchstrings ( 'Sean' , 'Se?nn' ) then ShowMessage ( 'strings don''t match!' );
end ;
---------------------------------------
function MatchPatternEx ( InpStr , Pattern : PChar ): Boolean ;
{*****************************************************************}
{* 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). *}
{*****************************************************************}
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 ;