Проверка на соответствие имени файла заданной маске

Автор: Dmitry Raduzhan

{ **** UBPFD *********** by delphibase.endimus.com ****
>> Проверка на соответствие имени файла заданной маске

Зависимости: sysutils
Автор:       Dmitry Raduzhan
Copyright:   Dmitry Raduzhan
Дата:        24 марта 2004 г.
***************************************************** }

function FileMaskEquate(F, M: string): boolean;
var
  Fl, Ml: byte; // length of file name and mask
  Fp, Mp: byte; // pointers
begin
  F := UpperCase(F);
  M := UpperCase(M);
  result := true;
  Fl := length(F);
  Ml := length(M);
  Fp := 1;
  Mp := 1;
  while Mp <= Ml do
  begin // wildcard
    case M[Mp] of //
      '?':
        begin // if one any char
          inc(Mp); // next char of mask
          inc(Fp); // next char of file name
        end; //
      '*':
        begin // if any chars
          if Mp = Ml then
            exit; // if last char in mask then exit
          if M[Mp + 1] = F[Fp] then
          begin // if next char in mask equate char in
            Inc(Mp); // file name then next char in mask and
          end
          else
          begin // else
            if Fp = Fl then
            begin // if last char in file name then
              result := false; // function return false
              exit; //
            end; // else, if not previous, then
            inc(Fp); // next char in file name
          end; //
        end; //
    else
      begin // other char in mask
        if M[Mp] <> F[Fp] then
        begin // if char in mask not equate char in
          result := false; // file name then function return
          exit; // false
        end; // else
        inc(Fp); // next char of mask
        inc(Mp); // next char of file name
      end //
    end;
  end;
end;

Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
  s: string;
begin
  s := ExtractFileName(openDialog1.Files[0]);
  if opendialog1.Execute then
  begin
    if FileMaskEquate(s, Edit1.text) then
      ShowMessage('Ok')
    else
      ShowMessage('Failed');
  end;
end;