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

Вниз

Узнать какие диски присутствуют   Найти похожие ветки 

← →
Destroyer ©   (2005-12-11 20:30) [0]

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

---

← →
Джо ©   (2005-12-11 20:32) [1]

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

---

← →
Destroyer ©   (2005-12-11 22:25) [2]

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

---

← →
Джо ©   (2005-12-11 22:46) [3]

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

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

---

← →
Джо ©   (2005-12-11 22:57) [4]

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

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 23:10) [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;



---

← →
Destroyer ©   (2005-12-11 23:38) [6]

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

---

← →
Anatoly Podgoretsky ©   (2005-12-11 23:53) [7]

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

---

← →
Джо ©   (2005-12-12 01:19) [8]

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

Угум-с :)

---

← →
VirEx ©   (2005-12-12 19:01) [9]

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;

---

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

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

Наверх

Память: 0.51 MB
Время: 0.042 c