Mam's WebSite

Mamの覚書Q&A検索


大項目:「 Delphi 」 - 中項目:「 API 」

「 デバイス認識 」

デバイス認識


回答

ソース

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs ,DBT, StdCtrls,ShlObj,Registry;
 
type
  TDeviceType = (dtOEM,
                 dtDEVNODE,
                 dtVOLUME,
                 dtPORT,
                 dtNET,
                 dtDEVICEINTERFACE,
                 dtHANDLE);
 
  TDeviceTypes = set of TDeviceType;
  TWMDeviceChange = record
    Msg: Cardinal;
    Event: UINT;
    dwData: Pointer;
    Result: LongInt;
  end;
 
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    procedure WMDEVICECHANGE(var Msg: TMessage);message WM_DEVICECHANGE;
    function FirstDriveFromMask (unitmask:Cardinal):char;
  public
    { Public 宣言 }
  end;
 

 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
{ TForm1 }
 
procedure TForm1.WMDEVICECHANGE(var Msg: TMessage);
var
  MsgType: String;
  Filter: PDevBroadcastVolume;
  lpdb: PDEVBROADCASTHDR;
  Volume: String;
  lpdbv:PDevBroadcastVolume;
  sDevInt:PDevBroadcastDeviceInterface;
  flag:integer;//外付けドライブは2、CDは1、ネットワークは0、以外は-1
  drv:char;
  reg:TRegistry;
begin
  flag:=-1;
  lpdb := PDEVBROADCASTHDR({Msg.lParam}Msg.lParam);
  if assigned(lpdb) then
  begin
    case lpdb^.dbch_devicetype of
      DBT_DEVTYP_OEM: MsgType := 'OEM- or IHV-defined';
      DBT_DEVTYP_DEVNODE: MsgType := 'Devnode number';
      DBT_DEVTYP_VOLUME:
      begin
        MsgType := 'Logical volume';
        lpdbv:=PDevBroadcastVolume(lpdb);
        if (lpdbv.dbcv_flags and DBTF_MEDIA)<>0 then
        begin
          memo1.Lines.Add('挿入CDは:'+FirstDriveFromMask(lpdbv.dbcv_unitmask));
          drv:=FirstDriveFromMask(lpdbv.dbcv_unitmask);
          flag:=0;
        end
        else if (lpdbv.dbcv_flags and DBTF_NET)<>0 then
        begin
          memo1.Lines.Add('ネットワークドライブは:'+FirstDriveFromMask(lpdbv.dbcv_unitmask));
          drv:=FirstDriveFromMask(lpdbv.dbcv_unitmask);
          flag:=1;
        end
        else
        begin
          memo1.Lines.Add('外付けドライブは:'+FirstDriveFromMask(lpdbv.dbcv_unitmask));
          drv:=FirstDriveFromMask(lpdbv.dbcv_unitmask);
          flag:=2;
        end;
 

//PDEV_BROADCAST_VOLUME lpdbv = (PDEV_BROADCAST_VOLUME)lpdb;
 
//           if (lpdbv -> dbcv_flags & DBTF_MEDIA)
           {
              wsprintf (szMsg, "Drive %c: was removed\n",
                        FirstDriveFromMask(lpdbv ->dbcv_unitmask));
 
              MessageBox (hwnd, szMsg, "WM_DEVICECHANGE", MB_OK);
           }
 
      end;
      DBT_DEVTYP_PORT: MsgType := 'Port (serial or parallel';
      DBT_DEVTYP_NET: MsgType := 'Network resource';
      DBT_DEVTYP_DEVICEINTERFACE:
      begin
        sDevInt:=PDevBroadcastDeviceInterface(Msg.lParam);
 
        MsgType := 'DEVTYP_DEVICEINTERFACE';
      end;
      DBT_DEVTYP_HANDLE: MsgType := 'DEVTYP_HANDLE';
    else MsgType := 'Unkown DeviceType' + IntToStr(lpdb^.dbch_devicetype);
    end;
  end;
  Memo1.Lines.Add(MsgType);
 
  case {Msg.wParam} Msg.WParam of
    //デバイスが使用可能になりました
    DBT_DEVICEARRIVAL: MsgType := 'DBT_DEVICEARRIVAL';
    //デバイス停止要求が発行されました
    DBT_DEVICEQUERYREMOVE: MsgType := 'DBT_DEVICEQUERYREMOVE';
    //デバイス停止要求が失敗されました
    DBT_DEVICEQUERYREMOVEFAILED: MsgType := 'DBT_DEVICEQUERYREMOVEFAILED';
    //デバイスを停止中です
    DBT_DEVICEREMOVEPENDING: MsgType := 'DBT_DEVICEREMOVEPENDING';
    //デバイスが停止されました
    DBT_DEVICEREMOVECOMPLETE: MsgType := 'DBT_DEVICEREMOVECOMPLETE';
    //デバイスの独自イベントが発行されました
    DBT_DEVICETYPESPECIFIC: MsgType := 'DBT_DEVICETYPESPECIFIC';
    //設定が変更されました。
    DBT_CONFIGCHANGED: MsgType := 'DBT_CONFIGCHANGED';
    //設定変更要求がキャンセルされました
    DBT_CONFIGCHANGECANCELED: MsgType := 'DBT_CONFIGCHANGECANCELED';
    //ドライバー定義のカスタムイベントが発行されました
    DBT_CUSTOMEVENT:MsgType := 'DBT_CUSTOMEVENT';
    //システムのデバイス状態が変化しました
    DBT_DEVNODES_CHANGED:MsgType := 'DBT_DEVNODES_CHANGED';
    else MsgType := 'Unknown event ' + IntToHex(Msg.wParam, 0);
  end;
  if MsgType <> 'DBT_DEVNODES_CHANGED' then
  begin
    Memo1.Lines.Add(MsgType);
    Memo1.Lines.Add('Msg: ' + IntToStr(Msg.Msg));
    Memo1.Lines.Add('wParam: ' + IntToStr(Msg.wParam));
    Memo1.Lines.Add('lParam: ' + IntToStr(Msg.lParam));
    if MsgType = 'DBT_DEVICEARRIVAL' then
    begin
      if fileexists(drv+':\write.txt') then
      begin
        reg:=TRegistry.Create;
        try
          reg.RootKey:=HKEY_LOCAL_MACHINE;
          reg.OpenKey('SYSTEM\CurrentControlSet\Control\StorageDevicePolicies',true);
          reg.WriteInteger('WriteProtect',0);
        finally
          reg.Free;
        end;
      end;
    end;
    if MsgType = 'DBT_DEVICEREMOVECOMPLETE' then
    begin
      //showmessage('はずした');
      reg:=TRegistry.Create;
      try
        reg.RootKey:=HKEY_LOCAL_MACHINE;
        reg.OpenKey('SYSTEM\CurrentControlSet\Control\StorageDevicePolicies',true);
        reg.WriteInteger('WriteProtect',1);
      finally
        reg.Free;
      end;
    end;
  end;
{
  if Msg.lParam > 0 then
  begin
    Filter:= @Msg.lParam;
//    Volume:= DetermineVolume(Filter^.dbcv_unitmask);
    MsgType := MsgType + ' ' + Volume +
      ' '+ IntToSTr(Filter^.dbcv_flags);
    Memo1.Lines.Add(MsgType);
  end;
}
 
  if Msg.wParam = DBT_DEVICEARRIVAL then
  begin
    //do something
  end;
end;
 

function TForm1.FirstDriveFromMask (unitmask:Cardinal):char;
var i,j:integer;
begin
 
  for i := 0 to  25 do
  begin
    if (unitmask and 1)<>0 then
    begin
     j:=i;
     break;
    end;
    unitmask:=unitmask shr 1;
  end;
 
  {
     if (unitmask & 0x1)
        break;
     unitmask = unitmask >> 1;
  }
 
  result:= chr(j + ord('A'));
end;
 

procedure TForm1.Button1Click(Sender: TObject);
begin
//  SHChangeNotify(SHCNE_ASSOCCHANGED,SHCNF_FLUSH,nil,nil);
  SHChangeNotify(SHCNE_DISKEVENTS,SHCNF_FLUSH,nil,nil);
 
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var reg:TRegistry;
begin
  reg:=TRegistry.Create;
  try
    reg.RootKey:=HKEY_LOCAL_MACHINE;
    reg.OpenKey('SYSTEM\CurrentControlSet\Control\StorageDevicePolicies',true);
    reg.WriteInteger('WriteProtect',1);
  finally
    reg.Free;
  end;
end;
 
end.

Copyright 2019 Mam