Solved

Version Info

Posted on 1998-12-15
5
267 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
  • 2
  • 2
5 Comments
 
LVL 12

Accepted Solution

by:
rwilson032697 earned 100 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

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

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…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In this video I am going to show you how to back up and restore Office 365 mailboxes using CodeTwo Backup for Office 365. Learn more about the tool used in this video here: http://www.codetwo.com/backup-for-office-365/ (http://www.codetwo.com/ba…
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

920 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

12 Experts available now in Live!

Get 1:1 Help Now