Smart questions
Smart answers
Smart people
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Member Login




Remember Me
Forgot Password?
Join Us!

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips now!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

Join Tek-Tips
*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Donate Today!

Do you enjoy these
technical forums?
Donate Today! Click Here

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.
Jobs from Indeed

Link To This Forum!

Partner Button
Add Stickiness To Your Site By Linking To This Professionally Managed Technical Forum.
Just copy and paste the
code below into your site.

Canderel (Programmer)
30 Apr 04 7:30
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

Helpful Member!  whosrdaddy (Vendor)
30 Apr 04 8:12
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)

CODE

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 :

CODE

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 (Vendor)
30 Apr 04 8:18
the 'u_versioninfo' code misses a line at the END with 'end.'

grrr, stupid typos

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

towerbase (Programmer)
30 Apr 04 8:22
Or perhaps a little simpler

CODE

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 (Programmer)
30 Apr 04 9:45
Towerbase... I couldn't do that...
Why is that?

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

buho (Programmer)
30 Apr 04 10:34

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

CODE

{---------------------------------------------------------------------------------}
{ 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 (Vendor)
30 Apr 04 11:12
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 (Programmer)
30 Apr 04 18:40
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).
Helpful Member!  Stretchwickster (Programmer)
30 Apr 04 19:33
Don't know if this site may be of some use to you:
http://www.undu.com/Articles/990216c.html

Clive

Canderel (Programmer)
3 May 04 2:13
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 (Programmer)
4 May 04 6:03
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 (Programmer)
4 May 04 7:36
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 (Programmer)
5 May 04 17:26
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 (Programmer)
6 May 04 10:52
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 (Programmer)
6 May 04 11:42
I'm using D7 Professional.  Maybe its not in Delphi 5.

Andrew
Hampshire, UK

DjangMan (Programmer)
6 May 04 14:49
JEDI has TJclFileVersionInfo which will allow you to read all sorts of information on a file.

DjangMan

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close