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

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

Работа с каталогами [D7]


Страницы:   1 2

unregister_256 ©   (2005-07-03 13:19:00) 

Как узнать количество и буквы жестких дисков?
Как считать каталоги и файлы в директории?
спасибо :)


unregister_256   (2005-07-06 09:42:00) [1]


> Просто Джо

Благодарю :)


Просто Джо   (2005-07-05 16:30:00) [2]


> [8] unregister_256   (05.07.05 10:31)

Туман у тебя в голове какой-то... Извини, суже по коду - похоже он написан "методом тыка" :(

Если я правильно понял что тебе нужно, то вот переделал твой образец в рабочий вариант:

procedure ScanDir(Path:string; ATreeView: TTreeView; AParentNode: TTreeNode);
var
SR : TSearchRec;
NewNode: TTreeNode;
begin
if FindFirst(path+'*.*', faAnyFile, SR) = 0 then
  begin
    repeat
      if (SR.Name<>'.')and(SR.Name<>'..') then
        if (SR.Attr and faDirectory) = faDirectory then
        begin
          NewNode := ATreeView.Items.AddChild(AParentNode,SR.Name);
          ScanDir(Path+SR.Name+'\',ATreeView,NewNode);
        end
        else
        begin
          NewNode := ATreeView.Items.AddChild(AParentNode,SR.Name);
          NewNode.Text := SR.Name;
        end;
    until FindNext(SR)<>0;
    FindClose(SR);
  end;
end;

Пример использования (перед запуском в TreeView1 должен быть создан 1 верхний Item):

 ScanDir('e:\temp\d\',TreeView1,TreeView1.Items.Item[0]);


Просто Джо   (2005-07-05 15:57:00) [3]


>  [18] Anatoly Podgoretsky ©   (05.07.05 15:53)
> У жестких дисков букв нет.

Есть. Сам видел - на корпусе нарисованы. И ешшо цыфры :)


Anatoly Podgoretsky   (2005-07-05 15:53:00) [4]

unregister_256   (03.07.05 13:19)  
Как узнать количество и буквы жестких дисков?

У жестких дисков букв нет.


Digitman   (2005-07-05 15:50:00) [5]


> причем дело явно не в алгоритме


именно в алгоритме и дело


> еще попробуй отладку... сам все поймешь


тут и отладка не нужна ... алгоритм даже на невооруженный взгляд "кривой"


MTsv DN   (2005-07-05 13:22:00) [6]

> фенс
Пожалуйста...

С уважением MTsv DN


unregister_256   (2005-07-05 13:10:00) [7]


> MTsv DN   (05.07.05 12:28) [11]
> Вот модуль:
> http://www.uus4u.com/download/modules/treedir.zip
>
> С уважением MTsv DN

фенс


unregister_256   (2005-07-05 13:09:00) [8]

Да ну?
ну так сделай лучше!!


NeoTall   (2005-07-05 13:01:00) [9]

> мне не надо никакких модулей... надо было бы давно бы нашел...
Мог бы найти (а еще лучше написал самому) - ДАВНО БЫ СДЕЛАЛ... А не выпендривался бы...

> мне нужно узнать в чем ошибка
В клавиатуре или, вероятнее, В РУКАХ :о)


unregister_256   (2005-07-05 12:31:00) [10]

мне не надо никакких модулей... надо было бы давно бы нашел...
мне нужно узнать в чем ошибка


MTsv DN   (2005-07-05 12:28:00) [11]

Вот модуль:
http://www.uus4u.com/download/modules/treedir.zip

С уважением MTsv DN


unregister_256   (2005-07-05 10:42:00) [12]

посмотри внимательно на получившуюся структуру катологов в ТриВью... многие файлы и каталоги находятся не в своих директориях... а еще попробуй отладку... сам все поймешь


Anatoly Podgoretsky   (2005-07-05 10:34:00) [13]

Чем "карявость" измеряешь?


unregister_256   (2005-07-05 10:31:00) [14]


{
type
 TfrmMain = class(TForm)
   trvFils: TTreeView;
   imglstFils: TImageList;
}
procedure ScanDir(path:string; ptr:TTreeNode);
var
 f : TSearchRec;

begin
 if FindFirst(path+'*.*', faAnyFile, f) = 0 then
   begin

     repeat
       if (f.Name<>'.')and(f.Name<>'..') then
         if (f.Attr and faDirectory) = faDirectory then
         begin
           ptr:=frmMain.trvFils.Items.AddChildFirst(ptr,'['+f.Name+']');

           ptr.ImageIndex:=1;
           ptr.SelectedIndex:=2;

           ScanDir(path+f.Name+'\',ptr);
         end
         else frmMain.trvFils.Items.AddChild(ptr,f.Name);
     until FindNext(f)<>0;
     FindClose(f);

   end;
end;

procedure TfrmMain.FormCreate(Sender: TObject);
begin
 ScanDir('C:\Test\',trvFils.Items.Item[0]);
end;


Почему то каряво работает... причем дело явно не в алгоритме...
сами попробуйте


unregister_256   (2005-07-04 07:51:00) [15]

огромное спасибо


Просто Джо   (2005-07-03 14:03:00) [16]

Вот, накатал пример класса. Протестировать не успеваю, но вроде работает.


unit Unit2;

interface
uses Windows, Classes;

type

 TCharArray = array of Char;

 TLogicalDrive = record
   Name: string;
   Kind: Word;
 end;

 TLogicalDrives = class
 private
   FDrives: TStrings;
   procedure ParseDrives (Chars: TCharArray);
   procedure Populate;
   function GetCount: Integer;
   function GetDrives(Index: Integer): TLogicalDrive;
 public
   property Count: Integer read GetCount;
   property Drives[Index: Integer]: TLogicalDrive read GetDrives; default;
   constructor Create;
   destructor Destroy; override;
 end;

 function DriveKindToString (AKind: Word): string;

implementation

const
 DriveTypes: array [0..6] of string =
 (
   'UNKNOWN',
   'NO ROOT DIR',
   'REMOVABLE',
   'FIXED',
   'REMOTE',
   'CDROM',
   'RAMDISK'
 );

function DriveKindToString (AKind: Word): string;
begin
 Result := DriveTypes[AKind]
end;

{ TLogicalDrives }

constructor TLogicalDrives.Create;
begin
 inherited Create;
 FDrives := TStringList.Create;

 Populate;
end;

destructor TLogicalDrives.Destroy;
begin
 FDrives.Free;
 inherited;
end;

function TLogicalDrives.GetCount: Integer;
begin
 Result := FDrives.Count
end;

function TLogicalDrives.GetDrives(Index: Integer): TLogicalDrive;
begin
 Result.Name := FDrives[Index];
 Result.Kind := Integer(FDrives.Objects[Index])
end;

procedure TLogicalDrives.ParseDrives(Chars: TCharArray);
var
 I,DrvType: Integer;
 S: string;
begin
 FDrives.Clear;

 S := '';
 for I := 0 to High(Chars) do
 begin
   if Chars[I] <> Chr(0) then
     S := S + Chars[I]
   else
   begin
     if Length(S) <> 0 then
     begin
       DrvType := GetDriveType(PChar(S));
       FDrives.AddObject(S,TObject(DrvType));
       S := ''
     end;
   end;
 end;
end;

procedure TLogicalDrives.Populate;
var
 BuffLen: Integer;
 Buff: TCharArray;
begin
 BuffLen := GetLogicalDriveStrings(0,nil) + 1;
 SetLength (Buff,BuffLen);
 GetLogicalDriveStrings(BuffLen,@Buff[0]);

 ParseDrives(Buff);
end;

end.


Пример использования:

procedure TForm1.Button1Click(Sender: TObject);
var
 Drives: TLogicalDrives;
 I: Integer;
 S: string;
begin
 Memo1.Clear;

 Drives := TLogicalDrives.Create;
 try

   for I := 0 to Drives.Count-1 do
   begin
     S := Drives[I].Name + ' - ' +
          DriveKindToString(Drives[I].Kind);
     Memo1.Lines.Add (S);
   end;

 finally
   Drives.Free;
 end;
end;

Разбирайся. Ничего сложного.


unregister_256   (2005-07-03 13:43:00) [17]

ок... посморю...
но все таки - у кого есть время напишите плиз а то заумные функции... да и первых трех в делфи 7 вообще нет :(


Просто Джо   (2005-07-03 13:41:00) [18]


>  [3] unregister_256   (03.07.05 13:40)

Сорри, нет времени на написание примера. По FindXXX есть рабочий пример в справке.


unregister_256   (2005-07-03 13:40:00) [19]

покажите на примере... а то чтото не могу разобраться с ними


unregister_256   (2005-07-03 13:30:00) [20]

thanks


Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо