Wie Programmversion abfragen?

Für alles, was in den übrigen Lazarusthemen keinen Platz, aber mit Lazarus zutun hat.
Antworten
ufkpra2
Beiträge: 32
Registriert: Fr 14. Mai 2010, 14:47
CPU-Target: i386
Wohnort: Ulm

Wie Programmversion abfragen?

Beitrag von ufkpra2 »

Hallo.

In den Projekteinstellungen kann man ja die Versionsnummer der Anwendung definieren. Kann man eben diese Nummer auf einfache Weise im Code abrufen?

Gruß und Danke mal wieder.

edewolf78
Beiträge: 12
Registriert: Mo 23. Nov 2009, 18:42
OS, Lazarus, FPC: Win (L 0.9.29 FPC 2.4.0)
CPU-Target: x32/x64
Wohnort: Ludwigsburg

Re: Wie Programmversion abfragen?

Beitrag von edewolf78 »

Hi,
ich mache das so:

Gruss Edwin

*edit Win32/Win64

Code: Alles auswählen

function GetVersionInfo : String;
var
  sAppName                   : string;
  iAppSize,iLenOfValue       : Dword;
  pcBuf                      : PChar;
  PFinfo                     : PVSFIXEDFILEINFO;
  iMajor, iMinor, iBuild, iRevis : Word;
begin
  iMajor := 0;
  iMinor := 0;
  iBuild := 0;
  iRevis := 0;
 
  sAppName := Application.ExeName;
  iAppSize:= GetFileVersionInfoSize(PChar(sAppName),iAppSize);
  if iAppSize > 0 then begin
    pcBuf := AllocMem(iAppSize);
    GetFileVersionInfo(PChar(sAppName),0,iAppSize,pcBuf);
    VerQueryValue(pcBuf,'\\',PFInfo,iLenOfValue);
    if iLenOfValue > 0 then begin
       iMajor := HIWord(PFinfo^.dwFileVersionMS);
       iMinor := LOWord(PFinfo^.dwFileVersionMS);
       iBuild := HiWord(PFinfo^.dwFileVersionLS);
       iRevis := LOWord(PFinfo^.dwFileVersionLS);
    end;
    FreeMem(pcBuf,iAppSize);
  end;
  GetVersionInfo := IntToStr(iMajor)+'.'+IntToStr(iMinor)+'.'+
                    IntToStr(iBuild)+'('+IntToStr(iRevis)+')';
end;

ufkpra2
Beiträge: 32
Registriert: Fr 14. Mai 2010, 14:47
CPU-Target: i386
Wohnort: Ulm

Re: Wie Programmversion abfragen?

Beitrag von ufkpra2 »

Danke für Deine Antwort.

Wo kommt denn der Typ PVSFIXEDFILEINFO her?

edewolf78
Beiträge: 12
Registriert: Mo 23. Nov 2009, 18:42
OS, Lazarus, FPC: Win (L 0.9.29 FPC 2.4.0)
CPU-Target: x32/x64
Wohnort: Ludwigsburg

Re: Wie Programmversion abfragen?

Beitrag von edewolf78 »

Hallo,

Code: Alles auswählen

uses
   Windows.
wie oben schon angemerkt, benutze ich das nur bei Win32/Win64, wie es unter Linux geht - da muss ich passen :( .
Die eigentliche Definition ist in der struct.inc:

Code: Alles auswählen

VS_FIXEDFILEINFO = record
          dwSignature : DWORD;
          dwStrucVersion : DWORD;
          dwFileVersionMS : DWORD;
          dwFileVersionLS : DWORD;
          dwProductVersionMS : DWORD;
          dwProductVersionLS : DWORD;
          dwFileFlagsMask : DWORD;
          dwFileFlags : DWORD;
          dwFileOS : DWORD;
          dwFileType : DWORD;
          dwFileSubtype : DWORD;
          dwFileDateMS : DWORD;
          dwFileDateLS : DWORD;
       end;
     _VS_FIXEDFILEINFO = VS_FIXEDFILEINFO;
     TVSFIXEDFILEINFO = VS_FIXEDFILEINFO;
     PVSFIXEDFILEINFO = ^VS_FIXEDFILEINFO;

joe
Beiträge: 37
Registriert: Fr 28. Mai 2010, 15:47

Re: Wie Programmversion abfragen?

Beitrag von joe »

Weiss denn jemand, ob es für diese Problemstellung mittlerweile eine portable Lösung gibt?
Im Web finde ich nur Lösungen für Windows.
(Bislang habe ich je Applikation eine globale Variable mit der Versionsnummer, die ich parallel zu der Versionsnummer in den Projekteinstellungen pflegen muss.)

Erweiterte Fragestellung:
Ich würde auch gerne die Versionsnummer von Compiler und LCL auslesen und in der About-Box meiner Applikation anzeigen.
* LCL Version habe ich gefunden → TForm.LCLVersion
* Bzgl. der FPC Version habe ich noch nichts richtiges gefunden. Nur via FPC Kommandozeile (z.B. fpc -iV). Ok, dass könnte ich jetzt vielleicht irgendwie per makefile in mein Programm hineinkompilieren ... aber eine Konstante im Source wäre mir wesentlich angenehmer.

Hat da vielleicht jemand eine Idee?

knight
Beiträge: 802
Registriert: Mi 13. Sep 2006, 22:30

Re: Wie Programmversion abfragen?

Beitrag von knight »

Schaue dir mal die Lazarus-Quelltexte an. Im Menü unter Ansicht -> IDE-Interna -> Über FPC werden einige Informationen angezeigt. Grundsätzlich solltest du das auch für ein eigenes Programm übernehmen können.

knight

joe
Beiträge: 37
Registriert: Fr 28. Mai 2010, 15:47

Re: Wie Programmversion abfragen?

Beitrag von joe »

knight hat geschrieben:Schaue dir mal die Lazarus-Quelltexte an. Im Menü unter Ansicht -> IDE-Interna -> Über FPC werden einige Informationen angezeigt. Grundsätzlich solltest du das auch für ein eigenes Programm übernehmen können.
Der Tipp war goldrichtig, denn er führte mich zur Lösung wie ich die FPC Version und noch einiges mehr zur Kompilierzeit ermitteln kann.
-> http://www.freepascal.org/docs-html/pro ... 30001.1.38

Ok, bleibt noch die Frage, wie man die eigene Programmversion portabel ermittelt.

joe
Beiträge: 37
Registriert: Fr 28. Mai 2010, 15:47

Re: Wie Programmversion abfragen?

Beitrag von joe »

joe hat geschrieben:Ok, bleibt noch die Frage, wie man die eigene Programmversion portabel ermittelt.
Nun denn, schauen wir doch mal nach wie's die Profis machen - schliesslich zeigen FPC und die Lazarus IDE ja auch ihre eigenen Programmversion an.

Bei Lazarus habe ich die Versionsnummer (hart kodiert) 2x in den Sourcen gefunden:
* /usr/share/lazarus/1.0.4/ide/version.inc) - schlicht ein '1.0.4'
* /usr/share/lazarus/1.0.4/lcl/lclversion.pas - verschiedene Varianten als Integer und String

In den FPC Sourcen habe ich auch 2 Stellen gefunden:
* fpc-2.6.0/Makefile.fpc - version=2.6.0
* fpc-2.6.0/compiler/version.pas - verschiedene Varianten als Integer und String

Ergo, weder Lazarus noch FPC versuchen irgendwie mittels GetFileVersionInfo() & Co an ihre eigene Programmversion zu kommen sondern haben dafür jeweils eigene Lösungen.
Mir deucht mittlerweile, dass es was vergleichbares wie GetFileVersionInfo() unter Linux garnicht gibt (und wohl erst recht nicht bei Targets wie Gameboy Advance ...).

Also ich fänd's ganz nett, wenn die in der Lazarus IDE eingestellten Programmversionsnummern irgendwie vom eigenen Source aus direkt zugänglich wären, z.B. via Macro.

Socke
Lazarusforum e. V.
Beiträge: 3178
Registriert: Di 22. Jul 2008, 19:27
OS, Lazarus, FPC: Lazarus: SVN; FPC: svn; Win 10/Linux/Raspbian/openSUSE
CPU-Target: 32bit x86 armhf
Wohnort: Köln
Kontaktdaten:

Re: Wie Programmversion abfragen?

Beitrag von Socke »

MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein

joe
Beiträge: 37
Registriert: Fr 28. Mai 2010, 15:47

Re: Wie Programmversion abfragen?

Beitrag von joe »

Yep, das funktioniert nun gleichermaßen unter Win32 und Linux.
Ein Tick schöner wäre es noch, wenn man auf die Versionsinformationen codeseitig schon zur Kompilierzeit zugreifen könnte statt sie erst zur Laufzeit (mehr oder weniger aufwändig) auszulesen.
Aber auf jeden Fall schon mal besser als nix, besten Dank dafür :-)

joe
Beiträge: 37
Registriert: Fr 28. Mai 2010, 15:47

Re: Wie Programmversion abfragen?

Beitrag von joe »

Der FPC bringt ab Version 2.7.1 eine portable Lösung mit.
http://bugs.freepascal.org/bug_view_adv ... g_id=23580

gocher
Beiträge: 298
Registriert: Di 23. Nov 2010, 23:41
OS, Lazarus, FPC: Ubuntu/Win, Lazarus trunk, FPC trunk
CPU-Target: 32Bit/64Bit
Wohnort: Geldern
Kontaktdaten:

Re: Wie Programmversion abfragen?

Beitrag von gocher »

Bei mir ist diese Version im Einsatz, habe ich mal aus allem was ich so finden konnte zusammengebaut!

Code: Alles auswählen

unit VersionSupport;
{$mode objfpc}
 
interface
 
uses
  Classes, SysUtils, resource, versiontypes, versionresource, LCLVersion, InterfaceBase;
 
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';
 
type
  TVersionInfo = class
  private
    FResource: TStringList;
    FBuildInfoAvailable: Boolean;
    FVersResource: TVersionResource;
    function GetFixedInfo: TVersionFixedInfo;
    procedure GetResourceStrings();
    function VersionToString(PV: TFileProductVersion): string;
    function GetFileVersion: string;
    function GetProductVersion: string;
    function GetStringFileInfo: TVersionStringFileInfo;
    function GetVarFileInfo: TVersionVarFileInfo;
    function GetCompilatonTime: string;
    function GetCompilerInfo: string;
    function GetTargetInfo: string;
    function GetOS: string;
    function GetCpu: string;
    function GetLCLVersion: string;
    function GetLCLFullVersion: string;
    function GetWidgetSet: string;
  public
    constructor Create;
    destructor Destroy; override;
 
    property BuildInfoAvailable: Boolean read FBuildInfoAvailable;
    property FixedInfo: TVersionFixedInfo read GetFixedInfo;
    property StringFileInfo: TVersionStringFileInfo read GetStringFileInfo;
    property VarFileInfo: TVersionVarFileInfo read GetVarFileInfo;
    property FileVersion: string read GetFileVersion ;
    property ProductVersion: string read GetProductVersion;
    property CompilatonTime: string read GetCompilatonTime;
    property CompilerInfo: string read GetCompilerInfo;
    property TargetInfo: string read GetTargetInfo;
    property OS: string read GetOS;
    property Resource: TStringList read FResource;
    property LCLVersion: string read GetLCLVersion;
    property LCLFullVersion: string read GetLCLFullVersion;
    property WidgetSet: string read GetWidgetSet;
  end;
 
implementation
 
function TVersionInfo.GetFixedInfo: TVersionFixedInfo;
begin
  result := FVersResource.FixedInfo;
end;
 
procedure TVersionInfo.GetResourceStrings();
var
  i, j : Integer;
  oTable : TVersionStringTable;
begin
  if BuildInfoAvailable then
  begin
    for i := 0 to StringFileInfo.Count-1 do
    begin
      oTable := StringFileInfo.Items[i];
      for j := 0 To oTable.Count-1 do
        if Trim(oTable.ValuesByIndex[j])<>'' then
          FResource.Values[oTable.Keys[j]] := oTable.ValuesByIndex[j];
    end;
  end;
end;
 
function TVersionInfo.VersionToString(PV: TFileProductVersion): string;
begin
  result := Format('%d.%d.%d.%d', [PV[0], PV[1], PV[2], PV[3]]);
end;
 
function TVersionInfo.GetProductVersion: string;
begin
  if BuildInfoAvailable then
    result := VersionToString(FixedInfo.ProductVersion)
  else
    result := 'No build information available';
end;
 
function TVersionInfo.GetFileVersion: string;
begin
  if BuildInfoAvailable then
    result := VersionToString(FixedInfo.FileVersion)
  else
    result := 'No build information available';
end;
 
function TVersionInfo.GetStringFileInfo: TVersionStringFileInfo;
begin
  result := FVersResource.StringFileInfo;
end;
 
function TVersionInfo.GetVarFileInfo: TVersionVarFileInfo;
begin
  result := FVersResource.VarFileInfo;
end;
 
constructor TVersionInfo.Create;
var
  Stream: TResourceStream;
  ResID: Integer;
  Res: TFPResourceHandle;
begin
  inherited Create;
  FVersResource := TVersionResource.Create;
  FResource := TStringList.Create;
  FBuildInfoAvailable := False;
  ResID := 1;
 
  // Defensive code to prevent failure if no resource available...
  Res := FindResource(HINSTANCE, PChar(PtrInt(ResID)), PChar(RT_VERSION));
  if Res = 0 then Exit;
 
  Stream := TResourceStream.CreateFromID(HINSTANCE, 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;
  GetResourceStrings();
end;
 
destructor TVersionInfo.Destroy;
begin
  FVersResource.Free;
  FResource.Free;
  inherited Destroy;
end;
 
function TVersionInfo.GetWidgetSet: string;
begin
  case InterfaceBase.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 TVersionInfo.GetCompilerInfo: string;
begin
  result := {$ifdef fpc}'Free Pascal FPC ' + {$I %FPCVERSION%}{$else}'Delphi'{$endif}
end;
 
function TVersionInfo.GetTargetInfo: string;
begin
  result := {$I %FPCTARGETCPU%} + ' - ' + {$I %FPCTARGETOS%};
end;
 
function TVersionInfo.GetOS: string;
begin
  result := {$I %FPCTARGETOS%};
end;
 
function TVersionInfo.GetCpu: string;
begin
  result := {$I %FPCTARGETCPU%};
end;
 
function TVersionInfo.GetLCLVersion: string;
begin
  result := {$ifdef fpc}'Lazarus LCL ' + lcl_version{$else}'unknown'{$endif};
end;
 
function TVersionInfo.GetLCLFullVersion: string;
begin
  result := {$ifdef fpc}'Lazarus LCL ' + IntToStr(lcl_major) + '.' + IntToStr(lcl_minor) + '.' + IntToStr(lcl_release) + '.' + IntToStr(lcl_patch){$else}'unknown'{$endif};
end;
 
function TVersionInfo.GetCompilatonTime: string;
var
  fs: TFormatSettings;
  dt: TDateTime;
begin
  GetLocaleFormatSettings(2057, fs);
  fs.TimeSeparator := ':';
  fs.DecimalSeparator := '.';
  fs.ShortDateFormat := 'yyyy"/"mm"/"dd';
  fs.LongTimeFormat := 'hh":"nn":"ss';
  fs.DateSeparator := '/';
  dt := StrToDateTime({$I %DATE%} + ' ' + {$I %TIME%}, fs);
  result := FormatDateTime('ddd, dd mmm yyyy hh:nn:ss', dt);
end;
 
end.    
MfG Gocher
akt. Projekt: Webserver(HTTPS HTTP/2) mit integrierten CMS in Free Pascal - www.gocher.me

gocher
Beiträge: 298
Registriert: Di 23. Nov 2010, 23:41
OS, Lazarus, FPC: Ubuntu/Win, Lazarus trunk, FPC trunk
CPU-Target: 32Bit/64Bit
Wohnort: Geldern
Kontaktdaten:

Re: Wie Programmversion abfragen?

Beitrag von gocher »

Ach so, für den Fall das jemand das in einer TStringList haben möchte!

Code: Alles auswählen

  procedure VersionInfo(VL: TStringList);
  var
    VInfo: TVersionInfo;
    i: integer;
  begin
    VInfo := TVersionInfo.Create;
    try
      VL.Values['FileVersion'] := VInfo.FileVersion;
      VL.Values['ProductVersion'] := VInfo.ProductVersion;
      VL.Values['IDEInfo'] := VInfo.LCLVersion;
      VL.Values['CompilerInfo'] := VInfo.CompilerInfo;
      VL.Values['TargetInfo'] := VInfo.TargetInfo;
      VL.Values['CompilationTime'] := VInfo.CompilatonTime;
....
      for i := 0 to  VInfo.Resource.Count-1 do
        VL.Values[VInfo.Resource.Names[i]] := VInfo.Resource.ValueFromIndex[i];
    finally
      VInfo.Free;
    end;
  end;  
MfG Gocher
akt. Projekt: Webserver(HTTPS HTTP/2) mit integrierten CMS in Free Pascal - www.gocher.me

Antworten