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

Вниз

А как получить список Дисков (FDD/HDD/CD/DVD)   Найти похожие ветки 

← →
AllBrain ©   (2006-03-11 13:20) [0]

Люди не подскажите как мне, получить список дисков, которые
у меня в системе есть ?
___________________
Заранее благодарин 8)

---

← →
Джо ©   (2006-03-11 13:30) [1]

Завалялся пример.

unit Unit2;

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;  


---

← →
AllBrain ©   (2006-03-11 13:56) [2]

Благодарю ДЖО, точно в яблочко 8)

---

← →
Eraser ©   (2006-03-11 21:02) [3]

> Джо ©   (11.03.06 13:30) [1]

;-)

---

← →
tesseract ©   (2006-03-12 12:12) [4]

Вспоминаю hello world у Master programmer :-))

type
 DriveRecord = record
    Letter:Char;   // буква диска
    kind:string; // тип диска
    caption:string; // метка диска
    FreeSpace, // свободное место
    EvailSpace, // доступное место
    TotalSpace:int64; // всего размер диска
    FileSystemName:string; // Имя файловой системы
    FileSystemFlags:cardinal; // Флаги файловой системы
    MaxFilenameSize:cardinal; // длина имени файла
    SerialNo:cardinal; // серийный номер тома

end;
type TDrives=array of DriveRecord;
const DTypeName:array[0..6] of string=("отсутствует","нет корневой папки","сьёмный диск","локальный диск","сетевой диск","CD/DVD ROM","виртуальный диск");

function GetDriveList:TDrives;
Var DriveString:Pchar;
   Size:integer;
   tChar,tcaption,tFSname:Pchar;
   DrvType:integer;
begin
// Получаем размер буфера
Size:=GetLogicalDriveStrings(0,nil);
GetMem(DriveString,size);
GetMem(tCaption,128);
GetMem(tFsName,128);
FillChar(DriveString^,size,#0);
GetLogicalDriveStrings(size,DriveString);
SetErrorMode(SEM_FAILCRITICALERRORS);
   while DriveString^ <> #0 do
   begin
     tChar := DriveString;
     Inc(DriveString, 4);
     DrvType:=GetDriveType(tChar);
     if (DrvType>0) and (DrvType<6) then // нормальная такая проверка
     begin
       SetLength(result,length(result)+1);
       with result[length(result)-1] do
        begin
          letter:=tChar^;
          kind:=DTypeName[DrvType];
          GetVolumeInformation(tChar,tCaption,128,@SerialNo,maxFileNameSize,FileSystemFlag s,tFSname,128);
          caption:=tCaption;
          FileSystemName:=tFSName;
          GetDiskFreeSpaceEx(tChar,EvailSpace,TotalSpace,@FreeSpace);
        end;

     end;
   end;
end;



Использование

procedure TForm1.Button1Click(Sender: TObject);
var DriveList:TDrives;
i:integer;
begin
DriveList:=GetDriveList;
 for i:=0 to length(DriveList)-1 do
  memo1.Lines.Add(DriveList[i].kind + " " +Drivelist[i].caption+ " " +Drivelist[i].FileSystemName );

end;


---

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

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

Наверх

Память: 0.49 MB
Время: 0.034 c