Easy to use Application Info class including AppDir and VendorDir

[munair]

Coming from RealBasic (now called Xojo) I missed an easy to use class in Lazarus to set and read essential application info, such as version and directory info. Therefore I wrote this class called TAppSpec.

- Example is included below.
- Tested on Debian 7.8 only.
- Suggestions are welcome!

Code: [Select]

unit uAppSpec;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils;

type
  TAppSpec = class
    AppName: string;
    BuildNumber: integer;
    MajorVersion: integer;
    MinorVersion: integer;
    ReleaseNumber: integer;
    VendorName: string;
    function VersionInfo(): string;
    function AppDir(const global: boolean = false): string;
    function VendorDir(const global: boolean = false): string;
  end;

procedure UseAppSpec();

var
  AppSpec: TAppSpec;

implementation

function _GetAppName(): string;
begin
  result := AppSpec.AppName;
end;

function _GetVendorName(): string;
begin
  result := AppSpec.VendorName;
end;

procedure UseAppSpec();
begin
  AppSpec := TAppSpec.Create;

  OnGetApplicationName := @uAppSpec._GetAppName;
  OnGetVendorName := @uAppSpec._GetVendorName;
end;

function TAppSpec.VersionInfo(): string;
begin
  result := IntToStr(MajorVersion)
    + '.'
    + IntToStr(MinorVersion)
    + '.'
    + IntToStr(ReleaseNumber)
    + ' build '
    + IntToStr(BuildNumber);
end;

function TAppSpec.AppDir(const global: boolean = false): string;
// AppDir and VendorDir return the same value if:
//   - AppName and VendorName are not specified
//   - either AppName or VendorName is not specified
var
  dir: string;
begin
  dir := GetAppConfigDir(global);
  result := lowercase(dir);
end;

function TAppSpec.VendorDir(const global: boolean = false): string;
// AppDir and VendorDir return the same value if:
//   - AppName and VendorName are not specified
//   - either AppName or VendorName is not specified
var
  dir: string;
  l: integer;
begin
  dir := GetAppConfigDir(global);
  if Length(VendorName) > 0 then
    begin
      l := Length(AppName);
      if l > 0 then
        begin
          dir := Copy(dir, 1, Length(dir) - l - 1);
        end;
    end;
  result := lowercase(dir);
end;

end.

EXAMPLE

Code: [Select]

unit uTestAppSpec;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  uAppSpec;

type

  { TForm1 }

  TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  UseAppSpec;

  with AppSpec do
  begin
    AppName := 'TestAppSpec';
    VendorName := 'NameIt';
    MajorVersion := 5;
    MinorVersion := 3;
    ReleaseNumber := 8;
    BuildNumber := 19;
  end;

  if not DirectoryExists(AppSpec.VendorDir) then
    if CreateDir(AppSpec.VendorDir) then
      Label1.caption := AppSpec.VendorDir();

  if not DirectoryExists(AppSpec.AppDir) then
    if CreateDir(AppSpec.AppDir) then
      Label2.Caption := AppSpec.AppDir();

  Label3.caption := 'Version ' + AppSpec.VersionInfo();
end;

end.