IT NEWS PC REVUE PC FORUM FreeBSDInternet time: @254
Obsah fóra
Pravidlá  •  Kontakt  •  Prihlásenie  •  Registrácia

Westend Tower

Kancelárie pre malých i veľkých - prenájom už od 9,50 €/m2/mesačne. www.westendtower.sk

Chcete darček pre svoje dieťa

Odpovedzte na otázky a vyhrajte! LEGO duplo 2 krát deňne do konca mesiaca www.duplo.lego.com

Televízia Magio

Široký výber programov aj v HD kvalite plus prvých 100 dní úplne zadarmo! telekom.sk

Magio Internet od Telekomu

Najobľúbenejší internet teraz prvých 100 dní zadarmo + za modem neplatíte! Telekom.sk

S Easy Free voláš za 9 centov

K tomu internet v mobile zadarmo, kredit ti bude platiť až 12 mes. a SMS za 0,06€ Telekom.sk

[Delphi] Detekcia USB

Zaslať odpoveď
AutorSpráva
ha2
Užívateľ
Užívateľ

Založený: 21.12.2008
Príspevky: 114

PríspevokZaslal: Pi 15.01.10 0:42Odpovedať s citátomNávrat hore

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.
Zobraziť informácie o autoroviOdoslať súkromnú správu
Fico
Skúsený užívateľ
Skúsený užívateľ

Založený: 11.01.2009
Príspevky: 1049

PríspevokZaslal: Pi 15.01.10 13:09Odpovedať s citátomNávrat hore

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;
Zobraziť informácie o autoroviOdoslať súkromnú správuICQ
ha2
Užívateľ
Užívateľ

Založený: 21.12.2008
Príspevky: 114

PríspevokZaslal: Pi 15.01.10 17:13Odpovedať s citátomNávrat hore

Vdaka , pre remove len upravim podmienku, jasne. A este drobnsot ako zistim ktore pismeno mu priradil system
Zobraziť informácie o autoroviOdoslať súkromnú správu
Fico
Skúsený užívateľ
Skúsený užívateľ

Založený: 11.01.2009
Príspevky: 1049

PríspevokZaslal: Pi 15.01.10 17:36Odpovedať s citátomNávrat hore

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.
Zobraziť informácie o autoroviOdoslať súkromnú správuICQ
ha2
Užívateľ
Užívateľ

Založený: 21.12.2008
Príspevky: 114

PríspevokZaslal: Pi 15.01.10 18:34Odpovedať s citátomNávrat hore

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]
Zobraziť informácie o autoroviOdoslať súkromnú správu
Fico
Skúsený užívateľ
Skúsený užívateľ

Založený: 11.01.2009
Príspevky: 1049

PríspevokZaslal: So 16.01.10 1:38Odpovedať s citátomNávrat hore

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.
Zobraziť informácie o autoroviOdoslať súkromnú správuICQ
ha2
Užívateľ
Užívateľ

Založený: 21.12.2008
Príspevky: 114

PríspevokZaslal: So 16.01.10 2:02Odpovedať s citátomNávrat hore

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?
Zobraziť informácie o autoroviOdoslať súkromnú správu
Fico
Skúsený užívateľ
Skúsený užívateľ

Založený: 11.01.2009
Príspevky: 1049

PríspevokZaslal: So 16.01.10 2:15Odpovedať s citátomNávrat hore

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
Zobraziť informácie o autoroviOdoslať súkromnú správuICQ
Zobraziť príspevky z predchádzajúcich:    
Zaslať odpoveď
Nemôžete pridávať nové témy do tohto fóra.
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.
Nemôžete hlasovať v tomto fóre.

Powered by phpBB 2.x.x © 2005 - 2012 PCforum, webhosting by WebSupport, edited by JanoF

SEO - optimalizácia pre vyhľadávače

Freebsd