Leistungsindex von Mehrkernprozessoren ermitteln

[Cyberstorm]

ein memo und ein button brauchts für das beispiel. leider funktioniert die threadzuweisung irgendwie nicht korrekt, wenn man den button mehrfach drückt, jemand eine idee warum?

also wenn ich das programm starte und ein benchmark mache sehe ich das alte phänomen, das cpu-kern 3 bei mir immer der langsamste ist. wenn ich allerdings nochmal den button drück scheint die threadzuweisung nicht mehr hinzuhauen (ist dann nicht mehr nr. 3 der langsamste). wenn ich das programm neustarte ist wieder alles beim alten...

naja hoffe das nützt irgendwem was:

Delphi-Quellcode:

unit main;

interface

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

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

  TBenchmarkThread = class(TThread)
    protected
      procedure Execute; override;
    public
      counter, dummy: Integer;
      constructor Create(ThreadNumber: Word); virtual;
  end;

var
  Form1: TForm1;
  BenchmarkThreads: Array of TBenchmarkThread;

implementation

{$R *.dfm}


constructor TBenchmarkThread.Create(ThreadNumber: Word);
begin
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); //set highest prio
  SetThreadAffinityMask(GetCurrentThread, 1 shl ThreadNumber); //only run on one cpu core (so you can compare the cores..)
  FreeOnTerminate:=True;
  counter:=0;
  inherited Create(True); //create suspended
end;

procedure TBenchmarkThread.Execute;
begin
  while not Terminated do
    begin
      inc(counter);
      dummy:=round(counter / 25); //do some stuff to benchmark
    end;
end;

function GetCPUCount: DWord;
var
  SysInfo: TSystemInfo;
begin
  GetSystemInfo(SysInfo);
  Result:=SysInfo.dwNumberOfProcessors;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  PriorityClass, i: Integer;
  ThreadCount: Word;
  result: integer;
begin
  PriorityClass:=GetPriorityClass(GetCurrentProcess); //save old state
  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  ThreadCount:=GetCPUCount;
  SetLength(BenchmarkThreads, ThreadCount);
  for i:= 0 to ThreadCount - 1 do BenchmarkThreads[i]:=TBenchmarkThread.Create(i); //create all benchmark threads
  for i:= 0 to ThreadCount - 1 do BenchmarkThreads[i].Start; //start all benchmark threads
  sleep(3000); //wait time can be changed here
  for i:=0 to ThreadCount - 1 do BenchmarkThreads[i].Suspend;
  SetPriorityClass(GetCurrentProcess, PriorityClass); //set old prio
  result:=0;
  for i:=0 to ThreadCount - 1 do
    begin
      memo1.Lines.Add('Thread' + IntToStr(i) + ': ' + IntToStr(BenchmarkThreads[i].counter));
      result:=result + BenchmarkThreads[i].counter;
      BenchmarkThreads[i].Resume;
      BenchmarkThreads[i].Terminate;
    end;
  memo1.Lines.add('--------------------------');
  memo1.lines.add(IntToStr(result));
end;

end.