delphi2007 教程

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)  
          TreeView:   TTreeView;  
          ImageList:   TImageList;  
          MainMenu1:   TMainMenu;  
          Eject1:   TMenuItem;  
          Exit1:   TMenuItem;  
          Change1:   TMenuItem;  
          ShowHidden1:   TMenuItem;  
          EjectDriver1:   TMenuItem;  
          Exit2:   TMenuItem;  
          procedure   FormCreate(Sender:   TObject);  
          procedure   ShowHidden1Click(Sender:   TObject);  
          procedure   FormCloseQuery(Sender:   TObject;   var   CanClose:   Boolean);  
          procedure   EjectDriver1Click(Sender:   TObject);  
          procedure   Exit2Click(Sender:   TObject);  
          procedure   TreeViewClick(Sender:   TObject);  
      private  
          DevInfo:   hDevInfo;  
          ClassImageListData:   TSPClassImageListData;  
          ShowHidden:   Boolean;  
          function   EnumAddDevices(ShowHidden:   Boolean;   hwndTree:   TTreeView;   DevInfo:   hDevInfo):   Boolean;  
          function   IsClassHidden(ClassGuid:   TGuid):   Boolean;  
          function   GetRegistryProperty(PnPHandle:   hDevInfo;   DevData:   TSPDevInfoData;  
                            Prop:   DWord;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
          function   ConstructDeviceName(DeviceInfoSet:   hDevInfo;  
                            DeviceInfoData:   TSPDevInfoData;   Buffer:   PChar;   dwLength:   DWord):   Boolean;  
          function   GetClassImageIndex(ClassGuid:   TGuid;   Index:   PInt):   Boolean;  
          function   GetDevInfo(var   hDevInfo:   hDevInfo):   boolean;  
   
   
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      Form1:   TForm1;  
   
  implementation  
   
  {$R   *.dfm}  
   
  function   TForm1.GetDevInfo(var   hDevInfo:   hDevInfo):   boolean;  
  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;  
      ImageList.Handle   :=   ClassImageListData.ImageList;  
      TreeView.Images   :=   ImageList;  
  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.EnumAddDevices(ShowHidden:   Boolean;   hwndTree:   TTreeView;   DevInfo:   hDevInfo):   Boolean;  
  var  
      i,   Status,   Problem:   DWord;  
      pszText:   PChar;  
      DeviceInfoData:   TSPDevInfoData;  
      iImage:   Integer;  
  begin  
      TTreeView(hWndTree).Items.BeginUpdate;  
      DeviceInfoData.cbSize   :=   SizeOf(TSPDevInfoData);  
      //   Clean   off   all   the   items   in   a   TreeView.  
      TTreeView(hWndTree).Items.Clear;  
      i   :=   0;  
      //   Enumerate   though   all   the   devices.  
      while   SetupDiEnumDeviceInfo(DevInfo,   i,   DeviceInfoData)   do  
      begin  
          inc(i);  
          //   Should   we   display   this   device,   or   move   onto   the   next   one.  
          if   (CM_Get_DevNode_Status(@Status,   @Problem,   DeviceInfoData.DevInst,   0)   <>   CR_SUCCESS)   then  
          begin  
              break;  
          end;  
          if   (not   (ShowHidden   or   not(Boolean(Status   and   DN_NO_SHOW_IN_DM)   or   IsClassHidden(DeviceInfoData.ClassGuid))))   then  
          begin  
              break;  
          end;  
          GetMem(pszText,   256);  
          try  
              //   Get   a   friendly   name   for   the   device.  
              ConstructDeviceName(DevInfo,   DeviceInfoData,   pszText,   DWord(nil));  
              //   Try   to   get   an   icon   index   for   this   device.  
              if   (GetClassImageIndex(DeviceInfoData.ClassGuid,   @iImage))   then  
              begin  
                  with   TTreeView(hWndTree).Items.AddObject(nil,   pszText,   nil)   do  
                  begin  
                      TTreeView(hWndTree).Items[i-1].ImageIndex   :=   iImage;  
                      TTreeView(hWndTree).Items[i-1].SelectedIndex   :=   iImage;  
                  end;  
                  if   (Problem   =   CM_PROB_DISABLED)   then   //   red   (X)  
                  begin  
                          TTreeView(hWndTree).Items[i-1].OverlayIndex   :=   IDI_DISABLED_OVL   -   IDI_CLASSICON_OVERLAYFIRST;  
                  end   else  
                  begin  
                      if   (Boolean(Problem))   then   //   yellow   (!)  
                      begin  
                              TTreeView(hWndTree).Items[i-1].OverlayIndex   :=   IDI_PROBLEM_OVL   -   IDI_CLASSICON_OVERLAYFIRST;  
                      end;  
                  end;  
                  if   (Status   and   DN_NO_SHOW_IN_DM   =   DN_NO_SHOW_IN_DM)   then   //   Greyed   out  
                  begin  
                      TTreeView(hWndTree).Items[i-1].Cut   :=   true;  
                  end;  
              end;  
          finally  
              FreeMem(pszText);  
          end;  
      end;  
      TTreeView(hWndTree).Items.EndUpdate;  
      Result   :=   true;  
  end;  
   
  procedure   TForm1.FormCreate(Sender:   TObject);  
  begin  
      if   (not   LoadSetupAPI)   then  
      begin  
      ShowMessage('Could   not   load   SetupAPI.dll');  
      exit;            
      end;            
      DevInfo       :=       nil;            
      ShowHidden       :=       false;            
      //       Get       a       handle       to       all       devices       in       all       classes       present       on       system            
      if       not       GetDevInfo(DevInfo)       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;            
      ImageList.Handle       :=       ClassImageListData.ImageList;            
      TreeView.Images       :=       ImageList;            
      //       Add       the       devices       to       the       TreeView       window.  
      EnumAddDevices(ShowHidden,       TreeView,       DevInfo);  
  end;  
   
  procedure   TForm1.EjectDriver1Click(Sender:   TObject);  
  var  
      DeviceInfoData:   TSPDevInfoData;  
      Status,   Problem:   DWord;  
      VetoType:   TPNPVetoType;  
      VetoName:   array[0..256]   of   Char;  
  begin  
          DeviceInfoData.cbSize   :=   SizeOf(TSPDevInfoData);  
          //   Get   a   handle   to   the   Selected   Item.  
          if   (not   SetupDiEnumDeviceInfo(DevInfo,   TreeView.Selected.Index,   DeviceInfoData))   then  
          begin  
              exit;  
          end;  
          if   (CM_Get_DevNode_Status(@Status,   @Problem,   DeviceInfoData.DevInst,   0)   <>   CR_SUCCESS)   then  
          begin  
              exit;  
          end;  
          VetoName[0]   :=   #0;  
        case       CM_Request_Device_Eject(DeviceInfoData.DevInst,       VetoType,       @VetoName,       SizeOf(VetoName),       0)       of  
          CR_SUCCESS:  
          begin  
            MessageBox(Handle,   'Successful   to   eject   the   Device',   'Done',   MB_OK);  
          if   not   GetDevInfo(DevInfo)   then  
              begin  
              ShowMessage('GetClassDevs');  
              end;  
                  EnumAddDevices(ShowHidden,   TreeView,   DevInfo);  
              end;  
              CR_REMOVE_VETOED:  
              begin  
                  MessageBox(Handle,   PChar('Failed   to   eject   the   Device   (Veto:   '   +   VetoName   +   ')'),   'Vetoed',   MB_OK);  
              end;  
              else  
              begin  
                  MessageBox(Handle,   PChar('Failed   to   eject   the   Device   ('   +   SysErrorMessage(GetLastError)   +   ')'),   'Failure',   MB_OK);  
              end;  
          end;                  
  end;  
   
  procedure   TForm1.ShowHidden1Click(Sender:   TObject);  
  begin  
      ShowHidden   :=   not   ShowHidden;  
      EnumAddDevices(ShowHidden,   TreeView,   DevInfo);  
  end;  
   
  procedure   TForm1.FormCloseQuery(Sender:   TObject;   var   CanClose:   Boolean);  
  begin  
  canclose:=application.MessageBox('你真的要退出吗？','系统提示',mb_yesno+MB_ICONQUESTION)=idyes   ;  
  if   canclose   then  
  begin  
  Application.Terminate;  
  end;  
  end;  
   
  procedure   TForm1.Exit2Click(Sender:   TObject);  
  begin  
  Close;  
  end;  
   
  end.

呵呵~  
  这个也有源码的~

先收藏了，再试试

呵呵，mark!