понедельник, 15 июня 2026 г.

Показываем информацию о системе и компьютере на Lazarus 4.6 под Debian 13

Пример кода программы на Lazarus 4.6 под Debian 13. Прграмма получает информацию об объёме физической памяти, процессоре, операционной системе. Мной код скомпилирован, программа работает.

Рисунок 1. Пример работы программы "Информация о системе и компьютере"

unit p1_u1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls,
  BaseUnix;

type

  { TAboutForm }

  TAboutForm = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    Cpu: TLabel;
    Label3: TLabel;
    OS: TLabel;
    Mem: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private

  public
        procedure GetOSInfo;
        procedure GetCpuInfo; // Добавили процедуру сбора данных о CPU
        procedure GetMemInfo;
        procedure InitializeCaptions;

  end;

var
  AboutForm: TAboutForm;

implementation

{$R *.lfm}

procedure TAboutForm.FormCreate(Sender: TObject);
begin
     InitializeCaptions;
end;

procedure TAboutForm.Button1Click(Sender: TObject);
begin
     AboutForm.Close;
end;

procedure TAboutForm.GetOSInfo;
var
  UNameRec: utsname; // Структура для информации о системе
  DistroName, DistroVersion: string;
  List: TStringList;
begin
  // 1. Получаем информацию о ядре через системный вызов
  FillChar(UNameRec, SizeOf(UNameRec), 0);
  fpUname(UNameRec);

  // 2. Пытаемся узнать название дистрибутива из /etc/os-release
  DistroName := 'Linux'; // Значение по умолчанию
  DistroVersion := '';

  if FileExists('/etc/os-release') then
  begin
    List := TStringList.Create;
    try
      List.LoadFromFile('/etc/os-release');

      // Ищем ID (например, ubuntu) и PRETTY_NAME (например, Ubuntu 22.04.3 LTS)
      DistroName := List.Values['ID']; // Может вернуть 'ubuntu', 'debian' и т.д.
      if List.Values['PRETTY_NAME'] <> '' then
        DistroName := List.Values['PRETTY_NAME'];
    finally
      List.Free;
    end;
  end;

  // 3. Формируем строку
  // Пример результата: "Ubuntu 22.04.3 LTS (Kernel 5.15.0-76-generic)"
  if DistroName <> 'Linux' then
    OS.Caption := Format('%s (Kernel %s)', [DistroName, UNameRec.release])
  else
    OS.Caption := Format('Linux Kernel %s', [UNameRec.release]);
end;

procedure TAboutForm.GetMemInfo;
var
  List: TStringList;
  sLine, sVal: string;
  P: Integer;
  MemKB: QWord;
begin
  Mem.Caption := 'Unknown';

  // В Linux информация о памяти находится в файле /proc/meminfo
  if FileExists('/proc/meminfo') then
  begin
    List := TStringList.Create;
    try
      List.LoadFromFile('/proc/meminfo');

      // Ищем строку, начинающуюся с MemTotal:
      // Формат строки: MemTotal:       16384000 kB
      for sLine in List do
      begin
        if Pos('MemTotal:', sLine) > 0 then
        begin
          // Удаляем "MemTotal:"
          sVal := sLine;
          Delete(sVal, 1, 9);

          // Получаем первое число (оно может идти с пробелами)
          sVal := Trim(sVal);
          P := Pos(' ', sVal);
          if P > 0 then
            sVal := Copy(sVal, 1, P - 1);

          // Конвертируем и форматируем
          if TryStrToQWord(sVal, MemKB) then
            Mem.Caption := FormatFloat('#,###" KB"', MemKB);

          Break;
        end;
      end;
    finally
      List.Free;
    end;
  end;
end;

procedure TAboutForm.GetCpuInfo;
var
  List: TStringList;
  I: Integer;
  Line: string;
  CpuModel: string;
  CpuCores: string;
begin
  CpuModel := 'Unknown CPU';
  CpuCores := '0';

  if FileExists('/proc/cpuinfo') then
  begin
    List := TStringList.Create;
    try
      List.LoadFromFile('/proc/cpuinfo');

      for I := 0 to List.Count - 1 do
      begin
        Line := List[I];

        // Ищем строку с моделью процессора
        if Pos('model name', Line) = 1 then
        begin
          CpuModel := Copy(Line, Pos(':', Line) + 1, MaxInt);
          CpuModel := Trim(CpuModel); // Убираем лишние пробелы
        end;

        // Ищем количество ядер процессора
        if Pos('cpu cores', Line) = 1 then
        begin
          CpuCores := Copy(Line, Pos(':', Line) + 1, MaxInt);
          CpuCores := Trim(CpuCores);
        end;

        // Если нашли оба значения, выходим из цикла раньше
        if (CpuModel <> 'Unknown CPU') and (CpuCores <> '0') then
          Break;
      end;
    finally
      List.Free;
    end;
  end;

  // Формируем итоговую строку. Если данные не нашлись, выведется "Unknown CPU"
  if (CpuModel <> 'Unknown CPU') and (CpuCores <> '0') then
    Cpu.Caption := Format('%s (%s cores)', [CpuModel, CpuCores])
  else
    Cpu.Caption := 'Unknown CPU';
end;

procedure TAboutForm.InitializeCaptions;
begin
  // Теперь здесь только чистый последовательный вызов модулей
  GetOSInfo;
  GetCpuInfo;
  GetMemInfo;
end;

end.


Комментариев нет:

Отправить комментарий