computerinfo.pas

木马源程序,供大家研究

    uKeMaximumIncrement: ULONG;

    uPageSize: ULONG;

    uMmNumberOfPhysicalPages: ULONG;

    uMmLowestPhysicalPage: ULONG;

    uMmHighestPhysicalPage: ULONG;

    uAllocationGranularity: ULONG;

    pLowestUserAddress: Pointer;

    pMmHighestUserAddress: Pointer;

    uKeActiveProcessors: ULONG;

    bKeNumberProcessors: Byte;

    bUnknown2: Byte;

    wUnknown3: WORD;

  end;

  TSYSTEM_PERFORMANCE_INFORMATION = record

    liIdleTime: LARGE_INTEGER;

    dwSpare: array[0..75] of DWORD;

  end;

  TSYSTEM_TIME_INFORMATION = record

    liKeBootTime: LARGE_INTEGER;

    liKeSystemTime: LARGE_INTEGER;

    liExpTimeZoneBias: LARGE_INTEGER;

    uCurrentTimeZoneId: ULONG;

    dwReserved: DWORD;

  end;

  PROCNTQSI = function(

    aSystemInformationClass: UINT;      // information type

    var SystemInformation;              // pointer to buffer

    SystemInformationLength: ULONG;     // buffer size in bytes

    var ReturnLength: ULONG): LongInt;  // pointer to a 32-bit

    stdcall;                            // variable that receives


var

  NtQuerySystemInformation: PROCNTQSI;

  _EAX,

  _EBX,

  _ECX,

  _EDX: Integer;

  aBulkData: Packed array[0..31] of byte;

  (*!~it had to be here, do not move after funct declaration*)

const

  _cpuType : Byte = 0;


function ExecuteCPUIDPtr(

  const nLevel:Integer;   //第几个CPU

  var eax, ebx, ecx, edx : pointer  //返回四个寄存器的值

  ):Integer; stdcall; //返回总有的CPU个数

const

  _cpuTypeBit = 12;

  _PSNBitMask = $200000;

asm

  @@Begin:

    cmp nLevel, 3            // Cyrix workaround:

    jnz @@CyrixPass          // PSN-bit mus be enabled

    pushfd                   // no way to turn it back (off) ;)

    pop EAX                  // if you want to do so

    or EAX, _PSNBitMask      // pushfd at begin and popfd at end

    push EAX                 // beware of lost of flow-control

    popfd

  @@CyrixPass:

    cmp nLevel, 2

    jnz @@Synchronized

  @@MPCheck:                 // Multi Processor Check Synchronicity

                            // Differentiate only primary & non-primary
    mov EAX,1

    dw $A20F                // execute service 1 call

    shr EAX, _cpuTypeBit     // extract cpuType

    and AL, 3                // validate bit-0 and bit-1

    cmp AL, _cpuType         // compare wih previous result

    mov _cpuType, AL         // save current value

    loopnz @@MPCheck

  @@Synchronized:

    mov EAX, nLevel

    dw $A20F

    push EAX

    mov EAX, [&ecx]          // var argument is REALLY a pointer-

    mov [EAX], ECX           // load it first to register & then

    mov EAX, [&edx]          // you can get the value it's refers to

    mov [EAX], EDX

    mov EAX, [&ebx]

    mov [EAX], EBX

    pop EAX

    push EBX

    mov EBX, [&eax]

    mov [EBX], EAX

    pop EBX

    cmp nLevel, 0             // is it a level 0 Query?

    jnz @@End

    push EAX                 // save eax result

    shr EAX, _cpuTypeBit     // extract cpuType

    and AL, 3                // validate bit-0 and bit-1

    mov _cpuType, AL

    pop EAX

  @@End:

    mov dword ptr aBulkData, EAX       // save all result

    mov dword ptr aBulkData[+4], EBX   // maybe used sometime

    mov dword ptr aBulkData[+8], ECX   //

    mov dword ptr aBulkData[+12], EDX  //

    mov @Result, EAX                   // done.

end;

function ExecuteCPUID(const nLevel:Integer;

  var eax, ebx, ecx, edx:Integer):Integer;

begin

  Result := ExecuteCPUIDPtr(nLevel, pointer(eax), pointer(ebx),

    pointer(ecx), pointer(edx));

end;

function GetCPUVendorStr(nLevel: Integer): String;

begin

  ExecuteCPUID(nLevel, _EAX, _EBX, _ECX, _EDX);

  SetLength(Result, 4);

  move(_EBX, Result[1], 4);

end;

function GetCPUVendor(nLevel: Integer): TCPUVendor;

var

  Str : string;

begin

  Str := GetCPUVendorStr(0);

  for Result := Low(TCPUVendor) To high(TCPUVendor) do

    if Pos(Str, CPUVendorSigns[Result]) = 1 then Break;

end;

function GetCPUType(nLevel: Integer): TCPUType;

begin

  ExecuteCPUID(nLevel, _EAX, _EBX, _ECX, _EDX);

  Result := TCPUType((_EAX shr 12) and $03);

end;

function GetCPUName(nLevel: Integer): String;

const

  I486=4;

  I586=5;

  I686=6;

  Itanium=$F;

  NOFAMILY='(unknown cpu-family)';

  NOMODEL='(unknown cpu-model)';

var

  cmodel, cfamily : Integer;

begin

  ExecuteCPUID(nLevel, _EAX, _EBX, _ECX, _EDX);

  cfamily := (_EAX shr 8) and $0F;

  cmodel  := (_EAX shr 4) and $0F;

  case GetCPUVendor(nLevel) of

    vnIntel:

    (*!~英特尔*)

      case cfamily of

        I486:

          case cmodel of

            0: Result :='i486 DX 25/33';

            1: Result :='i486 DX 50';

            2: Result :='i486 SX';

            3: Result :='i486 DX2 / i487';

            4: Result :='i486 SL';

            5: Result :='i486 SX2';

            7: Result :='i486 DX2-WB';

            8: Result :='i486 DX4';

            9: Result :='i486 DX4-WB';

            else Result :='i486 '+NOMODEL;

          end;

        I586:

          case cmodel of

            0: Result :='P5 A-Step';

            1: Result :='Pentium 60/66';

            2: Result :='Pentium 75-200';

            3: Result :='P24T OverDrive';

            4: Result :='Pentium MMX 166/200';

            5: Result :='P54C';

            7: Result :='P55C 0.25 micron';

            else Result :='Pentium '+NOMODEL;

          end;

        I686:

          case cmodel of

            0: Result :='P6 A-Step';

            1: Result :='Pentium Pro';

            3: Result :='PII model 3 (0.28u)';

            5: Result :='PII model 5 (0.25u),';

            6: Result :='Celeron model 6';

            7: Result :='PIII model 7 (0.25u)';

            8: Result :='PIII/Xeon model 8 (0.18u) 256KB L2 Cache';

            11: Result :='Celeron III model 11 (0.13u) 256B L2 Cache';

            $A: Result :='PIII Xeon model A 1/2 MB L2 Cache';

            else Result :='Pentium Pro'+NOMODEL;

          end;

        Itanium: Result  :='Itanium IA-64';

        else Result  := NOMODEL;

      end;

    vnAMD:

    (*!~AMD*)

      case cfamily of

        I486:

          case cmodel of

            3: Result :='80486 DX2';

            7: Result :='80486 DX2 WB';

            8: Result :='80486 DX4';

            9: Result :='80486 DX4 WB';

            $E: Result :='5x86';

            $F: Result :='5x86 WB';

            else Result :='4x86 '+NOMODEL;

          end;

        I586:

          case cmodel of

            0: Result :='SSA5 PR-75/90/100)';

            1: Result :='5K86 PR-120/133';

            2: Result :='5K86 PR-166';

            3: Result :='5K86 PR-200';

            6: Result :='K6 0.3 micron';

            7: Result :='K6 0.25 micron';

            8: Result :='K6-II';

            9: Result :='K6-III';

            else Result :='K5/K6 '+NOMODEL;

          end;

        I686:

          case cmodel of

            1: Result :='K7 0.25u';

            2: Result :='K7 0.18u';

            3: Result :='K7 0.18u 64KB L2 Cache';

            4: Result :='K7 0.18u 256KB L2 Cache';

            else Result :='K7 '+NOMODEL;

          end;

        else Result :=NOMODEL;

      end;

    vnCyrix:

      case cfamily of

        I486:

          case cmodel of

            4: Result :='Media GX/GXm';

            9: Result :='5x86';

            else Result :='5x86 '+NOMODEL;

          end;

        I586:

          case cmodel of

            2: Result :='M1';

            4: Result :='Media GX/GXm';

            else Result :='M1 '+NOMODEL;

          end;

        I686:

          case cmodel of

            0: Result :='M2';

            5: Result :='III';

            else Result :='M2 '+NOMODEL;

          end;

        else Result :=NOMODEL;

      end;

    vnIDT:

      case cfamily of

        I486:

          case cmodel of

            0: Result :='x486';

            else Result :='x486 '+NOMODEL;

          end;

        I586:

          case cmodel of

            4: Result :='C6';

            8: Result :='C2';

            9: Result :='C3';

            else Result :='C6 '+NOMODEL;

          end;

        I686:

          case cmodel of

            0: Result :='C7';

            else Result :='C7 '+NOMODEL;

          end;

        else Result :=NOMODEL;

      end;

    vnNexGen:

      case cfamily of

        I486:

          case cmodel of

            0: Result :='nx486'

            else Result :='nx486 '+NOMODEL;

          end;

        I586:

          case cmodel of

            0: Result :='nx586 / nx586FPU';

            else Result :='nx586 '+NOMODEL;

          end;

        I686:

          case cmodel of

            0: Result :='nx686';

            else Result :='nx686'+NOMODEL;

          end;

        else Result :=NOMODEL;

      end;

    vnUMC:

      case cfamily of

        I486:

          case cmodel of

            1: Result :='U5D';

            2: Result :='U5S';

            else Result :='U5-S/D '+NOMODEL;

          end;

        I586:

          case cmodel of

            0: Result :='x586';

            else Result :='x586 '+NOMODEL;

          end;

        I686:

          case cmodel of

            0: Result :='x686';

            else Result :='x686'+NOMODEL;

          end;

        else Result :=NOMODEL;

      end;

    vnRise:

      case cfamily of

        I486:

          case cmodel of

            0: Result :='mP5'

            else Result :='mP5 '+NOMODEL;

          end;

        I586:

          case cmodel of

            0: Result :='mP6 0.25u';

            2: Result :='mP6 0.18u';

            else Result :='mP6 '+NOMODEL;

          end;

        I686:

          case cmodel of

            0: Result :='x686';

            else Result :='x686'+NOMODEL;

          end;

        else Result :=NOMODEL;

      end;

  end;

  Result := CPUVendorName[GetCPUVendor(nLevel)]+' '+Result;

end;

function GetCPUFeature(nLevel : Integer): TCPUFeatureSet;

var

  Feature: TCPUFeature;

begin

  Result := [];

  ExecuteCPUID(nLevel, _EAX, _EBX, _ECX, _EDX);

  for Feature := low(TCPUFeature) to high(TCPUFeature) do

    If _EDX and (1 shl ord(Feature)) <> 0 then

      Include(Result, Feature);

end;

function CPUFeatureToStr(Features : TCPUFeatureSet): String;

var

  Feature: TCPUFeature;

begin

  for Feature := low(TCPUFeature) to high(TCPUFeature) do

  begin

    Result := Result +

      CPUFeaturesDescription[feature]+'('+

      CPUFeaturesAbbreviation[feature]+')';

    If Feature in Features then

       Result := Result+':是'+#13#10

    else Result := Result+':否'+#13#10;

  end;

end;

function GetCPURec(nLevel : Integer): TCPURec;

const

  Key = '\HARDWARE\DESCRIPTION\System\CentralProcessor\';

begin

  with TRegistry.Create do

  begin

    try

      RootKey := HKEY_LOCAL_MACHINE;

      If OpenKey(Key+Inttostr(nLevel), False) then

      begin

        Result.ID   := ReadString('Identifier');

        Result.MHZ  := ReadInteger('~MHz');

        CloseKey;

        Result.Name := GetCPUName(nLevel);

        Result.cType := GetCPUType(nLevel);

        Result.Features := GetCPUFeature(nLevel);

        Result.Vendor := GetCPUVendor(nLevel);

        Result.FeatureStr := CPUFeatureToStr(Result.Features);

      end;

    finally