Dostęp do WMI z wątku - error

0

Witam, mam sobie taki oto kod:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
   
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure  GetProcessorPerformanceInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;

begin
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\WMI', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM ProcessorPerformance','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Form1.Memo1.Lines.Add(Format('frequency   %d',[Integer(FWbemObject.frequency)])+Format('%s',[String(FWbemObject.InstanceName)]));
    FWbemObject:=Unassigned;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  thread:DWORD;
 ThreadId:Cardinal;
begin
   ThreadId:=1;
   thread:=BeginThread(nil,0,@GetProcessorPerformanceInfo,nil,0,ThreadId);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
    GetProcessorPerformanceInfo;
end;

end.


Gdy kliknę Button2 jest ok, wyświetla info o procesorze, ale gdy kliknę to samo w wątku czyli Button1 to wywala się w pierwszej linijce FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
Czy to znaczy że dostęp do WMI z innego wątku niż główny nie jest możliwy?
Błąd:

EOleSysError "Funkcja CoInitialize nie została wywołana"

1

No to przecież masz wyraźnie napisane o co chodzi. Możesz ten kod poprawić w taki sposób:

procedure  GetProcessorPerformanceInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;

begin
  try
  if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
  begin
    try
    FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
    FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\WMI', WbemUser, WbemPassword);
    FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM ProcessorPerformance','WQL',wbemFlagForwardOnly);
    oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
    while oEnum.Next(1, FWbemObject, iValue) = 0 do
    begin
      Form1.Memo1.Lines.Add(Format('frequency   %d',[Integer(FWbemObject.frequency)])+Format('%s',[String(FWbemObject.InstanceName)]));
      FWbemObject:=Unassigned;
    end;
    finally
      CoUninitialize;
    end;
  end;
  except
    on E:Exception do
      Application.MessageBox(PChar(Format( 'Error %0:s : %1:s', [E.Classname, E.Message])), PChar(Application.Title), MB_ICONERROR);
  end;
end;

ale to też nie jest dobrze, bo jeżeli to nie jest tylko test to zapis do Memo z wątku też jest głupim pomysłem (generalnie nie powinno się używać komponentów VCL w wątkach a zwłaszcza dokonywać zapisu). Pasowałoby zrobić jakieś zdarzenie typu OnData, które powinieneś wywołać poprzez Synchronize.

0

Dzięki, teraz działa. W sumie sam kod nieważny, tylko klepnięty na szybko jako przykład. Głownie mi chodziło o to że nie mogę używać wątku. Ta konstrukcja załatwiła sprawę, pozdrawiam

if Succeeded(CoInitializeEx(nil, COINIT_MULTITHREADED)) then
begin
  try
  ....
  finally
      CoUninitialize;
  end;
end;

1 użytkowników online, w tym zalogowanych: 0, gości: 1