Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2006.11.12;
Скачать: CL | DM;

Вниз

Запись путей ко всем каталогам диска в текстовый файл...   Найти похожие ветки 

 
Max.66RUS ©   (2006-10-24 20:12) [0]

Подскажите пожалуйста, как реализовать следующую процедуру: нужно, чтобы пути ко всем каталогам, в т.ч. и вложенным, которые существуют на диске, записались в текстовый файл. Т.е. к примеру, если на диске С существует три папки: "1", "2" и "3". То нужно, чтобы в текстовый файл записалась следующая информация:
-
C:/1/
C:/2/
C:/3/
-

Заранее спасибо.


 
Наиль ©   (2006-10-24 20:25) [1]

Ответ не серьёный, но работает

procedure TForm1.Button1Click(Sender: TObject);
begin
WinExec("Cmd /c dir /s/b c:\ >c:\files.txt",SW_HIDE);
Hide;
sleep(15000);
Show;
Memo1.Lines.LoadFromFile("c:\files.txt");
end;


 
Джо ©   (2006-10-24 20:31) [2]

// Параметр коммандной строки — путь к папке
//
// Выводит список папок в стандартный вывод (можно перенаправить в файл)

program ListFiles;

{$APPTYPE CONSOLE}

uses
 Windows, SysUtils;

type
 // Прототип процедуры обратного вызова
 TOnNextFileProc = procedure (const AFileName: string);

procedure FindDirsRecursively(StartDir: string; OnFileFoundProc: TOnNextFileProc);
Var
 Sr: TSearchRec;
 FullName: string;
begin
 if FindFirst(StartDir+"*.*", faAnyFile, Sr) = 0 then
 begin
   repeat
     if (Sr.Attr and faDirectory)>0 then
     begin
       if (Sr.Name <> ".") and (Sr.Name <> "..") then
       begin
         FullName := StartDir + Sr.Name + "\";
         // рекурсивный вызов
         FindDirsRecursively(FullName,OnFileFoundProc);
       end;
     end;
   until FindNext(Sr) <> 0;
   FindClose(Sr);
 end;
end;

procedure OnNewFile (const AFileName: string);
begin
 WriteLn (AFileName)
end;

var
 Dir: string;

begin
 Dir := ParamStr(1);
 Dir := IncludeTrailingPathDelimiter(Dir);
 FindDirsRecursively(Dir,OnNewFile);

end.

Переделывай, как считаешь нужным. И не забудь, что тут с длинными (длиннее MAX_PATH) именами путей будет беда.


 
Джо ©   (2006-10-24 20:33) [3]

Пардон, перед FindDirsRecursively(FullName,OnFileFoundProc); вставить:
         OnFileFoundProc (FullName);



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

Текущий архив: 2006.11.12;
Скачать: CL | DM;

Наверх




Память: 0.47 MB
Время: 0.035 c
15-1161573936
Slider007
2006-10-23 07:25
2006.11.12
С днем рождения ! 22 октября


2-1161693916
azot
2006-10-24 16:45
2006.11.12
progress bar


5-1142545792
Суслик
2006-03-17 00:49
2006.11.12
Документация в сети по разработке OpenTools


2-1161842761
_Mouse_
2006-10-26 10:06
2006.11.12
Как скопировать в клипбоард?


15-1161506068
SergeiDos
2006-10-22 12:34
2006.11.12
XLGrid для Delphi7