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

Вниз

Как прочесть контент папки вместе с подпапками?   Найти похожие ветки 

 
Miwa   (2002-02-26 17:47) [0]

Верю, что вопрос ламерский, но в хелпе/факе я его не нашел :о(.


 
Sasha9   (2002-02-26 19:07) [1]

findfirst/fintdnext/findclose/HELP


 
Miwa   (2002-02-26 19:58) [2]

И все так просто...
Спасибо.


 
Anatoly Podgoretsky   (2002-02-26 21:29) [3]

Наверно нет, так как это самый любимый вопром.


 
Miwa   (2002-02-27 21:50) [4]

Ну, тогда предложение авторам сайта: включите этот вопрос в фак.


 
Miwa   (2002-03-01 15:22) [5]


procedure TForm1.Search(const Path: string; Attr: Integer; var F: TSearchRec);
var count:integer;
attach:shortstring;
begin
count:=1;
attach:="*.*";
if FindFirst(path+attach,Attr,F)=0 then
begin
repeat
label1.Caption:=F.Name;
label2.Caption:=inttostr(count);
inc(count);
//!!!
if F.Attr=faDirectory then
Search(path + F.Name "\"+attach ,faAnyFile,F);
//!!!
until FindNext(F)<>0;
FindClose(F);
end;
end;

//Вызов процедуры

path:="C:\Windows\";
Search(path,faAnyFile,sr);


Что-то типа этого я наваял. Только если я не включаю выделенный блок, то процедура не заходит в подпапки, а если включаю - на выходе получаю count=1. Хелп.


 
null   (2002-03-01 15:48) [6]

используй рекурсию (т.е.вызов ф-ции внутри себя):
procedure TForm1.Make;
var Sr : TSearchRec;
Err : integer;
FilePath : string;
Begin
Err:=FindFirst(edit1.Text,$37,Sr) ;//$37 - все атрибуты, кроме faVolumeID
While (Err = 0) do
begin
if Sr.Name[1]<>"." then
begin
fFile:=ExpandFileName(Sr.Name);
if Sr.Attr<>faDirectory then
begin
//сделать что-н. с sr или fFile
end;
end;
{ начало рекурсии }
If ( ((Sr.Attr and faDirectory)<>0)AND(Sr.Name[1] <> ".") ) and checkbox1.Checked then
begin
ChDir(Sr.Name) ;
Make ;//!!!!!!!!!!!!!
ChDir("..") ;
end ;//конец рекурсии
Err:=FindNext(Sr) ;
end ;
End;


 
Miwa   (2002-03-01 16:13) [7]

2 null:

> ChDir("..") ;

Точно, блин. Вот что я прохлопал. Спасибо.


 
Miwa   (2002-03-06 23:29) [8]

В конце концов код в таком виде работает.

procedure TForm1.Search;
var Sr : TSearchRec;
Err : integer;
fFile: string;
mask: shortstring;
Begin
mask:="*.*";
Err:=FindFirst(where + mask,faAnyFile,Sr);
While (Err = 0) do
begin
if Sr.Attr <> faDirectory then
begin
fFile:=where + Sr.Name;
if Sr.Attr<>faDirectory then
begin
inc(count);
label1.Caption:=fFile;
label2.Caption:=inttostr(count);
end;
end;
{рекурсия - страшная вещь ;o)}
if (Sr.Attr = faDirectory) and (Sr.Name[1] <> ".") then
begin
where:=where + Sr.Name + "\";
label3.Caption:=where;
inc(fcount);
label4.Caption:=inttostr(fcount);
Search ;
//а теперь убрать бы нахрен последнюю подпапку
for i:=length(where) - 1 downto 1 do
if where[i]="\" then break;
delete(where,i+1,length(where)-i);
end;
Err:=FindNext(Sr) ;
end;
FindClose(sr);
end;

Собственно, вызов:

if edit1.Text[length(edit1.Text)]<>"\" then
where:=edit1.Text+"\" else
where:=edit1.Text;

count:=0; fcount:=0;
Search;

А собственно проблема в том, что при попытке в переменную mask поставить, например, "*.txt" программа ВООБЩЕ не работает. Выдает Err=2, да только в моем D6: Personal edition хелп не содержит какой-либо инфы о ошибках FindFirst.
Помогите, кто чем может!


 
Anatoly Podgoretsky   (2002-03-06 23:41) [9]

Miwa © (27.02.02 21:50)
Вкдючен уже


 
Miwa   (2002-03-07 02:15) [10]

Спасибо всем ответившим. И все-таки, если можно, повторю свой последний вопросс:
почему в приведенном мною коде не удается удалять файлы по маске (или, если точнее, просто считывать их). Где ошибка (кроме ДНК, конечно ;о))? И где найти более полный хелп?


 
MBo   (2002-03-07 06:48) [11]

ты не мог бы уточнить, что именно тебе нужно - техзадание поставить


 
Miwa   (2002-03-08 17:17) [12]

Техзадание? Мда...
Нужно удалить с определенного места файлы - все или по маске. С входом в подпапки. Приведенный мною код работает только для удаления ВСЕХ файлов. А если я передаю например в переменную mask значение *.txt, процедура выдает при пошаговом прогоне err=2. Ну и вылетает (ведь while err=0). Вот и интерессно, во-первых ПОЧЕМУ, а во-вторых, где есть более подробный хелп чтобы узнать что это за ошибка(err=2), так как в хелпе шестого персонал эдишн я этого не нашел. Вот собсно и все.


 
Anatoly Podgoretsky   (2002-03-08 20:01) [13]

Не пытался посмотреть, что эта ошибка значит, а значит она ERROR_FILE_NOT_FOUND



 
Набережных С.   (2002-03-08 21:02) [14]

type
TProcessingOfFile = procedure(const FileName: string);

procedure EnumFiles(const Dir, Mask: string; Attr: integer; Processing: TProcessingOfFile);
var
Sr : TSearchRec;
Err : integer;
InternalDir: string;
begin
InternalDir:=IncludeTrailingBackslash(Dir);
Err:=FindFirst(InternalDir+Mask,Attr,Sr);
while Err = 0 do
begin
Processing(InternalDir+Sr.Name);
Err:=FindNext(Sr);
end;
FindClose(Sr);
Err:=FindFirst(InternalDir+"*.*",faDirectory,Sr);
while Err = 0 do
begin
if (Sr.Name<>".")and(Sr.Name<>"..") then
EnumFiles(InternalDir+Sr.Name,Mask,Attr,Processing);
Err:=FindNext(Sr);
end;
FindClose(Sr);
end;

procedure Process(const FileName: string);
begin
Form1.ListBox1.Items.Add(FileName);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.BeginUpdate;
EnumFiles("C:\Program files\Borland\Delphi5","*.txt",faAnyFile,Process);
ListBox1.Items.EndUpdate;
end;


 
Miwa   (2002-03-12 15:16) [15]

2 Anatoly Podgoretsky © (08.03.02 20:01):

Я не смог найти хелп об ошибках функций FindFirst/FindNext. Не подскажете, где именно его (хелп) искать в Delphi 6: Personal.

2 Набережных С. (08.03.02 21:02):
Большое спасибо. Заработало!

2 администратор:
Все же вариант предложенный в факе выдает ту же ошибку "файл не найден". Предлагаю заменить его на вариант, предложенный Набережных С. (08.03.02 21:02).


 
Anatoly Podgoretsky   (2002-03-12 20:31) [16]

Miwa © (12.03.02 15:16)
Такого хелпа нет, зато есть хелп по Windows - MS Windows SDK, входит в состав поставки Дельфи
Укажи значение where + mask и если там искомое, но только не из головы, а в отладчике.
"Собственно, вызов:" - практически не верно, работает только для пустой строки.



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

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

Наверх





Память: 0.49 MB
Время: 0.005 c
1-80514
Serghei
2002-03-12 12:31
2002.03.25
Посимвольный вывод в Мемо!!!


3-80425
kserg@ukr.net
2002-02-26 18:31
2002.03.25
Как восстановить пользовательские установки DBGrid-а?


1-80504
pashka
2002-03-11 12:41
2002.03.25
Разное


3-80412
Andrey V. Zuev
2002-02-26 12:48
2002.03.25
Импортирование таблицы из dbf на сервер MSSQL7


6-80651
Velocity
2002-01-07 11:03
2002.03.25
Нууу... вопрос по сокетам <совсем маленький>





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