Дерево жёского диска.

[coolle]

Доброго времени суток.
Уважаемые, помогите начинающему...
Как мне в Memo вывести всё дерево жёсткого диска... директории папки файлы?
За ранее благодарен!

[mihali4]

Вот вам пример для StringList:

//Как получить список файлов со всеми подкаталогами

procedure ScanDir(StartDir: string; Mask:string; List:TStrings);
var
SearchRec : TSearchRec;
begin
if Mask = '' then Mask := '*.*';
if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
begin
repeat
Application.ProcessMessages;
if (SearchRec.Attr and faDirectory) <> faDirectory then
List.Add(StartDir + SearchRec.Name)
else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
begin
List.Add(StartDir + SearchRec.Name + '\');
ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;

{Пример вызова. параметры
1. имя папки
2. маска, по умолчанию *.*
3. хранилище для результата, любой наследник от TString, например TStringList}

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Items.Clear;
ScanDir('c:','',ListBox1.Items);
Label1.Caption := IntToStr(ListBox1.Items.Count);
end;

Осталось чуть-чуть переделать под Мемо...

[coolle]

Нужно дерево а не полные пути всего что есть на жёском диске. т.е. к примеру диск "с" и "d", захожу на диск "с" там папки дальше пошёл в нужную папку.

[MadReason]

смотря для чего это нужно.
как вариант можно запустить программно в cmd

tree c:>>c:\q1.txt

сохраниться вся структура с: в файле q1.txt в dos кодировке,
а потом просто подгрузить этот файл куда нужно

memo1.Lines.LoadFromFile('c:\q1.txt ');

производительность думаю будет достаточно хорошая

P.S.
написал до предыдущего сообщения)

00:11

в Д7 на вкладке samples есть компонент ShellTreeView
добавляешь его на форму и через инспектор объектов или программно меняешь свойство root

У нас принято пользоваться кнопочкой "Правка", дабы не плодить посты подряд, друг за другом.
Читаем правила. Рекомендую. Помимо общих правил форума есть и дополнения к ним в каждом разделе...
Уважайте форумчан, и они ответят вам взаимностью...
Модератор

Прошу прощения

[coolle]

tree c:>>c:\q1.txt
не сработал этот код система Windows7.
Да и не вариант это подгружать из файла, не ужели средства Delphi не могут показать дерево винта...

Сообщение от MadReason

в Д7 на вкладке samples есть компонент ShellTreeView
добавляешь его на форму и через инспектор объектов или программно меняешь свойство root

Не нашёл как поменять свойство root...
Но всё равно это не то что нужно мне, мне нужен именно вывод дерева в Memo.

[mihali4]

Мемо точно не может, а вот ТreeView может...
А может бросить мучительные искания и просто использовать готовый штатный компонент ТShellListView ?

[coolle]

Сообщение от mihali4

Мемо точно не может, а вот ТreeView может...
А может бросить мучительные искания и просто использовать готовый штатный компонент ТShellListView ?

Может Memo< вопрос как это осуществить.

[MadReason]

Пишется все элементарно и буквально в 10 строк, не считая процеды поиска. Исходник откомментил, думаю все должно быть понятно.
а как же порой все это лень...

сорцы
дерево файлов в memo.zip

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Memo1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  dir:string='';// полный путь

implementation

{$R *.dfm}

//процедура поиска файлов и папок в директории
procedure ScanDir(StartDir: string; Mask:string; List:TStrings);
var
SearchRec : TSearchRec;
begin
if Mask = '' then Mask := '*.*';
if StartDir[Length(StartDir)] <> '\' then StartDir := StartDir + '\';
if FindFirst(StartDir+Mask, faAnyFile, SearchRec) = 0 then
begin
repeat
Application.ProcessMessages;
if (SearchRec.Attr and faDirectory) <> faDirectory then
List.Add({StartDir + }SearchRec.Name)
else if (SearchRec.Name <> '..') and (SearchRec.Name <> '.') then
begin
List.Add({StartDir + }SearchRec.Name + '\');
//ScanDir(StartDir + SearchRec.Name + '\',Mask,List);
end;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
dir:=edit1.text;//задается необходимый драйв
if edit1.text[Length(edit1.text)] <> '\' then// нормализация представления
dir:=dir+'\';
memo1.Enabled:=true;
memo1.Lines.Clear;
scandir(edit1.text,'',memo1.Lines);//выводим дерево драйва
label1.Caption:=dir;//выводим полный путь
end;

procedure TForm1.Memo1Click(Sender: TObject);
begin
//получаем индекс выбраной строки и саму строку
dir:=dir+memo1.Lines.Strings[Memo1.CaretPos.Y];
if dir[Length(dir)] = '\' then// если выбрана директория
begin
memo1.Clear;
scandir(dir,'',memo1.Lines);//создаем дерево для выбранной директории
end;
label1.Caption:=dir;//выводим полный путь
end;

end.

"улыбаемся и машем парни, улыбаемся и машем..."

[coolle]

Отлично! Всем спасибо за помощь. MadReason, поблагодарил индивидуально

Вот я совсем запарился, а как заставить, чтобы все имеющиеся диски выводились в мемо?
Ну чтобы не через Edit указывать какой нужен, а сразу весь список дисков в Memo...

[coolle]

Вот код который выводит количество дисков на компьютере
и показывает информацию о диске:

unit MainFrm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, FileCtrl;
type TMainForm = class(TForm)
btnGetDriveTypes: TButton;
lbDrives: TListBox;
lblSectPerClust2: TLabel;
lblBytesPerSector2: TLabel;
lblNumFreeClusters2: TLabel;
lblTotalClusters2: TLabel;
lblSectPerCluster: TLabel;
lblBytesPerSector: TLabel;
lblNumFreeClust: TLabel;
lblTotalClusters: TLabel;
lblFreeSpace2: TLabel;
lblTotalDiskSpace2: TLabel;
lblFreeSpace: TLabel;
lblTotalDiskSpace: TLabel;
procedure btnGetDriveTypesClick(Sender: TObject);
procedure lbDrivesClick(Sender: TObject);
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.btnGetDriveTypesClick(Sender: TObject);
var
  i: Integer;
  C: String;
  DType: Integer;
  DriveString: String;
begin
 lbDrives.Clear;
 // Луп от A..Z для определения
 for i:=65 to 90 do
  begin
   // Формат строки предмтавляет корневой каталог
   C:=chr(i)+':\';
   // Call the GetDriveType() возвращает целое число.
   // значение и является одним из таких типов в случае заявления
   // ниже
   DType:=GetDriveType(PChar(C));
   // На основании типа привода вернуть, формат строки,
   //    чтобы добавить к списку отображаемых различных типов дисков
   case DType of
     0: DriveString:=C+' Тип накопителя не может быть определен.';
     1: DriveString:=C+' Корневая директория не существует.';
     DRIVE_REMOVABLE: DriveString:=
        C+' Диск может быть удален из накопителя.';
     DRIVE_FIXED: DriveString:=
        C+' Диск НЕ может быть удален из накопителя.';
     DRIVE_REMOTE: DriveString:=
        C+' Удаленный (сетевой) диск.';
     DRIVE_CDROM: DriveString:=C+' Устройство - CD-ROM.';
     DRIVE_RAMDISK: DriveString:=C+' Устройство - RAM диск.';
    end;
   // Only add drive types that can be determined.
   if not ((DType = 0) or (DType = 1))
   then lbDrives.Items.AddObject(DriveString, Pointer(i));
  end;
end;
procedure TMainForm.lbDrivesClick(Sender: TObject);
var
 RootPath: String;         // Держит путь корневого диска
 SectorsPerCluster: DWord; // Секторов в кластере
 BytesPerSector: DWord;    // Байт в секторе
 NumFreeClusters: DWord;   // количество свободных кластеров
 TotalClusters: DWord;     // Всего кластеров
 DriveByte: Byte;          // Драйв байта
 FreeSpace: Int64;         // Свободное место на диске
 TotalSpace: Int64;        // Всего на диске
begin
 with lbDrives do
  begin
    { Convert the ascii value for the drive letter to a valid drive number:
        1 = A, 2 = B, etc. by subtracting 64 from the ascii value. }
    DriveByte:=Integer(Items.Objects[ItemIndex])-64;
    // Сначало создать строку корневой путь
    RootPath:=chr(Integer(Items.Objects[ItemIndex]))+':\';
    // Получить информацию диска
    if GetDiskFreeSpace(PChar(RootPath), SectorsPerCluster,
      BytesPerSector, NumFreeClusters, TotalClusters)
    then
     begin
      // Если функция успешна, то обновление меток отображения информации о диске
      lblSectPerCluster.Caption:=Format('%.0n', [SectorsPerCluster*1.0]);
      lblBytesPerSector.Caption:=Format('%.0n', [BytesPerSector*1.0]);
      lblNumFreeClust.Caption:=Format('%.0n', [NumFreeClusters*1.0]);
      lblTotalClusters.Caption:=Format('%.0n', [TotalClusters*1.0]);
      // Свободное место на диске
      FreeSpace:=DiskFree(DriveByte);
      TotalSpace:=DiskSize(DriveByte);
      lblFreeSpace.Caption:=Format('%.0n', [FreeSpace*1.0]);
      // Рассчитать общий объём дискового пространства
      lblTotalDiskSpace.Caption:=Format('%.0n', [TotalSpace*1.0]);
     end
    else
     begin
      // Set labels to display nothing
      lblSectPerCluster.Caption:='X';
      lblBytesPerSector.Caption:='X';
      lblNumFreeClust.Caption:='X';
      lblTotalClusters.Caption:='X';
      lblFreeSpace.Caption:='X';
      lblTotalDiskSpace.Caption:='X';
      ShowMessage('Невозможно получить информацию о диске!');
    end;
  end;
end;
end.

У меня ещё один вопрос.Идея такая, значит в ListBox выводится дерево папок конкретного диска,каждая папка это строка.мне нужно циклом посчитать количество строк и вывести номер строки равной значению в edit.Ну вот к примеру открыли дерево папок диска "С" там есть папка ProgramFiles и пусть она будет 3 по счёту, я пишу в edite "ProgramFiles" жму на кнопку начинает работать цикл подсчета количества строк и выводит ту строку которая с названием ProgramFiles, вот я крутил вертел и не фига не получается :

procedure TForm1.Button1Click(Sender: TObject);
var
i:integer;
count: integer;
begin
if edit1.text='ProgramFiles\' then
begin
for i := 0 to ListBox1.items.Count - 1 do
begin
if i=strtoint(edit1.text) then 
begin ListBox1.Items.Clear;
scandir(dir,'',ListBox1.Items);
end;
end;
end;

что тут не так???