設定系統工作CPU個數

有些程式運行在多個CPU的系統上運行不穩定，為瞭解決這個問題，寫了一個更改進程工作CPU個數的程式

原始碼如下：

unit main;<br />interface<br />uses<br /> Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,<br /> Dialogs, TlHelp32, StdCtrls, Buttons;<br />type<br /> TfrmMain = class(TForm)<br /> Button1: TButton;<br /> Button2: TButton;<br /> OpenDialog1: TOpenDialog;<br /> Button3: TButton;<br /> GroupBox1: TGroupBox;<br /> Label1: TLabel;<br /> Edit1: TEdit;<br /> SpeedButton1: TSpeedButton;<br /> Label3: TLabel;<br /> RadioButton1: TRadioButton;<br /> RadioButton2: TRadioButton;<br /> RadioButton4: TRadioButton;<br /> RadioButton5: TRadioButton;<br /> RadioButton3: TRadioButton;<br /> RadioButton6: TRadioButton;<br /> procedure Button1Click(Sender: TObject);<br /> procedure Button2Click(Sender: TObject);<br /> procedure SpeedButton1Click(Sender: TObject);<br /> procedure FormCreate(Sender: TObject);<br /> procedure Button3Click(Sender: TObject);<br /> private<br /> { Private declarations }<br /> public<br /> { Public declarations }<br /> function Getcpu_num(): DWORD;<br /> end;<br />var<br /> frmMain: TfrmMain;<br />function SetProcessCPU_NUM: boolean;<br />implementation<br />{$R *.dfm}</p><p>function Max(a, b: integer): integer;<br />begin<br /> if a > b then<br /> result := a<br /> else<br /> result := b;<br />end;</p><p>function SetCPUProcessByFullPath(ModuleFullPath: string; AppName: string = ''; real_CPU_NUM: DWORD = 1): integer;<br />var<br /> lppe: TPROCESSENTRY32;<br /> found: boolean;<br /> ProcessList: THandle;<br /> ModuleList: Thandle;<br /> pm: TMODULEENTRY32;<br /> h: Thandle;<br /> a: DWORD;<br /> ModuleName: string;<br /> AppProcessId: DWORD; // 線程ID<br />begin<br /> Result := 0;<br /> AppProcessId := GetCurrentProcessId;<br /> if Length(AppName) = 0 then<br /> AppName := ExtractFileName(ModuleFullPath);<br /> lppe.dwSize := sizeof(TPROCESSENTRY32);<br /> pm.dwSize := sizeof(TMODULEENTRY32);<br /> ProcessList := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);<br /> found := Process32First(ProcessList, lppe);<br /> while found do //進程列表<br /> begin<br /> if StrIComp(PChar(StrPas(lppe.szExeFile)), PChar(AppName)) = 0 then //應用程式名稱字是否相同？<br /> begin<br /> ModuleList := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, lppe.th32ProcessID);<br /> found := module32first(ModuleList, pm);<br /> while found do //模組列表<br /> begin<br /> ModuleName := StrPas(pm.szexepath);<br /> ModuleName := copy(ModuleName, max(1, pos(':', ModuleName) - 1), MaxInt);<br /> if StrIComp(pchar(ModuleName), pchar(ModuleFullPath)) = 0 then //是否包含要找的模組<br /> begin<br /> if AppProcessId <> lppe.th32ProcessID then<br /> begin<br /> h := openprocess(PROCESS_ALL_ACCESS, TRUE, lppe.th32ProcessID);<br /> if SetProcessAffinityMask(h, real_CPU_NUM) then<br /> inc(Result);<br /> end;<br /> break;<br /> end;<br /> found := module32next(ModuleList, pm);<br /> end;<br /> closehandle(ModuleList);<br /> end;<br /> found := Process32Next(ProcessList, lppe);<br /> end;<br /> closehandle(ProcessList);<br />end;<br />function TfrmMain.Getcpu_num(): DWORD;<br />begin<br /> if RadioButton1.Checked then<br /> result := $0001<br /> else if RadioButton2.Checked then<br /> result := $0002<br /> else if RadioButton3.Checked then<br /> result := $0003<br /> else if RadioButton4.Checked then<br /> result := $000F<br /> else if RadioButton5.Checked then<br /> result := $007F<br /> else if RadioButton6.Checked then<br /> result := $0007;<br />end;<br />procedure TfrmMain.Button1Click(Sender: TObject);<br />var<br /> i, cpu_num: integer;<br />begin<br /> //例如系統有2個CPU，參數說明如下<br /> //1: 表示進程在第一個CPU上運行<br /> //2: 表示進程在第二個CPU上運行<br /> //3: 表示進程同時在二個CPU上運行<br /> cpu_num := Getcpu_num;<br /> i := SetCPUProcessByFullPath(edit1.Text, '', cpu_num);<br /> if i < 1 then<br /> ShowMessage('設定失敗！')<br /> else<br /> ShowMessage('設定成功！')<br />end;<br />procedure TfrmMain.Button2Click(Sender: TObject);<br />var<br /> CPU_NUM: DWORD;<br /> h: THandle;<br />begin<br /> cpu_num := Getcpu_num;<br /> h := GetCurrentProcess();<br /> if SetProcessAffinityMask(h, CPU_NUM) then<br /> ShowMessage('設定成功！');<br />end;<br />procedure TfrmMain.Button3Click(Sender: TObject);<br />begin<br /> Close;<br />end;<br />procedure TfrmMain.FormCreate(Sender: TObject);<br />var<br /> lpSystemInfo:SYSTEM_INFO;<br />begin<br /> GetSystemInfo(lpSystemInfo);<br /> Label3.Caption := Label3.Caption + IntToStr(lpSystemInfo.dwNumberOfProcessors);<br /> RadioButton1.Checked := True;<br /> if lpSystemInfo.dwNumberOfProcessors <= 1 then<br /> begin<br /> RadioButton2.Enabled := False;<br /> RadioButton3.Enabled := False;<br /> RadioButton4.Enabled := False;<br /> RadioButton5.Enabled := False;<br /> RadioButton6.Enabled := False;<br /> end<br /> else if lpSystemInfo.dwNumberOfProcessors = 2 then<br /> begin<br /> RadioButton4.Enabled := False;<br /> RadioButton5.Enabled := False;<br /> RadioButton6.Enabled := False;<br /> end<br /> else if lpSystemInfo.dwNumberOfProcessors = 4 then<br /> begin<br /> RadioButton6.Enabled := False;<br /> end<br /> else if lpSystemInfo.dwNumberOfProcessors = 8 then<br /> begin<br /> //<br /> end;<br /> SetProcessCPU_NUM;<br />end;<br />procedure TfrmMain.SpeedButton1Click(Sender: TObject);<br />begin<br /> if OpenDialog1.Execute then<br /> begin<br /> Edit1.Text := OpenDialog1.FileName;<br /> end;<br />end;<br />//當系統CPU個數超過4個時，設定進程CPU個數為4<br />function SetProcessCPU_NUM: boolean;<br />var<br /> lpSystemInfo:SYSTEM_INFO;<br /> CPU_NUM: DWORD;<br /> h: THandle;<br />begin<br /> result := true;<br /> GetSystemInfo(lpSystemInfo);<br /> if lpSystemInfo.dwNumberOfProcessors > 4 then<br /> begin<br /> cpu_num := $000F;<br /> h := GetCurrentProcess();<br /> result := SetProcessAffinityMask(h, CPU_NUM);<br /> end;<br />end;<br />end.