关于用程序获得系统资源的方法！200分！(200分)

我想在程序用Timer控件随时检查系统资源的百分数！请问如何实现，怎样获得系统所剩
资源的百分比！(就是 关于Windows 98窗口内系统资源： xx% 可用空间)

有些过分了吧？你同样的一个帖子别人回答了你不给一个回复却新开一个帖子？

是啊，因为我试过了，不太满意，所以又提出来了！对不起 wjiachun！我这就去结束以前的
问题！

不会吧，没人理我！我真的很急！麻烦大家了，解答一下！

用GlobalMemoryStatus函数获取内存使用信息　
　MemStatus: TMEMORYSTATUS; //定义内存结构变量
　　Lbl_Memory:Tlabel;　　MemStatus.dwLength := size of(TMEMORYSTATU?S);
　　GlobalMemoryStatus(MemStatus); //返回内存使用信息
　　 Lbl_Memory.Caption := format('共有内存: %d KB 可用内
存: %dKB',[MemStatus.dwAvailPhys div 1024,MemStatus.dwTotalPhys div 1024]);
　　//将内存信息显示在Lbl_Memory中

用下面的控件（可以查看内存资源以及系统资源,只能在Win9X下使用）
==========================================================
unit SystemProbe;

interface

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

type
TDialUp = Class(TPersistent)
private
FConnectSpeed : Integer;
FBytesRecvd : Integer;
FBytesXmit : Integer;
FTotalBytesRecvd : Integer;
FTotalBytesXmit : Integer;
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
property ConnectSpeed : Integer Read FConnectSpeed Write FConnectSpeed;
property BytesRecvd : Integer Read FBytesRecvd Write FBytesRecvd;
property BytesXmit : Integer Read FBytesXmit Write FBytesXmit;
property TotalBytesRecvd : Integer Read FTotalBytesRecvd Write FTotalBytesRecvd;
property TotalBytesXmit : Integer Read FTotalBytesXmit Write FTotalBytesXmit;
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 % }
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
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;
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;

TKernel = Class(TPersistent)
private
FCPUUsage : Integer;{ in %}
FThreads : Integer;
FVMs : Integer;
protected
public
constructor Create;
destructor Destroy;override;
procedure RefreshInfo;
published
property CPUUsage : Integer Read FCPUUsage Write FCPUUsage;
property Threads : Integer Read FThreads Write FThreads;
property VMs : Integer Read FVMs Write FVMs;
end;

TSystemProbe = class(TComponent)
private
FRefreshInterval : Integer;
FAutoRefresh : Boolean;
FRefreshTime : Integer;
FTimer : tTimer;
FStatus : String;
FSmartRefresh : Boolean;
FOnRefreshed : TNotifyEvent;

FMemory : TMemory;
FResources : TResources;
FKernel : TKernel;
FDialUp : TDialUp;

Procedure SetAutoRefresh (Value:Boolean);
Procedure SetRefreshInterval (Value:Integer);
protected
Procedure OnTimer(Sender: TObject);
public
constructor create(AOwner:TComponent);override;
destructor destroy;override;
procedure Loaded;override;
Procedure Refresh;
published
property RefreshInterval : Integer Read FRefreshInterval Write SetRefreshInterval;
property AutoRefresh : Boolean Read FAutoRefresh Write SetAutoRefresh;
property Status : String Read FStatus Write FStatus;
property RefreshTime : Integer Read FRefreshTime Write FRefreshTime;
property SmartRefresh : Boolean Read FSmartRefresh Write FSmartRefresh;
property OnRefreshed : TNotifyEvent Read FOnRefreshed Write FOnRefreshed;

property Resources : TResources Read FResources Write FResources;
property Memory : tMemory Read FMemory Write FMemory;
Property Kernel : tKernel Read FKernel Write FKernel;
property DialUp : TDialUp Read FDialUp Write FDialUp;
end;

procedure Register;

implementation


{*************************************************************}
{ 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 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;

{ ---------------------------------------------------------------------------- }

constructor TKernel.Create;
Begin
inherited Create;
End;

destructor TKernel.Destroy;
Begin
inherited Destroy;
End;

procedure TKernel.RefreshInfo;
var
BBuf : Array [1..4] of Byte;
Begin
With TRegistry.Create do
Try
RootKey:=HKEY_DYN_DATA;
If OpenKey('PerfStats/StatData',False) then
Begin

If ValueExists('KERNEL/CPUUsage') then
Begin
ReadBinaryData('KERNEL/CPUUsage',BBuf,4);
Move(BBuf,FCPUusage,4);
End else
FCPUUSage:=-1;

If ValueExists('KERNEL/Threads') then
Begin
ReadBinaryData('KERNEL/Threads',BBuf,4);
Move(BBuf,FThreads,4);
End else
FThreads:=-1;

If ValueExists('KERNEL/VMs') then
Begin
ReadBinaryData('KERNEL/VMs',BBuf,4);
Move(BBuf,FVMs,4);
End else
FVMs:=-1;

CloseKey;
End;
Finally
Free;
End;

End;

constructor TMemory.Create;
Begin
inherited Create;
End;

destructor TMemory.Destroy;
Begin
inherited Destroy;
End;

procedure TMemory.RefreshInfo;
var MS : TMemoryStatus;
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;
End;

constructor TResources.Create;
Begin
inherited Create;
End;

destructor TResources.Destroy;
Begin
inherited Destroy;
End;

procedure TResources.RefreshInfo;
var
Thunks: Array[0..$20] of Word;
Result,
SysRes: 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!');

{ System Res }
SysRes := GFSR_SystemRes;
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;
FSystemRes:=Result;

{ GDI Res }
SysRes := GFSR_GDIRes;
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;
FGDIRes:=Result;

{ User Res }
SysRes := GFSR_UserRes;
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;
FUserRes:=Result;
End;

constructor TDialUp.Create;
Begin
inherited Create;
End;

destructor TDialUp.Destroy;
Begin
inherited Destroy;
End;

procedure TDialUp.RefreshInfo;
var
BBuf : Array [1..4] of Byte;
Begin
With TRegistry.Create do
Try
RootKey:=HKEY_DYN_DATA;
If OpenKey('PerfStats/StatData',False) then
Begin

If ValueExists('Dial-Up Adapter/ConnectSpeed') then
Begin
ReadBinaryData('Dial-Up Adapter/ConnectSpeed',BBuf,4);
Move(BBuf,FConnectSpeed,4);
End else
FConnectSpeed:=-1;

If ValueExists('Dial-Up Adapter/BytesRecvd') then
Begin
ReadBinaryData('Dial-Up Adapter/BytesRecvd',BBuf,4);
Move(BBuf,FBytesRecvd,4);
End else
FBytesRecvd:=-1;

If ValueExists('Dial-Up Adapter/BytesXmit') then
Begin
ReadBinaryData('Dial-Up Adapter/BytesXmit',BBuf,4);
Move(BBuf,FBytesXmit,4);
End else
FBytesXmit:=-1;

If ValueExists('Dial-Up Adapter/TotalBytesRecvd') then
Begin
ReadBinaryData('Dial-Up Adapter/TotalBytesRecvd',BBuf,4);
Move(BBuf,FTotalBytesRecvd,4);
End else
FTotalBytesRecvd:=-1;

If ValueExists('Dial-Up Adapter/TotalBytesXmit') then
Begin
ReadBinaryData('Dial-Up Adapter/TotalBytesXmit',BBuf,4);
Move(BBuf,FTotalBytesXmit,4);
End else
FTotalBytesXmit:=-1;

CloseKey;
End;
Finally
Free;
End;
End;

Procedure TSystemProbe.Refresh;
var Start : Integer;
Begin
// if (csDesigning in ComponentState) then Exit;
FStatus:='Refreshing...';
Start:=GetTickCount;

FResources.RefreshInfo;
FMemory.RefreshInfo;
FKernel.RefreshInfo;
FDialUp.RefreshInfo;

If FRefreshTime=-1 then
Begin
FRefreshTime:=(GetTickCount-Start);
If FSmartRefresh then
RefreshInterval:=FRefreshTime*5;
End;

FStatus:='Ready';
If Assigned(FOnRefreshed) then FOnRefreshed(Self);
End;

procedure TSystemProbe.OnTimer(Sender: TObject);
begin
Refresh;
end;

Procedure TSystemProbe.SetRefreshInterval (Value:Integer);
Begin
If Value<>FRefreshInterval then
Begin
FRefreshInterval := Value;
FTimer.Interval := FRefreshInterval;
End;
End;

Procedure TSystemProbe.SetAutoRefresh (Value:Boolean);
Begin
If Value<>FAutoRefresh then
Begin
FAutoRefresh := Value;
FTimer.Enabled := FAutoRefresh;
End;
End;


Constructor TSystemProbe.create(AOwner:TComponent);
Begin
inherited Create(AOwner);
FDialUp:=tDialUp.Create;
FResources:=TResources.Create;
FMemory:=TMemory.Create;
FKernel:=tKernel.Create;

FRefreshTime:=-1;
FTimer:=tTimer.Create(Self);
FTimer.OnTimer:=OnTimer;
FRefreshInterval:=5000; { 1 second }
FTimer.Interval:=FRefreshInterval;
AutoRefresh :=True;
end;

procedure TSystemProbe.Loaded;
begin
inherited Loaded;
If AutoRefresh then Refresh;
end;

Destructor TSystemProbe.destroy;
Begin
FTimer.Free;
FResources.Free;
FMemory.Free;
FKernel.Free;
FDialUp.Free;
inherited destroy;
End;


procedure Register;
begin
RegisterComponents('Jazarsoft', [TSystemProbe]);
end;

end.

多人接受答案了。