|
(评分: , 回复: 0, 阅读: 148)
{******************************************************************************}
{******************************************************************************}
{ 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 asthis header and }
{ copyrightinformation 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 aparticular 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;
destructorDestroy;override;
procedure RefreshInfo;
published
property Numlock : BooleanRead FNumlockWrite FNumlock;
property ScrollLock: BooleanRead FScrollLockWrite FScrollLock;
property Capslock: BooleanRead FCapslockWrite 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 FDACTypeWrite FDACType;
property Revision: String Read FRevision Write FRevision;
property AGP : BooleanRead FAGPWrite FAGP;
property Processor3D : BooleanRead F3dProcessorWrite 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 : stringread FStandardName write FStandardName;
property StandardTime : TDateTimeread FStandardTime write FStandardTime;
property DaylightName : Stringread FDaylightName write FDaylightName;
property DaylightTime : TDateTimeread FDaylightTime write FDaylightTime;
property DayLightBias : Integerread 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;
procedureRefreshInfo;
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 FBytesPerSectorwrite FBytesPerSector;
property FreeCluster : String read FNumberOfFreeCluster write FNumberOfFreeCluster ;
property TotalCluster: String read FTotalNumberOfClusterwrite FTotalNumberOfCluster;
property TotalBytes: String read FTotalNumberOfByteswrite FTotalNumberOfBytes;
// property NumberOfFreeBytes : String read FTotalNumberOfFreeByteswrite 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 ReadFProcessorTypeWrite FProcessorType;
Property Version : String ReadFProcessorVersionWrite FProcessorVersion;
property Freq: String ReadFFreq 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;
destructorDestroy; 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 : TAPMRead 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}
PUSHEAX{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
PUSHEBX {Save affected register}
PUSHEDI
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
PUSHEBX{Save affected register}
PUSHEDI
MOV EDI,EAX{@Result (TVendor)}
MOV EAX,0
DW$A20F{CPUID Command}
MOV EAX,EBX
XCHGEBX,ECX {save ECX result}
MOVECX,4
@1:
STOSB
SHR EAX,8
LOOP@1
MOV EAX,EDX
MOVECX,4
@2:
STOSB
SHR EAX,8
LOOP@2
MOV EAX,EBX
MOVECX,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;
varKeys: 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:=tString
|
