Multi-Prozessor - Prozesse: CPU-Zuweisung setzen/auslesen

[MuTzE.Y85]

Mit diesem Code ist es möglich, die Prozessorzuweisung eines/einer Prozesses/Andwendung auszulesen und zu setzen.

Den Code zum Setzen habe ich hier gefunden:
Multi-Prozessor - einem Prozess eine CPU zuweisen

Den Code zum Auslesen habe ich dann davon abgeleitet.


Code:

Delphi-Quellcode:

// Prozess ID anhand der Exe ermitteln
function TMainFrm.GetProcessID(Exename: string): DWORD;
var
 hProcSnap: THandle;
 pe32: TProcessEntry32;
begin
 result := 0;
 hProcSnap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
 if hProcSnap <> INVALID_HANDLE_VALUE then
  begin
   pe32.dwSize := SizeOf(ProcessEntry32);
   if Process32First(hProcSnap, pe32) = true then
    begin
     while Process32Next(hProcSnap, pe32) = true do
      begin
       if pos(Exename, pe32.szExeFile) <> 0 then
        result := pe32.th32ProcessID;
      end;
    end;
   CloseHandle(hProcSnap);
  end;
end;

// Prozessorzuweisung setzen
function SetProcessAffinityMaskByID(ID, Affinity: DWORD): Boolean;
var
  Handle: THandle;
begin
  Result := False;
  Handle := OpenProcess(PROCESS_SET_INFORMATION, False, ID);
  if Handle <> 0 then
  begin
    Result := SetProcessAffinityMask(Handle, Affinity);
    CloseHandle(Handle);
  end;
end;

// Prozessorzuweisung ermitteln
function GetProcessAffinityMaskByID(ID: DWORD): Cardinal;
var
 Handle: THandle;
 aSysMask: Cardinal;
begin
 Handle := OpenProcess(PROCESS_QUERY_INFORMATION, False, ID);
 if Handle <> 0 then
  begin
   GetProcessAffinityMask(Handle, Result, aSysMask);
   CloseHandle(Handle);
  end;
end;

Anwendung:

Delphi-Quellcode:

// Setzen - CPU0 = 1 | CPU1 = 2 | CPU0+1 = 3 | CPU2 = 4 usw.
procedure Zuweisung_Setzen;
begin
 SetProcessAffinityMaskByID(GetProcessID('nero.exe'), 1);
end;

// Ermitteln - CPU0 = 1 | CPU1 = 2 | CPU0+1 = 3 | CPU2 = 4 usw.
procedure Zuweisung_Ermitteln;
var
 BitMaske: Cardinal;
 CPU: String;
begin
 BitMaske := GetProcessAffinityMaskByID(GetProcessID('nero.exe'));
 if BitMaske = 1 then
  CPU := 'CPU0';
 if BitMaske = 2 then
  CPU := 'CPU1';
 if BitMaske = 3 then
  CPU := 'CPU0+1';
 if BitMaske = 4 then
  CPU := 'CPU2';
 // usw.
end;

[edit=Matze]Code angepasst. Mfg, Matze[/edit]

[hoika]

Hallo,

such mal im Netz nach IBAffinity.
Das setzt bei Interbase (6) den IBSERVER-Prozess
auf einen der Prozessoren.

Ich benutze es zwar nicht mehr,
hatte es damals aber mal mit Erfolg.


Heiko