matrixFont/source/misc/appabout.pas

unit appAbout;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, StdCtrls, LCLType, LCLIntf, LazFileUtils, Registry,
  AppLocalizer, OnlineUpdater, ouVersion,
  u_helpers, u_utilities;


resourcestring
  ABOUT_VERSION = 'версия %s';
  ABOUT_BIT     = '%s-битная';
  ABOUT_BUILD   = 'сборка #%d, %s';


const
  ABOUT_RIGHTS  = 'Modified FreeBSD License';
  ABOUT_OPENSRC = 'Free Open Source Software';

  FILE_LICENSE  = 'license.md';
  FILE_README   = 'readme.md';
  FILE_HELP     = 'help' + DirectorySeparator + 'matrixFont-help.md';

  // homepage url, e.g. https://example.site/home
  APP_URL_HOME  = 'https://riva-lab.gitlab.io/apps/matrixFont/';

  // project repository url
  APP_URL_REPO  = 'https://gitlab.com/riva-lab/matrixFont';

  // project issue url
  APP_URL_ISSUE = 'https://gitlab.com/riva-lab/matrixFont/-/issues';

  // project online help url
  APP_URL_HELP  = 'https://riva-lab.gitlab.io/apps/matrixFont/help.html';


procedure linkClick(Sender: TObject);
function UpdateAboutAppShort: String;
function UpdateAboutAppInfo: String;

function GetAppName: String;
function GetAppVersion: String;
function GetAppNameVersion: String;
function GetAppCompanyName: String;
function GetAppNameAuthor: String;


var
  AppVersionStr: String = '';
  AppProductStr: String = '';
  AppSystemStr:  String = '';


implementation

var
  fvi: TFileVersionInfoSimple;


procedure linkClick(Sender: TObject);

  function TryOpenFile(AFilename: String): Boolean;
    begin
      Result := False;
      if OpenDocument(AFilename) then Exit(True);
      if OpenDocument('..' + DirectorySeparator + AFilename) then Exit(True);
    end;

  function GetFromResources(ARes: String; AFilename: String): Boolean;
    begin
        try
        with TResourceStream.Create(HINSTANCE, ARes, RT_RCDATA) do
          try
          SaveToFile(AFilename);
          finally
          Free;
          OpenDocument(AFilename); // open file
          Sleep(2000);             // wait for 2s while file is opening
          DeleteFile(AFilename);   // delete file
          end;
        Result := True;
        except
        Result := False;
        end;
    end;
  var
    url, id: String;
  begin
    if TComponent(Sender).ClassName <> 'TLabel' then Exit;
    url := TLabel(Sender).Hint;
    id  := ExtractFileNameWithoutExt(url);

    if url.StartsWith('https://') then
      OpenURL(url)
    else
    if not TryOpenFile(id + '.' + appLocalizerEx.CurrentLangCode + '.html') then
      if not TryOpenFile(id + '.' + appLocalizerEx.CurrentLangCode + '.md') then
        if not TryOpenFile(id + '.html') then
          if not TryOpenFile(id + '.md') then
            GetFromResources(id, url);
  end;

function UpdateAboutAppShort: String;
  var
    _bldTime: TDateTime;
    _info:    TStringList;
    _arc:     String;
  begin
    _info  := TStringList.Create;
    _arc   := '';
    Result := '';

    {$IfDef WINDOWS}
      {$IfDef WIN64}
      _arc := Format(ABOUT_BIT, ['64']);
      {$EndIf}
      {$IfDef WIN32}
      _arc := Format(ABOUT_BIT, ['32']);
      {$EndIf}

      with TRegistry.Create(KEY_READ) do
        begin
          try
          RootKey      := HKEY_LOCAL_MACHINE;
          OpenKeyReadOnly('SYSTEM\CurrentControlSet\Control\Session Manager\Environment');
          AppSystemStr := ReadString('PROCESSOR_ARCHITECTURE').Contains('64').Select('x64', 'x32');
          CloseKey;
          OpenKeyReadOnly('SOFTWARE\Microsoft\Windows NT\CurrentVersion');
          AppSystemStr := Format('%s %s Version %s Build %s.%d', [
            ReadString('ProductName'),
            AppSystemStr,
            ReadString('DisplayVersion').IsEmpty.Select(
              ReadString('ReleaseId'),
              ReadString('DisplayVersion') + ' (' + ReadString('ReleaseId') + ')'),
            ReadString('CurrentBuild'),
            ReadInteger('UBR')]);
          except
          end;
        Free;
        end;
    {$EndIf}

    with fvi do
      begin
      _info.Add(InternalName);

      with ParseVersion(FileVersion) do
        begin
        TryStrToDate({$INCLUDE %DATE%}, _bldTime, 'YYYY/MM/DD', '/');
        AppVersionStr := Format('%d.%d.%d', [Major, Minor, Revision]);
        _info.Add(Format(ABOUT_VERSION, [AppVersionStr]) + (_arc <> '').Select(', ' + _arc, ''));
        _info.Add(Format(ABOUT_BUILD, [Build, FormatDateTime('yyyy.mm.dd', _bldTime)]));
        end;

      Result := _info.Text;
      end;

    _info.Free;
  end;

function UpdateAboutAppInfo: String;
  var
    _info: TStringList;
  begin
    _info  := TStringList.Create;
    Result := '';

    with fvi do
      begin
      _info.Add('');
      _info.Add(Comments);
      _info.Add('');
      _info.Add('© ' + LegalCopyright);
      _info.Add(CompanyName);
      _info.Add('');
      _info.Add(ABOUT_RIGHTS);
      _info.Add(ABOUT_OPENSRC);
      _info.Add('');

      {$IfDef DEBUG}
      _info.Add('DEBUG VERSION');
      {$EndIf}

      Result := UpdateAboutAppShort + _info.Text;

      AppProductStr := ProductName;
      end;

    _info.Free;
  end;


function GetAppName: String;
  begin
    Result := fvi.ProductName;
  end;

function GetAppVersion: String;
  begin
    Result := fvi.FileVersion;
  end;

function GetAppNameVersion: String;
  begin
    Result := Format('%s v%s', [fvi.ProductName, fvi.FileVersion]);
  end;

function GetAppCompanyName: String;
  begin
    Result := fvi.CompanyName;
  end;

function GetAppNameAuthor: String;
  begin
    Result := Format('%s, © %s', [fvi.InternalName, GetAuthorName(fvi.LegalCopyright)]);
  end;


initialization
  fvi := TFileVersionInfoSimple.Create;
  fvi.ReadVersionInfo;

end.