|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
??? Поиск файлов по маске с указанием размера
народ всем привет помогите разобраться с кодом нарыл на сайте ищет папки во всех подкаталогах по маске и сохраняет это дело в файл...
вообщем пытался модифицировать его чтобы выводились размеры перовначально хотел сделать типо такого чтобы к примеру мы в маске использовали мп3 и результат был таким C:\Ария\ = 30 Мб C:\Инструментал\ = 50 Мб короче учитывался размер файлов по маске а потом они складывались и писались в файл... ей Богу целый день сидел мострячил функцию filesize() не пойму как ее тут применить в каком месте ??? видимо тупею....8-( Код:
procedure CreateFileList (LogFile,StartDir: String; Mask: String ='*.*'; FindSubDir: Boolean = True); var hSRFile,hSRFolder,hFile,nBytesWritten: Cardinal; fndFile,fndFolder: WIN32_FIND_DATA; FileName: PChar; i: Byte; begin if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir+'\'; i := 1; while i <> Length(Mask) do begin hSRFile := FindFirstFile(PChar(StartDir+Copy(Mask,i,5)),fndFile); inc(i,6); if hSRFile <> INVALID_HANDLE_VALUE then begin repeat if (fndFile.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0 then Continue; hFile := CreateFile(PChar(LogFile),GENERIC_WRITE,0,nil,OPEN_ALWAYS,0,0); if hFile <> INVALID_HANDLE_VALUE then begin FileName := PChar(StartDir+fndFile.cFileName+#13#10); SetFilePointer(hFile,0,nil,FILE_END); WriteFile(hFile,FileName^,Length(FileName),nBytesWritten,nil); CloseHandle(hFile); end; until not FindNextFile(hSRFile,fndFile); Windows.FindClose(hSRFile); end; end; if FindSubDir then begin hSRFolder := FindFirstFile(PChar(StartDir+'*.*'),fndFolder); if hSRFolder <> INVALID_HANDLE_VALUE then begin repeat if ((fndFolder.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) <> 0) and (fndFolder.cFileName <> '..') and (String(fndFolder.cFileName) <> '.') then CreateFileList(LogFile,StartDir+fndFolder.cFileName+'\',Mask); until not FindNextFile(hSRFolder,fndFolder); Windows.FindClose(hSRFolder); end; end; end; // Пример вызова: procedure TForm1.Button1Click(Sender: TObject); begin CreateFileList('c:\FileList.txt','c:\','*.doc;*.txt;*.log',True); end; Невозможного нет! На невозможное нужно чуть больше времени! ! ! (с) Den Braun |
#2
|
|||
|
|||
Описуха для прошлого кода может кому пригодиться?!
{ CreateFileList позволяет производить поиск файлов с разными раширениями
в указанном каталоге, его подкаталогах или сразу по всему диску и создавать файл-лист. procedure CreateFileList ( LogFile: String; // имя файла, в который будут записаны имена найденых файлов StartDir: String; // каталог, в которым производится поиск Mask: String ='*.*'; // маска файлов (масок может быть несколько см. ниже) FindSubDir: Boolean = True // определяет нужно ли искать в подкаталогах ); LogFile Полное имя файла, например: c:\FileList.txt StartDir Каталог, в которым производится поиск, например: c:\windows Mask Необязательный; маска файлов, например: *.txt. по умолчанию - *.* Можно указать сразу несколько разных масок, разделенных любым символом (но только одним!), например: '*.doc;*.txt;*.log' или '*.doc *.txt *.log' Следите за тем, чтобы в маске не было лишних символов, в противном случае процедура уйдет в бесконечный цикл! FindSubDir Необязательный; разрешает поиск в подкаталогах. По умолчанию = True } Невозможного нет! На невозможное нужно чуть больше времени! ! ! (с) Den Braun |
#3
|
||||
|
||||
THE CRACKER IS OUT THERE |
#4
|
|||
|
|||
Цитата:
Спасибо за отклик но мой код помоему более функционален но неважно... меня интересует слегка другое как получить размер файлов определенной папки и только допустим мп3 файлов ???? Я понимаю 1 это найти пути к ним 2 это запустить процедуру подсчета, тут уже все сложнее надо скалдывать схожие папки к схожим.... у меня по этому поводу какие то не понятные мысли.. Невозможного нет! На невозможное нужно чуть больше времени! ! ! (с) Den Braun |
#5
|
||||
|
||||
Ну, все же предельно просто - указываешь в параметрах ф-ии еще 3 параметра:
1. Тип (маска) для файлов, размер которых надо считать. 2. var параметр для размера всей папки, в которой мы ищем 3. var параметр для размера только тех файлов, что мы указали в п.1 А на счет суммирования - все просто, у тебя будет 2 параметра, объявленные как var - их и суммируешь. например: Код:
procedure CreateFileList (LogFile,StartDir: String; Mask: String; SpecMask: String; var iFullDirSize: Integer; var iSpecMaskSize: Integer; FindSubDir: Boolean = True); А размер файла можно получить при помощи API GetFileSize Либо вот так: Код:
function GetFileSizeByPath(sFileName: String): Int64; var FindData: TWin32FindData; hFind: THandle; begin Result := 0; hFind := FindFirstFile(PChar(sFileName), FindData); if hFind <> INVALID_HANDLE_VALUE then begin Windows.FindClose(hFind); if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then Result := FindData.nFileSizeLow; end; end; THE CRACKER IS OUT THERE Последний раз редактировалось 4kusNick, 27.07.2007 в 14:58. |
#6
|
|||
|
|||
спасибо вроде получилось,
а как бы сделать теперь чтобы вместо эфекта зависания окна у меня progress bar работал ??? и показывал сколько осталось??? Невозможного нет! На невозможное нужно чуть больше времени! ! ! (с) Den Braun |
#7
|
||||
|
||||
А ты сначала вычисляй количество нужных (по маске) файлов в папке, ставь Max у прогресс бара = этому количеству, Step = 1, Position = 0, а потом, во время выполнения ф-ии поиска при каждом найденном файле делай у прогресс бара StepIt. И не забывай либо обновлятиь форму после изменения прогресс бара, либо использовать Application.ProcessMessages, хотя я всегдя использую аналогичную по сути, но намного более безглючную по исполнению процедуру
Код:
procedure Delay(Wnd: HWND = 0); var Msg: TMsg; begin while True do begin if not PeekMessage(Msg,Wnd,0,0,PM_REMOVE) then Break; TranslateMessage(Msg); DispatchMessage(Msg); end; end; Причем, для вычисления кол-ва файлов по маске можешь написать аналогичную функцию\процедуру текущей твоей, только более простую THE CRACKER IS OUT THERE |