Solved

Accessing version/rel/build info from EXE

Posted on 1998-03-05
13
479 Views
Last Modified: 2010-04-06
In Delphi 3, I have started using the Project VersionInfo facility to number successive versions/builds of an application.  However, I see no easy-to-use means to access these data at run time so I can display this info in a Help|About box, for example.  I see in the WIN32S.HLP a reference to a control block (a Resource called VersionInfo) that contains this, but I don't know how to access it from Delphi if there's no built-in component that accesses that block.

Any clues on how to either (A) get these fields easily from a built-in component or function that I've overlooked, or (B) write some code to access the info from a lower-level source, or (C) get some public domain component that serves this purpose?  I'd be happy to either get the info directly from some in-memory source once the program is running or re-read the running EXE file to get the data.

TIA.
0
Comment
Question by:nrosenblatt
  • 8
  • 5
13 Comments
 

Author Comment

by:nrosenblatt
Comment Utility
Edited text of question
0
 

Accepted Solution

by:
jpussacq earned 150 total points
Comment Utility
I have a component (FREEWARE) to get the "Version Info".
Give me your e-mail, and I will send you this component.

jpussacq.-
0
 

Author Comment

by:nrosenblatt
Comment Utility
jpussacq-

Thanx for your offer.  Please e-mail to n_rosenblatt@hotmail.com.  Will this include source too?

Thanx again.

nrosenblatt
0
 

Expert Comment

by:jpussacq
Comment Utility
I have sent the component to n_rosenblatt@hotmail.com.
Check it.

jpussacq.-
0
 

Author Comment

by:nrosenblatt
Comment Utility
jpussacq-

It's been over 8 hours since your last posted comment, and the e-mail has not shown up.  Would you be good enough to send it again to n_rosenblatt@hotmail.com?  

Thanks again.

nrosenblatt
0
 

Expert Comment

by:jpussacq
Comment Utility
I am sending the mail again, a this moment.

Jpussacq.-
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Expert Comment

by:jpussacq
Comment Utility
Did you receive the component????
0
 

Author Comment

by:nrosenblatt
Comment Utility
jpussacq:

No, not really.  I am unable to download the attachments you sent to my HotMail address -- seems to be a problem with HotMail itself.  I'd sent you a reply saying this to the e-mail address you used to send the files over, but I guess you didn't get those.

So, if you don't mind indulging me again, would you please send the file(s) to a different e-mail address: nrosenbl@slip.net.  I've been pretty successful in downloading from a standard e-mail service.

Thanks again.

nrosenblatt
0
 

Expert Comment

by:jpussacq
Comment Utility
I have sent the mail to nrosenbl@slip.net.
0
 

Expert Comment

by:jpussacq
Comment Utility
This is the unit for the component:




{
Unit        : verslab.pas
Description : A TCustomLabel derivative that displays Win32 VersionInfo data
Version     : 1.03, 29 July 1997
Status      : Freeware.
Contact     : Marc Evans, marc@leviathn.demon.co.uk

History:
    v1.01   : fixed bug stopping LangCharSet from actually doing anything
                at all on a non-UK system.

    v1.02   : Fixed resource leak bug. (surely there can't be any more? It's
                only 6K!) Thanks to Peter Stromblad for finding it!
                1 July 1997

    v1.03   : Added display of flags, tidied up code. Made LangCharSet
                autodetect. Thanks to Fabrice Marguerie
                (FabriceM@compuserve.com) for the flags code.
                29 July 1997
}

unit verslab;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
    TVersionResources = (vrCompanyName, vrFileDescription, vrFileVersion,
                         vrInternalName, vrLegalCopyright, vrOriginalFilename,
                         vrProductName, vrProductVersion, vrComments, vrFlags);

  TVersionLabel = class(TCustomLabel)
  private
    { Private declarations }
    FVersionResource: TVersionResources;
    FInfoPrefix: string;
    FShowInfoPrefix: boolean;
    FVersionResourceKey: string;
    FLangCharset: string;

    procedure SetupInfoPrefix;
    procedure SetupResourceKey;
    function GetStringFileInfo(Buffer: Pchar; size: integer): string;
    function GetFixedFileInfo(Buffer: PChar; size: integer): string;
    function GetInfo: string;
    procedure SetupCaption;
  protected
    { Protected declarations }
    procedure SetInfoPrefix(Value: String);
    function GetInfoPrefix: string;
    procedure SetVersionResource(Value: TVersionResources);
    procedure SetShowInfoPrefix(Value: boolean);
    procedure SetVersionResourceKey(Value: string);
    procedure SetLangCharset(Value: string);
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

  published
    { Published declarations }
    property VersionResource: TVersionResources read FVersionResource
                                                write SetVersionResource;
    property VersionResourceKey: string read FVersionResourceKey
                                         write SetVersionResourceKey;
    property InfoPrefix: String read GetInfoPrefix write SetInfoPrefix;
    property ShowInfoPrefix: boolean read FShowInfoPrefix write SetShowInfoPrefix;
    property LangCharset: string read FLangCharset write SetLangCharset;
    property WordWrap;
    property Align;
    property Color;
    property Font;
    property AutoSize;
    property Alignment;
    property ParentFont;
  end;

const
    {The order of this array must be the same as the VersionResources
    enum type as that is used for the index lookup}
    VersionLookup: array[TVersionResources, 0..1] of string = (
                    ('CompanyName', 'Company Name:'),
                    ('FileDescription', 'File Description:'),
                    ('FileVersion', 'File Version:'),
                    ('InternalName', 'Internal Name:'),
                    ('LegalCopyright', 'Legal Copyright:'),
                    ('OriginalFilename', 'Original Filename:'),
                    ('ProductName', 'Product Name:'),
                    ('ProductVersion', 'Product Version:'),
                    ('Comments', 'Comments:'),
                    ('Flags', 'Flags:'));

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TVersionLabel]);
end;

constructor TVersionLabel.Create(AOwner: TComponent);
begin
    inherited Create(AOwner);
    WordWrap := false;
    Autosize := true;
    ShowInfoPrefix := true;
    LangCharset :='-1';   {-1 = auto detect}
    VersionResource := vrFileVersion;
end;

destructor TVersionLabel.Destroy;
begin
    inherited Destroy;
end;

procedure TVersionLabel.SetVersionResource(Value: TVersionResources);
begin
    FVersionResource := Value;
    SetupResourceKey;
    SetupInfoPrefix;
end;

procedure TVersionLabel.SetupInfoPrefix;
var s: string;
begin
    s := VersionLookup[FVersionResource, 1];
    InfoPrefix := s;
end;

procedure TVersionLabel.SetupResourceKey;
var s: string;
begin
    s := VersionLookup[FVersionResource, 0];
    VersionResourceKey := s;
end;

function TVersionLabel.GetFixedFileInfo(Buffer: PChar; size: integer): string;
var
  ValLen: Integer;
  FixedFileInfo: PVSFixedFileInfo;
begin
    if VerQueryValue(buffer, '\', Pointer(FixedFileInfo), ValLen) then
    begin
        Result := '';
        if (ValLen > 1) then
        begin
            if FixedFileInfo.dwFileFlags and VS_FF_DEBUG <> 0 then
                Result := Result+', Debug Build';
            if FixedFileInfo.dwFileFlags and VS_FF_PRERELEASE <> 0 then
                Result := Result+', Pre-Release Build';
            if FixedFileInfo.dwFileFlags and VS_FF_PATCHED <> 0 then
                Result := Result+', Patched Build';
            if FixedFileInfo.dwFileFlags and VS_FF_PRIVATEBUILD <> 0  then
                Result := Result+', Private Build';
            if FixedFileInfo.dwFileFlags and VS_FF_INFOINFERRED <> 0  then
                Result := Result+', InfoInferred';
            if FixedFileInfo.dwFileFlags and VS_FF_SPECIALBUILD <> 0  then
                Result := Result+', Special Build';

            if result <> '' then
                if Result[1] = ',' then Delete(Result, 1, 2);
        end;
    end
    else Result := '< Error retrieving version info >';
end;

function TVersionLabel.GetStringFileInfo(Buffer: Pchar; size: integer): string;
var vallen, Translen: integer;
    VersionPointer, TransBuffer: pchar;
    Temp: integer;
    CalcLangCharSet: string;
begin
    if FLangCharSet = '-1' then
    begin
        VerQueryValue(buffer, '\VarFileInfo\Translation',
                        pointer(TransBuffer), TransLen);
        if TransLen >= 4 then
        begin
            StrLCopy(@temp, TransBuffer, 2);
            CalcLangCharSet:=IntToHex(temp, 4);
            StrLCopy(@temp, TransBuffer+2, 2);
            CalcLangCharSet := CalcLangCharSet+IntToHex(temp, 4);
            FLangCharSet := CalcLangCharSet;
        end
        else
        begin
            Result := '< Error retrieving translation info >';
            exit;
        end;
    end;

    if VerQueryValue(buffer, pchar('\StringFileInfo\'+FLangCharSet+'\'+
                     VersionResourceKey),
                     pointer(VersionPointer), vallen) then
    begin
        if (Vallen > 1) then
        begin
            SetLength(Result, vallen);
            StrLCopy(Pchar(Result), VersionPointer, vallen);
        end
        else Result := '< No Version Info >';
    end
    else result := '< Error retrieving version info >';
end;

function TVersionLabel.GetInfo: string;
var dump, size: integer;
    buffer: pchar;
begin
    if csDesigning in Self.ComponentState then result := '< No design info >'
    else
    begin
        size := GetFileVersionInfoSize(pchar(Application.Exename), dump);
        if  size = 0 then
        begin
            Result := '< No Data Available >';
        end
        else
        begin
            buffer := StrAlloc(size+1);
            try
                if not GetFileVersionInfo(Pchar(Application.Exename), 0,
                        size, buffer) then
                    result := '< Error retrieving version info >'
                else
                begin
                    if FVersionResource = vrFlags then
                        Result := GetFixedFileInfo(buffer, size)
                    else Result := GetStringFileInfo(buffer, size);
                end;
            finally
                StrDispose(Buffer);
            end;
        end;
    end;
    if ShowInfoPrefix then Result := InfoPrefix+' '+Result;
end;

procedure TVersionLabel.SetInfoPrefix(Value: String);
begin
    if FInfoPrefix = Value then exit;
    FInfoPrefix := Value;
    {The caption needs to be recalculated everytime the prefix is
    changed, otherwise the detaults override the user specified one}
    SetupCaption;
end;

procedure TVersionLabel.SetVersionResourceKey(Value: string);
begin
    if FVersionResourceKey = Value then exit;
    FVersionResourceKey := Value;
    InfoPrefix := Value;
end;

function TVersionLabel.GetInfoPrefix: string;
begin
    result := FInfoPrefix;
end;

procedure TVersionLabel.SetShowInfoPrefix(Value: boolean);
begin
    if FShowInfoPrefix = value then exit;
    FShowInfoPrefix := Value;
    SetupCaption;
end;

procedure TVersionLabel.SetLangCharset(Value: string);
begin
    if FLangCharSet = Value then exit;
    FLangCharSet := Value;
    SetupCaption;
end;

procedure TVersionLabel.SetupCaption;
begin
    Caption := GetInfo;
end;


end.

0
 

Expert Comment

by:jpussacq
Comment Utility
If you have any problem, look for the component in the following page:

http://sunsite.icm.edu.pl/delphi/


0
 

Expert Comment

by:jpussacq
Comment Utility
Did the component solve your problem???

0
 

Author Comment

by:nrosenblatt
Comment Utility
To jpussacq:

Thanks for your persistence in following through the difficulties in getting me this solution.  Although I have not yet implemented the solution, it seems to offer all the information I need to get to where I want to be.

Bye, nrosenblatt
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Creating an auto free TStringList The TStringList is a basic and frequently used object in Delphi. On many occasions, you may want to create a temporary list, process some items in the list and be done with the list. In such cases, you have to…
Sending a Secure fax is easy with eFax Corporate (http://www.enterprise.efax.com). First, Just open a new email message.  In the To field, type your recipient's fax number @efaxsend.com. You can even send a secure international fax — just include t…
This demo shows you how to set up the containerized NetScaler CPX with NetScaler Management and Analytics System in a non-routable Mesos/Marathon environment for use with Micro-Services applications.

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

15 Experts available now in Live!

Get 1:1 Help Now