procedure TForm1.GetVersionInfo;
const
  n_Info = 10;
  InfoStr : array [1..n_Info] of String =
    (''CompanyName'', ''FileDescription'', ''FileVersion'', ''InternalName'',
     ''LegalCopyright'', ''LegalTradeMarks'', ''OriginalFilename'',
     ''ProductName'', ''ProductVersion'', ''Comments'');
var
  Info      : String;
  BuffSize,
  Len, i    : Integer;
  Buff      : PChar;
  Value     : PChar;
begin
  Info := Application.ExeName;   
  BuffSize := GetFileVersionInfoSize(PChar(Info),BuffSize);
  if BuffSize > 0 then  
  begin
    Buff := AllocMem(BuffSize);
    Memo1.Lines.Add(''FileVersionInfoSize=''+IntToStr(BuffSize));
    GetFileVersionInfo(PChar(Info),0,BuffSize,Buff);
    Info := Info + '':'';
    for i := 1 to n_Info do
      if VerQueryValue(Buff,PChar(''StringFileInfo\040904E4\''+
                       InfoStr[i]), Pointer(Value), Len) then
        Info := Info + #13 + InfoStr[i] + ''='' + Value;
    FreeMem(Buff,BuffSize);
    ShowMessage (Info);
  end
  else
    ShowMessage (''No FileVersionInfo found'');
end;