Проверка на соответствие имени файла заданной маске
Автор: Dmitry Raduzhan
WEB-сайт: http://delphibase.endimus.com
{ **** 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;
|