Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "WinAPI";
Текущий архив: 2003.01.02;
Скачать: [xml.tar.bz2];

Вниз

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

 
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]

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



Страницы: 1 вся ветка

Форум: "WinAPI";
Текущий архив: 2003.01.02;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.56 MB
Время: 0.027 c
3-1746
SergeySubbotin
2002-12-11 16:06
2003.01.02
Работа с DataSet


14-1891
Agent Smith
2002-12-11 14:38
2003.01.02
С днем рождения, MBo!


1-1799
EvgeniyM
2002-12-20 13:05
2003.01.02
Вопрос по Outlook+OLE


14-1866
Anatoly Podgoretsky
2002-12-12 07:47
2003.01.02
Именинники 12 декабря


1-1814
gagarkin
2002-12-20 11:21
2003.01.02
По поводу TypeLib Editor а





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский