Модуль поиска по маске (более совершеный нежели дельфийский masks)

Previous  Top  Next

    
 

 

 

 

Code:

unit awMachMask; // © Alexandr Petrovich Sysoev

 

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-1Then Break;  // это СОВПАДЕНИЕ

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

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

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

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

           End

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

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

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

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

       End;

 

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

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

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

       Else begin                      // иначе

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

       End;

 

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

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

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

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

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

           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)=0then 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 <> 0Then

   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)=0then 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.

 

 

 

©Drkb::00168

Автор: Петрович

Взято из http://forum.sources.ru