подскажите функцию...

← →
kamalov (2002-11-16 13:03) [0]

как определить размер каталога?
или количество файлов(оъектов) в нем?

← →
bak (2002-11-16 13:06) [1]

не помню откуда у меня этот хтмл, поетому кидаю текстом

Очередной пример манипуляции с файлами

Функция GetAllFiles позволяет без лишних заморочек производить разнообразные действия с файлами в дирректории, включая и поддиректории.

GetAllFiles возвращает в stringlist все файлы удовлетворяющие заданному критерию. Эта функция относится к типу рекурсивных.
Работает на все версиях Delphi.

procedure GetAllFiles(aPathPlusMask:string;aSubFolders: boolean;
aResultList: TStringList);
var Search: TSearchrec;
hDir: string;
hMask: string;

begin
hMask := aPathPlusMask;
hDir := ExtractFilepath(aPathPlusMask);
if hDir[length(hDir)]<>"\" then hDir := hDir + "\";

// Внимание: FindFirst ищей все файлы в общей папке
// Если дирректория недоступна ( hDir содержит ошибку)
if not DirExists(hDir) then
EXIT;

if FindFirst(hMask, $23, Search)= 0 then
repeat
aResultList.Add(hDir + Search.Name);
until FindNext(Search)<>0;

if aSubFolders then
if FindFirst(hDir + "*.*",fadirectory, Search)= 0 then
repeat
if((search.attr and fadirectory)=fadirectory) and
(search.name[1]<>".") then
GetAllFiles(hDir+Search.Name+"\"+hMask, aSubFolders,
aResultList);
until FindNext(Search) <> 0;
end;

Теперь не составляет труда создать функцию, которая будет устанавливать атрибуты у всех файлов:

procedure SetAllFilesAttr(aPathPlusMask: string;
aSubFolders: boolean;
aAttr: Integer);
var i: integer;
hStrList: TStringList;
begin
hStrList:= TStringList.Create;

GetAllFiles(aPathPlusMask,aSubFolders, hStrList);

for i := 0 to hStrlist.Count - 1 do
FileSetAttr(hStrlist[i], aAttr);

hStrList.Destroy;
end;

Вызов этой функции будет выглядеть примерно так:

SetAllFilesAttr("*.*", false, faArchive );

Впринципе такие функции как CopyAllFiles или FindInFiles могут быть реализованы различными способами !

Комментарии

У меня возникли проблемы с функцией GetAllFiles. Если путь задавать в виде path + originalpath с маской, то функция всё время выходит на ошибку. Также я заметил, что aResultList передаётся в функцию значением, а не указателем. Это хорошо для объектов, но у меня переменная величина.

Итак, изменил функцию, чтобы извлекать из aPathPlusMask только маску.

Собственно моя процедура

procedure GetAllFiles(aPathPlusMask:string;aSubFolders: boolean;
var aResultList: TStringList);
var Search: TSearchrec;
hDir: string;
hMask: string;
begin
hDir := ExtractFilepath(aPathPlusMask);
if length(hDir) > 0 then
begin
if hDir[length(hDir)]<>`\` then hDir := hDir + `\`;
end
else
begin
// No Path -- Get the current and tack on the mask
hDir:= ExtractFilePath(Application.ExeName);
aPathPlusMask:= hDir + aPathPlusMask;
end;

hMask := copy(aPathPlusMask,length(hDir)+1,(length(aPathPlusMask) - length(hDir)));

// Внимание: FindFirst ищей все файлы в общей папке
// Если дирректория недоступна ( hDir содержит ошибку)
if not DirectoryExists(hDir) then
EXIT;

if FindFirst(hMask, faAnyFile, Search)= 0 then
repeat
aResultList.Add(hDir + Search.Name);
until FindNext(Search)<>0;

if aSubFolders then
if FindFirst(hDir + `*.*`,fadirectory, Search)= 0 then
repeat
if((search.attr and fadirectory)=fadirectory) and
(search.name[1]<>`.`) then
GetAllFiles(hDir+Search.Name+`\`+hMask, aSubFolders,
aResultList);
until FindNext(Search) <> 0;
end;

← →
kamalov (2002-11-16 13:27) [2]

спасибо bak.

а стандартной API функции нет?

← →
bak (2002-11-16 13:41) [3]

а зачем тебе стандартная? ведь и так просто - рекурсия и всё тут :)

← →
Viktor Kushnir (2002-11-16 18:10) [4]

Если бы стандартная и была, то она была бы написана, наверное, примерно так же.

подскажите функцию... Найти похожие ветки