CPUSpeed - Ram - Netkort mb ind/ud

Hvilket OS har du?

jeg har me... men det ville være lidt fede hvis det sådan kunne være til mutible systemer...

og forresten en string der finder Os navn ville heller ikke skade :) .. hvis i vil have en smule flere points for det så kan jeg da smide en 10-20 oveni :)

øhh.....lige en winversion ting:

function GetWinVersion: String;
var
  VersionInfo : TOSVersionInfo;
  OSName      : String;
  SerStr      : String;
begin
VersionInfo.dwOSVersionInfoSize := SizeOf( TOSVersionInfo );
  if Windows.GetVersionEx( VersionInfo ) then
      begin
        with VersionInfo do
        begin
          case dwPlatformId of
              VER_PLATFORM_WIN32s      : OSName := \'Win32s\';
              VER_PLATFORM_WIN32_WINDOWS : OSName := \'Windows 9x\';
              VER_PLATFORM_WIN32_NT      : OSName := \'Windows NT\';
          end;
            if VersionInfo.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS then
              if VersionInfo.dwMinorVersion = 0 then
              begin
              OSName := \'Windows 95\'  ;
              end;
              if VersionInfo.dwMinorVersion = 10 then
              begin
                if versioninfo.szCSDVersion[1] = \'A\' then
                  begin
                  OSName := \'Windows 98 SE\';
                  end
                  else
                  OSName := \'Windows 98\';
                  end;
              end;
              if VersionInfo.dwMinorVersion = 90 then
                begin
                OSName := \'Windows Me\'  ;
                end;
              End;
       
            if VersionInfo.dwPlatformId = VER_PLATFORM_WIN32_NT then
            begin
              if VersionInfo.dwMajorVersion = 5 then
              begin
                if VersionInfo.dwMinorVersion = 0 then
                begin
                OSNAme := \'Windows 2000\';
                end;
                if VersionInfo.dwMinorVersion = 1 then
                OSName := \'Windows XP\';
              end;
              if VersionInfo.dwMajorVersion = 6 then
              begin
                OSName := \'Windows XP\';
              end;
              end
              else
              begin
              OSName := \'Windows NT Version \' + IntToStr( VersionInfo.dwMajorVersion ) + \'.\' + IntToStr( VersionInfo.dwMinorVersion );
              end;
            if VersionInfo.szCSDVersion <> \'\' then
            begin
              SerStr := \' (Build \' + IntToStr( VersionInfo.dwBuildNumber ) + \': \' + VersionInfo.szCSDVersion + \')\';
            end
            else
            begin
              SerStr := \' (Build \' + IntToStr( VersionInfo.dwBuildNumber ) + \')\';
            end;
          if OSName <> \'\' then
              begin
            Result := OSName + SerStr;
              end
          else
        begin
          Result := \'\';
        end;
end;

nåeh ja...jeg har da også en-eller-anden cpuspeed ting....


Function GetCpuSpeed : Real;
  Function IsCPUID_Available : Boolean;assembler;register;
  asm
    PUSHFD
    POP        EAX
    MOV        EDX,EAX
    XOR        EAX,$200000
    PUSH      EAX
    POPFD
    PUSHFD
    POP        EAX
    XOR        EAX,EDX
    JZ        @exit
    MOV        AL,true
    @exit:
  end;

  const
    Delay = 500;

    var
    TimerHi, TimerLo: Integer;
    PriorityClass, Priority: Integer;
    Begin
      Result := 0;
      if not IsCPUID_Available then exit;
      PriorityClass := GetPriorityClass(GetCurrentProcess);
      Priority := GetThreadPriority(GetCurrentThread);

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

      SleepEx(10, FALSE);

      asm
      db $0F
      db $31
      mov TimerLo, eax
      mov TimerHi, edx
      end;

      SleepEx(Delay, FALSE);

      asm
      db $0F
      db $31
      sub eax, TimerLo
      sub edx, TimerHi
      mov TimerLo, eax
      mov TimerHi, edx
      end;

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

      Result := TimerLo / (1000 * Delay);
end;

og så er der jo bare tilbage at smide den afsted som FloatToStr(GetCpuSpeed) + \' MHz\'

;)

hmm damit hvordan fanden skal man da også regne sig ud til alle de ting :(

men den cpu tig finder den ud af total cpu speed.. eller det speed der bliver brugt lige nu ...

for programmet skal enlig komme til at ligne den der er i Win NT/2000 hvor man kan se hvor meget ram der bliver brugt og er totalt og hvor meget cpu bliver brugt og er i alt :)

den cpu er da kin total cpu speed

yup, den viser hvad din cpu kan...og ikke hvad den gør :-/...

aaah .. Hvis du gerne vil vide noget om dit OS så prøv den her unit :

unit Unit2;

interface

uses
  SysUtils, Windows, Classes, Routines, Common;

type
  TTimeZone = class(TPersistent)
  private
    FStdBias: integer;
    FDayBias: integer;
    FBias: integer;
    FDisp: string;
    FStd: string;
    FDayStart: TDatetime;
    FStdStart: TDatetime;
    FDay: string;
    FMap: string;
  public
    procedure GetInfo;
    procedure Report(var sl :TStringList);
    property MapID: string read FMap;
  published
    property DisplayName: string        read FDisp      {$IFNDEF D6PLUS} write FDisp    {$ENDIF} stored False;
    property StandardName: string      read FStd      {$IFNDEF D6PLUS} write FStd      {$ENDIF} stored False;
    property DaylightName: string      read FDay      {$IFNDEF D6PLUS} write FDay      {$ENDIF} stored False;
    property DaylightStart: TDatetime  read FDayStart  {$IFNDEF D6PLUS} write FDayStart {$ENDIF} stored False;
    property StandardStart: TDatetime  read FStdStart  {$IFNDEF D6PLUS} write FStdStart {$ENDIF} stored False;
    property Bias: integer              read FBias      {$IFNDEF D6PLUS} write FBias    {$ENDIF} stored False;
    property DaylightBias: integer      read FDayBias  {$IFNDEF D6PLUS} write FDayBias  {$ENDIF} stored False;
    property StandardBias: integer      read FStdBias  {$IFNDEF D6PLUS} write FStdBias  {$ENDIF} stored False;
  end;

const
  VER_NT_WORKSTATION      = $0000001;
  VER_NT_DOMAIN_CONTROLLER = $0000002;
  VER_NT_SERVER            = $0000003;

  VER_SUITE_SMALLBUSINESS            = $0000002;
  VER_SUITE_ENTERPRISE              = $0000004;
  VER_SUITE_BACKOFFICE              = $0000008;
  VER_SUITE_COMMUNICATIONS          = $0000010;
  VER_SUITE_TERMINAL                = $0000020;
  VER_SUITE_SMALLBUSINESS_RESTRICTED = $0000040;
  VER_SUITE_EMBEDDEDNT              = $0000080;
  VER_SUITE_DATACENTER              = $0000100;


type
  POSVersionInfoEx = ^TOSVersionInfoEx;
  TOSVersionInfoEx = record
    dwOSVersionInfoSize: DWORD;
    dwMajorVersion: DWORD;
    dwMinorVersion: DWORD;
    dwBuildNumber: DWORD;
    dwPlatformId: DWORD;
    szCSDVersion: array [0..127] of Char;
    wServicePackMajor: Word;
    wServicePackMinor: Word;
    wSuiteMask: Word;
    wProductType: Byte;
    wReserved: Byte;
  end;

  TNtProductType = (ptUnknown, ptWorkStation, ptServer, ptAdvancedServer);

  TNTSuite = (suSmallBusiness, suEnterprise, suBackOffice, suCommunications, suTerminal, suSmallBusinessRestricted, suEmbeddedNT, suDataCenter);
  TNTSuites = set of TNTSuite;

  TNTSpecific = class(TPersistent)
  private
    FSPMinorVer: Word;
    FSPMajorVer: Word;
    FProduct: TNTProductType;
    FSuites: TNTSuites;
  public
    procedure GetInfo;
    procedure Report(var sl: TStringList);
    procedure Report_InstalledSuites(var sl: TStringList);
    function GetProductTypeStr(PT: TNTProductType): string;
  published
    property ProductType: TNTProductType        read FProduct  {$IFNDEF D6PLUS}  write FProduct    {$ENDIF} stored False;
    property InstalledSuites: TNTSuites        read FSuites    {$IFNDEF D6PLUS} write FSuites    {$ENDIF} stored False;
    property ServicePackMajorVersion: Word      read FSPMajorVer {$IFNDEF D6PLUS} write FSPMajorVer {$ENDIF} stored False;
    property ServicePackMinorVersion: Word      read FSPMinorVer {$IFNDEF D6PLUS} write FSPMinorVer {$ENDIF} stored False;
  end;

  TInternet = class(TPersistent)
  private
    FBrowser: string;
    FProxy: string;
    FMailClient: string;
    FCType: TConnectionType;
  public
    function GetConnTypeStr(ACType: TConnectionType): string;
    procedure GetInfo;
    procedure Report(var sl :TStringList);
  published
    property DefaultBrowser: string            read FBrowser    {$IFNDEF D6PLUS} write FBrowser    {$ENDIF} stored False;
    property DefaultMailClient: string          read FMailClient {$IFNDEF D6PLUS} write FMailClient {$ENDIF} stored False;
    property ConnectionType: TConnectionType    read FCType      {$IFNDEF D6PLUS} write FCType      {$ENDIF} stored False;
    property ProxyServer: string                read FProxy      {$IFNDEF D6PLUS} write FProxy      {$ENDIF} stored False;
  end;

  TOperatingSystem = class(TPersistent)
  private
    FBuildNumber: integer;
    FMajorVersion: integer;
    FMinorVersion: integer;
    FPlatform: string;
    FCSD: string;
    FVersion: string;
    FRegUser: string;
    FProductID: string;
    FRegOrg: string;
    FEnv: TStrings;
    FDirs: TStrings;
    FTZ: TTimeZone;
    FNTSpec: TNTSpecific;
    FProductKey: string;
    FDVD: string;
    FInternet: TInternet;
    FMode: TExceptionMode;
    FCSDEx: string;
  protected
  public
    constructor Create;
    destructor Destroy; override;
    procedure GetInfo;
    procedure Report(var sl :TStringList);
    property CSDEx :string read FCSDEx;
  published
    property ExceptionMode: TExceptionMode      read FMode                          write FMode;
    property MajorVersion :integer              read FMajorVersion {$IFNDEF D6PLUS} write FMajorVersion {$ENDIF} stored false;
    property MinorVersion :integer              read FMinorVersion {$IFNDEF D6PLUS} write FMinorVersion {$ENDIF} stored false;
    property BuildNumber :integer              read FBuildNumber  {$IFNDEF D6PLUS} write FBuildNumber  {$ENDIF} stored false;
    property Platform :string                  read FPlatform    {$IFNDEF D6PLUS} write FPlatform    {$ENDIF} stored false;
    property Version :string                    read FVersion      {$IFNDEF D6PLUS} write FVersion      {$ENDIF} stored false;
    property CSD :string                        read FCSD          {$IFNDEF D6PLUS} write FCSD          {$ENDIF} stored false;
    property ProductID :string                  read FProductID    {$IFNDEF D6PLUS} write FProductID    {$ENDIF} stored false;
    property ProductKey :string                read FProductKey  {$IFNDEF D6PLUS} write FProductKey  {$ENDIF} stored False;
    property RegisteredUser :string            read FRegUser      {$IFNDEF D6PLUS} write FRegUser      {$ENDIF} stored false;
    property RegisteredOrg :string              read FRegOrg      {$IFNDEF D6PLUS} write FRegOrg      {$ENDIF} stored false;
    property TimeZone :TTimeZone                read FTZ          {$IFNDEF D6PLUS} write FTZ          {$ENDIF} stored false;
    property Environment :TStrings              read FEnv          {$IFNDEF D6PLUS} write FEnv          {$ENDIF} stored false;
    property Folders: TStrings                  read FDirs        {$IFNDEF D6PLUS} write FDirs        {$ENDIF} stored False;
    property NTSpecific: TNTSpecific            read FNTSpec      {$IFNDEF D6PLUS} write FNTSpec      {$ENDIF} stored False;
    property DVDRegion: string                  read FDVD          {$IFNDEF D6PLUS} write FDVD          {$ENDIF} stored False;
    property Internet: TInternet                read FInternet    {$IFNDEF D6PLUS} write FInternet    {$ENDIF} stored False;
  end;

function GetVersionEx(lpVersionInformation: POSVersionInfoEx): BOOL; stdcall;

implementation

uses
  ShlObj, Registry{$IFDEF D6PLUS} ,StrUtils {$ENDIF};

function GetVersionEx; external kernel32 name \'GetVersionExA\';

{ TTimeZone }

type
  TRegTimeZoneInfo = packed record
    Bias: Longint;
    StandardBias: Longint;
    DaylightBias: Longint;
    StandardDate: TSystemTime;
    DaylightDate: TSystemTime;
  end;

function ReverseString(const AText: string): string;
var
  I: Integer;
  P: PChar;
begin
  SetLength(Result, Length(AText));
  P := PChar(Result);
  for I := Length(AText) downto 1 do
  begin
    P^ := AText[I];
    Inc(P);
  end;
end;

function GetTZDaylightSavingInfoForYear(TZ: TTimeZoneInformation; year: word;  var DaylightDate, StandardDate: TDateTime; var DaylightBias, StandardBias: longint): boolean;
begin
  Result:=false;
  try
    if (TZ.DaylightDate.wMonth <> 0) and (TZ.StandardDate.wMonth <> 0) then
    begin
      DaylightDate:=DSTDate2Date(TZ.DaylightDate,year);
      StandardDate:=DSTDate2Date(TZ.StandardDate,year);
      DaylightBias:=TZ.Bias+TZ.DaylightBias;
      StandardBias:=TZ.Bias+TZ.StandardBias;
      Result:=true;
    end;
  except
  end;
end;

function CompareSysTime(st1, st2: TSystemTime): integer;
begin
  if st1.wYear<st2.wYear then
    Result:=-1
  else
    if st1.wYear>st2.wYear then
      Result:=1
    else
      if st1.wMonth<st2.wMonth then
        Result:=-1
      else
        if st1.wMonth>st2.wMonth then
          Result:=1
        else
          if st1.wDayOfWeek<st2.wDayOfWeek then
            Result:=-1
          else
            if st1.wDayOfWeek>st2.wDayOfWeek then
              Result:=1
            else
              if st1.wDay<st2.wDay then
                Result:=-1
              else
                if st1.wDay>st2.wDay then
                  Result:=1
                else
                  if st1.wHour<st2.wHour then
                    Result:=-1
                  else
                    if st1.wHour>st2.wHour then
                      Result:=1
                    else
                      if st1.wMinute<st2.wMinute then
                        Result:=-1
                      else
                        if st1.wMinute>st2.wMinute then
                          Result:=1
                        else
                          if st1.wSecond<st2.wSecond then
                            Result:=-1
                          else
                            if st1.wSecond>st2.wSecond then
                              Result:=1
                            else
                              if st1.wMilliseconds<st2.wMilliseconds then
                                Result:=-1
                              else
                                if st1.wMilliseconds>st2.wMilliseconds then
                                  Result:=1
                                else
                                  Result:=0;
end;

function IsEqualTZ(tz1, tz2: TTimeZoneInformation): boolean;
begin
  Result:=(tz1.Bias=tz2.Bias) and(tz1.StandardBias=tz2.StandardBias) and (tz1.DaylightBias=tz2.DaylightBias) and
          (CompareSysTime(tz1.StandardDate,tz2.StandardDate)=0) and (CompareSysTime(tz1.DaylightDate,tz2.DaylightDate)=0) and
          (WideCharToString(tz1.StandardName)=WideCharToString(tz2.StandardName)) and (WideCharToString(tz1.DaylightName)=WideCharToString(tz2.DaylightName));
end;

procedure TTimeZone.GetInfo;
var
  TZKey: string;
  RTZ: TRegTimeZoneInfo;
  HomeTZ, RegTZ: TTimeZoneInformation;
  y,m,d,i: Word;
  sl: TStringList;
const
  rkNTTimeZones = {HKEY_LOCAL_MACHINE\\}\'SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\\Time Zones\';
  rk9xTimeZones = {HKEY_LOCAL_MACHINE\\}\'SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\Time Zones\';
  rkTimeZone = {HKEY_LOCAL_MACHINE\\}\'SYSTEM\\CurrentControlSet\\Control\\TimeZoneInformation\';
  rvTimeZone = \'StandardName\';
begin
  GetTimeZoneInformation(HomeTZ);
  sl:=TStringList.Create;

  with TRegistry.create do
  begin
    rootkey:=HKEY_LOCAL_MACHINE;

    if IsNT then
      TZKey:=rkNTTimeZones
    else
      TZKey:=rk9xTimeZones;

    if OpenKey(TZKey,False) then
    begin
      GetKeyNames(sl);
      CloseKey;

      for i:=0 to sl.Count-1 do
        if OpenKey(TZKey+\'\\\'+sl[i],False) then
        begin
          if GetDataSize(\'TZI\')=SizeOf(RTZ) then
          begin
            ReadBinaryData(\'TZI\',RTZ,SizeOf(RTZ));

            StringToWideChar(ReadString(\'Std\'),@RegTZ.StandardName,SizeOf(RegTZ.StandardName) div SizeOf(WideChar));
            StringToWideChar(ReadString(\'Dlt\'),@RegTZ.DaylightName,SizeOf(RegTZ.DaylightName) div SizeOf(WideChar));

            RegTZ.Bias:=RTZ.Bias;
            RegTZ.StandardBias:=RTZ.StandardBias;
            RegTZ.DaylightBias:=RTZ.DaylightBias;
            RegTZ.StandardDate:=RTZ.StandardDate;
            RegTZ.DaylightDate:=RTZ.DaylightDate;

            if IsEqualTZ(HomeTZ,RegTZ) then
            begin
              FDisp:=ReadString(\'Display\');
              try
                FMap:=ReadString(\'MapID\');
              except
                FMap:=\'\';
              end;
              Break;
            end;
          end;
          CloseKey;
        end;
    end;
    Free;
  end;
 
  FBias:=HomeTZ.Bias;
  FStd:=HomeTZ.StandardName;
  FDay:=HomeTZ.DaylightName;
  DecodeDate(Date,y,m,d);

  GetTZDaylightSavingInfoForYear(HomeTZ,y,FDayStart,FStdStart,FDayBias,FStdBias);
 
  sl.Free;
end;

procedure TTimeZone.Report(var sl: TStringList);
begin
  with sl do begin
    Add(\'[Time Zone]\');
    Add(Format(\'TimeZone=%s\',[DisplayName]));
    Add(Format(\'StdName=%s\',[DateTimeToStr(StandardStart)]));
    Add(Format(\'StdBias=%d\',[StandardBias]));
    Add(Format(\'DlghtName=%s\',[DateTimeToStr(DaylightStart)]));
    Add(Format(\'DlghtBias=%d\',[DaylightBias]));
  end;
end;


{ TOperatingSystem }

constructor TOperatingSystem.Create;
begin
  inherited;
  FEnv:=TStringList.Create;
  FDirs:=TStringList.Create;
  FTZ:=TTimeZone.Create;
  FNTSpec:=TNTSpecific.Create;
  FInternet:=TInternet.Create;
  FMode:=emMessage;
end;

destructor TOperatingSystem.Destroy;
begin
  FEnv.Free;
  FDirs.Free;
  FTZ.Free;
  FNTSpec.Free;
  FInternet.Free;
  inherited;
end;


procedure TOperatingSystem.GetInfo;
var
  OS :TOSVersionInfo;
  OK: Boolean;
  p: pchar;
  n: DWORD;
  WinH: HWND;
  s: string;
const
  rkOSInfo95 = {HKEY_LOCAL_MACHINE\\}\'SOFTWARE\\Microsoft\\Windows\\CurrentVersion\';
  rkOSInfoNT = {HKEY_LOCAL_MACHINE\\}\'SOFTWARE\\Microsoft\\Windows NT\\CurrentVersion\';
  rkSP6a = {HKEY_LOCAL_MACHINE\\}\'SOFTWARE\\Microsoft\\WindowsNT\\CurrentVersion\\Hotfix\\Q246009\';

  rvInstalled = \'Installed\';
  rvVersionName95 = \'Version\';
  rvVersionNameNT = \'CurrentType\';
  rvRegOrg = \'RegisteredOrganization\';
  rvRegOwn = \'RegisteredOwner\';
  rvProductID = \'ProductID\';
  rvProductKey = \'ProductKey\';
  rvDVD = \'DVD_Region\';

  cUserProfile = \'USERPROFILE\';
  cUserProfileReg = {HKEY_CURRENT_USER\\}\'Software\\Microsoft\\Windows\\CurrentVersion\\ProfileList\';
  cUserProfileRec = {HKEY_CURRENT_USER\\}\'SOFTWARE\\Microsoft\\Windows\\CurrentVersion\\ProfileReconciliation\';
  cProfileDir = \'ProfileDirectory\';
begin
  FDirs.Clear;
  MSafeCall(TimeZone.GetInfo,TimeZOne.Classname+\'.GetInfo\',ExceptionMode);
  MSafeCall(NTSpecific.GetInfo,NTSpecific.Classname+\'.GetInfo\',ExceptionMode);
  MSafeCall(Internet.GetInfo,Internet.Classname+\'.GetInfo\',ExceptionMode);
  ZeroMemory(@OS,SizeOf(OS));
  OS.dwOSVersionInfoSize:=SizeOf(OS);
  Windows.GetVersionEx(OS);
  FMajorVersion:=OS.dwMajorVersion;
  FMinorVersion:=OS.dwMinorVersion;
  FBuildNumber:=word(OS.dwBuildNumber);

  case OS.dwPlatformId of
    VER_PLATFORM_WIN32s        :FPlatform:=\'Windows 3.1x\';
    VER_PLATFORM_WIN32_WINDOWS :FPlatform:=\'Windows 9x\';
    VER_PLATFORM_WIN32_NT      :FPlatform:=\'Windows NT\';
  end;

  FCSD:=strpas(OS.szCSDVersion);

  FVersion:=\'\';
  FRegUser:=\'\';
  FRegOrg:=\'\';
  FProductID:=\'\';

  with TRegistry.create do
  begin
    rootkey:=HKEY_LOCAL_MACHINE;

    if IsNT then
      OK:=OpenKey(rkOSInfoNT,False)
    else
      OK:=OpenKey(rkOSInfo95,False);

    if OK then
    begin
      if isnt then
      begin
        if ValueExists(rvVersionNameNT) then
          FVersion:=ReadString(rvVersionNameNT);
      end
      else
        if ValueExists(rvVersionName95) then
          FVersion:=ReadString(rvVersionName95);

      if ValueExists(rvRegOrg) then
        FRegOrg:=ReadString(rvRegOrg);
      if ValueExists(rvRegOwn) then
        FRegUser:=ReadString(rvRegOwn);
      if ValueExists(rvProductID) then
        FProductID:=ReadString(rvProductID);
      if ValueExists(rvProductKey) then
        FProductKey:=ReadString(rvProductKey);
      if ValueExists(rvDVD) then
        FDVD:=ReadString(rvDVD);

      FDirs.Add(\'CommonFiles=\'  +ReadString(\'CommonFilesDir\'));
      FDirs.Add(\'ProgramFiles=\'  +ReadString(\'ProgramFilesDir\'));
      FDirs.Add(\'Device=\'        +ReadString(\'DevicePath\'));
      FDirs.Add(\'OtherDevice=\'  +ReadString(\'OtherDevicePath\'));
      FDirs.Add(\'Media=\'        +ReadString(\'MediaPath\'));
      FDirs.Add(\'Config=\'        +ReadString(\'ConfigPath\'));
      FDirs.Add(\'Wallpaper=\'    +ReadString(\'WallPaperDir\'));
      CloseKey;

      FCSDEx:=\'\';
      if IsNT then
      begin
        FCSDEx:=FCSD;
        if CSD=\'Service Pack 6\' then
          if OpenKey(rkSP6a,False) then
          begin
            if ValueExists(rvInstalled) then
              if ReadInteger(rvInstalled)=1 then
                FCSD:=\'Service Pack 6a\';
            CloseKey;
          end;
      end
      else
        if IsOSR2 then
          FCSDEx:=\'OSR 2\'
        else
          if IsSE then
            FCSDEx:=\'Second Edition\';
    end;
    Free;
  end;

  n:=MAX_PATH;
  p:=StrAlloc(n);

  GetWindowsDirectory(p,n);
  FDirs.Add(\'Windows=\'+StrPas(p));

  GetSystemDirectory(p,n);
  FDirs.Add(\'System=\'+StrPas(p));

  GetTempPath(n,p);
  FDirs.Add(\'Temp=\'+StrPas(p));

  StrDispose(p);

  WinH:=GetDesktopWindow;
  FDirs.Add(\'AppData=\'+GetSpecialFolder(WinH,CSIDL_APPDATA));
  FDirs.Add(\'CommonDesktopDir=\'+GetSpecialFolder(WinH,CSIDL_COMMON_DESKTOPDIRECTORY));
  FDirs.Add(\'CommonAltStartUp=\'+GetSpecialFolder(WinH,CSIDL_COMMON_ALTSTARTUP));
  FDirs.Add(\'RecycleBin=\'+GetSpecialFolder(WinH,CSIDL_BITBUCKET));
  FDirs.Add(\'CommonPrograms=\'+GetSpecialFolder(WinH,CSIDL_COMMON_PROGRAMS));
  FDirs.Add(\'CommonStartMenu=\'+GetSpecialFolder(WinH,CSIDL_COMMON_STARTMENU));
  FDirs.Add(\'CommonStartup=\'+GetSpecialFolder(WinH,CSIDL_COMMON_STARTUP));
  FDirs.Add(\'CommonFavorites=\'+GetSpecialFolder(WinH,CSIDL_COMMON_FAVORITES));
  FDirs.Add(\'Cookies=\'+GetSpecialFolder(WinH,CSIDL_COOKIES));
  FDirs.Add(\'Controls=\'+GetSpecialFolder(WinH,CSIDL_CONTROLS));
  FDirs.Add(\'Desktop=\'+GetSpecialFolder(WinH,CSIDL_DESKTOP));
  FDirs.Add(\'DesktopDir=\'+GetSpecialFolder(WinH,CSIDL_DESKTOPDIRECTORY));
  FDirs.Add(\'Favorites=\'+GetSpecialFolder(WinH,CSIDL_FAVORITES));
  FDirs.Add(\'Drives=\'+GetSpecialFolder(WinH,CSIDL_DRIVES));
  FDirs.Add(\'Fonts=\'+GetSpecialFolder(WinH,CSIDL_FONTS));
  FDirs.Add(\'History=\'+GetSpecialFolder(WinH,CSIDL_HISTORY));
  FDirs.Add(\'Internet=\'+GetSpecialFolder(WinH,CSIDL_INTERNET));
  FDirs.Add(\'InternetCache=\'+GetSpecialFolder(WinH,CSIDL_INTERNET_CACHE));
  FDirs.Add(\'NetWork=\'+GetSpecialFolder(WinH,CSIDL_NETWORK));
  FDirs.Add(\'NetHood=\'+GetSpecialFolder(WinH,CSIDL_NETHOOD));
  FDirs.Add(\'MyDocuments=\'+GetSpecialFolder(WinH,CSIDL_PERSONAL));
  FDirs.Add(\'PrintHood=\'+GetSpecialFolder(WinH,CSIDL_PRINTHOOD));
  FDirs.Add(\'Printers=\'+GetSpecialFolder(WinH,CSIDL_PRINTERS));
  FDirs.Add(\'Programs=\'+GetSpecialFolder(WinH,CSIDL_PROGRAMS));
  FDirs.Add(\'Recent=\'+GetSpecialFolder(WinH,CSIDL_RECENT));
  FDirs.Add(\'SendTo=\'+GetSpecialFolder(WinH,CSIDL_SENDTO));
  FDirs.Add(\'StartMenu=\'+GetSpecialFolder(WinH,CSIDL_STARTMENU));
  FDirs.Add(\'StartUp=\'+GetSpecialFolder(WinH,CSIDL_STARTUP));
  FDirs.Add(\'Templates=\'+GetSpecialFolder(WinH,CSIDL_TEMPLATES));
  s:=ReverseString(FDirs.Values[\'Desktop\']);
  s:=ReverseString(Copy(s,Pos(\'\\\',s)+1,255));
  FDirs.Add(\'Profile=\'+s);
  FEnv.Clear;
  GetEnvironment(FEnv);
end;

procedure TOperatingSystem.Report(var sl: TStringList);
begin
  with sl do begin
    Add(\'[Operating System]\');
    Add(Format(\'Platform=%s\',[Platform]));
    Add(Format(\'VersionName=%s\',[Version]));
    Add(Format(\'Version=%d.%d\',[MajorVersion,MinorVersion]));
    Add(Format(\'BuildNumber=%d\',[BuildNumber]));
    Add(Format(\'CSD=%s\',[CSD]));
    Add(Format(\'ProductID=%s\',[ProductID]));
    Add(Format(\'ProductKey=%s\',[ProductKey]));
    Add(Format(\'RegUser=%s\',[RegisteredUser]));
    Add(Format(\'RegOrganization=%s\',[RegisteredOrg]));
    Add(Format(\'DVDRegion=%s\',[DVDRegion]));
    NTSpecific.Report(sl);
    Add(\'[Environment]\');
    AddStrings(Environment);
    Add(\'[Folders]\');
    AddStrings(Folders);
    TimeZone.Report(sl);
    Internet.Report(sl);
  end;
end;


{ TNTSpecific }

procedure TNTSpecific.GetInfo;
var
  VersionInfo: TOSVersionInfoEx;
  OS :TOSVersionInfo;
  s: string;
const
  rkProductTypeNT = {HKEY_LOCAL_MACHINE\\}\'System\\CurrentControlSet\\Control\\ProductOptions\';
  rvProductType = \'ProductType\';
begin
  ZeroMemory(@OS,SizeOf(OS));
  OS.dwOSVersionInfoSize:=SizeOf(OS);
  Windows.GetVersionEx(OS);

  if (OS.dwPlatformId=VER_PLATFORM_WIN32_NT) and (OS.dwMajorVersion=5) then
  begin
    ZeroMemory(@VersionInfo,SizeOf(VersionInfo));
    VersionInfo.dwOSVersionInfoSize:=SizeOf(VersionInfo);

    if GetVersionEx(@VersionInfo) then
    begin
      case VersionInfo.wProductType of
        VER_NT_WORKSTATION: FProduct:=ptWorkStation;
        VER_NT_DOMAIN_CONTROLLER: FProduct:=ptAdvancedServer;
        VER_NT_SERVER: FProduct:=ptServer;
      end;

      FSuites:=[];

      if VersionInfo.wSuiteMask and VER_SUITE_SMALLBUSINESS=VER_SUITE_SMALLBUSINESS then
        FSuites:=FSuites+[suSmallBusiness];
      if VersionInfo.wSuiteMask and VER_SUITE_ENTERPRISE=VER_SUITE_ENTERPRISE then
        FSuites:=FSuites+[suEnterprise];
      if VersionInfo.wSuiteMask and VER_SUITE_BACKOFFICE=VER_SUITE_BACKOFFICE then
        FSuites:=FSuites+[suBackOffice];
      if VersionInfo.wSuiteMask and VER_SUITE_COMMUNICATIONS=VER_SUITE_COMMUNICATIONS then
        FSuites:=FSuites+[suCommunications];
      if VersionInfo.wSuiteMask and VER_SUITE_TERMINAL=VER_SUITE_TERMINAL then
        FSuites:=FSuites+[suTerminal];
      if VersionInfo.wSuiteMask and VER_SUITE_SMALLBUSINESS_RESTRICTED=VER_SUITE_SMALLBUSINESS_RESTRICTED then
        FSuites:=FSuites+[suSmallBusinessRestricted];
      if VersionInfo.wSuiteMask and VER_SUITE_EMBEDDEDNT=VER_SUITE_EMBEDDEDNT then
        FSuites:=FSuites+[suEmbeddedNT];
      if VersionInfo.wSuiteMask and VER_SUITE_DATACENTER=VER_SUITE_DATACENTER then
        FSuites:=FSuites+[suDataCenter];

      FSPMajorVer:=VersionInfo.wServicePackMajor;
      FSPMinorVer:=VersionInfo.wServicePackMinor;
    end;
  end;
  if FProduct=ptUnknown then
    with TRegistry.Create do
    begin
      if OpenKey(rkProductTypeNT,False) then
      begin
        s:=ReadString(rvProductType);
        if s=\'WinNT\' then
          FProduct:=ptWorkStation
        else
          if s=\'ServerNT\' then
            FProduct:=ptServer
          else
            if s=\'LanmanNT\' then
              FProduct:=ptAdvancedServer;
        CloseKey;
      end;
      Free;
    end;
end;

function TNTSpecific.GetProductTypeStr(PT: TNTProductType): string;
begin
  Result:=\'Unknown\';
  case PT of
    ptWorkstation: Result:=\'Workstation\';
    ptServer: Result:=\'Server\';
    ptAdvancedServer: Result:=\'Advanced Server\';
  end;
end;

procedure TNTSpecific.Report(var sl: TStringList);
begin
  with sl do
  begin
    Add(\'[NT Specific]\');

    case ProductType of
      ptUnknown        : Add(\'ProductType=Unknown\');
      ptWorkStation    : Add(\'ProductType=Workstation\');
      ptServer        : Add(\'ProductType=Server\');
      ptAdvancedServer : Add(\'ProductType=Advanced Server\');
    end;

    Report_InstalledSuites(sl);
    Add(Format(\'ServicePackMajorVersion=%d\',[ServicePackMajorVersion]));
    Add(Format(\'ServicePackMinorVersion=%d\',[ServicePackMinorVersion]));
  end;
end;

procedure TNTSpecific.Report_InstalledSuites(var sl: TStringList);
begin
  with sl do
  begin
    Add(Format(\'Microsoft Small Business Server=%d\', [integer(suSmallBusiness in InstalledSuites)]));
    Add(Format(\'Windows 2000 Advanced Server=%d\', [integer(suEnterprise in InstalledSuites)]));
    Add(Format(\'Microsoft BackOffice Components=%d\', [integer(suBackOffice in InstalledSuites)]));
    Add(Format(\'Communications=%d\', [integer(suCommunications in InstalledSuites)]));
    Add(Format(\'Terminal Services=%d\', [integer(suSmallBusiness in InstalledSuites)]));
    Add(Format(\'Microsoft Small Business Server with the restrictive client license in force=%d\', [integer(suSmallBusinessRestricted in InstalledSuites)]));
    Add(Format(\'Terminal Services=%d\', [integer(suSmallBusiness in InstalledSuites)]));
    Add(Format(\'Embedded NT=%d\', [integer(suEmbeddedNT in InstalledSuites)]));
    Add(Format(\'Windows 2000 Datacenter Server=%d\', [integer(suDataCenter in InstalledSuites)]));
  end;
end;

function TInternet.GetConnTypeStr(ACType: TConnectionType): string;
begin
  case ACType of
    ctNone  : Result:=\'None\';
    ctDialup : Result:=\'Dialup\';
    ctLAN    : Result:=\'LAN\';
  end;
end;

procedure TInternet.GetInfo;
begin
  try
    FBrowser:=GetDefaultBrowser;
  except
    FBrowser:= \'\';
  end;

  try
    FMailClient:=GetdefaultMailClient;
  except
    FMailClient := \'\';
  end;

  try
    FCType:=GetConnectionType;
  except
    FCType := ctNone;
  end;

  try
    FProxy:=GetProxyserver;
  except
    FCType := ctNone;
  end;
end;

procedure TInternet.Report(var sl: TStringList);
begin
  with sl do begin
    Add(\'[Internet]\');
    Add(Format(\'DefaultBrowser=%s\',[DefaultBrowser]));
    Add(Format(\'DefaultmailClient=%s\',[DefaultMailClient]));
    Add(Format(\'Connection=%s\',[GetConnTypeStr(ConnectionType)]));
    Add(Format(\'ProxyServer=%s\',[ProxyServer]));
  end;
end;

end.

Jens B

hvis du gerne vil vide lidt om din CPu så prøv der her :

unit Unit2;

interface

{$IFDEF VER140}
  {$DEFINE D4PLUS}
  {$DEFINE D5PLUS}
  {$DEFINE D6PLUS}
{$ENDIF}
{$IFDEF VER130}
  {$DEFINE D4PLUS}
  {$DEFINE D5PLUS}
{$ENDIF}
{$IFDEF VER120}
  {$DEFINE D4PLUS}
{$ENDIF}

uses
  SysUtils, Windows, Classes;

type
  TCPUIDResult = packed record
    EAX: Cardinal;
    EBX: Cardinal;
    ECX: Cardinal;
    EDX: Cardinal;
  end;

  TIntelCache = record
    L2Cache: Cardinal;
    CacheDescriptors: array[0..15] of Byte;
  end;

  TAMDCache = record
    DataTLB: array[0..1] of Byte;
    InstructionTLB: array[0..1] of Byte;
    L1DataCache: array[0..3] of Byte;
    L1ICache: array[0..3] of Byte;
  end;

  TCyrixCache = record
    L1CacheInfo: array[0..3] of Byte;
    TLBInfo: array[0..3] of Byte;
  end;

  TFreqInfo = record
    RawFreq: Cardinal;
    NormFreq: Cardinal;
    InCycles: Cardinal;
    ExTicks: Cardinal;
  end;

const
  { CPUID EFLAGS Id bit }
  CPUIDID_BIT = $200000;

  { CPUID execution levels }
  CPUID_MAXLEVEL: DWORD = $0;
  CPUID_VENDORSIGNATURE: DWORD = $0;
  CPUID_CPUSIGNATURE: DWORD = $1;
  CPUID_CPUFEATURESET: DWORD = $1;
  CPUID_CACHETLB: DWORD = $2;
  CPUID_CPUSERIALNUMBER: DWORD = $3;
  CPUID_MAXLEVELEX: DWORD = $80000000;
  CPUID_CPUSIGNATUREEX: DWORD = $80000001;
  CPUID_CPUMARKETNAME1: DWORD = $80000002;
  CPUID_CPUMARKETNAME2: DWORD = $80000003;
  CPUID_CPUMARKETNAME3: DWORD = $80000004;
  CPUID_LEVEL1CACHETLB: DWORD = $80000005;
  CPUID_LEVEL2CACHETLB: DWORD = $80000006;

  { CPU vendors }
  VENDOR_UNKNOWN = 0;
  VENDOR_INTEL = 1;
  VENDOR_AMD = 2;
  VENDOR_CYRIX = 3;
  VENDOR_IDT = 4;
  VENDOR_NEXGEN = 5;
  VENDOR_UMC = 6;
  VENDOR_RISE = 7;

  { Standard feature set flags }
  SFS_FPU = 0;
  SFS_VME = 1;
  SFS_DE = 2;
  SFS_PSE = 3;
  SFS_TSC = 4;
  SFS_MSR = 5;
  SFS_PAE = 6;
  SFS_MCE = 7;
  SFS_CX8 = 8;
  SFS_APIC = 9;
  SFS_SEP = 11;
  SFS_MTRR = 12;
  SFS_PGE = 13;
  SFS_MCA = 14;
  SFS_CMOV = 15;
  SFS_PAT = 16;
  SFS_PSE36 = 17;
  SFS_SERIAL = 18;
  SFS_MMX = 23;
  SFS_XSR = 24;
  SFS_SIMD = 25;

  { Extended feature set flags (duplicates removed) }
  EFS_EXMMXA = 22; { AMD Specific }
  EFS_EXMMXC = 24; { Cyrix Specific }
  EFS_3DNOW = 31;
  EFS_EX3DNOW = 30;

type
  TCPUFeatures = class(TPersistent)
  private
    FSEP: boolean;
    FMTRR: boolean;
    FMSR: boolean;
    FPSE: boolean;
    FTSC: boolean;
    FMCE: boolean;
    FMMX: boolean;
    FPAT: boolean;
    FPAE: boolean;
    FXSR: boolean;
    FVME: boolean;
    FPGE: boolean;
    FCMOV: boolean;
    FFPU: boolean;
    FCX8: boolean;
    FSIMD: Boolean;
    FMCA: boolean;
    FAPIC: boolean;
    FDE: boolean;
    FPSE36: boolean;
    FSERIAL: Boolean;
    F3DNOW: boolean;
    FEX3DNOW: Boolean;
    FEXMMX: Boolean;
  public
    CPUID: TCPUIDResult;
    procedure GetInfo;
    procedure Report(var sl: TStringList);
  published
    property _3DNOW: Boolean read F3DNOW{$IFNDEF D6PLUS} write F3DNOW{$ENDIF} stored False;
    property EX_3DNOW: Boolean read FEX3DNOW{$IFNDEF D6PLUS} write FEX3DNOW{$ENDIF} stored False;
    property EX_MMX: Boolean read FEXMMX{$IFNDEF D6PLUS} write FEXMMX{$ENDIF} stored False;
    property SIMD: Boolean read FSIMD{$IFNDEF D6PLUS} write FSIMD{$ENDIF} stored False;
    property SERIAL: Boolean read FSERIAL{$IFNDEF D6PLUS} write FSERIAL{$ENDIF} stored False;
    property XSR: Boolean read FXSR{$IFNDEF D6PLUS} write FXSR{$ENDIF} stored false;
    property MMX: Boolean read FMMX{$IFNDEF D6PLUS} write FMMX{$ENDIF} stored false;
    property PSE36: Boolean read FPSE36{$IFNDEF D6PLUS} write FPSE36{$ENDIF} stored false;
    property PAT: Boolean read FPAT{$IFNDEF D6PLUS} write FPAT{$ENDIF} stored false;
    property CMOV: Boolean read FCMOV{$IFNDEF D6PLUS} write FCMOV{$ENDIF} stored false;
    property MCA: Boolean read FMCA{$IFNDEF D6PLUS} write FMCA{$ENDIF} stored false;
    property PGE: Boolean read FPGE{$IFNDEF D6PLUS} write FPGE{$ENDIF} stored false;
    property MTRR: Boolean read FMTRR{$IFNDEF D6PLUS} write FMTRR{$ENDIF} stored false;
    property SEP: Boolean read FSEP{$IFNDEF D6PLUS} write FSEP{$ENDIF} stored false;
    property APIC: Boolean read FAPIC{$IFNDEF D6PLUS} write FAPIC{$ENDIF} stored false;
    property CX8: Boolean read FCX8{$IFNDEF D6PLUS} write FCX8{$ENDIF} stored false;
    property MCE: Boolean read FMCE{$IFNDEF D6PLUS} write FMCE{$ENDIF} stored false;
    property PAE: Boolean read FPAE{$IFNDEF D6PLUS} write FPAE{$ENDIF} stored false;
    property MSR: Boolean read FMSR{$IFNDEF D6PLUS} write FMSR{$ENDIF} stored false;
    property TSC: Boolean read FTSC{$IFNDEF D6PLUS} write FTSC{$ENDIF} stored false;
    property PSE: Boolean read FPSE{$IFNDEF D6PLUS} write FPSE{$ENDIF} stored false;
    property DE: Boolean read FDE{$IFNDEF D6PLUS} write FDE{$ENDIF} stored false;
    property VME: Boolean read FVME{$IFNDEF D6PLUS} write FVME{$ENDIF} stored false;
    property FPU: Boolean read FFPU{$IFNDEF D6PLUS} write FFPU{$ENDIF} stored false;
  end;

  TCPUCache = class(TPersistent)
  private
    FLevel2: LongInt;
    FLevel1: LongInt;
    FLevel1Data: LongInt;
    FLevel1Code: LongInt;
  public
    IntelCache: TIntelCache;
    AMDCache: TAMDCache;
    CyrixCache: TCyrixCache;
    procedure GetInfo(AVendor: DWORD);
    procedure Report(var sl: TStringList);
  published
    property L1Data: LongInt read FLevel1Data{$IFNDEF D6PLUS} write FLevel1Data{$ENDIF} stored FALSE;
    property L1Code: LongInt read FLevel1Code{$IFNDEF D6PLUS} write FLevel1Code{$ENDIF} stored FALSE;
    property Level1: LongInt read FLevel1{$IFNDEF D6PLUS} write FLevel1{$ENDIF} stored FALSE;
    property Level2: LongInt read FLevel2{$IFNDEF D6PLUS} write FLevel2{$ENDIF} stored FALSE;
  end;

  TCPU = class(TPersistent)
  private
    FFreq: integer;
    FFeatures: TCPUFeatures;
    FVendorReg: string;
    FVendorIDReg: string;
    FCount: integer;
    FFamily: integer;
    FStepping: integer;
    FModel: integer;
    FVendorID: string;
    FVendor: string;
    FTyp: DWORD;
    FLevel: DWORD;
    FCache: TCPUCache;
    FSerial: string;
    FDIV: Boolean;
    FVendorCPUID: string;
    FVendorIDCPUID: string;
    FBrand: DWORD;
    FCPUVendor: DWORD;
    FCodeName: string;
    FTrans: integer;
    FVendorEx: string;
  public
    constructor Create;
    destructor Destroy; override;
    procedure GetInfo;
    procedure Report(var sl: TStringList);

    property Vendor_Reg: string read FVendorReg{$IFNDEF D6PLUS} write FVendorReg{$ENDIF} stored false;
    property VendorID_Reg: string read FVendorIDReg{$IFNDEF D6PLUS} write FVendorIDReg{$ENDIF} stored False;
    property Vendor_CPUID: string read FVendorCPUID{$IFNDEF D6PLUS} write FVendorCPUID{$ENDIF} stored false;
    property VendorID_CPUID: string read FVendorIDCPUID{$IFNDEF D6PLUS} write FVendorIDCPUID{$ENDIF} stored False;
    property Brand: DWORD read FBrand{$IFNDEF D6PLUS} write FBrand{$ENDIF} stored False;
    property Typ: DWORD read FTyp{$IFNDEF D6PLUS} write FTyp{$ENDIF} stored False;
    property Level: DWORD read FLevel{$IFNDEF D6PLUS} write FLevel{$ENDIF} stored False;
    property CPUVendor: DWORD read FCPUVendor{$IFNDEF D6PLUS} write FCPUVendor{$ENDIF} stored False;
    property Vendor: string read FVendor{$IFNDEF D6PLUS} write FVendor{$ENDIF} stored False;
  published
    property Count: integer read FCount{$IFNDEF D6PLUS} write FCount{$ENDIF} stored false;
    property VendorEx: string read FVendorEx{$IFNDEF D6PLUS} write FVendorEx{$ENDIF} stored False;
    property VendorID: string read FVendorID{$IFNDEF D6PLUS} write FVendorID{$ENDIF} stored false;
    property Frequency: integer read FFreq{$IFNDEF D6PLUS} write FFreq{$ENDIF} stored false;
    property Family: integer read FFamily{$IFNDEF D6PLUS} write FFamily{$ENDIF} stored false;
    property Stepping: integer read FStepping{$IFNDEF D6PLUS} write FStepping{$ENDIF} stored false;
    property Model: integer read FModel{$IFNDEF D6PLUS} write FModel{$ENDIF} stored false;
    property Features: TCPUFeatures read FFeatures{$IFNDEF D6PLUS} write FFeatures{$ENDIF} stored false;
    property Cache: TCPUCache read FCache{$IFNDEF D6PLUS} write FCache{$ENDIF} stored false;
    property SerialNumber: string read FSerial{$IFNDEF D6PLUS} write FSerial{$ENDIF} stored False;
    property FDIVBug: Boolean read FDIV{$IFNDEF D6PLUS} write FDIV{$ENDIF} stored False;
    property CodeName: string read FCodeName{$IFNDEF D6PLUS} write FCodeName{$ENDIF} stored False;
    property Transistors: integer read FTrans{$IFNDEF D6PLUS} write FTrans{$ENDIF} stored False;
  end;

var
  CPUID_Level: DWORD;

implementation

uses
  Registry, INIFiles, Routines;

const
  CPUVendorIDs: array[VENDOR_INTEL..VENDOR_RISE] of string =
  (\'GenuineIntel\',
    \'AuthenticAMD\',
    \'CyrixInstead\',
    \'CentaurHauls\',
    \'NexGenDriven\',
    \'UMC UMC UMC\',
    \'RiseRiseRise\'
    );

  CPUVendorsEx: array[VENDOR_INTEL..VENDOR_RISE] of string =
  (\'Intel Corporation\',
    \'Advanced Micro Devices\',
    \'Cyrix Corporation\',
    \'IDT/Centaur\',
    \'NexGen Inc.\',
    \'United Microelectronics Corp\',
    \'Rise Technology\');

  CPUVendors: array[VENDOR_INTEL..VENDOR_RISE] of string =
  (\'Intel\',
    \'AMD\',
    \'Cyrix\',
    \'IDT\',
    \'NexGen\',
    \'UMC\',
    \'Rise\');

function GetCPUVendorID(AVendor, AFamily, AModel, ABrand, ATyp, AL2Cache, AFreq: integer; var Codename: string; var TranCount: integer): string;
begin
  case AVendor of
    VENDOR_INTEL:
      begin
        case AFamily of
          4:
            case AModel of
              0, 1:
                begin
                  Result := \'i80486DX\';
                  CodeName := \'P4\';
                  TranCount := 1250000;
                end;

              2:
                begin
                  Result := \'i80486SX\';
                  CodeName := \'P23\';
                  TranCount := 900000;
                end;

              3:
                begin
                  Result := \'i80486DX2\';
                  CodeName := \'P24\';
                  TranCount := 1250000;
                end;

              4:
                begin
                  Result := \'i80486SL\';
                  CodeName := \'P23\';
                  TranCount := 900000;
                end;

              5:
                begin
                  Result := \'i80486SX2\';
                  CodeName := \'P23\';
                  TranCount := 900000;
                end;

              7:
                begin
                  Result := \'i80486DX2WB\';
                  CodeName := \'P24\';
                  TranCount := 1250000;
                end;

              8:
                begin
                  Result := \'i80486DX4\';
                  CodeName := \'P24C\';
                  TranCount := 1600000;
                end;

              9:
                begin
                  Result := \'i80486DX4WB\';
                  CodeName := \'P24C\';
                  TranCount := 1600000;
                end;
            end;
          5:
            case AModel of
              0:
                begin
                  Result := \'Pentium\';
                  CodeName := \'P5 (0,80µm)\';
                  TranCount := 3100000;
                end;

              1, 2:
                begin
                  Result := \'Pentium\';
                  CodeName := \'P54C (0,50µm)\';
                  TranCount := 3100000;
                end;

              3:
                begin
                  Result := \'Pentium\';
                  CodeName := \'P24T\';
                  TranCount := 0;
                end;

              4:
                begin
                  Result := \'Pentium MMX\';
                  CodeName := \'P55C (0,28µm)\';
                  TranCount := 4500000;
                end;

              5:
                begin
                  Result := \'DX4\';
                  CodeName := \'\';
                  TranCount := 0;
                end;

              6:
                begin
                  Result := \'Pentium\';
                  CodeName := \'P5\';
                  TranCount := 0;
                end;

              7:
                begin
                  Result := \'Pentium\';
                  CodeName := \'P54C (0,35µm)\';
                  TranCount := 3100000;
                end;

              8:
                begin
                  Result := \'Pentium MMX (mobile)\';
                  CodeName := \'Tillamook (0,25µm)\';
                  TranCount := 4500000;
                end;
            else
              begin
                Result := \'Pentium\';
                CodeName := \'\';
                TranCount := 0;
              end;
            end;
          6: case
            AModel of
              0:
                begin
                  Result := \'Pentium Pro\';
                  CodeName := \'P6 (0.50 µm)\';
                  TranCount := 5500000;
                end;

              1:
                begin
                  Result := \'Pentium Pro\';
                  CodeName := \'P6 (0.35 µm)\';
                  TranCount := 5500000;
                end;

              3:
                begin
                  Result := \'Pentium II\';

                  if AL2Cache = 333 then
                    CodeName := \'P6T (0.25 µm)\'
                  else
                    CodeName := \'Klamath (0.35 µm)\';

                  TranCount := 7500000;

                  if ATyp = 1 then
                    Result := Result + \' OverDrive\';
                end;

              4:
                begin
                  Result := \'Pentium II\';
                  Codename := \'P55CT (P54 OverDrive)\';
                  TranCount := 3100000;
                end;

              5:
                if (AL2Cache <= 512) then
                begin
                  if (AL2Cache = 0) then
                  begin
                    Result := \'Celeron\';
                    Codename := \'Covington (0,25µm)\';
                    TranCount := 7500000;
                  end
                  else
                  begin
                    Result := \'Pentium II\';
                    Codename := \'Deschutes (0,25µm)\';
                    TranCount := 7500000;
                  end;
                end
                else
                begin
                  Result := \'Pentium II Xeon\';
                  Codename := \'Deschutes (0.25 µm)\';
                  TranCount := 7500000;
                end;

              6:
                if AL2Cache < 256 then
                begin
                  Result := \'Celeron A\';
                  Codename := \'Mendocino (0.25 µm)\';
                  TranCount := 19000000;
                end
                else
                begin
                  Result := \'Pentium II PE (mobile)\';
                  Codename := \'Dixon (0.25 µm)\';
                  TranCount := 27400000;
                end;

              7:
                if AL2Cache <= 512 then
                begin
                  Result := \'Pentium III\';
                  Codename := \'Katmai (0.25 µm)\';
                  TranCount := 9500000;
                end
                else
                begin
                  Result := \'Pentium III Xeon\';
                  Codename := \'Tanner (0.25 µm)\';
                  TranCount := 9500000;
                end;

              8:
                begin
                  Result := \'Pentium III E\';
                  Codename := \'Coppermine (0.18 µm)\';
                  TranCount := 28100000;
                end;
            else
              begin
                Result := \'Pentium II\';
                Codename := \'\';
                TranCount := 0;
              end;
            end;
          7, 8: case ABrand of
              1:
                begin
                  Result := \'Celeron\';
                  Codename := \'\';
                  TranCount := 0;
                end;
              3:
                begin
                  Result := \'Pentium III Xeon\';
                  Codename := \'\';
                  TranCount := 0;
                end;
              4:
                begin
                  Result := \'Pentium IV\';
                  Codename := \'\';
                  TranCount := 0;
                end;
            else
              begin
                if (AL2Cache < 1024) then
                  Result := \'Pentium III\'
                else
                  Result := \'Pentium III Xeon\';
                Codename := \'\';
                TranCount := 0;
              end;
            end;
          $A:
            begin
              Result := \'Pentium III Xeon\';
              Codename := \'\';
              TranCount := 0;
            end;
          $F:
            begin
              Result := \'Pentium IV\';
              Codename := \'\';
              TranCount := 0;
            end;

        end;
      end;

    VENDOR_AMD:
      begin
        case AFamily of
          4: case AModel of
              0:
                begin
                  Result := \'Am486DX\';
                  Codename := \'P4\';
                  TranCount := 1250000;
                end;
              3, 7:
                begin
                  Result := \'Am486DX2\';
                  Codename := \'P24\';
                  TranCount := 1250000;
                end;
              8, 9:
                begin
                  Result := \'Am486DX4\';
                  Codename := \'P24C\';
                  TranCount := 1250000;
                end;
              14, 15:
                begin
                  Result := \'Am5x86\';
                  Codename := \'X5\';
                  TranCount := 1600000;
                end;
            end;
          5: case AModel of
              0:
                begin
                  Result := \'K5\';
                  Codename := \'SSA5 (0.50-0.35 µm)\';
                  TranCount := 4300000;
                end;
              1, 2, 3:
                begin
                  Result := \'K5-5k86 (PR120, PR133)\';
                  Codename := \'5k86 (0.35 µm)\';
                  TranCount := 4300000;
                end;
              6:
                begin
                  Result := \'K6\';
                  Codename := \'K6 (0.30 µm)\';
                  TranCount := 8800000;
                end;
              7:
                begin
                  Result := \'K6\';
                  Codename := \'Little Foot (0.25 µm)\';
                  TranCount := 8800000;
                end;
              8:
                begin
                  Result := \'K6-II\';
                  Codename := \'Chomper (0.25 µm)\';
                  TranCount := 9300000;
                end;
              9:
                begin
                  Result := \'K6-III\';
                  Codename := \'Slarptooth (0.25 µm)\';
                  TranCount := 21300000;
                end;
              $D:
                begin
                  Result := \'K6-II+/K6-III+\';
                  Codename := \'\';
                  TranCount := 0;
                end;
            end;
          6:
            begin
              Result := \'K7\';
              Codename := \'Athlon (0.25-0.18 µm)\';
              TranCount := 22000000;
            end;
        end;
      end;

    VENDOR_CYRIX:
      begin
        case AFamily of
          4: case AModel of
              0:
                begin
                  if AFreq in [20, 66] then
                  begin
                    Result := \'Cx486SLC/DLC\';
                    Codename := \'M0.5\';
                    TranCount := 600000;
                  end;
                  if AFreq in [33, 50] then
                  begin
                    Result := \'Cx486S\';
                    Codename := \'M0.6\';
                    TranCount := 600000;
                  end;
                  if AFreq > 66 then
                  begin
                    Result := \'Cx486DX/DX2/DX4\';
                    Codename := \'M0.7\';
                    TranCount := 1100000;
                  end;
                end;
              4:
                begin
                  Result := \'Media GX\';
                  Codename := \'Gx86\';
                  TranCount := 24000000;
                end;
              9:
                begin
                  Result := \'5x86\';
                  Codename := \'M0.9 or M1sc (0.65 µm)\';
                  TranCount := 20000000;
                end;
            end;
          5: case AModel of
              2:
                begin
                  Result := \'6x86 and 6x86L\';
                  Codename := \'M1 (0.65 µm) and M1L (0.35 µm)\';
                  TranCount := 30000000;
                end;
              4:
                begin
                  Result := \'MediaGXm\';
                  Codename := \'GXm\';
                  TranCount := 24000000;
                end;
            end;
          6: case AModel of
              0: if AFreq < 225 then
                begin
                  Result := \'6x86MX (PR166-266)\';
                  Codename := \'M2 (0.35 µm)\';
                  TranCount := 65000000;
                end
                else
                begin
                  Result := \'M-II (PR300-433)\';
                  Codename := \'M2 (0.35-0.25 µm)\';
                  TranCount := 65000000;
                end;
              5:
                begin
                  Result := \'VIA Cyrix III\';
                  Codename := \'\';
                  TranCount := 0;
                end;
            end;
        end;
      end;

    VENDOR_IDT:
      begin
        case AFamily of
          5: case AModel of
              4:
                begin
                  Result := \'WinChip\';
                  Codename := \'C6 (0.35 µm)\';
                  TranCount := 54000000;
                end;
              8:
                begin
                  Result := \'WinChip 2x\';
                  Codename := \'W2x (0.35-0.25 µm)\';
                  TranCount := 59000000;
                end;
              9:
                begin
                  Result := \'WinChip 3\';
                  Codename := \'W3 (0.25 µm)\';
                  TranCount := 90000000;
                end;
            end;
        end;
      end;

    VENDOR_NEXGEN:
      begin
        case AFamily of
          5: case AModel of
              0:
                begin
                  Result := \'Nx586\';
                  Codename := \'Nx5x86 (0.50-0.44 µm)\';
                  TranCount := 35000000;
                end;
              6:
                begin
                  Result := \'Nx686\';
                  Codename := \'HA (0,50µm)\';
                  TranCount := 60000000;
                end;
            end;
        end;
      end;

    VENDOR_UMC:
      begin
        case AFamily of
          4:
            begin
              Codename := \'U5D and U5S\';
              TranCount := 12000000;
              case AModel of
                1: Result := \'U5D\';
                2: Result := \'U5S\';
                3: Result := \'U486DX2\';
                4: Result := \'U486SX2\';
              end;
            end;
        end;
      end;

    VENDOR_RISE:
      begin
        case AFamily of
          4: case AModel of
              0, 2:
                begin
                  Result := \'mP6\';
                  Codename := \'mP6 (0.25-0.18 µm)\';
                  TranCount := 36000000;
                end;
            end;
        end;
      end;
  end;
end;

function GetCPUIDSupport: Boolean;
asm
    PUSHFD
    POP    EAX
    MOV    EDX, EAX
    XOR    EAX, CPUIDID_BIT
    PUSH    EAX
    POPFD
    PUSHFD
    POP    EAX
    XOR    EAX, EDX
    JZ        @exit
    MOV    AL, TRUE
  @exit:
end;

function ExecuteCPUID: TCPUIDResult; assembler;
asm
    PUSH    EBX
    PUSH    EDI
    MOV    EDI, EAX
    MOV    EAX, CPUID_LEVEL
    DW        $A20F
    STOSD
    MOV    EAX, EBX
    STOSD
    MOV    EAX, ECX
    STOSD
    MOV    EAX, EDX
    STOSD
    POP    EDI
    POP    EBX
end;

function ExecuteIntelCache: TIntelCache;
var
  Cache: TIntelCache;
  i: DWORD;
  TimesToExecute, CurrentLoop: Byte;
begin
  asm
    PUSH    EAX
    PUSH    EBP
    PUSH    EBX
    PUSH    ECX
    PUSH    EDI
    PUSH    EDX
    PUSH    ESI

    MOV    CurrentLoop, 0
    PUSH    ECX

  @@RepeatCacheQuery:
    POP    ECX
    MOV    EAX, CPUID_CACHETLB
    DB        0FH
    DB        0A2H
    INC    CurrentLoop
    CMP    CurrentLoop, 1
    JNE    @@DoneCacheQuery
    MOV    TimesToExecute, AL
    CMP    AL, 0
    JE        @@Done

  @@DoneCacheQuery:
    PUSH    ECX
    MOV    CL, CurrentLoop
    SUB    CL, TimesToExecute
    JNZ    @@RepeatCacheQuery
    POP    ECX
    MOV    DWORD PTR [Cache.CacheDescriptors], EAX
    MOV    DWORD PTR [Cache.CacheDescriptors + 4], EBX
    MOV    DWORD PTR [Cache.CacheDescriptors + 8], ECX
    MOV    DWORD PTR [Cache.CacheDescriptors + 12], EDX
    JMP    @@Done

  @@Done:
    POP    ESI
    POP    EDX
    POP    EDI
    POP    ECX
    POP    EBX
    POP    EBP
    POP    EAX
  end;

  Cache.L2Cache := 0;

  for i := 1 to 15 do
    case Cache.CacheDescriptors[i] of
      $40: Cache.L2Cache := 0;
      $41: Cache.L2Cache := 128;
      $42, $82: Cache.L2Cache := 256;
      $43, $83: Cache.L2Cache := 512;
      $44, $84: Cache.L2Cache := 1024;
      $45, $85: Cache.L2Cache := 2048;
    end;
  Result := Cache;
end;

function ExecuteAMDCache: TAMDCache;
var
  Cache: TAMDCache;
begin
  asm
    PUSH    EAX
    PUSH    EBP
    PUSH    EBX
    PUSH    ECX
    PUSH    EDI
    PUSH    EDX
    PUSH    ESI

    MOV    EAX, CPUID_LEVEL1CACHETLB
    DB        0Fh
    DB        0A2h
    MOV    WORD PTR [Cache.InstructionTLB], BX
    SHR    EBX, 16
    MOV    WORD PTR [Cache.DataTLB], BX
    MOV    DWORD PTR [Cache.L1DataCache], ECX
    MOV    DWORD PTR [Cache.L1ICache], EDX

    POP    ESI
    POP    EDX
    POP    EDI
    POP    ECX
    POP    EBX
    POP    EBP
    POP    EAX
  end;
  Result := Cache;
end;

function ExecuteCyrixCache: TCyrixCache;
var
  Cache: TCyrixCache;
begin
  asm
    PUSH    EAX
    PUSH    EBP
    PUSH    EBX
    PUSH    ECX
    PUSH    EDI
    PUSH    EDX
    PUSH    ESI

    MOV    EAX, CPUID_LEVEL1CACHETLB
    DB        0Fh
    DB        0A2h
    MOV    DWORD PTR [Cache.TLBInfo], EBX
    MOV    DWORD PTR [Cache.L1CacheInfo], ECX

    POP    ESI
    POP    EDX
    POP    EDI
    POP    ECX
    POP    EBX
    POP    EBP
    POP    EAX
  end;
  Result := Cache;
end;

function GetCPUSerialNumber: string;

  function SplitToNibble(ANumber: string): string;
  begin
    Result := Copy(ANumber, 0, 4) + \'-\' + Copy(ANumber, 5, 4);
  end;

var
  SerialNumber: TCPUIDResult;
begin
  Result := \'\';
  CPUID_Level := CPUID_CPUSIGNATURE;
  SerialNumber := ExecuteCPUID;
  Result := SplitToNibble(IntToHex(SerialNumber.EAX, 8)) + \'-\';
  CPUID_Level := CPUID_CPUSIGNATURE;
  SerialNumber := ExecuteCPUID;
  Result := Result + SplitToNibble(IntToHex(SerialNumber.EDX, 8)) + \'-\';
  Result := Result + SplitToNibble(IntToHex(SerialNumber.ECX, 8));
end;

function RoundFrequency(const Frequency: Integer): Integer; overload;
const
  NF: array[0..8] of Integer = (0, 20, 33, 50, 60, 66, 80, 90, 100);
var
  Freq, RF: Integer;
  i: Byte;
  Hi, Lo: Byte;
begin
  RF := 0;
  Freq := Frequency mod 100;

  for i := 0 to 8 do
  begin
    if Freq < NF[i] then
    begin
      Hi := i;
      Lo := i - 1;

      if (NF[Hi] - Freq) > (Freq - NF[Lo]) then
        RF := NF[Lo] - Freq
      else
        RF := NF[Hi] - Freq;

      Break;
    end;
  end;
  Result := Frequency + RF;
end;

function REGCPUGetSpeed: DWORD;
var
  _cpufreq: DWORD;
  len: integer;
  rh: HKEY;
  pr: dword;
begin
  result := 0;

  if regOpenKeyEx(HKEY_LOCAL_MACHINE, \'HARDWARE\\DESCRIPTION\\System\\CentralProcessor\\0\',  0, KEY_READ, rh) = ERROR_SUCCESS then
  begin
    if RegQueryValueEx(rh, \'~MHz\', nil, @pr, @_cpufreq, @len) = ERROR_SUCCESS then
      Result := _cpufreq;
    RegCloseKey(rh);
  end;
end;

function ASMGetCpuSpeed: DWORD;
const
  Delay = 500;
var
  TimerHi, TimerLo: Integer;
begin
  ZeroMemory(@Result, sizeof(Result));

  if not GetCPUIDSupport then
    Exit;

  SleepEx(10, FALSE);

  asm
    dw 0F31h { $0F31 op-code for RDTSC pentiun instruction returns a 64 Bit Integer}
    mov TimerLo, eax
    mov TimerHi, edx
  end;

  SleepEx(Delay, FALSE);

  asm
    dw 0F31h { $0F31 op-code for RDTSC pentiun instruction returns a 64 Bit Integer}
    sub eax, TimerLo
    sbb edx, TimerHi
    mov TimerLo, eax
    mov TimerHi, edx
  end;

  Result := Trunc(TimerLo / (1000 * Delay));
end;

function GetCpuSpeed : Dword;
begin
  Result := REGCPUGetSpeed;
  if Result = 0 then
    Result := ASMGetCpuSpeed;
end;
function GetVendor: string;
var
  CPUName: array[0..11] of Char;
begin
  asm
    PUSH    EAX
    PUSH    EBP
    PUSH    EBX
    PUSH    ECX
    PUSH    EDI
    PUSH    EDX
    PUSH    ESI

    MOV    EAX, CPUID_VENDORSIGNATURE
    DB    0FH
    DB    0A2H

    MOV    DWORD PTR [CPUName], EBX
    MOV    DWORD PTR [CPUName + 4], EDX
    MOV    DWORD PTR [CPUName + 8], ECX

    POP    ESI
    POP    EDX
    POP    EDI
    POP    ECX
    POP    EBX
    POP    EBP
    POP    EAX
  end;
  Result := CPUName;
end;

function GetVendorID: string;
var
  CPUName: array[0..47] of Char;
begin
  asm
  PUSH    EAX
  PUSH    EBP
  PUSH    EBX
  PUSH    ECX
  PUSH    EDI
  PUSH    EDX
  PUSH    ESI

  MOV    EAX, CPUID_CPUMARKETNAME1
  DW    $A20F

  MOV    DWORD PTR [CPUName], EAX
  MOV    DWORD PTR [CPUName + 4], EBX
  MOV    DWORD PTR [CPUName + 8], ECX
  MOV    DWORD PTR [CPUName + 12], EDX

  MOV    EAX, CPUID_CPUMARKETNAME2
  DW    $A20F

  MOV    DWORD PTR [CPUName + 16], EAX
  MOV    DWORD PTR [CPUName + 20], EBX
  MOV    DWORD PTR [CPUName + 24], ECX
  MOV    DWORD PTR [CPUName + 28], EDX

  MOV    EAX, CPUID_CPUMARKETNAME3
  DW    $A20F

  MOV    DWORD PTR [CPUName + 32], EAX
  MOV    DWORD PTR [CPUName + 36], EBX
  MOV    DWORD PTR [CPUName + 40], ECX
  MOV    DWORD PTR [CPUName + 44], EDX

  POP    ESI
  POP    EDX
  POP    EDI
  POP    ECX
  POP    EBX
  POP    EBP
  POP    EAX
  end;
  Result := CPUName;
end;

function GetFDIVBugPresent: Boolean;
const
  N1: Real = 4195835.0;
  N2: Real = 3145727.0;
begin
  Result := ((((N1 / N2) * N2) - N1) <> 0.0);
end;

{ TCPUFeatures }

procedure TCPUFeatures.GetInfo;
begin
  CPUID_Level := CPUID_CPUSIGNATUREEX;
  CPUID := ExecuteCPUID;
  FEXMMX := ((CPUID.EDX and (1 shl EFS_EXMMXA)) <> 0) or ((CPUID.EDX and (1 shl EFS_EXMMXC)) <> 0);
  FEX3DNOW := ((CPUID.EDX and (1 shl EFS_EX3DNOW)) <> 0);
  F3DNOW := ((CPUID.EDX and (1 shl EFS_3DNOW)) <> 0);

  CPUID_Level := CPUID_CPUFEATURESET;
  CPUID := ExecuteCPUID;
  FSIMD := ((CPUID.EDX and (1 shl SFS_SIMD)) <> 0);
  FXSR := ((CPUID.EDX and (1 shl SFS_XSR)) <> 0);
  FMMX := ((CPUID.EDX and (1 shl SFS_MMX)) <> 0);
  FSERIAL := ((CPUID.EDX and (1 shl SFS_SERIAL)) <> 0);
  FPSE36 := ((CPUID.EDX and (1 shl SFS_PSE36)) <> 0);
  FPAT := ((CPUID.EDX and (1 shl SFS_PAT)) <> 0);
  FCMOV := ((CPUID.EDX and (1 shl SFS_CMOV)) <> 0);
  FMCA := ((CPUID.EDX and (1 shl SFS_MCA)) <> 0);
  FPGE := ((CPUID.EDX and (1 shl SFS_PGE)) <> 0);
  FMTRR := ((CPUID.EDX and (1 shl SFS_MTRR)) <> 0);
  FSEP := ((CPUID.EDX and (1 shl SFS_SEP)) <> 0);
  FAPIC := ((CPUID.EDX and (1 shl SFS_APIC)) <> 0);
  FCX8 := ((CPUID.EDX and (1 shl SFS_CX8)) <> 0);
  FMCE := ((CPUID.EDX and (1 shl SFS_MCE)) <> 0);
  FPAE := ((CPUID.EDX and (1 shl SFS_PAE)) <> 0);
  FMSR := ((CPUID.EDX and (1 shl SFS_MSR)) <> 0);
  FTSC := ((CPUID.EDX and (1 shl SFS_TSC)) <> 0);
  FPSE := ((CPUID.EDX and (1 shl SFS_PSE)) <> 0);
  FDE := ((CPUID.EDX and (1 shl SFS_DE)) <> 0);
  FVME := ((CPUID.EDX and (1 shl SFS_VME)) <> 0);
  FFPU := ((CPUID.EDX and (1 shl SFS_FPU)) <> 0);
end;

procedure TCPUFeatures.Report(var sl: TStringList);
begin
  with sl do
  begin
    Add(\'[CPU Features]\');
    Add(Format(\'3D Now! extensions=%d\', [integer(_3DNOW)]));
    Add(Format(\'Enhanced 3D Now! extensions=%d\', [integer(EX_3DNOW)]));
    Add(Format(\'Enhanced MMX extensions=%d\', [integer(EX_MMX)]));
    Add(Format(\'SIMD instructions=%d\', [integer(SIMD)]));
    Add(Format(\'FXSAVE/FXRSTOR instruction=%d\', [integer(XSR)]));
    Add(Format(\'MMX extensions=%d\', [integer(MMX)]));
    Add(Format(\'Serial number=%d\', [integer(SERIAL)]));
    Add(Format(\'36bit Page Size Extension=%d\', [integer(PSE36)]));
    Add(Format(\'Page Attribute Table=%d\', [integer(PAT)]));
    Add(Format(\'CMOVcc (+FCMOVcc/F(U)COMI(P) opcodes=%d\', [integer(CMOV)]));
    Add(Format(\'Machine Check Architecture=%d\', [integer(MCA)]));
    Add(Format(\'Page Global Extension=%d\', [integer(PGE)]));
    Add(Format(\'Memory Type Range Registers=%d\', [integer(MTRR)]));
    Add(Format(\'SYSENTER/SYSEXIT extension=%d\', [integer(SEP)]));
    Add(Format(\'Processor contains an enabled APIC=%d\', [integer(APIC)]));
    Add(Format(\'CMPXCHG8B instruction=%d\', [integer(CX8)]));
    Add(Format(\'Machine Check Exception=%d\', [integer(MCE)]));
    Add(Format(\'Physical Address Extension=%d\', [integer(PAE)]));
    Add(Format(\'Model Specific Registers=%d\', [integer(MSR)]));
    Add(Format(\'Time Stamp Counter=%d\', [integer(TSC)]));
    Add(Format(\'Page Size Extension=%d\', [integer(PSE)]));
    Add(Format(\'Debugging Extension=%d\', [integer(DE)]));
    Add(Format(\'Virtual Mode Extension=%d\', [integer(VME)]));
    Add(Format(\'Built-In FPU=%d\', [integer(FPU)]));
  end;
end;

{ TCPU }

constructor TCPU.Create;
begin
  inherited;
  FFeatures := TCPUFeatures.Create;
  FCache := TCPUCache.Create;
end;

destructor TCPU.Destroy;
begin
  FFeatures.Free;
  FCache.Free;
  inherited;
end;

procedure TCPU.GetInfo;
var
  SI: TSystemInfo;
  CPUID: TCPUIDResult;
  i, t: integer;
  cn: string;
const
  rkCPU = {HKEY_LOCAL_MACHINE\\} \'HARDWARE\\DESCRIPTION\\System\\CentralProcessor\\0\';
  rvVendorID = \'VendorIdentifier\';
  rvID = \'Identifier\';
begin
  ZeroMemory(@SI, SizeOf(SI));
  GetSystemInfo(SI);
  FCount := SI.dwNumberOfProcessors;

  with TRegistry.Create do
  begin
    Rootkey := HKEY_LOCAL_MACHINE;

    if OpenKey(rkCPU, False) then
    begin
      FVendorReg := ReadString(rvVendorID);
      FVendorIDReg := ReadString(rvID);
      CloseKey;
    end;

    Free;
  end;

  // FFreq:=GetCPUSpeed.NormFreq;
  FFreq := GetCpuSpeed;

  CPUID_Level := CPUID_CPUSIGNATURE;
  CPUID := ExecuteCPUID;
  FFamily := CPUID.EAX shr 8 and $F;
  FTyp := CPUID.EAX shr 12 and 3;
  FModel := CPUID.EAX shr 4 and $F;
  FStepping := CPUID.EAX and $F;
  FBrand := LoByte(LoWord(CPUID.EBX));

  CPUID_Level := CPUID_MAXLEVEL;

  try
    CPUID := ExecuteCPUID;
  except
  end;

  FLevel := CPUID.EAX;

  try
    FVendorCPUID := GetVendor;
  except
  end;

  FCPUVendor := VENDOR_UNKNOWN;
  FVendor := \'\';

  for i := VENDOR_INTEL to VENDOR_RISE do
    if CPUVendorIDs[i] = Vendor_CPUID then
    begin
      FCPUVendor := i;
      FVendor := CPUVendors[i];
      FVendorEx := CPUVendorsEx[i];
      Break;
    end;

  Features.GetInfo;

  if Features.SERIAL then
    FSerial := GetCPUSerialNumber;

  FVendorIDCPUID := GetVendorID;

  FDIV := GetFDIVBugPresent;

  Cache.GetInfo(CPUVendor);

  FVendorID := GetCPUVendorID(CPUVendor, Family, Model, Brand, Typ, Cache.Level2, Frequency, cn, t);
  FCodeName := cn;
  FTrans := t;
end;

procedure TCPU.Report(var sl: TStringList);
begin
  with sl do
  begin
    Add(\'[CPU]\');
    Add(Format(\'Count=%d\', [Self.Count]));
    Add(Format(\'Frequency=%d\', [Frequency]));
    Add(Format(\'VendorID=%s\', [VendorID]));
    Add(Format(\'Vendor=%s\', [Vendor]));
    Add(Format(\'Family=%d\', [Family]));
    Add(Format(\'Model=%d\', [Model]));
    Add(Format(\'Stepping=%d\', [Stepping]));
    Add(Format(\'CodeName=%s\', [CodeName]));
    Add(Format(\'Transistors=%d\', [Transistors]));
    Add(Format(\'SerialNumber=%s\', [SerialNumber]));
    Add(Format(\'FDIVBug=%d\', [Integer(FDIVBug)]));

    Features.Report(sl);

    Cache.Report(sl);
  end;
end;

{ TCPUCache }

procedure TCPUCache.GetInfo;
var
  i: integer;
begin
  FLevel1Data := 0;
  FLevel1Code := 0;
  FLevel1 := 0;
  FLevel2 := 0;

  case AVendor of
    VENDOR_INTEL:
      begin
        IntelCache := ExecuteIntelCache;
        FLevel2 := IntelCache.L2Cache;

        FLevel1Data := 0;
        for i := 0 to 15 do
          if (IntelCache.CacheDescriptors[i] in [$0A, $0C]) then
          begin
            if (IntelCache.CacheDescriptors[i] = $0A) then
              FLevel1Data := 8
            else
              FLevel1Data := 16;
          end;

        FLevel1Code := 0;
        for i := 0 to 15 do
          if (IntelCache.CacheDescriptors[i] in [$6, $8]) then
          begin
            if (IntelCache.CacheDescriptors[i] = $06) then
              FLevel1Code := 8
            else
              FLevel1Code := 16;
          end;

        FLevel1 := 0;
        for i := 0 to 15 do
          if (IntelCache.CacheDescriptors[i] = $80) then
            FLevel1 := 16;
      end;

    VENDOR_AMD:
      begin
        AMDCache := ExecuteAMDCache;
        FLevel1Data := AMDCache.L1DataCache[3];
        FLevel1Code := AMDCache.L1ICache[3];
        FLevel1 := L1Data + L1Code;
      end;

    VENDOR_CYRIX:
      begin
        CyrixCache := ExecuteCyrixCache;
        if $80 in [CyrixCache.L1CacheInfo[0], CyrixCache.L1CacheInfo[1], CyrixCache.L1CacheInfo[2], CyrixCache.L1CacheInfo[3]] then
          FLevel1 := 16;
      end;

    VENDOR_IDT: ;
    VENDOR_NEXGEN: ;
    VENDOR_UMC: ;
    VENDOR_RISE: ;
  end;
end;

procedure TCPUCache.Report(var sl: TStringList);
begin
  with sl do
  begin
    Add(\'[CPU Cache]\');
    Add(Format(\'Level 1 Data Cache=%d\', [L1Data]));
    Add(Format(\'Level 1 Instruction Cache=%d\', [L1Code]));
    Add(Format(\'Level 1 Unified Cache=%d\', [Level1]));
    Add(Format(\'Level 2 Unified Cache=%d\', [Level2]));
  end;
end;

end.


Jens B

CPU usage siger du ?

unit CPUUsage;

interface

uses
  SysUtils, Windows, Classes, ExtCtrls;

type
  TOnIntervalEvent = procedure (Sender: TObject; Value: DWORD) of object;

  TMCPUUsage = class(TComponent)
  private
    Timer: TTimer;
    FOnInterval: TOnIntervalEvent;
    FLastValue, FValue: comp;
    FReady: Boolean;
    function GetActive: Boolean;
    function GetInterval: DWORD;
    procedure SetActive(const Value: Boolean);
    procedure SetInterval(const Value: DWORD);
    procedure OnTimer(Sender: TObject);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Active: Boolean read GetActive write SetActive;
    property Interval: DWORD read GetInterval write SetInterval;
    property OnInterval: TOnIntervalEvent read FOnInterval write FOnInterval;
  end;

function Init9xCPUData: Boolean;
function Get9xCPUUsage: integer;
procedure Release9xCPUData;

function InitNTCPUData: Boolean;
function GetNTCPUUsage: comp;
procedure ReleaseNTCPUData;

const
  ObjCounter = \'KERNEL\\CPUUsage\';
  StartStat = \'PerfStats\\StartStat\';
  StatData = \'PerfStats\\StatData\';
  StopStat = \'PerfStats\\StopStat\';

implementation

uses Routines, Registry;

type
  PULONG = ^ULONG;

  ULONG = DWORD;

  NTSTATUS = ULONG;

  PVOID = Pointer;

  _SYSTEM_INFORMATION_CLASS = (
          SystemBasicInformation,
          SystemProcessorInformation,
          SystemPerformanceInformation,
          SystemTimeOfDayInformation,
          SystemNotImplemented1,
          SystemProcessesAndThreadsInformation,
          SystemCallCounts,
          SystemConfigurationInformation,
          SystemProcessorTimes,
          SystemGlobalFlag,
          SystemNotImplemented2,
          SystemModuleInformation,
          SystemLockInformation,
          SystemNotImplemented3,
          SystemNotImplemented4,
          SystemNotImplemented5,
          SystemHandleInformation,
          SystemObjectInformation,
          SystemPagefileInformation,
          SystemInstructionEmulationCounts,
          SystemInvalidInfoClass1,
          SystemCacheInformation,
          SystemPoolTagInformation,
          SystemProcessorStatistics,
          SystemDpcInformation,
          SystemNotImplemented6,
          SystemLoadImage,
          SystemUnloadImage,
          SystemTimeAdjustment,
          SystemNotImplemented7,
          SystemNotImplemented8,
          SystemNotImplemented9,
          SystemCrashDumpInformation,
          SystemExceptionInformation,
          SystemCrashDumpStateInformation,
          SystemKernelDebuggerInformation,
          SystemContextSwitchInformation,
          SystemRegistryQuotaInformation,
          SystemLoadAndCallImage,
          SystemPrioritySeparation,
          SystemNotImplemented10,
          SystemNotImplemented11,
          SystemInvalidInfoClass2,
          SystemInvalidInfoClass3,
          SystemTimeZoneInformation,
          SystemLookasideInformation,
          SystemSetTimeSlipEvent,
          SystemCreateSession,
          SystemDeleteSession,
          SystemInvalidInfoClass4,
          SystemRangeStartInformation,
          SystemVerifierInformation,
          SystemAddVerifier,
          SystemSessionProcessesInformation);
    SYSTEM_INFORMATION_CLASS = _SYSTEM_INFORMATION_CLASS;

    _SYSTEM_PROCESSOR_TIMES = packed record
          IdleTime,
          KernelTime,
          UserTime,
          DpcTime,
          InterruptTime: int64;
          InterruptCount: ULONG;
    end;

    SYSTEM_PROCESSOR_TIMES = _SYSTEM_PROCESSOR_TIMES;
    PSYSTEM_PROCESSOR_TIMES = ^_SYSTEM_PROCESSOR_TIMES;

  TNativeQuerySystemInformation = function(
          SystemInformationClass: SYSTEM_INFORMATION_CLASS;
          SystemInformation: PVOID;
          SystemInformationLength: ULONG;
          ReturnLength: PULONG
          ): NTSTATUS; stdcall;

const
  NTDLL_DLL_Name = \'NTDLL.DLL\';

  STATUS_SUCCESS = $00000000;
  STATUS_INFO_LENGTH_MISMATCH = $C0000004;

  Timer100N = 10000000;
  Timer1S = 1000;

var
  CPUSize, Cpu9xUsage: DWORD;
  CPUNTUsage: PSYSTEM_PROCESSOR_TIMES;
  Reg: TRegistry;

  NTDLL_DLL: THandle = 0;
  ZwQuerySystemInformation: TNativeQuerySystemInformation = nil;

function Init9xCPUData: Boolean;
begin
  Reg:=TRegistry.Create;
  with Reg do
    try
      Rootkey:=HKEY_DYN_DATA;
      if OpenKey(StartStat,False) then begin
        GetDataType(ObjCounter);
        ReadBinaryData(ObjCounter,CPU9xUsage,GetDataSize(ObjCounter));
        CloseKey;
        if not OpenKey(StatData,False) then
          raise Exception.Create(\'Unable to read performance data\');
      end else
        raise Exception.Create(\'Unable to start performance monitoring\');
    finally
      Result:=CurrentPath=StatData;
    end;
end;

function Get9xCPUUsage: integer;
begin
  with Reg do begin
    ReadBinaryData(ObjCounter,CPU9xUsage,4);
  end;
  Result:=Cpu9xUsage;
end;

procedure Release9xCPUData;
begin
  with Reg do begin
    CloseKey;
    if OpenKey(StopStat,False) then begin
      GetDataType(ObjCounter);
      GetDataType(ObjCounter);
      ReadBinaryData(ObjCounter,CPU9xUsage,GetDataSize(ObjCounter));
      CloseKey;
    end;
    Free;
  end;
end;

function InitNTCPUData: Boolean;
var
  R: NTSTATUS;
  n: DWORD;
begin
  n:=0;
  CPUNTUsage:=AllocMem(SizeOf(SYSTEM_PROCESSOR_TIMES));
  R:=ZwQuerySystemInformation(SystemProcessorTimes,CPUNTUsage,SizeOf(SYSTEM_PROCESSOR_TIMES),nil);
  while R=STATUS_INFO_LENGTH_MISMATCH do begin
    Inc(n);
    ReallocMem(CPUNTUsage,n*SizeOf(CPUNTUsage^));
    R:=ZwQuerySystemInformation(SystemProcessorTimes,CPUNTUsage,n*SizeOf(SYSTEM_PROCESSOR_TIMES),nil);
  end;
  CPUSize:=n*SizeOf(CPUNTUsage^);
  Result:=R=STATUS_SUCCESS;
end;

function GetNTCPUUsage;
begin
  ZwQuerySystemInformation(SystemProcessorTimes,CPUNTUsage,CPUSize,nil);
  Result:=CPUNTUsage^.IdleTime;
end;

procedure ReleaseNTCPUData;
begin
  Freemem(CPUNTUsage);
end;

{ TMCPUUsage }

constructor TMCPUUsage.Create(AOwner: TComponent);
begin
  inherited;
  Timer:=TTimer.Create(Self);
  Timer.Interval:=1000;
  Timer.Enabled:=False;
  if IsNT then
    FReady:=InitNTCPUData
  else
    FReady:=Init9xCPUData;
  if FReady then
    Timer.OnTimer:=OnTimer;
end;

destructor TMCPUUsage.Destroy;
begin
  Timer.Free;
  if FReady then begin
    if IsNT then
      ReleaseNTCPUData
    else
      Release9xCPUData;
  end;
  inherited;
end;

function TMCPUUsage.GetActive: Boolean;
begin
  Result:=Timer.Enabled;
end;

function TMCPUUsage.GetInterval: DWORD;
begin
  Result:=Timer.Interval;
end;

procedure TMCPUUsage.OnTimer(Sender: TObject);
var
  v: DWORD;
begin
  if IsNT then begin
    FLastValue:=FValue;
    FValue:=GetNTCPUUsage;
    v:=Round((Timer100n-(FValue-FLastValue)/(Timer.Interval/Timer1s))/Timer100n*100);
  end else
    v:=Get9xCPUUsage;
  if Assigned(FOnInterval) then
    FOnInterval(Self,v);
end;

procedure TMCPUUsage.SetActive(const Value: Boolean);
begin
  Timer.Enabled:=Value and FReady;
end;

procedure TMCPUUsage.SetInterval(const Value: DWORD);
begin
  Timer.Interval:=Value;
end;

initialization
  if IsNT then begin
    if NTDLL_DLL=0 then
      NTDLL_DLL:=GetModuleHandle(NTDLL_DLL_name);
    if NTDLL_DLL<>0 then
      @ZwQuerySystemInformation:=GetProcAddress(NTDLL_DLL,\'ZwQuerySystemInformation\');
  end;
end.

prøv det her komponent ...

Jens B

så har du fåer 2500 loinjers kode så har du lidt at begynde med .....

Jens B

Borrisholt>> er du autist ? ;)

kun lidt ... Og så havde jeg lidt på lager ....

Det virker meget godt ....


Fidusen er du opretten en klasse og så kalder du GetInfo() på den så er den i luften. Så kan du trække en masse oplysninger ud af dem.

Jens B

HELE kode kan hentes her :


http://BORRISHOLT.COM/SYSDIMS.ZIP

samt et lille eksempel.

Jens B

fedt at du kalder filen noget med \'dims\' ...:)

hest.txt .....

det er da for vildt. .... :)....(jeg tillod mig at hente dit eksempel)...bortset fra at hest staves hÆst (stort Æ er vigtigt)

OKI ... Det er ænderet og et nyt eksempel er uploaded .... Der er også lide flere oplysninger ....

Jens B

kult nok :)....

Jeg plejer at påstå at min dims ved mere om din computer end du selv gør.

Correct me if I\'m wrong ?

Jens B

jeg anede ikke at min cpu\'s CodeName=Tillamook
hehe

orv ja forresten der er et lille problem med TMemory hvis den bliver kaldet på WIN32s (32 Bits subsystem på en Windows 3.11). Så vil den benytte sig af Generic Thunk. For det skal lykkes skal flaget ONLYWIN9X sættes i DEF.inc

Jens B

hehe...der er sq da ingen der bruger win3x længere ;).....bortset fra en gammel ting jeg har til at ligge et sted hehe

Jeg ville bare nævne det kan lade sig gøre at smide det i luften på et WIN32s system. DET er ikke nemt, men det kan lade sig gøre ....

OG jo der findes stadig firmaer der koder til WIN32s

Jens b

weird...de burde få sig et liv....;)....og opgradere deres gamle lård

Det er altså ikke lige sådan noget man gør ... Hvis dit program fx er på over 100.000 linjer ... Og som regl  betyder det at det skal skrives om fra bunden ...

Appropos gammel lort så er din CPU da vist ikke helt frisk ?

Jens B

nix....den er wolalte, men den kører stabilt ... og jeg opgraderer lige efter nytår ...

pizzaking >> Jeg var lige ved at se på din CPU Speed tester ... Hvorfor bruger du db to gange, altså 16 bits metoden,  :

asm
      db $0F
      db $31
      mov TimerLo, eax
      mov TimerHi, edx
end;

istedet for blot at bruge

asm
  dw 0F31h
  mov TimerLo, eax
  mov TimerHi, edx
end;


ja ja forskellen er ens det ved jeg godt. Compileren forvanler det alligevel til en rdtsc kommando, men opkoden på rdtsc er trods alt 0F31h. 

Nå blot en strø tanke .....

Jens B

det var faktisk bare noget jeg kopierede etellerandetsted og addede til min husk.txt ;)
hehe...

pizzaking>> OKI så har du lidt ekstra du kan adde ...

Jens B

hmm Jens... jeg får en grim fejl når jeg prøver at kører din projekt:

Acces vioalation at address 00452b85 in mudule \'Projekt2.exe\'. write of address 00459f14.


:(

puuuh .. prøv at kompilere selv ...

Jens B

øhh hvis det ikke er for meget forlangt vil i så ikke sende mig en projekt med dem i ??

det vil enlig være lidt næmmere
min mail er JRe@Kontor-Teknik.dk
ellers lik et link til filerne


btw. jens din hp ser helt skæv ud hos mig din menu ligger helt uppe i hjørnet og man kan kun se 3 punkter på en gang :) og dit txt felt midt på siden er så smalt at man ikke kan se hvad der står i..  jeg briger IE 5 eller også er det 6

hvis det har nogen forskel

planethunter >> Du bruger IE6 og det har STOR forskel :-) JEg skal have lavet den om, men orker det blot ikke !

Her har du et direkte link til filerne : http://BORRISHOLT.COM/SYSDIMS.ZIP

jens B

det var også den jeg dl den fra men det var den jeg fik den fejl med

prøv at finde ud af hvad det er det går galt :-) Fordi selve sysreg koder fejler ikke noget ...

Jens B

ok.. men det kan være min skod maskine... jeg kører med ME .. det stiker

prøv at remme de forskellige klaser ud en efter en ..

JEns B

mig ??... hmm jeg har ikke delphi på min comp lige nu... for jeg har forputtet min cd et sted ... så jeg kan ikke finde lorted

well nu har en af mine venner prøvet den og jeg har prøvet den på min bærbare ... de får samme fejl

prøv at remme de forskellige klaser ud en efter en .... Ellers ved vi jo ikke hvor den falder ned ... Og uden den viden kan jeg UMULIGT hjælpe dig ....

Jens B

hmmm så skal jeg jo til at lede vildt meget efter den :(... hmm well i kan få lidt point for det i har hjålpet mig med nu... så skal jeg vende tilbage når jeg har fundet min delphi cd...


btw. jeg sagde også til mine andre venner at de skulle prøve programmet og de får samme fejl :).. så det er ikke min comp der er noget galt med heheheheheh det er da altid noget :)

planethunter >> Skriv lige en mail til Jens@Borrisholt.com

Jens B

weee .. jeg har fundet min cd nu :) .. jeg får denne her fejl når jeg kører projektet inde i delphi : [Fatal Error] Project2.dpr(5): File not found: \'Devices.dcu\'

og denne her linie bliver higlightet

program Project2;

uses
  Forms,
--------------------------------------
  Unit1 in \'Unit1.pas\' {Form1}|her er min kurser|;
--------------------------------------
{$R *.res}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

Hey
jeg har side og set på de fine eksempler her og det ser ud til det er lige hvad jeg mangler men.. når jeg vil bruge det brokker delphi sig over at den ikke kan finde filen Routines.dcu har søgt mine diske i gennem men nej den er der ikke

/MB