Delphi-Help

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

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

Оцените материал
(0 голосов)


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

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.

 

Прочитано 5119 раз

Авторизация



Счетчики