AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Programmieren allgemein SetThreadAffinityMask für Konsolenprogramm

SetThreadAffinityMask für Konsolenprogramm

Ein Thema von hathor · begonnen am 13. Mai 2010 · letzter Beitrag vom 13. Mai 2010
Antwort Antwort
hathor
(Gast)

n/a Beiträge
 
#1

SetThreadAffinityMask für Konsolenprogramm

  Alt 13. Mai 2010, 18:15
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.
Miniaturansicht angehängter Grafiken
penryn_stress-01_189.jpg  
Angehängte Dateien
Dateityp: zip test_708.zip (250,4 KB, 5x aufgerufen)
  Mit Zitat antworten Zitat
Benutzerbild von Zacherl
Zacherl

Registriert seit: 3. Sep 2004
4.629 Beiträge
 
Delphi 10.2 Tokyo Starter
 
#2

Re: SetThreadAffinityMask für Konsolenprogramm

  Alt 13. Mai 2010, 18:59
Du brauchst MSDN-Library durchsuchenSetProcessAffinityMask
  Mit Zitat antworten Zitat
Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 14:33 Uhr.
Powered by vBulletin® Copyright ©2000 - 2021, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2021 by Daniel R. Wolf