| 0,0 → 1,582 |
|---|
| { ## |
| @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. |