165 lines
4.6 KiB
ObjectPascal
165 lines
4.6 KiB
ObjectPascal
{
|
|
********************************************************************************
|
|
|
|
SPackGui
|
|
Copyright (C) 2000-2012 Geoffray Levasseur <geoffray.levasseurbrandin@numericable.fr>.
|
|
http://www.geoffray-levasseur.org/
|
|
|
|
This software is governed by the CeCILL license under French law and
|
|
abiding by the rules of distribution of free software. You can use,
|
|
modify and/ or redistribute the software under the terms of the CeCILL
|
|
license as circulated by CEA, CNRS and INRIA at the following URL
|
|
"http://www.cecill.info".
|
|
|
|
As a counterpart to the access to the source code and rights to copy,
|
|
modify and redistribute granted by the license, users are provided only
|
|
with a limited warranty and the software's author, the holder of the
|
|
economic rights, and the successive licensors have only limited
|
|
liability.
|
|
|
|
In this respect, the user's attention is drawn to the risks associated
|
|
with loading, using, modifying and/or developing or reproducing the
|
|
software by the user in light of its specific status of free software,
|
|
that may mean that it is complicated to manipulate, and that also
|
|
therefore means that it is reserved for developers and experienced
|
|
professionals having in-depth computer knowledge. Users are therefore
|
|
encouraged to load and test the software's suitability as regards their
|
|
requirements in conditions enabling the security of their systems and/or
|
|
data to be ensured and, more generally, to use and operate it in the
|
|
same conditions as regards security.
|
|
|
|
The fact that you are presently reading this means that you have had
|
|
knowledge of the CeCILL license and that you accept its terms.
|
|
|
|
********************************************************************************
|
|
|
|
Description:
|
|
Version info manipulation functions
|
|
|
|
********************************************************************************
|
|
}
|
|
|
|
unit uVersion;
|
|
|
|
{$MODE objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, InterfaceBase, LCLVersion, LCLPlatformDef;
|
|
|
|
type
|
|
TVersionState = (vsAlpha, vsBeta, vsReleaseCandidate, vsFinal);
|
|
TVerRec = record
|
|
Major: Byte;
|
|
Minor: Byte;
|
|
Release: Byte;
|
|
Build: Word;
|
|
Add: TVersionState;
|
|
end;
|
|
|
|
const
|
|
LCLPlatformDisplayNames: array[TLCLPlatform] of string = ('GTK 1', 'GTK 2',
|
|
{$IF (lcl_major >= 1) and (lcl_minor >= 1)}
|
|
'GTK 3',
|
|
{$ENDIF}
|
|
'Win32/Win64', 'WinCE', 'Carbon', 'QT 4',
|
|
{$IF (lcl_major >= 1) and (lcl_minor >= 4)}
|
|
'QT 5',
|
|
{$ENDIF}
|
|
'FpGui', 'NoGui', 'Cocoa',
|
|
{$IF (lcl_major >= 1) and (lcl_minor >= 8)}
|
|
'Android', 'MUI');
|
|
{$ELSE}
|
|
'Android');
|
|
{$ENDIF}
|
|
|
|
|
|
function GetBuildCPU: string;
|
|
function GetBuildOS: string;
|
|
function GetBuildDate: string;
|
|
function GetLCLWidgetType: TLCLPlatform;
|
|
function GetFPCVersion: String;
|
|
function GetLazarusVersion: string;
|
|
function GetLazarusRevision: string;
|
|
function GetVersionString(VerRec: TVerRec): String;
|
|
|
|
{$I version.inc}
|
|
|
|
var
|
|
Debug: Boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
uUtils;
|
|
|
|
function GetBuildOS: string;
|
|
begin
|
|
Result := LowerCase({$I %FPCTARGETOS%});
|
|
end;
|
|
|
|
function GetBuildCPU: string;
|
|
begin
|
|
Result := LowerCase({$I %FPCTARGETCPU%});
|
|
end;
|
|
|
|
function GetLCLWidgetType: TLCLPlatform;
|
|
begin
|
|
if WidgetSet <> nil then
|
|
Result := WidgetSet.LCLPlatform
|
|
else
|
|
Result:= lpGtk;
|
|
end;
|
|
|
|
function GetFPCVersion: String;
|
|
begin
|
|
Result := {$I %FPCVERSION%};
|
|
end;
|
|
|
|
function GetBuildDate: string;
|
|
var
|
|
BuildDate: string;
|
|
SlPos1, SlPos2: integer;
|
|
Date: TDateTime;
|
|
begin
|
|
BuildDate := {$I %date%};
|
|
SlPos1 := Pos('/', BuildDate);
|
|
SlPos2 := SlPos1 + Pos('/', Copy(BuildDate, SlPos1 + 1, Length(BuildDate)- SlPos1));
|
|
Date := EncodeDate(StrToWord(Copy(BuildDate, 1, SlPos1 - 1)),
|
|
StrToWord(Copy(BuildDate, SlPos1 + 1, SlPos2 - SlPos1 - 1)),
|
|
StrToWord(Copy(BuildDate, SlPos2 + 1, Length(BuildDate) - SlPos2)));
|
|
Result := FormatDateTime('yyyy/mm/dd', Date);
|
|
end;
|
|
|
|
function GetLazarusVersion: string;
|
|
begin
|
|
Result := Format('%d.%d.%d', [lcl_major, lcl_minor, lcl_release]);
|
|
end;
|
|
|
|
function GetLazarusRevision: string;
|
|
//use the lazarus source code - change path as you need
|
|
//if you don't have lazarus source code delete the line {$I <path>} and replace
|
|
//RevisionStr const by 'unknow'
|
|
{$I ../../../fp-laz/lazarus/ide/revision.inc}
|
|
begin
|
|
if Trim(RevisionStr) <> '' then
|
|
Result := 'svn ' + RevisionStr
|
|
else
|
|
Result := 'inconnue';
|
|
end;
|
|
|
|
function GetVersionString(VerRec: TVerRec): String;
|
|
begin
|
|
Result := InttoStr(VerRec.Major) + '.' + InttoStr(VerRec.Minor) + '.' +
|
|
InttoStr(VerRec.Release) + '-' + InttoStr(VerRec.Build);
|
|
case VerRec.Add of
|
|
vsAlpha: Result := Result + ' alpha';
|
|
vsBeta: Result := Result + ' beta';
|
|
vsReleaseCandidate: Result := Result + 'RC';
|
|
end;
|
|
Result := Result + ' ' + LCLPlatformDisplayNames[GetLCLWidgetType];
|
|
end;
|
|
|
|
end.
|