用来替换 MaskMatch 的通配符比较函数

Delphi 提供的通配符匹配函数 TMask.Matches 有些问题：如果通配符字符串太长，比如进入 hotmail 邮箱时的地址有大概 250 个字符。这会导致 TMask.Matches 函数出错，并导致整个程序崩溃。我在网上找了一些不同的实现，并且做了性能比较。现在我优化过的版本分享出来。

 

type
  TMaskMatchResult =  record
    Offset: Integer;  
    PatternLength: Integer;
    LeadingFlexibleLength: Integer;
   end ;


function  HasWildcardsA( const  S:  string ): Boolean;
var
  I: Integer;
begin
  Result := False;
   for  I :=  1  to  Length(S)  do
     if  S[I]  in  [ '*' ,  '?' ]  then
     begin
      Result := True;
      Exit;
     end ;
end ;

// Indicates whether a string matches a wildcard pattern.
function  MatchMaskA( const  APattern, ASource:  string ): Boolean;
var
  I: Integer;
begin
   if  APattern =  ''  then
    Result := ASource =  ''
   else  if  ASource =  ''  then
   begin
     for  I :=  1  to  Length(APattern)  do
       if  APattern[I] <>  '*'  then
       begin
        Result := False;
        Exit;
       end ;
    Result := True;
   end  else
    Result := MatchMaskExA(APattern, ASource).PatternLength = Length(ASource);
end ;

// Indicates whether a string matches a wildcard pattern. 
// When not matched, Result.PatternLength = 0.
function  MatchMaskExA( const  APattern, ASource:  string ; Offset: Integer =  1 ;
 ScanPattern: Boolean = True): TMaskMatchResult;
var
  StringPtr, StringRes, PatternPtr, PatternRes: PChar;
  CountingFlexibleLength: Boolean;
  I: Integer;
begin
  FillChar(Result, SizeOf(Result),  # 0 );
   if  Offset <  1  then
    Offset :=  1 ;

   if  ScanPattern  and  not  HasWildcardsA(APattern)  then
   begin
     if  Offset = PosEx {ANSI only} (APattern, ASource, Offset)  then
     begin
      Result.PatternLength := Length(APattern) {! >0} ;
      Result.Offset := Offset;
     end ;
    Exit;
   end ;

  StringPtr := PChar(ASource);
   if  Offset >  1  then
    Inc(StringPtr, Offset -  1 );
  PatternPtr := PChar(APattern);
  StringRes :=  nil ;
  PatternRes :=  nil ;
  CountingFlexibleLength := (Length(APattern) >  0 )  and  (APattern[ 1 ] =  '*' );
   repeat
     repeat  // ohne vorangegangenes "*"
       case  PatternPtr^  of
         # 0  :  begin
               Result.PatternLength := Length(ASource) + ( 1  - Offset) - Length(StringPtr);
                if  Result.PatternLength >  0  then
                 Result.Offset := Offset;
               Exit;
              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.PatternLength := Length(ASource) + ( 1  - Offset);
                if  AnsiLastChar(APattern) <>  '*'  then
                 Dec(Result.PatternLength, Length(StringPtr));
                if  Result.PatternLength >  0  then
                 Result.Offset := Offset;
                if  CountingFlexibleLength  then
                 Result.LeadingFlexibleLength := Result.PatternLength;
               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;

     if  CountingFlexibleLength  then
     begin
      Result.LeadingFlexibleLength := Length(ASource) - Offset - Length(StringPtr);
      CountingFlexibleLength := False;
     end ;
   until  False;
end ;