投稿日	： 2006/09/19(Tue) 02:05
投稿者	： Blue
Ｅメール	：
ＵＲＬ	：
タイトル	： Re^3: バージョン情報の取得

Option Explicit

Type CODEPAGE
    lngLOW As Integer
    lngHIGH As Integer
End Type

Private Declare Function GetFileVersionInfoSize Lib "version" Alias "GetFileVersionInfoSizeA" ( _
    ByVal lptstrFilename As String, ByRef lpdwHandle As Long) As Long
Private Declare Function GetFileVersionInfo Lib "version" Alias "GetFileVersionInfoA" ( _
    ByVal lptstrFilename As String, ByVal dwHandle As Long, _
    ByVal dwLen As Long, ByRef lpData As Byte) As Long
Private Declare Function VerQueryValue Lib "version" Alias "VerQueryValueA" ( _
    ByRef pBlock As Byte, ByVal lpSubBlock As String, _
    ByRef lplpBuffer As Long, ByRef puLen As Long) As Long
Private Declare Function MoveMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Dest As Any, ByRef Src As Any, ByVal size As Long) As Long
    Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    Destination As Any, Source As Any, ByVal Length As Long)

Public Sub GetFileVersion(ByVal path As String)
    Dim size     As Long
    Dim dummy    As Long
    Dim vi()     As Byte
    Dim subblock As String
    Dim pointa   As Long
    Dim cp       As CODEPAGE
    Dim buff()   As Byte
    Dim verstr   As String
    
    ' バージョンリソースのサイズを取得
    size = GetFileVersionInfoSize(path, dummy)
    If size < 1 Then
        Exit Sub
    End If
    ' バージョンリソースを取得
    ReDim vi(size)
    If GetFileVersionInfo(path, 0&, size, vi(0)) = 0 Then
        Exit Sub
    End If
    ' バージョンリソースの言語情報を取得
    subblock = "\VarFileInfo\Translation"
    If VerQueryValue(vi(0), subblock, pointa, size) = 0 Then
        Exit Sub
    End If
    CopyMemory cp, ByVal pointa, size
    ' 製品バージョンを取得
    subblock = "\StringFileInfo\" & Right$("0000" & Hex(cp.lngLOW), 4) & Right$("0000" & Hex(cp.lngHIGH), 4) & "\ProductVersion"
    If VerQueryValue(vi(0), subblock, pointa, size) = 0 Then
        Exit Sub
    End If
    ReDim buff(size)
    CopyMemory buff(0), ByVal pointa, size ' Shift_JIS文字列
    verstr = StrConv(buff, vbUnicode)      ' Unicode変換
    verstr = Left(verstr, InStr(verstr, vbNullChar) - 1)  ' 末尾のNULL文字削除
    
    MsgBox verstr
    
End Sub

参考:ファイルのバージョン情報を取得する(VC++)
http://katsura-kotonoha.sakura.ne.jp/prog/win/tip00019.shtml

★ - バージョン情報の取得 - Nemo 09/18-18:37No.7264
• Re: バージョン情報の取得 - Blue 09/18-23:59 No.7265
  • Re^2: バージョン情報の取得 - Nemo 09/19-00:40 No.7266
    • Re^3: バージョン情報の取得 - Blue 09/19-02:05 No.7267
    • Re^3: バージョン情報の取得 - Blue 09/19-02:48 No.7268
      • 解決 - Nemo 09/19-05:36 No.7269
        • Re: 解決 - Blue 09/19-09:16 No.7270