Thread einem Core zuweisen

[Gargamel]

Hallo

Ich wollte mal probieren, ob ich einen Thread zur Laufzeit eines Programmes einem bestimmten CPU-Kern zuweisen kann. Auf einem Dual-Core und auch Quad-Core lief alles. Jetzt habe ich das Testprogramm jemanden testen lassen, der eine aktuelle Intel-CPU (Sandy Bridge) hat. Die soll wohl 4 Kerne und zusätzlich 4 virtuelle Kerne haben. Und prompt macht mein Programm nicht das, was es soll.
Wer will, kann das Programm gerne selbst testen. http://darkware.de/SwitchThreadAtRuntime.exe

Wäre nett, wenn das jemand probieren würde bzw. sich zumindest mal den Quellcode anschaut.

Delphi-Quellcode:

unit Unit_Main;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Combobox_numcores: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Button3: TButton;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

  function getNumCPUs:integer;

var
  Form1: TForm1;
  Thread:TMyThread;
  Tmyhandle:Cardinal;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var selCore:integer;
begin
  FreeandNil(Thread);
  selCore:=Combobox_numcores.ItemIndex;

  Thread:=TMyThread.Create(false);
  Tmyhandle:=Thread.Handle;
  setThreadAffinityMask(Tmyhandle,1 shl selCore);

  Button1.Enabled:=false;
  Button2.Enabled:=true;
  Button3.Enabled:=true;
end;

// get the number of installed cpu's
function getNumCPUs:integer;
var
  SystemInfo: TSystemInfo;
begin
  GetSystemInfo(SystemInfo);
  Result:=SystemInfo.dwNumberOfProcessors;
End;

procedure TForm1.Button2Click(Sender: TObject);
var selCore:integer;
begin
  selCore:=Combobox_numcores.ItemIndex;

  Tmyhandle:=Thread.Handle;
  setThreadAffinityMask(Tmyhandle,1 shl selCore);
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Thread.Terminate;
  Button1.Enabled:=true;
  Button2.Enabled:=false;
  Button3.Enabled:=false;
end;

procedure TForm1.FormShow(Sender: TObject);
var numCores:integer;
    i:integer;
begin
  NumCores:=getNumCPUs();
  Combobox_numcores.Clear;
  for i:=1 to NumCores do
    Begin
      Combobox_numcores.Items.Add(inttostr(i));
    End;
  ComboBox_numcores.ItemIndex:=0;
end;

end.

Delphi-Quellcode:

unit Unit_Thread;

interface

uses
  Classes;

type

TMyThread = class(TThread)
  private
    { Private-Deklarationen }
  protected
    Zaehler:integer;
    procedure Execute; override;
  end;


implementation

procedure TMyThread.Execute;
var zaehler:integer;
Begin
  Zaehler:=0;

  while not Terminated do
  Begin
    Zaehler:=Zaehler+1;
    if Zaehler>=100000 then Zaehler:=0;
  End;
end;

end.