- Код: Выделить всё
function isMatchByMask (const AText, AMask: UTF8String): boolean;
//Собственно функция поиска по маске
function ScanByMaskItem (const ATxt, AMsk: UTF8String): boolean;
var StarPos, i: integer;
MaskToStar, MaskPassStar, s, t: UTF8String;
b, c: boolean;
begin
//главное ограничение - допускается лишь один "*"!
if AMsk = '*' then
Result:= true
else
begin
StarPos:= Pos('*', AMsk);
if (StarPos = 0) or (StarPos = 1) then
MaskToStar:= ''
else
MaskToStar:= Copy(AMsk, 1, StarPos - 1);
if StarPos = Length(AMsk) then
MaskPassStar:= ''
else
MaskPassStar:= Copy(AMsk, StarPos + 1, Length(AMsk) - StarPos);
if (MaskToStar <> '') and (Length(MaskToStar) < Length(ATxt)) then
s:= Copy(ATxt, 1, Length(MaskToStar))
else
s:= '';
if (MaskPassStar <> '') and (Length(ATxt) - Length(MaskToStar) + 1 > 0) then
t:= Copy(ATxt, Length(ATxt) - Length(MaskPassStar) + 1, Length(ATxt))
else
t:= '';
b:= (UTF8CompareText(MaskToStar, s) = 0);
c:= (UTF8CompareText(MaskPassStar, t) = 0);
Result:= (b and c);
end;
end;
var MList: TStringList;
FName, FMName, FExt, FMExt: UTF8String;
i: integer;
begin
//По умолчанию, нет соответствия
Result:= false;
//Создаём список масок (все маски должны быть в "" и разделитель масок - ;)
MList:= TStringList.Create;
MList.Delimiter:= ';';
MList.QuoteChar:= '"';
MList.DelimitedText:= AMask;
if MList.Count > 0 then
for i:= 0 to MList.Count - 1 do
begin
//выделяем имя файла
FName:= ExtractFileNameOnly(AText);
//и имя файла в маске
FMName:= ExtractFileNameOnly(MList[i]);
//Выделяем расширение файла
FExt:= ExtractFileExt(AText);
if (FExt[1] = '.') then
FExt:= Copy(FExt, 2, Length(FExt) - 1);
//и расширение в маске
FMExt:= ExtractFileExt(MList[i]);
if (FMExt[1] = '.') then
FMExt:= Copy(FMExt, 2, Length(FMExt) - 1);
//Проверяем имя файла и расширение на соответствие имени и расширению маски
if (ScanByMaskItem(FName, FMName) and ScanByMaskItem(FExt, FMExt)) then
//если и имя, и расширение удовлетворяют имени и расширению маски, то соответствует
Result:= true;
end;
MList.Free;
end;
По отдельности, эта функция прекрасно работает, а вот в функции сканирования папок:
- Код: Выделить всё
procedure ScanDir (const ADir, ASourceDir, ATargetDir, ACopyConfigFile, AMaskList: string; const isMove, ARecursion: boolean; var vFilesCount: Int64);
var SR: TSearchRec;
begin
if FindFirstUTF8(IncludeTrailingBackslash(ADir) + '*.*', faAnyFile, SR) = 0 then
repeat
if not ((SR.Name = '.') or (SR.Name = '..')) then
begin
Application.ProcessMessages;
if ((SR.Attr and faDirectory) = faDirectory) and ARecursion then
ScanDir(IncludeTrailingBackslash(ADir) + SR.Name, ASourceDir, ATargetDir, ACopyConfigFile, AMaskList, isMove, ARecursion, vFilesCount)
else
if isMatchByMask(SR.Name, AMaskList) then
Inc(vFilesCount);
end;
until FindNextUTF8(SR) <> 0;
FindCloseUTF8(SR);
end;
постоянно крашится и ассемблер (ох, научится бы его понимать!) выдаёт следующее:
и жалуется на
- Код: Выделить всё
if isMatchByMask(SR.Name, AMaskList) then
