D7多线程，cpu资源分配问题

[boneheart]

各位，请教下。我用D7做了个多线程的程序，运行的时候发现，就算多线程也只是用CPU的一个核。我运行在至强CPU服务器上，有一个核基本都跑到100%了，其他3个核还空闲着。我要怎么解决这个问题，让程序跑的跟有效率一点？

[SQLDebug_Fan]

线程写的有问题，看是否是加锁导致的，多个线程是可以跑满多个CPU的，你的操作系统版本是多少？可以放到Win7或Win2008的服务器上试试。

[武稀松]

正常来说操作系统会帮你做自动分配线程的处理器亲缘性. 当然也可以用SetThreadAffinityMask来强制设置线程的处理器亲缘性. 但是如果你一个线程机器消耗CPU资源,而其他线程几乎不消耗CPU资源,那么你看到一个核心资源占用高也是正常的.

[sololie]

贴代码，先看看多线程是否本身没写正确

[pathletboy]

用这个 SetThreadAffinityMask

[lyhoo163]

这个问题应该是操作系统问题，让程序线程自动分配CPU，有一定难度。应该说版本高的系统，应该能平衡CPU。

[boneheart]

虽然没有说到点子上，但还是学习到了新函数了。所以结贴给分算了。正确来讲。应该是线程数刚好使用到cpu的25%。我的程序不是无限开线程的。是消息来一个，开一个线程，处理一个。d7应该是没办法了。openmp.TBB这些技术是2006年以后才出的。而d7是2002年。

[BambooCaep]

你不会是用Synchronize去执行线程里费时的操作了吧？

[pathletboy]

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Classes,
  Windows;

type
  TRunThread = class(TThread)
  protected
    procedure Execute(); override;
  end;
var
  dwCpuCount: Cardinal;
  curCpu: Cardinal = 0;
procedure TRunThread.Execute;
var
  startTime: Cardinal;
begin
  startTime := GetTickCount;
  while not Terminated do
  begin

    if GetTickCount - startTime > 8000 then
    begin
      Inc(curCpu);
      if curCpu > dwCpuCount then
        curCpu := 0;
      SetThreadAffinityMask(Self.Handle, curCpu);
      startTime := GetTickCount;
    end;
  end;
end;

function getCpuCount: Cardinal;
var
  sysinfo: TSystemInfo;
begin
  GetSystemInfo(sysinfo);
  Result := sysinfo.dwNumberOfProcessors;
end;

begin
  dwCpuCount := getCpuCount;
  TRunThread.Create(False);
  Readln;
end.

样例每隔8秒切换至下个CPU核心，根据你的需求可以写的高级点，获得每个核心的CPU占用率，然后新建线程的时候SetThreadAffinityMask到较低的核心上。