Wie Programmversion abfragen?
Wie Programmversion abfragen?
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.
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.
-
- 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?
Hi,
ich mache das so:
Gruss Edwin
*edit Win32/Win64
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;
Re: Wie Programmversion abfragen?
Danke für Deine Antwort.
Wo kommt denn der Typ PVSFIXEDFILEINFO her?
Wo kommt denn der Typ PVSFIXEDFILEINFO her?
-
- 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?
Hallo,
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
uses
Windows.

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;
Re: Wie Programmversion abfragen?
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?
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?
Re: Wie Programmversion abfragen?
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
knight
Re: Wie Programmversion abfragen?
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.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.
-> http://www.freepascal.org/docs-html/pro ... 30001.1.38
Ok, bleibt noch die Frage, wie man die eigene Programmversion portabel ermittelt.
Re: Wie Programmversion abfragen?
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.joe hat geschrieben:Ok, bleibt noch die Frage, wie man die eigene Programmversion portabel ermittelt.
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.
-
- 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?
Schau mal hier: http://www.lazarusforum.de/viewtopic.php?f=10&t=4085
MfG Socke
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein
Ein Gedicht braucht keinen Reim//Ich pack’ hier trotzdem einen rein
Re: Wie Programmversion abfragen?
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
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

Re: Wie Programmversion abfragen?
Der FPC bringt ab Version 2.7.1 eine portable Lösung mit.
→ http://bugs.freepascal.org/bug_view_adv ... g_id=23580
→ http://bugs.freepascal.org/bug_view_adv ... g_id=23580
-
- 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?
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
akt. Projekt: Webserver(HTTPS HTTP/2) mit integrierten CMS in Free Pascal - www.gocher.me
-
- 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?
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
akt. Projekt: Webserver(HTTPS HTTP/2) mit integrierten CMS in Free Pascal - www.gocher.me