Version No to About Box 2

[Canderel]

I have an about box. Any variable, or something which I can use in the form's create method to set it automatically to the version no from my project options?

ie.

procedure Aboutbox.FormCreate(sender : TObject);
begin
Label3.caption := Application.version;
end;

Well, if there was such a variable.

If it's not possible... it should be!

I am using Delphi 5.

Thanks

-Canderel

o__
,_.>/ _
(_)_\(_)_______
..speed is good

 

[whosrdaddy]

actually you can,

if you include version information in your project, it is stored as a resource into your '.EXE' file.

here's some code I snagged some years ago (I didn't write it)

unit u_versioninfo;

interface

uses Windows, Classes, SysUtils;
type
  TVersionInfo = class
  fModule : THandle;
  fVersionInfo : PChar;
  fVersionHeader : PChar;
  fChildStrings : TStringList;
  fTranslations : TList;
  fFixedInfo : PVSFixedFileInfo;
  fVersionResHandle : THandle;
  fModuleLoaded : boolean;

  private
    function GetInfo : boolean;
    function GetKeyCount: Integer;
    function GetKeyName(idx: Integer): string;
    function GetKeyValue(const idx: string): string;
    procedure SetKeyValue(const idx, Value: string);
  public
    constructor Create (AModule : THandle); overload;
    constructor Create (AVersionInfo : PChar); overload;
    constructor Create (const AFileName : string); overload;
    destructor Destroy; override;
    procedure SaveToStream (strm : TStream);

    property KeyCount : Integer read GetKeyCount;
    property KeyName [idx : Integer] : string read GetKeyName;
    property KeyValue [const idx : string] : string read GetKeyValue write SetKeyValue;
  end;

implementation

{ TVersionInfo }

type
TVersionStringValue = class
  fValue : string;
  fLangID, fCodePage : Integer;

  constructor Create (const AValue : string; ALangID, ACodePage : Integer);
end;

constructor TVersionInfo.Create(AModule: THandle);
var
  resHandle : THandle;
begin
  fModule := AModule;
  fChildStrings := TStringList.Create;
  fTranslations := TList.Create;
  resHandle := FindResource (fModule, pointer (1), RT_VERSION);
  if resHandle <> 0 then
  begin
    fVersionResHandle := LoadResource (fModule, resHandle);
    if fVersionResHandle <> 0 then
      fVersionInfo := LockResource (fVersionResHandle)
  end;

  if not Assigned (fVersionInfo) then
    raise Exception.Create ('Unable to load version info resource');
end;

constructor TVersionInfo.Create(AVersionInfo: PChar);
begin
  fChildStrings := TStringList.Create;
  fTranslations := TList.Create;
  fVersionInfo := AVersionInfo;
end;

constructor TVersionInfo.Create(const AFileName: string);
var
  handle : THandle;
begin
  handle := LoadLibraryEx (PChar (AFileName), 0, LOAD_LIBRARY_AS_DATAFILE);
  if handle <> 0 then
  begin
    Create (handle);
    fModuleLoaded := True
  end
  else
    raiseLastOSError;
end;

destructor TVersionInfo.Destroy;
var
  i : Integer;
begin
  for i := 0 to fChildStrings.Count - 1 do
    fChildStrings.Objects [i].Free;

  fChildStrings.Free;
  fTranslations.Free;
  if fVersionResHandle <> 0 then
    FreeResource (fVersionResHandle);
  if fModuleLoaded then
    FreeLibrary (fModule);
  inherited;
end;

function TVersionInfo.GetInfo : boolean;
var
  p : PChar;
  t, wLength, wValueLength, wType : word;
  key : string;

  varwLength, varwValueLength, varwType : word;
  varKey : string;

  function GetVersionHeader (var p : PChar; var wLength, wValueLength, wType : word; var key : string) : Integer;
  var
    szKey : PWideChar;
    baseP : PChar;
  begin
    baseP := p;
    wLength := PWord (p)^;
    Inc (p, sizeof (word));
    wValueLength := PWord (p)^;
    Inc (p, sizeof (word));
    wType := PWord (p)^;
    Inc (p, sizeof (word));
    szKey := PWideChar (p);
    Inc (p, (lstrlenw (szKey) + 1) * sizeof (WideChar));
    while Integer (p) mod 4 <> 0 do
      Inc (p);
    result := p - baseP;
    key := szKey;
  end;

  procedure GetStringChildren (var base : PChar; len : word);
  var
    p, strBase : PChar;
    t, wLength, wValueLength, wType, wStrLength, wStrValueLength, wStrType : word;
    key, value : string;
    i, langID, codePage : Integer;

  begin
    p := base;
    while (p - base) < len do
    begin
      t := GetVersionHeader (p, wLength, wValueLength, wType, key);
      Dec (wLength, t);

      langID := StrToInt ('$' + Copy (key, 1, 4));
      codePage := StrToInt ('$' + Copy (key, 5, 4));

      strBase := p;
      for i := 0 to fChildStrings.Count - 1 do
        fChildStrings.Objects [i].Free;
      fChildStrings.Clear;

      while (p - strBase) < wLength do
      begin
        t := GetVersionHeader (p, wStrLength, wStrValueLength, wStrType, key);
        Dec (wStrLength, t);

        if wStrValueLength = 0 then
          value := ''
        else
          value := PWideChar (p);
        Inc (p, wStrLength);
        while Integer (p) mod 4 <> 0 do
          Inc (p);

        fChildStrings.AddObject (key, TVersionStringValue.Create (value, langID, codePage))
      end
    end;
    base := p
  end;

  procedure GetVarChildren (var base : PChar; len : word);
  var
    p, strBase : PChar;
    t, wLength, wValueLength, wType: word;
    key : string;
    v : DWORD;

  begin
    p := base;
    while (p - base) < len do
    begin
      t := GetVersionHeader (p, wLength, wValueLength, wType, key);
      Dec (wLength, t);

      strBase := p;
      fTranslations.Clear;

      while (p - strBase) < wLength do
      begin
        v := PDWORD (p)^;
        Inc (p, sizeof (DWORD));
        fTranslations.Add (pointer (v));
      end
    end;
    base := p
  end;

begin
  result := False;
  if not Assigned (fFixedInfo) then
  try
    p := fVersionInfo;
    GetVersionHeader (p, wLength, wValueLength, wType, key);

    if wValueLength <> 0 then
    begin
      fFixedInfo := PVSFixedFileInfo (p);
      if fFixedInfo^.dwSignature <> $feef04bd then
        raise Exception.Create ('Invalid version resource');

      Inc (p, wValueLength);
      while Integer (p) mod 4 <> 0 do
        Inc (p);
    end
    else
      fFixedInfo := Nil;

    while wLength > (p - fVersionInfo) do
    begin
      t := GetVersionHeader (p, varwLength, varwValueLength, varwType, varKey);
      Dec (varwLength, t);

      if varKey = 'StringFileInfo' then
        GetStringChildren (p, varwLength)
      else
        if varKey = 'VarFileInfo' then
          GetVarChildren (p, varwLength)
        else
          break;
    end;

    result := True;
  except
  end
  else
    result := True
end;

function TVersionInfo.GetKeyCount: Integer;
begin
  if GetInfo then
    result := fChildStrings.Count
  else
    result := 0;
end;

function TVersionInfo.GetKeyName(idx: Integer): string;
begin
  if idx >= KeyCount then
    raise ERangeError.Create ('Index out of range')
  else
    result := fChildStrings [idx];
end;

function TVersionInfo.GetKeyValue(const idx: string): string;
var
  i : Integer;
begin
  if GetInfo then
  begin
    i := fChildStrings.IndexOf (idx);
    if i <> -1 then
      result := TVersionStringValue (fChildStrings.Objects [i]).fValue
    else
      raise Exception.Create ('Key not found')
  end
  else
    raise Exception.Create ('Key not found')
end;

procedure TVersionInfo.SaveToStream(strm: TStream);
var
  zeros, v : DWORD;
  wSize : WORD;
  stringInfoStream : TMemoryStream;
  strg : TVersionStringValue;
  i, p, p1 : Integer;
  wValue : WideString;

  procedure PadStream (strm : TStream);
  begin
    if strm.Position mod 4 <> 0 then
      strm.Write (zeros, 4 - (strm.Position mod 4))
  end;

  procedure SaveVersionHeader (strm : TStream; wLength, wValueLength, wType : word; const key : string; const value);
  var
    wKey : WideString;
    valueLen : word;
    keyLen : word;
  begin
    wKey := key;
    strm.Write (wLength, sizeof (wLength));

    strm.Write (wValueLength, sizeof (wValueLength));
    strm.Write (wType, sizeof (wType));
    keyLen := (Length (wKey) + 1) * sizeof (WideChar);
    strm.Write (wKey [1], keyLen);

    PadStream (strm);

    if wValueLength > 0 then
    begin
      valueLen := wValueLength;
      if wType = 1 then
        valueLen := valueLen * sizeof (WideChar);
      strm.Write (value, valueLen)
    end;
  end;

begin { SaveToStream }
  if GetInfo then
  begin
    zeros := 0;

    SaveVersionHeader (strm, 0, sizeof (fFixedInfo^), 0, 'VS_VERSION_INFO', fFixedInfo^);

    if fChildStrings.Count > 0 then
    begin
      stringInfoStream := TMemoryStream.Create;
      try
        strg := TVersionStringValue (fChildStrings.Objects [0]);

        SaveVersionHeader (stringInfoStream, 0, 0, 0, IntToHex (strg.fLangID, 4) + IntToHex (strg.fCodePage, 4), zeros);

        for i := 0 to fChildStrings.Count - 1 do
        begin
          PadStream (stringInfoStream);

          p := stringInfoStream.Position;
          strg := TVersionStringValue (fChildStrings.Objects [i]);
          wValue := strg.fValue;
          SaveVersionHeader (stringInfoStream, 0, Length (strg.fValue) + 1, 1, fChildStrings [i], wValue [1]);
          wSize := stringInfoStream.Size - p;
          stringInfoStream.Seek (p, soFromBeginning);
          stringInfoStream.Write (wSize, sizeof (wSize));
          stringInfoStream.Seek (0, soFromEnd);

        end;

        stringInfoStream.Seek (0, soFromBeginning);
        wSize := stringInfoStream.Size;
        stringInfoStream.Write (wSize, sizeof (wSize));

        PadStream (strm);
        p := strm.Position;
        SaveVersionHeader (strm, 0, 0, 0, 'StringFileInfo', zeros);
        strm.Write (stringInfoStream.Memory^, stringInfoStream.size);
        wSize := strm.Size - p;
      finally
        stringInfoStream.Free
      end;
      strm.Seek (p, soFromBeginning);
      strm.Write (wSize, sizeof (wSize));
      strm.Seek (0, soFromEnd)
    end;

    if fTranslations.Count > 0 then
    begin
      PadStream (strm);
      p := strm.Position;
      SaveVersionHeader (strm, 0, 0, 0, 'VarFileInfo', zeros);
      PadStream (strm);

      p1 := strm.Position;
      SaveVersionHeader (strm, 0, 0, 0, 'Translation', zeros);

      for i := 0 to fTranslations.Count - 1 do
      begin
        v := Integer (fTranslations [i]);
        strm.Write (v, sizeof (v))
      end;

      wSize := strm.Size - p1;
      strm.Seek (p1, soFromBeginning);
      strm.Write (wSize, sizeof (wSize));
      wSize := sizeof (Integer) * fTranslations.Count;
      strm.Write (wSize, sizeof (wSize));

      wSize := strm.Size - p;
      strm.Seek (p, soFromBeginning);
      strm.Write (wSize, sizeof (wSize));
    end;

    strm.Seek (0, soFromBeginning);
    wSize := strm.Size;
    strm.Write (wSize, sizeof (wSize));
    strm.Seek (0, soFromEnd);
  end
  else
    raise Exception.Create ('Invalid version resource');
end;

procedure TVersionInfo.SetKeyValue(const idx, Value: string);
var
  i : Integer;
begin
  if GetInfo then
  begin
    i := fChildStrings.IndexOf (idx);
    if i = -1 then
      i := fChildStrings.AddObject (idx, TVersionStringValue.Create (idx, 0, 0));

    TVersionStringValue (fChildStrings.Objects [i]).fValue := Value
  end
  else
    raise Exception.Create ('Invalid version resource');
end;

{ TVersionStringValue }

constructor TVersionStringValue.Create(const AValue: string; ALangID,
  ACodePage: Integer);
begin
  fValue := AValue;
  fCodePage := ACodePage;
  fLangID := ALangID;
end;

you can use it like this :

var VersionInfo : TVersionInfo;

...
  VersionInfo:=TVersionInfo.Create(FindHInstance(Self.ClassType));
  s:=VersionInfo.KeyValue ['FileVersion']; //get application version
...

you can add offcourse your own keys and read those..

Cheers,
daddy

--------------------------------------
What You See Is What You Get

 

[whosrdaddy]

the 'u_versioninfo' code misses a line at the END with 'end.'

grrr, stupid typos

--------------------------------------
What You See Is What You Get

 

[towerbase]

Or perhaps a little simpler

procedure TForm1.Button1Click(Sender: TObject);
var
  version: integer;
  major: integer;
  minor: integer;
begin
  version := GetFileVersion(paramstr(0));
  major := version shr 16;
  minor := version and $FFFF;
  Label1.Caption := Format ( '%d.%d', [ major, minor ] );
end;

Andrew
Hampshire, UK

 

[Canderel]

Towerbase... I couldn't do that...
Why is that?


o__
,_.>/ _
(_)_\(_)_______
..speed is good

 

[buho]

Or may be a quick hack into the EXE properties section?

{---------------------------------------------------------------------------------}
{ GetAppVersion                                                                   }
{---------------------------------------------------------------------------------}
{Returns:
  Vers   = "xx", Major  = "xxx", Minor  = "xxx", Build  = "xxxxx"
  or "??", "???", "???", "?????" if the "FileVersion" entry can't be found.
} 
procedure GetAppVersion(var Vers, Major, Minor, Build : AnsiString);
  {-----------------------------------------------------------------------------}
  function CheckUnicode : boolean;
    var
      Vers    : TOSVersionInfo;
    begin
      CheckUnicode := False;
      Vers.dwOSVersionInfoSize := SizeOf(Vers);
      if GetVersionEx(Vers)
        then CheckUnicode := Vers.dwPlatformId = VER_PLATFORM_WIN32_NT;
    end;
  {-----------------------------------------------------------------------------}
  function ConvertString(PInfo : PWideChar; Len : integer) : AnsiString;
    begin
      ConvertString := WideCharLenToString(PInfo, Len);
    end;
  {-----------------------------------------------------------------------------}
  procedure Slice(Str : AnsiString);
    {-------------------------------------------------------------------------}
      {Cut off the first token and left-padd it with zeroes till Width}
    function GetToken(var Str : AnsiString;
                          Width : byte        {Total width}
                      ): AnsiString;
      var
        Aux : AnsiString;
      begin
        {Copy and delete.}
        while (Str <> '') and (Str[1] <> '.') do
          begin
            Aux := Aux + Str[1];
            Delete(Str, 1, 1);
          end;
          {Delete the '.' if needed.}
          if Str <> ''
            then Delete(Str, 1, 1);
          {Left-padd till Width.}
          while Length(Aux) < Width do
            Aux := '0' + Aux;
          GetToken := Aux;
      end;
    {-------------------------------------------------------------------------}
    begin
      {Get the tokens.
      Version is formatted to 2 chars;  Major and Minor to 3 chars 
      and Build to 5 chars.}
      Vers := GetToken(Str, 2);
      Major:= GetToken(Str, 3);
      Minor:= GetToken(Str, 3);
      Build:= GetToken(Str, 5);
    end;
  {-----------------------------------------------------------------------------}
  var
    Unicode         : boolean;		// True if unicode OS
    Pgm             : AnsiString;	// App path and name
    PInfo           : PChar;		// Raw data
    Info            : AnsiString;	// Data as string
    InfoSize        : integer;
    Aux             : cardinal;
    VString         : AnsiString;	// Raw version data
    i               : integer;
  begin
    Unicode := CheckUnicode;
    Pgm := ParamStr(0);
    {Get the string size and the string itself.}
    InfoSize := GetFileVersionInfoSize(PChar(Pgm), Aux);
    GetMem(PInfo, InfoSize);
    GetFileVersionInfo(Pchar(Pgm), 0, InfoSize, PInfo);
    if Unicode
      then Info := ConvertString(PWideChar(PInfo), InfoSize)
      else
        begin
	  {The returned data is a raw multi-zero string.
          Translate it to something manageable.} 
          for i := 0 to InfoSize do
            Info := Info + PInfo[i];
        end;
    {Search the stamp. If found, copy the string and reformat it.}
    i := Pos('FileVersion', Info);
    if i <> 0
      then {Stamp found}
        begin
          i := i + 12;
          {!+!+!+!+!+!+!+!+!+!+!+!+!+!+!+!+!} 
          {Evil rounds every corner!!! - Minsk, Baldur's Gate I}
          if Unicode then Inc(i);
          {!+!+!+!+!+!+!+!+!+!+!+!+!+!+!+!+!} 
          while (Info[i] <> #0) and (i <= Length(Info)) do
            begin
              VString := VString + Info[i];
              Inc(i);
            end;
          Slice(VString);
        end
      else {Stamp not found}
        begin
          Vers  := '??';
          Major := '???';
          Minor := '???';
          Build := '?????';
        end;
    FreeMem(PInfo, InfoSize);
  end;

Most of the code is to reformat the string to our "version standard" "xx.xxx.xxx-xxxxx"; probably you can delete the Slice function to shorten it.

buho (A).

 

[whosrdaddy]

I know that the code I'm using is way overkill for this but I find it very usefull to store and retrieve data into that resource part, having the fileversion is an added bonus...

--------------------------------------
What You See Is What You Get

 

[buho]

Mine is totally ill-behaved. It is jumping over the due API functions and resorting to some supposed/expected format.

It will stop working as soon MS changes the properties section format.

Quick hacks are double edged swords.

buho (A).

 

[Stretchwickster]

Don't know if this site may be of some use to you:

http://www.undu.com/Articles/990216c.html

Clive

 

[Canderel]

I got it to work thanks! (Albeit with the long unit way) And anything that does it is splendid.

I did not really go through the code, but I understand that it can do more than just extract a version string... I just don't have a clue what one would use it for, but I'll probably include that unit into any project of mine that has an about box.

Thanks for the great advice!

o__
,_.>/ _
(_)_\(_)_______
..speed is good

 

[towerbase]

Canderel

When you say you couldn't do that, what exactly do you mean? Did you get an error at compile time or at run time or is your keyboard missing some keys or what!!!



Andrew
Hampshire, UK

 

[sggaunt]

I use a component called Getver by Bernd Juergens, Its easy to use and will save you a lot of Coding. (see above)
You could try this URL

http://www.weihenstephan.org/~bernjuer

but its a bit old so might not work.
Steve

 

[DjangMan]

You can also use a feature in GExperts that will create and update a variable with the latest build of your application - then you can reference it without having to do too much.

DjangMan

 

[buho]

tower:

I know the Win Script Engine have a GetFileVersion function, but I can't find it in the Win API.

What compiler version are you using? I can't find it in D5/D6.

buho (A).

 

[towerbase]

I'm using D7 Professional. Maybe its not in Delphi 5.

Andrew
Hampshire, UK

 

[DjangMan]

JEDI has TJclFileVersionInfo which will allow you to read all sorts of information on a file.

DjangMan