{******************************************************************************}
{******************************************************************************}
{ Jazarsoft SystemInfo Component }
{******************************************************************************}
{ }
{ VERSION : 1.0 }
{ AUTHOR : James Azarja }
{ CREATED : 10 July 2000 }
{ WEBSITE : http://www.jazarsoft.cjb.net/ }
{ SUPPORT : support@jazarsoft.cjb.net }
{ BUG-REPORT : bugreport@jazarsoft.cjb.net }
{ COMMENT : comment@jazarsoft.cjb.net }
{ LEGAL : Copyright (C) 2000 Jazarsoft. }
{ }
{******************************************************************************}
{ NOTE : }
{ }
{ This code may be used and modified by anyone so long as this header and }
{ copyright information remains intact. }
{ }
{ The code is provided "as-is" and without warranty of any kind, }
{ expressed, implied or otherwise, including and without limitation, any }
{ warranty of merchantability or fitness for a particular purpose.? }
{ }
{ In no event shall the author be liable for any special, incidental, }
{ indirect or consequential damages whatsoever (including, without }
{ limitation, damages for loss of profits, business interruption, loss }
{ of information, or any other loss), whether or not advised of the }
{ possibility of damage, and on any theory of liability, arising out of }
{ or in connection with the use or inability to use this software.牋 }
{ }
{******************************************************************************}
unit SystemInfo;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry, ShlObj, WinSock;
Const
adr_BiosName = $FE061;
adr_BiosCopyright = $FE091;
adr_BIOSExtendedInfo = $FEC71;
adr_BiosDate = $FFFF5;
type
tOnRefreshInfo = procedure(Sender: TObject;InfoCategory:String) of object;
tDriveType = (dtUnknown, dtRootNotFound, dtRemovable, dtFixed, dtRemote, dtCDROM, dtRAMDisk);
tFileSystemFlag = (fsCaseIsPreserved,fsCaseSensitive,fsUnicodeStoredOnDisk,fsPersistentAcls,fsFileCompression,fsVolIsCompressed);
tFileSystem = Set of TFileSystemFlag;
TKeyboard = Class(TPersistent)
private
FNumLock : Boolean;
FScrollLock : Boolean;
FCapsLock : Boolean;
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
property Numlock : Boolean Read FNumlock Write FNumlock;
property ScrollLock : Boolean Read FScrollLock Write FScrollLock;
property Capslock : Boolean Read FCapslock Write FCapslock;
end;
TDisplay = Class(TPersistent)
private
FChipType : String;
FDACType : String;
FRevision : String;
FAGP : Boolean;
F3DProcessor : Boolean;
FMemory : String;
FSupportedModes : tstrings;
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo(AdapterIndex:Integer);
published
property ChipType : String Read FChipType Write FChipType;
property DACType : String Read FDACType Write FDACType;
property Revision : String Read FRevision Write FRevision;
property AGP : Boolean Read FAGP Write FAGP;
property Processor3D : Boolean Read F3dProcessor Write F3dProcessor;
property Memory : String Read FMemory Write FMemory;
property SupportedModes : tStrings Read FSupportedModes;
end;
TNetwork = Class(TPersistent)
private
FNetAdap : tstrings;
FNetCli : tStrings;
FNetProto : tStrings;
FLocalIP : String;
FLocalHost: String;
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
property Adapter : tStrings Read FNetAdap;
property Clients : tstrings Read FNetCli;
property Protocols : tstrings Read FNetProto;
property LocalIP : String Read FLocalIP write FLocalIP;
property LocalHost : String Read FLocalHost Write FLocalHost;
end;
TDirectX = Class(TPersistent)
private
FVersion : String;
FDirect3dDrvDesc : tStrings;
FDirectMusicDrvDesc : tStrings;
FDirectPlayDrvDesc : tstrings;
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
property Version : String Read FVersion Write FVersion;
property Direct3D : tstrings Read FDirect3dDrvDesc;
property DirectMusic : tstrings Read FDirectMusicDrvDesc;
property DirectPlay : tstrings Read FDirectPlayDrvDesc;
end;
TDevice = Class(TPersistent)
private
F3DAccel : tStrings;
FAdapter : tStrings;
FSystem : tstrings;
FUSB : tstrings;
FPorts : tStrings;
FMedia : tstrings;
FPrinter : tStrings;
FSCSI : tStrings;
FModem : tStrings;
FMonitor : tStrings;
FKeyBoard : tStrings;
FMouse : tStrings;
FCdRom : tStrings;
FPCMCIA : tstrings;
FInfraRed : tStrings;
FMultiFun : tStrings;
FHDC : tStrings;
FFDC : tStrings;
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
property Accelerators3D : tStrings Read F3dAccel;
property CdRom : tStrings Read FCDROM;
property Adapter: tStrings Read FAdapter;
property System : tStrings Read FSystem;
property USB : tStrings Read FUSB;
property Ports : tStrings Read FPorts;
property Media : tStrings Read FMedia;
property Printer: tStrings Read FPrinter;
property SCSI : tStrings Read FSCSI;
property Modem : tstrings Read FModem;
property Monitor: tstrings read FMonitor;
property Keyboard:tStrings Read FKeyBoard;
property Mouse : tStrings Read FMouse;
property PCMCIASocket : tstrings Read FPCMCIA;
property InfraRed : tStrings Read FInfraRed;
property MultiFunction : tStrings Read FMultiFun;
property HardDiskControllers : tStrings Read FHDC;
property FloppyDiskControllers : tStrings Read FFDC;
end;
TLocaleInfo = Class(TPersistent)
private
FLang : String;
FEngLang : String;
FAbbrLang : String;
FCountry : String;
FFCountry : String;
FAbbrCtry : String;
FList : String;
FMeasure : String;
FDecimal : String;
FDigit : String;
FCurrency : String;
FIntlSymbol: String;
FMonDecSep : String;
FMonThoSep : String;
FCurrdigit : String;
FPCurrMode : String;
FNCurrMode : String;
FDate : String;
FTime : String;
FTimeFormat : String;
FShortDate : String;
FShortDateOrdr : String;
FLongDateOrdr : String;
FTimeFormatSpec: String;
FYearFormat : String;
protected
public
constructor Create;
destructor Destroy;override;
Procedure RefreshInfo(LocaleID:Cardinal);
published
property FullLocalizeLanguage : String Read Flang Write FLang;
property FullLanguageEnglishName : String Read FEngLang Write FEngLang;
property AbbreviateLanguageName : String Read FAbbrLang Write FAbbrLang;
property CountryCode : String Read FCountry Write FCountry;
property FullCountryCode : String Read FFCountry Write FFCountry;
property AbbreviateCountryCode : String Read FAbbrCtry Write FAbbrCtry;
property ListSeparator : String Read FList Write FList;
property SystemofMeasurement : String Read FMeasure Write FMeasure;
property DecimalSeparator : String Read FDecimal Write FDecimal;
property NumberofDecimalDigits : String Read FDigit Write FDigit;
property LocalMonetarySymbol : String Read FCurrency Write FCurrency;
property InternationalMonetarySymbol : String Read FIntlSymbol Write FIntlSymbol;
Property CurrencyDecimalSeparator : String Read FMonDecSep Write FMonDecSep;
property CurrencyThousandSeparator: String Read FMonThoSep write FMonThoSep;
property CurrencyDecimalDigits : string Read FCurrDigit Write FCurrdigit;
property PositiveCurrencyMode : String Read FPCurrMode Write FPCurrMode;
property NegativeCurrencyMode : string Read FNCurrMode Write FNCurrMode;
property DateSeparator : string Read FDate Write FDate;
property TimeSeparator : string Read FTime Write FTime;
property TimeFormat : string Read FTimeFormat Write FTimeFormat;
property ShortDateFormat : string Read FShortDate Write FShortDate;
property ShortDateOrder : string Read FShortDateOrdr Write FShortDateOrdr;
property LongDateOrder : string Read FLongDateOrdr Write FLongDateOrdr;
property TimeFormatSpecifier : string Read FTimeFormatSpec Write FTimeFormatSpec;
property YearFormat : string Read FYearFormat Write FYearFormat;
end;
TTimeZone = Class(TPersistent)
private
FBias : Integer;
FStandardName : string;
FStandardTime : TDateTime;
FDaylightName : String;
FDaylightTime : TDateTime;
FDayLightBias : Integer;
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
property Bias : Integer read FBias write FBias;
property StandardName : string read FStandardName write FStandardName;
property StandardTime : TDateTime read FStandardTime write FStandardTime;
property DaylightName : String read FDaylightName write FDaylightName;
property DaylightTime : TDateTime read FDaylightTime write FDaylightTime;
property DayLightBias : Integer read FDayLightBias write FDayLightBias;
end;
TDirectories = Class(TPersistent)
private
FProgramFiles : String;
FCommonFiles : String;
FMedia : String;
FDevice : String;
FConfig : String;
FOtherDevice : String;
FWallpaper : String;
FWindows : String;
FSystem : String;
FTemp : String;
{ Spesial Folder, Win9x ONLY ! }
FDesktop : String;
FInternet : String;
FPrograms : String;
FControls : String;
FPrinters : String;
FPersonal : String; { My Document }
FFavorites : String;
FStartUp : String;
FRecent : String;
FSendTo : String;
FBitBucket : String; { Recycle Bin }
FStartMenu : String;
FDesktopDir : String;
FDrives : String; { My Computer }
FNetWork : String;
FNetHood : String;
FFonts : String;
FTemplates : String;
FCommonStartMenu : String; { Startmenu, For all user }
FcommonPrograms : String;
FCommonStartUp : String;
FCommonDesktopDir: String;
FAppData : String;
FPrintHood : String;
FCommonAltStartUp : String;
FCommonFavorites : String;
FInternetCache : String;
FCookies : String;
FHistory : String;
protected
public
constructor Create;
destructor Destroy;override;
// procedure RefreshInfo;
published
property ProgramFiles : String read FProgramFiles Write FProgramFiles;
property CommonFiles : String Read FCommonFiles write FcommonFiles;
property Media : String Read FMedia write FMedia;
property Device : String Read FDevice write FDevice;
property Config : String Read FConfig write FConfig;
property OtherDevice : String Read FOtherDevice write FOtherDevice;
property Wallpaper : String Read FWallpaper write FWallpaper;
property Windows : String Read Fwindows Write FWindows;
property System : String read FSystem Write Fsystem;
property Temp : String Read FTemp Write FTemp;
{ Spesial Folder, Alphabetical Order }
property AppData : String read FAppData Write FAppData;
// property RecycleBin : String Read FBitBucket Write FBitBucket;
// property CommonAltStartUp : String Read FCommonAltStartUp Write FCommonAltStartUp;
property CommonDesktopDir : String Read FCommonDesktopDir Write FCommonDesktopDir;
// property CommonFavorites : String Read FCommonFavorites Write FCommonFavorites;
// property CommonFiles : String Read FCommonFiles Write FCommonFiles;
// property CommonPrograms : String Read FCommonPrograms Write FCommonPrograms;
// property CommonStartmenu : String Read FCommonStartmenu Write FCommonStartmenu;
// property CommonStartUp : String Read FCommonStartUp Write FCommonStartUp;
// property Config : String read FConfig Write FConfig;
// property Controls : String read FControls Write FControls;
property Cookies : String read FCookies Write FCookies;
property Desktop : String read FDesktop Write FDesktop;
property DesktopDir : String read FDesktopDir Write FDesktopDir;
// property Drives : String read FDrives Write FDrives;
property Favorites : String read FFavorites Write FFavorites;
property Fonts : String read FFonts Write FFonts;
property History : String read FHistory Write FHistory;
// property Internet : String read FInternet Write Finternet;
property InternetCache : String read FInternetCache Write FinternetCache;
property NetHood : String read FNetHood Write FNetHood;
// property NetWork : String read FNetWork Write FNetWork;
property MyDocuments : String read FPersonal Write FPersonal;
// property Printers : String Read FPrinters Write FPrinters;
property PrintHood : String Read FPrintHood Write FPrintHood;
// property Programs : String Read Fprograms Write Fprograms;
property Recent : String read FRecent Write FRecent;
property SendTo : String Read FSendTo Write FSendTo;
property StartUp : String Read FStartup write FStartUp;
property Templates : String Read FTemplates Write FTemplates;
end;
TDisk = Class(TPersistent)
private
FDrive : String;
FDriveType : tDriveType;
FSerialNumber : Integer;
FSerialNumberText : String;
FReady : Boolean;
FVolumeLabel : String;
FFileSystem : String;
FFileSystemFlag : tFileSystem;
{ Delphi Internal Function }
// FDiskSize : String; { In Bytes }
// FDiskFree : String; { In Bytes }
{ GetDiskFreeSpace and GetDiskFreeSpaceEx }
FSectorsPerCluster : String;
FBytesPerSector : String;
FNumberOfFreeCluster : String;
FTotalNumberOfCluster : String;
FTotalNumberOfBytes : String;
FTotalNumberOfFreeBytes : String; { Quotas for the calling thread, refer to WINAPI SDK GetDiskFreeSpaceEx }
FClusterSize : String;
FFreeBytes : String;
Procedure SetDrive(Drive:String);
protected
Procedure GetDiskInfo(Drive:string);
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
protected
published
property Drive : String Read FDrive Write SetDrive;
property DriveType : tDriveType Read FDriveType Write FDriveType;
property SerialNumber : Integer Read FSerialNumber Write FSerialNumber;
property SerialNumberLabel : String Read FSerialNumberText Write FSerialNumberText;
property VolumeLabel : String Read FVolumeLabel Write FVolumeLabel;
property FileSystem : string Read FFilesystem Write FFileSystem;
property FileSystemFlag : tFilesystem Read FFileSystemFlag Write FFileSystemFlag;
property DiskReady : Boolean Read FReady Write FReady;
// property DiskSize : String Read FDiskSize Write FDiskSize;
// property DiskFree : String Read FDiskFree Write FDiskFree;
property SectorsPerCluster : String Read FSectorsPerCluster write FSectorsPerCluster ;
property BytesPerSector : String read FBytesPerSector write FBytesPerSector ;
property FreeCluster : String read FNumberOfFreeCluster write FNumberOfFreeCluster ;
property TotalCluster : String read FTotalNumberOfCluster write FTotalNumberOfCluster ;
property TotalBytes : String read FTotalNumberOfBytes write FTotalNumberOfBytes ;
// property NumberOfFreeBytes : String read FTotalNumberOfFreeBytes write FTotalNumberOfFreeBytes;
property ClusterSize : String read FClusterSize Write FClusterSize;
property FreeBytes : String read FFreeBytes Write FFreeBytes;
end;
TUser = Class(TPersistent)
private
FLocaleInfo : tLocaleInfo;
FUserName : String;
FUsrLangDefID : String;
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
property UserName : String read FUsername write FUsername;
property LanguageID : String Read FUsrLangDefID Write FUsrLangDefID;
property LocaleInfo : tLocaleInfo Read FLocaleInfo Write FLocaleInfo;
end;
TCPU = Class(TPersistent)
private
FProcessorArchitecture : Integer;
FProcessorCount : Integer;
FProcessorLevel : Integer;
FProcessorType : String;
FProcessorVersion : String;
FProcessorRevision : Integer; { Hi=Maj, Lo=Min }
FProcessorOEMID : Integer; { NT Only }
FFreq : String; { in MHz }
FCPUID : Boolean;
FVendor : String;
{ CPU ID Properties }
FFamily : integer;
FStepping : Integer;
FModel : Integer;
FType : Integer;
FProcessorID : tStrings; { Assume your computer has multiple Processor }
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
property Architecture : Integer Read FProcessorArchitecture Write FProcessorArchitecture;
property Count : Integer Read FProcessorCount Write FProcessorCount;
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
TimerHi, TimerLo: DWORD;
PriorityClass, Priority: Integer;
begin
PriorityClass := GetPriorityClass(GetCurrentProcess);
Priority := GetThreadPriority(GetCurrentThread);
SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);
SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);
Sleep(10);
asm
dw 310Fh // rdtsc
mov TimerLo, eax
mov TimerHi, edx
end;
Sleep(DelayTime);
asm
dw 310Fh // rdtsc
sub eax, TimerLo
sbb edx, TimerHi
mov TimerLo, eax
mov TimerHi, edx
end;
SetThreadPriority(GetCurrentThread, Priority);
SetPriorityClass(GetCurrentProcess, PriorityClass);
Result := TimerLo / (1000.0 * DelayTime);
end;
const
ID_BIT = $200000; // EFLAGS ID bit
type
TCPUID = array[1..4] of Longint;
TVendor = array [0..11] of char;
function IsCPUIDAvailable : Boolean; register;
asm
PUSHFD {direct access to flags no possible, only via stack}
POP EAX {flags to EAX}
MOV EDX,EAX {save current flags}
XOR EAX,ID_BIT {not ID bit}
PUSH EAX {onto stack}
POPFD {from stack to flags, with not ID bit}
PUSHFD {back to stack}
POP EAX {get back to EAX}
XOR EAX,EDX {check if ID bit affected}
JZ @exit {no, CPUID not availavle}
MOV AL,True {Result=True}
@exit:
end;
function GetCPUID : TCPUID; assembler; register;
asm
PUSH EBX {Save affected register}
PUSH EDI
MOV EDI,EAX {@Resukt}
MOV EAX,1
DW $A20F {CPUID Command}
STOSD {CPUID[1]}
MOV EAX,EBX
STOSD {CPUID[2]}
MOV EAX,ECX
STOSD {CPUID[3]}
MOV EAX,EDX
STOSD {CPUID[4]}
POP EDI {Restore registers}
POP EBX
end;
function GetCPUVendor : TVendor; assembler; register;
asm
PUSH EBX {Save affected register}
PUSH EDI
MOV EDI,EAX {@Result (TVendor)}
MOV EAX,0
DW $A20F {CPUID Command}
MOV EAX,EBX
XCHG EBX,ECX {save ECX result}
MOV ECX,4
@1:
STOSB
SHR EAX,8
LOOP @1
MOV EAX,EDX
MOV ECX,4
@2:
STOSB
SHR EAX,8
LOOP @2
MOV EAX,EBX
MOV ECX,4
@3:
STOSB
SHR EAX,8
LOOP @3
POP EDI {Restore registers}
POP EBX
end;
Function GetSpesialFolder(Handle:Hwnd;nFolder:Integer):String;
var
PIDL: PItemIDList;
Path: LPSTR;
begin
Result:='';
Path := StrAlloc(MAX_PATH);
SHGetSpecialFolderLocation(Handle, nFolder, PIDL);
if SHGetPathFromIDList(PIDL, Path) then
Result := StrPas(Path);
// SHGetSpecialFolderPath(Handle,Path,nFolder,False);
// Result:=Path;
StrDispose(Path);
end;
{*************************************************************}
{*************************************************************}
constructor TKeyboard.Create;
Begin
inherited Create;
// RefreshInfo;
End;
destructor TKeyboard.Destroy;
Begin
inherited Destroy;
End;
Procedure TKeyboard.RefreshInfo;
var Keys: TKeyboardState;
Begin
GetKeyboardState( keys );
FNumLock := keys[VK_NUMLOCK]=1;
FCapsLock := keys[VK_CAPITAL]=1;
FScrollLock := keys[VK_SCROLL]=1;
End;
constructor TDisplay.Create;
Begin
inherited Create;
FSupportedModes:=tStringList.Create;
// RefreshInfo(0);
End;
destructor TDisplay.Destroy;
Begin
FsupportedModes.Free;
inherited Destroy;
End;
Procedure TDisplay.RefreshInfo(AdapterIndex:Integer);
var
Buf : array [0..3] of byte;
I : Integer;
DevMode : TDevMode;
Function MsgColorDepth(ColorDepth:Integer):String;
Begin
case ColorDepth of
2 : result:='Grayscale';
4 : result:='16 Colors';
8 : result:='256 Colors';
16: result:='High Colors';
24: result:='True Colors';
End;
End;
Begin
FsupportedModes.Free;
FSupportedModes:=tStringList.Create;
i := 0;
while EnumDisplaySettings(nil,i,Devmode) do begin
with Devmode do
Begin
FSupportedModes.Add(Format('%d x %d - %s',[dmPelsWidth,dmPelsHeight,MsgColorDepth(dmBitsPerPel)]));
Inc(i);
end;
End;
with TRegistry.Create do
Try
RootKey := HKEY_LOCAL_MACHINE;
If OpenKey('System\CurrentControlSet\Services\Class\Display\'+FormatFloat('0000',AdapterIndex)+'\INFO', False) then
Begin
FChipType:=ReadString('ChipType');
FDACType:=ReadString('DACType');
FRevision:=ReadString('Revision');
FMemory:=Inttostr(ReadInteger('VideoMemory'));
CloseKey;
End;
If OpenKey('System\CurrentControlSet\Services\Class\Display\'+FormatFloat('0000',AdapterIndex)+'\3D', False) then
Begin
I := Readbinarydata ('AGP',buf,sizeof(buf));
FAGP:=(Buf[0]=1);
I := Readbinarydata ('3DP',buf,sizeof(buf));
F3DProcessor:=(Buf[0]=1);
CloseKey;
End;
Finally
Free;
End;
End;
constructor TNetwork.Create;
Begin
inherited Create;
FNetProto:=tStringList.Create;
FNetCli:=tStringList.Create;
FNetAdap:=tStringList.Create;
// RefreshInfo;
End;
destructor TNetwork.Destroy;
Begin
FNetProto.Free;
FNetCli.Free;
FNetAdap.Free;
inherited Destroy;
End;
procedure TNetwork.RefreshInfo;
var
count:integer;
wVersionRequested : WORD;
wsaData : TWSAData;
p : PHostEnt;
s : array[0..128] of char;
p2 : pchar;
begin
{Start up WinSock}
wVersionRequested := MAKEWORD(1, 1);
WSAStartup(wVersionRequested, wsaData);
{Get the computer name}
GetHostName(@s, 128);
p := GetHostByName(@s);
FLocalHost:=p^.h_Name;
{Get the IpAddress}
p2 := iNet_ntoa(PInAddr(p^.h_addr_list^)^);
FLocalIP:=p2;
WSACleanup;
FNetProto.Free;
FNetProto:=tStringList.Create;
FNetCli.Free;
FNetCli:=tStringList.Create;
FNetAdap.Free;
FNetAdap:=tStringList.Create;
with TRegistry.Create do
Try
RootKey := HKEY_LOCAL_MACHINE;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Net\'+FormatFloat('0000',Count), False) do
Begin
FNetAdap.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\NetClient\'+FormatFloat('0000',Count), False) do
Begin
FNetCli.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\NetTrans\'+FormatFloat('0000',Count), False) do
Begin
FNetProto.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Finally
Free;
End;
End;
constructor TDirectX.Create;
Begin
inherited Create;
FDirect3dDrvDesc:=tStringList.Create;
FDirectMusicDrvDesc:=tstringList.Create;
FDirectPlayDrvDesc:=tstringList.Create;
// RefreshInfo;
End;
destructor TDirectX.Destroy;
Begin
FDirect3dDrvDesc.Free;
FDirectMusicDrvDesc.Free;
FDirectPlayDrvDesc.Free;
inherited Destroy;
End;
procedure TDirectX.RefreshInfo;
var Key : tstrings;
I : Integer;
Begin
FDirect3dDrvDesc.Free;
FDirect3dDrvDesc:=tStringList.Create;
FDirectMusicDrvDesc.Free;
FDirectMusicDrvDesc:=tstringList.Create;
FDirectPlayDrvDesc.Free;
FDirectPlayDrvDesc:=tstringList.Create;
Key:=tstringList.Create;
with TRegistry.Create do
Try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey('Software\Microsoft\DirectX', False) then
Begin
FVersion:=ReadString('Version');
CloseKey;
End;
{ Getting Direct3D Driver Description }
if OpenKey('Software\Microsoft\Direct3D\Drivers', False) then
Begin
GetKeynames(Key);
CloseKey;
End;
For I:=0 to Key.count-1 do
Begin
if OpenKey('Software\Microsoft\Direct3D\Drivers\'+Key.Strings[I], False) then
Begin
FDirect3dDrvDesc.Add(ReadString('Description'));
CloseKey;
End;
end;
{ Getting DirectMusic Description }
if OpenKey('Software\Microsoft\DirectMusic\SoftwareSynths', False) then
Begin
GetKeynames(Key);
CloseKey;
End;
For I:=0 to Key.count-1 do
Begin
if OpenKey('Software\Microsoft\DirectMusic\SoftwareSynths\'+Key.Strings[I], False) then
Begin
FDirectMusicDrvDesc.Add(ReadString('Description'));
CloseKey;
End;
end;
{ Getting DirectPlay Description }
if OpenKey('Software\Microsoft\DirectPlay\Services', False) then
Begin
GetKeynames(Key);
CloseKey;
End;
For I:=0 to Key.count-1 do
Begin
if OpenKey('Software\Microsoft\DirectPlay\Services\'+Key.Strings[I], False) then
Begin
FDirectPlayDrvDesc.Add(ReadString('Description'));
CloseKey;
End;
end;
Key.Free;
Finally
Free;
End;
End;
constructor TDevice.Create;
Begin
inherited Create;
FHDC:=TstringList.Create;
FFDC:=tStringList.create;
FMultiFun:=TstringList.Create;
FInfraRed:=tstringList.create;
FPCMCIA:=tStringList.Create;
FCDROM:=tStringList.Create;
F3dAccel:=tStringList.Create;
FMouse:=tStringList.Create;
FKeyboard:=tStringList.Create;
FModem:=tstringList.Create;
FMonitor:=tstringList.Create;
FSCSI:=tstringList.Create;
FPrinter:=tstringList.Create;
FMedia:=tstringList.Create;
FAdapter:=tStringList.Create;
FSystem:=TStringList.Create;
FUSB:=tStringList.Create;
FPorts:=tStringList.Create;
// RefreshInfo;
End;
destructor TDevice.Destroy;
Begin
FHDC.Free;
FFDC.Free;;
FMultiFun.Free;
FInfraRed.Free;
FPCMCIA.Free;
FCDROM.Free;
F3dAccel.Free;
FMouse.Free;
FKeyboard.Free;
FModem.Free;
FMonitor.Free;
FSCSI.Free;
FPrinter.Free;
FMedia.Free;
FAdapter.Free;
FSystem.Free;
FUSB.Free;
FPorts.Free;
inherited Destroy;
End;
procedure TDevice.RefreshInfo;
var Count:Integer;
Begin
FHDC.Free;FHDC:=TstringList.Create;
FFDC.Free;FFDC:=tStringList.create;
FMultiFun.Free;
FMultiFun:=TstringList.Create;
FInfraRed.Free;
FInfraRed:=tstringList.create;
FPCMCIA.Free;
FPCMCIA:=tStringList.Create;
FCDROM.Free;
FCDROM:=tStringList.Create;
F3dAccel.Free;
F3dAccel:=tStringList.Create;
FMouse.Free;
FMouse:=tStringList.Create;
FKeyboard.Free;
FKeyboard:=tStringList.Create;
FModem.Free;
FModem:=tstringList.Create;
FMonitor.Free;
FMonitor:=tstringList.Create;
FSCSI.Free;
FSCSI:=tstringList.Create;
FPrinter.Free;
FPrinter:=tstringList.Create;
FMedia.Free;
FMedia:=tstringList.Create;
FAdapter.Free;
FAdapter:=tStringList.Create;
FSystem.Free;
FSystem:=TStringList.Create;
FUSB.Free;
FUSB:=tStringList.Create;
FPorts.Free;
FPorts:=tStringList.Create;
with TRegistry.Create do
Try
RootKey := HKEY_LOCAL_MACHINE;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\System\'+FormatFloat('0000',Count), False) do
Begin
FSystem.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\USB\'+FormatFloat('0000',Count), False) do
Begin
FUSB.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Ports\'+FormatFloat('0000',Count), False) do
Begin
FPorts.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Adapter\'+FormatFloat('0000',Count), False) do
Begin
FAdapter.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Media\'+FormatFloat('0000',Count), False) do
Begin
FMedia.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\SCSIAdapter\'+FormatFloat('0000',Count), False) do
Begin
FSCSI.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Printer\'+FormatFloat('0000',Count), False) do
Begin
FPrinter.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Mouse\'+FormatFloat('0000',Count), False) do
Begin
FMouse.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Monitor\'+FormatFloat('0000',Count), False) do
Begin
FMonitor.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Modem\'+FormatFloat('0000',Count), False) do
Begin
FModem.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Keyboard\'+FormatFloat('0000',Count), False) do
Begin
FKeyboard.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\3D Accelerators\'+FormatFloat('0000',Count), False) do
Begin
F3dAccel.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\CDROM\'+FormatFloat('0000',Count), False) do
Begin
FCDROM.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\PCMCIA\'+FormatFloat('0000',Count), False) do
Begin
FPCMCIA.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\Infrared\'+FormatFloat('0000',Count), False) do
Begin
FInfraRed.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\MultiFunction\'+FormatFloat('0000',Count), False) do
Begin
FMultiFun.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\HDC\'+FormatFloat('0000',Count), False) do
Begin
FHDC.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Count:=0;
While OpenKey('System\CurrentControlSet\Services\Class\FDC\'+FormatFloat('0000',Count), False) do
Begin
FFDC.AddObject(ReadString('DriverDesc'),tObject(ReadString('ProviderName')));
CloseKey;
Inc(count);
End;
Finally
Free;
End;
End;
constructor TLocaleInfo.Create;
Begin
inherited Create;
// RefreshInfo;
End;
destructor TLocaleInfo.Destroy;
Begin
inherited Destroy;
End;
procedure TLocaleInfo.RefreshInfo(LocaleID:Cardinal);
var Buffer : PChar;
BufLen : Integer;
Begin
BufLen:=255;
GetMem(Buffer,BufLen);
Try
GetLocaleInfo(LocaleID, LOCALE_SLANGUAGE, Buffer, BufLen);
FLang :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SENGLANGUAGE, Buffer, BufLen);
FEngLang :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SABBREVLANGNAME, Buffer, BufLen);
FAbbrLang :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_ICOUNTRY, Buffer, BufLen);
FCountry :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SCOUNTRY, Buffer, BufLen);
FFCountry :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SABBREVCTRYNAME, Buffer, BufLen);
FAbbrCtry :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SLIST, Buffer, BufLen);
FList :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_IMEASURE, Buffer, BufLen);
FMeasure :=Buffer;
case FMeasure[1] of
'0' : FMeasure := 'Decimal';
'1' : FMeasure := 'Usa';
end;
GetLocaleInfo(LocaleID, LOCALE_SDECIMAL, Buffer, BufLen);
FDecimal :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_IDIGITS, Buffer, BufLen);
FDigit :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SCURRENCY, Buffer, BufLen);
FCurrency :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SINTLSYMBOL, Buffer, BufLen);
FIntlSymbol:=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SMONDECIMALSEP, Buffer, BufLen);
FMonDecSep :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SMONTHOUSANDSEP, Buffer, BufLen);
FMonThoSep :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_ICURRDIGITS, Buffer, BufLen);
FCurrdigit :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_ICURRENCY, Buffer, BufLen);
FPCurrMode :=Buffer;
case FPCurrMode[1] of
'0': FPCurrMode := 'Prefix, no separation';
'1': FPCurrMode := 'Suffix, no separation';
'2': FPCurrMode := 'Prefix, 1-char. separation';
'3': FPCurrMode := 'Suffix, 1-char. separation';
end;
GetLocaleInfo(LocaleID, LOCALE_INEGCURR, Buffer, BufLen);
FNCurrMode :=Buffer;
case FNCurrMode[1] of
'0': FNCurrMode := '$1.1)';
'1': FNCurrMode := '-$1.1';
'2': FNCurrMode := '$-1.1';
'3': FNCurrMode := '$1.1-';
'4': FNCurrMode := '(1.1$)';
'5': FNCurrMode := '-1.1$';
'6': FNCurrMode := '1.1-$';
'7': FNCurrMode := '1.1$-';
'8': FNCurrMode := '-1.1 $ (space before $)';
'9': FNCurrMode := '-$ 1.1 (space after $)';
end;
GetLocaleInfo(LocaleID, LOCALE_SDATE, Buffer, BufLen);
FDate :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_STIME, Buffer, BufLen);
FTime :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_STIMEFORMAT, Buffer, BufLen);
FTimeFormat :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_SSHORTDATE, Buffer, BufLen);
FShortDate :=Buffer;
GetLocaleInfo(LocaleID, LOCALE_IDATE, Buffer, BufLen);
FShortDateOrdr :=Buffer;
case FShortDateOrdr[1] of
'0': FShortDateOrdr := 'Month-Day-Year';
'1': FShortDateOrdr := 'Day-Month-Year';
'2': FShortDateOrdr := 'Year-Month-Day';
end;
GetLocaleInfo(LocaleID, LOCALE_ILDATE, Buffer, BufLen);
FLongDateOrdr :=Buffer;
case FLongDateOrdr[1] of
'0': FLongDateOrdr := 'Month-Day-Year';
'1': FLongDateOrdr := 'Day-Month-Year';
'2': FLongDateOrdr := 'Year-Month-Day';
end;
GetLocaleInfo(LocaleID, LOCALE_ITIME, Buffer, BufLen);
FTimeFormatSpec :=Buffer;
case FTimeFormatSpec[1] of
'0': FTimeFormatSpec := 'AM / PM 12-hour format';
'1': FTimeFormatSpec := '24-hour format';
end;
GetLocaleInfo(LocaleID, LOCALE_ICENTURY, Buffer, BufLen);
FYearFormat :=Buffer;
case YearFormat[1] of
'0': YearFormat := 'Abbreviated 2-digit century';
'1': YearFormat := 'Full 4-digit century';
end;
Finally
FreeMem(Buffer,BufLen);
End;
End;
constructor TTimeZone.Create;
Begin
inherited Create;
// RefreshInfo;
End;
destructor TTimeZone.Destroy;
Begin
inherited Destroy;
End;
procedure TTimeZone.RefreshInfo;
var Information:_Time_Zone_Information;
Begin
GetTimeZoneInformation(Information);
with Information do
Begin
FBias:=Bias;
FDayLightBias:=DaylightBias;
FDaylightName:=DaylightName;
FStandardName:=StandardName;
FDaylightTime:=DaylightTime;
FStandardTime:=StandardTime;
End;
End;
constructor TDirectories.Create;
Begin
inherited Create;
// RefreshInfo;
End;
destructor TDirectories.Destroy;
Begin
inherited Destroy;
End;
{procedure TDirectories.RefreshInfo;
Begin
End;
}
constructor TDisk.Create;
Begin
inherited Create;
FDrive:='C:';
{ RefreshInfo;
}End;
destructor TDisk.Destroy;
Begin
inherited Destroy;
End;
procedure TDisk.GetDiskInfo(Drive:String);
var DriveType : Integer;
// I : Int64;
vSectorsPerCluster : Cardinal;
vBytesPerSector : Cardinal;
vNumberOfFreeCluster : Cardinal;
vTotalNumberOfCluster : Cardinal;
vTotalNumberOfBytes : Int64;
vTotalNumberOfFreeBytes : Int64; { Quotas for the calling thread }
vClusterSize : Cardinal;
vFreeBytes : Cardinal;
MaxFilenameLength,
FSFlags : DWord;
VolumeLabel,
FileSystem : Array[0..$FF] of Char;
begin
DriveType := GetDriveType(PChar(Drive[1]+':\'));
if DriveType in [0,1] then Exit;
Case DriveType of
0 : FDriveType:=dtUnknown;
1 : FDriveType:=dtRootNotFound;
DRIVE_REMOVABLE : FDriveType:=dtRemovable;
DRIVE_FIXED : FDriveType:=dtFixed;
DRIVE_REMOTE : FDriveType:=dtRemote;
DRIVE_CDROM : FDriveType:=dtCdrom;
DRIVE_RAMDISK : FDriveType:=dtRAMDISK;
End;
FDrive:=Drive;
If GetVolumeInformation(PChar(Drive[1] + ':\'), @VolumeLabel, SizeOf(VolumeLabel),
@FSerialNumber, MaxFilenameLength, FSFlags, @FileSystem, SizeOf(FileSystem)) then
Begin
FVolumeLabel:=VolumeLabel;
FFileSystem:=FileSystem;
FFileSystemFlag:=[];
If (FSFlags and FS_CASE_IS_PRESERVED)=FS_CASE_IS_PRESERVED then
FFileSystemFlag:=FFileSystemFlag+[fsCaseIsPreserved];
If (FSFlags and FS_CASE_SENSITIVE)=FS_CASE_SENSITIVE then
FFileSystemFlag:=FFileSystemFlag+[fsCaseSensitive];
If (FSFlags and FS_UNICODE_STORED_ON_DISK)=FS_UNICODE_STORED_ON_DISK then
FFileSystemFlag:=FFileSystemFlag+[fsUnicodeStoredOnDisk];
If (FSFlags and FS_PERSISTENT_ACLS)=FS_FILE_COMPRESSION then
FFileSystemFlag:=FFileSystemFlag+[fsFileCompression];
If (FSFlags and FS_PERSISTENT_ACLS)=FS_VOL_IS_COMPRESSED then
FFileSystemFlag:=FFileSystemFlag+[fsVolIsCompressed];
FSerialNumberText := IntToHex(HiWord(FSerialNumber), 4) + '-' + IntToHex(LoWord(FSerialNumber), 4);
End;
FReady:=(SysUtils.DiskSize(Ord(Drive[1])-Ord('A')+1)<>-1);
If Not FReady then Exit; { Keep it silent }
{ Delphi Codes
I:=SysUtils.DiskSize(Ord(Drive[1])-Ord('A')+1);
If I<>-1 then
FDiskSize:=Inttostr(I) else FDiskSize:='drive invalid';
I:=SysUtils.DiskFree(Ord(Drive[1])-Ord('A')+1);
If I<>-1 then
FDiskFree:=Inttostr(I) else FDiskFree:='drive invalid';
}
if GetDiskFreeSpace(PChar(Drive[1]+':\'), vSectorsPerCluster,
vBytesPerSector, vNumberOfFreeCluster,
vTotalNumberOfCluster ) then
begin
vClusterSize := vSectorsPerCluster * vBytesPerSector;
End;
// this function works on Win95 Osr2 or later, Win98, NT 4.0 all version
if NOT GetDiskFreeSpaceEx(PChar(Drive[1]+':\'), vTotalNumberOfFreeBytes, vTotalNumberOfBytes, @vFreeBytes) then begin
vFreeBytes := vClusterSize * vNumberOfFreeCluster;
vTotalNumberOfBytes := vClusterSize * vTotalNumberOfCluster;
end;
FSectorsPerCluster :=IntToStr(vSectorsPercluster);
FBytesPerSector :=IntToStr(vBytesPerSector);
FNumberOfFreeCluster :=IntToStr(vNumberOfFreeCluster);
FTotalNumberOfCluster :=IntToStr(vTotalNumberOfcluster);
FTotalNumberOfBytes :=IntToStr(vTotalNumberOfBytes);
FTotalNumberOfFreeBytes :=IntToStr(vTotalNumberOfFreeBytes);
FClusterSize :=IntToStr(vClusterSize);
FFreeBytes :=IntToStr(vFreeBytes);
End;
Procedure TDisk.SetDrive(Drive:String);
Begin
If (Drive<>FDrive) then
Begin
GetDiskInfo(Drive);
End;
End;
procedure TDisk.RefreshInfo;
Begin
GetDiskInfo(FDrive);
End;
constructor TUser.Create;
Begin
inherited Create;
FLocaleInfo:=tLocaleInfo.Create;
// RefreshInfo;
End;
destructor TUser.Destroy;
Begin
FLocaleInfo.Free;
inherited Destroy;
End;
procedure TUser.RefreshInfo;
Begin
FLocaleInfo.RefreshInfo(LOCALE_USER_DEFAULT);
FUsrLangDefID := Format('$%.4x',[GetUserDefaultLangID]);
FUsername:=GetCurrentUsername;
End;
constructor TCPU.Create;
Begin
inherited Create;
FProcessorID:=tStringList.Create;
// RefreshInfo;
End;
destructor TCPU.Destroy;
Begin
FProcessorID.Free;
inherited Destroy;
End;
procedure TCPU.RefreshInfo;
var SI : _SYSTEM_INFO;
CPUID : tCPUID;
I : Integer;
Count : Integer;
Begin
GetSystemInfo(SI);
With SI do
Begin
FProcessorArchitecture:=wProcessorArchitecture;
FProcessorCount:=dwNumberOfProcessors;
FProcessorLevel:=wProcessorLevel;
FProcessorRevision:=wProcessorRevision;
FProcessorVersion := Format('Level %d Rev. %d.%d',
[wProcessorLevel, hi(wProcessorRevision), lo(wProcessorRevision)]);
case dwProcessorType of
386 : FProcessorType := 'Intel 386';
486 : FProcessorType := 'Intel 486';
586 : FProcessorType := 'Intel Pentium';
4000 : FProcessorType := 'MIPS RISC 4000';
21064 : FProcessorType := 'ALPHA 21064';
else FProcessorType:='Unknown';
end;
FProcessorOEMid:=dwOEMid;
End;
{ Meassuring CPU Speed }
FFreq:=Format('%f', [GetCPUSpeed]);
FCPUID:=IsCPUIDAvailable;
If FCPUID then
Begin
For I := Low(CPUID) to High(CPUID) do CPUID[I] := -1;
CPUID := GetCPUID;
FType :=CPUID[1] shr 12 and 3;
FFamily:=CPUID[1] shr 8 and $f;
FModel:=CPUID[1] shr 4 and $f;
FStepping:=CPUID[1] and $f;
FVendor:=GetCPUVendor;
End;
FProcessorID.Free;
FProcessorID:=tStringList.create;
with TRegistry.Create do
Try
RootKey := HKEY_LOCAL_MACHINE;
For Count:= 0 to FProcessorCount-1 do
if OpenKey('Hardware\Description\System\CentralProcessor\'+Inttostr(count), False) then
Begin
If ValueExists('Identifier') then FProcessorID.Add(ReadString('Identifier'));
CloseKey;
End;
Finally
Free;
End;
End;
constructor TMemory.Create;
Begin
inherited Create;
// RefreshInfo;
End;
destructor TMemory.Destroy;
Begin
inherited Destroy;
End;
procedure TMemory.RefreshInfo;
var MS : TMemoryStatus;
SI : _System_Info;
Begin
MS.dwLength:=SizeOf(MS);
GlobalMemoryStatus(MS);
With MS do
Begin
FMemoryLoad:=dwMemoryLoad;
FTotalPhys:=dwTotalPhys;
FAvailPhys:=dwAvailPhys;
FTotalVirtual:=dwTotalVirtual;
FAvailVirtual:=dwAvailVirtual;
FTotalPageFile:=dwTotalPageFile;
FAvailPageFile:=dwAvailPageFile;
FSwapFileSize := Trunc((dwTotalPageFile-dwAvailPageFile));
FSwapFileUsage := 100-trunc(dwAvailPageFile/dwTotalPageFile*100);
End;
GetSystemInfo(SI);
With SI do
Begin
FPageSize:=dwPageSize;
FAllocGranularity:=dwAllocationGranularity;
FMinAppAddr:=LongInt(lpMinimumApplicationAddress);
FMaxAppAddr:=LongInt(lpMaximumApplicationAddress);
End;
End;
constructor TResources.Create;
Begin
inherited Create;
// RefreshInfo;
End;
destructor TResources.Destroy;
Begin
inherited Destroy;
End;
{
procedure TResources.RefreshInfo;
Begin
FSystemRes:=GetFreeSysResources(GFSR_SystemRes); // In Percent
FGDIRes := GetFreeSysResources(GFSR_GDIRes); // In Percent
FUserRes := GetFreeSysResources(GFSR_USERRes); // In Percent
End;
}
constructor TOperatingSystem.Create;
Begin
inherited Create;
FResources :=tResources.Create;
FDirectories:=tDirectories.Create;
FUser :=tUser.Create;
FTimeZone :=tTimeZone.Create;
FLocaleInfo:=tLocaleInfo.Create;
FUpdates:=tStringList.Create;
// RefreshInfo;
End;
destructor TOperatingSystem.Destroy;
Begin
FUpdates.Free;
FLocaleInfo.Free;
FResources.Free;
FTimeZone.Free;
FUser.Free;
FDirectories.Free;
inherited Destroy;
End;
procedure TOperatingSystem.RefreshInfo;
var OS : tOSVERSIONINFO;
CurRegKey : PChar;
Buf : array [0..3] of byte;
I : Integer;
PathArray : array [0..255] of char;
WinH : Hwnd;
Begin
FUpdates.Free;
FUpdates:=tStringList.Create;
FLocaleInfo.RefreshInfo(LOCALE_USER_DEFAULT);
FUser.RefreshInfo;
FTimeZone.RefreshInfo;
// FResources.RefreshInfo;
with TRegistry.Create do
Try
RootKey := HKEY_LOCAL_MACHINE;
If OpenKey('Software\Microsoft\Windows\CurrentVersion\Setup',False) then
Begin
FBootDrive:=ReadString('BootDir');
CloseKey;
End;
If OpenKey('Software\Microsoft\Windows\CurrentVersion\Setup\Updates',False) then
Begin
GetValuenames(FUpdates);
For I:=0 to FUpdates.Count-1 do
Begin
if (FUpdates.Strings[I]='') or
(FUpdates.Strings[I]='CLSID') then
FUpdates.Strings[I]:='' else
FUpdates.Strings[I]:=FUpdates.Strings[I]+
Format(' (%s)',[ ReadString( FUpdates.Strings[I] ) ]);
End;
I:=0;
Repeat
If FUpdates.Strings[I]='' then FUpdates.Delete(I) else
Inc(I);
Until I=FUpdates.Count-1;
CloseKey;
End;
Finally
Free;
End;
OS.dwOSVersionInfoSize := sizeof(TOSVERSIONINFO);
GetVersionEx(OS);
case OS.dwPlatformId of
VER_PLATFORM_WIN32s : FPlatform := 'Windows 3.1x/32s';
VER_PLATFORM_WIN32_WINDOWS : FPlatform := 'Windows 95';
VER_PLATFORM_WIN32_NT : FPlatform := 'Windows NT';
else
FPlatForm:='Unknown'; { For Future .... }
end;
with OS do
begin
FWinBuild := LOWORD(dwBuildNumber);
FWinMajVer :=dwMajorVersion;
FWinMinVer :=dwMinorVersion;
FCSDVersion :=szCSDVersion;
FWinVersion :=Format('%d.%d (%d.%s)',
[dwMajorVersion, dwMinorVersion,(dwBuildNumber and $FFFF), szCSDVersion]);
end;
FSysLangDefID:=Format('$%.4x',[GetSystemDefaultLangID]);
{ Getting Registration Info ... }
case OS.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS : CurRegKey := '\SOFTWARE\Microsoft\Windows\CurrentVersion';
VER_PLATFORM_WIN32_NT : CurRegKey := '\SOFTWARE\Microsoft\Windows NT\CurrentVersion';
else CurRegKey := nil;
end;
with TRegistry.Create do
Try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey(CurRegKey, False) then
Begin
FRegOwner := ReadString('RegisteredOwner');
FRegOrg := ReadString('RegisteredOrganization');
FProductID := ReadString('ProductID');
FProductKey := ReadString('ProductKey');
FProductName:= ReadString('ProductName');
I := Readbinarydata ('FirstInstallDateTime',buf,sizeof(buf));
FVersion := ReadString('Version');
//=================================================================================================
//操作版本失效 cactus123456
// FInstallDate:=DateTimeToStr(FileDateToDateTime(buf[0]+buf[1]*256+buf[2]*65535+buf[3]*16777216));
FBootCount := ReadString('BootCount');
With FDirectories do
Begin
FCommonFiles :=ReadString('CommonFilesDir');
FProgramFiles :=ReadString('ProgramFilesDir');
FDevice :=ReadString('DevicePath');
FOtherDevice :=ReadString('OtherDevicePath');
FMedia :=ReadString('MediaPath');
FConfig :=ReadString('ConfigPath');
FWallpaper :=ReadString('WallPaperDir');
FillChar(PathArray, SizeOf(PathArray), #0);
GetWindowsDirectory(PathArray,255);
FWindows :=PathArray;
FillChar(PathArray, SizeOf(PathArray), #0);
// ExpandEnvironmentStrings('%TEMP%', PathArray, 255);
{ Much Saver, Just use WinAPI Function }
GetTempPath(255,@PathArray);
FTemp := PathArray;
{ Kill the Backslash }
If FTemp[Length(FTemp)]='\' then
Delete(Ftemp,length(FTemp),1);
FillChar(PathArray, SizeOf(PathArray), #0);
GetSystemDirectory(@PathArray,255);
FSystem:=PathArray;
WinH:=GetDesktopWindow;
FAppData :=GetSpesialFolder(WinH,CSIDL_APPDATA);
FCommonDesktopDir :=GetSpesialFolder(WinH,CSIDL_COMMON_DESKTOPDIRECTORY);
FCommonAltStartUp :=GetSpesialFolder(WinH,CSIDL_COMMON_ALTSTARTUP);
FBitBucket :=GetSpesialFolder(WinH,CSIDL_BITBUCKET);
FCommonPrograms :=GetSpesialFolder(WinH,CSIDL_COMMON_PROGRAMS);
FCommonStartMenu :=GetSpesialFolder(WinH,CSIDL_COMMON_STARTMENU);
FCommonStartup :=GetSpesialFolder(WinH,CSIDL_COMMON_STARTUP);
FCommonFavorites :=GetSpesialFolder(WinH,CSIDL_COMMON_FAVORITES);
FCookies :=GetSpesialFolder(WinH,CSIDL_COOKIES);
FControls :=GetSpesialFolder(WinH,CSIDL_CONTROLS);
FDesktop :=GetSpesialFolder(WinH,CSIDL_DESKTOP);
FDesktopDir :=GetSpesialFolder(WinH,CSIDL_DESKTOPDIRECTORY);
FFavorites :=GetSpesialFolder(WinH,CSIDL_FAVORITES);
FDrives :=GetSpesialFolder(WinH,CSIDL_DRIVES);
FFonts :=GetSpesialFolder(WinH,CSIDL_FONTS);
FHistory :=GetSpesialFolder(WinH,CSIDL_HISTORY);
FInternet :=GetSpesialFolder(WinH,CSIDL_INTERNET);
FInternetCache :=GetSpesialFolder(WinH,CSIDL_INTERNET_CACHE);
FNetWork :=GetSpesialFolder(WinH,CSIDL_NETWORK);
FNetHood :=GetSpesialFolder(WinH,CSIDL_NETHOOD);
FPersonal :=GetSpesialFolder(WinH,CSIDL_PERSONAL);
FPrintHood :=GetSpesialFolder(WinH,CSIDL_PRINTHOOD);
FPrinters :=GetSpesialFolder(WinH,CSIDL_PRINTERS);
Fprograms :=GetSpesialFolder(WinH,CSIDL_PROGRAMS);
FRecent :=GetSpesialFolder(WinH,CSIDL_RECENT);
FSendTo :=GetSpesialFolder(WinH,CSIDL_SENDTO);
FStartMenu :=GetSpesialFolder(WinH,CSIDL_STARTMENU);
FStartUp :=GetSpesialFolder(WinH,CSIDL_STARTUP);
FTemplates :=GetSpesialFolder(WinH,CSIDL_TEMPLATES);
End;
CloseKey;
End;
Finally
Free;
End;
End;
constructor TDrive.Create;
Begin
inherited Create;
FDisk:=tDisk.Create;
// RefreshInfo;
End;
destructor TDrive.Destroy;
Begin
FDisk.Free;
inherited Destroy;
End;
procedure TDrive.RefreshInfo;
var DriveChar:Char;
DriveType:Integer;
CurrDrive:String;
Begin
FDisk.RefreshInfo;
FAvailDrive:='';
For DriveChar:='A' to 'Z' do
begin
CurrDrive := DriveChar + ':\';
DriveType := GetDriveType(PChar(CurrDrive));
if DriveType in [0,1] then Continue; // Invalid drive specification
FAvailDrive:=FAvailDrive+DriveChar;
End;
End;
constructor TMouse.Create;
Begin
inherited Create;
// RefreshInfo;
End;
destructor TMouse.Destroy;
Begin
inherited Destroy;
End;
procedure TMouse.RefreshInfo;
Begin
FAvailable:=Boolean(GetSystemMetrics(SM_MOUSEPRESENT));
If Not Favailable then Exit;
FButtons:=GetSystemMetrics(SM_CMOUSEBUTTONS);
FSwapButton:=Boolean(GetSystemMetrics(SM_SWAPBUTTON));
FMouseWheel:=Boolean(GetSystemMetrics(SM_MOUSEWHEELPRESENT));
FDoubleClickTime:=GetDoubleClickTime;
with TRegistry.Create do
Try
RootKey := HKEY_LOCAL_MACHINE;
{ Assume all Computer only have 1 mouse }
if OpenKey('System\CurrentControlSet\Services\Class\Mouse\0000', False) then
Begin
FMouseType:=ReadString('MouseType');
FDescription:=ReadString('DriverDesc');
FProvider:=ReadString('ProviderName');
CloseKey;
End;
Finally
Free;
End;
End;
constructor TAPM.Create;
Begin
inherited Create;
// RefreshInfo;
End;
destructor TAPM.Destroy;
Begin
inherited Destroy;
End;
procedure TAPM.RefreshInfo;
var
SystemPowerstatus:_System_Power_Status;
Begin
GetSystemPowerStatus(SystemPowerStatus);
Case SystemPowerStatus.ACLineStatus of
0 : FAcLineStatus:='Offline';
1 : FAcLineStatus:='Online';
255 : FAcLineStatus:='Unknown Status';
End;
Case SystemPowerStatus.BatteryFlag of
1 : FBatteryFlag:='High';
2 : FBatteryFlag:='Low';
4 : FBatteryFlag:='Critical';
8 : FBatteryFlag:='Charging';
128 : FBatteryFlag:='No System Battery';
255 : FBatteryFlag:='Unknown Status';
End;
FBatteryLifePercent:=SystemPowerStatus.BatteryLifePercent;
FBatteryLifeTime:=SystemPowerStatus.BatteryLifeTime;
FBatteryFullLifeTime:=SystemPowerStatus.BatteryFullLifeTime;
End;
constructor TWorkStation.Create;
Begin
inherited Create;
// RefreshInfo;
End;
destructor TWorkstation.Destroy;
Begin
inherited Destroy;
End;
procedure TWorkstation.RefreshInfo;
Begin
FBIOSName:=GetBIOSName;
FBIOSDate:=DateTimeToStr(GetBIOSDate);
FBIOSCopyright:=GetBIOSCopyright;
FBIOSExtendedInfo:=GetBIOSExtendedInfo;
FUsername:=GetCurrentUsername;
FComputerName:=GetCurrentComputerName;
with TRegistry.Create do
Try
RootKey := HKEY_LOCAL_MACHINE;
LazyWrite:=False;
if OpenKey('System\CurrentControlSet\Services\VxD\VNETSUP', False) then
Begin
If ValueExists('Workgroup') then FWorkgroup:=ReadString('Workgroup');
If ValueExists('Comment') then FComment:=ReadString('Comment');
CloseKey;
End;
Finally
Free;
End;
End;
constructor TSystemInfo.Create(AOwner: TComponent);
Begin
inherited Create(AOwner);
FWorkStation:=tWorkStation.Create;
FMouse:=tMouse.Create;
FAPM:=tAPM.Create;
FDrive:=TDrive.Create;
FOS:=tOperatingSystem.Create;
FMemory:=tMemory.create;
FDevice:=tDevice.Create;
FDirectX:=tDirectX.Create;
FCPU:=tCPU.Create;
FNetwork:=tNetWork.Create;
FDisplay:=tDisplay.Create;
FKeyboard:=tKeyboard.Create;
Status:='Need to be refresh';
If FAutoRefresh then RefreshInfo;
End;
destructor TSystemInfo.Destroy;
Begin
inherited Destroy;
FNetwork.Free;
FDevice.Free;
FDirectX.Free;
FWorkstation.Free;
FOS.Free;
FMemory.Free;
FMouse.Free;
FAPM.Free;
FDrive.Free;
FCPU.Free;
FDisplay.Free;
FKeyboard.Free;
End;
procedure tSystemInfo.SetStatus(Status:String);
begin
FStatus:=Status;
If Assigned(FOnStatusChange) then FOnStatusChange(Self);
End;
Procedure tSystemInfo.RefreshInfo;
var Start : Integer;
H,M,S : Integer;
Procedure TickToTime(Tick:Integer;Var Hour, Minute, Sec : Integer);
Begin
Tick:=Tick div 1000;
Hour:=(Tick div 3600);
Minute:=(Tick mod 3600) div 60;
Sec:=((Tick mod 3600) mod 60);
End;
Begin
SetStatus('Refreshing Info Start at '+DateTimeToStr(Now));
If Assigned(FOnRefreshStart) then FOnRefreshStart(Self);
Start:=GetTickCount;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Operating System');
FOS.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Keyboard');
FKeyboard.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Display');
FDisplay.RefreshInfo(0);
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Network');
FNetwork.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'DirectX');
FDirectX.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Device');
FDevice.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'CPU');
FCPU.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Memory');
FMemory.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Mouse');
FMouse.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Drive');
FDrive.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Mouse');
FMouse.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'APM');
FAPM.RefreshInfo;
If Assigned(FOnRefreshInfo) then FOnRefreshInfo(Self,'Workstation');
FWorkStation.RefreshInfo;
If Assigned(FOnRefreshFinish) then FOnRefreshFinish(Self);
SetStatus('Refreshing Info Finish at '+DateTimeToStr(Now));
SetStatus(Format('Refreshing time %d ms',[GetTickCount-Start]));
End;
procedure tSystemInfo.SetAutoRefresh(Value:Boolean);
Begin
If (Value<>FAutoRefresh) then
Begin
FAutoRefresh:=Value;
If Value then RefreshInfo;
End;
End;
procedure Register;
begin
RegisterComponents('Jazarsoft', [TSystemInfo]);
end;
end.
