⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 systeminfo.pas

📁 得到
💻 PAS
📖 第 1 页 / 共 5 页
字号:
   property Level         : Integer Read FProcessorLevel Write FProcessorLevel;
   property Revision      : Integer Read FProcessorRevision Write FProcessorRevision;
   property OEMid         : Integer Read FProcessorOEMid Write FProcessorOEMid;
   Property ProcType      : String Read  FProcessorType  Write FProcessorType;
   Property Version       : String Read  FProcessorVersion  Write FProcessorVersion;
   property Freq          : String Read  FFreq Write FFreq;
   property CPUID         : Boolean Read FCPUID Write FCPUID;
   property Vendor        : String Read FVendor Write FVendor;
   property Family        : Integer Read FFamily Write FFamily;
   property Stepping      : Integer Read FStepping Write FStepping;
   property Model         : Integer Read FModel Write FModel;
   property TypeID        : Integer Read FType Write FType;
   property ProcessorID   : tStrings Read FProcessorID Write FProcessorID;
  end;

  TMemory = Class(TPersistent)
  private
   {  Formula For Usage Memory Calc  :
      100-trunc(Avail/Total*100)   }
   FMemoryLoad     : Byte;
   FTotalPhys      : Integer;{ in Bytes }
   FAvailPhys      : Integer;{ in Bytes }
   FTotalPageFile  : Integer;{ in Bytes }
   FAvailPageFile  : Integer;{ in Bytes }
   FTotalVirtual   : Integer;{ in Bytes }
   FAvailVirtual   : Integer;{ in Bytes }
   FSwapFileSize   : Integer;{ in Bytes }
   FSwapFileUsage  : Integer;{ in % }
   { For more information, about the following properties, see
     Windows API Help, SYSTEM_INFO Struct }
   FPageSize       : Integer;{ ? }
   FAllocGranularity : Integer; { ? }
   { Memory Mapping }
   FMinAppAddr     : Integer;
   FMaxAppAddr     : Integer;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property MaxAppAddress  : Integer Read FMaxAppAddr Write FMaxAppAddr;
   property MinAppAddress  : Integer Read FMinAppAddr Write FMinAppAddr;
   property MemoryLoad     : Byte Read FMemoryLoad Write FMemoryLoad;
   property SwapFileSize   : Integer Read FSwapFileSize Write FSwapFileSize;
   property SwapUsage      : Integer Read FSwapFileUsage Write FSwapFileUsage;
   property PhysicalTotal  : Integer Read FTotalPhys Write FTotalPhys;
   property PhysicalFree   : Integer Read FAvailPhys Write FAvailPhys;
   property PageFileTotal  : Integer Read FTotalPageFile Write FTotalPageFile;
   property PageFileFree   : Integer Read FAvailPageFile Write FAvailPageFile;
   property VirtualTotal   : Integer Read FTotalVirtual Write FTotalVirtual;
   property VirtualFree    : Integer Read FAvailVirtual Write FAvailVirtual;
   property PageSize       : Integer Read FPageSize Write FPagesize;
   property AllocGranularity : Integer Read FAllocGranularity Write FAllocGranularity;
  end;

  TResources = Class(TPersistent)
  private
   FSystemRes : Byte;
   FGDIRes    : Byte;
   FUserRes   : Byte;
  protected
  public
   constructor Create;
   destructor Destroy;override;
//   procedure RefreshInfo;
  published
   property SystemResources : Byte Read FSystemRes Write FSystemRes;
   property GDIResources : Byte Read FGDIRes Write FGDIRes;
   property UserResources : Byte Read FUserRes Write FUserRes;
  end;

  TOperatingSystem = Class(TPersistent)
  private
   FLocaleInfo   : tLocaleInfo;
   FResources    : tResources;
   FDirectories  : tDirectories;
   FTimeZone     : tTimeZone;
   FBootDrive    : String;
   FPlatform     : String;
   FWinBuild     : Integer;
   FWinMajVer    : Integer;
   FWinMinVer    : Integer;
   FCSDVersion   : String;   { Refer to WINAPI SDK, OSVERSIONINFO }
   FWinVersion   : String;
   FSysLangDefID : String;
   FUser         : tUser;
   FRegOwner     : String;
   FRegOrg       : String;
   FProductID    : String;
   FProductKey   : String;
   FProductName  : String;
   FInstallDate  : String;
   FVersion      : String;
   FBootCount    : String;
   FUpdates      : tStrings;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property BootDrive     : String Read FBootDrive Write FBootDrive;
   property LocaleInfo    : tLocaleInfo Read FLocaleInfo Write FLocaleInfo;
   property TimeZone      : TTimeZone Read FTimeZone Write FTimeZone;
   property Directories   : TDirectories Read FDirectories Write FDirectories;
   property Resources     : TResources Read FResources Write FResources;
   property Platform      : String Read FPlatform Write FPlatform;
   property Build         : Integer Read FWinBuild Write FWinBuild;
   property BootCount     : String Read FBootCount Write FBootCount;
   property MajorVer      : Integer Read FWinMajVer Write FWinMajVer;
   property MinorVer      : Integer Read FWinMinVer Write FWinMinVer;
   property LanguageID    : String Read FSysLangDefID Write FSysLangDefID;
   property CSDVersion    : String Read FCSDVersion Write FCSDVersion;
   property RegOwner      : String Read FRegOwner Write FRegOwner;
   property RegOrg        : String Read FRegOrg Write FRegOrg;
   property InstallDate   : String Read FInstallDate Write FInstallDate;
   property ProductID     : String Read FProductID Write FProductID;
   property ProductKey    : String Read FProductKey Write FProductKey;
   property ProductName   : String Read FProductName Write FProductName;
   property SerialNo      : String Read FProductKey Write FProductKey;
   property VersionNumber : String Read FWinVersion Write FWinVersion; { e.g : 4.10 2222.A }
   property User          : tUser Read FUser Write FUser;
   property Version       : String Read FVersion Write FVersion;  { e.g : Windows 95 / Windows 98 }
   property SoftwareUpdates : tStrings Read FUpdates;
  end;

  TDrive = class (TPersistent)
  private
   FAvailDrive : String;
   FDisk       : tDisk;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   Property AvailableDrive : String read FAvailDrive Write FAvailDrive;
   property Disk           : tDisk Read FDisk Write FDisk;
  end;

  TMouse = class (TPersistent)
  private
   FMouseType  : String;
   FDescription : String;
   FAvailable  : Boolean;
   FButtons    : Integer;
   FSwapButton : Boolean;
   FMouseWheel : Boolean;
   FProvider   : String;
   FDoubleClickTime : Integer;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   Property Available : Boolean read FAvailable Write FAvailable;
   property Buttons : Integer Read FButtons Write FButtons;
   property SwapButton : Boolean read FSwapButton Write FSwapButton;
   property MouseWheel : Boolean read FMouseWheel Write FMouseWheel;
   property DoubleClickTime : Integer read FDoubleClickTime Write FDoubleClickTime;
   property MouseType   : String Read FMouseType Write FMouseType;
   property Description : String Read FDescription Write FDescription;
   property Provider    : String Read FProvider Write FProvider;
  end;

  TAPM = class (TPersistent)
  private
   FACLineStatus        : String;
   FBatteryFlag         : String;
   FBatteryLifePercent  : Byte;
   FBatteryLifeTime     : Integer;
   FBatteryFullLifeTime : Integer;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property ACLineStatus : String Read FACLineStatus Write FAcLineStatus;
   property BatteryFlag  : String Read FBatteryFlag Write FBatteryFlag;
   property BatteryLifePercent  : Byte Read FBatteryLifePercent Write FBatteryLifePercent;
   property BatteryLifeTime  : Integer Read FBatteryLifeTime Write FBatteryLifeTime;
   property BatteryFullLifeTime  : Integer Read FBatteryFullLifeTime Write FBatteryFullLifeTime;
  end;

  TWorkstation = class (TPersistent)
  private
   FBIOSName         : String;
   FBIOSDate         : String;
   FBIOSCopyright    : String;
   FBIOSExtendedInfo : String;
   FUserName         : String;
   FComputerName     : String;
   FWorkGroup        : String;
   FComment          : String;
  protected
  public
   constructor Create;
   destructor Destroy;override;
   procedure RefreshInfo;
  published
   property BIOSName : String read FBiosName Write FBIOSName;
   property BIOSDate : String read FBiosDate Write FBIOSDate;
   property BIOSExtendedInfo : String read FBIOSExtendedInfo Write FBIOSExtendedInfo;
   property BIOSCopyright : String read FBiosCopyright Write FBIOSCopyright;
   property UserName : String read FUsername write FUsername;
   property ComputerName : String read FComputerName Write FComputerName; 
   property Workgroup    : String read FWorkGroup Write FWorkGroup;
   property Comment    : String read FComment Write FComment;
  end;

  TSystemInfo = class(TComponent)
  private
   FKeyboard             : tKeyboard;
   FDisplay              : tDisplay;
   FDirectX              : tDirectX;
   FDevice               : TDevice;
   FWorkstation          : TWorkStation;
   FMouse                : TMouse;
   FAPM                  : TAPM;
   FDrive                : TDrive;
   FOS                   : TOperatingSystem;
   FMemory               : TMemory;
   FCPU                  : TCPU;
   FNetwork              : tNetwork;
   FStatus               : String;

   
   FAutoRefresh          : Boolean;
   FOnStatusChange       : tNotifyEvent;
   FOnRefreshInfo        : tOnRefreshInfo;
   FOnRefreshStart       : tNotifyEvent;
   FOnRefreshFinish      : tNotifyEvent;

   procedure SetAutoRefresh(Value:Boolean);
  protected
    procedure   SetStatus(Status:String);
  public
    constructor Create(AOwner: TComponent); override;
    destructor  Destroy; override;
    Procedure   RefreshInfo;
  published
    property Device      : TDevice Read FDevice Write FDevice;
    property Workstation : TWorkStation read FWorkStation Write FWorkStation;
    property Mouse       : TMouse Read FMouse Write FMouse;     
    property APM         : TAPM  Read FAPM Write FAPM;     
    property Drives      : TDrive Read FDrive Write FDrive;
    property OS          : tOperatingsystem Read FOS Write FOS;
    property Memory      : tMemory Read FMemory Write FMemory;
    property CPU         : TCPU Read FCPU Write FCPU;
    property DirectX     : tDirectX Read FDirectX Write FDirectX;
    property Network     : tNetwork Read Fnetwork write FNetwork;
    property Display     : tDisplay Read FDisplay Write FDisplay;
    property Keyboard    : tKeyboard Read FKeyboard Write FKeyboard;
    
    property AutoRefresh : Boolean Read FAutoRefresh Write SetAutoRefresh default False;
    property Status      : String Read FStatus Write FStatus;

    property OnStatusChange : tNotifyEvent Read FOnStatusChange Write FOnStatusChange;
    property OnRefreshInfo  : tOnRefreshInfo Read FOnRefreshInfo Write FOnRefreshInfo;
    property OnRefreshStart : tNotifyEvent Read FOnRefreshStart Write FOnRefreshStart;
    property OnRefreshFinish: tNotifyEvent Read FOnRefreshFinish Write FOnRefreshFinish;
  end;

procedure Register;

implementation

Function GetBiosName : String;
Begin
  try
    Result := String(PChar(Ptr(adr_BiosName)));
  except
    Result := 'NoName';
  end;{try..except}
End;{Function GetBiosName}

Function GetBiosCopyright : String;
Begin
  try
    Result := String(PChar(Ptr(adr_BiosCopyright)));
  except
    Result := 'NoCopyright';
  end;{try..except}
End;{Function GetBiosCopyright}

Function GetBIOSExtendedInfo : String;
Begin
  try
    Result := String(PChar(Ptr(adr_BIOSExtendedInfo)));
  except
    Result := '';
  end;{try..except}
End;{Function GetBIOSExtendedInfo}

Function GetBiosDate : TDateTime;
Var
  RegStr, RegFormat : String;
  RegSeparator      : Char;
Begin
  Result := 0;
  try
    RegStr := String(PChar(Ptr(adr_BiosDate)));
  except
    Exit;
  end;{try..except}

  RegFormat := ShortDateFormat;
  RegSeparator := DateSeparator;
  try
    DateSeparator   := '/';
    try
      ShortDateFormat := 'm/d/y';
      Result := StrToDate(RegStr);
    except
      try
        ShortDateFormat := 'y/m/d';
        Result := StrToDate(RegStr);
      except
      end;
    end;
  finally
    ShortDateFormat := RegFormat;
    DateSeparator   := RegSeparator;
  end;{try..finally}
End;{Function GetBiosDate}

Function GetCurrentComputerName : String;
Var
  Name : PChar;
  Size : DWord;
Begin
  Size := MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(Name, Size);
  try
    GetComputerName(Name, Size);
    Result := Trim(StrPas(Name));
  finally
    FreeMem(Name, Size);
  end;{try..finally}
End;{Function GetCurrentComputerName}

Function GetCurrentUserName : String;
Var
  Name : PChar;
  Size : DWord;
Begin
  Size := SizeOf(ShortString);
  GetMem(Name, Size);
  try
    GetUserName(Name, Size);
    Result := Trim(StrPas(Name));
  finally
    FreeMem(Name, Size);
  end;{try..finally}
End;{Function GetCurrentUserName}


{*************************************************************}
{            ResMeter Component for Delphi 32                 }
{ Version:   1.0                                              }
{ Author:    Aleksey Kuznetsov                                }
{ E-Mail:    info@utilmind.com                                }
{ Home Page: http://www.utilmind.com                          }
{ Created:   June, 30, 1999                                   }
{ Modified:  June, 30, 1999                                   }
{ Legal:     Copyright (c) 1999, UtilMind Solutions           }
{*************************************************************}

const
  GFSR_SystemRes = 0;
  GFSR_GDIRes = 1;
  GFSR_USERRes = 2;

var
  hInst16: THandle;
  SR: Pointer;

function LoadLibrary16(LibraryName: PChar): THandle; stdcall; external kernel32 index 35;
procedure FreeLibrary16(HInstance: THandle); stdcall; external kernel32 index 36;
function GetProcAddress16(Hinstance: THandle; ProcName: PChar): Pointer; stdcall; external kernel32 index 37;
{ QT_Thunk needs a stack frame. }

{$StackFrames On}
{procedure QT_Thunk; cdecl; external kernel32 name 'QT_Thunk';

function GetFreeSysResources(SysRes: Word): Word;
var
  Thunks: Array[0..$20] of Word;
begin
  Thunks[0] := hInst16;
  hInst16 := LoadLibrary16('user.exe');
  if hInst16 < 32 then
    raise Exception.Create('Can''t load USER.EXE!');
  FreeLibrary16(hInst16);
  SR := GetProcAddress16(hInst16, 'GetFreeSystemResources');
  if SR = nil then
    raise Exception.Create('Can''t get address of GetFreeSystemResources!');
  asm
    push SysRes       // push arguments
    mov edx, SR       // load 16-bit procedure pointer
    call QT_Thunk     // call thunk
    mov Result, ax    // save the result
  end;
end;
}
Function GetCPUSpeed: Double;
const
  DelayTime = 500; // measure time in ms
var

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -