喫茶XRAY [Mr.XRAY掲示板]

> SetupAPI (SetupDI API?) 関係の関数類がありました．

SetupAPI を使用すると ClassID の GUID 値が取得できるようです．
CkassID は環境に依存しない値ですから，
皆さんの PC の C ドライブも同じ値になると思います．
以下，参考コードです．
元コードは以下です．

[ドライブ名からデバイス情報を取得する(UsefullCode.net)]
http://www.usefullcode.net/2007/02/post_48.html

Delphi XE(UP1) Pro には SetupAPI は実装されていません．
以下の記事の手順で JEDI API を使用しました．

[475] [パフォーマンスカウンタで CPU の使用率  -  JEDI API の準備]
http://mrxray.on.coocan.jp/Delphi/plSamples/475_CpuUsageRate.htm#00

以下にライブラリのパスを追加しています．
  [Common]
  [Win32API]
  [SaCMAPI]
  [includes]

動作確認環境は Windows 7 U64(SP1) + Delphi XE(UP1) Pro です．

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, JwaWindows;

type
  TForm1 = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses
  SetupApi;

{$R *.dfm}

//=============================================================================
//  ドライブの情報の取得
//  JEDI Windows APIのユニットを使用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);

  //---------------------------------------------------------------------------
  //  引数のAPropertyに相当するプロパティの値を取得する
  //---------------------------------------------------------------------------
  function GetProperty(AhDevInfo: HDEVINFO; ADeviceInfoData:
    TSPDevInfoData; AProperty: DWORD): string;
  var
    LRegDataType : DWORD;
    Lpbuffer     : PByte;
    Lbuffersize  : DWORD;
  begin
    Result := '';

    Lpbuffer := nil;
    Lbuffersize := 0;

    while (not SetupDiGetDeviceRegistryProperty(
         AhDevInfo,
         ADeviceInfoData,
         AProperty,
         LRegDataType,
         Lpbuffer ,
         Lbuffersize,
         Lbuffersize)) do begin
      if (GetLastError = ERROR_INSUFFICIENT_BUFFER) then begin
        if (Lpbuffer <> nil) then begin
          FreeMemory(Lpbuffer);
        end;
        Lpbuffer := GetMemory(Lbuffersize * SizeOf(Char));
      end else begin
        break;
      end;
    end;

    Result := PChar(Lpbuffer);
    if (Lpbuffer <> nil) then begin
      FreeMemory(Lpbuffer);
    end;
  end;
  //---------------------------------------------------------------------------

var
  LDriveLetter    : string;
  LTargetPath     : array [0..MAX_PATH - 1] of Char;
  LPhysicDevName  : string;
  LhDevInfo       : HDEVINFO;
  LDeviceInfoData : TSPDevInfoData;
  LStrProperty    : string;
  LIndex          : DWORD;
begin
  //DLLのロード
  LoadSetupApi;

  ListBox1.Items.Clear;

  LDriveLetter := 'C:';
  QueryDosDevice(PChar(LDriveLetter), LTargetPath, SizeOf(LTargetPath));
  LPhysicDevName := LTargetPath;
  ListBox1.Items.Add(LDriveLetter);

  LhDevInfo := SetupDiGetClassDevs(nil,
     nil,
     0,
     DIGCF_PRESENT or DIGCF_ALLCLASSES );

  if (Cardinal(LhDevInfo) = INVALID_HANDLE_VALUE) then exit;

  LIndex := 0;

  LDeviceInfoData.cbSize := sizeof(TSPDevInfoData);
  while SetupDiEnumDeviceInfo(LhDevInfo, LIndex, LDeviceInfoData) do begin
    Inc(LIndex);

    LStrProperty := GetProperty(LhDevInfo, LDeviceInfoData,
                                SPDRP_PHYSICAL_DEVICE_OBJECT_NAME);

    //QueryDosDeviceで取得したドライブのパス名と同じなら
    if LStrProperty = LPhysicDevName then begin
      ListBox1.Items.Add(LStrProperty);

      //以下，いろいろなプロパティを取得して表示
      LStrProperty := GetProperty(LhDevInfo, LDeviceInfoData, SPDRP_DEVICEDESC);
      ListBox1.Items.Add(LStrProperty);

      LStrProperty := GetProperty(LhDevInfo, LDeviceInfoData, SPDRP_DRIVER);
      ListBox1.Items.Add(LStrProperty);

      LStrProperty := GetProperty(LhDevInfo, LDeviceInfoData, SPDRP_CLASSGUID);
      ListBox1.Items.Add(LStrProperty);
    end;
  end;

  //後処理
  SetupDiDestroyDeviceInfoList(LhDevInfo);
end;

end.