Obsah fóra
PravidláRegistrovaťPrihlásenie




Odpovedať na tému [ 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
Príspevok NapísalOffline : 14.01.2010 23:42

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ý: 26.04.24
Príspevky: 1385
Témy: 9
Bydlisko: Hrinova
Príspevok NapísalOffline : 15.01.2010 12: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;


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
Príspevok Napísal autor témyOffline : 15.01.2010 16:13

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ý: 26.04.24
Príspevky: 1385
Témy: 9
Bydlisko: Hrinova
Príspevok NapísalOffline : 15.01.2010 16: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.


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
Príspevok Napísal autor témyOffline : 15.01.2010 17:34

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ý: 26.04.24
Príspevky: 1385
Témy: 9
Bydlisko: Hrinova
Príspevok NapísalOffline : 16.01.2010 0:38

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
Príspevok Napísal autor témyOffline : 16.01.2010 1:02

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ý: 26.04.24
Príspevky: 1385
Témy: 9
Bydlisko: Hrinova
Príspevok NapísalOffline : 16.01.2010 1:15

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


Odpovedať na tému [ Príspevkov: 8 ] 


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

1107

11.05.2008 12:02

p360t Zobrazenie posledných príspevkov

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

v Audio programy

3

874

10.09.2007 18:01

br4n0 Zobrazenie posledných príspevkov

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

v Ovládače

1

1075

16.03.2019 18:48

Sheldorr Zobrazenie posledných príspevkov

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

v Pamäte

5

592

12.05.2009 20:06

shiro Zobrazenie posledných príspevkov

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

v Operačné systémy Unix a Linux

5

763

09.02.2009 18:16

jararak Zobrazenie posledných príspevkov

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

v Pamäte

6

626

13.08.2008 23:43

fuco Zobrazenie posledných príspevkov

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

v Pamäte

2

402

13.02.2015 14:14

masar33 Zobrazenie posledných príspevkov

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

v Video programy

0

491

30.11.2010 21:36

svejk Zobrazenie posledných príspevkov

V tomto fóre nie sú ďalšie neprečítané témy. php detekcia krajiny užívateľa

v PHP, ASP

5

2440

03.01.2019 11:40

JanoF Zobrazenie posledných príspevkov

V tomto fóre nie sú ďalšie neprečítané témy. Detekcia agresivity pri kamerách

v Ostatné

0

401

29.02.2016 19:27

jojala Zobrazenie posledných príspevkov

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

v Pamäte

24

1296

26.08.2008 1:07

walther Zobrazenie posledných príspevkov

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

v Antivíry a antispywary

8

538

31.12.2013 14:31

patrice Zobrazenie posledných príspevkov

V tomto fóre nie sú ďalšie neprečítané témy. Občas zlyháva detekcia IDE drives....

v nVidia čipové sady

4

923

20.04.2009 10:58

kimmi Zobrazenie posledných príspevkov

V tomto fóre nie sú ďalšie neprečítané témy. Ip kamera Detekcia pohybu na gmail

v Siete

1

352

21.05.2017 14:31

void Zobrazenie posledných príspevkov

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

370

05.06.2013 16:33

Ageiris Zobrazenie posledných príspevkov

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

956

18.11.2009 2:24

foxXx Zobrazenie posledných príspevkov


Nemôžete zakladať nové témy v tomto fóre
Nemôžete odpovedať na témy v tomto fóre
Nemôžete upravovať svoje príspevky v tomto fóre
Nemôžete mazať svoje príspevky v tomto fóre

Skočiť na:  

Powered by phpBB Jarvis © 2005 - 2024 PCforum, webhosting by WebSupport, secured by GeoTrust, edited by JanoF
Ako väčšina webových stránok aj my používame cookies. Zotrvaním na webovej stránke súhlasíte, že ich môžeme používať.
Všeobecné podmienky, spracovanie osobných údajov a pravidlá fóra