function GetAppVersionInfo(const Plik: string): string;
var
VerSize: integer;
VerBuf: PChar;
VerBufValue: pointer;
VerHandle: cardinal;
VerBufLen: cardinal;
VerKey: string;
function GetInfo(ThisKey: string): string;
begin
Result := '';
VerKey := '\StringFileInfo\' + IntToHex(loword(integer(VerBufValue^)), 4) +
IntToHex(hiword(integer(VerBufValue^)), 4) + '\' + ThisKey;
if VerQueryValue(VerBuf, PChar(VerKey), VerBufValue, VerBufLen) then
Result := StrPas(VerBufValue);
end;
function QueryValue(ThisValue: string): string;
begin
Result := '';
if GetFileVersionInfo(PChar(Plik), VerHandle, VerSize, VerBuf) and
VerQueryValue(VerBuf, '\VarFileInfo\Translation', VerBufValue, VerBufLen) then
Result := GetInfo(ThisValue);
end;
begin
VerSize := GetFileVersionInfoSize(PChar(Plik), VerHandle);
VerBuf := AllocMem(VerSize);
try
Result := QueryValue('CompanyName');
{
QueryValue('CompanyName');
QueryValue('FileDescription');
QueryValue('FileVersion');
QueryValue('InternalName');
QueryValue('LegalCopyRight');
QueryValue('LegalTradeMark');
QueryValue('OriginalFileName');
QueryValue('ProductName');
QueryValue('ProductVersion');
QueryValue('Comments');
}
finally
FreeMem(VerBuf, VerSize);
end;
end;
// wywołanie
procedure TForm2.Button1Click(Sender: TObject);
begin
ShowMessage(GetAppVersionInfo('C:\Windows\explorer.exe'));
end;
// wrzuć to proszę do gotowców albo do faq, o ile tego tam jeszcze nie ma... dzięki! - Ł
// niestety nie mogę, albo nie potrafię dodać do Gotowców ;/ - Opi