[Lazarus] More testing please

[Aradeonas]

Anthony here is a windows info version.I didnt saw your code so I wrote
a very test version with some options, check it and if you want
different or more tell me.It will compile with last fpc and Lazarus
version or your nightly build.

> unit Unit1;
>
> {$mode delphi}
>
> interface
>
> uses  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,
> StdCtrls,  ActiveX, ComObj, Variants, LCLIntf;
>
> { TForm1 }
>
> type  TForm1 = class(TForm)    ListBox1: TListBox;    ListBox2:
> TListBox;    procedure FormActivate(Sender: TObject);    procedure
> FormCreate(Sender: TObject);  private  public    procedure GetCPUInfo;
> procedure GetCPUUsage;  const    WbemUser = '';    WbemPassword = '';
> WbemComputer = 'localhost';    wbemFlagForwardOnly = $00000020;  var
> FSWbemLocator: olevariant;    FWMIService: olevariant;  end;
>
> var  Form1: TForm1;
>
> implementation
>
> {$R *.lfm}
>
> { TForm1 }
>
> procedure TForm1.FormCreate(Sender: TObject); begin  FSWbemLocator :=
> CreateOleObject('WbemScripting.SWbemLocator');  FWMIService :=
> FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser,
> WbemPassword); end;
>
> procedure TForm1.FormActivate(Sender: TObject); begin  GetCPUInfo;
> while True do  begin    GetCPUUsage;    Application.ProcessMessages;
> end; end;
>
> procedure TForm1.GetCPUInfo; var  FWbemObjectSet: olevariant;
> FWbemObject: olevariant;  oEnum: IEnumvariant;  pCeltFetched:
> cardinal; begin  FWbemObjectSet := FWMIService.ExecQuery('SELECT *
> FROM Win32_Processor', 'WQL', wbemFlagForwardOnly);
>
> oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
>
> while oEnum.Next(1, FWbemObject, pCeltFetched) = 0 do  begin    with
> ListBox1.Items do    begin      Add(FWbemObject.Name);
> Add(FWbemObject.Caption);      Add(FWbemObject.Description);
> Add(FWbemObject.Manufacturer);      Add(FWbemObject.ProcessorId);
> Add(IntToStr(FWbemObject.NumberOfCores));
> Add(IntToStr(FWbemObject.NumberOfLogicalProcessors));
> Add(FWbemObject.Status);    end;
>
> FWbemObject := Unassigned;  end;
>
> FWbemObjectSet := FWMIService.ExecQuery('SELECT * FROM
> Win32_Processor', 'WQL', wbemFlagForwardOnly);
>
> oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
>
> while oEnum.Next(1, FWbemObject, pCeltFetched) = 0 do  begin
> ListBox1.Items.Add(IntToStr(FWbemObject.CurrentClockSpeed));
> ListBox1.Items.Add(IntToStr(FWbemObject.MaxClockSpeed));
> FWbemObject := Unassigned;  end; end;
>
> procedure TForm1.GetCPUUsage; var  FWbemObjectSet: olevariant;
> FWbemObject: olevariant;  oEnum: IEnumvariant;  pCeltFetched:
> cardinal;  Tick: int64; begin  Tick := GetTickCount;  FWbemObjectSet
> := FWMIService.ExecQuery('SELECT * FROM
> Win32_PerfFormattedData_PerfOS_Processor', 'WQL',
> wbemFlagForwardOnly);
>
> oEnum := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
>
> ListBox2.Items.Clear;  while oEnum.Next(1, FWbemObject, pCeltFetched)
> = 0 do  begin    ListBox2.Items.Add(FWbemObject.Name + '  ' +
> IntToStr(FWbemObject.PercentProcessorTime));
>
> FWbemObject := Unassigned;  end;  self.Caption :=
> IntToStr(GetTickCount - Tick); end;
>
> end.

PS. because list wont let me attach the project I will send you directly
    a sample one.

Regards, Ara


Regards, Ara


-- 
http://www.fastmail.com - Or how I learned to stop worrying and
                          love email again

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.lazarus-ide.org/pipermail/lazarus/attachments/20151109/3f6ee267/attachment-0003.html>