ايران ويج

ايران ويج > برنامه نویسی > دلفی > مشکل در root\CIMV2
نسخه‌ی کامل: مشکل در root\CIMV2
شما در حال مشاهده‌ی نسخه‌ی متنی این صفحه می‌باشید. مشاهده‌ی نسخه‌ی کامل با قالب بندی مناسب.

The.Ghost

۲۶-شهریور-۱۳۹۴, ۱۲:۵۲:۴۲
سلام
چرا وقتی از کد زیر در تایمر و یا در رویدادی که usb فعال می شود استفاده می کنم این کد کار نمی کند ولی وقتی همین کد در یک دکمه مینویسم و بعد کلیک می کنم به درستی کار می کند.

منظورم اینه که کد زیر چطور میشه به طور خودکار فعال بشه؟؟ نه اینکه بخواهیم کلیک کنیم بعد فعال شود؟؟

من حتی از CoInitialize(nil); // uses Winapi.ActiveX هم استفاده کردم ولی بازم هیچ فرقی نمی کند!!!

لطفا راهنمایی کنید، با تشکر.

کد:
unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
 Dialogs, StdCtrls, FileCtrl, StrUtils, ActiveX, ComObj, XPMan;

type
 TForm1 = class(TForm)
   ListBox1: TListBox;
   Button2: TButton;
   procedure Button2Click(Sender: TObject);
   procedure ListBox1Click(Sender: TObject);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form1: TForm1;

implementation

{$R *.dfm}

function VarStrNull(const V:OleVariant):string; //avoid issues with null variants
begin
  Result:='';
  if not VarIsNull(V) then
     Result:=VarToStr(V);
end;

// Obtiene el Nْmero de Serial un Drive USB por medio de la propiedad PnPDeviceID
function GetUsbDriveSerial(const Drive : Char) : string;
var
  FSWbemLocator : OleVariant;
  objWMIService : OLEVariant;
  colDiskDrives : OLEVariant;
  colLogicalDisks : OLEVariant;
  colPartitions : OLEVariant;
  objDiskDrive : OLEVariant;
  objPartition : OLEVariant;
  objLogicalDisk : OLEVariant;
  oEnumDiskDrive : IEnumvariant;
  oEnumPartition : IEnumvariant;
  oEnumLogical : IEnumvariant;
  iValue : LongWord;
  DeviceID : string;

begin;

  Result:='';

  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  objWMIService := FSWbemLocator.ConnectServer('.', 'root\CIMV2', '', '');
  colDiskDrives := objWMIService.ExecQuery('SELECT * FROM Win32_DiskDrive WHERE InterfaceType="USB"','WQL',0);
  oEnumDiskDrive:= IUnknown(colDiskDrives._NewEnum) as IEnumVariant;

  while oEnumDiskDrive.Next(1, objDiskDrive, iValue) = 0 do
  begin

     //Escape the `\` chars in the DeviceID value because the '\' is a reserved character in WMI.
     DeviceID := StringReplace(VarStrNull(objDiskDrive.DeviceID),'\','\\',[rfReplaceAll]);

     //link the Win32_DiskDrive class with the Win32_DiskDriveToDiskPartition class
     colPartitions := objWMIService.ExecQuery(Format('ASSOCIATORS OF {Win32_DiskDrive.DeviceID="%s"} WHERE AssocClass = Win32_DiskDriveToDiskPartition',[DeviceID]));

     oEnumPartition := IUnknown(colPartitions._NewEnum) as IEnumVariant;

     while oEnumPartition.Next(1, objPartition, iValue) = 0 do
     begin

        //link the Win32_DiskPartition class with theWin32_LogicalDiskToPartition class.
        colLogicalDisks := objWMIService.ExecQuery('ASSOCIATORS OF {Win32_DiskPartition.DeviceID="'+VarStrNull(objPartition.DeviceID)+'"} WHERE AssocClass = Win32_LogicalDiskToPartition');

        oEnumLogical := IUnknown(colLogicalDisks._NewEnum) as IEnumVariant;

        while oEnumLogical.Next(1, objLogicalDisk, iValue) = 0 do
        begin

           if SameText(VarStrNull(objLogicalDisk.DeviceID),Drive+':')  then //compare the device id
           begin

              Result := VarStrNull(objDiskDrive.PnPDeviceID);

              if AnsiStartsText('USBSTOR', Result) then
              begin
                 iValue := LastDelimiter('\', Result);
                 Result := Copy(Result, iValue+1, Length(Result));
              end;

              objLogicalDisk:=Unassigned;

              Exit;

           end;

           objLogicalDisk:=Unassigned;

        end;

        objPartition:=Unassigned;

     end;

     objDiskDrive:=Unassigned;

  end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Drive : Char;
begin
  for Drive := 'A'  to 'Z' do
     if GetDriveType(PChar(Drive + ':\')) = DRIVE_REMOVABLE then
        ListBox1.Items.Add(UpperCase(Drive));
end;

procedure TForm1.ListBox1Click(Sender: TObject);
var
 Drive : String;
begin
  Drive := ListBox1.Items.Strings[ListBox1.ItemIndex];
  ShowMessage('USB Serial Number : ' + GetUsbDriveSerial(Drive[1]));
end;

end.

lord_viper

۲۹-شهریور-۱۳۹۴, ۱۰:۱۸:۱۲
وقتی چیزی به usb وصل میشه یه پیغام WM_DEVICECHANGE به برنامه های در حال اجرا فرستاده میشه

کد زیر میتونه به شما کمک کنه

کد:
unit illusb;

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: array [0..255] of char;
 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;
   fDeviceName:String;
   procedure WndProc(var Msg: TMessage);
   function USBRegister: Boolean;
 protected
   procedure WMDeviceChange(var Msg: TMessage); dynamic;
 public
   property DeviceName:String read FDeviceName;
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
 published
   property OnUSBArrival: TNotifyEvent read FOnUSBArrival write
FOnUSBArrival;
   property OnUSBRemove: TNotifyEvent read FOnUSBRemove write FOnUSBRemove;
 end;
procedure Register;
implementation

procedure Register;   { add this in the implementation section }
begin
 RegisterComponents('Samples', [TComponentUSB]);
end;


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 := dbi.dbcc_name;
 fDeviceName := String(dbi.dbcc_name);
 r := RegisterDeviceNotification(FWindowHandle, @dbi,
   DEVICE_NOTIFY_WINDOW_HANDLE
   );
 if Assigned(r) then Result := True;
end;


end.

//=================================================
 public
 usb:TComponentUSB;
 procedure usbDisConnect(Sender: TObject);
 procedure usbConnect(Sender: TObject);

Usage

Code: [Select]
procedure TForm1.usbDisConnect(Sender: TObject);
begin
ShowMessage('Disconnect Usb');
end;

procedure TForm1.usbConnect(Sender: TObject);
begin
ShowMessage('Connect Usb:');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
usb:=TComponentUSB.Create(self);
usb.OnUSBArrival := usbConnect;
usb.OnUSBRemove := usbDisConnect;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
FreeAndNil(usb);
end;

end.
ايران ويج > برنامه نویسی > دلفی > مشکل در root\CIMV2