500分求助!参与就给分!(300分)

  • 主题发起人 主题发起人 NewHuman
  • 开始时间 开始时间
to 王公子,你有代码!太好了newhuman_2001@21cn.com,呵呵曾分的兄弟们,多少也说两句啊
大家难道真的不知道如何取得系统的动态信息吗?我
 
已发到你的箱子里去了,注意收一下
 
下面是关于内存的信息,它的结构可以查看Delphi中Windows SDK帮助
Structure of TMemoryStatus:
TMemoryStatus = record
dwLength: DWORD;
dwMemoryLoad: DWORD;
dwTotalPhys: DWORD;
dwAvailPhys: DWORD;
dwTotalPageFile: DWORD;
dwAvailPageFile: DWORD;
dwTotalVirtual: DWORD;
dwAvailVirtual: DWORD;

VOID GlobalMemoryStatus(
LPMEMORYSTATUS lpBuffer // pointer to the memory status structure
);

使用方法如下:
var
MemoryStatus: TMemoryStatus;
begin
Memo1.Lines.Clear;
MemoryStatus.dwLength := SizeOf(MemoryStatus);
GlobalMemoryStatus(MemoryStatus);
with MemoryStatus do
begin
// Size of MemoryStatus record
Memo1.Lines.Add(IntToStr(dwLength) +' Size of ''MemoryStatus'' record');
// Per-Cent of Memory in use by your system
Memo1.Lines.Add(IntToStr(dwMemoryLoad) + '% memory in use');
// The amount of Total Physical memory allocated to your system.
Memo1.Lines.Add(IntToStr(dwTotalPhys) + 'Total Physical Memory in bytes');
// The amount available of physical memory in your system.
Memo1.Lines.Add(IntToStr(dwAvailPhys) + ' Available Physical Memory in bytes');
// The amount of Total Bytes allocated to your page file.
Memo1.Lines.Add(IntToStr(dwTotalPageFile) + ' Total Bytes of Paging File');
// The amount of available bytes in your page file.
Memo1.Lines.Add(IntToStr(dwAvailPageFile) + ' Available bytes in paging file');
// The amount of Total bytes allocated to this program
// (generally 2 gigabytes of virtual space).
Memo1.Lines.Add(IntToStr(dwTotalVirtual) + ' User Bytes of Address space');
// The amount of avalable bytes that is left to your program to use.
Memo1.Lines.Add(IntToStr(dwAvailVirtual) +' Available User bytes of address space');
end; // with
 
当前内存
procedure TForm1.Button2Click(Sender: TObject);

var

str:String;

begin

ClearMemoryInData;

GlobalMemoryStatus(m1);

str:='内存使用百分比 :

'+IntToStr(m.dwMemoryLoad)+','+IntToStr(m1.dwMemoryLoad)+#13#10+

'实际内存总字节数 :

'+IntToStr(m.dwTotalPhys)+','+IntToStr(m1.dwTotalPhys)+#13#10+

'可用的实际内存字节数:

'+IntToStr(m.dwAvailPhys)+','+IntToStr(m1.dwAvailPhys)+#13#10+

'分页文件总字节数 :

'+IntToStr(m.dwTotalPageFile)+','+IntToStr(m1.dwTotalPageFile)+#13#10+

'分页文件可用字节数 :

'+IntToStr(m.dwAvailPageFile)+','+IntToStr(m1.dwAvailPageFile)+#13#10+

'虚拟内存的总字节数 :

'+IntToStr(m.dwTotalVirtual)+','+IntToStr(m1.dwTotalVirtual)+#13#10+

'可用的虚拟内存字节数:

'+IntToStr(m.dwAvailVirtual)+','+IntToStr(m1.dwAvailVirtual)+#13#10;

MessageBox(Handle,PChar(str),'提示信息',MB_OK);

end;
//网络流量
procedure TForm1.Timer1Timer(Sender: TObject);

var

usage,usage1:integer;

begin

with TRegistry.Create do

begin

RootKey:=HKEY_DYN_DATA;

OpenKey('PerfStats/StatData',false);

ReadBinaryData('Dial-Up Adapter/TotalBytesRecvd',usage,sizeof(usage));

ReadBinaryData('Dial-Up Adapter/TotalBytesXmit',usage1,sizeof(usage1));

Caption:=IntToStr(usage)+','+IntToStr(usage1);

CloseKey;

Free;

end;

end;
//CPU使用率
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, CommCtrl, StdCtrls, Menus,WinSpool, ExtCtrls, Validat, Buttons,
Registry;

type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Timer1: TTimer;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
started : boolean;
reg : TRegistry;
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
Dummy : array[0..1024] of byte;

begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_DYN_DATA; //统计数据在这个表项下
Reg.OpenKey('PerfStats/StartStat',false); // Reg.ReadBinaryData('KERNEL/CPUUsage',Dummy,Sizeof(Dummy));
Reg.CloseKey;
started:=true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
CPUU : integer;

begin
if started then
begin
Reg.OpenKey('PerfStats/StatData',false);
Reg.ReadBinaryData('KERNEL/CPUUsage',CPUU,SizeOf(Integer));
Reg.CloseKey;
Label1.Caption:=IntToStr(CPUU)+'%';
end;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
Dummy : array[0..1024] of byte;

begin
'PerfStats/StopStat' }
Reg.OpenKey('PerfStats/StopStat',false);
Reg.ReadBinaryData('KERNEL/CPUUsage',Dummy,SizeOf(Dummy));
Reg.Free;
Started:=false;
end;
 
用控件,BUPACK好像可以。
 
to 公孙剑影
您所使用的HKEY_DYN_DATA分支,在windows2k中已经被取消了,怎么办啊!
 
我也学学。
 
看那本'指南',很详细。
 
不要浪费时间了!
下载下面的控件,十分钟搞定!
最强大的系统信息控件:MiTec控件
http://www.mitec.d2.cz/
 
取得CPU的使用率

unit adCpuUsage;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
CPU Usage Measurement routines for Delphi and C++ Builder

Author: Alexey A. Dynnikov
EMail: aldyn@chat.ru
WebSite: http://www.aldyn.ru/
Support: Use the e-mail aldyn@chat.ru
or support@aldyn.ru

Creation: Jul 8, 2000
Version: 1.02

Legal issues: Copyright (C) 2000 by Alexey A. Dynnikov <aldyn@chat.ru>

This software is provided 'as-is', without any express or
implied warranty. In no event will the author be held liable
for any damages arising from the use of this software.

Permission is granted to anyone to use this software for any
purpose, including commercial applications, and to alter it
and redistribute it freely, subject to the following
restrictions:

1. The origin of this software must not be misrepresented,
you must not claim that you wrote the original software.
If you use this software in a product, an acknowledgment
in the product documentation would be appreciated but is
not required.

2. Altered source versions must be plainly marked as such, and
must not be misrepresented as being the original software.

3. This notice may not be removed or altered from any source
distribution.

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
USAGE:

1. Include this unit into project.

2. Call GetCPUCount to obtain the numbr of processors in the system

3. Each time you need to know the value of CPU usage call the CollectCPUData
to refresh the CPU usage information. Then call the GetCPUUsage to obtain
the CPU usage for given processor. Note that succesive calls of GetCPUUsage
without calling CollectCPUData will return the same CPU usage value.

Example:

procedure TTestForm.TimerTimer(Sender: TObject);
var i: Integer;
begin
CollectCPUData; // Get the data for all processors

for i:=0 to GetCPUCount-1 do // Show data for each processor
MInfo.Lines:=Format('CPU #%d - %5.2f%%',[i,GetCPUUsage(i)*100]);
end;
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

interface

uses
Windows, SysUtils;

// Call CollectCPUData to refresh information about CPU usage
procedure CollectCPUData;

// Call it to obtain the number of CPU's in the system
function GetCPUCount: Integer;

// Call it to obtain the % of usage for given CPU
function GetCPUUsage(Index: Integer): Double;

// For Win9x only: call it to stop CPU usage monitoring and free system resources
procedure ReleaseCPUData;

implementation

{$ifndef ver110}

{$ifndef ver90}
{$ifndef ver100}
{$define UseInt64}
{$endif}
{$endif}


{$ifdef UseInt64}
type TInt64 = Int64;
{$else}
type TInt64 = Comp;
{$endif}

{$else}

type TInt64 = TLargeInteger;

{$endif}

type
PInt64 = ^TInt64;

type
TPERF_DATA_BLOCK = record
Signature : array[0..4 - 1] of WCHAR;
LittleEndian : DWORD;
Version : DWORD;
Revision : DWORD;
TotalByteLength : DWORD;
HeaderLength : DWORD;
NumObjectTypes : DWORD;
DefaultObject : Longint;
SystemTime : TSystemTime;
Reserved: DWORD;
PerfTime : TInt64;
PerfFreq : TInt64;
PerfTime100nSec : TInt64;
SystemNameLength : DWORD;
SystemNameOffset : DWORD;
end;

PPERF_DATA_BLOCK = ^TPERF_DATA_BLOCK;

TPERF_OBJECT_TYPE = record
TotalByteLength : DWORD;
DefinitionLength : DWORD;
HeaderLength : DWORD;
ObjectNameTitleIndex : DWORD;
ObjectNameTitle : LPWSTR;
ObjectHelpTitleIndex : DWORD;
ObjectHelpTitle : LPWSTR;
DetailLevel : DWORD;
NumCounters : DWORD;
DefaultCounter : Longint;
NumInstances : Longint;
CodePage : DWORD;
PerfTime : TInt64;
PerfFreq : TInt64;
end;

PPERF_OBJECT_TYPE = ^TPERF_OBJECT_TYPE;

type
TPERF_COUNTER_DEFINITION = record
ByteLength : DWORD;
CounterNameTitleIndex : DWORD;
CounterNameTitle : LPWSTR;
CounterHelpTitleIndex : DWORD;
CounterHelpTitle : LPWSTR;
DefaultScale : Longint;
DetailLevel : DWORD;
CounterType : DWORD;
CounterSize : DWORD;
CounterOffset : DWORD;
end;

PPERF_COUNTER_DEFINITION = ^TPERF_COUNTER_DEFINITION;

TPERF_COUNTER_BLOCK = record
ByteLength : DWORD;
end;

PPERF_COUNTER_BLOCK = ^TPERF_COUNTER_BLOCK;

TPERF_INSTANCE_DEFINITION = record
ByteLength : DWORD;
ParentObjectTitleIndex : DWORD;
ParentObjectInstance : DWORD;
UniqueID : Longint;
NameOffset : DWORD;
NameLength : DWORD;
end;

PPERF_INSTANCE_DEFINITION = ^TPERF_INSTANCE_DEFINITION;

//------------------------------------------------------------------------------
{$ifdef ver130}
{$L-} // The L+ causes internal error in Delphi 5 compiler
{$O-} // The O+ causes internal error in Delphi 5 compiler
{$Y-} // The Y+ causes internal error in Delphi 5 compiler
{$endif}

{$ifndef ver110}
type
TInt64F = TInt64;
{$else}
type
TInt64F = Extended;
{$endif}

{$ifdef ver110}
function FInt64(Value: TInt64): TInt64F;
function Int64D(Value: DWORD): TInt64;
{$else}
type
FInt64 = TInt64F;
Int64D = TInt64;
{$endif}

{$ifdef ver110}
function FInt64(Value: TInt64): TInt64F;
var V: TInt64;
begin
if (Value.HighPart and $80000000) = 0 then // positive value
begin
result:=Value.HighPart;
result:=result*$10000*$10000;
result:=result+Value.LowPart;
end else
begin
V.HighPart:=Value.HighPart xor $FFFFFFFF;
V.LowPart:=Value.LowPart xor $FFFFFFFF;
result:= -1 - FInt64(V);
end;
end;

function Int64D(Value: DWORD): TInt64;
begin
result.LowPart:=Value;
result.HighPart := 0; // positive only
end;
{$endif}

//------------------------------------------------------------------------------

const
Processor_IDX_Str = '238';
Processor_IDX = 238;
CPUUsageIDX = 6;

type
AInt64F = array[0..$FFFF] of TInt64F;
PAInt64F = ^AInt64F;

var
_PerfData : PPERF_DATA_BLOCK;
_BufferSize: Integer;
_POT : PPERF_OBJECT_TYPE;
_PCD: PPerf_Counter_Definition;
_ProcessorsCount: Integer;
_Counters: PAInt64F;
_PrevCounters: PAInt64F;
_SysTime: TInt64F;
_PrevSysTime: TInt64F;
_IsWinNT: Boolean;

_W9xCollecting: Boolean;
_W9xCpuUsage: DWORD;
_W9xCpuKey: HKEY;


//------------------------------------------------------------------------------
function GetCPUCount: Integer;
begin
if _IsWinNT then
begin
if _ProcessorsCount < 0 then CollectCPUData;
result:=_ProcessorsCount;
end else
begin
result:=1;
end;

end;

//------------------------------------------------------------------------------
procedure ReleaseCPUData;
var H: HKEY;
R: DWORD;
dwDataSize, dwType: DWORD;
begin
if _IsWinNT then exit;
if not _W9xCollecting then exit;
_W9xCollecting:=False;

RegCloseKey(_W9xCpuKey);

R:=RegOpenKeyEx( HKEY_DYN_DATA, 'PerfStats/StopStat', 0, KEY_ALL_ACCESS, H );

if R <> ERROR_SUCCESS then exit;

dwDataSize:=sizeof(DWORD);

RegQueryValueEx ( H, 'KERNEL/CPUUsage', nil, @dwType, PBYTE(@_W9xCpuUsage), @dwDataSize);

RegCloseKey(H);

end;

//------------------------------------------------------------------------------
function GetCPUUsage(Index: Integer): Double;
begin
if _IsWinNT then
begin
if _ProcessorsCount < 0 then CollectCPUData;
if (Index >= _ProcessorsCount) or (Index < 0) then
raise Exception.Create('CPU index out of bounds');
if _PrevSysTime = _SysTime then result:=0 else
result:=1-(_Counters[index] - _PrevCounters[index])/(_SysTime-_PrevSysTime);
end else
begin
if Index <> 0 then
raise Exception.Create('CPU index out of bounds');
if not _W9xCollecting then CollectCPUData;
result:=_W9xCpuUsage / 100;
end;
end;

var VI: TOSVERSIONINFO;

//------------------------------------------------------------------------------
procedure CollectCPUData;
var BS: integer;
i: Integer;
_PCB_Instance: PPERF_COUNTER_BLOCK;
_PID_Instance: PPERF_INSTANCE_DEFINITION;
ST: TFileTime;

var H: HKEY;
R: DWORD;
dwDataSize, dwType: DWORD;
begin
if _IsWinNT then
begin
BS:=_BufferSize;
while RegQueryValueEx( HKEY_PERFORMANCE_DATA, Processor_IDX_Str, nil, nil,
PByte(_PerfData), @BS ) = ERROR_MORE_DATA do
begin
// Get a buffer that is big enough.
INC(_BufferSize,$1000);
BS:=_BufferSize;
ReallocMem( _PerfData, _BufferSize );
end;

// Locate the performance object
_POT := PPERF_OBJECT_TYPE(DWORD(_PerfData) + _PerfData.HeaderLength);
for i := 1 to _PerfData.NumObjectTypes do
begin
if _POT.ObjectNameTitleIndex = Processor_IDX then Break;
_POT := PPERF_OBJECT_TYPE(DWORD(_POT) + _POT.TotalByteLength);
end;

// Check for success
if _POT.ObjectNameTitleIndex <> Processor_IDX then
raise Exception.Create('Unable to locate the "Processor" performance object');

if _ProcessorsCount < 0 then
begin
_ProcessorsCount:=_POT.NumInstances;
GetMem(_Counters,_ProcessorsCount*SizeOf(TInt64));
GetMem(_PrevCounters,_ProcessorsCount*SizeOf(TInt64));
end;

// Locate the "% CPU usage" counter definition
_PCD := PPERF_Counter_DEFINITION(DWORD(_POT) + _POT.HeaderLength);
for i := 1 to _POT.NumCounters do
begin
if _PCD.CounterNameTitleIndex = CPUUsageIDX then break;
_PCD := PPERF_COUNTER_DEFINITION(DWORD(_PCD) + _PCD.ByteLength);
end;

// Check for success
if _PCD.CounterNameTitleIndex <> CPUUsageIDX then
raise Exception.Create('Unable to locate the "% of CPU usage" performance counter');

// Collecting coutners
_PID_Instance := PPERF_INSTANCE_DEFINITION(DWORD(_POT) + _POT.DefinitionLength);
for i := 0 to _ProcessorsCount-1 do
begin
_PCB_Instance := PPERF_COUNTER_BLOCK(DWORD(_PID_Instance) + _PID_Instance.ByteLength );

_PrevCounters:=_Counters;
_Counters:=FInt64(PInt64(DWORD(_PCB_Instance) + _PCD.CounterOffset)^);

_PID_Instance := PPERF_INSTANCE_DEFINITION(DWORD(_PCB_Instance) + _PCB_Instance.ByteLength);
end;

_PrevSysTime:=_SysTime;
SystemTimeToFileTime(_PerfData.SystemTime, ST);
_SysTime:=FInt64(TInt64(ST));
end else
begin
if not _W9xCollecting then
begin
R:=RegOpenKeyEx( HKEY_DYN_DATA, 'PerfStats/StartStat', 0, KEY_ALL_ACCESS, H );
if R <> ERROR_SUCCESS then
raise Exception.Create('Unable to start performance monitoring');

dwDataSize:=sizeof(DWORD);

RegQueryValueEx( H, 'KERNEL/CPUUsage', nil, @dwType, PBYTE(@_W9xCpuUsage), @dwDataSize );

RegCloseKey(H);

R:=RegOpenKeyEx( HKEY_DYN_DATA, 'PerfStats/StatData', 0,KEY_READ, _W9xCpuKey );

if R <> ERROR_SUCCESS then
raise Exception.Create('Unable to read performance data');

_W9xCollecting:=True;
end;

dwDataSize:=sizeof(DWORD);
RegQueryValueEx( _W9xCpuKey, 'KERNEL/CPUUsage', nil,@dwType, PBYTE(@_W9xCpuUsage), @dwDataSize );
end;
end;


initialization
_ProcessorsCount:= -1;
_BufferSize:= $2000;
_PerfData := AllocMem(_BufferSize);

VI.dwOSVersionInfoSize:=SizeOf(VI);
if not GetVersionEx(VI) then raise Exception.Create('Can''t get the Windows version');

_IsWinNT := VI.dwPlatformId = VER_PLATFORM_WIN32_NT;
finalization
ReleaseCPUData;
FreeMem(_PerfData);
end.






http://www.swissdelphicenter.ch/torry/showcode.php?id=969
How to get the CPU usage in percent
const
SystemBasicInformation = 0;
SystemPerformanceInformation = 2;
SystemTimeInformation = 3;

type
TPDWord = ^DWORD;

TSystem_Basic_Information = packed record
dwUnknown1: DWORD;
uKeMaximumIncrement: ULONG;
uPageSize: ULONG;
uMmNumberOfPhysicalPages: ULONG;
uMmLowestPhysicalPage: ULONG;
uMmHighestPhysicalPage: ULONG;
uAllocationGranularity: ULONG;
pLowestUserAddress: Pointer;
pMmHighestUserAddress: Pointer;
uKeActiveProcessors: ULONG;
bKeNumberProcessors: byte;
bUnknown2: byte;
wUnknown3: word;
end;

type
TSystem_Performance_Information = packed record
liIdleTime: LARGE_INTEGER; {LARGE_INTEGER}
dwSpare: array[0..75] of DWORD;
end;

type
TSystem_Time_Information = packed record
liKeBootTime: LARGE_INTEGER;
liKeSystemTime: LARGE_INTEGER;
liExpTimeZoneBias: LARGE_INTEGER;
uCurrentTimeZoneId: ULONG;
dwReserved: DWORD;
end;

var
NtQuerySystemInformation: function(infoClass: DWORD;
buffer: Pointer;
bufSize: DWORD;
returnSize: TPDword): DWORD; stdcall = nil;


liOldIdleTime: LARGE_INTEGER = ();
liOldSystemTime: LARGE_INTEGER = ();

function Li2Double(x: LARGE_INTEGER): Double;
begin
Result := x.HighPart * 4.294967296E9 + x.LowPart
end;

procedure GetCPUUsage;
var
SysBaseInfo: TSystem_Basic_Information;
SysPerfInfo: TSystem_Performance_Information;
SysTimeInfo: TSystem_Time_Information;
status: Longint; {long}
dbSystemTime: Double;
dbIdleTime: Double;

bLoopAborted : boolean;

begin
if @NtQuerySystemInformation = nil then
NtQuerySystemInformation := GetProcAddress(GetModuleHandle('ntdll.dll'),
'NtQuerySystemInformation');

// get number of processors in the system

status := NtQuerySystemInformation(SystemBasicInformation, @SysBaseInfo, SizeOf(SysBaseInfo), nil);
if status <> 0 then Exit;

// Show some information
with SysBaseInfo do
begin
ShowMessage(
Format('uKeMaximumIncrement: %d'#13'uPageSize: %d'#13+
'uMmNumberOfPhysicalPages: %d'+#13+'uMmLowestPhysicalPage: %d'+#13+
'uMmHighestPhysicalPage: %d'+#13+'uAllocationGranularity: %d'#13+
'uKeActiveProcessors: %d'#13'bKeNumberProcessors: %d',
[uKeMaximumIncrement, uPageSize, uMmNumberOfPhysicalPages,
uMmLowestPhysicalPage, uMmHighestPhysicalPage, uAllocationGranularity,
uKeActiveProcessors, bKeNumberProcessors]));
end;


bLoopAborted := False;

while not bLoopAborted do
begin

// get new system time
status := NtQuerySystemInformation(SystemTimeInformation, @SysTimeInfo, SizeOf(SysTimeInfo), 0);
if status <> 0 then Exit;

// get new CPU's idle time
status := NtQuerySystemInformation(SystemPerformanceInformation, @SysPerfInfo, SizeOf(SysPerfInfo), nil);
if status <> 0 then Exit;

// if it's a first call - skip it
if (liOldIdleTime.QuadPart <> 0) then
begin

// CurrentValue = NewValue - OldValue
dbIdleTime := Li2Double(SysPerfInfo.liIdleTime) - Li2Double(liOldIdleTime);
dbSystemTime := Li2Double(SysTimeInfo.liKeSystemTime) - Li2Double(liOldSystemTime);

// CurrentCpuIdle = IdleTime / SystemTime
dbIdleTime := dbIdleTime / dbSystemTime;

// CurrentCpuUsage% = 100 - (CurrentCpuIdle * 100) / NumberOfProcessors
dbIdleTime := 100.0 - dbIdleTime * 100.0 / SysBaseInfo.bKeNumberProcessors + 0.5;

// Show Percentage
Form1.Label1.Caption := FormatFloat('CPU Usage: 0.0 %',dbIdleTime);

Application.ProcessMessages;

// Abort if user pressed ESC or Application is terminated
bLoopAborted := (GetKeyState(VK_ESCAPE) and 128 = 128) or Application.Terminated;

end;

// store new CPU's idle and system time
liOldIdleTime := SysPerfInfo.liIdleTime;
liOldSystemTime := SysTimeInfo.liKeSystemTime;

// wait one second
Sleep(1000);
end;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
GetCPUUsage
end;
 
有控件嘛,找一找,好多。
 
后退
顶部