Mega Code Archive
Delphi Version Information Component
<![CDATA[
Title: Delphi Version Information Component
Question: When you right click an executable program, it has a tab containing the Version Information. This information can be extracted from the program and used for display purposes
Answer:
I was curious as how to solve this problem and thought it would be a good idea to write a component for it. That way I could be lazy and reuse it when ever I wanted. In addition, other people can be lazy too. It's not perfect, but it works. I've talked to people using it in D4, D5, CB4, and CB5. Please let me know if you find any bugs or even if you just like it.
{
Tprojinfo version 2.04.38.5.17b
This component gathers version info from a given file
using the "the dreaded and bizarre GetFileVersionInfo,
VerQueryValue, and VerLanguageName functions defined in winver.h." (msdn)
This component comes with no guarantee at all.
The source code may be copyied, modified, deleted, burned, blasphemed, or what
ever you wish to do with it as long as it is distributed for free.
Author: Gregory Liss
delphi3000@gregoryliss.com
Usage : Drop component on form.
Set project name in the exename property or programatically. This
name must include the path. The easiest way is like this:
projinfo1.exename := application.exename;
To get the information, simply use the execute method:
projinfo1.execute;
project information is stored as properties or you can get a stringlist
from the allinfo property.
}
unit GetVerInfo;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;
const
CInfoStr : array[1..10] of string =
('FileVersion','FileDescription','LegalCopyright','Comments',
'CompanyName', 'InternalName','LegalTrademarks',
'OriginalFilename','ProductName', 'ProductVersion');
type
TProjInfo = class(TComponent)
private
{ Private declarations }
sFileName ,
sFileVersion ,
sFileDescription ,
sLegalCopyright,
sComments ,
sCompanyName ,
sInternalName ,
sLegalTrademarks ,
sOriginalFilename ,
sProductName ,
sProductVersion ,
sLanguage : string;
slAllItems: TStrings;
procedure SetFileName (exename : string);
procedure SetFileVersion (ver : string);
procedure SetFileDescription(desc : string);
procedure SetLegalCopyright(cr : string);
procedure SetComments(cmt : string);
procedure SetCompanyName(cn : string);
procedure SetInternalName(intn : string);
procedure SetLegalTrademarks(tm : string);
procedure SetOriginalFilename(ofn : string);
procedure SetProductName(pn : string);
procedure SetProductVersion(pv : string);
procedure SetLanguage(lang : string);
procedure SetAllItems(items : Tstrings);
procedure GetVersionInfo(AVersionList: TStrings);
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
procedure execute;
published
property EXEName : string read sFileName write SetFileName;
property FileVersion: String read sFileVersion write SetFileVersion;
property FileDescription: String read sFileDescription write SetFileDescription;
property LegalCopyright: String read sLegalCopyright write SetLegalCopyright;
property Comments: String read sComments write SetComments;
property CompanyName: String read sCompanyName write SetCompanyName;
property InternalName: String read sInternalName write SetInternalName;
property LegalTrademarks: String read sLegalTrademarks write SetLegalTrademarks;
property OriginalFilename: String read sOriginalFilename write SetOriginalFilename;
property ProductName: String read sProductName write SetProductName;
property ProductVersion: String read sProductVersion write SetProductVersion;
property Language: String read sLanguage write SetLanguage;
property AllItems: TStrings read slAllItems write SetAllItems;
{ Published declarations }
end;
procedure Register;
implementation
// simply change this to register to a different location
procedure Register;
begin
RegisterComponents('Tools', [TProjInfo]);
end;
// constructor - creates the needed items
constructor TProjInfo.Create(AOwner: TComponent);
begin
sFileName := '';
slAllItems := TStringList.create;
inherited create(Aowner);
end;
// set the exename property
procedure TProjInfo.SetFileName(exename : string);
begin
if fileexists(exename) then
begin
sFileName := exename;
end
else
begin
sFileName := '';
end;
end;
{**********************************************}
{** set the various properties **}
{**********************************************}
procedure TProjInfo.SetFileVersion(ver: string);
begin
sFileVersion := ver;
end;
procedure TProjInfo.SetFileDescription(desc : string);
begin
sFileDescription := desc;
end;
procedure TProjInfo.SetLegalCopyright(cr : string);
begin
sLegalCopyright := cr;
end;
procedure TProjInfo.SetComments(cmt : string);
begin
sComments := cmt;
end;
procedure TProjInfo.SetCompanyName(cn : string);
begin
sCompanyName := cn;
end;
procedure TProjInfo.SetInternalName(intn : string);
begin
sInternalName := intn;
end;
procedure TProjInfo.SetLegalTrademarks(tm : string);
begin
sLegalTrademarks := tm;
end;
procedure TProjInfo.SetOriginalFilename(ofn : string);
begin
sOriginalFilename := ofn;
end;
procedure TProjInfo.SetProductName(pn : string);
begin
sProductName := pn;
end;
procedure TProjInfo.SetProductVersion(pv : string);
begin
sProductVersion := pv;
end;
procedure TProjInfo.SetLanguage(lang : string);
begin
sLanguage := lang;
end;
procedure TProjInfo.SetAllItems(items : Tstrings);
begin
slAllItems.AddStrings(items);
end;
// execute method
procedure TProjInfo.execute;
var alist: TStrings;
begin
alist := TStringList.create;
getversioninfo(alist); // stores the version information into the stringlist
// only do if information obtained
if alist.count 0 then
begin
setfileversion(alist.values[CInfoStr[1]]);
SetFileDescription(alist.values[CInfoStr[2]]);
setLegalCopyright(alist.values[CInfoStr[3]]);
SetComments(alist.values[CInfoStr[4]]);
SetCompanyName(alist.values[CInfoStr[5]]);
SetComments(alist.values[CInfoStr[6]]);
SetLegalTrademarks(alist.values[CInfoStr[7]]);
SetOriginalFilename(alist.values[CInfoStr[8]]);
SetProductName(alist.values[CInfoStr[9]]);
SetProductVersion(alist.values[CInfoStr[10]]);
SetLanguage(alist[1]);
SetAllItems(alist);
end;
alist.free;
end;
procedure TProjInfo.GetVersionInfo(AVersionList: TStrings);
// all version information items
type
PTransBuffer = ^TTransBuffer;
TTransBuffer = array[1..4] of smallint;
var
transStr,
typeStr,
filename,
language : string;
i : integer;
ptrans : PTransBuffer;
value : PChar;
verBuf : pointer;
infoSize,
verSize,
wnd : DWORD;
begin
// clear the list
AVersionList.Clear;
// get application information
filename := sFileName;
infoSize := GetFileVersioninfoSize(PChar(filename), wnd);
// if information exists . . .
if infoSize 0 then
begin
GetMem(verBuf, infoSize);
try
if GetFileVersionInfo(PChar(filename), wnd, infoSize, verBuf) then
begin
VerQueryvalue(verBuf, PChar('\VarFileInfo\Translation'),
Pointer(ptrans), verSize);
transStr := IntToHex(ptrans^[1], 4) + IntToHex(ptrans^[2], 4);
// loop through all version information
for i := Low(CInfoStr) to High(CInfoStr) do
begin
typeStr := 'StringFileInfo\' + transStr + '\' + CInfoStr[i];
// get information and store into list
if VerQueryvalue(verBuf, PChar(typeStr),Pointer(value), verSize) then
// use this if you wish to add the title
//AVersionList.Add(CInfoStr[i] + ': ' + value);
// AVersionList.Add(value);
AVersionList.Values[CInfoStr[i]] := value;
end;
// only add language if the rest completed sucessfully
if AVersionList.Count 0 then
begin
SetLength(language, 256);
// get language info and convert to string
VerLanguageName(ptrans^[1], PChar(language), 256);
SetLength(language, StrLen(PChar(language)));
// use this if you wish to add the title
// AVersionList.Add('Language: ' + language);
AVersionList.Add(language);
end;
end;
finally
// memory cleanup
FreeMem(verBuf);
end;
end;
end;
// thus endeth the component and all the code contained therein.
end.
]]>