[バージョン番号を取得する]

実行ファイルのバージョン番号等の情報を取得します。
但し、ＷＩＮプログラムのみ対応しており、ＤＯＳプログラムの情報が取得できません。

program tips0004;
{$APPTYPE CONSOLE}
uses  Windows, SysUtils;
type
  TVerResourceKey = (
        vrComments,         // コメント
        vrCompanyName,      // 会社名
        vrFileDescription,  // 説明
        vrFileVersion,      // ファイルバージョン
        vrInternalName,     // 内部名
        vrLegalCopyright,   // 著作権
        vrLegalTrademarks,  // 商標
        vrOriginalFilename, // 正式ファイル名
        vrPrivateBuild,     // プライベートビルド情報
        vrProductName,      // 製品名
        vrProductVersion,   // 製品バージョン
        vrSpecialBuild);     // スペシャルビルド情報

const
  KeyWordStr: array [TVerResourceKey] of String = (
        'Comments',
        'CompanyName',
        'FileDescription',
        'FileVersion',
        'InternalName',
        'LegalCopyright',
        'LegalTrademarks',
        'OriginalFilename',
        'PrivateBuild',
        'ProductName',
        'ProductVersion',
        'SpecialBuild');

// バージョン情報を取得
function GetVersionInfo(FileName:string; KeyWord: TVerResourceKey): string;
const
  Translation = '\VarFileInfo\Translation';
  FileInfo = '\StringFileInfo\%0.4s%0.4s\';
var
  BufSize, HWnd: DWORD;
  VerInfoBuf: Pointer;
  VerData: Pointer;
  VerDataLen: Longword;
  PathLocale: String;
  str:string;
begin

  BufSize := GetFileVersionInfoSize(PChar(FileName), HWnd);
  if BufSize <> 0 then
  begin
    GetMem(VerInfoBuf, BufSize);
    try
      GetFileVersionInfo(PChar(FileName), 0, BufSize, VerInfoBuf);
      VerQueryValue(VerInfoBuf, PChar(Translation), VerData, VerDataLen);
      if not (VerDataLen > 0) then
        raise Exception.Create('情報の取得に失敗しました');
      PathLocale := Format(FileInfo + KeyWordStr[KeyWord],
        [IntToHex(Integer(VerData^) and $FFFF, 4),
         IntToHex((Integer(VerData^) shr 16) and $FFFF, 4)]);
      VerQueryValue(VerInfoBuf, PChar(PathLocale), VerData, VerDataLen);
      if VerDataLen > 0 then
      begin
        result := '';
        SetLength(result, VerDataLen);
        StrLCopy(PChar(result), VerData, VerDataLen);
      end;
    finally
      FreeMem(VerInfoBuf);
    end;
  end;
end;

var
FileName:string;
begin
  FileName:='C:\WINDOWS\notepad.exe';
  writeLn('ファイル名　　　　　　：',FileName);
  writeLn('コメント　　　　　　　：',GetVersionInfo(FileName,vrComments));         // コメント
  writeLn('会社名　　　　　　　　：',GetVersionInfo(FileName,vrCompanyName));      // 会社名
  writeLn('説明　　　　　　　　　：',GetVersionInfo(FileName,vrFileDescription));  // 説明
  writeLn('ファイルバージョン　　：',GetVersionInfo(FileName,vrFileVersion));      // ファイルバージョン
  writeLn('内部名　　　　　　　　：',GetVersionInfo(FileName,vrInternalName));     // 内部名
  writeLn('商標　　　　　　　　　：',GetVersionInfo(FileName,vrLegalCopyright));   // 著作権
  writeLn('商標　　　　　　　　　：',GetVersionInfo(FileName,vrLegalTrademarks));  // 商標
  writeLn('正式ファイル名　　　　：',GetVersionInfo(FileName,vrOriginalFilename)); // 正式ファイル名
  writeLn('プライベートビルド情報：',GetVersionInfo(FileName,vrPrivateBuild));     // プライベートビルド情報
  writeLn('製品名　　　　　　　　：',GetVersionInfo(FileName,vrProductName));      // 製品名
  writeLn('製品バージョン　　　　：',GetVersionInfo(FileName,vrProductVersion));   // 製品バージョン
  writeLn('スペシャルビルド情報　：',GetVersionInfo(FileName,vrSpecialBuild));     // スペシャルビルド情報

  writeLn('');

  FileName:=paramstr(0);
  writeLn('ファイル名　　　　　　：',FileName);
  writeLn('コメント　　　　　　　：',GetVersionInfo(FileName,vrComments));         // コメント
  writeLn('会社名　　　　　　　　：',GetVersionInfo(FileName,vrCompanyName));      // 会社名
  writeLn('説明　　　　　　　　　：',GetVersionInfo(FileName,vrFileDescription));  // 説明
  writeLn('ファイルバージョン　　：',GetVersionInfo(FileName,vrFileVersion));      // ファイルバージョン
  writeLn('内部名　　　　　　　　：',GetVersionInfo(FileName,vrInternalName));     // 内部名
  writeLn('商標　　　　　　　　　：',GetVersionInfo(FileName,vrLegalCopyright));   // 著作権
  writeLn('商標　　　　　　　　　：',GetVersionInfo(FileName,vrLegalTrademarks));  // 商標
  writeLn('正式ファイル名　　　　：',GetVersionInfo(FileName,vrOriginalFilename)); // 正式ファイル名
  writeLn('プライベートビルド情報：',GetVersionInfo(FileName,vrPrivateBuild));     // プライベートビルド情報
  writeLn('製品名　　　　　　　　：',GetVersionInfo(FileName,vrProductName));      // 製品名
  writeLn('製品バージョン　　　　：',GetVersionInfo(FileName,vrProductVersion));   // 製品バージョン
  writeLn('スペシャルビルド情報　：',GetVersionInfo(FileName,vrSpecialBuild));     // スペシャルビルド情報

end.

dcc32 tips0004.pas 
tips0004.exe > tips0004.txt
pause

ファイル名　　　　　　：C:\WINDOWS\notepad.exe
コメント　　　　　　　：
会社名　　　　　　　　：Microsoft Corporation 
説明　　　　　　　　　：Notepad 
ファイルバージョン　　：5.1.2600.5512 (xpsp.080413-2105) 
内部名　　　　　　　　：Notepad 
商標　　　　　　　　　：(C) Microsoft Corporation. All rights reserved. 
商標　　　　　　　　　：
正式ファイル名　　　　：NOTEPAD.EXE 
プライベートビルド情報：
製品名　　　　　　　　：Microsoft(R) Windows(R) Operating System 
製品バージョン　　　　：5.1.2600.5512 
スペシャルビルド情報　：

ファイル名　　　　　　：C:\Documents and Settings\Administrator\My Documents\delphi tips\tips0004.exe
コメント　　　　　　　：
会社名　　　　　　　　：
説明　　　　　　　　　：
ファイルバージョン　　：
内部名　　　　　　　　：
商標　　　　　　　　　：
商標　　　　　　　　　：
正式ファイル名　　　　：
プライベートビルド情報：
製品名　　　　　　　　：
製品バージョン　　　　：
スペシャルビルド情報　：