SetThreadAffinityMask für Konsolenprogramm

[hathor]

SetThreadAffinityMask für Konsolenprogramm

Ich bin z.Zt. am Entwickeln eines Programms, das die Qualität
der CPU-Kühlung ermitteln soll - siehe Anhang.
Dazu will ich für jeden CPU-Core ein verstecktes Konsolenprogramm starten,
das nach einer vorgegebenen Zeit wieder beendet wird.

Starten und Beenden funktionieren - siehe extrahierter Beispielcode.

Das Problem ist: wie kann ich das Konsolenprogramm mit einem bestimmten Core
laufen lassen? ...SetThreadAffinityMask(GetCurrentThread(), 1);...???

Anmerkung: Vom Konsolenprogramm habe ich NICHT den Sourcecode.

Danke für jede Hilfe !!

Delphi-Quellcode:

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Spin;
type
  TForm1 = class(TForm)
    TerminateEdit1: TSpinEdit;
    RunEdit1: TSpinEdit;
    Timer1: TTimer;
    lbl_CountDown1: TLabel;
    lbl_Process1: TLabel;
    B1_STRESS: TButton;
    B1_STOP: TButton;
    lbl_STATUS: TLabel;
    Label1: TLabel;
    procedure Timer1Timer(Sender: TObject);
    procedure B1_STRESSClick(Sender: TObject);
    procedure B1_STOPClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    FProcessInfo: TProcessInformation;
    FAutoTermTime: TDateTime;
  public
  end;
var
  Form1: TForm1;
implementation
{$R *.DFM}

procedure STRESS(var fn: String);
var
  sProgram: String;
  zCommand: array[0..512] of char;
  si: TStartupInfo;
  dwError: DWORD;
begin
      Form1.Timer1.Tag:=0;
      sProgram := ExtractFilePath(Application.ExeName) + fn;
      if (Pos(' ', sProgram) > 0) and (sProgram[1] <> '"') then
          sProgram := AnsiQuotedStr(sProgram, '"');
      sProgram := sProgram + ' ' + IntToStr(Form1.RunEdit1.Value); // Add parameters
      StrPCopy(zCommand, sProgram);
      FillChar(si, SizeOf(si), #0);
      si.cb := SizeOf(si);
      si.dwFlags := STARTF_USESHOWWINDOW;
      si.wShowWindow :=  SW_HIDE;// SW_SHOWNORMAL;

[b]// wie hier CORE 0, CORE 1 etc. bestimmen ???[/b]

  if CreateProcess(nil, zCommand, nil, nil, False,
                   CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
                   nil, nil, si, Form1.FProcessInfo) then
  begin
      Form1.FAutoTermTime :=
      Now + EncodeTime(0, Form1.TerminateEdit1.Value div 60, Form1.TerminateEdit1.Value mod 60, 0);
      Form1.lbl_STATUS.Caption:=
      Format('STRESS - process created with handle %d, will auto-terminate at %s.',
             [Form1.FProcessInfo.hProcess, DateTimeToStr(Form1.FAutoTermTime)]);
      Form1.Timer1.Enabled := True;
  end else begin
      dwError := GetLastError;
      Form1.lbl_STATUS.Caption:=
      Format('STRESS - CreateProcess failed with error %d', [dwError]);
  end;
end;

procedure TForm1.B1_STOPClick(Sender: TObject);
var uExitCode: Cardinal; sAuto: String; hProcess : Cardinal;
begin
    uExitCode := 0;
    hProcess:= StrToInt(lbl_Process1.caption);
    if Sender is TTimer then sAuto := 'auto-' else sAuto := '';
    if TerminateProcess(hProcess, uExitCode) then
      begin
        Timer1.enabled:=false;
        B1_STOP.Enabled:= false;
        B1_STRESS.Enabled:= true;
        lbl_CountDown1.Caption:='-----';
        lbl_Process1.Caption:='-----';
        lbl_STATUS.Caption:= Format('Test %sterminated: exit code %d.', [sAuto, uExitCode]);
  end else begin
        uExitCode := GetLastError;
        lbl_STATUS.Caption:= Format('Test %sterminated: error code %d.', [sAuto, uExitCode]);
  end;
end;

procedure TForm1.B1_STRESSClick(Sender: TObject);
var B1 : String;
begin
    Timer1.Tag:=0;
    B1_STRESS.Enabled:= false;
    B1:= 'STRESS.001';
        STRESS(B1);
    B1_STOP.Enabled:=true;
    lbl_Process1.Caption:= IntToStr(FProcessInfo.hProcess);
    lbl_STATUS.Caption:='Running...';
end;

procedure TForm1.FormShow(Sender: TObject);
begin
      lbl_STATUS.Caption:='Waiting...';
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var   ret: DWORD;
begin
      Timer1.Tag:= Timer1.Tag +1;
      lbl_CountDown1.caption:= IntToStr(TerminateEdit1.Value-Timer1.Tag)+' sec';
  ret := MsgWaitForMultipleObjects(
           1,             { 1 handle to wait on }
           FProcessInfo.hProcess, { the handle }
           False,         { wake on any event }
           5,             { wait timeout (# or INFINITE) }
           QS_PAINT or    { wake on paint messages }
           QS_SENDMESSAGE { or messages from other threads }
           );
  if ret = WAIT_OBJECT_0 then begin
      Timer1.Enabled := False;
      B1_STOP.Enabled := False;
      B1_STRESS.Enabled := True;
      CloseHandle(FProcessInfo.hProcess);
      CloseHandle(FProcessInfo.hThread);
      lbl_STATUS.Caption:='Not Running...';
  end else begin
      if Now >= FAutoTermTime then B1_STOPClick(Sender);
  end;
end;

end.

[Zacherl]

Du brauchst SetProcessAffinityMask :)