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

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

Узнать какие диски присутствуют [D7, WinXP]

Destroyer ©   (2005-12-11 20:30:00) 

Как узнать какие жесткие(и нетолько) диски присутствуют в компе? В смысле их буквы : C:, D: ...? Заранее спасибо.

---

VirEx   (2005-12-12 19:01:00) [1]

procedure TForm1.Button3Click(Sender: TObject);
var
 i, mask : integer;
 s : string;
begin
//находим все устройства
mask := GetLogicalDrives;
i := 0;
while mask<>0 do begin
s:= chr( ord('a') + i ) + ':\';
if (mask and 1) <> 0 then
case GetDriveType(PChar(s)) of
 0               : Memo1.Lines.Add(s + ' unknown.');
 1               : Memo1.Lines.Add(s + ' not exist.');
 DRIVE_REMOVABLE : Memo1.Lines.Add(s + ' removable.'); // floppy,zip
 DRIVE_FIXED     : Memo1.Lines.Add(s + ' fixed.');
 DRIVE_REMOTE    : Memo1.Lines.Add(s + ' network.');
 DRIVE_CDROM     : Memo1.Lines.Add(s + ' CD-ROM.');
 DRIVE_RAMDISK   : Memo1.Lines.Add(s + ' RAM.');
end;
inc(i); mask := mask shr 1;
end;

---

Джо   (2005-12-12 01:19:00) [2]

> [7] Anatoly Podgoretsky ©   (11.12.05 23:53)

Угум-с :)

---

Anatoly Podgoretsky   (2005-12-11 23:53:00) [3]

Джо ©   (11.12.05 22:57) [4]
Решил повеселиться в конце недели :-)

---

Destroyer   (2005-12-11 23:38:00) [4]

Огромное спасибо, буду пробовать.

---

Джо   (2005-12-11 23:10:00) [5]

Сорри, но раз уж сам вызвался... Случайно обнаружил более новый вариант юнита, им удобнее пользоваться и немного логичнее.

unit LogDrives;

interface
uses Windows, Classes;

type

 TCharArray = array of Char;

 IDriveSize = interface
   ['{05BC3517-3F19-471A-A4BB-5D155592B45F}']
   function GetAvailableBytes: Int64;
   function GetFreeBytes: Int64;
   function GetTotalBytes: Int64;
   property AvailableBytes: Int64 read GetAvailableBytes;
   property FreeBytes: Int64 read GetFreeBytes;
   property TotalBytes: Int64 read GetTotalBytes;
 end;

 ILogicalDrive = interface
   ['{B16AB8A6-5FCE-485A-AEAC-D2F5F006D986}']
   function GetName: string;
   function GetKind: Word;
   function GetSize: IDriveSize;
   property Name: string read GetName;
   property Kind: Word read GetKind;
   property Size: IDriveSize read GetSize;
 end;

 ILogicalDrives = interface
   ['{755E3820-7C87-4A07-B897-1A8E136FB93F}']
   function GetCount: Integer;
   function GetDrives(Index: Integer): ILogicalDrive;
   property Count: Integer read GetCount;
   property Drives[Index: Integer]: ILogicalDrive read GetDrives; default;
 end;

 function GetLogicalDrives: ILogicalDrives;
 function DriveKindToString (AKind: Word): string;

implementation
uses SysUtils;

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

type
 TLogicalDrive = class (TInterfacedObject, ILogicalDrive)
 private
   FName: string;
   FKind: Word;
   function GetName: string;
   function GetKind: Word;
   function GetSize: IDriveSize;
 public
   constructor Create (AName: string);
 end;

 TDriveSize = class (TInterfacedObject, IDriveSize)
 private
   FAvailableBytes,
   FFreeBytes,
   FTotalBytes: Int64;
   function GetAvailableBytes: Int64;
   function GetFreeBytes: Int64;
   function GetTotalBytes: Int64;
 public
   constructor Create (AName: string);
 end;

 TLogicalDrives = class (TInterfacedObject, ILogicalDrives)
 private
   FDrives: TStrings;
   procedure ParseDrives (Chars: TCharArray);
   procedure Populate;
   function GetCount: Integer;
   function GetDrives(Index: Integer): ILogicalDrive;
   procedure AddDrive(S: string);
 public
   constructor Create;
   destructor Destroy; override;
 end;

function GetLogicalDrives: ILogicalDrives;
begin
 Result := TLogicalDrives.Create
end;  

function DriveKindToString (AKind: Word): string;
begin
 Assert (AKind in [Low(DriveTypes)..High(DriveTypes)],
   'Неверный тип логического диска');

 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): ILogicalDrive;
begin
 Result := TLogicalDrive.Create(FDrives[Index]);
end;

procedure TLogicalDrives.AddDrive(S: string);
begin
 FDrives.Add (S);
end;

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

 S := '';
 for I := 0 to High(Chars) do
 begin
   if Chars[I] <> #0 then
     S := S + Chars[I]
   else
   begin
     if Length(S) <> 0 then
     begin
       AddDrive(S);
       S := ''
     end;
   end;
 end;
end;

procedure TLogicalDrives.Populate;
var
 BuffLen: Integer;
 Buff: TCharArray;
begin
 BuffLen := GetLogicalDriveStrings(0,nil) + 1;
 if BuffLen = 0 then
   RaiseLastOSError;

 SetLength (Buff,BuffLen);
 if GetLogicalDriveStrings(BuffLen,@Buff[0]) = 0 then
   RaiseLastOSError;

 ParseDrives(Buff);
end;

{ TLogicalDrive }

constructor TLogicalDrive.Create(AName: string);
begin
 inherited Create;
 FName := AName;
 FKind := GetDriveType(PChar(AName));
end;

function TLogicalDrive.GetKind: Word;
begin
 Result := FKind
end;

function TLogicalDrive.GetName: string;
begin
 Result := FName
end;

function TLogicalDrive.GetSize: IDriveSize;
begin
 Result := TDriveSize.Create(FName)
end;

{ TDriveSize }

constructor TDriveSize.Create(AName: string);
begin
 inherited Create;
 if not GetDiskFreeSpaceEx (
   PChar(AName),
   FAvailableBytes,
   FTotalBytes,
   @FFreeBytes) then
     RaiseLastOSError;
end;

function TDriveSize.GetAvailableBytes: Int64;
begin
 Result := FAvailableBytes
end;

function TDriveSize.GetFreeBytes: Int64;
begin
 Result := FFreeBytes
end;

function TDriveSize.GetTotalBytes: Int64;
begin
 Result := FTotalBytes
end;

end.

Соответственно, пример будет выглядеть так:

procedure TForm1.Button1Click(Sender: TObject);
var
 I: Integer;
 Drives: ILogicalDrives;
 Drive: ILogicalDrive;
 Size: IDriveSize;
 S: string;
begin
 ListBox1.Clear;
 Drives := GetLogicalDrives;

 for I := 0 to Drives.Count - 1 do
 begin
   Drive := Drives[I];
   S := Format ('%s [%s]',
     [Drive.Name,DriveKindToString(Drive.Kind)]);

   if Drive.Kind = DRIVE_FIXED then
   begin
     Size := Drive.Size;
     S := S + ' ' +
       Format ('Total: %d, Free: %d, Avail: %d',
         [Size.TotalBytes, Size.FreeBytes, Size.AvailableBytes]);
   end;

   ListBox1.Items.Add(S)
 end;
end;



---

Джо   (2005-12-11 22:57:00) [6]

Вот, нашел недоделанный модуль, когда-то кому то на форуме давал. Там есть немного лишнего и немного недоделано, но то, что тебе нужно, есть. Модифицируй и пользуйся.

unit LogDrives;

interface
uses Windows, Classes;

type

 TCharArray = array of Char;

 IDriveSize = interface
   ['{05BC3517-3F19-471A-A4BB-5D155592B45F}']
   function GetAvailableBytes: Int64;
   function GetFreeBytes: Int64;
   function GetTotalBytes: Int64;
   property AvailableBytes: Int64 read GetAvailableBytes;
   property FreeBytes: Int64 read GetFreeBytes;
   property TotalBytes: Int64 read GetTotalBytes;
 end;

 ILogicalDrive = interface
   ['{B16AB8A6-5FCE-485A-AEAC-D2F5F006D986}']
   function GetName: string;
   function GetKind: Word;
   function GetSize: IDriveSize;
   property Name: string read GetName;
   property Kind: Word read GetKind;
   property Size: IDriveSize read GetSize;
 end;

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

 function DriveKindToString (AKind: Word): string;

implementation
uses SysUtils;

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

type
 TLogicalDrive = class (TInterfacedObject, ILogicalDrive)
 private
   FName: string;
   FKind: Word;
   function GetName: string;
   function GetKind: Word;
   function GetSize: IDriveSize;
 public
   constructor Create (AName: string);
 end;

 TDriveSize = class (TInterfacedObject, IDriveSize)
 private
   FAvailableBytes,
   FFreeBytes,
   FTotalBytes: Int64;
   function GetAvailableBytes: Int64;
   function GetFreeBytes: Int64;
   function GetTotalBytes: Int64;
 public
   constructor Create (AName: string);
 end;

function DriveKindToString (AKind: Word): string;
begin
 Assert (AKind in [Low(DriveTypes)..High(DriveTypes)],
   'Неверный тип логического диска');

 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): ILogicalDrive;
begin
 Result := TLogicalDrive.Create(FDrives[Index]);
end;

procedure TLogicalDrives.AddDrive(S: string);
begin
 FDrives.Add (S);
end;

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

 S := '';
 for I := 0 to High(Chars) do
 begin
   if Chars[I] <> #0 then
     S := S + Chars[I]
   else
   begin
     if Length(S) <> 0 then
     begin
       AddDrive(S);
       S := ''
     end;
   end;
 end;
end;

procedure TLogicalDrives.Populate;
var
 BuffLen: Integer;
 Buff: TCharArray;
begin
 BuffLen := GetLogicalDriveStrings(0,nil) + 1;
 if BuffLen = 0 then
   RaiseLastOSError;

 SetLength (Buff,BuffLen);
 if GetLogicalDriveStrings(BuffLen,@Buff[0]) = 0 then
   RaiseLastOSError;

 ParseDrives(Buff);
end;

{ TLogicalDrive }

constructor TLogicalDrive.Create(AName: string);
begin
 inherited Create;
 FName := AName;
 FKind := GetDriveType(PChar(AName));
end;

function TLogicalDrive.GetKind: Word;
begin
 Result := FKind
end;

function TLogicalDrive.GetName: string;
begin
 Result := FName
end;

function TLogicalDrive.GetSize: IDriveSize;
begin
 Result := TDriveSize.Create(FName)
end;

{ TDriveSize }

constructor TDriveSize.Create(AName: string);
begin
 inherited Create;
 if not GetDiskFreeSpaceEx (
   PChar(AName),
   FAvailableBytes,
   FTotalBytes,
   @FFreeBytes) then
     RaiseLastOSError;
end;

function TDriveSize.GetAvailableBytes: Int64;
begin
 Result := FAvailableBytes
end;

function TDriveSize.GetFreeBytes: Int64;
begin
 Result := FFreeBytes
end;

function TDriveSize.GetTotalBytes: Int64;
begin
 Result := FTotalBytes
end;

end.

Пример. На форме кнопка и TListBox, даю код обработчика нажатия на кнопку.

uses ... LogDrives ....;
procedure TForm1.Button1Click(Sender: TObject);
var
 I: Integer;
 Drives: TLogicalDrives;
 Drive: ILogicalDrive;
 Size: IDriveSize;
 S: string;
begin
 ListBox1.Clear;
 Drives := TLogicalDrives.Create;
 try
   for I := 0 to Drives.Count - 1 do
   begin
     Drive := Drives[I];
     S := Format ('%s [%s]',
       [Drive.Name,DriveKindToString(Drive.Kind)]);

     if Drive.Kind = DRIVE_FIXED then
     begin
       Size := Drive.Size;
       S := S + ' ' +
         Format ('Total: %d, Free: %d, Avail: %d',
           [Size.TotalBytes, Size.FreeBytes, Size.AvailableBytes]);
     end;

     ListBox1.Items.Add(S)
   end;
 finally
   Drives.Free;
 end;
end;


---

Джо   (2005-12-11 22:46:00) [7]

>  [2] Destroyer ©   (11.12.05 22:25)

Произвести разбор в цикле.

---

Destroyer   (2005-12-11 22:25:00) [8]

А как бы выделить все диски в отдельные строковые переменные? Понятно что можно в цикле всё это долго перебирать, но может есть другой способ?

---

Джо   (2005-12-11 20:32:00) [9]

Логические диски: GetLogicalDriveStrings

---

Наверх