Загруженость ситемы

← →
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;

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

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;

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