* * *

Author Topic: Accessing build info and compiler info in Source...  (Read 18095 times)

Mike.Cornflake

  • Hero Member
  • *****
  • Posts: 1223
Re: Accessing build info and compiler info in Source...
« Reply #15 on: March 23, 2016, 05:29:06 pm »
Updated code in original post with GetCPU...
Lazarus Trunk/FPC Trunk on Windows [7, 10]
  Have you tried searching this forum or the wiki?:   http://wiki.lazarus.freepascal.org/Alternative_Main_Page
  BOOKS! (Free and otherwise): http://wiki.lazarus.freepascal.org/Pascal_and_Lazarus_Books_and_Magazines

Mike.Cornflake

  • Hero Member
  • *****
  • Posts: 1223
Re: Accessing build info and compiler info in Source...
« Reply #16 on: January 03, 2017, 03:21:55 am »
Sorry for re-opening an old topic.  I've been out of code for about 9 months, and sometime along the way changes to trunk code have meant some changes required for VersionSupport.  I'll be honest, I'm not completely uptodate with what changes have been made, so I'm not updating the code on the first page.  Instead, please consider this a beta draft :-)

Code: Pascal  [Select]
  1. Unit VersionSupport;
  2.  
  3. {$mode objfpc}
  4.  
  5. Interface
  6.  
  7. (*
  8.   Building on the excellent vinfo.pas supplied by Paul Ishenin and available elsewhere on the Lazarus
  9.   Forums
  10.     - I hid the TVersionInfo class from the end user to simplify their (mine) number of required Uses...
  11.     - Added defensive code to TVersionInfo if no build info is compiled into the exe
  12.     - Deduced GetResourceStrings - works under Linux 64/GTK2 with Lazarus 0.9.30, but fails under
  13.       Win XP 32bit/Lazarus 0.9.29 - suspecting my install as the lazresexplorer example also fails
  14.       for me under Lazarus 0.9.29, but works with Lazarus 0.9.30
  15.  
  16.   Trawled through IDE source code, FPC source code and Lazarus supplied example program lasresexplorer
  17.   to find the other defines and lookups...
  18.  
  19.   End user only needs to use VersionSupport - no other units necessary for their project.
  20.  
  21.   Jedi CodeFormatter seems to fail on the {$I %VARIABLE%} references, so sticking them all in here
  22.   means end user code can be neatly formatted using Jedi CodeFormatter
  23.  
  24.   Other interesting includes I picked up in my travels are...
  25.   //  {$I %HOME%} = User Home Directory
  26.   //  {$I %FILE%} = Current pas file
  27.   //  {$I %LINE%} = current line number
  28.  
  29.   Mike Thompson - mike.cornflake@gmail.com
  30.   Origin: July 24 2011
  31.  
  32.   Changes:
  33.   January 2017:   Updated code to cope with refactored LCL Platform Definitions
  34. *)
  35.  
  36. Uses
  37.   Classes, SysUtils;
  38.  
  39. // Surfacing general defines and lookups
  40. Function GetCompiledDate: String;
  41. Function GetCompilerInfo: String;
  42. Function GetTargetInfo: String;
  43. Function GetOS: String;
  44. Function GetCPU: String;
  45. Function GetLCLVersion: String;
  46. Function GetWidgetSet: String;
  47.  
  48. // Exposing resource and version info compiled into exe
  49. Function GetResourceStrings(oStringList : TStringList) : Boolean;
  50. Function GetFileVersion: String;
  51. Function GetProductVersion: String;
  52.  
  53. Implementation
  54.  
  55. Uses
  56.   resource, versiontypes, versionresource, LCLVersion, InterfaceBase, LCLPlatformDef;
  57.  
  58. Function GetWidgetSet: String;
  59. Begin
  60.   Result := LCLPlatformDisplayNames[WidgetSet.LCLPlatform];
  61. End;
  62.  
  63. Function GetCompilerInfo: String;
  64. begin
  65.   Result := 'FPC '+{$I %FPCVERSION%};
  66. end;
  67.  
  68. Function GetTargetInfo: String;
  69. Begin
  70.   Result := {$I %FPCTARGETCPU%}+' - '+{$I %FPCTARGETOS%};
  71. End;
  72.  
  73. Function GetOS: String;
  74. Begin
  75.   Result := {$I %FPCTARGETOS%};
  76. End;
  77.  
  78. function GetCPU: String;
  79. begin
  80.   Result := {$I %FPCTARGETCPU%};
  81. end;
  82.  
  83. Function GetLCLVersion: String;
  84. Begin
  85.   Result := 'LCL '+lcl_version;
  86. End;
  87.  
  88. Function GetCompiledDate: String;
  89. Var
  90.   sDate, sTime: String;
  91. Begin
  92.   sDate := {$I %DATE%};
  93.   sTime := {$I %TIME%};
  94.  
  95.   Result := sDate + ' at ' + sTime;
  96. End;
  97.  
  98. { Routines to expose TVersionInfo data }
  99.  
  100. Type
  101.   TVersionInfo = Class
  102.   private
  103.     FBuildInfoAvailable: Boolean;
  104.     FVersResource: TVersionResource;
  105.     Function GetFixedInfo: TVersionFixedInfo;
  106.     Function GetStringFileInfo: TVersionStringFileInfo;
  107.     Function GetVarFileInfo: TVersionVarFileInfo;
  108.   public
  109.     Constructor Create;
  110.     Destructor Destroy; override;
  111.  
  112.     Procedure Load(Instance: THandle);
  113.  
  114.     Property BuildInfoAvailable: Boolean Read FBuildInfoAvailable;
  115.  
  116.     Property FixedInfo: TVersionFixedInfo Read GetFixedInfo;
  117.     Property StringFileInfo: TVersionStringFileInfo Read GetStringFileInfo;
  118.     Property VarFileInfo: TVersionVarFileInfo Read GetVarFileInfo;
  119.   End;
  120.  
  121. Var
  122.   FInfo: TVersionInfo;
  123.  
  124. Procedure CreateInfo;
  125. Begin
  126.   If Not Assigned(FInfo) Then
  127.   Begin
  128.     FInfo := TVersionInfo.Create;
  129.     FInfo.Load(HINSTANCE);
  130.   End;
  131. End;
  132.  
  133. Function GetResourceStrings(oStringList: TStringList): Boolean;
  134. Var
  135.   i, j : Integer;
  136.   oTable : TVersionStringTable;
  137. begin
  138.   CreateInfo;
  139.  
  140.   oStringList.Clear;
  141.   Result := False;
  142.  
  143.   If FInfo.BuildInfoAvailable Then
  144.   Begin
  145.     Result := True;
  146.     For i := 0 To FInfo.StringFileInfo.Count-1 Do
  147.     Begin
  148.       oTable := FInfo.StringFileInfo.Items[i];
  149.  
  150.       For j := 0 To oTable.Count-1 Do
  151.         If Trim(oTable.ValuesByIndex[j])<>'' Then
  152.           oStringList.Values[oTable.Keys[j]] := oTable.ValuesByIndex[j];
  153.     end;
  154.   end;
  155. end;
  156.  
  157. Function ProductVersionToString(PV: TFileProductVersion): String;
  158. Begin
  159.   Result := Format('%d.%d.%d.%d', [PV[0], PV[1], PV[2], PV[3]]);
  160. End;
  161.  
  162. Function GetProductVersion: String;
  163. Begin
  164.   CreateInfo;
  165.  
  166.   If FInfo.BuildInfoAvailable Then
  167.     Result := ProductVersionToString(FInfo.FixedInfo.ProductVersion)
  168.   Else
  169.     Result := 'No build information available';
  170. End;
  171.  
  172. Function GetFileVersion: String;
  173. Begin
  174.   CreateInfo;
  175.  
  176.   If FInfo.BuildInfoAvailable Then
  177.     Result := ProductVersionToString(FInfo.FixedInfo.FileVersion)
  178.   Else
  179.     Result := 'No build information available';
  180. End;
  181.  
  182. { TVersionInfo }
  183.  
  184. Function TVersionInfo.GetFixedInfo: TVersionFixedInfo;
  185. Begin
  186.   Result := FVersResource.FixedInfo;
  187. End;
  188.  
  189. Function TVersionInfo.GetStringFileInfo: TVersionStringFileInfo;
  190. Begin
  191.   Result := FVersResource.StringFileInfo;
  192. End;
  193.  
  194. Function TVersionInfo.GetVarFileInfo: TVersionVarFileInfo;
  195. Begin
  196.   Result := FVersResource.VarFileInfo;
  197. End;
  198.  
  199. Constructor TVersionInfo.Create;
  200. Begin
  201.   Inherited Create;
  202.  
  203.   FVersResource := TVersionResource.Create;
  204.   FBuildInfoAvailable := False;
  205. End;
  206.  
  207. Destructor TVersionInfo.Destroy;
  208. Begin
  209.   FVersResource.Free;
  210.  
  211.   Inherited Destroy;
  212. End;
  213.  
  214. Procedure TVersionInfo.Load(Instance: THandle);
  215. Var
  216.   Stream: TResourceStream;
  217.   ResID: Integer;
  218.   Res: TFPResourceHandle;
  219. Begin
  220.   FBuildInfoAvailable := False;
  221.   ResID := 1;
  222.  
  223.   // Defensive code to prevent failure if no resource available...
  224.   Res := FindResource(Instance, PChar(PtrInt(ResID)), PChar(RT_VERSION));
  225.   If Res = 0 Then
  226.     Exit;
  227.  
  228.   Stream := TResourceStream.CreateFromID(Instance, ResID, PChar(RT_VERSION));
  229.   Try
  230.     FVersResource.SetCustomRawDataStream(Stream);
  231.  
  232.     // access some property to load from the stream
  233.     FVersResource.FixedInfo;
  234.  
  235.     // clear the stream
  236.     FVersResource.SetCustomRawDataStream(nil);
  237.  
  238.     FBuildInfoAvailable := True;
  239.   Finally
  240.     Stream.Free;
  241.   End;
  242. End;
  243.  
  244. Initialization
  245.   FInfo := nil;
  246.  
  247. Finalization
  248.   If Assigned(FInfo) Then
  249.     FInfo.Free;
  250. End.
  251.  
Lazarus Trunk/FPC Trunk on Windows [7, 10]
  Have you tried searching this forum or the wiki?:   http://wiki.lazarus.freepascal.org/Alternative_Main_Page
  BOOKS! (Free and otherwise): http://wiki.lazarus.freepascal.org/Pascal_and_Lazarus_Books_and_Magazines

minesadorada

  • Hero Member
  • *****
  • Posts: 575
  • Retired
Re: Accessing build info and compiler info in Source...
« Reply #17 on: January 03, 2017, 07:39:32 am »
@Mike Have you had a look at unit fileinfo which is part of FCL?
It contains the object TFileVersionInfo which could integrate well in your VersionSupport unit (maybe you could subclass it)
« Last Edit: January 03, 2017, 07:41:30 am by minesadorada »
GPL Apps: Health MonitorRetro Ski Run
OnlinePackageManager Components: LazAutoUpdate, LongTimer, PoweredBy, ScrollText, PlaySound, CryptINI

Mike.Cornflake

  • Hero Member
  • *****
  • Posts: 1223
Re: Accessing build info and compiler info in Source...
« Reply #18 on: January 04, 2017, 02:01:12 am »
@Mike Have you had a look at unit fileinfo which is part of FCL?
It contains the object TFileVersionInfo which could integrate well in your VersionSupport unit (maybe you could subclass it)

Heh, I was unaware.  Many thanks.  I'll look into it, should help with future proofing the unit...
Lazarus Trunk/FPC Trunk on Windows [7, 10]
  Have you tried searching this forum or the wiki?:   http://wiki.lazarus.freepascal.org/Alternative_Main_Page
  BOOKS! (Free and otherwise): http://wiki.lazarus.freepascal.org/Pascal_and_Lazarus_Books_and_Magazines

Zirneklitis

  • New member
  • *
  • Posts: 9
Re: Accessing build info and compiler info in Source...
« Reply #19 on: January 09, 2018, 09:35:51 am »
Hi,
May I include this piece of code in my application which distributed under GPL?

Mike.Cornflake

  • Hero Member
  • *****
  • Posts: 1223
Re: Accessing build info and compiler info in Source...
« Reply #20 on: January 09, 2018, 09:50:50 am »
Hi,
May I include this piece of code in my application which distributed under GPL?

I never know the answer to these questions.  I released this into the public domain, so from my point of view this is 100% free to use with no limitation. 

However, there's some code in there I didn't write, but again - as far as I see things, that code had also been fully released into the public domain via the forums.

Where it gets confusing (to me) is that there's not really much code in my unit.  Mostly it is wrappers to various stuff I found by looking at the source code for FPC and Lazarus.  Both those items are released under modified-GPL (errr, or is that modified-LGPL?)

Ah, and just writing that helped clarify things for me.  So, this unit is neither adding or subtracting any licensing over that which FPC and Lazarus use.

Errr, does that help?  :-)
Lazarus Trunk/FPC Trunk on Windows [7, 10]
  Have you tried searching this forum or the wiki?:   http://wiki.lazarus.freepascal.org/Alternative_Main_Page
  BOOKS! (Free and otherwise): http://wiki.lazarus.freepascal.org/Pascal_and_Lazarus_Books_and_Magazines

Zirneklitis

  • New member
  • *
  • Posts: 9
Re: Accessing build info and compiler info in Source...
« Reply #21 on: January 09, 2018, 10:50:21 am »
Thank You for clarification  :)

 

Recent

Get Lazarus at SourceForge.net. Fast, secure and Free Open Source software downloads Open Hub project report for Lazarus