Option Compare Database
Option Explicit

'ファイルのバージョン情報を取得
Type VS_FIXEDFILEINFO
    dwSignature As Long         '&HFEEFO4BD
    dwStrucVersion As Long      '構造体のﾊﾞｰｼﾞｮﾝ番号(例：&H00000042 の時、0.42)
    dwFileVersionMS As Long     'ﾌｧｲﾙのﾊﾞｰｼﾞｮﾝ番号(&H00030075 の時、3.75)
    dwFileVersionLS As Long     '同、(&H00000031 の時、0.31)
    dwProductVersionMS As Long  'ﾌﾟﾛﾀﾞｸﾄのﾊﾞｰｼﾞｮﾝ番号(&H00030010 の時、3.10)
    dwProductVersionLS As Long  '
    dwFileFlagsMask As Long     '= 0x3F for version "0.42"
    dwFileFlags As Long         'VS_FF_xxx
    dwFileOS As Long            'VOS_xxx
    dwFileType As Long          'VFT_xxx
    dwFileSubtype As Long       'VFT2_xxx
    dwFileDateMS As Long        '0
    dwFileDateLS As Long        '0
End Type
Declare Function GetFileVersionInfo Lib "VERSION" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwHandle As Long, ByVal dwLen As Long, lpData As Any) As Long
Declare Function GetFileVersionInfoSize Lib "VERSION" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Declare Function VerQueryValue Lib "VERSION" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Long, puLen As Long) As Long
Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Dest As Any, Source As Any, ByVal length&)

'WindowsSystemディレクトリを取得
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'ロケール情報を取得
'戻り値      正常＝lpLCDataの有功文字数
'           エラー＝0
Declare Function GetLocaleInfo Lib "kernel32" Alias "GetLocaleInfoA" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long
Public Const LOCALE_SDATE = &H1D            '  date separator
Public Const LOCALE_STIME = &H1E            '  time separator
Public Const LOCALE_SSHORTDATE = &H1F       '  short date format string
Public Const LOCALE_SLONGDATE = &H20        '  long date format string
Public Const LOCALE_STIMEFORMAT = &H1003    '  time format string
Public Const LOCALE_IDATE = &H21            '  short date format ordering
Public Const LOCALE_ILDATE = &H22           '  long date format ordering
Public Const LOCALE_ITIME = &H23            '  time format specifier
Public Const LOCALE_ICENTURY = &H24         '  century format specifier
Public Const LOCALE_ITLZERO = &H25          '  leading zeros in time field
Public Const LOCALE_IDAYLZERO = &H26        '  leading zeros in day field
Public Const LOCALE_IMONLZERO = &H27        '  leading zeros in month field
Public Const LOCALE_S1159 = &H28            '  AM designator
Public Const LOCALE_S2359 = &H29            '  PM designator
Public Const LocaleId_JPN = &H411           '  日本語のLocaleId  米英語のLocaleIdは &H409

Function GetVer(wFileName As String, outProductVer As String) As String
    Dim rc As Long
    Dim lpData() As Byte, dwLen As Long
    Dim VFI As VS_FIXEDFILEINFO
    Dim lplpBuffer As Long, puLen As Long, w1 As String, w2 As String, w3 As String, w4 As String
    
    outProductVer = ""
    'バージョン情報のバイト数を得る
    dwLen = GetFileVersionInfoSize(wFileName, 0)
    
    'バージョン情報がないとき
    If dwLen < 1 Then Exit Function
    
    'バージョン情報を受け取るバイト配列を確保
    ReDim lpData(dwLen - 1) As Byte
    
    'VS_FIXEDFILEINFO 構造体を含むバージョン情報を取得する
    rc = GetFileVersionInfo(wFileName, 0, dwLen, lpData(0))
    
    'VS_FIXEDFILEINFO 構造体へのポインタとバイト数を得る
    rc = VerQueryValue(lpData(0), "\", lplpBuffer, puLen)
    
    'ポインタから構造体にコピー
    Call MoveMemory(VFI, ByVal lplpBuffer, puLen)
    w1 = Hex(VFI.dwFileVersionMS)
    w2 = "." & Format(Val("&H" & Right$(w1, 4)), "#00")
    w1 = Trim$(Str$(Val("&H" & Left$(w1, Len(w1) - 4))))
    w3 = Hex(VFI.dwFileVersionLS)
    w4 = "." & Format(Val("&H" & Right$(w3, 4)), "#00")
    If Len(w3) > 4 Then
        w3 = Format(Val("&H" & Left$(w3, Len(w3) - 4)), "####")
        If w3 > "" Then w3 = "." & w3
    Else
        w3 = ""
    End If
    GetVer = w1 & w2 & w3 & w4
    w1 = Hex(VFI.dwProductVersionMS)
    w2 = "." & Format(Val("&H" & Right$(w1, 4)), "#00")
    w1 = Trim$(Str$(Val("&H" & Left$(w1, Len(w1) - 4))))
    w3 = Hex(VFI.dwProductVersionLS)
    w4 = "." & Format(Val("&H" & Right$(w3, 4)), "#00")
    If Len(w3) > 4 Then
        w3 = Format(Val("&H" & Left$(w3, Len(w3) - 4)), "####")
        If w3 > "" Then w3 = "." & w3
    Else
        w3 = ""
    End If
    outProductVer = w1 & w2 & w3 & w4
End Function

'WindowsSystemディレクトリを取得
Function LsGetSystemDirectory() As String
    Dim Gwdvar As String, Gwdvar_Length As Long
    Gwdvar = Space(255)
    Gwdvar_Length = GetSystemDirectory(lpBuffer:=Gwdvar, nSize:=255)
    LsGetSystemDirectory = Trim$(Left$(Gwdvar, Gwdvar_Length))
End Function