3

我尝试使用 WMI 获取 CPU 缓存信息，效果很好，但仅适用于 2 级和 3 级缓存，所以我的问题是，如何获取 CPU 1 级缓存信息？

4

2 回答 2

9

这是使用该GetLogicalProcessorInformation函数的WinAPI方式。如果您至少有 Delphi XE2，则不需要以下定义，它们已经在Windows单元中：

type
  TLogicalProcessorRelationship = (
    RelationProcessorCore = 0,
    RelationNumaNode = 1,
    RelationCache = 2,
    RelationProcessorPackage = 3,
    RelationGroup = 4,
    RelationAll = $FFFF
  );
  TProcessorCacheType = (
    CacheUnified,
    CacheInstruction,
    CacheData,
    CacheTrace
  );
  TCacheDescriptor = record
    Level: Byte;
    Associativity: Byte;
    LineSize: Word;
    Size: DWORD;
    pcType: TProcessorCacheType;
  end;
  PSystemLogicalProcessorInformation = ^TSystemLogicalProcessorInformation;
  TSystemLogicalProcessorInformation = record
    ProcessorMask: ULONG_PTR;
    Relationship: TLogicalProcessorRelationship;
    case Integer of
      0: (Flags: Byte);
      1: (NodeNumber: DWORD);
      2: (Cache: TCacheDescriptor);
      3: (Reserved: array [0..1] of ULONGLONG);
  end;

function GetLogicalProcessorInformation(
  Buffer: PSystemLogicalProcessorInformation;
  var ReturnLength: DWORD): BOOL; stdcall;
  external kernel32 name 'GetLogicalProcessorInformation';

以及如何显示所有 1 级缓存条目的缓存类型、级别和大小的示例：

procedure TForm1.Button1Click(Sender: TObject);
var
  S: string;
  I: Integer;
  ReturnLength: DWORD;
  Buffer: array of TSystemLogicalProcessorInformation;
begin
  SetLength(Buffer, 1);
  if not GetLogicalProcessorInformation(@Buffer[0], ReturnLength) then
  begin
    if GetLastError = ERROR_INSUFFICIENT_BUFFER then
    begin
      SetLength(Buffer, 
        ReturnLength div SizeOf(TSystemLogicalProcessorInformation) + 1);
      if not GetLogicalProcessorInformation(@Buffer[0], ReturnLength) then
        RaiseLastOSError;
    end
    else
      RaiseLastOSError;
  end;

  for I := 0 to High(Buffer) do
  begin
    if (Buffer[I].Relationship = RelationCache) and
      (Buffer[I].Cache.Level = 1) then
    begin
      S := 'Type: ';
      case Buffer[I].Cache.pcType of
        CacheUnified: S := S + 'Unified cache';
        CacheInstruction: S := S + 'Instruction cache';
        CacheData: S := S + 'Data cache';
        CacheTrace: S := S + 'Trace cache';
      end;
      S := S + sLineBreak;
      S := S + 'Level: ' + IntToStr(Buffer[I].Cache.Level) + sLineBreak;
      S := S + 'Size: ' + IntToStr(Buffer[I].Cache.Size) + ' B';
      ShowMessage(S);
    end;
  end;
end;
于 2012-12-09T16:25:09.817 回答
5

您可以使用Win32_CacheMemoryWMI 类，试试这个代码：

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ActiveX,
  ComObj,
  Variants;



procedure  GetWin32_CacheMemoryInfo;
const
  WbemUser            ='';
  WbemPassword        ='';
  WbemComputer        ='localhost';
  wbemFlagForwardOnly = $00000020;
var
  FSWbemLocator : OLEVariant;
  FWMIService   : OLEVariant;
  FWbemObjectSet: OLEVariant;
  FWbemObject   : OLEVariant;
  oEnum         : IEnumvariant;
  iValue        : LongWord;
begin;
  FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
  FWMIService   := FSWbemLocator.ConnectServer(WbemComputer, 'root\CIMV2', WbemUser, WbemPassword);
  FWbemObjectSet:= FWMIService.ExecQuery('SELECT MaxCacheSize, Purpose  FROM Win32_CacheMemory','WQL',wbemFlagForwardOnly);
  oEnum         := IUnknown(FWbemObjectSet._NewEnum) as IEnumVariant;
  while oEnum.Next(1, FWbemObject, iValue) = 0 do
  begin
    Writeln(Format('MaxCacheSize    %d',[Integer(FWbemObject.MaxCacheSize)]));
    Writeln(Format('Purpose         %s',[String(FWbemObject.Purpose)]));
    FWbemObject:=Unassigned;
  end;
end;


begin
 try
    CoInitialize(nil);
    try
      GetWin32_CacheMemoryInfo;
    finally
      CoUninitialize;
    end;
 except
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln('Press Enter to exit');
 Readln;
end.
于 2012-12-09T16:05:15.213 回答