Solved

Accessing version/rel/build info from EXE

Posted on 1998-03-05
13
480 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
ID: 1360153
Edited text of question
0
 

Accepted Solution

by:
jpussacq earned 150 total points
ID: 1360154
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
ID: 1360155
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
ID: 1360156
I have sent the component to n_rosenblatt@hotmail.com.
Check it.

jpussacq.-
0
 

Author Comment

by:nrosenblatt
ID: 1360157
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
ID: 1360158
I am sending the mail again, a this moment.

Jpussacq.-
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

Expert Comment

by:jpussacq
ID: 1360159
Did you receive the component????
0
 

Author Comment

by:nrosenblatt
ID: 1360160
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
ID: 1360161
I have sent the mail to nrosenbl@slip.net.
0
 

Expert Comment

by:jpussacq
ID: 1360162
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
ID: 1360163
If you have any problem, look for the component in the following page:

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


0
 

Expert Comment

by:jpussacq
ID: 1360164
Did the component solve your problem???

0
 

Author Comment

by:nrosenblatt
ID: 1360165
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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
ddeman not working in activex 3 94
Delphi component that can load a DLL in design time? 8 53
Delphi cmd execution 6 56
Communication Between RC4 Delphi <-> PHP 3 101
This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Internet Business Fax to Email Made Easy - With eFax Corporate (http://www.enterprise.efax.com), you'll receive a dedicated online fax number, which is used the same way as a typical analog fax number. You'll receive secure faxes in your email, fr…
Learn how to create flexible layouts using relative units in CSS.  New relative units added in CSS3 include vw(viewports width), vh(viewports height), vmin(minimum of viewports height and width), and vmax (maximum of viewports height and width).

864 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

18 Experts available now in Live!

Get 1:1 Help Now