[ ドライブの情報 ] - Halbow 資料館

「ドライブの情報」と言っても、参照元１の絵のように車に乗って出かけるわけではない。（笑）右図のように、「ファイルを開く」コモンダイアログのルートをマイコンピュータにもっていくと、システムの現在のドライブの一覧がリストビューに表示される。右図は、現在の筆者のノートパソコンの例であるが、このような一覧を取得するにはどうしたらよいかをここで調べよう。

最初は、システムのドライブにどんなものがあるかを列挙することから始めよう。

この引数のない API の戻り値は、符号なし３２ビット値であるが、低位のビットから、A ドライブ、B ドライブ、・・・に対応しており、もしそのそのドライブが存在するならば、対応するビットが１になっている。試してみよう。

procedure GetLogicalDriveList(List:TStrings);
var
  Drive,Mask:DWORD;
  i:integer;
begin
  Mask := 1;
  Drive := GetLogicalDrives;
  for i := 0 to 25 do begin
    if (Drive and Mask) <> 0 then List.Add(Char(ord('A')+i));
    Mask := Mask shl 1;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  GetLogicalDriveList(ListBox1.Items);
  Label1.Caption := IntToStr(ListBox1.Items.Count);
end;

つぎに、各ドライブの種類を取得してみよう。参照元２でやった GetDriveType() API を使ってみよう。

引数には、例えば 'A:\' のように設定する。この戻り値は以下のいずれかである。

type
  TDriveType = (dtUnknown, dtNoDrive, dtRemovable, dtFixed,
                                     dtNetwork, dtCDROM, dtRAM);

procedure GetLogicalDriveList(List:TStrings);
var
  Drive,Mask:DWORD;
  i:integer;
begin
  Mask := 1;
  Drive := GetLogicalDrives;
  for i := 0 to 25 do begin
    if (Drive and Mask) <> 0 then List.Add(Char(ord('A')+i));
    Mask := Mask shl 1;
  end;
end;

function AGetDriveType(s:string):TDriveType;
begin
  result := TDriveType(GetDriveType(PChar(s)));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  SL:TStringList;
  i:integer;
  s:string;
begin
  ListBox1.Clear;
  SL := TStringList.Create;
  try
    GetLogicalDriveList(SL);
    Label1.Caption := IntToStr(SL.Count);
    if SL.Count > 0 then begin
      for i := 0 to SL.Count-1 do begin
        s := SL[i][1]+':\';
        case AGetDriveType(s) of
          dtUnknown  : s := s+'  Unknown';
          dtNoDrive  : s := s+'  NoDrive';
          dtRemovable: s := s+'  Removable';
          dtFixed    : s := s+'  Fixed';
          dtNetwork  : s := s+'  Network';
          dtCDROM    : s := s+'  CD-ROM';
          dtRAM      : s := s+'  RAMDisk';
        end;
        ListBox1.Items.Add(s);
      end
    end;
  finally
    SL.Free;
  end;
end;

実行すると右図のようになる。これでだいたい各ドライブの種類は分かったが、フロッピードライブの場所などは分からない。冒頭の図の情報とは違うようだ。

各ドライブの情報は、ShellAPI にある SHGetFileInfo() で取得できる。

pszPath には、ここでは 'A:\' のような文字列を設定する。dwFileAttributes には、NT 系ではファイルの属性を設定できるが、ここではゼロを設定する。psfi には以下のようなレコード型を設定し、戻り値として情報を受け取れる。cbFileInfo は、psfi に設定したレコード型のサイズを設定する。

SHGetFileInfo() の uFlags には取得したい情報のフラグを以下の定数を or で結合して設定する。

const
  SHGFI_ICON              = $000000100;     { アイコンを取得 }
  SHGFI_DISPLAYNAME       = $000000200;     { display name を取得 }
  SHGFI_TYPENAME          = $000000400;     { type name を取得 }
  SHGFI_ATTRIBUTES        = $000000800;     { attributes を取得 }
  SHGFI_ICONLOCATION      = $000001000;     { icon location を取得 }
  SHGFI_EXETYPE           = $000002000;     { exe type を戻り値に返す }
  SHGFI_SYSICONINDEX      = $000004000;     { system icon index を取得 }
  SHGFI_LINKOVERLAY       = $000008000;     { アイコンに link overlay を重ねる }
  SHGFI_SELECTED          = $000010000;     { icon を選択状態にする }
  SHGFI_LARGEICON         = $000000000;     { large icon を取得 }
  SHGFI_SMALLICON         = $000000001;     { small icon を取得 }
  SHGFI_OPENICON          = $000000002;     { open icon にする }
  SHGFI_SHELLICONSIZE     = $000000004;     { shell size icon を取得 }
  SHGFI_PIDL              = $000000008;     { pszPath は pidl である }
  SHGFI_USEFILEATTRIBUTES = $000000010;     { dwFileAttribute フィールドを使う }

SHGetFileInfo() は、成功すると非ゼロを返す。それではやってみよう。Form1 に ListView1 と Label1 と Button1 と ImageList1 を置いて以下のようにする。

uses
  ShellAPI;

type
TDriveShellInfo = record
 Icon:hIcon;
 Image:integer;
 DisplayName,
 TypeName:string
end;

procedure GetLogicalDriveList(List:TStrings);
var
  Drive,Mask:DWORD;
  i:integer;
begin
  Mask := 1;
  Drive := GetLogicalDrives;
  for i := 0 to 25 do begin
    if (Drive and Mask) <> 0 then List.Add(Char(ord('A')+i));
    Mask := Mask shl 1;
  end;
end;

procedure GetDriveShellInfo(Drive:string;var Info:TDriveShellInfo);
var
  SHFileInfo : TSHFileInfo;
begin
  ShGetFileInfo(PChar(Drive),0, SHFileInfo,SizeOf(TSHFileInfo),
     SHGFI_TYPENAME or SHGFI_DISPLAYNAME or SHGFI_ICON or SHGFI_SMALLICON);
  with Info do
  begin
    Icon  := SHFileInfo.hIcon;
    Image := SHFileInfo.iIcon;
    DisplayName := SHFileInfo.szDisplayName;
    TypeName := SHFileInfo.szTypeName
  end
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
  SL:TStringList;
  DSI:TDriveShellInfo;
  IC:TIcon;
begin
  SL := TStringList.Create;
  IC := TIcon.Create;
  try
    GetLogicalDriveList(SL);
    Label1.Caption := IntToStr(SL.Count);
    if SL.Count > 0 then
      for i := 0 to SL.Count-1 do begin
        GetDriveShellInfo(SL[i]+':\',DSI);
        IC.Handle := DSI.Icon;
        with ListView1.Items.Add do begin
          Caption := DSI.DisplayName;
          ImageIndex := ImageList1.AddIcon(IC);
        end;
        DestroyIcon(DSI.Icon);
      end;
  finally
    SL.Free;
    IC.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.ViewStyle := vsSmallIcon;
  ListView1.SmallImages := ImageList1;
  ListView1.Font.Name := 'MS UI Gothic';
end;

実行して Button1 を押すと右図のようになる。どうやら、冒頭の図と同じようになったらしい。

VCL の関数には、SysUtils にドライブの容量と空き容量を取得する以下の関数がある。

これらは、ドライブの容量、または空き容量をバイト単位で返す。ドライブ番号は，0 がカレントドライブ，1 が A ドライブ，2 が B ドライブ・・・となっている。ドライブ番号が無効な場合は -1 を返し、エラーが起きないので、特にリムーバブルドライブにアクセスするときは、この関数でメディアの有無を取得できる。

function ADiskSize(ch:Char):Int64;
begin
  result := DiskSize(Ord(ch)-64);
end;

function ADiskFree(ch:Char):Int64;
begin
  result := DiskFree(Ord(ch)-64);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  ret:Int64;
  d:Double;
begin
  ret := ADiskSize('A');
  if ret = -1 then
    ShowMessage('DiskSize Failed!')
  else begin
    d := ret div 1024;
    Label1.Caption := Format('容量 %.0n ｷﾛﾊﾞｲﾄ',[d]);
    ret := ADiskFree('A');
    d := ret div 1024;
    Label2.Caption := Format('空き容量 %.0n ｷﾛﾊﾞｲﾄ',[d]);
  end;
end;

実行すると右図のようになる。筆者の A ドライブはフロッピードライブであるが、メディアを挿しているときは上記のように正常に動作するし、メディアを引っこ抜いても、エラーは起きない。上記の例では、ShowMessage() が実行される。

また、右図は筆者の E ドライブに対して行った結果である。640MB MO ドライブである。

を使って得られる。lpRootPathName には、GetDriveType() のパラメータと同じように 'C:\' などと指定する｡ lpVolumeNameBuffer には、名前を受け取るバッファを指定する｡ nVolumeNameSize には、受け取るバッファのサイズをバイト単位で指定する。 lpVolumeSerialNumber にはシリアル番号を受け取る DWORD 型変数のアドレスを指定する。 lpMaximumComponentLength はファイルシステムのパス名のうち \ 記号で挟まれている部分で使える最長の名前の大きさをバイト単位で受け取るために DWORD 型の変数を指定する。長いファイル名をサポートしているシステムでは、255 を受け取る。 lpFileSystemFlags には、以下の定数の組み合わせが返される。

  FS_CASE_IS_PRESERVED = FILE_CASE_PRESERVED_NAMES;//大文字・小文字を予約ずみ
  FS_CASE_SENSITIVE = FILE_CASE_SENSITIVE_SEARCH;  //大文字・小文字を区別する
  FS_UNICODE_STORED_ON_DISK = FILE_UNICODE_ON_DISK;//ファイル名にユニコードをサポート
  FS_PERSISTENT_ACLS = FILE_PERSISTENT_ACLS;       //ACLSを使用（NTなど）
  FS_VOL_IS_COMPRESSED = FILE_VOLUME_IS_COMPRESSED;//圧縮されている
  FS_FILE_COMPRESSION = FILE_FILE_COMPRESSION;     //ファイルベースの圧縮をサポート

  FILE_CASE_SENSITIVE_SEARCH          = $00000001; 
  FILE_CASE_PRESERVED_NAMES           = $00000002; 
  FILE_UNICODE_ON_DISK                = $00000004; 
  FILE_PERSISTENT_ACLS                = $00000008; 
  FILE_FILE_COMPRESSION               = $00000010; 
  FILE_VOLUME_IS_COMPRESSED           = $00008000;

そのほかにもあるかも知れない。これらの定数の意味については、MSDN などを調べてほしい。lpFileSystemNameBuffer は、そのボリュウムのファイルシステムの名前が返される。nFileSystemNameSize は、システム名を受け取るバッファのサイズをバイト単位で指定する。それでは試してみよう。

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ComCtrls, ImgList;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    ListView1: TListView;
    ImageList1: TImageList;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ListView1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  ShellAPI;

type
TDriveShellInfo = record
  Icon:hIcon;
  Image:integer;
  DisplayName,
  TypeName:string
end;

TVolumeInformation = record
  VolumeName:string;
  VolumeSerialNumber,
  MaximumComponentLength,
  FileSystemFlags:DWORD;
  FileSystemName:string;
end;

procedure GetLogicalDriveList(List:TStrings);
var
  Drive,Mask:DWORD;
  i:integer;
begin
  Mask := 1;
  Drive := GetLogicalDrives;
  for i := 0 to 25 do begin
    if (Drive and Mask) <> 0 then List.Add(Char(ord('A')+i));
    Mask := Mask shl 1;
  end;
end;

procedure GetDriveShellInfo(Drive:string;var Info:TDriveShellInfo);
var
  SHFileInfo : TSHFileInfo;
begin
  ShGetFileInfo(PChar(Drive),0, SHFileInfo,SizeOf(TSHFileInfo),
     SHGFI_TYPENAME or SHGFI_DISPLAYNAME or SHGFI_ICON or SHGFI_SMALLICON);
  with Info do
  begin
    Icon  := SHFileInfo.hIcon;
    Image := SHFileInfo.iIcon;
    DisplayName := SHFileInfo.szDisplayName;
    TypeName := SHFileInfo.szTypeName
  end
end;

function ADiskSize(ch:Char):Int64;
begin
  result := DiskSize(Ord(ch)-64);
end;

function ADiskFree(ch:Char):Int64;
begin
  result := DiskFree(Ord(ch)-64);
end;

function AGetVolumeInformation(Drive:Char;var V:TVolumeInformation):Boolean;
begin
  result := false;
  if ADiskSize(Drive) = -1 then exit;

  with V do
  begin
    SetLength(VolumeName,MAX_PATH);
    SetLength(FileSystemName,MAX_PATH);
    VolumeSerialNumber := 0;
    MaximumComponentLength := 0;
    FileSystemFlags := 0;
    Result := GetVolumeInformation(PChar(Drive+':\'),PChar(VolumeName),
                   MAX_PATH,@VolumeSerialNumber,MaximumComponentLength,
                   FileSystemFlags,PChar(FileSystemName),MAX_PATH);
    SetLength(VolumeName,StrLen(PChar(VolumeName)));
    SetLength(FileSystemName,StrLen(PChar(FileSystemName)));
  end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
  SL:TStringList;
  DSI:TDriveShellInfo;
  IC:TIcon;
begin
  SL := TStringList.Create;
  IC := TIcon.Create;
  try
    GetLogicalDriveList(SL);
    Label1.Caption := IntToStr(SL.Count);
    if SL.Count > 0 then
      for i := 0 to SL.Count-1 do begin
        GetDriveShellInfo(SL[i]+':\',DSI);
        IC.Handle := DSI.Icon;
        with ListView1.Items.Add do begin
          Caption := DSI.DisplayName;
          SubItems.Add(SL[i]);
          ImageIndex := ImageList1.AddIcon(IC);
        end;
        DestroyIcon(DSI.Icon);
      end;
  finally
    SL.Free;
    IC.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  ListView1.ViewStyle := vsSmallIcon;
  ListView1.SmallImages := ImageList1;
  ListView1.Font.Name := 'MS UI Gothic';
end;

procedure TForm1.ListView1Click(Sender: TObject);
var
  VI:TVolumeInformation;
begin
  if AGetVolumeInformation(ListView1.Selected.SubItems[0][1],VI) then begin
    ListBox1.Clear;
    with VI do begin
      ListBox1.Items.Add(       'VolumeName:      '+VolumeName);
      ListBox1.Items.Add(Format('VolSerialNumber: %u',[VolumeSerialNumber]));
      ListBox1.Items.Add(Format('MaxCompLength:   %u',[MaximumComponentLength]));
      ListBox1.Items.Add(Format('FileSystemFlags: $%x',[FileSystemFlags]));
      ListBox1.Items.Add(       'FileSystemName:  '+FileSystemName);
    end;
  end else
    ShowMessage('メディアがありません');
end;

実行して、Button1 を押して表示される ListView1 の項目をクリックすると、右図のように ListBox1 にその情報が表示される。

以上、ここではドライブの情報を取得する方法について調べた。