delphi 显示CPU频率，内存，主板型号，显卡型号等硬件信息

控件需要可以显示CPU频率，内存，主板型号，显卡型号等硬件信息，还需要显示CPU占用率，GDI,USER资源，内存占用等软件信息，信息越多越好。如果一个控件不行，多个也可！  

unit MainDlg;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Registry;

type
TMainForm = class(TForm)
MemoBox: TMemo;
CloseBtn: TButton;
procedure GetOSVersionInfo;
procedure GetDriveNames;
procedure GetDirectories;
procedure GetSystemInfo;
procedure GetDiskInfo;
procedure GetVolumeInfo;
procedure GetCurrentDir;
procedure GetComputerName;
procedure GetRegisterInfo;
procedure GetNetInfo;
procedure GetPowerInfo;
{ -o- }
procedure FormShow(Sender: TObject);
procedure CloseBtnClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

const
CrLf = #13#10;

{===============================================================================
I've made the choice to load all the results in a record for a more simple
output.
}
type
SystemInfoRecord = record
{- Disk Section }
SectorsPerCluster,
BytesPerSector,
FreeClusters,
TotalClusters,
FreeBytes,
TotalBytes : DWORD;
VolumeName,
VolumeSerial,
FileSystemName,
Drives : string;
{- Processor Section }
ProcessorType : string;
ProcessorNum : integer;
ProcessorOemId : integer;
{- Directory Section }
CurrentDir,
SystemDir,
WindowsDir : string;
{- Windows Section }
Version,
Plattform : string;
PlattId : DWORD;
{- Property Section }
UserConName,
ComputerName,
FPU,
UserName,
CompanyName,
CDSerial : string;
end;

var
MainForm: TMainForm;
SysInfoRec: SystemInfoRecord;

implementation

{$R *.DFM}

var
OSVerInfo: TOSVersionInfo;

{===============================================================================
}
procedure TMainForm.GetComputerName;
var
Computer : PChar;
CSize : DWORD;
begin
Computer := #0;
CSize := MAX_COMPUTERNAME_LENGTH + 1;
try
GetMem( Computer, CSize );
if Windows.GetComputerName( Computer, CSize ) then
SysInfoRec.ComputerName := Computer;
finally
FreeMem( Computer );
end;
end; {- GetComputerName }

{===============================================================================
}
procedure TMainForm.GetCurrentDir;
var
BufLen : DWORD;
Buffer : PChar;
begin
try
GetMem( Buffer, MAX_PATH + 1 );
if Windows.GetCurrentDirectory( BufLen, Buffer ) > 0 then
SysInfoRec.CurrentDir := Buffer;
finally
FreeMem( Buffer );
end; // try
end; {- GetCurrentDir }

{===============================================================================
}
procedure TMainForm.GetVolumeInfo;
var
lpRootPathName : PChar;
lpVolumeNameBuffer : PChar;
nVolumeNameSize : DWORD;
lpVolumeSerialNumber : DWORD;
lpMaximumComponentLength : DWORD;
lpFileSystemFlags : DWORD;
lpFileSystemNameBuffer : PChar;
nFileSystemNameSize : DWORD;
begin
try
GetMem( lpVolumeNameBuffer, MAX_PATH + 1 );
GetMem( lpFileSystemNameBuffer, MAX_PATH + 1 );

nVolumeNameSize := MAX_PATH + 1;
nFileSystemNameSize := MAX_PATH + 1;

lpRootPathName := PChar( 'C:/' );
if Windows.GetVolumeInformation( lpRootPathName,
lpVolumeNameBuffer,
nVolumeNameSize,
@lpVolumeSerialNumber,
lpMaximumComponentLength,
lpFileSystemFlags,
lpFileSystemNameBuffer,
nFileSystemNameSize ) then
begin
with SysInfoRec do begin
VolumeName := lpVolumeNameBuffer;
VolumeSerial := Format('%d',[lpVolumeSerialNumber]);
FileSystemName := lpFileSystemNameBuffer;
end;
end;
finally
FreeMem( lpVolumeNameBuffer );
FreeMem( lpFileSystemNameBuffer );
end; // try
end; {- GetVolumeInfo }

{===============================================================================
}
procedure TMainForm.GetOSVersionInfo;

function Plat(Pl: DWORD): string;
begin
case Pl of
VER_PLATFORM_WIN32s: result := 'Win32s on Windows 3.1';
VER_PLATFORM_WIN32_WINDOWS: result := 'Win32 on Windows 95';
VER_PLATFORM_WIN32_NT: result := 'Windows NT';
else result := '???';
end;
end;

begin

with OSVerInfo, SysInfoRec do begin
dwOSVersionInfoSize := SizeOf(OSVerInfo);
if GetVersionEx(OSVerInfo) then;
Version := Format('%d.%d (%d.%s)',[dwMajorVersion, dwMinorVersion,
(dwBuildNumber and $FFFF), szCSDVersion]);
Plattform := Plat(dwPlatformId);
PlattID := dwPlatformId;
end;
end; {- GetOSVersionInfo }

{===============================================================================
}
procedure TMainForm.GetDriveNames;
var
D1 : set of 0..25;
D2 : integer;
begin
DWORD( D1 ) := Windows.GetLogicalDrives;
with SysInfoRec do begin
for D2 := 0 to 25 do
if D2 in D1 then
Drives := Drives + Chr( D2 + Ord( 'A' )) + ': ';
end;
end; {- GetDriveNames }

{===============================================================================
}
procedure TMainForm.GetDirectories;
var nSize: integer;
Names: Pchar;
begin
Names := #0;
try
GetMem( Names, MAX_PATH+1 );
nSize := GetSystemDirectory(Names, MAX_PATH+1);
SysInfoRec.SystemDir := StrPas(Names);
nSize := GetWindowsDirectory(Names, MAX_PATH+1);
SysInfoRec.WindowsDir := StrPas(Names);
finally
FreeMem( Names );
end;
end; {- GetDirectories }

{===============================================================================
}
procedure TMainForm.GetSystemInfo;
var TmpStr: string;
MProc: string;
LocalSI: TSystemInfo;
const
PROCESSOR_INTEL_386 = 386;
PROCESSOR_INTEL_486 = 486;
PROCESSOR_INTEL_PENTIUM = 586;
PROCESSOR_MIPS_R4000 = 4000;
PROCESSOR_ALPHA_21064 = 21064;
begin
Windows.GetSystemInfo(LocalSI);

with LocalSI, SysInfoRec do begin
ProcessorOemId := dwOemId;
ProcessorNum := dwNumberOfProcessors;
case dwProcessorType of
PROCESSOR_INTEL_386 : ProcessorType := ' 386';
PROCESSOR_INTEL_486 : ProcessorType := ' 486';
PROCESSOR_INTEL_PENTIUM : ProcessorType := ' Pentium';
PROCESSOR_MIPS_R4000 : ProcessorType := ' MIPS';
PROCESSOR_ALPHA_21064 : ProcessorType := ' ALPHA';
end;
end;
end; {- GetSystemInfo }

{===============================================================================
}
procedure TMainForm.GetDiskInfo;
var TmpStr: string;
RootPathName: Pchar;
SectorsPerCluster,
BytesPerSector,
FreeClusters,
TotalClusters,
FreeBytes,
TotalBytes : DWORD;
begin

with SysInfoRec do begin
RootPathName := Pchar('C:/');
if GetDiskFreeSpace( RootPathName, SectorsPerCluster,
BytesPerSector, FreeClusters,
TotalClusters ) then;
FreeBytes := SectorsPerCluster * BytesPerSector * FreeClusters;
TotalBytes := SectorsPerCluster * BytesPerSector * TotalClusters;
end; {- with }
end; {- GetDiskInfo }

{===============================================================================
}
procedure TMainForm.GetRegisterInfo;
const
FPPKey = '/hardware/DESCRIPTION/System/FloatingPointProcessor';
var
CurVerKey : PChar;
begin
with SysInfoRec do begin
case PlattID of
VER_PLATFORM_WIN32_WINDOWS :
CurVerKey := '/SOFTWARE/Microsoft/Windows/CurrentVersion';
VER_PLATFORM_WIN32_NT :
CurVerKey := '/SOFTWARE/Microsoft/Windows NT/CurrentVersion';
else CurVerKey := nil;
end;

with TRegistry.Create do
try
RootKey := HKEY_LOCAL_MACHINE;
if OpenKey(FPPKey, False) then
FPU := 'Yes'
else FPU := 'No';

if OpenKey(CurVerKey, False) then begin
UserName := ReadString('RegisteredOwner');
CompanyName := ReadString('RegisteredOrganization');
if PlattID = VER_PLATFORM_WIN32_WINDOWS then
CDSerial := ReadString('ProductID');
end; {- if }
finally
Free;
end; {- try }
end; {- with }
end; {- GetRegisterInfo }
{===============================================================================
}
procedure TMainForm.GetNetInfo;
var
BufLen : DWORD;
Buffer : PChar;
begin
BufLen := 32+1;
Buffer := #0;
try
GetMem( Buffer, BufLen );
case WNetGetUser(nil, Buffer, BufLen) of
NO_ERROR: SysInfoRec.UserConName := Buffer;
ERROR_NOT_CONNECTED: SysInfoRec.UserConName := 'Not Connected';
ERROR_NO_NETWORK: SysInfoRec.UserConName := 'No Network';
else SysInfoRec.UserConName := 'Other Network error';
end;
finally
FreeMem( Buffer );
end; // try
end; {- GetNetInfo }
{===============================================================================
NOT COMPLETED & TESTED
}
procedure TMainForm.GetPowerInfo;
var PowerRec: TSystemPowerStatus;
begin
MemoBox.Lines.Add(CrLf+'----------[ SYSTEM POWER STATUS ]----------');
if GetSystemPowerStatus(PowerRec) then ;
with PowerRec do begin
MemoBox.Lines.Add('ACLine Status: '+ Format('%d', [ACLineStatus]) );
MemoBox.Lines.Add('Battery Flag: '+ Format('%d', [BatteryFlag]) );
MemoBox.Lines.Add('Battery Life %: '+ Format('%d%', [BatteryLifePercent]) );
MemoBox.Lines.Add('Battery Life Time: '+ Format('%d', [BatteryLifeTime]) );
MemoBox.Lines.Add('Battery Full Life Time: '+ Format('%d', [BatteryFullLifeTime]) );
end;
end; {- GetPowerInfo }
{===============================================================================
}
procedure TMainForm.FormShow(Sender: TObject);
var TmpStr: string;
begin
GetDirectories;
GetOSVersionInfo;
GetDriveNames;
GetDiskInfo;
GetSystemInfo;
GetVolumeInfo;
GetCurrentDir;
GetComputerName;
GetRegisterInfo;
GetNetInfo;
with SysInfoRec do begin
MemoBox.Lines.Add(CrLf+'----------[ WINDOWS & USER ]----------');
MemoBox.Lines.Add('Computer Name: '+ComputerName);
MemoBox.Lines.Add('Name: ' + VolumeName + ' - Serial: ' +
VolumeSerial + ' - File System: ' + FileSystemName);
MemoBox.Lines.Add(Format('Version %s Platform: %s', [Version, Plattform] ));
MemoBox.Lines.Add('CD Serial No: '+ CDSerial);
MemoBox.Lines.Add('User Name: '+ UserName);
MemoBox.Lines.Add('Company Name: '+ CompanyName);
MemoBox.Lines.Add('User Connection Name: '+ UserConName);
MemoBox.Lines.Add(CrLf+'----------[ DISK ]----------');
MemoBox.Lines.Add('Drives: '+Drives);
MemoBox.Lines.Add('Current Directory: '+CurrentDir);
MemoBox.Lines.Add('System Directory: '+SysInfoRec.SystemDir);
MemoBox.Lines.Add('Windows Directory: '+SysInfoRec.WindowsDir);
MemoBox.Lines.Add(Format('Sectors per Cluster: %.0n', [SectorsPerCluster*1.0]));
MemoBox.Lines.Add(Format('Bytes per Sector: %.0n', [BytesPerSector*1.0]));
MemoBox.Lines.Add(Format('Free Clusters: %.0n', [FreeClusters*1.0]));
MemoBox.Lines.Add(Format('Total Clusters: %.0n', [TotalClusters*1.0]));
MemoBox.Lines.Add(Format('Total Space: %.0n bytes',[TotalBytes * 1.0]));
MemoBox.Lines.Add(Format('Free Space: %.0n bytes',[FreeBytes * 1.0]));
MemoBox.Lines.Add(CrLf+'----------[ CPU ]----------');
MemoBox.Lines.Add(Format('OEM Id %d', [ProcessorOemId]));
MemoBox.Lines.Add(Format('Number of processor %d', [ProcessorNum]));
MemoBox.Lines.Add('Processor Type'+ProcessorType);
MemoBox.Lines.Add('FPU : '+ FPU);
end;
GetPowerInfo;
end; {- FormShow }
procedure TMainForm.CloseBtnClick(Sender: TObject);
begin
Close;
end;

end.