Пример кода программы на 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.

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