unit_main.~pas

设备管理器。就像Window的设备管理器一样。源码来自网络

unit Unit_Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ImgList, ComCtrls, SetupApi, Menus, ExtCtrls;

const
  CfgMgr32ModuleName        = 'cfgmgr32.dll';
  SetupApiModuleName        = 'SetupApi.dll';
  REGSTR_VAL_NODISPLAYCLASS = 'NoDisplayClass';
  CR_SUCCESS                = $00000000;
  CR_REMOVE_VETOED          = $00000017;
  DN_HAS_PROBLEM            = $00000400;
  DN_DISABLEABLE            = $00002000;
  DN_REMOVABLE              = $00004000;
  DN_NO_SHOW_IN_DM          = $40000000;
  CM_PROB_DISABLED          = $00000016;
  CM_PROB_HARDWARE_DISABLED = $0000001D;

type
  _PNP_VETO_TYPE = (
     PNP_VetoTypeUnknown,
     PNP_VetoLegacyDevice,
     PNP_VetoPendingClose,
     PNP_VetoWindowsApp,
     PNP_VetoWindowsService,
     PNP_VetoOutstandingOpen,
     PNP_VetoDevice,
     PNP_VetoDriver,
     PNP_VetoIllegalDeviceRequest,
     PNP_VetoInsufficientPower,
     PNP_VetoNonDisableable,
     PNP_VetoLegacyDriver
  );
  PNP_VETO_TYPE = _PNP_VETO_TYPE;
  PPNP_VETO_TYPE = ^_PNP_VETO_TYPE;
  TPNPVetoType = _PNP_VETO_TYPE;
  PPNPVetoType = PPNP_VETO_TYPE;

  function CM_Get_DevNode_Status(pulStatus: PULong; pulProblemNumber: PULong;
  dnDevInst: DWord; ulFlags: ULong): DWord; stdcall;
  external CfgMgr32ModuleName name 'CM_Get_DevNode_Status';

  function CM_Request_Device_Eject(dnDevInst: DWord; out pVetoType: TPNPVetoType;
  pszVetoName: PChar; ulNameLength: ULong; ulFlags: ULong): DWord; stdcall;
  external SetupApiModuleName name 'CM_Request_Device_EjectA';


type
  TForm1 = class(TForm)
    TreeView1: TTreeView;
    ImageList1: TImageList;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N5: TMenuItem;
    N4: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    Panel1: TPanel;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Deletion(Sender: TObject; Node: TTreeNode);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure TreeView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
    procedure N5Click(Sender: TObject);
    procedure N6Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure N8Click(Sender: TObject);
  private
    DevInfo: hDevInfo;
    ClassImageListData: TSPClassImageListData;
    ShowHidden: Boolean;
    ahandle:DWORD;
    procedure GetDevInfo;
    function EnumAddDevices(ShowHidden: Boolean; DevInfo: hDevInfo; ahd:DWORD = 0): Boolean;
    function CheckStatus(ahd: DWord; hDevInfo: hDevInfo;
      StatusFlag: LongWord): Boolean;
    function ConstructDeviceName(DeviceInfoSet: hDevInfo;
      DeviceInfoData: TSPDevInfoData; Buffer: PChar;
      dwLength: DWord): Boolean;
    function GetClassImageIndex(ClassGuid: TGuid; Index: PInt): Boolean;
    function GetDeviceClassName(aGUID: TGUID): string;
    function GetRegistryProperty(PnPHandle: hDevInfo;
      DevData: TSPDevInfoData; Prop: DWord; Buffer: PChar;
      dwLength: DWord): Boolean;
    function IsClassHidden(ClassGuid: TGuid): Boolean;
    function IsDisabled(ahd: DWord; hDevInfo: hDevInfo): Boolean;
    function StateChange(NewState: DWord; aDeviceInfoData: TSPDevInfoData;
      hDevInfo: hDevInfo): Boolean;
    Function GetParentNode(aname: String):TTreeNode;
    procedure WMDeviceChange(var Msg: TMessage); message WM_DEVICECHANGE;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{计算机名称}
function GetPCname :string;
var
  temp:pchar;
  size:DWord;
begin
   getmem(temp,255);
   size:=255;
   if GetComputerName(temp,size)=false then
   begin
     freemem(temp);
     exit;
   end;
   Result := temp;
   freemem(temp);
end;

function TForm1.CheckStatus(ahd: DWord; hDevInfo: hDevInfo; StatusFlag: LongWord): Boolean;
var
  Status, Problem: DWord;
begin
  if (CM_Get_DevNode_Status(@Status, @Problem, ahd, 0) <> CR_SUCCESS) then
  begin
    Result := false;
    exit;
  end;
  Result := ((Status and StatusFlag = StatusFlag) and not
             (CM_PROB_HARDWARE_DISABLED = Problem));
end;

function TForm1.IsDisabled(ahd: DWord; hDevInfo: hDevInfo): Boolean;
var
  Status, Problem: DWord;
begin
  if (CM_Get_DevNode_Status(@Status, @Problem, ahd, 0) <> CR_SUCCESS) then
  begin
    Result := false;
    exit;
  end;
  Result := ((Status and DN_HAS_PROBLEM = DN_HAS_PROBLEM) and
             (CM_PROB_DISABLED = Problem));
end;

function TForm1.StateChange(NewState: DWord; aDeviceInfoData: TSPDevInfoData;
  hDevInfo: hDevInfo): Boolean;
var
  PropChangeParams: TSPPropChangeParams;
begin
  PropChangeParams.ClassInstallHeader.cbSize := SizeOf(TSPClassInstallHeader);
  // Set the PropChangeParams structure.
  PropChangeParams.ClassInstallHeader.InstallFunction := DIF_PROPERTYCHANGE;
  PropChangeParams.Scope := DICS_FLAG_GLOBAL;
  PropChangeParams.StateChange := NewState;
  if (not SetupDiSetClassInstallParams(hDevInfo, @aDeviceInfoData,
     PSPClassInstallHeader(@PropChangeParams), SizeOf(PropChangeParams))) then
  begin
    Result := false;
    ShowMessage('SetClassInstallParams');
    exit;
  end;
  // Call the ClassInstaller and perform the change.
  if not SetupDiCallClassInstaller(DIF_PROPERTYCHANGE,
    hDevInfo, @aDeviceInfoData) then
  begin
    Result := false;
    ShowMessage('SetClassInstallParams');
    exit;
  end;
  Result := true;
end;

function TForm1.GetClassImageIndex(ClassGuid: TGuid; Index: PInt): Boolean;
begin
  Result := SetupDiGetClassImageIndex(ClassImageListData, ClassGuid, Index^);
end;

function TForm1.GetRegistryProperty(PnPHandle: hDevInfo;
DevData: TSPDevInfoData; Prop: DWord; Buffer: PChar; dwLength: DWord): Boolean;
var
  aBuffer: array[0..256] of Char;
begin
  dwLength := 0;
  aBuffer[0] := #0;
  SetupDiGetDeviceRegistryProperty(PnPHandle, DevData, Prop, Prop,
  PBYTE(@aBuffer[0]), SizeOf(aBuffer), dwLength);
  StrCopy(Buffer, aBuffer);
  Result := Buffer^ <> #0;
end;

function TForm1.ConstructDeviceName(DeviceInfoSet: hDevInfo;
         DeviceInfoData: TSPDevInfoData; Buffer: PChar; dwLength: DWord): Boolean;
const
  UnknownDevice = '<Unknown Device>';
begin
  if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_FRIENDLYNAME, Buffer, dwLength)) then
  begin
    if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_DEVICEDESC, Buffer, dwLength)) then
    begin
      if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASS, Buffer, dwLength)) then
      begin
        if (not GetRegistryProperty(DeviceInfoSet, DeviceInfoData, SPDRP_CLASSGUID, Buffer, dwLength)) then
        begin
          dwLength := DWord(SizeOf(UnknownDevice));
          Buffer := Pointer(LocalAlloc(LPTR, Cardinal(dwLength)));
          StrCopy(Buffer, UnknownDevice);
        end;
      end;
    end;
  end;
  Result := true;
end;

function TForm1.IsClassHidden(ClassGuid: TGuid): Boolean;
var
  bHidden: Boolean;
  hKeyClass: HKey;
begin
  bHidden := false;
  hKeyClass := SetupDiOpenClassRegKey(@ClassGuid, KEY_READ);
  if (hKeyClass <> 0) then
  begin
    bHidden := (RegQueryValueEx(hKeyClass, REGSTR_VAL_NODISPLAYCLASS, nil, nil, nil, nil) = ERROR_SUCCESS);
    RegCloseKey(hKeyClass);
  end;
  Result := bHidden;
end;

{ 获取设备类型 }
function TForm1.GetDeviceClassName(aGUID: TGUID): string;
var
  ClassName: PChar;
  ClassNameSize: DWORD;
begin
  ClassNameSize := 0;
  GetMem(ClassName, ClassNameSize);
  { 利用GUID返回设备类型名 }
  while not SetupDiClassNameFromGuid(aGUID, ClassName, ClassNameSize,
    @ClassNameSize) do
  begin
    if GetLastError() = ERROR_INSUFFICIENT_BUFFER then
    begin
      if ClassName <> nil then FreeMem(ClassName);
      GetMem(ClassName, ClassNameSize);
    end else
      Break;
  end;
  Result := ClassName;
  if ClassName <> nil then FreeMem(ClassName);
end;


procedure TForm1.GetDevInfo;
begin
  if (assigned(DevInfo)) then
  begin
    SetupDiDestroyDeviceInfoList(DevInfo);
    SetupDiDestroyClassImageList(ClassImageListData);
  end;
  // Get a handle to all devices in all classes present on system
  DevInfo := SetupDiGetClassDevs(nil, nil, 0, DIGCF_PRESENT or DIGCF_ALLCLASSES);
  if (DevInfo = Pointer(INVALID_HANDLE_VALUE)) then
  begin
    ShowMessage('GetClassDevs');
    exit;
  end;
  // Get the Images for all classes, and bind to the TreeView
  ClassImageListData.cbSize := SizeOf(TSPClassImageListData);
  if (not SetupDiGetClassImageList(ClassImageListData)) then
  begin
    ShowMessage('GetClassImageList');
    exit;
  end;
  ImageList1.Handle := ClassImageListData.ImageList;
  //TreeView1.Images := ImageList1;
end;

Function TForm1.GetParentNode(aname: String):TTreeNode;
Var
  I: Integer;
  hasnode: Boolean;
Begin