[ Príspevkov: 8 ] 
AutorSpráva
Offline

Užívateľ
Užívateľ
Obrázok užívateľa

Registrovaný: 21.12.08
Prihlásený: 14.07.16
Príspevky: 114
Témy: 21 | 21
NapísalOffline : 14.01.2010 23:42 | [Delphi] Detekcia USB

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.


Offline

Skúsený užívateľ
Skúsený užívateľ
[Delphi] Detekcia USB

Registrovaný: 11.01.09
Prihlásený: 01.01.25
Príspevky: 1395
Témy: 10 | 10
Bydlisko: Hrinova
NapísalOffline : 15.01.2010 12:09 | [Delphi] Detekcia USB

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;


Offline

Užívateľ
Užívateľ
Obrázok užívateľa

Registrovaný: 21.12.08
Prihlásený: 14.07.16
Príspevky: 114
Témy: 21 | 21
Napísal autor témyOffline : 15.01.2010 16:13 | [Delphi] Detekcia USB

Vdaka :), pre remove len upravim podmienku, jasne. A este drobnsot ako zistim ktore pismeno mu priradil system


Offline

Skúsený užívateľ
Skúsený užívateľ
[Delphi] Detekcia USB

Registrovaný: 11.01.09
Prihlásený: 01.01.25
Príspevky: 1395
Témy: 10 | 10
Bydlisko: Hrinova
NapísalOffline : 15.01.2010 16:36 | [Delphi] Detekcia USB

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.


Offline

Užívateľ
Užívateľ
Obrázok užívateľa

Registrovaný: 21.12.08
Prihlásený: 14.07.16
Príspevky: 114
Témy: 21 | 21
Napísal autor témyOffline : 15.01.2010 17:34 | [Delphi] Detekcia USB

no poguglil som ale neviem sa z toho vysomarit, je to tam vyriesene, len jak to rozbehat.... Ak by si bol ochoty budem vdacny.

http://209.85.135.132/search?q=cache:MKcKVy5NQk0J:www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_24135127.html+http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/Q_21552015.html%3FsfQueryTermInfo%3D1%2Bdrive%2Bletter%2Busb&cd=1&hl=sk&ct=clnk&gl=sk[/code]


Offline

Skúsený užívateľ
Skúsený užívateľ
[Delphi] Detekcia USB

Registrovaný: 11.01.09
Prihlásený: 01.01.25
Príspevky: 1395
Témy: 10 | 10
Bydlisko: Hrinova
NapísalOffline : 16.01.2010 0:38 | [Delphi] Detekcia USB

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.


Offline

Užívateľ
Užívateľ
Obrázok užívateľa

Registrovaný: 21.12.08
Prihlásený: 14.07.16
Príspevky: 114
Témy: 21 | 21
Napísal autor témyOffline : 16.01.2010 1:02 | [Delphi] Detekcia USB

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?


Offline

Skúsený užívateľ
Skúsený užívateľ
[Delphi] Detekcia USB

Registrovaný: 11.01.09
Prihlásený: 01.01.25
Príspevky: 1395
Témy: 10 | 10
Bydlisko: Hrinova
NapísalOffline : 16.01.2010 1:15 | [Delphi] Detekcia USB

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


 [ Príspevkov: 8 ] 


[Delphi] Detekcia USB



Podobné témy

 Témy  Odpovede  Zobrazenia  Posledný príspevok 
V tomto fóre nie sú ďalšie neprečítané témy.

delphi zapis cisla do editu v delphi

v Delphi, Visual Basic

3

1152

11.05.2008 12:02

p360t

V tomto fóre nie sú ďalšie neprečítané témy.

detekcia skladieb

v Audio programy

3

912

10.09.2007 18:01

br4n0

V tomto fóre nie sú ďalšie neprečítané témy.

Detekcia GPU

v Ovládače

1

1121

16.03.2019 18:48

Sheldorr

V tomto fóre nie sú ďalšie neprečítané témy.

zlá detekcia RAMky

v Pamäte

5

628

12.05.2009 20:06

shiro

V tomto fóre nie sú ďalšie neprečítané témy.

Žiadna detekcia HDD

v Operačné systémy Unix a Linux

5

799

09.02.2009 18:16

jararak

V tomto fóre nie sú ďalšie neprečítané témy.

Divná detekcia ramiek

v Pamäte

2

439

13.02.2015 14:14

masar33

V tomto fóre nie sú ďalšie neprečítané témy.

zla detekcia ramky?

v Pamäte

6

663

13.08.2008 23:43

fuco

V tomto fóre nie sú ďalšie neprečítané témy.

Detekcia agresivity pri kamerách

v Ostatné

0

439

29.02.2016 19:27

jojala

V tomto fóre nie sú ďalšie neprečítané témy.

Detekcia len polovice RAM

v Pamäte

24

1331

26.08.2008 1:07

walther

V tomto fóre nie sú ďalšie neprečítané témy.

php detekcia krajiny užívateľa

v PHP, ASP

5

2508

03.01.2019 11:40

JanoF

V tomto fóre nie sú ďalšie neprečítané témy.

adobe premiere, detekcia scen

v Video programy

0

531

30.11.2010 21:36

svejk

V tomto fóre nie sú ďalšie neprečítané témy.

ESET 7 detekcia potencionalnych virusov

v Antivíry a antispywary

8

588

31.12.2013 14:31

patrice

V tomto fóre nie sú ďalšie neprečítané témy.

Občas zlyháva detekcia IDE drives....

v nVidia čipové sady

4

953

20.04.2009 10:58

kimmi

V tomto fóre nie sú ďalšie neprečítané témy.

Ip kamera Detekcia pohybu na gmail

v Siete

1

388

21.05.2017 14:31

void

V tomto fóre nie sú ďalšie neprečítané témy.

zlá detekcia graf. hardwaru ati HD 4570

v ATI/AMD grafické karty

6

993

18.11.2009 2:24

foxXx

V tomto fóre nie sú ďalšie neprečítané témy.

Avast - Skript shield virus detekcia na facebooku

v Antivíry a antispywary

2

400

05.06.2013 16:33

Ageiris



© 2005 - 2025 PCforum, edited by JanoF