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

=== Модуль поиска по маске (более совершенный нежели дельфийский masks) ===
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-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.
Author: Петрович
Source: Взято из http://forum.sources.ru
ID: 00168