unit Versioninfo;
interface
uses
Types,windows,SysUtils, Dialogs;
type
TVersionInfo=class
private
FStandardKeys:
array[0..9]
of String;
VersionInfo:
String;
// Wird zum speichern der VersionsInfo benötigt.
// Ist das der richtige Typ?
function GetVersioninfo(
Index: Integer):
String;
function GetKey(KeyName:
String):
String;
procedure SetVersionInfo(
const Index: Integer;
const Value:
String);
function GetBuildNumber:
String;
public
constructor Create (ThisSourceFile:
String);
destructor Destroy;
override;
property Key[KeyName:
String]:
String read GetKey;
property CompanyName:
String index 0
read GetVersionInfo
write SetVersionInfo;
property FileDescription:
String index 1
read GetVersionInfo;
property FileVersion:
String index 2
read GetVersionInfo;
property InternalName:
String index 3
read GetVersionInfo;
property Copyright:
String index 4
read GetVersionInfo;
property TradeMarks:
String index 5
read GetVersionInfo;
property OriginalFileName:
String index 6
read GetVersionInfo;
property ProductName:
String index 7
read GetVersionInfo
write SetVersionInfo;
property ProductVersion:
String index 8
read GetVersionInfo
write SetVersionInfo;
property Comments:
String index 9
read GetVersionInfo;
property BuildNumber:
String read GetBuildNumber;
end;
implementation
{ TVersionInfo }
const
MaxVersionKeys= 9;
var
InfoAvailable: Boolean;
// Application.Exename
constructor TVersionInfo.Create(ThisSourceFile:
String);
const
VersionkeyNames:
array[0..MaxVersionKeys]
of String = ('
CompanyName',
'
FileDescription','
FileVersion','
InternalName','
Copyright','
TradeMarks',
'
OriginalFileName','
ProductName','
ProductVersion','
Comments');
var
ThisInfo: Integer;
InfoLength: UINT;
Len,
Handle: DWord;
PCharset: PLongint;
LangCharset:
String;
dummy: LongBool;
begin
inherited Create;
// Get size of version info
Len:= GetFileVersionInfoSize(PChar(ThisSourceFile),
Handle);
// Allocate VersionInfo buffer size. Größe in Byte. Ist das richtig?
SetLength(VersionInfo, Len+1);
//Get version info. Dies scheint nicht richtig zu funktionieren. Ergibt zwar true, die Infor-
// mationen, aus 'Getkey' ermittelt, bleiben aber leer...
if GetFileVersionInfo(PChar(ThisSourceFile),
Handle,Len,Pointer(VersionInfo))
then
begin
dummy:= VerQueryValue(Pointer(VersionInfo),'
\VarFileInfo\Translation',
Pointer(PCharSet),Len);
if dummy
then
begin
LangCharset:= Format('
%.4x%.4x',[LoWord(PCharset^),HiWord(PCharset^)]);
InfoAvailable:= true;
for ThisInfo:=0
to MaxVersionKeys
do
begin
FStandardKeys[ThisInfo]:= GetKey(VersionKeyNames[ThisInfo]);
end;
end;
end;
end;
destructor TVersionInfo.Destroy;
begin
inherited;
end;
function TVersionInfo.GetBuildNumber:
String;
begin
end;
function TVersionInfo.GetKey(KeyName:
String):
String;
var
InfoLength: UINT;
LangCharSet:
String;
begin
if InfoAvailable
then
begin
SetLength(Result, 255);
// liefert immer false. Habe ich die falschen Parameter?
if VerQueryValue(Pointer(VersionInfo),PChar(KeyName),Pointer(result), InfoLength)
then
begin
SetString(Result,PChar(Result),InfoLength-1);
end
else begin
result:='
'
end;
end
else begin
result:= '
N/A';
end;
end;
function TVersionInfo.GetVersioninfo(
Index: Integer):
String;
begin
result:= FStandardKeys[
Index]
end;
procedure TVersionInfo.SetVersionInfo(
const Index: Integer;
const Value:
String);
begin
FStandardKeys[
Index]:= Value;
end;
end.