Konuyu Oyla:
  • Derecelendirme: 4/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Wmi kullanırken hata vermesi.
#1
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.

EmA4Rg.png

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.
Cevapla
#2
Denemeden, sadece tahmin ederek yazıyorum:
TUSBDetector içindeki OnRemoved ve OnArrival olaylarını tetiklerken TThread.Queue kullanırsanız belki probleminiz çözülebilir
There's no place like 127.0.0.1
WWW
Cevapla
#3
Kodunuzu aşağıdaki bloğun içinde yazın:

TThread.CreateAnonymousThread(
  procedure
  begin
    Sleep(100);

    TThread.Queue(
      nil,

      procedure
      begin
        // Kodlarınızı burada yazın.
      end
    );
  end
).Start;

Olur ise bilgilendirin, nedenini de izah edelim.
Mal sahibi, mülk sahibi
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...
WWW
Cevapla
#4
evet hocam dediğiniz gibi şuan sorunu çözdüm çok teşekkür ederim, sebebi nedir hatanın ?
Cevapla
#5
Windows'a bir nefes ( 5-10 saniye ) USB'nin niteliğini anlayabilmesi için zaman vermeniz lazım. USB takıldı tamam ama Kingston gibi yavaş sürücüler için 10 saniyeyi de geçen ( hatta bu donanın bir başka HID device mı yoksa hakikaten bir USB memory stick mi ) bir algı süresi talebi var. Siz USB takıldı hemen içeriğini okuyayım derseniz, adam da "abi bir dur hele" diyor. Hepsi bu  Smile
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif
Cevapla
#6
(20-02-2019, Saat: 11:20)mrmarman Adlı Kullanıcıdan Alıntı: Windows'a bir nefes ( 5-10 saniye ) USB'nin niteliğini anlayabilmesi için zaman vermeniz lazım. USB takıldı tamam ama Kingston gibi yavaş sürücüler için 10 saniyeyi de geçen ( hatta bu donanın bir başka HID device mı yoksa hakikaten bir USB memory stick mi ) bir algı süresi talebi var. Siz USB takıldı hemen içeriğini okuyayım derseniz, adam da "abi bir dur hele" diyor. Hepsi bu  Smile

Mantığını anladım hocam Smile
Cevapla
#7
Yok, maalesef olay o kadar basit değil Sad
Tuğrul Hocam detaylandıracaktır muhakkak ama problem Windows message handler içerisinde COM kullanılmasından kaynaklı. Olayın ayrıntısını merak edenler RPC_E_CANTCALLOUT_ININPUTSYNCCALL şeklinde aratabilirler.
There's no place like 127.0.0.1
WWW
Cevapla
#8
Teşekkürler
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif
Cevapla
#9
Muharrem bey'in söylemine ek olarak, kaynak kodu incelerseniz OnArrival olayına yazdığınız kodun, WM_DEVICECHANGE mesajının DBT_DEVICEARRIVAL parametresini kontrol ettiğiniz blok içinde çağrıldığını göreceksiniz. Ancak sizin kodlarınız (OnArrival'a yazdıklarınız) çalışır iken; siz hâla WM_DEVICECHANGE olayı içindesiniz, yani işletim sisteminin sizi bilgilendirmek için gönderdiği mesajın içindesiniz. Bizim yaptığımız ise, gelen mesajı bekletmemek. Şu anda gelen mesaj sizin kodunuz işletilene kadar bekliyor. Windows mesajlarını hızlıca işlemek gerekir, mesajı göndereni bekletmemek icap eder.

Mesajı gönderen SendMessage türevi senkron bir API yardımı ile mesajı gönderdi ise; bu durumda tüm işin bitmesini bekler.
Mal sahibi, mülk sahibi
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...
WWW
Cevapla
#10
(20-02-2019, Saat: 11:36)SimaWB Adlı Kullanıcıdan Alıntı: Yok, maalesef olay o kadar basit değil Sad
Tuğrul Hocam detaylandıracaktır muhakkak ama problem Windows message handler içerisinde COM kullanılmasından kaynaklı. Olayın ayrıntısını merak edenler RPC_E_CANTCALLOUT_ININPUTSYNCCALL şeklinde aratabilirler.

Bu hususu ben de bilmiyorum. Ben de okuyup öğreneyim. Teşekkür ederim.
Mal sahibi, mülk sahibi
Hani bunun ilk sahibi ?
Mal da yalan mülk de yalan
Var biraz da sen oyalan...
WWW
Cevapla


Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  Rest Hata Yakalama m_ekici 9 1.456 08-03-2024, Saat: 19:30
Son Yorum: aegean
  Tanım Bulamadım Bu Hata İçin hi_selamlar 11 1.336 30-10-2023, Saat: 18:20
Son Yorum: hi_selamlar
  delphi de garip bir hata ercanskose 11 1.498 26-07-2023, Saat: 12:00
Son Yorum: delphiman
  UniDBGridColumnFilter Release Modda Hata veriyor yhackup 18 2.534 19-01-2023, Saat: 10:29
Son Yorum: yhackup
  CmdExecMode->amAsync Transaction Hata YILDIRIMBEY 1 531 24-10-2022, Saat: 00:07
Son Yorum: 3ddark



Konuyu Okuyanlar: 1 Ziyaretçi