WebSVN – spacemission – /VCL_PJVERSIONINFO/PJVersionInfo.pas

{ ##
@FILE PJVersionInfo.pas
@COMMENTS Version Information Component (32 bit) source code
(development split from 16 bit version after v1.0).
@PROJECT_NAME Version Information Component
@PROJECT_DESC Component that reads version information from files.
@OTHER_NAMES + Original unit name was VerInfo.pas
+ Changed to VInfo.pas at v2.1
+ Changed to PJVersionInfo.pas at v3.0
@AUTHOR Peter Johnson, LLANARTH, Ceredigion, Wales, UK
@EMAIL peter.johnson@openlink.org
@WEBSITE http://www.pjsoft.contactbox.co.uk/
@COPYRIGHT © 1998-2002, Peter D Johnson.
@LEGAL_NOTICE This component is placed in the public domain. It
may be freely copied and circulated on a not for
profit basis providing that the code is unmodified
and this notice and information about the author and
his copyright remains attached to the source code.
@CREDITS In producing this component some techniques were
used which were learned from FVersion by PJ Veger,
Best, The Netherlands (Feb/96). In particular the
method of accessing language and char-set tables was
taken from PJ Veger's code.
@HISTORY(
@REVISION(
@VERSION 1.0
@DATE 25/04/1998
@COMMENTS Original version - 16 bit only.
)
@REVISION(
@VERSION 2.0
@DATE 06/12/1998
@COMMENTS Revised for use with 32 bit Windows. Not compatible
with v1.
)
@REVISION(
@VERSION 2.0.1
@DATE 09/04/1999
@COMMENTS Changed installation palette from "Own" to "PJ
Stuff".
)
@REVISION(
@VERSION 2.1
@DATE 28/11/1999
@COMMENTS + Changed unit name to VInfo from VerInfo to allow
component to install under Delphi 3 & 4 (VerInfo
clashes with an existing unit in these versions).
+ Removed superfluous conditional compilation
directives.
)
@REVISION(
@VERSION 3.0
@DATE 17/02/2002
@COMMENTS Major update:
+ Added ability to access all "translations" stored
in a file's version information, rather than just
first one. This has been done so that code using
earlier versions of this component should continue
to work unchanged.
+ Added new property to expose fixed file
information record.
+ Added new "string array" property to give access
to string information by name: this property can
access any custom string information if the name
is known.
+ Added properties to return number of
"translations" and to select index of
"translation" to be used.
+ Added properites to return language and character
set codes in addition to descriptive strings.
+ All string info, language and character set
properties now return values from the currently
selected translation (which defaults to the first
translation maintaining backward compatibilty).
+ Empty file name string now accesses name of host
application per command line rather than using
Application.ExeName. This enables this code to
work correctly even if user changes name of
executable file.
+ CharSet property now returns '' for unknown value
rather than 'Unknown'
+ Renamed unit to PJVersionInfo from VInfo.
+ Renamed TVersionNumber record to TPJVersionNumber
+ Replaced Tvs_FixedFileInfo record with use of
Windows unit defined type TVSFixedFileInfo.
+ Changed component palette from PJ Stuff to PJSoft
)
)
}
unit PJVersionInfo;
interface
uses
// Delphi
Windows, Classes;
type
{
TPJVersionNumber:
Record holding version numbers.
}
TPJVersionNumber = record
V1, V2, V3, V4: WORD;
end;
{
TPJVersionInfo:
Component that exposes the version information embedded in an executable
file and exposed the detail as properties.
}
TPJVersionInfo = class(TComponent)
private // properties
fFileName: string;
fHaveInfo: Boolean;
fNumTranslations: Integer;
fCurrentTranslation: Integer;
fFixedFileInfo: TVSFixedFileInfo;
procedure SetFileName(AName: string);
function GetProductVersionNumber: TPJVersionNumber;
function GetFileVersionNumber: TPJVersionNumber;
function GetLanguage: string;
function GetCharSet: string;
function GetCharSetCode: WORD;
function GetLanguageCode: WORD;
function GetCurrentTranslation: Integer;
procedure SetCurrentTranslation(const Value: Integer);
function GetStringFileInfo(const Name: string): string;
function GetStringFileInfoByIdx(Index: Integer): string;
private
fPInfoBuffer: PChar;
{Pointer to info buffer}
fPTransBuffer: Pointer;
{Pointer to translation buffer}
procedure GetInfoBuffer(Len: DWORD);
{Creates an info buffer of required size}
procedure GetTransBuffer(Len: UINT);
{Creates a translation table buffer of required size}
function GetTransStr: string;
{Translation info encoded in string: takes into account current
translation}
protected
procedure ClearProperties; virtual;
{Forces properties to return cleared values}
procedure ReadVersionInfo; virtual;
{Reads version info from file}
public
constructor Create(AOwner: TComponent); override;
{Class constructor: sets default values}
destructor Destroy; override;
{Class destructor: frees allocated memory}
{Properties}
property HaveInfo: Boolean
read fHaveInfo;
{Property true if file version info for the file per FileName property has
been successfully read}
property FixedFileInfo: TVSFixedFileInfo
read fFixedFileInfo;
{Exposes the whole fixed file info record: following properties expose
the various fields of it}
property FileVersionNumber: TPJVersionNumber read
GetFileVersionNumber;
{Version number of file, in numeric format, from fixed file info}
property ProductVersionNumber: TPJVersionNumber
read GetProductVersionNumber;
{Version number of product, in numeric format, from fixed file info}
property FileOS: DWORD
read fFixedFileInfo.dwFileOS;
{Code describing operating system to be used by file}
property FileType: DWORD
read fFixedFileInfo.dwFileType;
{Code descibing type of file}
property FileSubType: DWORD
read fFixedFileInfo.dwFileSubType;
{Code describing sub-type of file - only used for certain values of
FileType property}
property FileFlagsMask: DWORD
read fFixedFileInfo.dwFileFlagsMask;
{Code describing which FileFlags are valid}
property FileFlags: DWORD
read fFixedFileInfo.dwFileFlags;
{Flags describing file state}
property Comments: string index 0
read GetStringFileInfoByIdx;
{String file info property giving user defined comments for current
translation}
property CompanyName: string index 1
read GetStringFileInfoByIdx;
{String file info property giving name of company for current translation}
property FileDescription: string index 2
read GetStringFileInfoByIdx;
{String file info property giving description of file for current
translation}
property FileVersion: string index 3
read GetStringFileInfoByIdx;
{String file info property giving version number of file in string format
for current translation}
property InternalName: string index 4
read GetStringFileInfoByIdx;
{String file info property giving internal name of file for current
translation}
property LegalCopyright: string index 5
read GetStringFileInfoByIdx;
{String file info property giving copyright message for current
translation}
property LegalTrademarks: string index 6
read GetStringFileInfoByIdx;
{String file info property giving trademark info for current translation}
property OriginalFileName: string index 7
read GetStringFileInfoByIdx;
{String file info property giving original name of file for current
translation}
property PrivateBuild: string index 8
read GetStringFileInfoByIdx;
{String file info property giving information about a private build of
file for current translation}
property ProductName: string index 9
read GetStringFileInfoByIdx;
{String file info property giving name of product for current translation}
property ProductVersion: string index 10
read GetStringFileInfoByIdx;
{String file info property giving version number of product in string
format for current translation}
property SpecialBuild: string index 11
read GetStringFileInfoByIdx;
{String file info property giving information about a special build of
file for current translation}
property StringFileInfo[const Name: string]: string
read GetStringFileInfo;
{Returns the value for string file info with given name for current
translation. This property can return both standard and custom string
info}
property Language: string
read GetLanguage;
{Name of language in use in current translation}
property CharSet: string
read GetCharSet;
{Name of character set in use in current translation}
property LanguageCode: WORD
read GetLanguageCode;
{Code of laguage in use in current translation}
property CharSetCode: WORD
read GetCharSetCode;
{Character set code in use in current translation}
property NumTranslations: Integer
read fNumTranslations;
{The number of difference translations (ie languages and char sets) in
the version information}
property CurrentTranslation: Integer
read GetCurrentTranslation write SetCurrentTranslation;
{Zero-based index of the current translation: this is 0 when a file is
first accessed. Set to a value in range 0..NumTranslations-1 to access
other translations. All string info, language and char set properties
return information for the current translation}
published
property FileName: string read fFileName write SetFileName;
{Name of file to which version information relates}
end;
procedure Register;
{Register this component}
implementation
uses
// Delphi
SysUtils;
{ Component registration routine }
procedure Register;
{Register this component}
begin
RegisterComponents('PJSoft', [TPJVersionInfo]);
end;
{ TPJVersionInfo }
type
{
TTransRec:
Record of language code and char set codes that are returned from version
information.
}
TTransRec = packed record // record to hold translation information
Lang, CharSet: Word;
end;
{
TTransRecs:
Type used to type cast translation data into an array of translation
records.
}
TTransRecs = array[0..1000] of TTransRec;
{
PTransRecs:
Pointer to an array of translation records.
}
PTransRecs = ^TTransRecs;
procedure TPJVersionInfo.ClearProperties;
{Forces properties to return cleared values}
begin
// Record that we haven't read ver info: this effectively clears properties
// since each property read access method checks this flag before returning
// result
fHaveInfo := False;
end;
constructor TPJVersionInfo.Create(AOwner: TComponent);
{Class constructor: sets default values}
begin
inherited Create(AOwner);
// Default is no file name - refers to executable file for application
FileName := '';
end;
destructor TPJVersionInfo.Destroy;
{Class destructor: frees allocated memory}
begin
// Ensure that info buffer is freed if allocated
if fPInfoBuffer <> nil then
StrDispose(fPInfoBuffer);
// Ensure that translation buffer is free if allocated
if fPTransBuffer <> nil then
FreeMem(fPTransBuffer);
inherited Destroy;
end;
function TPJVersionInfo.GetCharSet: string;
{Read access method for CharSet property: return string describing character
set if we have some version info and empty string if we haven't}
const
// Map code numbers to char-set names
cCharSets: array[0..11] of record
Code: Word; // char set code
Str: string; // associated name of char set
end = (
( Code: 0; Str: '7-bit ASCII' ),
( Code: 932; Str: 'Windows, Japan (Shift - JIS X-0208)'),
( Code: 949; Str: 'Windows, Korea (Shift - KSC 5601)' ),
( Code: 950; Str: 'Windows, Taiwan (GB5)' ),
( Code: 1200; Str: 'Unicode' ),
( Code: 1250; Str: 'Windows, Latin-2 (Eastern European)'),
( Code: 1251; Str: 'Windows, Cyrillic' ),
( Code: 1252; Str: 'Windows, Multilingual' ),
( Code: 1253; Str: 'Windows, Greek' ),
( Code: 1254; Str: 'Windows, Turkish' ),
( Code: 1255; Str: 'Windows, Hebrew' ),
( Code: 1256; Str: 'Windows, Arabic' )
);
var
I: Integer; // loop control
begin
Result := '';
if fHaveInfo then
begin
// We've have ver info: scan table of codes looking for required entry
for I := Low(cCharSets) to High(cCharSets) do
if GetCharSetCode = cCharSets[I].Code then
begin
// found one - record its name
Result := cCharSets[I].Str;
Exit;
end;
end;
end;
function TPJVersionInfo.GetCharSetCode: WORD;
{Read access for CharSetCode property: returns char set code for current
translation or 0 if there is no translation or we have no version info}
begin
if fHaveInfo and (GetCurrentTranslation >= 0) then
Result := PTransRecs(fPTransBuffer)^[GetCurrentTranslation].CharSet
else
Result := 0;
end;
function TPJVersionInfo.GetCurrentTranslation: Integer;
{Read access method for CurrentTranslation property: returns index to current
translation if we have version info or -1 if no version info}
begin
if fHaveInfo then
Result := fCurrentTranslation
else
Result := -1;
end;
function TPJVersionInfo.GetFileVersionNumber: TPJVersionNumber;
{Read access method for FileVersionNumber property: fill version info
structure and return it - if there's no version info all values will be zero}
begin
Result.V1 := HiWord(fFixedFileInfo.dwFileVersionMS);
Result.V2 := LoWord(fFixedFileInfo.dwFileVersionMS);
Result.V3 := HiWord(fFixedFileInfo.dwFileVersionLS);
Result.V4 := LoWord(fFixedFileInfo.dwFileVersionLS);
end;
procedure TPJVersionInfo.GetInfoBuffer(Len: DWORD);
{Creates an info buffer of required size}
begin
// Clear any existing buffer
if fPInfoBuffer <> nil then
StrDispose(fPInfoBuffer);
// Create the new one
fPInfoBuffer := StrAlloc(Len);
end;
function TPJVersionInfo.GetLanguage: string;
{Read access method for Language property: return string describing language
if we have some version info and empty string if we haven't}
var
Buf: array[0..255] of char; // stores langauge string from API call
begin
// Assume failure
Result := '';
// Try to get language name from Win API if we have ver info
if fHaveInfo and (VerLanguageName(GetLanguageCode, Buf, 255) > 0) then
Result := Buf;
end;
function TPJVersionInfo.GetLanguageCode: WORD;
{Read access for LanguageCode property: returns language code for current
translation or 0 if there is no translation or we have no version info}
begin
if fHaveInfo and (GetCurrentTranslation >= 0) then
Result := PTransRecs(fPTransBuffer)^[GetCurrentTranslation].Lang
else
Result := 0;
end;
function TPJVersionInfo.GetProductVersionNumber: TPJVersionNumber;
{Read access method for ProductVersionNumber property: fill version info
structure and return it - if there's no version info all values will be zero}
begin
Result.V1 := HiWord(fFixedFileInfo.dwProductVersionMS);
Result.V2 := LoWord(fFixedFileInfo.dwProductVersionMS);
Result.V3 := HiWord(fFixedFileInfo.dwProductVersionLS);
Result.V4 := LoWord(fFixedFileInfo.dwProductVersionLS);
end;
function TPJVersionInfo.GetStringFileInfo(const Name: string): string;
{Read access method for StringFileInfo array property: returns string
associated with given name or empty string if we have no version info}
var
CommandBuf: array[0..255] of char; // buffer to build API call command str
Ptr: Pointer; // pointer to result of API call
Len: UINT; // length of structure returned from API
begin
// Set default failure result to empty string
Result := '';
// Check if we have valid information recorded in info buffer - exit if not
if fHaveInfo then
begin
// Build API call command string for reading string file info:
// this uses info string + language and character set
StrPCopy(CommandBuf, '\StringFileInfo\' + GetTransStr + '\' + Name);
// Call API to get required string and return it if successful
if VerQueryValue(fPInfoBuffer, CommandBuf, Ptr, Len) then
Result := PChar(Ptr);
end;
end;
function TPJVersionInfo.GetStringFileInfoByIdx(Index: Integer): string;
{Read access method for all string file info properties: returns appropriate
string for the given property or empty string if we have no version info}
const
cNames: array[0..11] of string =
('Comments', 'CompanyName', 'FileDescription', 'FileVersion',
'InternalName', 'LegalCopyright', 'LegalTrademarks', 'OriginalFileName',
'PrivateBuild', 'ProductName', 'ProductVersion', 'SpecialBuild');
{names of predefined string file info strings}
begin
Result := GetStringFileInfo(cNames[Index]);
end;
procedure TPJVersionInfo.GetTransBuffer(Len: UINT);
{Creates a translation table buffer of required size}
begin
// Clear any existing buffer
if fPTransBuffer <> nil then
FreeMem(fPTransBuffer);
// Create the new one
GetMem(fPTransBuffer, Len);
end;
function TPJVersionInfo.GetTransStr: string;
{Translation info encoded in string: takes into account current translation}
var
TransRec: TTransRec; // translation record in array of translations
begin
if GetCurrentTranslation >= 0 then
begin
// There is a valid current translation: return hex string related to it
TransRec := PTransRecs(fPTransBuffer)^[GetCurrentTranslation];
Result := Format('%4.4x%4.4x', [TransRec.Lang, TransRec.CharSet]);
end
else
// No valid translation string: return empty string
Result := '';
end;
procedure TPJVersionInfo.ReadVersionInfo;
{Reads version info from file}
var
Len: UINT; // length of structs returned from API calls
Ptr: Pointer; // points to version info structures
InfoSize: DWORD; // size of info buffer
Dummy: DWORD; // stores 0 in call to GetFileVersionInfoSize
begin
// Record default value of HaveInfo property - no info read
fHaveInfo := False;
// Store zeros in fixed file info structure: this is used when no info
FillChar(fFixedFileInfo, SizeOf(fFixedFileInfo), 0);
// Set NumTranslations property to 0: this is value if no info
fNumTranslations := 0;
// Record required size of version info buffer
InfoSize := GetFileVersionInfoSize(PChar(fFileName), Dummy);
// Check that there was no error
if InfoSize > 0 then
begin
// Found info size OK
// Ensure we have a sufficiently large buffer allocated
GetInfoBuffer(InfoSize);
// Read file version info into storage and check success
if GetFileVersionInfo(PChar(fFileName), Dummy, InfoSize, fPInfoBuffer) then
begin
// Success: we've read file version info to storage OK
fHaveInfo := True;
// Get fixed file info & copy to own storage
VerQueryValue(fPInfoBuffer, '\', Ptr, Len);
fFixedFileInfo := PVSFixedFileInfo(Ptr)^;
// Get first translation table info from API
VerQueryValue(fPInfoBuffer, '\VarFileInfo\Translation', Ptr, Len);
// Ptr is to block of translation records each of size Len:
// work out number of translations
fNumTranslations := Len div SizeOf(TTransRec);
// store translation array in a buffer
GetTransBuffer(Len);
Move(Ptr^, fPTransBuffer^, Len);
// make first translation in block current one (-1 if no translations)
SetCurrentTranslation(0); // adjusts value to -1 if no translations
end;
end;
end;
procedure TPJVersionInfo.SetCurrentTranslation(const Value: Integer);
{Write accees method for CurrentTranslation property: if value is out of
translation range then it is set to -1 to indicate no translation}
begin
if (Value >= 0) and (Value < NumTranslations) then
fCurrentTranslation := Value
else
fCurrentTranslation := -1
end;
procedure TPJVersionInfo.SetFileName(AName: string);
{Write access method for FileName property: action at design time is different
to run time. At design time we simply record value while at run time we store
value - using actual name of program for '' string - and read the version
information}
begin
if csDesigning in ComponentState then
// We are designing, simply record the required name
fFileName := AName
else
begin
// It's run-time
// use Application exec file name if name is ''
if AName = '' then
fFileName := ParamStr(0)
else
fFileName := AName;
// clear all properties and read file version info for new file
ClearProperties;
ReadVersionInfo;
end;
end;
end.

Subversion Repositories spacemission

spacemission/VCL_PJVERSIONINFO/PJVersionInfo.pas – Rev 1