?
Solved

Version Info

Posted on 1998-12-15
5
Medium Priority
?
275 Views
Last Modified: 2010-04-04
Ok.  Im using D4.  I want to know what build my app is.  I have Version Info switched on and all that, but I cant extract it from my app.  How the bloody hell do I do it?  I have tried so many components and so much code and nothing has worked yet.

Preeze help....

Stu.
0
Comment
Question by:Stuart_Johnson
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
5 Comments
 
LVL 12

Accepted Solution

by:
rwilson032697 earned 300 total points
ID: 1351223
Use this one - we use it and it works...

http://sunsite.icm.edu.pl/delphi/ftp/d30free/verslab.zip

Cheers,

Raymond.

0
 
LVL 6

Author Comment

by:Stuart_Johnson
ID: 1351224
Its giving me exactly the same errors as I am getting doing it myself using VerQueryValue -  type of actual and formal parameters must be identical.

I think there is differences between D4 and previous version of Delphi, because I cant get it to work.  I've copied just the basic code bits from each example I have gotten (and they are almost all identical).  But I keep getting protection faults.

Can you please test it in D4 and let me know if it works or not, because I have just tried it on several computers here running D4 and none of them compile the component.

I have gone through the unit and fixed the errors, but when I run it I now get a protection fault.

Stu.
0
 
LVL 6

Author Comment

by:Stuart_Johnson
ID: 1351225
Argh!  I fixed it.  All numeric types have to be cardinal.

Works fine now!!  Wonderful!  Thanks.

Stu.
0
 
LVL 12

Expert Comment

by:rwilson032697
ID: 1351226
Here's our copy of the source - it works just fine on D4... (I did make a couple of very minor changes when we changed to D4...)

Cheers,

Raymond.

{
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:'), {SKIP}
                    ('FileDescription', 'File Description:'), {SKIP}
                    ('FileVersion', 'File Version:'), {SKIP}
                    ('InternalName', 'Internal Name:'), {SKIP}
                    ('LegalCopyright', 'Legal Copyright:'), {SKIP}
                    ('OriginalFilename', 'Original Filename:'), {SKIP}
                    ('ProductName', 'Product Name:'), {SKIP}
                    ('ProductVersion', 'Product Version:'), {SKIP}
                    ('Comments', 'Comments:'), {SKIP}
                    ('Flags', 'Flags:')); {SKIP}

procedure Register;

implementation

{$IFNDEF VER120}
Type
  LongWord = Integer;
{$ENDIF}

procedure Register;
begin
  RegisterComponents('Samples', [TVersionLabel]); {SKIP}
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: LongWord;
  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'; {SKIP}
            if FixedFileInfo.dwFileFlags and VS_FF_PRERELEASE <> 0 then
                Result := Result+', Pre-Release Build'; {SKIP}
            if FixedFileInfo.dwFileFlags and VS_FF_PATCHED <> 0 then
                Result := Result+', Patched Build'; {SKIP}
            if FixedFileInfo.dwFileFlags and VS_FF_PRIVATEBUILD <> 0  then
                Result := Result+', Private Build'; {SKIP}
            if FixedFileInfo.dwFileFlags and VS_FF_INFOINFERRED <> 0  then
                Result := Result+', InfoInferred'; {SKIP}
            if FixedFileInfo.dwFileFlags and VS_FF_SPECIALBUILD <> 0  then
                Result := Result+', Special Build'; {SKIP}

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

function TVersionLabel.GetStringFileInfo(Buffer: Pchar; size: integer): string;
var vallen, Translen: LongWord;
    VersionPointer, TransBuffer: pchar;
    Temp: integer;
    CalcLangCharSet: string;
begin
    if FLangCharSet = '-1' then
    begin
        VerQueryValue(buffer, '\VarFileInfo\Translation', {SKIP}
                        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 >'; {SKIP}
            exit;
        end;
    end;

    if VerQueryValue(buffer, pchar('\StringFileInfo\'+FLangCharSet+'\'+ {SKIP}
                     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 >'; {SKIP}
    end
    else result := '< Error retrieving version info >'; {SKIP}
end;

function TVersionLabel.GetInfo: string;
var dump : LongWord;
    size: integer;
    buffer: pchar;
begin
    if csDesigning in Self.ComponentState then result := '< No design info >' {SKIP}
    else
    begin
        size := GetFileVersionInfoSize(pchar(Application.Exename), dump);
        if  size = 0 then
        begin
            Result := '< No Data Available >'; {SKIP}
        end
        else
        begin
            buffer := StrAlloc(size+1);
            try
                if not GetFileVersionInfo(Pchar(Application.Exename), 0,
                        size, buffer) then
                    result := '< Error retrieving version info >' {SKIP}
                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;



0
 
LVL 3

Expert Comment

by:philipleighs
ID: 1351227
Let's see the code that gives the compiler error, and the variable declarations.
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

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

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…
In this video, Percona Solution Engineer Dimitri Vanoverbeke discusses why you want to use at least three nodes in a database cluster. To discuss how Percona Consulting can help with your design and architecture needs for your database and infras…
Suggested Courses

777 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