Форум по Delphi программированию

Delphi Sources



Вернуться   Форум по Delphi программированию > Все о Delphi > Файловая система
Ник
Пароль
Регистрация <<         Правила форума         >> FAQ Пользователи Календарь Поиск Сообщения за сегодня Все разделы прочитаны

Ответ
 
Опции темы Поиск в этой теме Опции просмотра
  #1  
Старый 26.07.2007, 17:06
fr33m4n fr33m4n вне форума
Прохожий
 
Регистрация: 23.07.2007
Адрес: Ростов на Дону
Сообщения: 10
Репутация: 10
Печаль ??? Поиск файлов по маске с указанием размера

народ всем привет помогите разобраться с кодом нарыл на сайте ищет папки во всех подкаталогах по маске и сохраняет это дело в файл...
вообщем пытался модифицировать его чтобы выводились размеры перовначально хотел сделать типо такого чтобы к примеру мы в маске использовали мп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  
Старый 26.07.2007, 17:07
fr33m4n fr33m4n вне форума
Прохожий
 
Регистрация: 23.07.2007
Адрес: Ростов на Дону
Сообщения: 10
Репутация: 10
По умолчанию Описуха для прошлого кода может кому пригодиться?!

{ 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  
Старый 26.07.2007, 18:34
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

http://www.delphisources.ru/forum/sh...ted=1#post7890

Перепиши для себя
__________________
THE CRACKER IS OUT THERE
Ответить с цитированием
  #4  
Старый 27.07.2007, 11:45
fr33m4n fr33m4n вне форума
Прохожий
 
Регистрация: 23.07.2007
Адрес: Ростов на Дону
Сообщения: 10
Репутация: 10
По умолчанию

Цитата:
Сообщение от 4kusNick

Спасибо за отклик но мой код помоему более функционален но неважно...

меня интересует слегка другое как получить размер файлов определенной папки и только допустим мп3 файлов ????
Я понимаю 1 это найти пути к ним
2 это запустить процедуру подсчета,
тут уже все сложнее надо скалдывать схожие папки к схожим....

у меня по этому поводу какие то не понятные мысли..
__________________
Невозможного нет! На невозможное нужно чуть больше времени! ! ! (с) Den Braun
Ответить с цитированием
  #5  
Старый 27.07.2007, 14:52
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

Ну, все же предельно просто - указываешь в параметрах ф-ии еще 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);
вот и во время поиска, ты к iFullDirSize прибавляй р-р найденного по Mask файла, потом проверяй, соответствует ли найденный файл еще и маске SpecMask, если да то прибавляй к iSpecMaskSize его размер...

А размер файла можно получить при помощи 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  
Старый 27.07.2007, 15:52
fr33m4n fr33m4n вне форума
Прохожий
 
Регистрация: 23.07.2007
Адрес: Ростов на Дону
Сообщения: 10
Репутация: 10
По умолчанию

спасибо вроде получилось,
а как бы сделать теперь чтобы вместо эфекта зависания окна у меня progress bar работал ??? и показывал сколько осталось???
__________________
Невозможного нет! На невозможное нужно чуть больше времени! ! ! (с) Den Braun
Ответить с цитированием
  #7  
Старый 28.07.2007, 01:00
Аватар для 4kusNick
4kusNick 4kusNick вне форума
Местный
 
Регистрация: 06.09.2006
Адрес: Россия, Санкт-Петербург
Сообщения: 444
Репутация: 550
По умолчанию

А ты сначала вычисляй количество нужных (по маске) файлов в папке, ставь 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
Ответить с цитированием
Ответ


Delphi Sources

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск
Опции просмотра

Ваши права в разделе
Вы не можете создавать темы
Вы не можете отвечать на сообщения
Вы не можете прикреплять файлы
Вы не можете редактировать сообщения

BB-коды Вкл.
Смайлы Вкл.
[IMG] код Вкл.
HTML код Выкл.
Быстрый переход


Часовой пояс GMT +3, время: 20:04.


 

Сайт

Форум

FAQ

RSS лента

Прочее

 

Copyright © Форум "Delphi Sources" by BrokenByte Software, 2004-2023

ВКонтакте   Facebook   Twitter