delphi 多核机器上编程实现将指定进程PID放到指定CPU上运行

本文整理自网络，侵删。

 
BOOL SetProcessAffinityMask( 
  HANDLE hProcess,                 // handle to process 
  DWORD_PTR dwProcessAffinityMask  // process affinity mask 
); 
 
procedure SetCPU(h: THandle; CpuNo: Integer);  //cpuNo = 1..n 
var 
  ProcessAffinity: Cardinal; 
  _SystemAffinity: Cardinal; 
begin 
  GetProcessAffinityMask(h, ProcessAffinity, _SystemAffinity); 
  ProcessAffinity := CpuNo; 
  SetProcessAffinityMask(h, ProcessAffinity) 
end; 
 
setCpu(GetCurrentProcess, 2); //到 cpu 核心 2 上面运行
 
 
呼~我?出?砹?!!
原??Mutli-thread是可以的!
但是若是用到Synchronize,?t??是只有main thread在?绦?..
所以即使有再多的thread..
也是只有一??thread在?绦?

?⒖?碓?:http://delphi.ktop.com.tw/board.php?cid=168&fid=912&tid=62520


type
  TCPUTester = Class(TThread)
    private
        FButton: TSpeedButton;
    protected
        procedure Execute;override;
    public
        constructor Create(Button:TSpeedButton ;
                           CreateSuspended: Boolean=true;
                           CPUMark: LongWord=1);
        destructor Destroy;override;
  end;
 
procedure TCPUTester.Execute;
begin
    while ((Not Terminated) and (FButton.Down)) do;
end;
  
constructor TCPUTester.Create(Button: TSpeedButton ;
                            CreateSuspended: boolean;
                            CPUMark: LongWord)
  
begin
    FButton := Button;
    Inherited Create(CreateSuspended);
    FreeOnTerminate:=true;
    SetThreadAffinityMask (Handle,1 shr (CPUMark-1));
end;
destructor TCPUTester.Destroy;
begin
    FButton:=NIL;
    Inherited;
end;
  
//---------------------------------------------------------------------------
procedure TForm1.FormCreate(Sender: TObject);
var
    ProcessAffinityMask: LongWord;
    SystemAffinityMask: LongWord;
    I: Integer;
begin
    if Not(GetProcessAffinityMask(    GetCurrentProcess(),
                                ProcessAffinityMask,
                                SystemAffinityMask)) then begin
        Application.Terminate();
        exit;
    end;
  
    for  i:=0 to sizeof(SystemAffinityMask)*8 - 1 do begin
        if(SystemAffinityMask and (1 shr i)) <> 0 then
        begin
            TSpeedButton(FindComponent('SpeedButton'+IntToStr(i+1))).Enabled:=true;
        end;
    end;
  
end;
//---------------------------------------------------------------------------
procedure TForm1.SpeedButton1Click(Sender: TObject );
var
  CPUTester:TCPUTester ;
  Button: TSpeedButton ;
begin
    if Not (Sender Is TSpeedButton) then
    begin
        Exit;
    end;
    Button:=Sender as TSpeedButton;
    if(NIL=Button)then Exit;
  
    if Not(Button.Down) then
    begin
        Exit;
    end;
    CPUTester:= TCPUTester.Create(Button,true,StrToInt(Button.Caption));
    if(NIL=CPUTester) then
    begin
        exit;
    end;
    CPUTester.Resume();
end;
//---------------------------------------------------------------------------
procedure TForm1.FormDestroy(Sender: TObject );
var
  I: Integer;
  comp: TComponent;
begin
   for i:=0 to ComponentCount-1 do
   begin
       comp:=Components[i];
       if(comp is TSpeedButton) then
         TSpeedButton(comp).Down:=false;
   end;
   Sleep(1000);
end;
 

相关阅读 >>

Delphi 暴力搜索api

Delphi idftp 使用被动连接

Delphi 读取正在被占用的txt文件

Delphi 判断系统服务是否运行

Delphi tmemo 可以显示、编辑多行文本

Delphi 替换系统文件实现绕过杀软启动

Delphi windows 编程[21] - wm_menuselect 消息与 getmenustring 函数

Delphi tadoquery的用法

Delphi 动态添加资源文件

qdac项目

更多相关阅读请进入《Delphi》频道 >>

转载请注明出处：木庄网络博客 » delphi 多核机器上编程实现将指定进程PID放到指定CPU上运行