Delphi-PRAXiS - Delphi Externe Exe starten und dieser einen best. Kern zuweisen

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 ;)