И чем тебя FindFirst/FindNext/FindClose не устроил?
Пишется всё буквально за 10-15 минут:
| Код |
{$WARN SYMBOL_PLATFORM OFF}
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls,Masks;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
//Поиск файлов в каталоге и его покаталогах с фильтром по маске и исключением
//из поиска всех файлов, атрибуты которых попадают в aExcludeAttr
procedure GetFiles(const aPath,aMask: String;var aListFile: TStringList;const aExcludeAttr: Integer=0);
var
SR: TSearchRec;
tPath: String;
begin
tPath := IncludeTrailingBackSlash(aPath);
if FindFirst(tPath+'*.*',faAnyFile,SR)=0 then
begin
try
repeat
if (SR.Name='.') or (SR.Name='..') then Continue;
if (SR.Attr and faDirectory)<>0 then GetFiles(tPath+SR.Name,aMask,aListFile,aExcludeAttr);
if (aExcludeAttr<>0) and (SR.Attr and aExcludeAttr <> 0) then Continue;
if MatchesMask(SR.Name,aMask) then aListFile.Add(tPath+SR.Name);
until FindNext(SR)<>0;
finally
Sysutils.FindClose(SR);
end;
end;
end;
function RenFiles(const SrcPath,DestPath,Mask: String;isMove: Boolean=False): Integer;
var
L: TStringList;
i: Integer;
DestFile: String;
begin
Result := 0;
try
if not DirectoryExists(DestPath) then
begin
if not CreateDir(DestPath) then Exit;
end;
except
Exit;
end;
L := TStringList.Create;
try
GetFiles(SrcPath,Mask,L);
for i := 0 to L.Count-2 do
begin
DestFile := ExtractFileName(L[i]);
DestFile := ChangeFileExt(DestFile,'.'+Format('%d',[i+1]));
DestFile := IncludeTrailingBackSlash(DestPath)+DestFile;
if isMove
then MoveFile(PChar(L[i]),PChar(DestFile))
else CopyFile(PChar(L[i]),PChar(DestFile),False);
end;
//Здесь обрабатываем последний файл (L[L.Count-1])
finally
L.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
RenFiles('d:\mp1','d:\mp2','*.jpg',False);
end;
end.
|
|
