WindowsXP 対応アプリを作る

　WindowsXPで動作すれば「WindowsXP対応」なのか？確かにそうでしょうが、XPで実装された新機能も知らないで 「XP対応」とはいかがなものかと...。

・フォント
 　WindowsXPでは固定ピッチフォント、正確に言うと「MSゴシック/MS明朝」のサイズが従来の Windowsと異なり、半角文字と全角文字が完全に1：2になりました。よって、XPを視野に入れるには余裕を持ったコントロールの配置が必要となります。キャプションが切れているのに「XP対応」なんて書いたら恥ずかしいですよ(^^;

・アイコン
 　WindowsXPではフルカラーアイコンが使えるようになりました。正確に言うと32bitアイコンが使えるようになっています。RGB各256階調+透明度(アルファ)256階調です。このHPにあるMuRICで作成する事ができます。

・視覚テーマ(ビジュアルスタイル)
 　WindowsXPではウィンドウの見た目を切り替える事ができます。具体的な作り方は以下を参照して下さい。

1.マニフェストファイル(*.manifest)を作成する。
 　 マニフェストファイルと呼ばれるXML形式のファイルを作成します。赤い文字以外の所はそのままで構いません。
　 
<?xml version="1.0" encoding="UTF-8" standalone="yes"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity
 version="バージョン"
 processorArchitecture="X86"
 name="アプリケーション名"
 type="win32"
/>
<description>アプリケーションの説明</description>
<dependency>
<dependentAssembly>
<assemblyIdentity
 type="win32"
 name="Microsoft.Windows.Common-Controls"
 version="6.0.0.0"
 processorArchitecture="X86"
 publicKeyToken="6595b64144ccf1df"
 language="*"
 />
</dependentAssembly>
</dependency>
</assembly>

　こんな内容のファイルを作成し、名前を「アプリケーション名.exe.manifest」とします(赤字の所は適宜書き換えてください)。日本語を使ったら文字コードセットをUTF-8形式で保存する事。
　

2.マニフェストファイルをリソース化し、EXEに統合する。
 　上記のマニフェストファイルを作成したら、リソーススクリプトファイル(*.rc)を書きます。

#define CREATEPROCESS_MANIFEST_RESOURCE_ID 1
#define CONTROL_PANEL_RESOURCE_ID 123
#define RT_MANIFEST 24
CREATEPROCESS_MANIFEST_RESOURCE_ID RT_MANIFEST "マニフェストファイル名"

　これをBRCC32.EXE 等のリソースコンパイラでコンパイルしてリソースファイル(*.res)を生成します。そして、プロジェクトファイル(*.dpr)に$R指令でこのリソースファイルを指定します。
　

3.よく解らないけどユーザーメッセージを無視する
 　これをやらないとツールバーのボタンがマウスで押下しても引っ込まなかったり、操作不能になる事があります(情報提供:飛龍＋＋氏)。

private
 { Private 宣言 }
  procedure AppMessage(var Msg: TMsg; var Handled: Boolean);


procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
end;

procedure TForm1.AppMessage(var Msg: TMsg; var Handled: Boolean);
begin
  case Msg.Message of
    WM_USER + $0500:
      Handled := True;
  end;
end;

上記のソースを参考に、アプリケーションにコードを追加して下さい。

Windows のバージョンを本格的に判断する。

　WindowsのバージョンはGetVersionExで簡単に取得できますが、「ＯＳ名」ともなると結構面倒なものです。

function IsWinNT:Boolean;
var
  Version:TOSVERSIONINFO;
begin
  result := False;
  Version.dwOSVersionInfoSize := SizeOf(Version);
  if GetVersionEx(Version) then
    if Version.dwPlatformId = VER_PLATFORM_WIN32_NT then
      result := True;
end;

function GetOSVersion:Integer;
var
  Version:TOSVERSIONINFO;
begin
  result := 0;
  Version.dwOSVersionInfoSize := SizeOf(Version);
  if GetVersionEx(Version) then
    result := (Version.dwMajorVersion  * 1000000) + (Version.dwMinorVersion * 10000) + Version.dwBuildNumber;
end;

function GetOSName:String;
// http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/sysinfo_3a0i.asp
// http://msdn.microsoft.com/library/default.asp?url=/library/en-us/sysinfo/sysinfo_1o1e.asp
// http://www.microsoft.com/japan/support/kb/articles/JP158/2/38.asp
// http://msdn.microsoft.com/library/en-us/sysinfo/base/getting_the_system_version.asp
// http://msdn.microsoft.com/library/en-us/sysinfo/base/getnativesysteminfo.asp
// http://technet2.microsoft.com/WindowsServer/ja/Library/efd0febb-02d9-4963-b0f4-b82be29aba921041.mspx?mfr=true
// http://msdn2.microsoft.com/en-us/library/ms724358.aspx
type
TOSVERSIONINFOEX =
   packed record
     dwOSVersionInfoSize:Cardinal;
     dwMajorVersion     :Cardinal;
     dwMinorVersion     :Cardinal;
     dwBuildNumber      :Cardinal;
     dwPlatformId       :Cardinal;
     szCSDVersion       :array [0..127] of Char;
     wServicePackMajor  :Word;
     wServicePackMinor  :Word;
     wSuiteMask         :Word;
     wProductType       :Byte;
     wReserved          :Byte;
   end;
const
  VER_NT_WORKSTATION       = 1;
  VER_NT_DOMAIN_CONTROLLER = 2;
  VER_NT_SERVER            = 3;
  VER_SUITE_SMALLBUSINESS            = $0001;
  VER_SUITE_ENTERPRISE               = $0002;
  VER_SUITE_BACKOFFICE               = $0004;
  VER_SUITE_TERMINAL                 = $0010;
  VER_SUITE_SMALLBUSINESS_RESTRICTED = $0020;
  VER_SUITE_DATACENTER               = $0080;
  VER_SUITE_SINGLEUSERTS             = $0100;
  VER_SUITE_PERSONAL                 = $0200;
  VER_SUITE_BLADE                    = $0400;

  PROCESSOR_ARCHITECTURE_INTEL           =  0;
  PROCESSOR_ARCHITECTURE_MIPS            =  1;
  PROCESSOR_ARCHITECTURE_ALPHA           =  2;
  PROCESSOR_ARCHITECTURE_PPC             =  3;
  PROCESSOR_ARCHITECTURE_SHX             =  4;
  PROCESSOR_ARCHITECTURE_ARM             =  5;
  PROCESSOR_ARCHITECTURE_IA64            =  6;
  PROCESSOR_ARCHITECTURE_ALPHA64         =  7;
  PROCESSOR_ARCHITECTURE_MSIL            =  8;
  PROCESSOR_ARCHITECTURE_AMD64           =  9;
  PROCESSOR_ARCHITECTURE_IA32_ON_WIN64   = 10;

  SM_SERVERR2 = 80;

  PRODUCT_UNDEFINED                    = $00000000;
  PRODUCT_ULTIMATE                     = $00000001;
  PRODUCT_HOME_BASIC                   = $00000002;
  PRODUCT_HOME_PREMIUM                 = $00000003;
  PRODUCT_ENTERPRISE                   = $00000004;
  PRODUCT_HOME_BASIC_N                 = $00000005;
  PRODUCT_BUSINESS                     = $00000006;
  PRODUCT_STANDARD_SERVER              = $00000007;
  PRODUCT_DATACENTER_SERVER            = $00000008;
  PRODUCT_SMALLBUSINESS_SERVER         = $00000009;
  PRODUCT_ENTERPRISE_SERVER            = $0000000A;
  PRODUCT_STARTER                      = $0000000B;
  PRODUCT_DATACENTER_SERVER_CORE       = $0000000C;
  PRODUCT_STANDARD_SERVER_CORE         = $0000000D;
  PRODUCT_ENTERPRISE_SERVER_CORE       = $0000000E;
  PRODUCT_ENTERPRISE_SERVER_IA64       = $0000000F;
  PRODUCT_BUSINESS_N                   = $00000010;
  PRODUCT_WEB_SERVER                   = $00000011;
  PRODUCT_CLUSTER_SERVER               = $00000012;
  PRODUCT_HOME_SERVER                  = $00000013;
  PRODUCT_STORAGE_EXPRESS_SERVER       = $00000014;
  PRODUCT_STORAGE_STANDARD_SERVER      = $00000015;
  PRODUCT_STORAGE_WORKGROUP_SERVER     = $00000016;
  PRODUCT_STORAGE_ENTERPRISE_SERVER    = $00000017;
  PRODUCT_SERVER_FOR_SMALLBUSINESS     = $00000018;
  PRODUCT_SMALLBUSINESS_SERVER_PREMIUM = $00000019;
var
  Unknown:Boolean;
  SP,
  Dmy:String;
  Version:TOSVERSIONINFO;
  VersionEX:TOSVERSIONINFOEX;
  SystemInfo:SYSTEM_INFO;
  {StatusEx begin}
  function StatusEx:TOSVERSIONINFOEX;
  var
    po :TFarProc;
    DLLWnd :THandle;
    VEX:TOSVERSIONINFOEX;
    GetVersionEx2:function(var LPOSVERSIONINFO:TOSVERSIONINFOEX):Boolean;stdcall;
  begin
    po := nil;
    DLLWnd := LoadLibrary('kernel32');
    if DLLWnd > 0 then
      begin
        try
          {$IFDEF UNICODE}
          po := GetProcAddress(DLLWnd, 'GetVersionExW');
          {$ELSE}
          po := GetProcAddress(DLLWnd, 'GetVersionExA');
          {$ENDIF}
          if po <> nil then
            begin
              @GetVersionEx2 := po;
              VEX.dwOSVersionInfoSize := SizeOf(VEX);
              if GetVersionEx2(VEX) then
                result := VEX;
            end;
        finally
          FreeLibrary(DLLWnd);
        end;
      end;
  end;
  {StatusEx end}
  {StatusEx2 begin}
  function StatusEx2:SYSTEM_INFO;
  var
    po :TFarProc;
    DLLWnd :THandle;
    SI:SYSTEM_INFO;
    GetNativeSystemInfo:procedure(var LPSYSTEM_INFO:SYSTEM_INFO);stdcall;
  begin
    po := nil;
    DLLWnd := LoadLibrary('kernel32');
    if DLLWnd > 0 then
      begin
        try
          po := GetProcAddress(DLLWnd, 'GetNativeSystemInfo');
          if po <> nil then
            begin
              @GetNativeSystemInfo := po;
              GetNativeSystemInfo(SI);
              result := SI;
            end;
        finally
          FreeLibrary(DLLWnd);
        end;
      end;
  end;
  {StatusEx2 end}
  {StatusEx3 begin}
  function StatusEx3(OSMajor,OSMinor,SPMajor,SPMinor:DWORD):DWORD;
  var
    po :TFarProc;
    DLLWnd :THandle;
    PT:DWORD;
    GetProductInfo:function(AOSMajor,AOSMinor,ASPMajor,ASPMinor:DWORD; var ProductType:DWORD):Boolean;stdcall;
  begin
    po := nil;
    DLLWnd := LoadLibrary('kernel32');
    if DLLWnd > 0 then
      begin
        try
          po := GetProcAddress(DLLWnd, 'GetProductInfo');
          if po <> nil then
            begin
              @GetProductInfo := po;
              GetProductInfo(OSMajor,OSMinor,SPMajor,SPMinor,PT);
              result := PT;
            end;
        finally
          FreeLibrary(DLLWnd);
        end;
      end;
  end;
  {StatusEx3 end}
begin
  result := '';
  Version.dwOSVersionInfoSize := SizeOf(Version);
  if GetVersionEx(Version) then
    begin
      Dmy := 'Windows';
      SP := Trim(StrPas(Version.szCSDVersion));
      case Version.dwPlatformId of
        // Windows3.1(Win32s)
        VER_PLATFORM_WIN32s:
          Dmy := Dmy + Format('%d.%d(Win32s)',[Version.dwMajorVersion,Version.dwMinorVersion]);
        // Windows9x系
        VER_PLATFORM_WIN32_WINDOWS:
          begin
            case Version.dwMinorVersion of
              // Windows95
              00:begin
                   Dmy := Dmy + '95';
                   case LOWORD(Version.dwBuildNumber) of
                     1111:
                       Dmy := Dmy + ' OSR2';
                     1212..1213:
                       Dmy := Dmy + ' OSR2.1';
                     1214..9999:
                       Dmy := Dmy + ' OSR2.5';
                   end;
                 end;
              // Windows98
              10:begin
                   Dmy := Dmy + '98';
                   case LOWORD(Version.dwBuildNumber) of
                    2222..9999:
                     Dmy := Dmy + ' Second Edition';
                   end;
                 end;
              // WindowsMe
              90:Dmy := Dmy + 'Me';
            end;
          end;
        // WindowsNT系
        VER_PLATFORM_WIN32_NT:
          begin
            Unknown := False;
            case Version.dwMajorVersion of
              5:begin
                  VersionEx := StatusEx;
                  case Version.dwMinorVersion of
                    // 2000
                    0:begin
                        Dmy := Dmy + '2000 ';
                        case VersionEx.wProductType of
                          VER_NT_WORKSTATION:
                            Dmy := Dmy + 'Professional';
                        else
                          Dmy := Dmy + 'Server';
                        end;
                      end;
                    // XP
                    1:begin
                        case VersionEx.wProductType of
                          VER_NT_WORKSTATION:
                            begin
                              Dmy := Dmy + 'XP ';
                              if (VersionEx.wSuiteMask and VER_SUITE_PERSONAL) = VER_SUITE_PERSONAL then
                                Dmy := Dmy + 'Home Edition'
                              else
                                Dmy := Dmy + 'Professional';
                            end;
                        else
                          Dmy := Dmy + 'Server 2003';
                        end;
                      end;
                    // XP
                    2:begin
                        SystemInfo := StatusEx2;
                        case VersionEx.wProductType of
                          VER_NT_WORKSTATION:
                            begin
                              if SystemInfo.wProcessorArchitecture = PROCESSOR_ARCHITECTURE_AMD64 then
                                Dmy := Dmy + 'XP Professional x64 Edition'
                              else
                                Unknown := True;
                            end;
                          VER_NT_SERVER,
                          VER_NT_DOMAIN_CONTROLLER:
                            begin
                              Dmy := Dmy + 'Server 2003 ';
                              if GetSystemMetrics(SM_SERVERR2) = 1 then
                                Dmy := Dmy + 'R2 ';  
                              case SystemInfo.wProcessorArchitecture of
                                PROCESSOR_ARCHITECTURE_IA64:
                                  begin
                                    if (VersionEx.wSuiteMask and VER_SUITE_DATACENTER)      = VER_SUITE_DATACENTER then
                                      Dmy := Dmy + 'Datacenter Edition for Itanium-based Systems'
                                    else if (VersionEx.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
                                      Dmy := Dmy + 'Enterprise Edition for Itanium-based Systems'
                                    else
                                      Dmy := Dmy + 'Standard Edition for Itanium-based Systems';
                                  end;
                                PROCESSOR_ARCHITECTURE_AMD64:
                                  begin
                                    if (VersionEx.wSuiteMask and VER_SUITE_DATACENTER)      = VER_SUITE_DATACENTER then
                                      Dmy := Dmy + 'Datacenter x64 Edition'
                                    else if (VersionEx.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
                                      Dmy := Dmy + 'Enterprise x64 Edition'
                                    else
                                      Dmy := Dmy + 'Standard x64 Edition';
                                  end;
                              else
                                if (VersionEx.wSuiteMask and VER_SUITE_DATACENTER)      = VER_SUITE_DATACENTER then
                                  Dmy := Dmy + 'Datacenter Edition'
                                else if (VersionEx.wSuiteMask and VER_SUITE_ENTERPRISE) = VER_SUITE_ENTERPRISE then
                                  Dmy := Dmy + 'Enterprise Edition'
                                else if (VersionEx.wSuiteMask and VER_SUITE_BLADE)      = VER_SUITE_BLADE then
                                  Dmy := Dmy + 'Web Edition'
                                else
                                  Dmy := Dmy + 'Standard Edition';
                              end;    
                            end;
                          else
                            Unknown := True;
                        end;
                      end;
                  else
                    Unknown := True;
                  end;
                end;
              6:begin
                  VersionEx := StatusEx;
                  case Version.dwMinorVersion of
                    0,1:
                      begin
                        case VersionEx.wProductType of
                          VER_NT_WORKSTATION:
                            begin
                              case Version.dwMinorVersion of
                                0:Dmy := Dmy + ' Vista ';
                                1:Dmy := Dmy + ' 7 ';
                              end;
                              case StatusEx3(Version.dwMajorVersion,Version.dwMinorVersion,0,0) of
                                PRODUCT_ULTIMATE:
                                  Dmy := Dmy + 'Ultimate';
                                PRODUCT_HOME_BASIC:
                                  Dmy := Dmy + 'Home Basic';
                                PRODUCT_HOME_PREMIUM:
                                  Dmy := Dmy + 'Home Premium';
                                PRODUCT_ENTERPRISE:
                                  Dmy := Dmy + 'Business';
                                PRODUCT_HOME_BASIC_N:
                                  Dmy := Dmy + 'Home Basic N';
                                PRODUCT_BUSINESS:
                                  Dmy := Dmy + 'Business';
                                PRODUCT_STARTER:
                                  Dmy := Dmy + 'Starter Edition';
                                PRODUCT_BUSINESS_N:
                                  Dmy := Dmy + 'Business N';
                              end;
                            end;
                        else
                          case Version.dwMinorVersion of
                            0:Dmy := Dmy + 'Server 2008 ';
                            1:Dmy := Dmy + 'Server 2008 R2 ';
                          end;
                          case StatusEx3(Version.dwMajorVersion,Version.dwMinorVersion,0,0) of
                            PRODUCT_STANDARD_SERVER:              
                              Dmy := Dmy + 'Standard Edition';
                            PRODUCT_DATACENTER_SERVER:
                              Dmy := Dmy + 'Datacenter Edition';
                            PRODUCT_SMALLBUSINESS_SERVER:
                              Dmy := Dmy + 'Small Business Server';
                            PRODUCT_ENTERPRISE_SERVER:
                              Dmy := Dmy + 'Enterprise Edition';
                            PRODUCT_DATACENTER_SERVER_CORE:
                              Dmy := Dmy + 'Datacenter Edition(Core)';
                            PRODUCT_STANDARD_SERVER_CORE:
                              Dmy := Dmy + 'Standard Edition(Core)';
                            PRODUCT_ENTERPRISE_SERVER_CORE:
                              Dmy := Dmy + 'Enterprise Edition(Core)';
                            PRODUCT_ENTERPRISE_SERVER_IA64:
                              Dmy := Dmy + 'Enterprise Edition for Itanium-based Systems';
                            PRODUCT_WEB_SERVER:
                              Dmy := Dmy + 'Web Server Edition';
                            PRODUCT_CLUSTER_SERVER:
                              Dmy := Dmy + 'Cluster Server Edition';
                            PRODUCT_HOME_SERVER:
                              Dmy := Dmy + 'Home Server Edition';
                            PRODUCT_STORAGE_EXPRESS_SERVER:
                              Dmy := Dmy + 'Storage Server Express Edition';
                            PRODUCT_STORAGE_STANDARD_SERVER:
                              Dmy := Dmy + 'Storage Server Standard Edition';
                            PRODUCT_STORAGE_WORKGROUP_SERVER:
                              Dmy := Dmy + 'Storage Server Workgroup Edition';
                            PRODUCT_STORAGE_ENTERPRISE_SERVER:
                              Dmy := Dmy + 'Storage Server Enterprise Edition';
                            PRODUCT_SERVER_FOR_SMALLBUSINESS:
                              Dmy := Dmy + 'for Small Business Edition';
                            PRODUCT_SMALLBUSINESS_SERVER_PREMIUM:
                              Dmy := Dmy + 'Small Business Server Premium Edition';
                          end;
                        end;
                        case SystemInfo.wProcessorArchitecture of
                          PROCESSOR_ARCHITECTURE_IA64:
                            Dmy := Dmy + '(IA64)';
                          PROCESSOR_ARCHITECTURE_AMD64:
                            Dmy := Dmy + '(x64)';
                        end;
                      end;
                  else
                    Unknown := True;
                  end;
                end;
            else
              Unknown := True;
            end;
            if Unknown then
              begin
                Dmy := Dmy + Format('NT%d.%d ',[Version.dwMajorVersion,Version.dwMinorVersion]);
                // NT4.0 SP6以降 or XP以降
                if (Version.dwMajorVersion >= 5) or
                   ((Version.dwMajorVersion = 4) and (Pos('6',SP) > 0)) then
                  begin
                    VersionEx := StatusEx;
                    case VersionEx.wProductType of
                      VER_NT_WORKSTATION:
                         Dmy := Dmy + 'WorkStation';
                    else
                      Dmy := Dmy + 'Server';
                    end;
                  end;
              end;
          end;
      end;
      if Length(SP) > 0 then
        Dmy := Dmy + Format(' [%s]',[SP]);
    end;
  result := Dmy;
end;

印刷部数を指定して印刷する

　Printers変数を用いてゴリゴリ印刷する場合のお話です。

procedure PrintProc(n: Integer);
var
  i, c: Integer;
begin
  if (pcCopies in Printer.Capabilities) then
    begin
      c := 1;
      Printer.Copies := n;
    end
  else
    begin
      c := n;
      Printer.Copies := 1;
    end;
  for i := 1 to c do
    begin
      Printer.BeginDoc;
      try
        // 印刷処理
      finally
        Printer.EndDoc;
      end;
    end;
end;

　このロジックは、「プリンタが部数印刷に対応していればそっちを利用する」というモノです。対応していない場合にはループで回して印刷します。

CPUを判断する

　ソフトの動作環境を調べる一つの手段ですね。絶対ではありませんが。

// http://www.dinop.com/vc/vctips.html
// http://www2u.biglobe.ne.jp/~M_manu/colum/comp/07.html
// http://www.mechatronics.mech.tohoku.ac.jp/~kumagai/research/library/linux/tips.html#rdtsc

function IsEnableCPUID: Boolean;
var
  dwTemp1,
  dwTemp2: DWORD;
begin
  asm
    pushfd
    pop eax
    mov dwTemp1,eax
    xor eax,00200000h
    push eax
    popfd
    pushfd
    pop eax
    mov dwTemp2,eax
  end;
  result := (dwTemp1 <> dwTemp2);
end;

function GetCPUFreq: Double;
var
  dwEAX1,
  dwEAX2,
  dwEDX1,
  dwEDX2,
  dwTime: DWORD;

  {IsEnableRDTSC Start}
  // IsProcessorFeaturePresent()は
  // NT系のOSでしか使えないため
  function IsEnableRDTSC: Boolean;
  var
    dwTemp: DWORD;
  begin
    result := False;
    if not IsEnableCPUID then
      Exit;
    asm
      pushad
      mov eax, 1
      DB 0Fh, 0A2h // cpuid
      mov dwTemp, edx
      popad
    end;
    result := ((dwTemp and $00000010) = $00000010);
  end;
  {IsEnableRDTSC End}
begin
  result := -1;
  if not IsEnableRDTSC then
    Exit;
  dwTime := GetTickCount;
  asm
    DB 0Fh,031h // rdtsc
    mov dwEAX1,eax
    mov dwEDX1,edx
  end;
  while True do // 2秒アイドル用の無限ループ
    begin
      if (GetTickCount - dwTime) > 2000 then
        Break;
    end;
  dwTime := GetTickCount - dwTime;
  asm
    DB 0Fh,031h // rdtsc
    mov dwEAX2,eax
    mov dwEDX2,edx
  end;
  dwEDX2 := dwEDX2 - dwEDX1;
  dwEAX2 := dwEAX2 - dwEAX1;
  result := (dwEDX2 shl 32) + dwEAX2; //Clock数
  result := result / (dwTime * 1000); //MHz
end;

function GetProcessorCount: Integer;
var
  SI: TSystemInfo;
begin
  GetSystemInfo(SI);
  result := SI.dwNumberOfProcessors;
end;

function GetCPUID(Func1, Func2: Byte): DWORD;
var
  dwEAX,
  dwEBX,
  dwECX,
  dwEDX: DWORD;
begin
  result := $FFFFFFFF;
  if not IsEnableCPUID then
    Exit;
  asm
    pushad
    mov eax, Func1
    DB 0Fh, 0A2h // cpuid
    mov dwEAX, eax
    mov dwEBX, ebx
    mov dwECX, ecx
    mov dwEDX, edx
    popad
  end;
  case Func2 of
    0: result := dwEAX;
    1: result := dwEBX;
    2: result := dwECX;
    3: result := dwEDX;
  end;
end;

Ex.

  1. GetProcessorCountでプロセッサ数を取得
  2. 「1.」が1以上だったら論理プロセッサ数はその値。
  3. GetCPUID(1,3)で28Bit目を調べる
  4. 「2.」のフラグが立っていたらGetCPUID(1,1)でBit16-Bit23を調べる
  5. 「3.」が1以上だったら論理プロセッサ数はその値そうでなければ論理プロセッサ数は1

[Intel製CPUの機能一覧(一部)]

Func1
/
Func2		 0(EAX) 1(EBX) 2(ECX) 3(EDX)
0
(基本)		 Func1(基本)に設定できる最大値 ベンダ ID文字列
1～4文字目		 ベンダID文字列
9～12文字目		 ベンダID文字列
5～8文字目
1
(基本)
Bit0-Bit3 ステッピングID
Bit4-Bit7 モデル番号
Bit8-Bit11 ファミリ・コード
Bit12-Bit13 プロセッサタイプ
Bit16-Bit19 拡張モデル
Bit20-Bit27 拡張ファミリ
Bit0-Bit7 ブランドID
Bit8-Bit15 チャンク
Bit16-Bit23 論理プロセッサ数
Bit24-Bit31 APIC ID
(reserved)
Bit0 オンチップ浮動小数点ユニット(FPU)
Bit1 仮想モード拡張(VME)
Bit2 デバッグ拡張機能(DE)
Bit3 ページサイズ拡張(PSE)
Bit4 タイムスタンプカウンタ(TSC)
Bit5 モデル固有レジスタ(MSR)
Bit6 物理アドレス拡張(PAE)
Bit7 マシンチェック例外(MCE)
Bit8 CMPXCH8命令のサポート(CX8)
Bit9 オンチップAPICハードウェアサポート(APIC)
Bit10 (reserved)
Bit11 高速システムコール (SEP)
Bit12 メモリタイプ・レンジレジスタ(MTRR)
Bit13 ページグローバルイネーブル(PGE)
Bit14 マシンチェックアーキテクチャ(MCA)
Bit15 条件付き移動命令のサポート (CMOV)
Bit16 ページ属性テーブル(PAT)
Bit17 36ビットページ拡張(PSE-36)
Bit18 プロセッサシリアルナンバーのサポートとイネーブル(PSN)
Bit19 CLFLUSH命令のサポート(CLFLUSH)
Bit20 (reserved)
Bit21 デバッグストア(DS)
Bit22 温度モニタ及びソフトウェア制御されるクロック機能のサポート(ACPI)
Bit23 MMXテクノロジのサポート(MMX)
Bit24 浮動小数点コンテキストの高速セーブ/リストア(FXSR)
Bit25 ストリーミングSIMD拡張命令のサポート(SSE)
Bit26 ストリーミング SIMD拡張命令2のサポート(SSE2)
Bit27 セルフスヌープ(SS)
Bit28 ハイパースレッディングのサポート(HTT)
Bit29 温度モニタのサポート(TM)
Bit30 (reserved)
Bit31 (reserved)
2
(基本)		 キャッシュ特性とTLB特性 キャッシュ特性と TLB特性 キャッシュ特性とTLB特性 キャッシュ特性と TLB特性
3
(基本)		 (reserved) (reserved) 96Bitのプロセッサ・シリアルナンバーのBit0-Bit31 96Bitのプロセッサ・シリアルナンバーのBit32-Bit63

詳しくは以下のURLの資料を参照の事

 BACK