Текущий архив: 2006.05.21;
Скачать: CL | DM;

Вниз

Загруженость ситемы   Найти похожие ветки 

← →
Sysanin   (2006-02-24 01:01) [0]

Как можно узнать насколько используется локальная сеть, загружен процессор, использована память (в процентном отношении)?

---

← →
Defunct ©   (2006-02-24 02:47) [1]

run -> taskmgr

---

← →
Sysanin   (2006-02-24 12:34) [2]

а программно как это осуществить? (что бы этими значениями можно было оперировать)

---

← →
Pit ©   (2006-02-24 12:46) [3]


type
TfmMain = class(TForm)
...
procedure FormCreate(Sender: TObject);
procedure Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
KeyboardDelay,
KeyboardSpeed,
ScreenSaveTimeOut : integer;
procedure ParametersInfo;
procedure ShowSomeInfo;
procedure BIOSInfo(OS : string);
procedure HardwareInfo;
procedure MemoryInfo;
procedure VideoInfo;
procedure OSInfo;
end;

var fmMain: TfmMain;

implementation
uses Registry;
{$R *.DFM}


// Информация о компьютере.
procedure TfmMain.HardwareInfo;
var Size : cardinal;
PRes : PChar;
BRes : boolean;
lpSystemInfo : TSystemInfo;
begin
// Имя компьютера
Size := MAX_COMPUTERNAME_LENGTH + 1;
PRes := StrAlloc(Size);
BRes := GetComputerName(PRes, Size);
if BRes then laCompName_.Caption := StrPas(PRes);
// Имя пользователя
Size := MAX_COMPUTERNAME_LENGTH + 1;
PRes := StrAlloc(Size);
BRes := GetUserName(PRes, Size);
if BRes then laUserName_.Caption := StrPas(PRes);
// Процессор
GetSystemInfo(lpSystemInfo);
laCPU_.Caption := "класса x" + IntToStr
(lpSystemInfo.dwProcessorType);
end;



// Информация о видеосистеме.
procedure TfmMain.VideoInfo;
var DC : hDC;
c : string;
begin
// Разрешение экрана
laWidth_.Caption := IntToStr(Screen.Height);
laHeight_.Caption := IntToStr(Screen.Width);
// Информация о глубине цвета.
DC := CreateDC("DISPLAY",nil,nil,nil);
laBitsPerPixel_.Caption :=
IntToStr(GetDeviceCaps(DC,BITSPIXEL));
laPlanes_.Caption :=
IntToStr(GetDeviceCaps(DC,PLANES));
case GetDeviceCaps(DC,BITSPIXEL) of
8 : c := "256 цветов";
15 : c := "Hi-Color / 32768 цветов";
16 : c := "Hi-Color / 65536 цветов";
24 : c := "True-Color / 16 млн цветов";
32 : c := "True-Color / 32 бит";
end;
laColors_.Caption := c;
DeleteDC(DC);
end;

// Информация о памяти.
procedure TfmMain.MemoryInfo;
var lpMemoryStatus : TMemoryStatus;
begin
lpMemoryStatus.dwLength := SizeOf(lpMemoryStatus);
GlobalMemoryStatus(lpMemoryStatus);
with lpMemoryStatus do begin
laFreeMemory.Caption :=
laFreeMemory.Caption +
IntToStr(dwMemoryLoad) + "%";
laRAM_.Caption := Format("%0.0f Мбайт",
[dwTotalPhys div 1024 / 1024]);
laFreeRAM_.Caption := Format("%0.3f Мбайт",
[dwAvailPhys div 1024 / 1024]);
laPF_.Caption := Format("%0.0f Мбайт",
[dwTotalPageFile div 1024 / 1024]);
laPFFree_.Caption := Format("%0.0f Мбайт",
[dwAvailPageFile div 1024 / 1024]);
end;
end;


// Информация о Windows.
procedure TfmMain.OSInfo;
var PRes : PChar;
Res : word;
BRes : boolean;
lpVersionInformation : TOSVersionInfo;
c : string;
begin
// Каталог, где установлена Windows
PRes := StrAlloc(255);
Res := GetWindowsDirectory(PRes, 255);
if Res > 0 then laWinDir_.Caption :=
StrPas(PRes);
// Системный каталог Windows
Res := GetSystemDirectory(PRes, 255);
if Res > 0 then laSysDir_.Caption :=
StrPas(PRes);
// Имя ОС
lpVersionInformation.dwOSVersionInfoSize :=
SizeOf(TOSVersionInfo);
BRes := GetVersionEx(lpVersionInformation);
if BRes then
with lpVersionInformation do case dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS :
if dwMinorVersion=0 then c := "Windows 95"
else c := "Windows 98";
VER_PLATFORM_WIN32_NT : c := "Windows NT";
VER_PLATFORM_WIN32s : c := "Win 3.1 with Win32s"
end;
laVersion_.Caption := c;
// Дата создания BIOS-а
if c="Windows NT" then BIOSInfo("NT") else BIOSInfo("95");
end;



// Информация о дате создания BIOS-а.
procedure TfmMain.BIOSInfo(OS : string);
var p : pointer;
s : string[255];
begin
if OS="NT" then begin with TRegistry.Create do
try RootKey := HKEY_LOCAL_MACHINE;
if OpenKeyReadOnly
("HARDWARE\DESCRIPTION\System")
then laBIOSDate_.Caption :=
ReadString("SystemBiosDate")
finally Free;
end;
end
else try
s[0] := #8;
p := Pointer($0FFFF5);
Move(p^,s[1],8);
laBIOSDate_.Caption :=
copy(s,1,2) + "/" + copy(s,4,2) + "/" +copy (s,7,2);
except laBIOSDate_.Caption := "XX.XX.XXXX";
end;
end;



// Информация о параметрах
procedure TfmMain.ParametersInfo;
var Bl : boolean;
begin
// Разрешен ли PC Speaker
SystemParametersInfo(SPI_GETBEEP,0,@Bl,0);
cbSpeaker.Checked := Bl;
// Активен ли хранитель экрана
SystemParametersInfo
(SPI_GETSCREENSAVEACTIVE,0,@Bl,0);
cbScreenSaverActive.Checked := Bl;
// Интервал вызова хранителя экрана
SystemParametersInfo
(SPI_GETSCREENSAVETIMEOUT,0,
@ScreenSaveTimeOut,0);
// Настройки клавиатуры
SystemParametersInfo
(SPI_GETKEYBOARDDELAY,0,
@KeyboardDelay,0);
SystemParametersInfo
(SPI_GETKEYBOARDSPEED,0,
@KeyboardSpeed,0);
end;

// Отображение настроек
procedure TfmMain.ShowSomeInfo;
begin
tbKeyboardDelay.Position := 3 - KeyboardDelay;
tbKeyboardSpeed.Position := KeyboardSpeed;
edSStimeOut.EditMask := IntToStr
(ScreenSaveTimeOut div 60);
end;

// Сохранение изменений параметров системы
procedure TfmMain.Change(Sender: TObject);
var Sen : TComponent;
begin
Sen := Sender as TComponent;
// Вкл/Выкл PC Speaker-а.
if (Sen.Name="cbSpeaker") and cbSpeaker.Checked
then SystemParametersInfo
(SPI_SETBEEP,1,nil,SPIF_UPDATEINIFILE)
else SystemParametersInfo
(SPI_SETBEEP,0,nil,SPIF_UPDATEINIFILE);
// Вкл/Выкл активности хранителя экрана.
if (Sen.Name="cbScreenSaver") and cbScreenSaverActive.Checked
then SystemParametersInfo
(SPI_SETSCREENSAVEACTIVE,1,nil,SPIF_UPDATEINIFILE)
else SystemParametersInfo
(SPI_SETSCREENSAVEACTIVE,0,nil,SPIF_UPDATEINIFILE);
// Изменение значения задержки перед повтором с клавиатуры
if (Sen.Name="tbKeyboardDelay") then SystemParametersInfo(
SPI_SETKEYBOARDDELAY,3-tbKeyboardDelay.Position,nil,
SPIF_SENDWININICHANGE);
// Изменение значения скорости ввода с клавиатуры
if (Sen.Name="tbKeyboardSpeed") then SystemParametersInfo(
SPI_SETKEYBOARDSPEED,tbKeyboardSpeed.Position,nil,
SPIF_SENDWININICHANGE);
// Изменение интервала запуска хранителя экрана
if (Sen.Name="edSSTimeOut") then SystemParametersInfo(
SPI_SETSCREENSAVETIMEOUT,StrToInt(edSSTimeOut.Text)
*60,nil,SPIF_UPDATEINIFILE);
end;


// Вызов информационных процедур при создании формы.
procedure TfmMain.FormCreate(Sender: TObject);
begin
HardwareInfo;
MemoryInfo;
VideoInfo;
ParametersInfo;
ShowSomeInfo;
OSInfo;
end;


---

← →
Pit ©   (2006-02-24 13:01) [4]

Информация о колличестве памяти занимаемой процессом.

uses
 PSAPI;

procedure TForm1.Button1Click(Sender: TObject);
var
pmc: PPROCESS_MEMORY_COUNTERS;
cb: Integer;
begin
cb := SizeOf(_PROCESS_MEMORY_COUNTERS);
GetMem(pmc, cb);
pmc^.cb := cb;
GetProcessMemoryInfo(GetCurrentProcess(){<-процесс}, pmc, cb) ;
Label1.Caption := IntToStr(pmc^.WorkingSetSize) + " Bytes";
FreeMem(pmc);
end;

---

Страницы: 1 вся ветка

Текущий архив: 2006.05.21;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.044 c