| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Поиск файлов на винте

Николай Быков ©   (2002-10-10 13:57:00) 

Я часто видел ответы на вопросы про поиск файлов на диске, но на каждый такой вопрос люди отвечали "findfirst findnext". Я добросовестно прочитал текст по этим подпрограммам :-)
Помогите мне организовать поиск этих файлов с заходом во все подкаталоги.
+ Я когда просто такой поиск делал, то так и не понял как сделать проверку что программа уже все файлы нашла (а то она потом просто последний файл постоянно выдает и все)

---

Rouse_   (2002-10-10 14:57:00) [1]

Ну я со вчерашнего восьми вечера за компом, упустил :(

---

Pumpkin   (2002-10-10 14:51:00) [2]

2Rouse_ (10.10.02 14:05)
А где же роз.. FindClose?
И проверка результата FindFirst тоже.

---

Rouse_   (2002-10-10 14:49:00) [3]

> AL2002 © (10.10.02 14:43)
Спасибо на добром слове ;)

---

AL2002   (2002-10-10 14:43:00) [4]

>Rouse_ © (10.10.02 14:08)
Зато твой лучше.

---

Rouse_   (2002-10-10 14:08:00) [5]

Во блин, пока писал уже накидали, и опять не успел :(

---

Rouse_   (2002-10-10 14:05:00) [6]

procedure TForm4.FindAllFiles(Dir:String);
const fn: string = "*.*";
var SRec: TSearchRec;
FromF, len:Integer;
begin
if dir[length(dir)]<>"\" then Dir:=Dir+"\";
FindFirst(Dir+fn, faAnyFile, SRec);
while FindNext(SRec) = 0 do
Memo1.Lines.Add(Dir+SRec.Name);
FindFirst(Dir+"*.*", faDirectory, SRec);
while FindNext(SRec) = 0 do begin
with SRec do
if (Attr and 16 <> 0 ) and (Name[1]<>".") then begin
FindAllFiles(Dir+Name);
end;
Application.ProcessMessages;
end;
end;

Желаю успехов

---

Pumpkin   (2002-10-10 14:04:00) [7]

http://delphi.mastak.ru/cgi-bin/faq.pl?look=1&id=1015254946&n=19

---

AL2002   (2002-10-10 14:04:00) [8]

А ты компоненту мне какую пришлёшь интересную? Если да, то лови:
unit FindFile;
interface

uses Windows, SysUtils, Classes, Masks;


procedure GetLogicalDriveList(const List: TStrings);
procedure GetFixedDriveList(const List: TStrings);
procedure FindFiles(Path, Mask: string; List: TStrings; IncludeSubDir: Boolean = True);

implementation

procedure GetLogicalDriveList(const List: TStrings);
var
Size, Pos: Cardinal;
Buffer: array[0..127] of AnsiChar;
P: PChar;
begin
List.BeginUpdate;
try
List.Clear;
Size:=GetLogicalDriveStrings(SizeOf(Buffer), Buffer);
Pos:=0;
while Pos<Size do begin
P:=@Buffer[Pos];
List.Add(P);
while Buffer[Pos]<>#0 do Inc(Pos);
Inc(Pos);
end;
finally
List.EndUpdate;
end;
end;

procedure GetFixedDriveList(const List: TStrings);
var
Size, Pos: Cardinal;
Buffer: array[0..127] of AnsiChar;
P: PChar;
begin
List.BeginUpdate;
try
List.Clear;
Size:=GetLogicalDriveStrings(SizeOf(Buffer), Buffer);
Pos:=0;
while Pos<Size do begin
P:=@Buffer[Pos];
if GetDriveType(P) = DRIVE_FIXED then List.Add(P);
while Buffer[Pos]<>#0 do Inc(Pos);
Inc(Pos);
end;
finally
List.EndUpdate;
end;
end;


procedure FindFiles(Path, Mask: string; List: TStrings; IncludeSubDir: Boolean = True);
var
SearchRec: TSearchRec;
FindResult: Integer;
begin
List.BeginUpdate;
try
Path:=IncludeTrailingBackSlash(Path);
FindResult:=FindFirst(Path+"*.*", faAnyFile, SearchRec);
try
while FindResult = 0 do with SearchRec do begin
if (Attr and faDirectory<>0) then begin
if IncludeSubDir and (Name<>"..") and (Name<>".")
then FindFiles(Path+Name, Mask, List, IncludeSubDir);
end else begin
if MatchesMask(Name, Mask) then List.Add(Path+Name);
end;
FindResult:=FindNext(SearchRec);
end;
finally
FindClose(SearchRec);
end;
finally
List.EndUpdate;
end;
end;


end.



---

Doctor Snap   (2002-10-10 14:02:00) [9]

napishi proceduru, kotoraja ishet vse faili v odnom kataloge, bez заходом во все подкаталоги, i sdelai tak chto kogda eta procedura nahodit fail s atributom DIR, ona vizivaet samu seba dla etogo naidennogo podkataloga. (rekursija)
A spisok naidennih failov zapisivai v kakoi- nibud hlobalnii spisok.

---

still   (2002-10-10 14:01:00) [10]

1. рекурсивно
2. from Delphi Help
FindNext function
...The return value is zero if the function was successful. Otherwise the return value is a Windows error code.
т.е. while (FindNext(...)=0) do

---

Наверх