Externe Exe starten und dieser einen best. Kern zuweisen

[thafuba]

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

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