unit About_Unit2;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, FileInfo,
ExtCtrls
{$IFDEF DARWIN}
, Sysctl
{$ENDIF}
{$IFDEF UNIX}
, Unix
{$ENDIF}
{$IFDEF FREEBSD}
, SysCtl
{$ENDIF}
{$IFDEF WINDOWS}
, Windows, Win32Proc
{$ENDIF}
{$IFDEF LINUX}
, Linux, BaseUnix, CTypes
{$ENDIF}
, LCLIntf; // for OpenURL()
type
{ TForm2_About }
TForm2_About = class(TForm)
InfoMemo: TMemo;
LicLabel2: TLabel;
MutexLabel: TLabel;
OK_Button: TButton;
Image1: TImage;
AppLabel: TLabel;
EvanLabel: TLabel;
VersionLabel: TLabel;
AuthorLabel: TLabel;
LicLabel1: TLabel;
LangLabel: TLabel;
AckLabel: TLabel;
CorbinLabel: TLabel;
MarkLabel: TLabel;
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Image1Click(Sender: TObject);
procedure LicLabel2Click(Sender: TObject);
procedure LicLabel2MouseEnter(Sender: TObject);
procedure LicLabel2MouseLeave(Sender: TObject);
procedure OK_ButtonClick(Sender: TObject);
private
public
end;
var
Form2_About: TForm2_About;
FileVerInfo: TFileVersionInfo;
implementation
{$R *.lfm}
{ TForm2_About }
{$IFNDEF LINUX}
{$IFNDEF WINDOWS}
function HWmodel : AnsiString;
var
mib : array[0..1] of Integer;
status : Integer;
len : size_t;
p : PChar;
begin
mib[0] := CTL_HW;
mib[1] := HW_MODEL;
// find out the the length needed for the buffer
status := fpSysCtl(@mib, Length(mib), Nil, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
// allocate the amount of memory discovered above for the buffer
GetMem(p, len);
try
status := fpSysCtl(@mib, Length(mib), p, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
Result := p;
finally
FreeMem(p);
end;
end;
{$IFDEF FREEBSD}
function GetCPUarchitecture: AnsiString;
var
status : Integer;
len : size_t;
p : PChar;
begin
status := fpSysCtlByName('hw.machine_arch', Nil, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
GetMem(p, len);
try
status := fpSysCtlByName('hw.machine_arch', p, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
Result := p;
finally
FreeMem(p);
end;
end;
{$ENDIF}
function NumberOfCPU: Integer;
var
mib: array[0..1] of Integer;
status : Integer;
len : size_t;
begin
mib[0] := CTL_HW;
mib[1] := HW_NCPU;
len := SizeOf(Result);
status := fpSysCtl(@mib, Length(mib), @Result, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
end;
function NumberOfPkgCPU: Integer;
var
status : Integer;
len : size_t;
begin
len := SizeOf(Result);
status := fpSysCtlByName('hw.packages', @Result, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
end;
function NumberOfPhysCPU: Integer;
var
status : Integer;
len : size_t;
begin
len := SizeOf(Result);
status := fpSysCtlByName('hw.physicalcpu', @Result, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
end;
function NumberOfLogCPU: Integer;
var
status : Integer;
len : size_t;
begin
len := SizeOf(Result);
status := fpSysCtlByName('hw.logicalcpu', @Result, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
end;
function GBMemorySize: Int64;
var
mib: array[0..1] of Integer;
status : Integer;
len : size_t;
begin
mib[0] := CTL_HW;
{$IFDEF DARWIN}
mib[1] := HW_MEMSIZE;
{$ELSE}
mib[1] := HW_PHYSMEM;
{$ENDIF}
len := SizeOf(Result);
status := fpSysCtl(@mib, Length(mib), @Result, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
end;
{$IFDEF DARWIN}
function SwapUsage: String;
type
swapinfo = record
xsu_total : Int64;
xsu_avail : Int64;
xsu_used : Int64;
xsu_pagesize : Integer;
xsu_encrypted: Boolean;
end;
var
mib : array[0..1] of Integer;
status : Integer;
len : size_t;
swap : swapinfo;
SwapEncrypted: String;
begin
mib[0] := CTL_VM;
mib[1] := VM_SWAPUSAGE;
swap := Default(swapinfo);
FillChar(swap, sizeof(swap), 0);
len := sizeof(swap);
status := fpSysCtl(@mib, Length(mib), @swap, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
if(swap.xsu_encrypted = true) then
SwapEncrypted := 'Yes' else SwapEncrypted := 'No';
Result := 'Swap total: ' + FloatToStr(Round(swap.xsu_total /1024 /1024)) + ' MB'
+ LineEnding + 'Swap used: ' + FloatToStr(Round(swap.xsu_used /1024 /1024)) + ' MB'
+ LineEnding + 'Swap free: ' + FloatToStr(Round(swap.xsu_avail /1024 /1024)) + ' MB'
+ LineEnding + 'Swap page size: ' + IntToStr(swap.xsu_pagesize) + ' bytes'
+ LineEnding + 'Swap encrypted: ' + SwapEncrypted + LineEnding;
end;
{$ENDIF}
function MaxProcesses : Integer;
var
mib : array[0..1] of Integer;
status : Integer;
len : size_t;
begin
mib[0] := CTL_KERN;
mib[1] := KERN_MAXPROC;
len := sizeof(Result);
status := fpSysCtl(@mib, Length(mib), @Result, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
end;
function BrandOfCPU: AnsiString;
var
status : Integer;
len : size_t;
p : PChar;
begin
status := fpSysCtlByName('machdep.cpu.brand_string', Nil, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
GetMem(p, len);
try
status := fpSysCtlByName('machdep.cpu.brand_string', p, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
Result := p;
finally
FreeMem(p);
end;
end;
function KernelVersion : AnsiString;
var
mib : array[0..1] of Integer;
status : Integer;
len : size_t;
p : PChar;
begin
mib[0] := CTL_KERN;
mib[1] := KERN_VERSION;
//get the length of the buffer
status := fpSysCtl(@mib, Length(mib), Nil, @len, Nil, 0);
if status<>0 then
RaiseLastOSError;
//allocates the buffer
GetMem(p, len);
try
status := fpSysCtl(@mib, Length(mib), p, @len, Nil, 0);
if status <> 0 then
RaiseLastOSError;
Result:=p;
finally
FreeMem(p);
end;
end;
function GetClockInfo: String;
type
clockinfo = record
hz : Integer; // clock frequency
tick : Integer; // ms per Hz tick
{$IFDEF DARWIN}
tickadj : Integer; // clock skew rate
{$ENDIF}
{$IFDEF FREEBSD}
spare : Integer; // unused in FreeBSD
{$ENDIF}
stathz : Integer; // statistics clock frequency
profhz : Integer; // profiling clock frequency
end;
var
mib : array[0..1] of Integer;
status : Integer;
len : size_t;
clock : clockinfo;
begin
mib[0] := CTL_KERN;
mib[1] := KERN_CLOCKRATE;
clock := Default(clockinfo);
FillChar(clock, sizeof(clock), 0);
len := sizeof(clock);
status := fpSysCtl(@mib, Length(mib), @clock, @len, Nil, 0);
if status <> 0 then RaiseLastOSError;
Result := 'Clock freq: ' + IntToStr(clock.hz) + 'Hz' + LineEnding
+ 'Ms per Hz tick: ' + IntToStr(clock.tick) + LineEnding
{$IFDEF DARWIN}
+ 'Clock skew rate: ' + IntToStr(clock.tickadj) + LineEnding
{$ENDIF}
+ 'Profiling clock freq: ' + IntToStr(clock.profhz) + ' Hz'
+ LineEnding;
end;
{$ENDIF}
{$IFDEF WINDOWS}
function GetLogicalCpuCount: Integer;
var
SystemInfo: _SYSTEM_INFO;
begin
GetSystemInfo(SystemInfo);
Result := SystemInfo.dwNumberOfProcessors;
end;
function GetCPUType: String;
var
SystemInfo: _SYSTEM_INFO;
begin
GetSystemInfo(SystemInfo);
{386, 486, 586, 8664 (x86_64/AMD64)}
if(SystemInfo.dwProcessorType = 8664) then Result := 'x86_64'
else if(SystemInfo.dwProcessorType = 586) then Result := 'Pentium'
else if(SystemInfo.dwProcessorType = 486) then Result := '80486'
else if(SystemInfo.dwProcessorType = 386) then Result := '80386'
else Result := 'Unknown!';
end;
function GetCPUArchitecture: String;
var
SystemInfo: _SYSTEM_INFO;
begin
GetSystemInfo(SystemInfo);
if (SystemInfo.wProcessorArchitecture = 9) then Result := 'AMD64'
else if (SystemInfo.wProcessorArchitecture = 5) then Result := 'ARM'
else if (SystemInfo.wProcessorArchitecture = 12) then Result := 'ARM64'
else if (SystemInfo.wProcessorArchitecture = 0) then Result := 'Intel'
else Result := 'Unknown!'
end;
function GetCPULevRev: String;
var
SystemInfo: _SYSTEM_INFO;
begin
GetSystemInfo(SystemInfo);
Result := 'CPU Level: ' + IntToStr(SystemInfo.wProcessorLevel)
+ LineEnding + 'CPU Revision: ' + IntToStr(SystemInfo.wProcessorRevision);
end;
{$ENDIF}
{$ENDIF}
{$IFDEF LINUX}
function sysconf(i:cint):clong;cdecl;external name 'sysconf';
{$ENDIF}
procedure TForm2_About.OK_ButtonClick(Sender: TObject);
begin
Close;
end;
procedure TForm2_About.FormCreate(Sender: TObject);
begin
FileVerInfo:=TFileVersionInfo.Create(Nil);
try
FileVerInfo.ReadFileInfo;
VersionLabel.Caption := 'Version: ' + FileVerInfo.VersionStrings.Values['FileVersion'];
//('Company: ',FileVerInfo.VersionStrings.Values['CompanyName']);
//('File description: ',FileVerInfo.VersionStrings.Values['FileDescription']);
//('File version: ',FileVerInfo.VersionStrings.Values['FileVersion']);
//('Internal name: ',FileVerInfo.VersionStrings.Values['InternalName']);
//('Legal copyright: ',FileVerInfo.VersionStrings.Values['LegalCopyright']);
//('Original filename: ',FileVerInfo.VersionStrings.Values['OriginalFilename']);
//('Product name: ',FileVerInfo.VersionStrings.Values['ProductName']);
//('Product version: ',FileVerInfo.VersionStrings.Values['ProductVersion']);
finally
FileVerInfo.Free;
end;
// Darwin/Windows default Laz 2.1.0, FPC 3.3.1
{$IFDEF FREEBSD}
LangLabel.Caption := 'Programmed in Lazarus 2.1, FPC 3.3.1';
{$ENDIF}
{$IFDEF LINUX}
LangLabel.Caption := 'Programmed in Lazarus 2.1, FPC 3.0.4';
{$ENDIF}
end;
procedure TForm2_About.FormShow(Sender: TObject);
begin
{$IFDEF DARWIN}
Form2_About.Height := 300;
{$ENDIF}
end;
procedure TForm2_About.Image1Click(Sender: TObject);
{$IFDEF UNIX}
{$IFNDEF LINUX}
Var
ResInt: Int64;
ResStr: String;
{$ENDIF}
{$ENDIF}
{$IFDEF WINDOWS}
Var
Memory: TMemoryStatus;
{$ENDIF}
{$IFDEF LINUX}
Var
KernelName: UtsName;
Info: TSysInfo;
{$ENDIF}
begin
if(InfoMemo.Visible = True) then
begin
InfoMemo.Visible := False;
InfoMemo.Text := '';
Exit;
end;
{$IFDEF WINDOWS}
if WindowsVersion = wv95 then InfoMemo.Lines.Add('Windows 95')
else if WindowsVersion = wvNT4 then InfoMemo.Lines.Add('Windows NT v.4')
else if WindowsVersion = wv98 then InfoMemo.Lines.Add('Windows 98')
else if WindowsVersion = wvMe then InfoMemo.Lines.Add('Windows ME')
else if WindowsVersion = wv2000 then InfoMemo.Lines.Add('Windows 2000')
else if WindowsVersion = wvXP then InfoMemo.Lines.Add('Windows XP')
else if WindowsVersion = wvServer2003 then InfoMemo.Lines.Add('Windows Server 2003/Windows XP64')
else if WindowsVersion = wvVista then InfoMemo.Lines.Add('Windows Vista')
else if WindowsVersion = wv7 then InfoMemo.Lines.Add('Windows 7')
else if WindowsVersion = wv10 then InfoMemo.Lines.Add('Windows 10')
else InfoMemo.Lines.Add('Windows Unknown Version!');
InfoMemo.Lines.Add('Logical CPU count: ' + IntToStr(GetLogicalCPUCount));
InfoMemo.Lines.Add('CPU type: ' + GetCPUType);
InfoMemo.Lines.Add('CPU architecture: ' + GetCPUArchitecture);
InfoMemo.Lines.Add(GetCPULevRev);
Memory.dwLength := SizeOf(Memory);
GlobalMemoryStatus(Memory);
InfoMemo.Lines.Add(Format('Memory total: %f GB', [Memory.dwTotalPhys /1024 /1024 /1024]));
InfoMemo.Lines.Add(Format('Memory free: %f GB', [Memory.dwAvailPhys /1024 /1024 /1024]));
InfoMemo.Lines.Add(Format('Memory in use: %d%%', [Memory.dwMemoryLoad]));
InfoMemo.Lines.Add(Format('Pagefile size: %f GB', [Memory.dwTotalPageFile /1024 /1024 /1024]));
InfoMemo.Lines.Add(Format('Pagefile free: %f GB', [Memory.dwAvailPageFile /1024 /1024 /1024]));
InfoMemo.Lines.Add(Format('Virtual memory total: %f GB', [Memory.dwTotalVirtual /1024 /1024 /1024]));
InfoMemo.Lines.Add(Format('Virtual memory free: %f GB', [Memory.dwAvailVirtual /1024 /1024 /1024]));
InfoMemo.Lines.Add(Format('Disk space total: %f GB', [DiskSize(0) /1024 /1024 /1024]));
InfoMemo.Lines.Add(Format('Disk space free: %f GB', [DiskFree(0) /1024 /1024 /1024]));
{$ENDIF}
{$IFNDEF LINUX}
{$IFNDEF WINDOWS}
ResStr := HWmodel;
InfoMemo.Lines.Add('Hardware model: ' + ResStr);
{$IFDEF DARWIN}
ResStr := BrandOfCPU;
InfoMemo.Lines.Add(ResStr);
ResInt := NumberOfPkgCPU;
InfoMemo.Lines.Add('CPU packages: ' + IntToStr(ResInt));
ResInt := NumberOfPhysCPU;
InfoMemo.Lines.Add('CPU cores: ' + IntToStr(ResInt));
ResInt := NumberOfLogCPU;
InfoMemo.Lines.Add('CPU logical: ' + IntToStr(ResInt));
{$ENDIF}
{$IFDEF FREEBSD}
InfoMemo.Lines.Add('CPU architecture: ' + GetCPUarchitecture);
{$ENDIF}
ResInt := NumberOfCPU;
InfoMemo.Lines.Add('CPU threads: ' + IntToStr(ResInt));
InfoMemo.Lines.Add(' ');
ResInt := Round(GBMemorySize);
InfoMemo.Lines.Add('Memory size: ' + IntToStr(Round(ResInt /1024 /1024 /1024)) + ' GB');
InfoMemo.Lines.Add(' ');
{$IFDEF DARWIN}
InfoMemo.Lines.Add(SwapUsage);
{$ENDIF}
InfoMemo.Lines.Add(GetClockInfo);
ResStr := KernelVersion;
InfoMemo.Lines.Add(ResStr);
{$IFNDEF FREEBSD}
InfoMemo.Lines.Add(' ');
{$ENDIF}
ResInt := MaxProcesses;
InfoMemo.Lines.Add('Max processes: ' + IntToStr(ResInt));
{$ENDIF}
{$ENDIF}
{$IFDEF LINUX}
fpuname(KernelName);
InfoMemo.Lines.Add('OS: ' + kernelname.sysname);
InfoMemo.Lines.Add('Hostname: ' + kernelname.nodename);
InfoMemo.Lines.Add('Release: ' + kernelname.release);
InfoMemo.Lines.Add('Kernel: ' + kernelname.version);
InfoMemo.Lines.Add('Architecture: ' + kernelname.machine);
InfoMemo.Lines.Add('');
InfoMemo.Lines.Add('CPU count: %d', [SysConf(83)]);
InfoMemo.Lines.Add('CPU online: %d', [SysConf(84)]);
SysInfo(@Info);
InfoMemo.Lines.Add('');
InfoMemo.Lines.Add('Total memory: %f GB', [Info.TotalRam /1024 /1024 /1024]);
InfoMemo.Lines.Add('Free memory: %f GB', [Info.FreeRam /1024 /1024 /1024]);
InfoMemo.Lines.Add('Shared memory: %f GB', [Info.SharedRam /1024 /1024 /1024]);
InfoMemo.Lines.Add('Buffer memory: %f GB', [Info.BufferRam /1024 /1024 /1024]);
InfoMemo.Lines.Add('Total swap: %f GB', [Info.TotalSwap /1024 /1024 /1024]);
InfoMemo.Lines.Add('Free swap: %f GB', [Info.FreeSwap /1024 /1024 /1024]);
{$ENDIF}
InfoMemo.Visible := True;
// Below needed or second time memo at bottom, not top
InfoMemo.VertScrollbar.Position := 1;
InfoMemo.VertScrollbar.Position := 0;
end;
procedure TForm2_About.LicLabel2Click(Sender: TObject);
begin
OpenURL('https://unlicense.org/');
end;
procedure TForm2_About.LicLabel2MouseEnter(Sender: TObject);
begin
Form2_About.LicLabel2.Cursor := crHandPoint;
Form2_About.LicLabel2.Font.Style := [fsUnderLine];
end;
procedure TForm2_About.LicLabel2MouseLeave(Sender: TObject);
begin
Form2_About.LicLabel2.Cursor := crDefault;
Form2_About.LicLabel2.Font.Style := [];
end;
procedure TForm2_About.FormActivate(Sender: TObject);
begin
{$IFDEF DARWIN}
// Make macOS-like About Box
Form2_About.BorderIcons := [biSystemMenu];
Form2_About.OK_Button.Visible := False;
Form2_About.Caption := '';
{$ENDIF}
{$IFDEF WINDOWS}
Form2_About.BorderIcons := [biSystemMenu];
Form2_About.OK_Button.Visible := True;
{$ENDIF}
end;
end.
Recent
