CreateProcess, задать соответствие процессорам исп. CheckboxList

[Человек_Борща]

Всем привет!

Мой способ:
В CreateProcess передаю через:

SetProcessAffinityMask(hProcess, AppInfo.CPUAffinity); //задаём соответствие Ядрам ЦП

где:

CPUAffinity: Cardinal;

все происходит вот таким образом:

function StrToAffinity(AStr: string): Cardinal;
var
  SL: TStringList;
  I: Integer;       
  IntVal: SmallInt;  
  Mask: Cardinal; 
begin
  Result := 0; 
  SL := TStringList.Create;    
  SL.Delimiter := ','; 
  SL.DelimitedText := AStr; 
  try
    for I := 0 to SL.Count - 1 do  
    begin
      IntVal := StrToIntDef(SL[I], 0); 
      Dec(IntVal);           
      if IntVal >= 0 then       
      begin
        Mask := 1 shl IntVal;   
        Result := Result or Mask; 
      end;
    end;
  finally
    SL.Free;   
  end;
end;

вышеприведённая функция проварачивает строку вида 1,2,3 в возвращаемое значение(Cardinal).
Возникла проблема что якобы эта функция не так работает.



Как можно вот так сделать с CheckListBox?
как вывести в него допустим:

Все ядра
1 ядро
2 ядро
3 ядро

Если стоит галочка "все ядра" то программа запускается на всех ядрах.
И как разделять выбранные галочки, и по ним запускать на нужном ядре. Допустим если выделено "1 ядро" запускать только на первом ядре цп.
А если выделено "3 ядро и 1 ядро", запускать на указанных ядрах.

Но тут проблема ядер может быть сколь угодно!
Ну это я тоже слава богу определяю:

function GetProcessorsCount: SmallInt;
var
  Sys: _SYSTEM_INFO;
begin
  GetSystemInfo(Sys); 
  Result := Sys.dwNumberOfProcessors;
end;

p.S. У всех так код в теге [code] "растянут" по вертикали?

[Человек_Борща]

Значит вот что выходит из забытых соображений :

function GetProcessorsCount: SmallInt;
var
  Sys: _SYSTEM_INFO;
begin
  GetSystemInfo(Sys);
  Result := Sys.dwNumberOfProcessors;
end;

procedure TForm3.FormCreate(Sender: TObject);
var
  i:SmallInt;
begin
  for i:=0 to GetProcessorsCount -1 do
  begin
  CPUList.Items.Add('CPU #'+IntToStr(i));
  end;
end;

function SetProcessAffinity(ChkList:TsCheckListBox):Cardinal;
var
i:integer;
p:dword;
begin
for i:=0 to 31 do
begin
if ChkList.Checked[i] then
Result:=1 shl i;
end;
end;

procedure TForm3.sButton1Click(Sender: TObject);
begin;
  if SetPriorityProc(StrToInt(Form1.ProcessList.Selected.SubItems[0]),SetProcessAffinity(CPUList)) then
  begin
    ShowMessage('Yeah!');
  end else
    ShowMessage('Fail!');
end;

Но проблема с функцией получения Affinity:
Выскакивает Indext Of Bounds(2); я в тупике.

нужна помощь=)

[Человек_Борща]

Поможет кто по сабжу темы?

Вот, но почему-то не выставляет заданные ядра и не может отметить разрешённые для процесса ядра.

function GetProcessorsCount: SmallInt;
var
  Sys: _SYSTEM_INFO;
begin
  GetSystemInfo(Sys);
  Result := Sys.dwNumberOfProcessors; //Число ядер ЦП
end;

procedure TForm3.FormCreate(Sender: TObject);
var
  i:SmallInt;
begin
  for i:=0 to GetProcessorsCount -1 do
  begin
  CPUList.Items.Add('CPU #'+IntToStr(i));
  end;
end;

function SetProcessAffinity(ChkList:TsCheckListBox):Cardinal;
var
i:integer;
begin
Result:=0;
for i:=0 to GetProcessorsCount-1 do
begin
if ChkList.Checked[i] then
Result:=1 shl i;
end;
end;

procedure GetProcessMaskFormProc(ProcPID:DWORD);
var i:integer;
p,s:DWORD;
h:THandle;
begin
h:=OpenProcess(ProcPID,false,PROCESS_QUERY_INFORMATION);//проверку стоит добавить
GetProcessAffinityMask(h,p,s);
CloseHandle(h);
for i:=0 to Form3.CPUList.Items.Count -1 do
Form3.CPUList.Checked[i]:=bool((p shr i) and 1);
end;

procedure TForm3.sButton1Click(Sender: TObject);
begin;
  if SetProcessAffinityMask(GetCurrentProcessId,SetProcessAffinity(CPUList)) then
  begin
    ShowMessage('Yeah!');

  end else
    ShowMessage('Fail!');
end;

procedure TForm3.sButton2Click(Sender: TObject);
begin
GetProcessMaskFormProc(GetCurrentProcessId); //получаем разрешённые процессора для процесса
end;