[Lazarus] Program version

[Antonio Fortuny]

Hi again.

I succeeded to make one source unit which when used into any Lazarus 
unit, gives the version of any file as far as the file :
- has been compiled whith Lazarus or Delphi
- version information is in the resource data ad hoc (as Lazarus and 
Delphi provide)
The file to analyze can be any executable file provided that the 
standard OS signatures are at the beginning of the file:
- 'MZ' as the first two chars of the file for any windows program 
(inclusive WinCE)
- #127+'ELF' as the first four chars of a Linux executable file
The unit can be compiled by Lazarus (or FPC I guess) on Win32, Win64, 
Linux x86_64 (I guess i386 too)
Targets can be Win32, WinCE, Win64, Linux x86_64
A program using the version unit runs on Win32, win64, winCE, Linux x86_64
Whatever the target can be, there is no need to change anything. Same 
source runs on all named platforms.
In case of trouble, the unit is supposed not to blow up. It gives a 
blank version intead.µ
See th source unit as attachment.

As I'm not perfect, so I suppose that my code could easily be changed, 
adapted or made better in any way. Feel free to comment for improvements
There are not very much comments as code is almost self explanatory but 
there improvements can be made as well.

Antonio.

-------------- next part --------------
unit uProgramVersion;
{
Author: Antonio Fortuny (a(DOT)fortuny(AT)sitasoftawre(DOT)lu )
Date: nov/2013
Company: Sita Software
Location: Luxembourg
www.sita.lu
}
interface

uses
  Classes,
  {$IFNDEF LINUX}
  windows,
  {$ENDIF}
  SysUtils;

type
  TVersion = record
    Major, Minor, Release, Build: Integer;
  end;
  PTVersion = ^TVersion;

{$IFDEF WINCE}
function ReadVersionInfo(const sProgram: WideString; Out vv: PTVersion) :Boolean;
function ProgramVersion(const sProgram: WideString) : WideString;
function ProgramVersionOnly(const sProgram: WideString) : WideString;
function ProgramFullVersion(const sProgram: WideString) : WideString;
function AnyProgramVersion(const sProgram: WideString): WideString; overload;
function AnyProgramVersion(const sProgram: string; Out vv: PTVersion) :Boolean; overload;
{$ELSE}
function ReadVersionInfo(const sProgram: string; Out vv: PTVersion) :Boolean;
function ProgramVersion(const sProgram: string) : string;
function ProgramVersionOnly(const sProgram: string) : string;
function ProgramFullVersion(const sProgram: string) : string;
function AnyProgramVersion(const sProgram: string): String; overload;
function AnyProgramVersion(const sProgram: string; Out vv: PTVersion) :Boolean; overload;
{$ENDIF}
function CurrentProgramVersion(const sProgram: string; const ExecType: char='W'): String;

implementation

uses
  elfreader,
  winpeimagereader,
  resource,
  versionresource;

{$IFDEF WINCE}
function ReadVersionInfo(const sProgram: WideString; Out vv: PTVersion): Boolean;
{$ELSE}
function ReadVersionInfo(const sProgram: string; Out vv: PTVersion) :Boolean;
{$ENDIF}
begin
  if AnyProgramVersion(sProgram, vv) then
    Result := True
  else begin
    Result := False;
    vv := New(PTVersion);
    vv^.Major := 0;
    vv^.Minor := 0;
    vv^.Release := 0;
    vv^.Build := 0;
  end;
end;

{$IFDEF WINCE}
function ProgramVersionOnly(const sProgram: WideString) : WideString;
{$ELSE}
function ProgramVersionOnly(const sProgram: string): string;
{$ENDIF}
var
  vver: PTVersion=nil;
begin
  try
    Result := '0.0.0.0';
    if ReadVersionInfo(sProgram, vver) then begin
      //VersionProgramme := Format('%d.%d.%d.%d', [vver.Major, vver.Minor, vver.Release, vver.Build]);
      Result := Format('%d.%d.%d.%d', [vver^.Major, vver^.Minor, vver^.Release, vver^.Build]);
    end;
  finally
    if Assigned(vver) then
      Dispose(vver);
  end;
end;

{$IFDEF WINCE}
function ProgramFullVersion(const sProgram: WideString) : WideString;
{$ELSE}
function ProgramFullVersion(const sProgram: string) : string;
{$ENDIF}
var
  vver: PTVersion=nil;
begin
  // Initialisation de l'application:
  try
    Result := '000.000.000.000';
    if sProgram = EmptyStr then
      Exit;
    if ReadVersionInfo(sProgram, vver) then begin
      //VersionProgramme := Format('%d.%d.%d.%d', [vver.Major, vver.Minor, vver.Release, vver.Build]);
      Result := Format('%.3d.%.3d.%.3d.%.3d', [vver^.Major, vver^.Minor, vver^.Release, vver^.Build]);
    end;
  finally
    if Assigned(vver) then
      Dispose(vver);
  end;
end;

function CurrentProgramVersion(const sProgram: string; const ExecType: char='W'): String;
var
  RS : TResources;
  E : TWinPEImageResourceReader=nil;
  EL : TElfResourceReader=nil;
  VR : TVersionResource;
  I : Integer;
  wProgram: String;
  ar: array[0..4] of byte;
begin
{

Msg := CurrentProgramVersion(ParamStr(0));
DoLog(Format('version ce programme %s', [Msg]));
Msg := CurrentProgramVersion('D:\Compiled\Lazarus\i386-win32\ipconsole.exe');
DoLog(Format('version lazarus win32 "D:\Compiled\Lazarus\i386-win32\ipconsole.exe" %s', [Msg]));
Msg := CurrentProgramVersion('D:\Compiled\BackupClient.exe');
DoLog(Format('version Delphi win32 "D:\Compiled\BackupClient.exe" %s', [Msg]));
Msg := CurrentProgramVersion('D:\Compiled\Lazarus\arm-wince\Commandes.exe');
DoLog(Format('version Delphi winCE "D:\Compiled\Lazarus\arm-wince\Commandes.exe" %s', [Msg]));
try
  Msg := CurrentProgramVersion('T:\compiled\TestVersionLinux', 'L');
  DoLog(Format('version Delphi winCE "T:\compiled\TestVersionLinux" %s', [Msg]));
except
  DoLog(Format('version Delphi winCE "T:\compiled\TestVersionLinux" %s', ['Exception']));
end;
}
  if sProgram = EmptyStr then
    wProgram := ParamStr(0)
  else
    wProgram := sProgram;
  RS:=TResources.Create;
  try
    try
      if ExecType = 'W' then begin
        E := TWinPEImageResourceReader.Create;
        Rs.LoadFromFile(wProgram, E);
      end else begin
        EL := TElfResourceReader.Create;
        Rs.LoadFromFile(wProgram, EL);
      end;
    finally
      if Assigned(E) then
        E.Free;
      if Assigned(EL) then
        EL.Free;
    end;
    VR:=Nil;
    I:=0;
    While (VR=Nil) and (I < RS.Count) do begin
      if RS.Items[i] is TVersionResource then
        VR := TVersionResource(RS.Items[i]);
      Inc(I);
    end;
    if VR <> Nil then begin
      Result := Format('%d.%d.%d.%d',[VR.FixedInfo.FileVersion[0], VR.FixedInfo.FileVersion[1], VR.FixedInfo.FileVersion[2], VR.FixedInfo.FileVersion[3]]);
    End ;
  Finally
    RS.FRee;
  end;
  {
  try
    E:=TWinPEImageResourceReader.Create;
    try
      Rs.LoadFromFile(wProgram, E);
    finally
      E.Free;
    end;
    VR:=Nil;
    I:=0;
    While (VR=Nil) and (I < RS.Count) do begin
      if RS.Items[i] is TVersionResource then
        VR:=TVersionResource(RS.Items[i]);
      Inc(I);
    end;
    if VR <> Nil then begin
      Result := Format('%d.%d.%d.%d',[VR.FixedInfo.FileVersion[0], VR.FixedInfo.FileVersion[1], VR.FixedInfo.FileVersion[2], VR.FixedInfo.FileVersion[3]]);
    End ;
  Finally
    RS.FRee;
  end;
  }
end;

{$IFDEF WINCE}
function AnyProgramVersion(const sProgram: WideString): WideString;
{$ELSE}
function AnyProgramVersion(const sProgram: string): String;
{$ENDIF}
var
  vv: PTVersion;
begin
  if AnyProgramVersion(sProgram, vv) then begin
    Result := Format('%d.%d.%d.%d', [vv^.Major, vv^.Minor, vv^.Release, vv^.Build]);
    Dispose(vv);
  end
  else
    Result := '0.0.0.0';
end;

{$IFDEF WINCE}
function AnyProgramVersion(const sProgram: string; Out vv: PTVersion) :Boolean;
{$ELSE}
function AnyProgramVersion(const sProgram: string; Out vv: PTVersion) :Boolean;
{$ENDIF}
const
  WIN_EXE: String = 'MZ';
  LINUX_EXE: String = #127 + 'ELF';
var
  wFileStr: TFileStream;
  RS : TResources;
  E : TWinPEImageResourceReader=nil;
  EL : TElfResourceReader=nil;
  VR : TVersionResource;
  I : Integer;
  {$IFDEF WINCE}
  wProgram: WideString;
  {$ELSE}
  wProgram: String;
  {$ENDIF}
  ar: array[0..4] of byte;
  ExecType: char;
begin
  Result := False;
  vv := New(PTVersion);
  with vv^ do begin
    Major:= -1;
    Minor := 0;
    Release := 0;
    Build := 0;
  end;
  if sProgram = EmptyStr then
    wProgram := ParamStr(0)
  else
    wProgram := sProgram;
  if not FileExists(wProgram) then begin
    // program name without path, assume directory of executing program
    if Pos(DirectorySeparator, wProgram) = 0 then begin
      wProgram := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))) + sProgram;
      if not FileExists(wProgram) then
        Exit;
    end else
      // no path delimiter, get out
      Exit;
  end else
    wProgram := sProgram;
  wFileStr := TFileStream.Create(sProgram, fmOpenRead);
  try
    // check what kind of executable an get resources accordingly
    wFileStr.Read(ar, 4);
  Finally
    wFileStr.Free;
  end;
  if CompareMem(@(ar), Pchar(WIN_EXE), 2) then
    ExecType := 'W'
  else
  if CompareMem(@(ar), Pchar(LINUX_EXE), 4) then
    ExecType := 'L'
  else
    Exit;
  RS:=TResources.Create;
  try
    try
      if ExecType = 'W' then begin
        E := TWinPEImageResourceReader.Create;
        Rs.LoadFromFile(wProgram, E);
      end else begin
        EL := TElfResourceReader.Create;
        Rs.LoadFromFile(wProgram, EL);
      end;
    finally
      if Assigned(E) then
        E.Free;
      if Assigned(EL) then
        EL.Free;
    end;
    VR:=Nil;
    I:=0;
    While (VR=Nil) and (I < RS.Count) do begin
      if RS.Items[i] is TVersionResource then
        VR := TVersionResource(RS.Items[i]);
      Inc(I);
    end;
    if VR <> Nil then begin
      with vv^ do begin
        Major:= VR.FixedInfo.FileVersion[0];
        Minor := VR.FixedInfo.FileVersion[1];
        Release := VR.FixedInfo.FileVersion[2];
        Build := VR.FixedInfo.FileVersion[3];
      end;
      Result := True
    End ;
  Finally
    RS.FRee;
  end;
end;

{$IFDEF WINCE}
function ProgramVersion(const sProgram: WideString): WideString;
{$ELSE}
function ProgramVersion(const sProgram: string) : string;
{$ENDIF}
begin
  // Initialisation de l'application:
  Result := ExtractFileName(sProgram) + ' v.' + ProgramVersionOnly(sProgram);
end;

end.