サンプル投稿用掲示板 VB2005 〜 用トップページ VB6.0 用 トップページ
- 日時： 2009/12/26 22:57
- 名前： 花ちゃん
- ***********************************************************************************
* カテゴリー：[他のアプリ関係][システム関係][] *
* キーワード：バージョン情報,,,,, *
***********************************************************************************
元質問：バージョン情報の取得 - Nemo 2006/09/18-18:37 No.7264
外部のDLLやEXEファイルのバージョン情報を取得したいのですが、
WinAPIのGetFileVersionInfo等を使っても変な数値しか取得出来ません。
-----------------------------------------------------------------------------------
Re^3: バージョン情報の取得 - Blue 2006/09/19-02:05 No.7267
-----------------------------------------------------------------------------------
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
Private 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
 |
