Delphi-Help

unit awMachMask;

interface

uses Classes;

{Работа со списком шаблонов Функции предназначены

для сопоставления текстов (имен файлов) на соответствие

заданному шаблону или списку шаблонов. Обычно используется

для построения простых фильтров, например аналогичных

файловым фильтрам программы Total Commander. Каждый шаблон

аналогичен шаблону имен файлов в MS-DOS и MS Windows, т.е.

может включать "шаблонные" символы '*' и '?' и не может

включать символ '|'. Любой шаблон может быть заключен в

двойные кавычки ('''), при этом двойные кавычки имеющиеся в

шаблоне должны быть удвоены. Если шаблон включает символы ';'

 или ' ' (пробел) то он обязательно должен быть заключен в

двойные кавычки. В списке, шаблоны разделяются символом ';'.

За первым списком шаблонов, может следовать символ '|', за 

которым может следовать второй список. Текст (имя файла) будет

 считаться соответствующим списку шаблонов только если он 

соответствует хотя бы одному шаблону из первого списка, и 

не соответствует ни одному шаблону из второго списка. Если 

первый список пуст, то подразумевается '*' Формальное описание

синтаксиса списка шаблонов: Полный список шаблонов      :: 

[<список включаемых шаблонов>]['|'<список исключаемых шаблонов>]

список включаемых шаблонов  :: <список шаблонов>

список исключаемых шаблонов :: <список шаблонов>

список шаблонов             :: <шаблон>[';'<шаблон>]

шаблон                      :: шаблон аналогичный шаблону имен файлов в

MS-DOS и MS Windows, т.е. может включать

"шаблонные" символы '*' и '?' и не может

включать символ '|'. Шаблон может быть

заключен в двойные кавычки (''') при этом

двойные кавычки имеющиеся в шаблоне должны

быть удвоены. Если шаблон включает символы

';' или ' ' (пробел) то он

обязательно должен быть заключен в двойные

кавычки.

Например:

'*.ini;*.wav'- соответствует любым файлам с расшиениями 'ini'

или 'wav'

'*.*|*.exe'- соответствует любым файлам, кроме файлов с

расширением 'EXE'

'*.mp3;*.wav|?.*;??.*' - соответствует любым файлам с 

расшиениями 'mp3'

и 'wav' за исключением файлов у которых имя

состоит из одного или двух символов.

'|awString.*'          - соответствует любым файлам за

 исключением файлов

с именем awString и любым расширением.

}

Function IsMatchMask (aText, aMask :pChar ) :Boolean; overload;

Function IsMatchMask (aText, aMask :String;

     aFileNameMode :Boolean =True) :Boolean; overload;

//Выполняют сопоставление текста aText с одним шаблоном aMask.

//Возвращает True если сопоставление выполнено успешно, т.е. текст

//aText соответствует шаблону aMask.

//Если aFileNameModd=True, то объект используется для сопоставления

//имен файлов с шаблоном. А именно, в этом случае, если aText не

//содержит символа '.' то он добавляется в конец. Это необходимо для

//того, чтобы файлы без расширений соответствовали например шаблону '*.*'

Function IsMatchMaskList (aText, aMaskList :String;

 aFileNameMode :Boolean =True): Boolean;

  // Выполняет сопоставление текста aText со списком шаблонов aMaskList.

  // Возвращает True если сопоставление выполнено успешно, т.е. текст

  // aText соответствует списку шаблонов aMaskList.

//Если aFileNameModd=True, то объект используется для сопоставления

//имен файлов с шаблоном. А именно, в этом случае, если aText не

//содержит символа '.' то он добавляется в конец. Это необходимо для

//того, чтобы файлы без расширений соответствовали например шаблону '*.*'

//Замечание, если требуется проверка сопоставления нескольких строк одному

//списку шаблонов, эффективнее будет воспользоваться объектом tMatchMaskList.

Type

  tMatchMaskList = class(tObject)

    Private

      fMaskList      :String;

      fCaseSensitive :Boolean;

      fFileNameMode  :Boolean;

      fPrepared     :Boolean;

      fIncludeMasks :tStringList;

      fExcludeMasks :tStringList;

      procedure SetMaskList      (v :String );

      procedure SetCaseSensitive (v :Boolean);

    Public

      constructor Create (Const aMaskList :String ='');

//Создает объект. Если задан параметр aMaskList, то он присваивается

        // свойству MaskList.

      destructor  Destroy;    override;

        // Разрушает объект

      procedure PrepareMasks;

// Осуществляет компиляцию списка шаблонов во внутреннюю структуру

// используемую при сопоставлении текста.

// Вызов данного метода не является обязательным и при необходимости

// будет вызван автоматически.

      Function IsMatch (aText :String) :Boolean;

// Выполняет сопоставление текста aText со списком шаблонов MaskList.

// Возвращает True если сопоставление выполнено успешно, т.е. текст

// aText соответствует списку шаблонов MaskList.

      Property MaskList:String   Read fMaskList  Write SetMaskList;

// Списко шаблонов используемый для сопоставления с текстом

      Property CaseSensitive :Boolean  Read fCaseSensitive  

 Write SetCaseSensitive   default False;

// Если False (по умолчанию), то при сопоставлении текста будет

// регистр символов не будет учитываться.

// Иначе, если True, сопоставление будет проводиться с учетом регистра.

      Property FileNameMode :Boolean   Read fFileNameMode 

   Write fFileNameMode      default True;

// Если True (по умолчанию), то объект используется для сопоставления

// имен файлов с шаблоном. А именно, в этом случае, если aText не

// содержит символа '.' то он добавляется в конец. Это необходимо для

// того, чтобы файлы без расширений соответствовали например шаблону '*.*'

    End;

implementation

uses

  SysUtils

 ;

Function IsMatchMask (aText, aMask :pChar ) :Boolean;  overload;

begin

  Result := False;

  While  True  Do begin

    Case  aMask^  of

      '*'  :   // соответствует любому числу любых символов кроме конца строки

        begin

          // переместиться на очередной символ шаблона, при этом, подряд

          // идущие '*' эквивалентны одному, поэтому пропуск всех '*'

          repeat  Inc(aMask);  Until  (aMask^<>'*');

          // если за '*' следует любой символ кроме '?' то он должен совпасть

          // с символом в тексте. т.е. нужно пропустить все не совпадающие,

          // но не далее конца строки

          If  aMask^ <> '?'  then

            While  (aText^ <> #0) And (aText^ <> aMask^)  Do  Inc(aText);

          If  aText^ <> #0   Then begin  // не конец строки, значит совпал символ

            // '*' 'жадный' шаблон поэтому попробуем отдать совпавший символ

            // ему. т.е. проверить совпадение продолжения строки с шаблоном,

            // начиная с того-же '*'. если продолжение совпадает, то

            If  IsMatchMask (aText+1, aMask-1)  Then  Break;  // это СОВПАДЕНИЕ

            // продолжение не совпало, значит считаем что здесь закончилось

            // соответствие '*'. Продолжим сопоставление со следующего

            // символа шаблона

            Inc(aMask); Inc(aText);     //   иначе переходим к следующему символу

            End

          Else If  (aMask^ = #0)  Then  // конец строки и конец шаблона

            Break                       //     это СОВПАДЕНИЕ

          Else                          // конец строки но не конец шаблона

            Exit                        //     это НЕ СОВПАДЕНИЕ

        End;

      '?'  :   // соответствует любому кроме конца строки

        If (aText^ = #0)  Then          // конец строки

          Exit                          //     это НЕ СОВПАДЕНИЕ

        Else begin                      // иначе

          Inc(aMask); Inc(aText);       //   иначе переходим к следующему символу

        End;

      Else     // символ в шаблоне должен совпасть с символом в строке

        If  aMask^ <> aText^  Then      // символы не совпали -

          Exit                          //     это НЕ СОВПАДЕНИЕ

        Else begin                      // совпал очередной символ

          If  (aMask^ = #0)  Then       //   совпавший символ последний -

            Break;                      //     это СОВПАДЕНИЕ

          Inc(aMask); Inc(aText);       //   иначе переходим к следующему символу

        End;

    End;

  End;

  Result := True;

End;

Function IsMatchMask (aText, aMask :String;

 aFileNameMode :Boolean =True) :Boolean;            overload;

begin

  If  aFileNameMode And (Pos('.',aText)=0)  then  aText := aText+'.';

  Result := IsMatchMask(pChar(aText),pChar(aMask));

End;

Function IsMatchMaskList (aText, aMaskList :String;

 aFileNameMode :Boolean =True) :Boolean;

begin

  With  tMatchMaskList.Create(aMaskList)  Do try

    FileNameMode := aFileNameMode;

    Result := IsMatch(aText);

  finally

    Free;

  End;

End;

/////////////////////////////////////////////////////////// tFileMask

procedure tMatchMaskList.SetMaskList (v :String );

begin

  If  fMaskList = v  Then  Exit;

  fMaskList := v;

  fPrepared := False;

End;

procedure tMatchMaskList.SetCaseSensitive  (v :Boolean);

begin

  If  fCaseSensitive = v  Then  Exit;

  fCaseSensitive := v;

  fPrepared      := False;

End;

constructor tMatchMaskList.Create (Const aMaskList :String);

begin

  MaskList := aMaskList;

  fFileNameMode := True;

  fIncludeMasks := TStringList.Create;  With  fIncludeMasks  Do begin

    Delimiter  := ';';

//    Sorted     := True;

//    Duplicates := dupIgnore;

  End;

  fExcludeMasks := tStringList.Create;  With  fExcludeMasks  Do begin

    Delimiter  := ';';

//    Sorted     := True;

//    Duplicates := dupIgnore;

  End;

End;

destructor  tMatchMaskList.Destroy;

begin

  fIncludeMasks.Free;

  fExcludeMasks.Free;

End;

procedure tMatchMaskList.PrepareMasks;

  procedure CleanList(l :tStrings);

  var i :Integer;

  begin

    For  i := l.Count-1  downto  0  Do   If  l[i] = ''  then  l.Delete(i);

  End;

var

  s :String;

  i :Integer;

begin

  If  fPrepared  Then  Exit;

  If  CaseSensitive  Then

    s := MaskList

  Else

    s := UpperCase(MaskList);

  i := Pos('|',s);

  If  i =  0  Then begin

    fIncludeMasks.DelimitedText := s;

    fExcludeMasks.DelimitedText := '';

    End

  Else begin

    fIncludeMasks.DelimitedText := Copy(s,1,i-1);

    fExcludeMasks.DelimitedText := Copy(s,i+1,MaxInt);

  End;

  CleanList(fIncludeMasks);

  CleanList(fExcludeMasks);

  // если список включаемых шаблонов пуст а

  // список исключаемых шаблонов не пуст, то

  // имеется ввиду что список включаемых шаблонов равен <все файлы>

  If  (fIncludeMasks.Count = 0) And (fExcludeMasks.Count <> 0)  Then

    fIncludeMasks.Add('*');

  fPrepared := True;

End;

Function tMatchMaskList.IsMatch (aText :String) :Boolean;

var

  i :Integer;

begin

  Result := False;

  If  aText = ''  then  Exit;

  If  Not CaseSensitive  Then  aText := UpperCase(aText);

  If  FileNameMode And (Pos('.',aText)=0)  then  aText := aText+'.';

  If  Not fPrepared  Then  PrepareMasks;

  // поиск в списке "включаемых" масок до первого совпадения

  For  i := 0  To  fIncludeMasks.Count-1  Do

    If  IsMatchMask(PChar(aText),PChar(fIncludeMasks[i]))  Then begin

      Result := True;

      Break;

    End;

  // если совпадение найдено, надо проверить по списку "исключаемых"

  If  Result  Then

    For  i := 0  To  fExcludeMasks.Count-1  Do

      If  IsMatchMask(PChar(aText),PChar(fExcludeMasks[i]))  Then begin

        Result := False;

        Break;

      End;

End;

end.