- Delphiartiklar, tips, forum, länksamling - 

      

START | DELPHI | LÄNKARGÄSTBOK 




 Forum

Grundkurs
  »Introduktion
  »Snabbguide
  »Komponenter
  »Händelser
  »Strängar
  »Räkna med Delphi   »Egna typer
  »Selektion
  »Iteration
  »Menyer
  »Funktioner
  »Arraystrukturer

Tips & Tricks
  »Nya tips
  »Blandat
  »Databaser
  »Filer
  »Forms
  »Grafik
  »Internet
  »Komponenter
  »Matematik
  »Multimedia
  »Objekt/ActiveX
  »Skrivare
  »Strängar
  »System
  »Mest lästa tips

Artiklar
  »Delphi och ADO
  »Bygga en DLL
  »Skapa en enkel rapport
  »Hantera registret
  »Enheter, units
  »Klassen TCanvas
  »Använd LookUp Controls

 Nya tips
 Lägg till tips
 Delphilänkar
 Gästbok

 

Kontrollera om en USB-enhet är ansluten eller ej Kategori: Strangar
Inlagt: 2004-08-23
Läst: 1436
Inlagt av: Staffan Berg
Beskrivning
Detta avancerade exempel känner av ifall en USB-enhet är ansluten eller inte. 
Kod
unit U_Usb;  
 
interface  
 
uses  
 Windows, Messages, SysUtils, Classes, Forms;  
 
type  
 
 PDevBroadcastHdr = ^DEV_BROADCAST_HDR;  
 DEV_BROADCAST_HDR = packed record  
  dbch_size: DWORD;  
  dbch_devicetype: DWORD;  
  dbch_reserved: DWORD;  
 end;  
 
 PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE;  
 DEV_BROADCAST_DEVICEINTERFACE = record  
  dbcc_size: DWORD;  
  dbcc_devicetype: DWORD;  
  dbcc_reserved: DWORD;  
  dbcc_classguid: TGUID;  
  dbcc_name: short;  
 end;  
 
const  
 GUID_DEVINTERFACE_USB_DEVICE: TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';  
 DBT_DEVICEARRIVAL     = $8000;     // system detected a new device  
 DBT_DEVICEREMOVECOMPLETE  = $8004;     // device is gone  
 DBT_DEVTYP_DEVICEINTERFACE = $00000005;   // device interface class  
 
type  
 
 TComponentUSB = class(TComponent)  
 private  
  FWindowHandle: HWND;  
  FOnUSBArrival: TNotifyEvent;  
  FOnUSBRemove: TNotifyEvent;  
  procedure WndProc(var Msg: TMessage);  
  function USBRegister: Boolean;  
 protected  
  procedure WMDeviceChange(var Msg: TMessage); dynamic;  
 public  
  constructor Create(AOwner: TComponent); override;  
  destructor Destroy; override;  
 published  
  property OnUSBArrival: TNotifyEvent read FOnUSBArrival write FOnUSBArrival;  
  property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;  
 end;  
 
implementation  
 
constructor TComponentUSB.Create(AOwner: TComponent);  
begin  
 inherited Create(AOwner);  
 FWindowHandle := AllocateHWnd(WndProc);  
 USBRegister;  
end;  
 
destructor TComponentUSB.Destroy;  
begin  
 DeallocateHWnd(FWindowHandle);  
 inherited Destroy;  
end;  
 
procedure TComponentUSB.WndProc(var Msg: TMessage);  
begin  
 if (Msg.Msg = WM_DEVICECHANGE) then  
 begin  
  try  
   WMDeviceChange(Msg);  
  except  
   Application.HandleException(Self);  
  end;  
 end  
 else  
  Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam);  
end;  
 
procedure TComponentUSB.WMDeviceChange(var Msg: TMessage);  
var  
 devType: Integer;  
 Datos: PDevBroadcastHdr;  
begin  
 if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) then  
 begin  
  Datos := PDevBroadcastHdr(Msg.lParam);  
  devType := Datos^.dbch_devicetype;  
  if devType = DBT_DEVTYP_DEVICEINTERFACE then  
  begin // USB Device  
   if Msg.wParam = DBT_DEVICEARRIVAL then  
   begin  
    if Assigned(FOnUSBArrival) then  
     FOnUSBArrival(Self);  
   end  
   else  
   begin  
    if Assigned(FOnUSBRemove) then  
     FOnUSBRemove(Self);  
   end;  
  end;  
 end;  
end;  
 
function TComponentUSB.USBRegister: Boolean;  
var  
 dbi: DEV_BROADCAST_DEVICEINTERFACE;  
 Size: Integer;  
 r: Pointer;  
begin  
 Result := False;  
 Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);  
 ZeroMemory(@dbi, Size);  
 dbi.dbcc_size := Size;  
 dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE;  
 dbi.dbcc_reserved := 0;  
 dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE;  
 dbi.dbcc_name := 0;  
 
 r := RegisterDeviceNotification(FWindowHandle, @dbi,  
  DEVICE_NOTIFY_WINDOW_HANDLE  
  );  
 if Assigned(r) then Result := True;  
end;  
 
end.  

 
 
© Copyright 2005 - Staffan Berg
- Alla rättigheter förbehålles -