19-02-2019, Saat: 19:41
Merhaba ustalarım. Usb disklerin bilgisayara takıldıktan sonra bilgilerini almak için wmi kullanıyorum. Regedit seçeneğide var ama ben wmi kullanmak istiyorum.Sebebi daha stabil ve sorunsuz olması. Sorunum örneğin usb takıldığında prosedür çalıştığı zaman wmi kodunu çalıştırdığında şu şekilde bir hata veriyor.
ama normal butondan çağırdığımda sorunsuz infosunu alabiliyorum.
Wmi kodu şu şekilde.
Normal butonda çağırdığımda hiç bir sorun yok.
Bu şekilde kullandığımda ise hata ile karşılaşıyorum.
Usb algılamak içinde şu kodu kullanıyorum.
Kaynak : https://github.com/MojtabaTajik/USB-Detector
Örneğin memoya aktarıp oradan işlem yaptırsamda gene hata veriyor. Nerede hata yapıyorum ? yardımcı olan üstatlarıma şimdiden çok teşekkür ederim.
ama normal butondan çağırdığımda sorunsuz infosunu alabiliyorum.
Wmi kodu şu şekilde.
function GetWMIstring (wmiHost, wmiClass, wmiProperty : string):string; var // These are all needed for the WMI querying process Locator: ISWbemLocator; Services: ISWbemServices; SObject: ISWbemObject; ObjSet: ISWbemObjectSet; SProp: ISWbemProperty; Enum: IEnumVariant; Value: Cardinal; TempObj: OleVariant; SN: string; begin try Locator := CoSWbemLocator.Create; // Create the Location object // Connect to the WMI service, with the root\cimv2 namespace Services := Locator.ConnectServer(wmiHost, 'root\cimv2', '', '', '','', 0, nil); ObjSet := Services.ExecQuery('SELECT * FROM '+wmiClass, 'WQL', wbemFlagReturnImmediately and wbemFlagForwardOnly , nil); Enum := (ObjSet._NewEnum) as IEnumVariant; while (Enum.Next(1, TempObj, Value) = S_OK) do begin SObject := IUnknown(tempObj) as ISWBemObject; SProp := SObject.Properties_.Item(wmiProperty, 0); if VarIsNull(SProp.Get_Value) then result := '' else begin SN := SProp.Get_Value; result := SN; end; end; except // Trap any exceptions (Not having WMI installed will cause one!) on exception do result := ''; end; end;
Normal butonda çağırdığımda hiç bir sorun yok.
procedure TForm4.Button1Click(Sender: TObject); var Y:string; begin CoInitialize(nil); try Y:=GetWMIstring('','Win32_DiskDrive"','SerialNumber') ; finally CoUninitialize; end; ShowMessage(y); end;
Bu şekilde kullandığımda ise hata ile karşılaşıyorum.
procedure TForm1.USBDetector1Arrival(Sender: TObject; Drive: string); var Y:string; begin CoInitialize(nil); try Y:=GetWMIstring('','Win32_DiskDrive"','SerialNumber') ; finally CoUninitialize; end; ShowMessage(Y); end;
Usb algılamak içinde şu kodu kullanıyorum.
Kaynak : https://github.com/MojtabaTajik/USB-Detector
unit USBDetect; //////////////////////////////////////////////////// /// /// /// USB Detector component Ver 2.0.0.0 /// /// /// /// Written by Mojtaba Tajik ( Silversoft ) /// /// Released on 10/13/2010 /// /// E-Mail : Tajik1991@gmail.com /// /// /// //////////////////////////////////////////////////// interface uses Windows, Forms, SysUtils, Classes, Messages, dialogs; type TUSBEvent= Procedure (Sender: TObject; Drive: String) of Object; type TUSBDetector = class(TComponent) private { Private declarations } FWindowHandle: HWND; FArrival, FRemoved: TUSBEvent; procedure WndProc(var Msg: TMessage); protected { Protected declarations } procedure WMDEVICECHANGE(Var Msg: TMessage); Message WM_DEVICECHANGE; public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; published { Published declarations } Property OnArrival: TUSBEvent read FArrival write FArrival; Property OnRemoved: TUSBEvent read FRemoved write FRemoved; end; procedure Register; // 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; implementation procedure Register; begin RegisterComponents('NAP', [TUSBDetector]); end; { TUSBDetector } constructor TUSBDetector.Create(AOwner: TComponent); begin inherited Create(AOwner); FWindowHandle := AllocateHWnd(WndProc); end; destructor TUSBDetector.Destroy; begin DeallocateHWnd(FWindowHandle); inherited Destroy; end; procedure TUSBDetector.WMDEVICECHANGE(var Msg: TMessage); var lpdbhHeader: PDevBroadcastHeader; lpdbvData: PDevBroadcastVolume; dwIndex: Integer; lpszDrive: String; begin inherited; // Get the device notification header lpdbhHeader:=PDevBroadcastHeader(Msg.lParam); // Handle the message 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; if Assigned(OnArrival) then OnArrival(Self, lpszDrive); 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; if Assigned(OnRemoved) then OnRemoved(Self, lpszDrive); end; end; end; end; procedure TUSBDetector.WndProc(var Msg: TMessage); begin if (Msg.Msg = WM_DEVICECHANGE) then begin try WMDeviceChange(Msg); except Application.HandleException(Self); end; end end; end.
Örneğin memoya aktarıp oradan işlem yaptırsamda gene hata veriyor. Nerede hata yapıyorum ? yardımcı olan üstatlarıma şimdiden çok teşekkür ederim.