Monitor zasobów, zużycie procesora, Ram itd

Monitor zasobów, zużycie procesora, Ram itd
FP
  • Rejestracja:prawie 2 lata
  • Ostatnio:około miesiąc
  • Postów:37
2

Siemka!
Robię sobie w Delphi mały program do sprawdzania zasobów systemowych — typu zużycie CPU, RAM itd.
Wrzucam kod mojego unita, może komuś się przyda albo ktoś będzie chciał coś dorzucić od siebie.

Kopiuj

// CODE BY FPERSON in Embarcadero Delphi 12 Version 29.0.55362.2017 

unit SystemResourceMonitor;

interface

uses
  Winapi.Windows, System.SysUtils, System.Classes, TLHelp32, PsAPI,
  System.Generics.Collections, System.Generics.Defaults, System.Math;

type
  // Rekord przechowujący informacje o wykorzystaniu CPU i pamięci przez pojedynczy proces
  TProcessCpuUsage = record
    ProcessID: Cardinal;       // ID procesu
    ProcessName: string;       // Nazwa pliku wykonywalnego procesu
    UsagePercent: Double;      // Procentowe wykorzystanie procesora przez proces
    MemoryUsageMB: Double;     // Ilość używanego RAM przez proces (w MB)
  end;

  // Kompletne informacje o stanie zasobów systemowych
  TSystemResourceInfo = record
    CPUUsage: Double;                  // Całkowite wykorzystanie procesora (%)
    MemoryUsed: Int64;                 // Używana pamięć fizyczna (w bajtach)
    MemoryTotal: Int64;                // Całkowita pamięć fizyczna (w bajtach)
    MemoryUsagePercent: Double;        // Procentowe wykorzystanie pamięci fizycznej
    VirtualMemoryUsed: Int64;          // Używana pamięć wirtualna (w bajtach)
    VirtualMemoryTotal: Int64;         // Całkowita pamięć wirtualna (w bajtach)
    VirtualMemoryUsagePercent: Double; // Procentowe wykorzystanie pamięci wirtualnej
    OSName: string;                    // Nazwa systemu operacyjnego (np. "Windows 10")
    OSVersion: string;                 // Wersja systemu (np. "Build 19043")
    ProcessorArchitecture: string;     // Architektura procesora (np. "AMD64")
    ProcessorCoreCount: Integer;       // Liczba rdzeni procesora
    ProcessCount: Integer;             // Liczba aktywnych procesów
    ThreadCount: Integer;             // Liczba aktywnych wątków
    ProcessUsages: TArray<TProcessCpuUsage>; // Tablica informacji o procesach
  end;

  // Typ zdarzenia wywoływanego przy przekroczeniu progów wykorzystania zasobów
  TResourceChangeEvent = procedure(Sender: TObject; const Info: TSystemResourceInfo) of object;

  // Główna klasa monitorująca zasoby systemowe
  TSystemResourceMonitor = class
  private
    // Zmienne do obliczania wykorzystania CPU
    FLastIdleTime: Int64;      // Poprzedni czas bezczynności systemu
    FLastKernelTime: Int64;    // Poprzedni czas jądra systemu
    FLastUserTime: Int64;      // Poprzedni czas użytkownika
    FLastSystemTime: Int64;    // Poprzedni całkowity czas systemowy
    
    // Słownik przechowujący poprzednie czasy procesów
    FLastProcessTimes: TDictionary<Cardinal, Int64>;
    
    // Uchwyt do migawki procesów
    FProcessHandle: THandle;
    
    // Ostatni stan pamięci
    FLastMemoryStatus: TMemoryStatusEx;
    
    // Czas ostatniej aktualizacji
    FLastUpdateTime: TDateTime;
    
    // Zdarzenia i progi alarmowe
    FOnHighCPUUsage: TResourceChangeEvent;    // Zdarzenie wysokiego CPU
    FOnHighMemoryUsage: TResourceChangeEvent; // Zdarzenie wysokiej pamięci
    FCPUUsageThreshold: Double;               // Próg alarmu CPU (domyślnie 90%)
    FMemoryUsageThreshold: Double;            // Próg alarmu pamięci (domyślnie 90%)

    // Metody prywatne
    function GetCurrentCPUUsage: Double;                      // Oblicza aktualne użycie CPU
    function GetMemoryStatus: TMemoryStatusEx;                // Pobiera status pamięci
    function GetOSInfo: TOSVersionInfoEx;                     // Pobiera informacje o systemie
    function GetProcessorArchitecture(ShowCoreCount: Boolean = True): string; // Pobiera architekturę CPU
    function GetOSDetails: string;                            // Pobiera szczegóły systemu
    function GetProcessorCoreCount: Integer;                  // Pobiera liczbę rdzeni
    procedure CheckForThresholds(const Info: TSystemResourceInfo); // Sprawdza progi alarmowe
    function GetProcessTimes(ProcessHandle: THandle): Int64;  // Pobiera czasy procesu
    function GetProcessCpuUsages: TArray<TProcessCpuUsage>;   // Pobiera użycie CPU przez procesy
    function GetProcessMemoryUsage(ProcessID: Cardinal): Double; // Pobiera użycie pamięci przez proces

  public
    constructor Create;  // Inicjalizacja monitora
    destructor Destroy; override; // Sprzątanie zasobów

    // Główne metody publiczne
    function GetResourceInfo: TSystemResourceInfo; // Kompletne informacje o systemie
    function GetCPUUsage: Double;                  // Aktualne użycie CPU
    function GetTotalMemory: Int64;                // Całkowita pamięć RAM
    function GetUsedMemory: Int64;                 // Używana pamięć RAM
    function GetMemoryUsagePercent: Double;        // Procent użycia RAM
    function GetProcessCount: Integer;             // Liczba procesów
    function GetThreadCount: Integer;              // Liczba wątków
    function FormatMemorySize(SizeInBytes: Int64): string; // Formatuje rozmiar pamięci
    function GetTopProcessesByCPUUsage(Count: Integer = 5): TArray<TProcessCpuUsage>; // Top procesy CPU
    function GetTopProcessesByMemoryUsage(Count: Integer = 5): TArray<TProcessCpuUsage>; // Top procesy RAM

    // Właściwości
    property OnHighCPUUsage: TResourceChangeEvent read FOnHighCPUUsage write FOnHighCPUUsage;
    property OnHighMemoryUsage: TResourceChangeEvent read FOnHighMemoryUsage write FOnHighMemoryUsage;
    property CPUUsageThreshold: Double read FCPUUsageThreshold write FCPUUsageThreshold;
    property MemoryUsageThreshold: Double read FMemoryUsageThreshold write FMemoryUsageThreshold;
  end;

implementation

{ TSystemResourceMonitor }

constructor TSystemResourceMonitor.Create;
begin
  inherited Create;
  // Inicjalizacja zmiennych do obliczania użycia CPU
  FLastIdleTime := 0;
  FLastKernelTime := 0;
  FLastUserTime := 0;
  FLastSystemTime := 0;
  
  // Inicjalizacja słownika przechowującego czasy procesów
  FLastProcessTimes := TDictionary<Cardinal, Int64>.Create;
  
  // Tworzenie migawki procesów
  FProcessHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  
  // Inicjalizacja struktury pamięci
  FillChar(FLastMemoryStatus, SizeOf(TMemoryStatusEx), 0);
  
  // Ustawienie domyślnych progów alarmowych
  FCPUUsageThreshold := 90.0;    // 90% dla CPU
  FMemoryUsageThreshold := 90.0; // 90% dla pamięci
end;

destructor TSystemResourceMonitor.Destroy;
begin
  // Zamykanie uchwytu migawki procesów
  CloseHandle(FProcessHandle);
  
  // Zwolnienie słownika
  FLastProcessTimes.Free;
  
  inherited;
end;

function TSystemResourceMonitor.GetCurrentCPUUsage: Double;
var
  li, ki, ui: TFileTime; // Czasy: idle, kernel, user
  sysIdle, sysKernel, sysUser: Int64;
  idleTime, kernelTime, userTime: Int64;
begin
  // Pobranie aktualnych czasów systemowych
  if not GetSystemTimes(li, ki, ui) then
    RaiseLastOSError;

  // Konwersja czasów do postaci Int64
  sysIdle := Int64(li.dwLowDateTime) or (Int64(li.dwHighDateTime) shl 32);
  sysKernel := Int64(ki.dwLowDateTime) or (Int64(ki.dwHighDateTime) shl 32);
  sysUser := Int64(ui.dwLowDateTime) or (Int64(ui.dwHighDateTime) shl 32);

  // Obliczenie różnicy czasu od ostatniego pomiaru
  idleTime := sysIdle - FLastIdleTime;
  kernelTime := sysKernel - FLastKernelTime;
  userTime := sysUser - FLastUserTime;

  // Zapamiętanie aktualnych czasów dla następnego pomiaru
  FLastIdleTime := sysIdle;
  FLastKernelTime := sysKernel;
  FLastUserTime := sysUser;
  FLastSystemTime := kernelTime + userTime;

  // Obliczenie procentowego wykorzystania CPU
  if (kernelTime + userTime) > 0 then
    Result := (1 - (idleTime / (kernelTime + userTime))) * 100
  else
    Result := 0;
end;

function TSystemResourceMonitor.GetProcessTimes(ProcessHandle: THandle): Int64;
var
  CreationTime, ExitTime, KernelTime, UserTime: TFileTime;
begin
  // Pobranie czasów procesu
  if not Winapi.Windows.GetProcessTimes(ProcessHandle, CreationTime, ExitTime, KernelTime, UserTime) then
    RaiseLastOSError;

  // Sumowanie czasu jądra i użytkownika
  Result := (Int64(KernelTime.dwLowDateTime) or (Int64(KernelTime.dwHighDateTime) shl 32)) +
            (Int64(UserTime.dwLowDateTime) or (Int64(UserTime.dwHighDateTime) shl 32));
end;

function TSystemResourceMonitor.GetProcessMemoryUsage(ProcessID: Cardinal): Double;
var
  ProcessHandle: THandle;
  MemInfo: PROCESS_MEMORY_COUNTERS;
begin
  Result := 0;
  // Otwarcie procesu z uprawnieniami do odczytu informacji
  ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessID);
  if ProcessHandle <> 0 then
  try
    // Pobranie informacji o użyciu pamięci przez proces
    if GetProcessMemoryInfo(ProcessHandle, @MemInfo, SizeOf(MemInfo)) then
      Result := MemInfo.WorkingSetSize / (1024 * 1024); // Konwersja bajtów na MB
  finally
    CloseHandle(ProcessHandle);
  end;
end;

function TSystemResourceMonitor.GetProcessCpuUsages: TArray<TProcessCpuUsage>;
var
  ProcessEntry: TProcessEntry32;
  CurrentTimes: TDictionary<Cardinal, Int64>;
  ProcessHandle: THandle;
  CurrentTime, LastTime, DeltaTime: Int64;
  SystemDelta: Int64;
begin
  SystemDelta := FLastSystemTime;

  // Słownik przechowujący aktualne czasy procesów
  CurrentTimes := TDictionary<Cardinal, Int64>.Create;
  try
    // Wyliczenie wszystkich procesów
    ProcessEntry.dwSize := SizeOf(ProcessEntry);
    if Process32First(FProcessHandle, ProcessEntry) then
    begin
      repeat
        // Otwarcie każdego procesu do odczytu informacji
        ProcessHandle := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, ProcessEntry.th32ProcessID);
        if ProcessHandle <> 0 then
        try
          // Pobranie czasów procesu i zapisanie do słownika
          CurrentTime := GetProcessTimes(ProcessHandle);
          CurrentTimes.Add(ProcessEntry.th32ProcessID, CurrentTime);
        finally
          CloseHandle(ProcessHandle);
        end;
      until not Process32Next(FProcessHandle, ProcessEntry);
    end;

    // Inicjalizacja tablicy wynikowej
    SetLength(Result, CurrentTimes.Count);
    var i := 0;
    
    // Obliczenie wykorzystania CPU dla każdego procesu
    for var Pair in CurrentTimes do
    begin
      // Obliczenie różnicy czasu od ostatniego pomiaru
      if FLastProcessTimes.TryGetValue(Pair.Key, LastTime) then
        DeltaTime := Pair.Value - LastTime
      else
        DeltaTime := 0;

      // Wypełnienie informacji o procesie
      Result[i].ProcessID := Pair.Key;
      Result[i].ProcessName := string(ProcessEntry.szExeFile);
      
      // Obliczenie procentowego wykorzystania CPU
      if SystemDelta > 0 then
        Result[i].UsagePercent := 100.0 * DeltaTime / SystemDelta
      else
        Result[i].UsagePercent := 0.0;
        
      // Pobranie użycia pamięci przez proces
      Result[i].MemoryUsageMB := GetProcessMemoryUsage(Pair.Key);

      Inc(i);
    end;

    // Aktualizacja słownika ostatnich czasów procesów
    FLastProcessTimes.Clear;
    for var Pair in CurrentTimes do
      FLastProcessTimes.Add(Pair.Key, Pair.Value);
  finally
    CurrentTimes.Free;
  end;
end;

function TSystemResourceMonitor.GetTopProcessesByCPUUsage(Count: Integer): TArray<TProcessCpuUsage>;
var
  AllProcesses: TArray<TProcessCpuUsage>;
begin
  // Pobranie wszystkich procesów
  AllProcesses := GetProcessCpuUsages;

  // Sortowanie procesów malejąco według użycia CPU
  TArray.Sort<TProcessCpuUsage>(AllProcesses, TComparer<TProcessCpuUsage>.Construct(
    function(const Left, Right: TProcessCpuUsage): Integer
    begin
      Result := CompareValue(Right.UsagePercent, Left.UsagePercent);
    end
  ));

  // Ograniczenie wyników do żądanej liczby
  if Length(AllProcesses) > Count then
    SetLength(AllProcesses, Count);

  Result := AllProcesses;
end;

function TSystemResourceMonitor.GetTopProcessesByMemoryUsage(Count: Integer): TArray<TProcessCpuUsage>;
var
  AllProcesses: TArray<TProcessCpuUsage>;
begin
  // Pobranie wszystkich procesów
  AllProcesses := GetProcessCpuUsages;

  // Sortowanie procesów malejąco według użycia pamięci
  TArray.Sort<TProcessCpuUsage>(AllProcesses, TComparer<TProcessCpuUsage>.Construct(
    function(const Left, Right: TProcessCpuUsage): Integer
    begin
      Result := CompareValue(Right.MemoryUsageMB, Left.MemoryUsageMB);
    end
  ));

  // Ograniczenie wyników do żądanej liczby
  if Length(AllProcesses) > Count then
    SetLength(AllProcesses, Count);

  Result := AllProcesses;
end;

function TSystemResourceMonitor.GetMemoryStatus: TMemoryStatusEx;
begin
  // Aktualizacja statusu pamięci nie częściej niż raz na sekundę
  if (FLastMemoryStatus.dwLength = 0) or (Now - FLastUpdateTime > (1/86400)) then
  begin
    FLastMemoryStatus.dwLength := SizeOf(TMemoryStatusEx);
    if not GlobalMemoryStatusEx(FLastMemoryStatus) then
      RaiseLastOSError;
    FLastUpdateTime := Now;
  end;
  Result := FLastMemoryStatus;
end;

function TSystemResourceMonitor.GetResourceInfo: TSystemResourceInfo;
var
  MemStatus: TMemoryStatusEx;
  OSVersion: TOSVersionInfoEx;
begin
  // Pobranie aktualnego statusu pamięci
  MemStatus := GetMemoryStatus;
  
  // Pobranie informacji o systemie operacyjnym
  OSVersion := GetOSInfo;

  // Wypełnienie struktury wynikowej
  Result.CPUUsage := GetCurrentCPUUsage;

  // Pamięć fizyczna
  Result.MemoryTotal := MemStatus.ullTotalPhys div (1024 * 1024); // Konwersja na MB
  Result.MemoryUsed := (MemStatus.ullTotalPhys - MemStatus.ullAvailPhys) div (1024 * 1024); // MB
  Result.MemoryUsagePercent := (Result.MemoryUsed / Result.MemoryTotal) * 100;

  // Pamięć wirtualna
  Result.VirtualMemoryTotal := MemStatus.ullTotalPageFile div (1024 * 1024); // MB
  Result.VirtualMemoryUsed := (MemStatus.ullTotalPageFile - MemStatus.ullAvailPageFile) div (1024 * 1024); // MB
  if Result.VirtualMemoryTotal > 0 then
    Result.VirtualMemoryUsagePercent := (Result.VirtualMemoryUsed / Result.VirtualMemoryTotal) * 100
  else
    Result.VirtualMemoryUsagePercent := 0;

  // Informacje o systemie
  Result.OSName := GetOSDetails;
  Result.OSVersion := Format('Build %d', [OSVersion.dwBuildNumber]);
  Result.ProcessorArchitecture := GetProcessorArchitecture;
  Result.ProcessorCoreCount := GetProcessorCoreCount;
  Result.ProcessCount := GetProcessCount;
  Result.ThreadCount := GetThreadCount;
  Result.ProcessUsages := GetTopProcessesByCPUUsage(10); // Top 10 procesów

  // Sprawdzenie progów alarmowych
  CheckForThresholds(Result);
end;

procedure TSystemResourceMonitor.CheckForThresholds(const Info: TSystemResourceInfo);
begin
  // Wywołanie zdarzenia dla wysokiego użycia CPU
  if Assigned(FOnHighCPUUsage) and (Info.CPUUsage >= FCPUUsageThreshold) then
    FOnHighCPUUsage(Self, Info);

  // Wywołanie zdarzenia dla wysokiego użycia pamięci
  if Assigned(FOnHighMemoryUsage) and (Info.MemoryUsagePercent >= FMemoryUsageThreshold) then
    FOnHighMemoryUsage(Self, Info);
end;

function TSystemResourceMonitor.GetCPUUsage: Double;
begin
  Result := GetCurrentCPUUsage;
end;

function TSystemResourceMonitor.GetTotalMemory: Int64;
var
  MemStatus: TMemoryStatusEx;
begin
  MemStatus := GetMemoryStatus;
  Result := MemStatus.ullTotalPhys div (1024 * 1024); // MB
end;

function TSystemResourceMonitor.GetUsedMemory: Int64;
var
  MemStatus: TMemoryStatusEx;
begin
  MemStatus := GetMemoryStatus;
  Result := (MemStatus.ullTotalPhys - MemStatus.ullAvailPhys) div (1024 * 1024); // MB
end;

function TSystemResourceMonitor.GetMemoryUsagePercent: Double;
var
  MemStatus: TMemoryStatusEx;
begin
  MemStatus := GetMemoryStatus;
  Result := ((MemStatus.ullTotalPhys - MemStatus.ullAvailPhys) / MemStatus.ullTotalPhys) * 100;
end;

function TSystemResourceMonitor.GetOSDetails: string;
var
  OSVersion: TOSVersionInfoEx;
  ProductType: DWORD;
begin
  OSVersion := GetOSInfo;

  // Pobranie typu produktu (wersji Windows)
  if not GetProductInfo(OSVersion.dwMajorVersion, OSVersion.dwMinorVersion, 0, 0, ProductType) then
    ProductType := 0;

  // Określenie nazwy systemu na podstawie wersji
  if OSVersion.dwMajorVersion = 10 then
  begin
    if OSVersion.dwBuildNumber >= 22621 then
      Result := 'Windows 11 22H2+'
    else if OSVersion.dwBuildNumber >= 22000 then
      Result := 'Windows 11'
    else
    begin
      case ProductType of
        PRODUCT_STANDARD_SERVER, PRODUCT_DATACENTER_SERVER, PRODUCT_ENTERPRISE_SERVER:
          begin
            if OSVersion.dwBuildNumber >= 17763 then
              Result := 'Windows Server 2019'
            else if OSVersion.dwBuildNumber >= 14393 then
              Result := 'Windows Server 2016'
            else
              Result := 'Windows Server';
          end;
        else
          Result := 'Windows 10';
      end;
    end;
  end
  else
  begin
    // Obsługa starszych wersji Windows
    case OSVersion.dwMajorVersion of
      6:
        case OSVersion.dwMinorVersion of
          0: Result := 'Windows Vista';
          1: Result := 'Windows 7';
          2: Result := 'Windows 8';
          3: Result := 'Windows 8.1';
          else Result := 'Windows ' + IntToStr(OSVersion.dwMajorVersion);
        end;
      5:
        case OSVersion.dwMinorVersion of
          0: Result := 'Windows 2000';
          1: Result := 'Windows XP';
          2: Result := 'Windows Server 2003';
          else Result := 'Windows ' + IntToStr(OSVersion.dwMajorVersion);
        end;
      else
        Result := 'Windows ' + IntToStr(OSVersion.dwMajorVersion) + '.' + IntToStr(OSVersion.dwMinorVersion);
    end;
  end;

  // Dodanie dodatkowych informacji o systemie jeśli dostępne
  if OSVersion.szCSDVersion <> '' then
    Result := Result + ' ' + string(OSVersion.szCSDVersion);
end;

function TSystemResourceMonitor.GetOSInfo: TOSVersionInfoEx;
var
  VerInfo: TOSVersionInfoEx;
begin
  FillChar(VerInfo, SizeOf(TOSVersionInfoEx), 0);
  VerInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfoEx);

  if not GetVersionEx(TOSVersionInfo(Addr(VerInfo)^)) then
    RaiseLastOSError;

  Result := VerInfo;
end;

function TSystemResourceMonitor.GetProcessorArchitecture(ShowCoreCount: Boolean = True): string;
var
  SysInfo: TSystemInfo;
  ProcessorName: string;
  IsWow64: BOOL;
begin
  GetSystemInfo(SysInfo);
  IsWow64 := False;

  // Sprawdzenie czy działa emulacja Wow64 (tylko dla 32-bit)
  {$IFDEF WIN32}
  if (SysInfo.wProcessorArchitecture <> PROCESSOR_ARCHITECTURE_INTEL) then
    IsWow64 := True;
  {$ENDIF}

  // Określenie architektury procesora na podstawie informacji systemowych
  case SysInfo.wProcessorArchitecture of
    PROCESSOR_ARCHITECTURE_INTEL:
    begin
      case SysInfo.wProcessorLevel of
        3:  ProcessorName := 'Intel 386';
        4:  ProcessorName := 'Intel 486';
        5:  ProcessorName := 'Intel Pentium';
        6:  ProcessorName := 'Intel Pentium Pro/II/III';
        15: ProcessorName := 'Intel Pentium 4';
        else ProcessorName := 'Intel x86';
      end;
      Result := ProcessorName + ' (32-bit)';
    end;

    PROCESSOR_ARCHITECTURE_MIPS:
      Result := 'MIPS R' + IntToStr(SysInfo.wProcessorLevel);

    PROCESSOR_ARCHITECTURE_ALPHA:
      Result := 'Alpha ' + IntToStr(SysInfo.wProcessorLevel);

    PROCESSOR_ARCHITECTURE_PPC:
    begin
      case SysInfo.wProcessorLevel of
        $0001: ProcessorName := 'PowerPC 601';
        $0003: ProcessorName := 'PowerPC 603';
        $0004: ProcessorName := 'PowerPC 604';
        $0006: ProcessorName := 'PowerPC 620';
        else   ProcessorName := 'PowerPC';
      end;
      Result := ProcessorName;
    end;

    PROCESSOR_ARCHITECTURE_SHX:
      Result := 'SuperH SH-' + IntToStr(SysInfo.wProcessorLevel);

    PROCESSOR_ARCHITECTURE_ARM:
    begin
      case SysInfo.wProcessorLevel of
        $A11:  ProcessorName := 'StrongARM';
        $720:  ProcessorName := 'ARM 720';
        $820:  ProcessorName := 'ARM 820';
        $920:  ProcessorName := 'ARM 920';
        else   ProcessorName := 'ARM';
      end;
      Result := ProcessorName;
    end;

    PROCESSOR_ARCHITECTURE_IA64:
      Result := 'Intel Itanium (64-bit)';

    PROCESSOR_ARCHITECTURE_ALPHA64:
      Result := 'Alpha 64-bit';

    PROCESSOR_ARCHITECTURE_MSIL:
      Result := 'MSIL';

    PROCESSOR_ARCHITECTURE_AMD64:
      Result := 'AMD64/Intel x64 (64-bit)';

    PROCESSOR_ARCHITECTURE_IA32_ON_WIN64:
      Result := 'IA-32 emulated on x64';

    PROCESSOR_ARCHITECTURE_UNKNOWN:
      Result := 'Unknown architecture';

    else
      Result := 'Other unrecognized architecture';
  end;

  // Dodanie informacji o liczbie rdzeni jeśli wymagane
  if ShowCoreCount then
    Result := Result + ', ' + IntToStr(SysInfo.dwNumberOfProcessors) + ' cores';

  // Dodanie informacji o emulacji Wow64 jeśli wymagane
  if IsWow64 then
    Result := Result + ' (WoW64)';
end;

function TSystemResourceMonitor.GetProcessorCoreCount: Integer;
var
  SysInfo: TSystemInfo;
begin
  GetSystemInfo(SysInfo);
  Result := SysInfo.dwNumberOfProcessors;
end;

function TSystemResourceMonitor.GetProcessCount: Integer;
var
  ProcessSnap: THandle;
  ProcessEntry: TProcessEntry32;
begin
  Result := 0;
  // Utworzenie migawki procesów
  ProcessSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  if ProcessSnap <> INVALID_HANDLE_VALUE then
  try
    ProcessEntry.dwSize := SizeOf(TProcessEntry32);
    // Zliczenie wszystkich procesów
    if Process32First(ProcessSnap, ProcessEntry) then
    begin
      repeat
        Inc(Result);
      until not Process32Next(ProcessSnap, ProcessEntry);
    end;
  finally
    CloseHandle(ProcessSnap);
  end;
end;

function TSystemResourceMonitor.GetThreadCount: Integer;
var
  ThreadSnap: THandle;
  ThreadEntry: TThreadEntry32;
begin
  Result := 0;
  // Utworzenie migawki wątków
  ThreadSnap := CreateToolhelp32Snapshot(TH32CS_SNAPTHREAD, 0);
  if ThreadSnap <> INVALID_HANDLE_VALUE then
  try
    ThreadEntry.dwSize := SizeOf(TThreadEntry32);
    // Zliczenie wszystkich wątków
    if Thread32First(ThreadSnap, ThreadEntry) then
    begin
      repeat
        Inc(Result);
      until not Thread32Next(ThreadSnap, ThreadEntry);
    end;
  finally
    CloseHandle(ThreadSnap);
  end;
end;

function TSystemResourceMonitor.FormatMemorySize(SizeInBytes: Int64): string;
begin
  // Formatowanie rozmiaru pamięci do czytelnej postaci
  if SizeInBytes < 1024 then
    Result := Format('%d B', [SizeInBytes])
  else if SizeInBytes < 1024 * 1024 then
    Result := Format('%.2f KB', [SizeInBytes / 1024])
  else if SizeInBytes < 1024 * 1024 * 1024 then
    Result := Format('%.2f MB', [SizeInBytes / (1024 * 1024)])
  else
    Result := Format('%.2f GB', [SizeInBytes / (1024 * 1024 * 1024)]);
end;

end.

Prostu przykład użycia

Kopiuj
uses
  SystemResourceMonitor;

procedure MonitorResources;
var
  Monitor: TSystemResourceMonitor;
  Info: TSystemResourceInfo;
begin
  Monitor := TSystemResourceMonitor.Create;
  try
    // Ustawienie progów alarmowych
    Monitor.CPUUsageThreshold := 85.0;    // Alarm przy 85% CPU
    Monitor.MemoryUsageThreshold := 80.0; // Alarm przy 80% pamięci

    // Przypisanie zdarzeń
    Monitor.OnHighCPUUsage := procedure(Sender: TObject; const Info: TSystemResourceInfo)
    begin
      WriteLn('ALARM: Wysokie obciążenie CPU: ' + FormatFloat('0.00', Info.CPUUsage) + '%');
    end;

    Monitor.OnHighMemoryUsage := procedure(Sender: TObject; const Info: TSystemResourceInfo)
    begin
      WriteLn('ALARM: Wysokie obciążenie pamięci: ' + FormatFloat('0.00', Info.MemoryUsagePercent) + '%');
    end;

    // Pobranie informacji o zasobach
    Info := Monitor.GetResourceInfo;

    // Wyświetlenie informacji
    WriteLn('System: ' + Info.OSName + ' ' + Info.OSVersion);
    WriteLn('Procesor: ' + Info.ProcessorArchitecture);
    WriteLn('CPU: ' + FormatFloat('0.00', Info.CPUUsage) + '%');
    WriteLn('RAM: ' + Monitor.FormatMemorySize(Info.MemoryUsed) + ' / ' + 
            Monitor.FormatMemorySize(Info.MemoryTotal) + 
            ' (' + FormatFloat('0.00', Info.MemoryUsagePercent) + '%)');
    WriteLn('Procesy: ' + Info.ProcessCount.ToString + ', Wątki: ' + Info.ThreadCount.ToString);

    // Wyświetlenie 5 najbardziej obciążających procesów
    WriteLn(#13#10'Top 5 procesów według CPU:');
    for var Proc in Monitor.GetTopProcessesByCPUUsage(5) do
    begin
      WriteLn(Format('  %-30s PID:%-6d CPU:%-6.2f%% RAM:%-6.2f MB', 
            [Proc.ProcessName, Proc.ProcessID, Proc.UsagePercent, Proc.MemoryUsageMB]));
    end;
  finally
    Monitor.Free;
  end;
end;


woolfik
  • Rejestracja:ponad 17 lat
  • Ostatnio:około godziny
  • Postów:1599
1
FP
  • Rejestracja:prawie 2 lata
  • Ostatnio:około miesiąc
  • Postów:37
2

@woolfik: Kod wyżej z mojego małego projektu. Póki co, tak to u mnie wygląda https://streamable.com/6yccn9


FP
  • Rejestracja:prawie 2 lata
  • Ostatnio:około miesiąc
  • Postów:37
0

Unit dla wersji programu, może się komuś przyda dla swojego/swoich programów :)

Kopiuj

// CODE BY FPERSON

unit AppVersion;

interface

uses
  System.SysUtils, System.DateUtils;

type
  // Typ wyliczeniowy dla określenia etapu wydania
  TReleaseType = (rtAlpha, rtBeta, rtRC, rtRTM);

  /// Struktura reprezentująca wersję aplikacji
  TAppVersion = record
  private
    FMajor: Integer;
    FMinor: Integer;
    FBuild: Integer;
    FRevision: Integer;
    FReleaseType: TReleaseType;
  public
    // Główny numer wersji, zwiększany przy znaczących zmianach
    property Major: Integer read FMajor write FMajor;
    // Podrzędny numer wersji, zwiększany przy mniejszych zmianach
    property Minor: Integer read FMinor write FMinor;
    // Numer kompilacji, zazwyczaj zwiększany przy każdej kompilacji
    property Build: Integer read FBuild write FBuild;
    // Numer rewizji, zazwyczaj używany dla poprawek lub małych zmian
    property Revision: Integer read FRevision write FRevision;
    // Typ wydania (Alpha, Beta, RC, RTM)
    property ReleaseType: TReleaseType read FReleaseType write FReleaseType;

    // Konwertuje wersję do pełnego formatu tekstowego (np. "1.0.0.1 Beta")
    function ToString: string;
    // Konwertuje wersję do krótkiego formatu (np. "1.0")
    function ToShortString: string;
    // Konwertuje wersję do formatu zgodnego z Windows (32-bitowa liczba)
    function ToWindowsVersion: Cardinal;
    // Sprawdza czy bieżąca wersja jest nowsza od podanej
    function IsNewerThan(const AVersion: TAppVersion): Boolean;
    // Sprawdza czy bieżąca wersja jest równa podanej
    function Equals(const AVersion: TAppVersion): Boolean;
    // Sprawdza czy bieżąca wersja jest kompatybilna z podaną
    function IsCompatibleWith(const AVersion: TAppVersion): Boolean;
    // Tworzy obiekt wersji z podanego ciągu znaków
    class function FromString(const AVersionStr: string): TAppVersion; static;
    // Automatycznie aktualizuje numery Build i Revision na podstawie aktualnej daty i czasu
    procedure AutoUpdateBuildInfo;
    // Konstruktor tworzący obiekt wersji
    class function Create(AMajor, AMinor: Integer; ABuild: Integer = 0; ARevision: Integer = 0; AReleaseType: TReleaseType = rtRTM): TAppVersion; static;
  end;

const
  /// domyslna wersja programu
  MyAppVersion: TAppVersion = (FMajor: 1; FMinor: 1; FBuild: 0; FRevision: 0; FReleaseType: rtRTM);

implementation

{ TAppVersion }

function TAppVersion.ToString: string;
const
  /// Nazwy typów wydania
  ReleaseNames: array[TReleaseType] of string = ('Alpha', 'Beta', 'RC', 'RTM');
begin
  if ReleaseType = rtRTM then
    Result := Format('%d.%d.%d.%d', [Major, Minor, Build, Revision])
  else
    Result := Format('%d.%d.%d.%d %s', [Major, Minor, Build, Revision, ReleaseNames[ReleaseType]]);
end;

function TAppVersion.ToShortString: string;
begin
  Result := Format('%d.%d', [Major, Minor]);
end;

function TAppVersion.ToWindowsVersion: Cardinal;
begin
  // Format używany przez Windows:
  // starsze 16 bitów to Major i Minor, młodsze 16 bitów to Build i Revision
  Result := (Cardinal(Major) shl 24) or (Cardinal(Minor) shl 16) or
            (Cardinal(Build) shl 8) or Cardinal(Revision);
end;

function TAppVersion.IsNewerThan(const AVersion: TAppVersion): Boolean;
begin
  // Sprawdzamy hierarchicznie każdy element wersji
  Result := (Major > AVersion.Major) or
           ((Major = AVersion.Major) and (Minor > AVersion.Minor)) or
           ((Major = AVersion.Major) and (Minor = AVersion.Minor) and (Build > AVersion.Build)) or
           ((Major = AVersion.Major) and (Minor = AVersion.Minor) and (Build = AVersion.Build) and
            (Revision > AVersion.Revision));
end;

function TAppVersion.Equals(const AVersion: TAppVersion): Boolean;
begin
  Result := (Major = AVersion.Major) and (Minor = AVersion.Minor) and
            (Build = AVersion.Build) and (Revision = AVersion.Revision) and
            (ReleaseType = AVersion.ReleaseType);
end;

function TAppVersion.IsCompatibleWith(const AVersion: TAppVersion): Boolean;
begin
  // Przykładowa implementacja kompatybilności:
  // Wersje są kompatybilne, jeśli mają ten sam numer Major
  Result := Major = AVersion.Major;
end;

class function TAppVersion.FromString(const AVersionStr: string): TAppVersion;
var
  Parts: TArray<string>;
  VersionPart, ReleasePart: string;
  i: Integer;
begin
  Result := TAppVersion.Create(0, 0);

  // Domyślnie ustawiamy jako RTM
  Result.ReleaseType := rtRTM;

  // Sprawdzamy czy jest część opisująca typ wydania
  i := Pos(' ', AVersionStr);
  if i > 0 then
  begin
    VersionPart := Copy(AVersionStr, 1, i-1);
    ReleasePart := Trim(Copy(AVersionStr, i+1, Length(AVersionStr)));

    // Określamy typ wydania
    if SameText(ReleasePart, 'Alpha') then
      Result.ReleaseType := rtAlpha
    else if SameText(ReleasePart, 'Beta') then
      Result.ReleaseType := rtBeta
    else if SameText(ReleasePart, 'RC') then
      Result.ReleaseType := rtRC;
  end
  else
    VersionPart := AVersionStr;

  // Dzielimy ciąg na części oddzielone kropkami
  Parts := VersionPart.Split(['.']);

  // Przypisujemy wartości, jeśli są dostępne
  if Length(Parts) > 0 then
    Result.Major := StrToIntDef(Parts[0], 0);

  if Length(Parts) > 1 then
    Result.Minor := StrToIntDef(Parts[1], 0);

  if Length(Parts) > 2 then
    Result.Build := StrToIntDef(Parts[2], 0);

  if Length(Parts) > 3 then
    Result.Revision := StrToIntDef(Parts[3], 0);
end;

procedure TAppVersion.AutoUpdateBuildInfo;
var
  CurrentDate: TDateTime;
begin
  CurrentDate := Now;

  // Używamy numeru dnia w roku jako numer kompilacji
  Build := DayOfTheYear(CurrentDate);

  // Używamy połączenia godziny i minuty jako numer rewizji
  Revision := HourOf(CurrentDate) * 100 + MinuteOf(CurrentDate);
end;

class function TAppVersion.Create(AMajor, AMinor, ABuild, ARevision: Integer;
  AReleaseType: TReleaseType): TAppVersion;
begin
  Result.FMajor := AMajor;
  Result.FMinor := AMinor;
  Result.FBuild := ABuild;
  Result.FRevision := ARevision;
  Result.FReleaseType := AReleaseType;
end;

end.

Przykład użycia unit AppVersion

Kopiuj

program AppVersionExample;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  AppVersion in 'AppVersion.pas';

procedure DisplayVersionInfo(const Version: TAppVersion);
begin
  Writeln('Pełna wersja: ', Version.ToString);
  Writeln('Krótka wersja: ', Version.ToShortString);
  Writeln('Wersja Windows: ', IntToHex(Version.ToWindowsVersion, 8));
  Writeln('Typ wydania: ', Ord(Version.ReleaseType));
  Writeln;
end;

procedure CompareVersions(const Ver1, Ver2: TAppVersion);
begin
  Writeln('Porównanie wersji:');
  Writeln(Ver1.ToString, ' vs ', Ver2.ToString);
  
  if Ver1.Equals(Ver2) then
    Writeln('Wersje są identyczne')
  else if Ver1.IsNewerThan(Ver2) then
    Writeln(Ver1.ToString, ' jest nowsza niż ', Ver2.ToString)
  else
    Writeln(Ver2.ToString, ' jest nowsza niż ', Ver1.ToString);
    
  if Ver1.IsCompatibleWith(Ver2) then
    Writeln('Wersje są kompatybilne (ten sam numer Major)')
  else
    Writeln('Wersje NIE są kompatybilne (różne numery Major)');
    
  Writeln;
end;

var
  CurrentVersion: TAppVersion;
  ParsedVersion: TAppVersion;
  TestVersion1, TestVersion2: TAppVersion;
begin
  try
    // Użycie domyślnej wersji z const
    Writeln('Domyślna wersja aplikacji:');
    DisplayVersionInfo(MyAppVersion);
    
    // Utworzenie nowej wersji
    CurrentVersion := TAppVersion.Create(2, 5, 1234, 5678, rtBeta);
    Writeln('Nowo utworzona wersja:');
    DisplayVersionInfo(CurrentVersion);
    
    // Automatyczna aktualizacja numerów Build i Revision
    CurrentVersion.AutoUpdateBuildInfo;
    Writeln('Wersja po automatycznej aktualizacji:');
    DisplayVersionInfo(CurrentVersion);
    
    // Parsowanie wersji z ciągu znaków
    ParsedVersion := TAppVersion.FromString('3.1.0.15 Alpha');
    Writeln('Wersja sparsowana z ciągu znaków:');
    DisplayVersionInfo(ParsedVersion);
    
    // Przykład parsowania krótszego ciągu
    ParsedVersion := TAppVersion.FromString('4.2.1');
    Writeln('Wersja sparsowana z krótszego ciągu:');
    DisplayVersionInfo(ParsedVersion);
    
    // Porównywanie wersji
    TestVersion1 := TAppVersion.Create(1, 0, 0, 0, rtRTM);
    TestVersion2 := TAppVersion.Create(1, 1, 0, 0, rtRTM);
    CompareVersions(TestVersion1, TestVersion2);
    
    TestVersion1 := TAppVersion.Create(2, 0, 0, 0, rtBeta);
    TestVersion2 := TAppVersion.Create(2, 0, 0, 0, rtRTM);
    CompareVersions(TestVersion1, TestVersion2);
    
    // Test kompatybilności
    TestVersion1 := TAppVersion.Create(3, 0, 0, 0, rtRTM);
    TestVersion2 := TAppVersion.Create(3, 5, 0, 0, rtRTM);
    CompareVersions(TestVersion1, TestVersion2);
    
    TestVersion1 := TAppVersion.Create(3, 0, 0, 0, rtRTM);
    TestVersion2 := TAppVersion.Create(4, 0, 0, 0, rtRTM);
    CompareVersions(TestVersion1, TestVersion2);
    
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
  
  Readln;
end.

Przykładowe wyjście programu

Kopiuj

Domyślna wersja aplikacji:
Pełna wersja: 1.1.0.0
Krótka wersja: 1.1
Wersja Windows: 01010000
Typ wydania: 3

Nowo utworzona wersja:
Pełna wersja: 2.5.1234.5678 Beta
Krótka wersja: 2.5
Wersja Windows: 020504D2162E
Typ wydania: 1

Wersja po automatycznej aktualizacji:
Pełna wersja: 2.5.99.1438 Beta
Krótka wersja: 2.5
Wersja Windows: 0205006359FE
Typ wydania: 1

Wersja sparsowana z ciągu znaków:
Pełna wersja: 3.1.0.15 Alpha
Krótka wersja: 3.1
Wersja Windows: 0301000F
Typ wydania: 0

Wersja sparsowana z krótszego ciągu:
Pełna wersja: 4.2.1.0
Krótka wersja: 4.2
Wersja Windows: 04020100
Typ wydania: 3

Porównanie wersji:
1.0.0.0 vs 1.1.0.0
1.1.0.0 jest nowsza niż 1.0.0.0
Wersje są kompatybilne (ten sam numer Major)

Porównanie wersji:
2.0.0.0 Beta vs 2.0.0.0
Wersje są identyczne
Wersje są kompatybilne (ten sam numer Major)

Porównanie wersji:
3.0.0.0 vs 3.5.0.0
3.5.0.0 jest nowsza niż 3.0.0.0
Wersje są kompatybilne (ten sam numer Major)

Porównanie wersji:
3.0.0.0 vs 4.0.0.0
4.0.0.0 jest nowsza niż 3.0.0.0
Wersje NIE są kompatybilne (różne numery Major)


Zarejestruj się i dołącz do największej społeczności programistów w Polsce.

Otrzymaj wsparcie, dziel się wiedzą i rozwijaj swoje umiejętności z najlepszymi.