Accessing build info and compiler info in Source...

Forum > General

(1/5) > >>

Mike.Cornflake:
G'day,

Spent the last couple of days working out how to access build information (ie FileVersion and ProductName) in code. I also wanted to access Lazarus Build Number, FPC version and a bunch of other info. Lots of information available on this forum, and also in the source code for both lazarus and FPC, and in the supplied example lazresexplorer. I've gathered all this information and placed it into a single unit attached below...

I started by taking vinfo.pas by Paul Ishenin which is available elsewhere on this forum and adding some defensive code so it didn't fall over when no build information had been compiled into the exe...

The stuff of the resource strings *should* work. Certainly works under Linux/Lazarus 0.9.30. Doesn't work for me under Windows XP/Lazarus 0.9.29 (oStringList is not populated), but I suspect my copy of Lazarus under Windows is misbehaving rather than the code here. The example that ships with Lazarus (lasrexexplorer) also fails for me under Windows XP/Lazarus 0.9.29.

Many thanks to everyone who posted their snippets, and I hope this is useful :-)

March 2016: UPDATE: Code below updated. Sometime since 2011 I added GetCPU, and forgot to update here.

Also, if someone could work out how to embed version.inc from the lazarus\IDE folder, that would be great. Means we could include SVN version information for the build of lazarus. I can only think of hack ways to get that info...

Aug 2017 UPDATE: Modified code to work with Laz 1.9 can be found at http://forum.lazarus.freepascal.org/index.php/topic,13957.msg233094.html#msg233094.

* I consider the updated code draft as the changes were made quickly without studying what had changed...
* I've still to implement minesadorada's suggestion, and I won't update the code here until I've found a version that compiles against older Lazarus AND trunk Lazarus.

--- Code: ---Unit VersionSupport;

{$mode objfpc}

Interface

(*
Building on the excellent vinfo.pas supplied by Paul Ishenin and available elsewhere on the Lazarus
Forums
- I hid the TVersionInfo class from the end user to simplify their (mine) number of required Uses...
- Added defensive code to TVersionInfo if no build info is compiled into the exe
- Deduced GetResourceStrings - works under Linux 64/GTK2 with Lazarus 0.9.30, but fails under
Win XP 32bit/Lazarus 0.9.29 - suspecting my install as the lazresexplorer example also fails
for me under Lazarus 0.9.29, but works with Lazarus 0.9.30

Trawled through IDE source code, FPC source code and Lazarus supplied example program lasresexplorer
to find the other defines and lookups...

End user only needs to use VersionSupport - no other units necessary for their project.

Jedi CodeFormatter seems to fail on the {$I %VARIABLE%} references, so sticking them all in here
means end user code can be neatly formatted using Jedi CodeFormatter

Other interesting includes I picked up in my travels are...
// {$I %HOME%} = User Home Directory
// {$I %FILE%} = Current pas file
// {$I %LINE%} = current line number

UPDATE: GetCPU added

Mike Thompson - mike.cornflake@gmail.com
March 24 2016

*)

Uses
Classes, SysUtils;

// Surfacing general defines and lookups
Function GetCompiledDate: String;
Function GetCompilerInfo: String;
Function GetTargetInfo: String;
Function GetOS: String;
Function GetCPU: String;
Function GetLCLVersion: String;
Function GetWidgetSet: String;

// Exposing resource and version info compiled into exe
Function GetResourceStrings(oStringList : TStringList) : Boolean;
Function GetFileVersion: String;
Function GetProductVersion: String;

Const
WIDGETSET_GTK = 'GTK widget set';
WIDGETSET_GTK2 = 'GTK 2 widget set';
WIDGETSET_WIN = 'Win32/Win64 widget set';
WIDGETSET_WINCE = 'WinCE widget set';
WIDGETSET_CARBON = 'Carbon widget set';
WIDGETSET_QT = 'QT widget set';
WIDGETSET_fpGUI = 'fpGUI widget set';
WIDGETSET_OTHER = 'Other gui';

Implementation

Uses
resource, versiontypes, versionresource, LCLVersion, InterfaceBase;

Function GetWidgetSet: String;
Begin
Case WidgetSet.LCLPlatform Of
lpGtk: Result := WIDGETSET_GTK;
lpGtk2: Result := WIDGETSET_GTK2;
lpWin32: Result := WIDGETSET_WIN;
lpWinCE: Result := WIDGETSET_WINCE;
lpCarbon:Result := WIDGETSET_CARBON;
lpQT: Result := WIDGETSET_QT;
lpfpGUI: Result := WIDGETSET_fpGUI;
Else
Result:=WIDGETSET_OTHER;
End;
End;

Function GetCompilerInfo: String;
begin
Result := 'FPC '+{$I %FPCVERSION%};
end;

Function GetTargetInfo: String;
Begin
Result := {$I %FPCTARGETCPU%}+' - '+{$I %FPCTARGETOS%};
End;

Function GetOS: String;
Begin
Result := {$I %FPCTARGETOS%};
End;

function GetCPU: String;
begin
Result := {$I %FPCTARGETCPU%};
end;

Function GetLCLVersion: String;
Begin
Result := 'LCL '+lcl_version;
End;

Function GetCompiledDate: String;
Var
sDate, sTime: String;
Begin
sDate := {$I %DATE%};
sTime := {$I %TIME%};

Result := sDate + ' at ' + sTime;
End;

{ Routines to expose TVersionInfo data }

Type
TVersionInfo = Class
private
FBuildInfoAvailable: Boolean;
FVersResource: TVersionResource;
Function GetFixedInfo: TVersionFixedInfo;
Function GetStringFileInfo: TVersionStringFileInfo;
Function GetVarFileInfo: TVersionVarFileInfo;
public
Constructor Create;
Destructor Destroy; override;

Procedure Load(Instance: THandle);

Property BuildInfoAvailable: Boolean Read FBuildInfoAvailable;

Property FixedInfo: TVersionFixedInfo Read GetFixedInfo;
Property StringFileInfo: TVersionStringFileInfo Read GetStringFileInfo;
Property VarFileInfo: TVersionVarFileInfo Read GetVarFileInfo;
End;

Var
FInfo: TVersionInfo;

Procedure CreateInfo;
Begin
If Not Assigned(FInfo) Then
Begin
FInfo := TVersionInfo.Create;
FInfo.Load(HINSTANCE);
End;
End;

Function GetResourceStrings(oStringList: TStringList): Boolean;
Var
i, j : Integer;
oTable : TVersionStringTable;
begin
CreateInfo;

oStringList.Clear;
Result := False;

If FInfo.BuildInfoAvailable Then
Begin
Result := True;
For i := 0 To FInfo.StringFileInfo.Count-1 Do
Begin
oTable := FInfo.StringFileInfo.Items[i];

For j := 0 To oTable.Count-1 Do
If Trim(oTable.ValuesByIndex[j])<>'' Then
oStringList.Values[oTable.Keys[j]] := oTable.ValuesByIndex[j];
end;
end;
end;

Function ProductVersionToString(PV: TFileProductVersion): String;
Begin
Result := Format('%d.%d.%d.%d', [PV[0], PV[1], PV[2], PV[3]]);
End;

Function GetProductVersion: String;
Begin
CreateInfo;

If FInfo.BuildInfoAvailable Then
Result := ProductVersionToString(FInfo.FixedInfo.ProductVersion)
Else
Result := 'No build information available';
End;

Function GetFileVersion: String;
Begin
CreateInfo;

If FInfo.BuildInfoAvailable Then
Result := ProductVersionToString(FInfo.FixedInfo.FileVersion)
Else
Result := 'No build information available';
End;

{ TVersionInfo }

Function TVersionInfo.GetFixedInfo: TVersionFixedInfo;
Begin
Result := FVersResource.FixedInfo;
End;

Function TVersionInfo.GetStringFileInfo: TVersionStringFileInfo;
Begin
Result := FVersResource.StringFileInfo;
End;

Function TVersionInfo.GetVarFileInfo: TVersionVarFileInfo;
Begin
Result := FVersResource.VarFileInfo;
End;

Constructor TVersionInfo.Create;
Begin
Inherited Create;

FVersResource := TVersionResource.Create;
FBuildInfoAvailable := False;
End;

Destructor TVersionInfo.Destroy;
Begin
FVersResource.Free;

Inherited Destroy;
End;

Procedure TVersionInfo.Load(Instance: THandle);
Var
Stream: TResourceStream;
ResID: Integer;
Res: TFPResourceHandle;
Begin
FBuildInfoAvailable := False;
ResID := 1;

// Defensive code to prevent failure if no resource available...
Res := FindResource(Instance, PChar(PtrInt(ResID)), PChar(RT_VERSION));
If Res = 0 Then
Exit;

Stream := TResourceStream.CreateFromID(Instance, ResID, PChar(RT_VERSION));
Try
FVersResource.SetCustomRawDataStream(Stream);

// access some property to load from the stream
FVersResource.FixedInfo;

// clear the stream
FVersResource.SetCustomRawDataStream(nil);

FBuildInfoAvailable := True;
Finally
Stream.Free;
End;
End;

Initialization
FInfo := nil;

Finalization
If Assigned(FInfo) Then
FInfo.Free;
End.

--- End code ---

Example code for this...

--- Code: ---Uses
VersionSuuport;

...

memAbout.Lines.Clear;
oResourceStrings := TStringList.Create;
Try
GetResourceStrings(oResourceStrings);

memAbout.Lines.Assign(oResourceStrings);

If oResourceStrings.Count>0 Then
memAbout.Lines.Add('');
Finally
oResourceStrings.Free;
End;

memAbout.Lines.Add('File version = ' + GetFileVersion);
memAbout.Lines.Add('Product version = ' + GetProductVersion);
memAbout.Lines.Add('');
memAbout.Lines.Add('Built for '+GetTargetInfo);
memAbout.Lines.Add(' with '+GetCompilerInfo + ' on '+GetCompiledDate);
memAbout.Lines.Add(' and using '+GetLCLVersion + ' and ' + GetWidgetset);

--- End code ---

Cheers

Mike Thompson

BlueIcaro:
Nice!!!

Thank you

/BlueIcaro

jwdietrich:
Great, it works with the Carbon widgetset, too.

elidorio:
Hello,
I'm doing some testing with this unit and I can't get the date format (GetCompiledDate) to display in the format ' dd/mm/yyyy hh: mm '

fatmonk:
I'm trying to use GetProductVersion with Lazarus 1.2.4 and FPC 2.6.4 on Windows 7.

I believe I have the unit included correctly (no compile or linking errors, and no runtime errors that I can see.

However GetProductVersion always returns 0.0.0.0 regardless of the version info set in Project->ProjectOptions->Version.

Any ideas where I should look for what's going wrong?

-FM

Navigation

[0] Message Index

[#] Next page