Externe Exe starten und dieser einen best. Kern zuweisen

[Aurelius]

Hallo DP'ler :hi:

Ich würde gerne eine Art Programm-Launcher für Mehrkern-CPU's bauen, in dem man eine .exe auswählt, diese einem bestimmten Kern des Mehrkern-Prozessors zuweist (per Checkbox) und dann das besagte Programm startet. DAs Starten an sich ist per Shellexecute ja kein Problem, nur wie kann ich dem Prozess dann dem vorher ausgewählten Kern zuweisen? Ich hab zwar hier im Forum schon was gefunden, nur leider kann ich damit nicht viel anfangen :oops:

Der Programmablauf wäre ja in etwa so:
- Launcher starten
- Dateipfad wählen
- gewünschten Kern wählen
- die Datei per Shellexecute starten
- dem Prozess dann durch das Progg den Kern zuweisen lassen
- Launcher ggf. beenden

Ich hoffe ihr habt ein paar Anregungen für mich.

[SirThornberry]

anstelle von Shellexecute solltest du lieber ShellexecuteEx oder CreateProcess nutzen. Dadurch hast du die Möglichkeit anschließend auf den Prozess zu zugreifen (weil du über die übergebenen strukturen das Prozesshandle bekommst) und kannst dann die Kerne zuweisen.

[WS1976]

Hallo,

er hatte gefragt wie man das macht. Allgemeine Hinweise helfen ihm da sicher nicht weiter!
So wie ich das sehe wird er mit diser Aussage nicht weiter kommen.

Rainer

[Luckie]

Da hatte eben jemand die Hoffnung, dass es noch Menschen mit Eigeninitiative gibt, die in der Lage sind nach den gegebenen Stichworten im Forum und mit Google zu suchen, um dann eigenständig zu einer Lösung zu kommen. Und wenn er so nicht weiter kommt kann er ja immer noch konkreter nachfragen. Das einzige Stichwort, was gefehlt hat wäre noch SetProcessAffinityMask. Damit hat er eigentlich alles beisammen, was er wissen muss, um sein Problem zu lösen.

[SirThornberry]

@WS1976: Ich gehe eigentlich schon aus das solche Infos genügen. Durch die Funktionsnamen den Luckie erwähnt hat, sind jetzt eigentliche alle Funktionsnamen gefallen die man dafür benötigt. Was will man mehr?
Eigentlich gäbe es ja nur noch das man ein Beispiel postet und dann wären wir schon bei der Komplettlösung. Aber dabei lernt man nicht so viel als wenn man sich selbst in der Hilfe die Parameter anschaut.

[Aurelius]

Google hab ich schon genutzt, auch auf das SetThreadAffinityMask bin ich schon gestoßen, hier in der CodeLibrary ist ja auch ein Beitrag dazu.

Da ich die DelphiHilfe auch nicht vor mir hab kann ich auch dort nicht gucken.

Mal schauen ob ichs mit SirThornberrys Hinweisen lösen kann.

[Aurelius]

So, ich habs probiert aber leider nicht hinbekommen. Könnte gut an der späten Stunde liegen :D

Delphi-Quellcode:

procedure ExecuteProgramm(const PFileName: string);
var 
  SEInfo: TShellExecuteInfo; 
  ExitCode: DWORD; 
  ExecuteFile: string; 
  Handle: THandle;
begin 
  ExecuteFile := '"' + PFileName + '"'; 
  FillChar(SEInfo, SizeOf(SEInfo), 0); 
  SEInfo.cbSize := SizeOf(TShellExecuteInfo); 

  with SEInfo do 
  begin 
    fMask := SEE_MASK_NOCLOSEPROCESS;
    Wnd := Application.Handle; 
    lpFile := PChar(ExecuteFile); 
    nShow := SW_SHOWNORMAL; 
  end;

  Handle := SEInfo.Wnd;
  if ShellExecuteEx(@SEInfo) then
  {begin
    repeat
      Application.ProcessMessages;
      GetExitCodeProcess(SEInfo.hProcess, ExitCode);
    until (ExitCode <> STILL_ACTIVE) or
      Application.Terminated;
  end} else
  begin 
    Application.MessageBox('Fehler beim Starten des Programms', 
      'Hinweis', MB_OK + MB_ICONERROR); 
  end;

  if Form1.checkbox1.checked then SetProcessAffinityMask(Handle, 0);
end;

procedure Aufruf;
begin
  ExecuteProgramm(Form1.File1.Text); // im Edit steht der Pfad
end;

Der Aufruf klappt, d.h. das Programm wird gestartet, nur die Zuweisung an den Kern funktioniert nicht...

[Zacherl]

Wnd ist das Fensterhandle. Du brauchst aber das Prozess Handle. Weiß grade im Kopf nicht, ob ShellExecute das auch liefert. Fals du die ProzessID besitzt kannst du das Handle mittels OpenProcess(PROCESS_ALL_ACCESS, false, PID) ermitteln.

[Aurelius]

Ah so... :|

Mal schaun, würde mich über weitere Tipps aber sehr freuen :thumb:

[sk0r]

Mit SetProcessAffinityMask kannst du einem Prozess eine Anzhal an zugehörigen CPUs zuweisen.
Mehr gibts da auch gar nicht zu erklären. Ich bin selbst erstaunt, dass es nur die eine API
benötigt, um eine CPU Zugehörigkeit zuzuweisen. Ach ja: Bei meinen Tests gibt SetProcessAffinityMask
auch 'true' zurück, wenn man eine Anzahl höher als die eigentlichen zur Verfügung stehen
CPUs hat. Deshalb habe ich dort einen Check eingebaut.

Delphi-Quellcode:

function GetActiveProcessorCount:Cardinal;
var
  lpSystemInfo: TSystemInfo;
begin
  GetSystemInfo(lpSystemInfo);
  result := lpSystemInfo.dwNumberOfProcessors
end;

function CreateProcessCPUKernel(lpProcessName, lpProcessParams: PChar; iProcessorNumb: Cardinal):LongBool;
var
  SUInfo: TStartupInfo;
  PIInfo: TPRocessInformation;
  lpSystemInfo: TSystemInfo;
begin
  result := not true;
  if iProcessorNumb = 0 then exit;
  FillChar(SUInfo, sizeof(SUInfo), #0);
  FillChar(PIInfo, sizeof(PIInfo), #0);
  GetSystemInfo(lpSystemInfo);
  if CreateProcess(lpProcessName, lpProcessParams, nil, nil, false, NORMAL_PRIORITY_CLASS or PROCESS_SET_INFORMATION, nil, PChar(ExtractFilePath(lpProcessName)), SUInfo, PIInfo) then
  begin
    if iProcessorNumb > lpSystemInfo.dwNumberOfProcessors then
      iProcessorNumb := lpSystemInfo.dwNumberOfProcessors;
    if SetProcessAffinityMask(PIInfo.hProcess, iProcessorNumb) then
    begin
      result := true;
    end;
  end;
end;

function SetProcessCPUKernel(lpProcId, iKernelNumb: Cardinal):LongBool;
var
  hProc: Cardinal;
  lpSystemInfo: TSystemInfo;
begin
  result := not true;
  if (lpProcId = 0) or (iKernelNumb = 0) then exit;
  hProc := OpenProcess(PROCESS_ALL_ACCESS or PROCESS_SET_INFORMATION, not true, lpProcId);
  if hProc <> 0 then
  begin
    GetSystemInfo(lpSystemInfo);
    if iKernelNumb > lpSystemInfo.dwNumberOfProcessors then
      iKernelNumb := lpSystemInfo.dwNumberOfProcessors;
    if SetProcessAffinityMask(hProc, iKernelNumb) then
    begin
      result := true;
    end;
    CloseHandle(hProc);
  end;
end;

Ich hoffe, ich konnte dir helfen. Der Code sollte sich von selbst erklären.
Man erstellt den gewünschten Prozess mit Hilfe von CreateProcess. Dort bekommt
man das Prozess-Handle über die TProcessInformation Struktur (TProcessInformation.hProcess).
Den übergibt man SetProcessAffinityMask als ersten Parameter und als zweiten
Parameter die Anzahl der CPUs. Aber bitte bei Eins anfangen, denn man zählt
in diesem Fall nicht von Null an, da man ja nicht weniger als eine CPU haben kann. :p

MfG: sk0r

[Aurelius]

Großes Dankeschön, ich schaus mir mal an!

Mein Problem war es ja ans ProzessHandle zu kommen :?

Werd mich nochmal melden wenn es Probleme geben sollte...

[Zacherl]

CreateProcess liefert dir sicher ein ProcessHandle.

[thafuba]

Zitat:

Zitat von sk0r

Mit SetProcessAffinityMask kannst du einem Prozess eine Anzhal an zugehörigen CPUs zuweisen.
Mehr gibts da auch gar nicht zu erklären. Ich bin selbst erstaunt, dass es nur die eine API
benötigt, um eine CPU Zugehörigkeit zuzuweisen. Ach ja: Bei meinen Tests gibt SetProcessAffinityMask
auch 'true' zurück, wenn man eine Anzahl höher als die eigentlichen zur Verfügung stehen
CPUs hat. Deshalb habe ich dort einen Check eingebaut.

Delphi-Quellcode:

function GetActiveProcessorCount:Cardinal;
var
  lpSystemInfo: TSystemInfo;
begin
  GetSystemInfo(lpSystemInfo);
  result := lpSystemInfo.dwNumberOfProcessors
end;

function CreateProcessCPUKernel(lpProcessName, lpProcessParams: PChar; iProcessorNumb: Cardinal):LongBool;
var
  SUInfo: TStartupInfo;
  PIInfo: TPRocessInformation;
  lpSystemInfo: TSystemInfo;
begin
  result := not true;
  if iProcessorNumb = 0 then exit;
  FillChar(SUInfo, sizeof(SUInfo), #0);
  FillChar(PIInfo, sizeof(PIInfo), #0);
  GetSystemInfo(lpSystemInfo);
  if CreateProcess(lpProcessName, lpProcessParams, nil, nil, false, NORMAL_PRIORITY_CLASS or PROCESS_SET_INFORMATION, nil, PChar(ExtractFilePath(lpProcessName)), SUInfo, PIInfo) then
  begin
    if iProcessorNumb > lpSystemInfo.dwNumberOfProcessors then
      iProcessorNumb := lpSystemInfo.dwNumberOfProcessors;
    if SetProcessAffinityMask(PIInfo.hProcess, iProcessorNumb) then
    begin
      result := true;
    end;
  end;
end;

function SetProcessCPUKernel(lpProcId, iKernelNumb: Cardinal):LongBool;
var
  hProc: Cardinal;
  lpSystemInfo: TSystemInfo;
begin
  result := not true;
  if (lpProcId = 0) or (iKernelNumb = 0) then exit;
  hProc := OpenProcess(PROCESS_ALL_ACCESS or PROCESS_SET_INFORMATION, not true, lpProcId);
  if hProc <> 0 then
  begin
    GetSystemInfo(lpSystemInfo);
    if iKernelNumb > lpSystemInfo.dwNumberOfProcessors then
      iKernelNumb := lpSystemInfo.dwNumberOfProcessors;
    if SetProcessAffinityMask(hProc, iKernelNumb) then
    begin
      result := true;
    end;
    CloseHandle(hProc);
  end;
end;

Ich hoffe, ich konnte dir helfen. Der Code sollte sich von selbst erklären.
Man erstellt den gewünschten Prozess mit Hilfe von CreateProcess. Dort bekommt
man das Prozess-Handle über die TProcessInformation Struktur (TProcessInformation.hProcess).
Den übergibt man SetProcessAffinityMask als ersten Parameter und als zweiten
Parameter die Anzahl der CPUs. Aber bitte bei Eins anfangen, denn man zählt
in diesem Fall nicht von Null an, da man ja nicht weniger als eine CPU haben kann. :p

MfG: sk0r

dein Code funktioniert mit Dual-Core Systemen und wenn man nur einen Kern ansprechen will.
Bei Multi-Core Systemen mit mehr als 2 Kernen und wo man möglicherweise mehrere Kerne gleichzeitig Ansprechen will leider nicht.
denn bei "iProcessorNumb" wird nicht die anzahl der Kerne direkt angegeben, sondern einen Wert mit dem auch alle Kerne Gleichzeitig angesprochen werden können.
Aber dein code hat mich angespornt das mal genau anzusehen :D

Hier mein Vorschlag zu CreateProcessCPUKernel:

Delphi-Quellcode:

function CreateProcessCPUKernel(lpProcessName, lpProcessParams: PChar; iCoreVal: Cardinal; iCreationFlags: Cardinal = NORMAL_PRIORITY_CLASS): LongBool;
var
  SUInfo: TStartupInfo;
  PIInfo: TPRocessInformation;
  lpSystemInfo: TSystemInfo;
  i, CoreValue: Cardinal;
begin
  Result := False;
  CoreValue:=0;
  FillChar(SUInfo, sizeof(SUInfo), #0);
  FillChar(PIInfo, sizeof(PIInfo), #0);
  GetSystemInfo(lpSystemInfo);
  for i:=0 to lpSystemInfo.dwNumberOfProcessors-1 do CoreValue:=CoreValue+(1 shl i);
  if iCoreVal > CoreValue then iCoreVal:=CoreValue;
  if CreateProcess(lpProcessName, lpProcessParams, nil, nil, false, iCreationFlags or PROCESS_SET_INFORMATION, nil, PChar(ExtractFilePath(lpProcessName)), SUInfo, PIInfo) then
  begin
    Result := SetProcessAffinityMask(PIInfo.hProcess, iCoreVal);
  end;
end;

hier mein Vorschlag zu SetProcessCPUKernelByID:

Delphi-Quellcode:

function SetProcessCPUKernelByID(lpProcId, iCoreVal: Cardinal):LongBool;
var
  hProc, i, CoreValue: Cardinal;
  lpSystemInfo: TSystemInfo;
begin
  Result := False;
  CoreValue:=0;
  if (not lpProcId <> 0) then exit;
  hProc := OpenProcess(PROCESS_ALL_ACCESS or PROCESS_SET_INFORMATION, not true, lpProcId);
  if hProc <> 0 then
  begin
    GetSystemInfo(lpSystemInfo);
    for i:=0 to lpSystemInfo.dwNumberOfProcessors-1 do CoreValue:=CoreValue+(1 shl i);
    if iCoreVal > CoreValue then iCoreVal:=CoreValue;
    Result := SetProcessAffinityMask(hProc, iCoreVal);
    CloseHandle(hProc);
  end;
end;

und zu guter letzt die funktion GetProcessID:

Delphi-Quellcode:

uses Tlhelp32;

function GetProcessID(const aFileName: string): integer;
var
  hProcSnap: THandle;
  pe32: TProcessEntry32;
  aFile: string;
begin
  result:= 0;
  aFile:=ExtractFileName(aFileName);
  hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
  if hProcSnap = INVALID_HANDLE_VALUE then exit;
  pe32.dwSize := SizeOf(ProcessEntry32);
  if Process32First(hProcSnap, pe32) then
  begin
    while Process32Next(hProcSnap, pe32) do
    begin
      if lowerCase(pe32.szExeFile) = lowercase(aFile) then
      begin
        result:= pe32.th32ProcessID;
        break;
      end;
    end;
  end;
  CloseHandle(hProcSnap);
end;

ich denke mal das es auch eine andere methode gibt, aber da die funktion ja schon da war, dachte ich, warum soll ich die nicht ändern ;)
hoffe du bist nicht böse, dass ich deinen code verändert habe.
bin gerne für änderungen und vorschläge offen, da ich nich relativ neu bin und mir deswegen leider öfter fehler unterlaufen ;)

[gitz]

Der Code hat einen kleinen fehler:

hier:
if iKernelNumb > lpSystemInfo.dwNumberOfProcessors

richtig:
if iKernelNumb > power(2,lpSystemInfo.dwNumberOfProcessors-1)

an anderer Stelle nochmals dasselbe.
ansonsten sehr nützlicher Code!

[Namenloser]

Delphi-Quellcode:

if iKernelNumb > power(2,lpSystemInfo.dwNumberOfProcessors-1)

kann man auch einfacher schreiben:

Delphi-Quellcode:

if iKernelNumb > 1 shl (lpSystemInfo.dwNumberOfProcessors-1)

[Assarbad]

Zitat:

Zitat von NamenLozer (Beitrag 1078976)

kann man auch einfacher schreiben:

Delphi-Quellcode:

if iKernelNumb > 1 shl (lpSystemInfo.dwNumberOfProcessors-1)

Einfacher ja, schneller vermutlich auch ... aber dann darf ein Kommentar nicht fehlen für all jene die sich nicht damit auskennen. Plus der Hinweis, daß es ab einer gewissen Anzahl Kerne nur noch 0 ergibt :zwinker:

[himitsu]

Dieses IF ist schon richtig so.
> Wenn der Kernel-Index größer als die Anzahl ist, dann auf den letzten Kern setzen.

Aber die nachfolgende Umrechnung von "Index" auf "Maske" fehlte.

Delphi-Quellcode:

if iKernelNumb > lpSystemInfo.dwNumberOfProcessors then
  iKernelNumb := lpSystemInfo.dwNumberOfProcessors;
if SetProcessAffinityMask(hProc, $1 shl (iKernelNumb - 1)) then

Wobei ich es etwas unpraktisch finde, daß man hier einen 1-basierenden Index verwendet.