unit u_sys_sysinfo;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
    TcpuMSG = record
      ID1    : string;
      ID2    : String;
      ID3    : String;
      ID4    : String;
   PValue    : String;
   FValue    : String;
   MValue    : String;
   SValue    : String;
   Vendor    : String;
                  end;
  function GetDisplayFrequency: Integer;
  function GetIdeSerialNumber: pchar;
  function GetCPUSpeed: Double;
  function GetDisplayDevice:string;
  function GetProcessorType:string;
  function GetWindowsVersion: string;
  function GetIdeDiskSerialNumber(var SerialNumber: string; var ModelNumber: string;
           var FirmwareRev: string; var TotalAddressableSectors: ULong;
           var SectorCapacity: ULong; var SectorsPerTrack: Word): Boolean; //得到硬盘物理号
 function GetcpuMSG:TcpuMSG;
implementation
const
	ID_BIT	=	$200000;			// EFLAGS ID bit
type
	TCPUID	= array[1..4] of Longint;
	TVendor	= array [0..11] of char;

function GetCPUSpeed: Double;
const
 DelayTime = 500; // 时间单位是毫秒
var
 TimerHi, TimerLo: DWORD;
 PriorityClass, Priority: Integer;
begin
    PriorityClass := GetPriorityClass(GetCurrentProcess);
    Priority := GetThreadPriority(GetCurrentThread);
    SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
    SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
    Sleep(10);
    asm
       dw 310Fh // rdtsc
       mov TimerLo, eax
       mov TimerHi, edx
    end;
    Sleep(DelayTime);
    asm
       dw 310Fh // rdtsc 
       sub eax, TimerLo
       sbb edx, TimerHi
       mov TimerLo, eax
       mov TimerHi, edx
    end;

    SetThreadPriority(GetCurrentThread, Priority);
    SetPriorityClass(GetCurrentProcess, PriorityClass);
    Result := TimerLo / (1000.0 * DelayTime);
end;
//*************
function GetCpuSpeed9: Comp;
var
  t: DWORD;
  mhi, mlo, nhi, nlo: DWORD;
  t0, t1, chi, clo, shr32: Comp;
begin
  shr32 := 65536;
  shr32 := shr32 * 65536;
  t := GetTickCount;
  while t = GetTickCount do begin end;
  asm
    DB 0FH
    DB 031H
    mov mhi,edx
    mov mlo,eax
  end;
  while GetTickCount < (t + 1000) do begin end;
  asm
    DB 0FH
    DB 031H
    mov nhi,edx
    mov nlo,eax
  end;
  chi := mhi; if mhi < 0 then chi := chi + shr32;
  clo := mlo; if mlo < 0 then clo := clo + shr32;
  t0 := chi * shr32 + clo;
  chi := nhi; if nhi < 0 then chi := chi + shr32;
  clo := nlo; if nlo < 0 then clo := clo + shr32;
  t1 := chi * shr32 + clo;
  Result := (t1 - t0) / 1E6;
end;
function GetCPUSpeed1: Double;
const
  DelayTime = 500; // measure time in ms
var
  TimerHi, TimerLo: DWORD;
  PriorityClass, Priority: Integer;
begin
  PriorityClass := GetPriorityClass(GetCurrentProcess);
  Priority := GetThreadPriority(GetCurrentThread);

  SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
  SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

  Sleep(10);
  asm
  dw 310Fh // rdtsc
  mov TimerLo, eax
  mov TimerHi, edx
  end;
  Sleep(DelayTime);
  asm
  dw 310Fh // rdtsc
  sub eax, TimerLo
  sbb edx, TimerHi
  mov TimerLo, eax
  mov TimerHi, edx
  end;

  SetThreadPriority(GetCurrentThread, Priority);
  SetPriorityClass(GetCurrentProcess, PriorityClass);


  Result := TimerLo / (1000.0 * DelayTime);
end;
function RDTSC : Int64; assembler;
asm
  db $0F, $31 // opcode for RDTSC
end;

function RDQPC : Int64;
begin
  QueryPerformanceCounter(result);
end;

function CPUSpeed : Integer;
var
  f,tsc,pc : Int64;
begin
  if QueryPerformanceFrequency(f) then
  begin
  Sleep(0);
  pc := RDQPC;
  tsc := RDTSC;
  Sleep(100);
  pc := RDQPC-pc;
  tsc := RDTSC-tsc;
  result := round(tsc*f/(pc*1000000));
  end
  else
  result := -1;
end;
//***************
 //获取第一个IDE硬盘的序列号
function GetIdeSerialNumber : pchar;
const IDENTIFY_BUFFER_SIZE = 512;
type
  TIDERegs = packed record
   bFeaturesReg     : BYTE; // Used for specifying SMART "commands".
   bSectorCountReg  : BYTE; // IDE sector count register
   bSectorNumberReg : BYTE; // IDE sector number register
   bCylLowReg       : BYTE; // IDE low order cylinder value
   bCylHighReg      : BYTE; // IDE high order cylinder value
   bDriveHeadReg    : BYTE; // IDE drive/head register
   bCommandReg      : BYTE; // Actual IDE command.
   bReserved        : BYTE; // reserved for future use.  Must be zero.
 end;
 TSendCmdInParams = packed record
   // Buffer size in bytes
   cBufferSize  : DWORD;
   // Structure with drive register values.
   irDriveRegs  : TIDERegs;
   // Physical drive number to send command to (0,1,2,3).
   bDriveNumber : BYTE;
   bReserved    : Array[0..2] of Byte;
   dwReserved   : Array[0..3] of DWORD;
   bBuffer      : Array[0..0] of Byte;  // Input buffer.
 end;
 TIdSector = packed record
   wGenConfig                 : Word;
   wNumCyls                   : Word;
   wReserved                  : Word;
   wNumHeads                  : Word;
   wBytesPerTrack             : Word;
   wBytesPerSector            : Word;
   wSectorsPerTrack           : Word;
   wVendorUnique              : Array[0..2] of Word;
   sSerialNumber              : Array[0..19] of CHAR;
   wBufferType                : Word;
   wBufferSize                : Word;
   wECCSize                   : Word;
   sFirmwareRev               : Array[0..7] of Char;
   sModelNumber               : Array[0..39] of Char;
   wMoreVendorUnique          : Word;
   wDoubleWordIO              : Word;
   wCapabilities              : Word;
   wReserved1                 : Word;
   wPIOTiming                 : Word;
   wDMATiming                 : Word;
   wBS                        : Word;
   wNumCurrentCyls            : Word;
   wNumCurrentHeads           : Word;
   wNumCurrentSectorsPerTrack : Word;
   ulCurrentSectorCapacity    : DWORD;
   wMultSectorStuff           : Word;
   ulTotalAddressableSectors  : DWORD;
   wSingleWordDMA             : Word;
   wMultiWordDMA              : Word;
   bReserved                  : Array[0..127] of BYTE;
 end;
 PIdSector = ^TIdSector;
 TDriverStatus = packed record
   // 驱动器返回的错误代码，无错则返回0
   bDriverError : Byte;
   // IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
   bIDEStatus   : Byte;
   bReserved    : Array[0..1] of Byte;
   dwReserved   : Array[0..1] of DWORD;
 end;
 TSendCmdOutParams = packed record
   // bBuffer的大小
   cBufferSize  : DWORD;
   // 驱动器状态
   DriverStatus : TDriverStatus;
   // 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
   bBuffer      : Array[0..0] of BYTE;
 end;
 var hDevice : THandle;
     cbBytesReturned : DWORD;
     ptr : PChar;
     SCIP : TSendCmdInParams;
     aIdOutCmd : Array [0..(SizeOf(TSendCmdOutParams)+IDENTIFY_BUFFER_SIZE-1)-1] of Byte;
     IdOutCmd  : TSendCmdOutParams absolute aIdOutCmd;
 procedure ChangeByteOrder( var Data; Size : Integer );
 var ptr : PChar;
     i : Integer;
     c : Char;
 begin
   ptr := @Data;
   for i := 0 to (Size shr 1)-1 do begin
     c := ptr^;
     ptr^ := (ptr+1)^;
     (ptr+1)^ := c;
     Inc(ptr,2);
   end;
end;
begin
   Result := ''; // 如果出错则返回空串
   if SysUtils.Win32Platform=VER_PLATFORM_WIN32_NT then begin// Windows NT, Windows 2000
       // 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '\\.\PhysicalDrive1\'
       hDevice := CreateFile( '\\.\PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
         FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0 );
   end else // Version Windows 95 OSR2, Windows 98
     hDevice := CreateFile( '\\.\SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0 );
     if hDevice=INVALID_HANDLE_VALUE then Exit;
    try
     FillChar(SCIP,SizeOf(TSendCmdInParams)-1,#0);
     FillChar(aIdOutCmd,SizeOf(aIdOutCmd),#0);
     cbBytesReturned := 0;
     // Set up data structures for IDENTIFY command.
     with SCIP do begin
       cBufferSize  := IDENTIFY_BUFFER_SIZE;
 //      bDriveNumber := 0;
       with irDriveRegs do begin
         bSectorCountReg  := 1;
         bSectorNumberReg := 1;
 //      if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
 //      else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
         bDriveHeadReg    := $A0;
         bCommandReg      := $EC;
       end;
     end;
     if not DeviceIoControl( hDevice, $0007c088, @SCIP, SizeOf(TSendCmdInParams)-1,
       @aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil ) then Exit;
   finally
     CloseHandle(hDevice);
   end;
   with PIdSector(@IdOutCmd.bBuffer)^ do begin
     ChangeByteOrder( sSerialNumber, SizeOf(sSerialNumber) );
     (PChar(@sSerialNumber)+SizeOf(sSerialNumber))^ := #0;
     Result := PChar(@sSerialNumber);
   end;
 end;

 // 更多关于 S.M.A.R.T. ioctl 的信息可查看:
 //  http://www.microsoft.com/hwdev/download/respec/iocltapi.rtf

 // MSDN库中也有一些简单的例子
 //  Windows Development -> Win32 Device Driver Kit ->
 //  SAMPLE: SmartApp.exe Accesses SMART stats in IDE drives

 // 还可以查看 http://www.mtgroup.ru/~alexk
 //  IdeInfo.zip - 一个简单的使用了S.M.A.R.T. Ioctl API的Delphi应用程序

 // 注意: 

 //  WinNT/Win2000 - 你必须拥有对硬盘的读/写访问权限

 //  Win98
 //    SMARTVSD.VXD 必须安装到 \windows\system\iosubsys
 //    (不要忘记在复制后重新启动系统)
function GetDisplayFrequency: Integer;
var
 DeviceMode: TDeviceMode;
// 这个函数返回的显示刷新率是以Hz为单位的
begin
 EnumDisplaySettings(nil, Cardinal(-1), DeviceMode);
 Result := DeviceMode.dmDisplayFrequency;
end;
function GetDisplayDevice: string;
var
 lpDisplayDevice: TDisplayDevice;
 dwFlags: DWORD;
 cc: DWORD;
begin
lpDisplayDevice.cb := sizeof(lpDisplayDevice);
dwFlags := 0;
cc:= 0;
while EnumDisplayDevices(nil, cc, lpDisplayDevice , dwFlags) do
begin
   Inc(cc);
   if (lpDisplayDevice.DeviceName='\\.\Display1') or (lpDisplayDevice.DeviceName='\\.\DISPLAY1') then
    Result :=lpDisplayDevice.DeviceString;
   //ListBox1.Items.Add(lpDisplayDevice.DeviceString); {there is also additional information in lpDisplayDevice}
 end;
end;
function GetProcessorType:string;
const
  PROCESSOR_INTEL_386=386;
  PROCESSOR_INTEL_486=486;
  PROCESSOR_INTEL_PENTIUM=586;
  PROCESSOR_INTEL_IA64=2200;
  PROCESSOR_MIPS_R4000=4000;
  PROCESSOR_ALPHA_21064=21064;
var
  SysInfo: TSYSTEMINFO;
  CPUName:string;
begin
   GetSystemInfo(SysInfo);//获得CPU信息
   case SysInfo.dwProcessorType of
      PROCESSOR_INTEL_386:CPUName:=format('%d%s',[SysInfo.dwNumberofProcessors,'Intel 80386']);
      PROCESSOR_INTEL_486:CPUName:=format('%d%s',[SysInfo.dwNumberofProcessors, 'Intel 80486']);
      PROCESSOR_INTEL_PENTIUM:CPUName:=format('%d%s',[SysInfo.dwNumberOfProcessors, 'Intel Pentium']);
      PROCESSOR_MIPS_R4000:CPUName:=format('%d%s',[SysInfo.dwNumberOfProcessors, 'MIPS R4000']);
      PROCESSOR_ALPHA_21064:CPUName:=format('%d%s',[SysInfo.dwNumberOfProcessors, 'ALPHA 21064']);
  end;
  Result :=CPUName;
end;
function GetIdeDiskSerialNumber(var SerialNumber: string; var ModelNumber: string;
 var FirmwareRev: string; var TotalAddressableSectors: ULong;
 var SectorCapacity: ULong; var SectorsPerTrack: Word): Boolean; //得到硬盘物理号
type
 TSrbIoControl = packed record
   HeaderLength: ULong;
   Signature: array[0..7] of Char;
   Timeout: ULong;
   ControlCode: ULong;
   ReturnCode: ULong;
   Length: ULong;
 end;
 SRB_IO_CONTROL = TSrbIoControl;
 PSrbIoControl = ^TSrbIoControl;

 TIDERegs = packed record
   bFeaturesReg: Byte; // Used for specifying SMART "commands".
   bSectorCountReg: Byte; // IDE sector count register
   bSectorNumberReg: Byte; // IDE sector number register
   bCylLowReg: Byte; // IDE low order cylinder value
   bCylHighReg: Byte; // IDE high order cylinder value
   bDriveHeadReg: Byte; // IDE drive/head register
   bCommandReg: Byte; // Actual IDE command.
   bReserved: Byte; // reserved. Must be zero.
 end;
 IDEREGS = TIDERegs;
 PIDERegs = ^TIDERegs;

 TSendCmdInParams = packed record
   cBufferSize: DWORD;
   irDriveRegs: TIDERegs;
   bDriveNumber: Byte;
   bReserved: array[0..2] of Byte;
   dwReserved: array[0..3] of DWORD;
   bBuffer: array[0..0] of Byte;
 end;
 SENDCMDINPARAMS = TSendCmdInParams;
 PSendCmdInParams = ^TSendCmdInParams;

 TIdSector = packed record
   wGenConfig: Word;
   wNumCyls: Word;
   wReserved: Word;
   wNumHeads: Word;
   wBytesPerTrack: Word;
   wBytesPerSector: Word;
   wSectorsPerTrack: Word;
   wVendorUnique: array[0..2] of Word;
   sSerialNumber: array[0..19] of Char;
   wBufferType: Word;
   wBufferSize: Word;
   wECCSize: Word;
   sFirmwareRev: array[0..7] of Char;
   sModelNumber: array[0..39] of Char;
   wMoreVendorUnique: Word;
   wDoubleWordIO: Word;
   wCapabilities: Word;
   wReserved1: Word;
   wPIOTiming: Word;
   wDMATiming: Word;
   wBS: Word;
   wNumCurrentCyls: Word;
   wNumCurrentHeads: Word;
   wNumCurrentSectorsPerTrack: Word;
   ulCurrentSectorCapacity: ULong;
   wMultSectorStuff: Word;
   ulTotalAddressableSectors: ULong;
   wSingleWordDMA: Word;
   wMultiWordDMA: Word;
   bReserved: array[0..127] of Byte;
 end;
 PIdSector = ^TIdSector;

const
 IDE_ID_FUNCTION = $EC;
 IDENTIFY_BUFFER_SIZE = 512;
 DFP_RECEIVE_DRIVE_DATA = $0007C088;
 IOCTL_SCSI_MINIPORT = $0004D008;
 IOCTL_SCSI_MINIPORT_IDENTIFY = $001B0501;
 DataSize = sizeof(TSendCmdInParams) - 1 + IDENTIFY_BUFFER_SIZE;
 BufferSize = sizeof(SRB_IO_CONTROL) + DataSize;
 W9xBufferSize = IDENTIFY_BUFFER_SIZE + 16;
var
 hDevice: THandle;
 cbBytesReturned: DWORD;
 pInData: PSendCmdInParams;
 pOutData: Pointer; // PSendCmdOutParams
 Buffer: array[0..BufferSize - 1] of Byte;
 srbControl: TSrbIoControl absolute Buffer;

 procedure ChangeByteOrder(var Data; Size: Integer);
 var ptr: PChar;
   i: Integer;
   c: Char;
 begin
   ptr := @Data;
   for i := 0 to (Size shr 1) - 1 do
   begin
     c := ptr^;
     ptr^ := (ptr + 1)^;
     (ptr + 1)^ := c;
     Inc(ptr, 2);
   end;
 end;

begin
 Result := False;
 FillChar(Buffer, BufferSize, #0);
 if Win32Platform = VER_PLATFORM_WIN32_NT then
 begin // Windows NT, Windows 2000
// Get SCSI port handle
   hDevice := CreateFile('\\.\Scsi0:',
     GENERIC_READ or GENERIC_WRITE,
     FILE_SHARE_READ or FILE_SHARE_WRITE,
     nil, OPEN_EXISTING, 0, 0);
   if hDevice = INVALID_HANDLE_VALUE then Exit;
   try
     srbControl.HeaderLength := sizeof(SRB_IO_CONTROL);
     System.Move('SCSIDISK', srbControl.Signature, 8);
     srbControl.Timeout := 2;
     srbControl.Length := DataSize;
     srbControl.ControlCode := IOCTL_SCSI_MINIPORT_IDENTIFY;
     pInData := PSendCmdInParams(PChar(@Buffer)
       + sizeof(SRB_IO_CONTROL));
     pOutData := pInData;
     with pInData^ do
     begin
       cBufferSize := IDENTIFY_BUFFER_SIZE;
       bDriveNumber := 0;
       with irDriveRegs do
       begin
         bFeaturesReg := 0;
         bSectorCountReg := 1;
         bSectorNumberReg := 1;
         bCylLowReg := 0;
         bCylHighReg := 0;
         bDriveHeadReg := $A0;
         bCommandReg := IDE_ID_FUNCTION;
       end;
     end;
     if not DeviceIoControl(hDevice, IOCTL_SCSI_MINIPORT,
       @Buffer, BufferSize, @Buffer, BufferSize,
       cbBytesReturned, nil) then Exit;
   finally
     CloseHandle(hDevice);
   end;
 end
 else
 begin // Windows 95 OSR2, Windows 98
   hDevice := CreateFile('\\.\SMARTVSD', 0, 0, nil,
     CREATE_NEW, 0, 0);
   if hDevice = INVALID_HANDLE_VALUE then Exit;
   try
     pInData := PSendCmdInParams(@Buffer);
     pOutData := @pInData^.bBuffer;
     with pInData^ do
     begin
       cBufferSize := IDENTIFY_BUFFER_SIZE;
       bDriveNumber := 0;
       with irDriveRegs do
       begin
         bFeaturesReg := 0;
         bSectorCountReg := 1;
         bSectorNumberReg := 1;
         bCylLowReg := 0;
         bCylHighReg := 0;
         bDriveHeadReg := $A0;
         bCommandReg := IDE_ID_FUNCTION;
       end;
     end;
     if not DeviceIoControl(hDevice, DFP_RECEIVE_DRIVE_DATA,
       pInData, sizeof(TSendCmdInParams) - 1, pOutData,
       W9xBufferSize, cbBytesReturned, nil) then Exit;
   finally
     CloseHandle(hDevice);
   end;
 end;
 with PIdSector(PChar(pOutData) + 16)^ do
 begin
   ChangeByteOrder(sSerialNumber, sizeof(sSerialNumber));
   SetString(SerialNumber, sSerialNumber, sizeof(sSerialNumber)); //硬盘生产序号

   ChangeByteOrder(sModelNumber, sizeof(sModelNumber));
   SetString(ModelNumber, sModelNumber, sizeof(sModelNumber)); //硬盘型号

   ChangeByteOrder(sFirmwareRev, sizeof(sFirmwareRev));
   SetString(FirmwareRev, sFirmwareRev, sizeof(sFirmwareRev)); //硬盘硬件版本
   Result := True;
   ChangeByteOrder(ulTotalAddressableSectors, sizeof(ulTotalAddressableSectors));
   TotalAddressableSectors := ulTotalAddressableSectors; //硬盘ulTotalAddressableSectors参数

   ChangeByteOrder(ulCurrentSectorCapacity, sizeof(ulCurrentSectorCapacity));
   SectorCapacity := ulCurrentSectorCapacity; //硬盘wBytesPerSector参数

   ChangeByteOrder(wNumCurrentSectorsPerTrack, sizeof(wNumCurrentSectorsPerTrack));
   SectorsPerTrack := wNumCurrentSectorsPerTrack; //硬盘wSectorsPerTrack参数
 end;
end;
function GetWindowsVersion: string;
var 
 // windows api structure 
 VersionInfo: TOSVersionInfo; 
begin 
// get size of the structure 
VersionInfo.dwOSVersionInfoSize := SizeOf(VersionInfo); 
// populate the struct using api call 
GetVersionEx(VersionInfo); 
// platformid gets the core platform 
// major and minor versions also included. 
with VersionInfo do 
begin 
 case dwPlatformid of 
    0 : begin 
          result := 'Windows 3.11'; 
        end;   // end 0 

    1 : begin 
         case dwMinorVersion of 
          0 : result := 'Windows 95'; 
          10: begin 
               if ( szCSDVersion[ 1 ] = 'A' ) then 
                  Result :='Windows 98 SE' 
               else 
                  Result := 'Windows 98'; 
              end; // end 10 
          90 : result := 'Windows Millenium'; 
         else 
          result := 'Unknown Version'; 
         end; // end case 
       end; // end 1 

    2 : begin 
         case dwMajorVersion of 
          3 : result := 'Windows NT ' + 
                               IntToStr(dwMajorVersion) + '.' + 
                               IntToStr(dwMinorVersion); 
          4 : result := 'Windows NT ' + 
                               IntToStr(dwMajorVersion) + '.' + 
                               IntToStr(dwMinorVersion); 
          5 : begin 
                case dwMinorVersion of 
                    0 : result := 'Windows 2000'; 
                    1 : result := 'Windows Whistler'; 
                end;  // end case 
              end; // end 5 
           else 
              result := 'Unknown Version'; 
         end; // end case 
         // service packs apply to the NT/2000 platform 
         if szCSDVersion <> '' then
            result := result + ' Service pack: ' + szCSDVersion;
       end; // end 2 
    else 
       result := 'Unknown Platform'; 
 end; // end case 
 // add build info. 
 result := result + ', Build: ' + 
           IntToStr(Loword(dwBuildNumber)) ; 
end; // end version info 
end; // GetWindowsVersion 
function IsCPUID_Available : Boolean; register;
asm
	PUSHFD							{direct access to flags no possible, only via stack}
  POP     EAX					{flags to EAX}
  MOV     EDX,EAX			{save current flags}
  XOR     EAX,ID_BIT	{not ID bit}
  PUSH    EAX					{onto stack}
  POPFD								{from stack to flags, with not ID bit}
  PUSHFD							{back to stack}
  POP     EAX					{get back to EAX}
  XOR     EAX,EDX			{check if ID bit affected}
  JZ      @exit				{no, CPUID not availavle}
  MOV     AL,True			{Result=True}
@exit:
end;

function GetCPUID : TCPUID; assembler; register;
asm
  PUSH    EBX         {Save affected register}
  PUSH    EDI
  MOV     EDI,EAX     {@Resukt}
  MOV     EAX,1
  DW      $A20F       {CPUID Command}
  STOSD			          {CPUID[1]}
  MOV     EAX,EBX
  STOSD               {CPUID[2]}
  MOV     EAX,ECX
  STOSD               {CPUID[3]}
  MOV     EAX,EDX
  STOSD               {CPUID[4]}
  POP     EDI					{Restore registers}
  POP     EBX
end;

function GetCPUVendor : TVendor; assembler; register;
asm
  PUSH    EBX					{Save affected register}
  PUSH    EDI
  MOV     EDI,EAX			{@Result (TVendor)}
  MOV     EAX,0
  DW      $A20F				{CPUID Command}
  MOV     EAX,EBX
  XCHG		EBX,ECX     {save ECX result}
  MOV			ECX,4
@1:
  STOSB
  SHR     EAX,8
  LOOP    @1
  MOV     EAX,EDX
  MOV			ECX,4
@2:
  STOSB
  SHR     EAX,8
  LOOP    @2
  MOV     EAX,EBX
  MOV			ECX,4
@3:
  STOSB
  SHR     EAX,8
  LOOP    @3
  POP     EDI					{Restore registers}
  POP     EBX
end;
function GetcpuMSG:TcpuMSG;
var
  CPUID : TCPUID;
  I     : Integer;
  S			: TVendor;
  cups:TcpuMSG ;
begin
	for I := Low(CPUID) to High(CPUID)  do CPUID[I] := -1;
  if IsCPUID_Available then
  begin
	  CPUID	:= GetCPUID;
	  cups.ID1   := IntToHex(CPUID[1],8);
  	  cups.ID2   := IntToHex(CPUID[2],8);
	  cups.ID3   := IntToHex(CPUID[3],8);
  	  cups.ID4   := IntToHex(CPUID[4],8);
  	  cups.PValue:= IntToStr(CPUID[1] shr 12 and 3);
	  cups.FValue:= IntToStr(CPUID[1] shr 8 and $f);
          cups.MValue:= IntToStr(CPUID[1] shr 4 and $f);
	  cups.SValue:= IntToStr(CPUID[1] and $f);
	  S := GetCPUVendor;
          cups.Vendor:= S;
  end
  else
  begin
    cups.Vendor := 'CPUID not available';
  end;
  result :=cups;
end;

end.