| Autor | Správa |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 |
Nasiel som nato uz hotovu unit len terz neviem co stym. Ten TcomponentUSB vytvorim ako...
| kód: | // Component to detect when usb devices are connected or disconnected
// using RegisterDeviceNotification
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.
|
|
| |
  |
 |
Fico
 Skúsený užívateľ
 Založený: 11.01.2009 Príspevky: 1049
 | Zaslal: Pi 15.01.10 13:09 |   |
1.) Tento unit si ulož ako napr U_Usb.pas (podľa názvu ho potom pridaj aj do uses)
2.) Zavri všetky okná v Delphi a daj vytvoriť nový projekt
3.) Napíš nasledujúci kód (pričom udalosti OnCreate a OnDestroy fromulára nestačí skopíraovať, lebo ti to nepôjde. Musíš ich vybrať riadne v Object Inspectore - zrejme drobná chybyčka v Delphi)
4.) Projekt ulož do rovnakej zložky ako unit
// Po pripojení USB kľúča vyskočí správa 'OK' (pre opdojenie si to už snáď vieš dopísať):
| kód: | unit Main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, U_Usb;
type
TForm1 = class(TForm)
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
public
procedure MyProc(Sender: TObject);
{ Public declarations }
end;
var
Form1: TForm1;
_USB: TComponentUSB;
implementation
{$R *.dfm}
procedure TForm1.MyProc(Sender: TObject);
begin
ShowMessage('ok');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
_USB:= TComponentUSB.Create(Self);
_USB.OnUSBArrival:= MyProc;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
_USB.Destroy;
end; |
|
| |
   |
 |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 | Zaslal: Pi 15.01.10 17:13 |   |
Vdaka , pre remove len upravim podmienku, jasne. A este drobnsot ako zistim ktore pismeno mu priradil system |
| |
  |
 |
Fico
 Skúsený užívateľ
 Založený: 11.01.2009 Príspevky: 1049
 | Zaslal: Pi 15.01.10 17:36 |   |
Pre remove sa dá: _USB.OnUSBRemove:= MyProc2;
Pomocou tohto unitu sa zrejme nedá zistiť písmenko, pretože on detekuje napríklad aj pripojenie myši a tá písmenko nemá. Prezrel som ho, ale nič z toho nevyzerá ako nejaká operácia s diskom. |
| |
   |
 |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 | Zaslal: Pi 15.01.10 18:34 |   |
|
  |
 |
Fico
 Skúsený užívateľ
 Založený: 11.01.2009 Príspevky: 1049
 |
V tom prípade netreba žiaden unit (ale môžeš si ho samozrejme vytvoriť). Skús toto:
| kód: | unit Main;
interface
uses
Windows, Messages, Forms, Classes, Controls, StdCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
private
{ Private declarations }
public
procedure WMDEVICECHANGE(var Msg: TMessage); message WM_DEVICECHANGE;
{ Public declarations }
end;
//------------------------------------------------------------------------------
// Device constants
const
DBT_DEVICEARRIVAL = $00008000;
DBT_DEVICEREMOVECOMPLETE = $00008004;
DBT_DEVTYP_VOLUME = $00000002;
// Device structs
type
_DEV_BROADCAST_HDR = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
end;
DEV_BROADCAST_HDR = _DEV_BROADCAST_HDR;
TDevBroadcastHeader = DEV_BROADCAST_HDR;
PDevBroadcastHeader = ^TDevBroadcastHeader;
type
_DEV_BROADCAST_VOLUME = packed record
dbch_size: DWORD;
dbch_devicetype: DWORD;
dbch_reserved: DWORD;
dbcv_unitmask: DWORD;
dbcv_flags: WORD;
end;
DEV_BROADCAST_VOLUME = _DEV_BROADCAST_VOLUME;
TDevBroadcastVolume = DEV_BROADCAST_VOLUME;
PDevBroadcastVolume = ^TDevBroadcastVolume;
//------------------------------------------------------------------------------
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.WMDEVICECHANGE(var Msg: TMessage);
var lpdbhHeader: PDevBroadcastHeader;
lpdbvData: PDevBroadcastVolume;
dwIndex: Integer;
lpszDrive: String;
begin
// Perform inherited
inherited;
// Get the device notification header
lpdbhHeader:=PDevBroadcastHeader(Msg.lParam);
// Handle the message
lpszDrive:='Drive ';
case Msg.WParam of
DBT_DEVICEARRIVAL : {a USB drive was connected}
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
lpdbvData:=PDevBroadcastVolume(Msg.lParam);
for dwIndex :=0 to 25 do
begin
if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
begin
lpszDrive:=lpszDrive+Chr(65+dwIndex)+':';
break;
end;
end;
Label1.Caption:=lpszDrive + ' connected';
end;
end;
DBT_DEVICEREMOVECOMPLETE: {a USB drive was removed}
begin
if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
begin
lpdbvData:=PDevBroadcastVolume(Msg.lParam);
for dwIndex:=0 to 25 do
begin
if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
begin
lpszDrive:=lpszDrive+Chr(65+dwIndex)+':';
break;
end;
end;
Label1.Caption:=lpszDrive + ' removed';
end;
end;
end;
end;
end. |
Keď je niečo nejasné, pýtaj sa. |
| |
   |
 |
ha2
 Užívateľ
 Založený: 21.12.2008 Príspevky: 114
 |
fajn to som potreboval , Uz len k funkcionalite. Procedura je vlastne kod ktory caka na zavolanie a nasledne sa vykona, tuna procedura nieje priamo volana, Ona neustale naslucha na msg od systemu a nasledne ho vyhodnoti? |
| |
  |
 |
Fico
 Skúsený užívateľ
 Založený: 11.01.2009 Príspevky: 1049
 |
| citácia: | | procedure WMDEVICECHANGE(var Msg: TMessage); message WM_DEVICECHANGE; |
znamená, že táto procedúra je zapuzdrená v triede TForm1 - teda v hlavnom formulári. Formulárom vo windowse sú pri akýchkoľvek udalostiach zasielané správy windows (windows messages). Konkrétne v tejto procedúre je dané, že ak hlavnému oknu dorazí správa WM_DEVICECHANGE, tak táto procedúra ju ošetrí (to znamená, že prebehne jej telo) s tým, že ako parameter dostane patričné informácie - Msg, WParam, LParam. V Msg je vlastne WM_DEVICECHANGE, pretože iba túto odchytávame a vo WParam a LParam potrebné dáta (konštanty a offsety záznamov) - viď http://msdn.microsoft.com/en-us/library/aa363480%28VS.85%29.aspx |
| |
   |
 |
|