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 :StringRead 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 Dobegin

Case aMask^ of

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

begin

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

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

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

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

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

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

If aMask^ <> '?'then

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

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

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

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

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

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

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

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

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

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

End

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

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

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

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

End;

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

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

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

Elsebegin// иначе

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

End;

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

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

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

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

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) Dotry

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 Dobegin

Delimiter := ';';

// Sorted := True;

// Duplicates := dupIgnore;

End;

fExcludeMasks := tStringList.Create; With fExcludeMasks Dobegin

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-1downto0DoIf 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 = 0Thenbegin

fIncludeMasks.DelimitedText := s;

fExcludeMasks.DelimitedText := '';

End

Elsebegin

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;

IfNot CaseSensitive Then aText := UpperCase(aText);

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

IfNot fPrepared Then PrepareMasks;

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

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

If IsMatchMask(PChar(aText),PChar(fIncludeMasks[i])) Thenbegin

Result := True;

Break;

End;

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

If Result Then

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

If IsMatchMask(PChar(aText),PChar(fExcludeMasks[i])) Thenbegin

Result := False;

Break;

End;

End;

end.