unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private 宣言 }
    InitDir : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  SysUtils.GetFileVersion によるファイルバージョンの取得
//  GetFileVersionの値をそのまま表示
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FileFullPath : String;
  aVersion     : Cardinal;
  StrText      : String;
begin
  if InitDir = EmptyStr then begin
    InitDir := ExpandFileName('../');
  end;

  OpenDialog1.InitialDir := InitDir;
  OpenDialog1.Filter     := 'ファイル|*.exe;*.dll';

  if OpenDialog1.Execute then begin
    FileFullPath := OpenDialog1.FileName;
    InitDir      := ExtractFileDir(FileFullPath);

    //ファイルのバージョンを取得
    aVersion := SysUtils.GetFileVersion(FileFullPath);

    StrText := ExtractFileName(FileFullPath) + sLineBreak + IntToStr(aVersion);
    MessageBox(Handle, PChar(StrText), '情報', MB_ICONINFORMATION);
  end;
end;

//=============================================================================
//  SysUtils.GetFileVersion によるファイルバージョンの取得
//  GetFileVersionの値からメジャーとマイナーバージョンの値を計算
//=============================================================================
procedure TForm1.Button2Click(Sender: TObject);
var
  FileFullPath : String;
  aVersion     : Cardinal;
  MajorVersion : Cardinal;
  MinorVersion : Cardinal;
  StrText      : String;
begin
  if InitDir = EmptyStr then begin
    InitDir := ExpandFileName('../');
  end;

  OpenDialog1.InitialDir := InitDir;
  OpenDialog1.Filter     := 'ファイル|*.exe;*.dll';

  if OpenDialog1.Execute then begin
    FileFullPath := OpenDialog1.FileName;
    InitDir      := ExtractFileDir(FileFullPath);

    //ファイルのバージョンを取得
    aVersion     := SysUtils.GetFileVersion(FileFullPath);
    //メジャーとマイナーバージョンの値を計算
    MajorVersion := aVersion shr 16;
    MinorVersion := aVersion and $FFFF;

    StrText := ExtractFileName(FileFullPath) + sLineBreak
             + Format('%d.%d', [MajorVersion, MinorVersion]);
    MessageBox(Handle, PChar(StrText), '情報', MB_ICONINFORMATION);
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    InitDir : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Scripting_TLB;

{$R *.dfm}

//=============================================================================
//  IFileSystem の GetFileVersion によるファイルバージョンの取得
//  タイプライブラリの取り込みで作成したScripting_TLB.pasを利用
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FileFullPath   : String;
  objFileSystem3 : Scripting_TLB.IFileSystem3;
  strVersion     : String;
  StrText        : String;
begin
  if InitDir = EmptyStr then begin
    InitDir := ExpandFileName('../');
  end;

  OpenDialog1.InitialDir := InitDir;
  OpenDialog1.Filter     := 'ファイル|*.exe;*.dll';

  if OpenDialog1.Execute then begin
    FileFullPath := OpenDialog1.FileName;
    InitDir      := ExtractFileDir(FileFullPath);

    //GetFileVerstionというメソッドがIFileSystem3にあるのでそのオブジェクトを生成
    objFileSystem3 := CoFileSystemObject.Create;
    try
      //ファイルのバージョン文字列を取得して表示
      strVersion := objFileSystem3.GetFileVersion(FileFullPath);

      StrText := ExtractFileName(FileFullPath) + sLineBreak + strVersion;
      MessageBox(Handle, PChar(StrText), '情報', MB_ICONINFORMATION);
    finally
      objFileSystem3 := nil;
    end;
  end;
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    OpenDialog1: TOpenDialog;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    InitDir : String;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

uses Shell32_TLB, Generics.Collections;

{$R *.dfm}

//=============================================================================
//  TShell を使用したバージョン情報の取得
//  Windows XPでは動作不可
//
//  ジェネリックスが使用できないDelphiではTList,整数配列等を使用する
//  for in do が使用できないDelphiではfor to do を使用しする
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FileFullPath : String;
  SHShell      : Shell32_TLB.TShell;
  SHFolder     : Shell32_TLB.Folder;
  SHFolderItem : Shell32_TLB.FolderItem;
  IntList      : TList<Integer>;
  ItemNo       : Integer;
  strItem      : String;
  StrText      : String;
begin
  if InitDir = EmptyStr then begin
    InitDir := ExpandFileName('../');
  end;

  OpenDialog1.InitialDir := InitDir;
  OpenDialog1.Filter     := 'ファイル|*.exe;*.dll';

  if OpenDialog1.Execute then begin
    FileFullPath := OpenDialog1.FileName;
    InitDir      := ExtractFileDir(FileFullPath);

    SHShell      := TShell.Create(Self);
    try
      //フォルダオブジェクトを取得
      //そのフォルダ内のファイルをフォルダオブジェクトのItemとして取得
      SHFolder     := SHShell.NameSpace(ExtractFileDir(FileFullPath));
      SHFolderItem := SHFolder.ParseName(ExtractFileName(FileFullPath));

      Memo1.Lines.Clear;

      IntList := TList<Integer>.Create;
      try
        //整数型配列に取得する項目の値を格納
        IntList.Add(0);    //名前
        IntList.Add(25);   //著作連
        IntList.Add(156);  //ファイルバージョン
        IntList.Add(270);  //製品名
        IntList.Add(271);  //製品バージョン

        //格納した項目値から実際の項目名と値を取り出して表示
        for Itemno in IntList do begin
          strItem := SHFolder.GetDetailsOf(varNull, ItemNo);
          StrText := SHFolder.GetDetailsOf(SHFolderItem, ItemNo);
          Memo1.Lines.Add(strItem + '  : ' + StrText);
        end;
      finally
        IntList.Free;
      end;
    finally
      SHShell.Free;
    end;
  end;
end;

end.

\StringFileInfo\' + ロケール識別子の 16 進文字(4桁) + コードページの 16 進文字(4桁) + '\'

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Button1: TButton;
    Memo1: TMemo;
    OpenDialog1: TOpenDialog;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
    InitDir : String;
    function GetEXEDLLVersionInfo(FileName: string): Boolean;
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//=============================================================================
//  フォーム生成時の処理
//=============================================================================
procedure TForm1.FormCreate(Sender: TObject);
begin
  Memo1.Font.Name   := 'Courier New';
  Memo1.Font.Size   := 10;
  Memo1.WordWrap    := False;
  Panel1.Font := Memo1.Font;

  Panel1.Caption := '';
end;

//=============================================================================
//  アプリケーションのバージョン情報の取得
//=============================================================================
procedure TForm1.Button1Click(Sender: TObject);
var
  FileFullPath : String;
begin
  if InitDir = EmptyStr then begin
    InitDir := ExtractFileDir(Application.ExeName);
  end;

  OpenDialog1.InitialDir := InitDir;
  OpenDialog1.Filter     := 'ファイル|*.exe;*.dll';

  if OpenDialog1.Execute then begin
    FileFullPath := OpenDialog1.FileName;
    InitDir      := ExtractFileDir(FileFullPath);

    Memo1.Lines.Clear;
    Panel1.Caption := ExtractFileName(FileFullPath);

    //ファイルのバージョン情報等を取得して表示
    GetEXEDLLVersionInfo(FileFullPath);
  end;
end;

//-----------------------------------------------------------------------------
//  実際にアプリケーションのバージョン等の値を取得して表示するメソッド
//  引数はファイルのフルパス名
//-----------------------------------------------------------------------------
function TForm1.GetEXEDLLVersionInfo(FileName: string): Boolean;
type
  TLangAndCodePage = record
    wLanguage : WORD;
    wCodePage : WORD;
  end;
  PLangAndCodePage = ^TLangAndCodePage;

var
  dwHandle    : Cardinal;
  pInfo       : Pointer;
  pLangCode   : PLangAndCodePage;
  SubBlock    : String;
  InfoSize    : DWORD;
  pFileInfo   : Pointer;
  strList     : TStringList;
  KeyName     : String;
  StrText     : String;
begin
  Result := False;

  InfoSize := GetFileVersionInfoSize(PChar(FileName), dwHandle);
  if InfoSize = 0 then exit;

  GetMem(pInfo, InfoSize);
  try
    GetFileVersionInfo(PChar(FileName), 0, InfoSize, pInfo);

    //ロケール識別子とコードページを取得
    VerQueryValue(pInfo, '\VarFileInfo\Translation', Pointer(pLangCode), InfoSize);

    //上で取得した値を元に，
    //各種情報取得用に，VerQueryValue関数の第2引数で使用する文字列を作成
    SubBlock := IntToHex(pLangCode.wLanguage, 4) + IntToHex(pLangCode.wCodePage, 4);
    SubBlock := '\StringFileInfo\' + SubBlock + PathDelim;


    strList := TStringList.Create;
    try
      //取得する項目の名前を文字列配列に格納
      strList.Add(SubBlock + 'CompanyName');
      strList.Add(SubBlock + 'FileDescription');
      strList.Add(SubBlock + 'FileVersion');
      strList.Add(SubBlock + 'InternalName');
      strList.Add(SubBlock + 'LegalCopyright');
      strList.Add(SubBlock + 'LegalTrademarks');
      strList.Add(SubBlock + 'OriginalFilename');
      strList.Add(SubBlock + 'ProductName');
      strList.Add(SubBlock + 'ProductVersion');
      strList.Add(SubBlock + 'Comments');
      strList.Add(SubBlock + 'SpecialBuild');
      strList.Add(SubBlock + 'PrivateBuild');
      strList.Add(SubBlock + 'Sample-Number');


      //項目名に相当するメンバーの値を順番に取得
      for KeyName in strList do begin
        if VerQueryValue(pInfo,
                         PChar(KeyName),
                         Pointer(pFileInfo),
                         InfoSize) then begin

          StrText := Format('%-16s', [ExtractFileName(KeyName)]) + ' : ';
          Memo1.Lines.Add(StrText  + PChar(pFileInfo));
        end;
      end;
    finally
      strList.Free;
    end;

    Result := True;
  finally
    FreeMem(pInfo, InfoSize);
  end;
end;

end.

procedure TForm1.Button1Click(Sender: TObject);
var
  Value   : Cardinal;
  StrText : String;
begin
  //ロケール識別子の取得
  Value := GetUserDefaultLCID;

  StrText := '$' + IntToStr(Value) + ' ( ' + IntToHex(Value, 4) + ' )';
  MessageBox(Handle, PChar(StrText), '情報', MB_ICONINFORMATION);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Value   : Cardinal;
  StrText : String;
begin
  //コードページの取得
  Value := GetACP;

  StrText := IntToStr(Value) + ' ( $' + IntToHex(Value, 4) + ' )';
  MessageBox(Handle, PChar(StrText), '情報', MB_ICONINFORMATION);

  //コードページの取得
  Value := GetOEMCP;

  StrText := IntToStr(Value) + ' ( $' + IntToHex(Value, 4) + ' )';
  MessageBox(Handle, PChar(StrText), '情報', MB_ICONINFORMATION);
end;

//-----------------------------------------------------------------------------
//  [ファイルのバージョン]の文字列を取得する関数
//  [ファイルのバージョン]は，ファイルのプロパティダイアログで表示される値
//  引数はファイルのフルパス名
//-----------------------------------------------------------------------------
function GetFileVersionString(FileName: string): String;
var
  dwHandle  : Cardinal;
  pInfo     : Pointer;
  InfoSize  : DWORD;
  pFileInfo : PVSFixedFileInfo;
  iVer      : array[0..3] of Cardinal;
begin
  Result := '';

  InfoSize := GetFileVersionInfoSize(PChar(FileName), dwHandle);
  if InfoSize = 0 then exit;

  GetMem(pInfo, InfoSize);
  try
    GetFileVersionInfo(PChar(FileName), 0, InfoSize, pInfo);
    VerQueryValue(pInfo, PathDelim, Pointer(pFileInfo), InfoSize);

    iVer[0] := pFileInfo.dwFileVersionMS shr 16;
    iVer[1] := pFileInfo.dwFileVersionMS and $FFFF;
    iVer[2] := pFileInfo.dwFileVersionLS shr 16;
    iVer[3] := pFileInfo.dwFileVersionLS and $FFFF;
    Result := Format('%d.%d.%d.%d', [iVer[0], iVer[1], iVer[2], iVer[3]]);
  finally
    FreeMem(pInfo, InfoSize);
  end;
end;

#define VER_FILEVERSION          1,2,3,456
#define VER_FILEVERSION_STR     "1.2.3.456\0"
#define VER_PRODUCTVERSION      VER_FILEVERSION
#define VER_PRODUCTVERSION_STR  VER_FILEVERSION_STR

//以下の5行は，リソースコンパイラでコンパイルする際に必要
//プロジェクトに追加して使用する際には不要
//その場合，この後の定数名のプリフィックスのVER_を削除する
#define VER_FF_DEBUG              0x00000001L
#define VER_VS_FFI_FILEFLAGSMASK  0x0000003FL
#define VER_VOS__WINDOWS32        0x00000004L
#define VER_VFT_APP               0x00000001L
#define VER_VFT2_UNKNOWN          0x00000000L

#ifndef DEBUG
#define VER_DEBUG  0L
#else
#define VER_DEBUG  VS_FF_DEBUG
#endif


1 VERSIONINFO

FILEVERSION        VER_FILEVERSION
PRODUCTVERSION     VER_PRODUCTVERSION
FILEFLAGSMASK      VER_VS_FFI_FILEFLAGSMASK
FILEFLAGS          VER_DEBUG
FILEOS             VER_VOS__WINDOWS32
FILETYPE           VER_VFT_APP
FILESUBTYPE        VER_VFT2_UNKNOWN
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "041103A4"
    BEGIN
      VALUE "CompanyName",      "\0"
      VALUE "FileDescription",  "File Version Resource Test\0"
      VALUE "FileVersion",      VER_FILEVERSION_STR
      VALUE "InternalName",     "Project1.exe\0"
      VALUE "LegalCopyright",   "Copyright (c) 2014 Mr.XRAY\0"
      VALUE "OriginalFilename", "Project1.exe\0"
      VALUE "ProductName",      "Resource Test App\0"
      VALUE "ProductVersion",   VER_PRODUCTVERSION_STR
      VALUE "Sample-Number",    "[318][06]\0"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x411, 0x3A4
  END
END

program Project1;

{$R 'VersionTest.res' 'VersionTest.rc'}

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

    BLOCK "041103A4" --> BLOCK "000004B0" 

    VALUE "Translation", 0x411, 0x3A4 --> VALUE "Translation", 0x0, 1200

[BRCC32 エラー] VersionTest.rc(1): Expecting resource name or resource type name

#define VER_FILEVERSION          1,2,3,456
#define VER_FILEVERSION_STR     "1.2.3.456\0"
#define VER_PRODUCTVERSION      VER_FILEVERSION
#define VER_PRODUCTVERSION_STR  VER_FILEVERSION_STR

//以下の5行は，リソースコンパイラでコンパイルする際に必要
//プロジェクトに追加して使用する際には不要
//その場合，この後の定数名のプリフィックスのVER_を削除する
#define VER_FF_DEBUG              0x00000001L
#define VER_VS_FFI_FILEFLAGSMASK  0x0000003FL
#define VER_VOS__WINDOWS32        0x00000004L
#define VER_VFT_APP               0x00000001L
#define VER_VFT2_UNKNOWN          0x00000000L

#ifndef DEBUG
#define VER_DEBUG  0L
#else
#define VER_DEBUG  VS_FF_DEBUG
#endif


1 VERSIONINFO

FILEVERSION        VER_FILEVERSION
PRODUCTVERSION     VER_PRODUCTVERSION
FILEFLAGSMASK      VER_VS_FFI_FILEFLAGSMASK
FILEFLAGS          VER_DEBUG
FILEOS             VER_VOS__WINDOWS32
FILETYPE           VER_VFT_APP
FILESUBTYPE        VER_VFT2_UNKNOWN
BEGIN
  BLOCK "StringFileInfo"
  BEGIN
    BLOCK "041103A4"
    BEGIN
      VALUE "CompanyName",      "\0"
      VALUE "FileDescription",  L"バージョン情報リソース設定テスト\0"
      VALUE "FileVersion",      VER_FILEVERSION_STR
      VALUE "InternalName",     "Project1.exe\0"
      VALUE "LegalCopyright",   "Copyright (c) 2014 Mr.XRAY\0"
      VALUE "OriginalFilename", "Project1.exe\0"
      VALUE "ProductName",      "Resource Test App\0"
      VALUE "ProductVersion",   VER_PRODUCTVERSION_STR
      VALUE "Sample-Number",    "[318][07]\0"
    END
  END
  BLOCK "VarFileInfo"
  BEGIN
    VALUE "Translation", 0x411, 0x3A4
  END
END

program Project1;

{$R 'VersionTest.res'}  //追加

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1};

{$R *.res}

begin
  Application.Initialize;
  Application.MainFormOnTaskbar := True;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.