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

Вниз

Количество файлов в папке   Найти похожие ветки 

 
harismatik   (2003-02-06 16:38) [0]

Как программно узнать, сколько файлов в папке на локальном диске?


 
Reindeer Moss Eater   (2003-02-06 16:40) [1]

Найти все. Находя очередной, увеличивать количество на 1


 
harismatik   (2003-02-06 16:45) [2]

Этот вариант не подходит. Мне надо сначала оценить колличество, чтобы получить максимальное значение в прогрессбаре и показывать в нем, при чтении названий, сколько еще осталось до конца.


 
gsu   (2003-02-06 16:47) [3]

так посчитай их сначала, там только FindFirst, ... имеется ?


 
pasha_golub   (2003-02-06 18:01) [4]

На даже в потоке :-)
type
TDetailsThread = class(TThread)
private
FFolderName: string;
FilesCount: longint;
FoldersCount: longint;
TotalSize: int64;
Created: string;
Attr: string;
DriveIndex: byte;
protected
procedure Execute; override;

constructor TDetailsThread.Create(const Path: string);
begin
FFolderName := Path;// else Exit;
DriveIndex := DriveLetterToIndex(ExtractFileDrive(FFolderName)[1]);
inherited Create(false);
end;

procedure TDetailsThread.UpdateInfo;
begin

with fmShell do
begin
reFolderInfo.Clear;
reFolderInfo.SelAttributes.Charset := RUSSIAN_CHARSET;
reFolderInfo.Lines.Append("");
reFolderInfo.SelAttributes.Style := [fsBold];
reFolderInfo.Lines.Append(FFolderName);
reFolderInfo.Lines.Append("");
reFolderInfo.SelAttributes.Style := [];
reFolderInfo.Lines.Append(Format(" %.0n байт", [TotalSize*1.0]));
reFolderInfo.Lines.Append(Format(" %.0n папок, %.0n файлов", [FoldersCount*1.0,FilesCount*1.0]));
if Created <> "" then reFolderInfo.Lines.Append(" Создана "+(Created));
reFolderInfo.Lines.Append(Attr);

end;


procedure TDetailsThread.Execute;
var A: word;
SR: TSearchRec;
begin
{$Warnings off}
FreeOnTerminate := false;
TotalSize := 0;
FilesCount := 0;
FoldersCount := 0;
FindFirst(FFolderName+"\.", faAnyFile, sr);
FindClose(SR);
if SR.Time <= -1 then Created := "" else Created := DateTimeToStr(FileDateToDateTime(SR.Time));
GetFolderSize(FFolderName);
A := FileGetAttr(FFolderName);
Attr := "";
If (A and faReadOnly) = faReadOnly then Attr := Attr+#13#10+" Только чтение";
if (A and faArchive) = faArchive then Attr := Attr+#13#10+" Архивная";
if (A and faSysFile) = faSysFile then Attr := Attr+#13#10+" Системная";
if (A and faHidden) = faHidden then Attr := Attr+#13#10+" Скрытая";
{$Warnings on}
if not Terminated then Synchronize(UpdateInfo);
end;

procedure TDetailsThread.GetFolderSize(const APath: string);
var SR: TSearchRec;
begin
if Terminated then Exit;
if FindFirst(APath+"\*.*", faAnyFile, sr) = 0 then
repeat
if ((sr.Attr and faDirectory) = faDirectory) then
begin
if (sr.Name <> ".") and (sr.Name <> "..") then
begin
GetFolderSize(APath+"\"+sr.Name);
inc(FoldersCount);
end
end
else
begin
inc(FilesCount);
TotalSize := TotalSize + sr.Size;
end;

until (FindNext(sr) <> 0) or (Terminated);
FindClose(sr);
end;
procedure UpdateInfo;
public
procedure GetFolderSize(const APath: string);
constructor Create(const Path: string);
end;


 
pasha_golub   (2003-02-06 18:04) [5]

Прошу прощения, 5 последних строчек надо перенести наверхв секцию type, а так даже ничего...



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

Форум: "Основная";
Текущий архив: 2003.02.17;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.46 MB
Время: 0.013 c
14-53164
Supreme
2003-01-26 21:35
2003.02.17
Carrara Studio


3-52730
Дима2003
2003-01-30 12:02
2003.02.17
Как сделать VIEW не обновляемым?


3-52739
Avsam
2003-01-30 11:56
2003.02.17
Определение типа значения поля


1-53084
oomneeq
2003-02-06 13:41
2003.02.17
Stdcall - необходимость его использования


14-53204
Vox
2003-01-30 21:17
2003.02.17
Как запороть письмо?





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
Английский Французский Немецкий Итальянский Португальский Русский Испанский