![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Работа с каталогами [D7]
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