'================================================================
'= ファイルバージョン情報の取得
'=    (GetFileVersionInfo2.bas)
'================================================================
#include "Windows.bi"

#define VS_FFI_SIGNATURE &HFEEF04BD     '構造体の識別子
#define VS_FFI_STRUCVERSION &H10000     '構造体のバイナリバージョン番号 0x00000029以上の値
#define VS_FFI_FILEFLAGSMASK &H3F&      '
' dwFileFlags
#define VS_FF_DEBUG &H1                 'デバッグ情報が含まれている
#define VS_FF_PRERELEASE &H2            'ファイルは開発バージョン
#define VS_FF_PATCHED &H4               'ファイルは修正されたバージョン
#define VS_FF_PRIVATEBUILD &H8          '標準的なリリースされたファイルではない
#define VS_FF_INFOINFERRED &H10         '構造体は動的に作成されている
#define VS_FF_SPECIALBUILD &H20         '標準ファイルのバリエーション
' dwFileOS
#define VOS_UNKNOWN &H0                 '    
#define VOS_DOS &H10000                 'MS-DOS
#define VOS_OS216 &H20000               'OS/2 16ビット
#define VOS_OS232 &H30000               'OS/2 32ビット
#define VOS_NT &H40000                  'WindowsNT
#define VOS__BASE &H0
#define VOS__WINDOWS16 &H1
#define VOS__PM16 &H2
#define VOS__PM32 &H3
#define VOS__WINDOWS32 &H4
#define VOS_DOS_WINDOWS16 &H10001       'in16
#define VOS_DOS_WINDOWS32 &H10004       'Win32s
#define VOS_OS216_PM16 &H20002
#define VOS_OS232_PM32 &H30003
#define VOS_NT_WINDOWS32 &H40004        '設計対象となったOS
' dwFileType
#define VFT_UNKNOWN &H0
#define VFT_APP &H1                     'アプリケーション
#define VFT_DLL &H2                     'ダイナミックリンクライブラリ
#define VFT_DRV &H3                     'デバイスドライバ
#define VFT_FONT &H4                    'フォント
#define VFT_VXD &H5                     '仮想デバイス
#define VFT_STATIC_Lib &H7              'スタティックリンクライブラリ
’dwFileSubtype
#define VFT2_UNKNOWN &H0
#define VFT2_DRV_PRINTER &H1            'プリンタドライバ
#define VFT2_DRV_KEYBOARD &H2           'キーボードドライバ
#define VFT2_DRV_LANGUAGE &H3           '言語ドライバ
#define VFT2_DRV_DISPLAY &H4            'ディスプレイドライバ
#define VFT2_DRV_MOUSE &H5              'マウスドライバ
#define VFT2_DRV_NETWORK &H6            'ネットワークドライバ
#define VFT2_DRV_SYSTEM &H7             'ファイルはシステムドライバ
#define VFT2_DRV_INSTALLABLE &H8        'インストール可能なドライバ
#define VFT2_DRV_SOUND &H9              'サウンドドライバ
#define VFT2_DRV_COMM &HA

Type VS_FIXEDFILEINFO
   dwSignature         As Long
   dwStrucVersionl     As Integer
   dwStrucVersionh     As Integer
   dwFileVersionMSl    As Integer
   dwFileVersionMSh    As Integer
   dwFileVersionLSl    As Integer
   dwFileVersionLSh    As Integer
   dwProductVersionMSl As Integer
   dwProductVersionMSh As Integer
   dwProductVersionLSl As Integer
   dwProductVersionLSh As Integer
   dwFileFlagsMask     As Long
   dwFileFlags         As Long
   dwFileOS            As Long
   dwFileType          As Long
   dwFileSubType       As Long
   dwFileDateMS        As Long
   dwFileDateLS        As Long
End Type

' ファイルに関するバージョン情報を取得
Declare Function Api_GetFileVersionInfo& Lib "Version" Alias "GetFileVersionInfoA" (ByVal lptstrFilename$, ByVal dwhAndle&, ByVal dwlen&, lpData As Any)

' ファイルからバージョン情報を取得できるかどうかを判定
Declare Function Api_GetFileVersionInfoSize& Lib "Version" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename$, lpdwHAndle&)

' バージョン情報リソースから選択されたバージョン情報を取得
Declare Function Api_VerQueryValue& Lib "Version" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock$, lplpBuffer As Any, puLen&)

' メモリの指定領域をコピー
Declare Sub MoveMemory Lib "Kernel32" Alias "RtlMoveMemory" (Dest As Any, ByVal Source&, ByVal length&)

Var Shared Button1 As Object
Var Shared Text1 As Object
Var Shared Edit1 As Object
Var Shared Edit2 As Object

Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14
Edit2.Attach GetDlgItem("Edit2") : Edit2.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared Filename As String
Var Shared Directory As String
Var Shared FullFileName As String
Var Shared StrucVer As String
Var Shared FileVer As String
Var Shared ProdVer As String
Var Shared FileFlags As String
Var Shared FileOS As String
Var Shared FileType As String
Var Shared FileSubType As String

'================================================================
'=
'================================================================
Declare Sub DisplayVerInfo edecl ()
Sub DisplayVerInfo()
    Var lDummy As Long
    Var BuffLen As Long
    Var VerPointer As Long
    Var VerBuff As VS_FIXEDFILEINFO
    Var VerBuffLen As Long
    Var Ret As Long

    BuffLen = Api_GetFileVersionInfoSize(FileName, lDummy)
    If BuffLen < 1 Then
        Res = MessageBox("", "バージョン情報は有りません！", 0, 2)
        Exit Sub
    End If

    Var sBuffer(BuffLen) As Byte

    Ret = Api_GetFileVersionInfo(FileName, 0&, BuffLen, sBuffer(0))
    Ret = Api_VerQueryValue(sBuffer(0), "\", VerPointer, VerBuffLen)
    MoveMemory VerBuff, VerPointer, Len(VerBuff)

    StrucVer = Format$(VerBuff.dwStrucVersionh) & "." & Format$(VerBuff.dwStrucVersionl)
    FileVer = Format$(VerBuff.dwFileVersionMSh) & "." & Format$(VerBuff.dwFileVersionMSl) & "." & Format$(VerBuff.dwFileVersionLSh) & "." & Format$(VerBuff.dwFileVersionLSl)
    ProdVer = Format$(VerBuff.dwProductVersionMSh) & "." & Format$(VerBuff.dwProductVersionMSl) & "." & Format$(VerBuff.dwProductVersionLSh) & "." & Format$(VerBuff.dwProductVersionLSl)

    FileFlags = ""
    If VerBuff.dwFileFlags And VS_FF_DEBUG        Then FileFlags = "Debug "
    If VerBuff.dwFileFlags And VS_FF_PRERELEASE   Then FileFlags = FileFlags & "PreRel "
    If VerBuff.dwFileFlags And VS_FF_PATCHED      Then FileFlags = FileFlags & "Patched "
    If VerBuff.dwFileFlags And VS_FF_PRIVATEBUILD Then FileFlags = FileFlags & "Private "
    If VerBuff.dwFileFlags And VS_FF_INFOINFERRE  Then FileFlags = FileFlags & "Info "
    If VerBuff.dwFileFlags And VS_FF_SPECIALBUILD Then FileFlags = FileFlags & "Special "
    If VerBuff.dwFileFlags And VFT2_UNKNOWN       Then FileFlags = FileFlags & "Unknown "

    Select Case VerBuff.dwFileOS
        Case VOS_DOS_WINDOWS16
            FileOS = "DOS-Win16"
        Case VOS_DOS_WINDOWS32
            FileOS = "DOS-Win32"
        Case VOS_OS216_PM16
            FileOS = "OS/2-16 PM-16"
        Case VOS_OS232_PM32
            FileOS = "OS/2-16 PM-32"
        Case VOS_NT_WINDOWS32
            FileOS = "NT-Win32"
        Case other
            FileOS = "Unknown"
    End Select

    Select Case VerBuff.dwFileType
        Case VFT_APP
            FileType = "App"
        Case VFT_DLL
            FileType = "DLL"
        Case VFT_DRV
            FileType = "Driver"
            Select Case VerBuff.dwFileSubtype
                Case VFT2_DRV_PRINTER
                    FileSubType = "Printer drv"
                Case VFT2_DRV_KEYBOARD
                    FileSubType = "Keyboard drv"
                Case VFT2_DRV_LANGUAGE
                    FileSubType = "Language drv"
                Case VFT2_DRV_DISPLAY
                    FileSubType = "Display drv"
                Case VFT2_DRV_MOUSE
                    FileSubType = "Mouse drv"
                Case VFT2_DRV_NETWORK
                    FileSubType = "Network drv"
                Case VFT2_DRV_SYSTEM
                    FileSubType = "System drv"
                Case VFT2_DRV_INSTALLABLE
                    FileSubType = "Installable"
                Case VFT2_DRV_SOUND
                    FileSubType = "Sound drv"
                Case VFT2_DRV_COMM
                    FileSubType = "Comm drv"
                Case VFT2_UNKNOWN
                    FileSubType = "Unknown"
            End Select
        Case VFT_FONT
            FileType = "Font"
            Select Case VerBuff.dwFileSubtype
                Case VFT_FONT_RASTER
                    FileSubType = "Raster Font"
                Case VFT_FONT_VECTOR
                    FileSubType = "Vector Font"
                Case VFT_FONT_TRUETYPE
                    FileSubType = "TrueType Font"
            End Select
        Case VFT_VXD
            FileType = "VxD"
        Case VFT_STATIC_Lib
            FileType = "Lib"
        Case Else
            FileType = "Unknown"
    End Select
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub  Button1_on()
    FileName = Edit2.GetWindowText
 
    FileVer = ""
    ProdVer = ""
    FileFlags = ""
    FileOS = ""
    FileType = ""

    DisplayVerInfo
    txt$ = txt$ & "Full Filename  : " & FileName & Chr$(13,10)
    txt$ = txt$ & "File Version   : " & FileVer & Chr$(13,10)
    txt$ = txt$ & "Product Version: " & ProdVer & Chr$(13,10)
    txt$ = txt$ & "File Flags     : " & FileFlags & Chr$(13,10)
    txt$ = txt$ & "File OS        : " & FileOS & Chr$(13,10)

    If FileSubType = "" Then
        txt2$ = ""
    Else
        txt2$ =  " (" & FileSubType + ")"
    End If

    txt$ = txt$ & "File Type      : " & FileType & txt2$
    Edit1.SetWindowText txt$
End Sub

'================================================================
'= シェルドロップされたファイル名を取得
'================================================================
Declare Sub Edit2_DropFiles edecl (ByVal DF As Long)
Sub Edit2_DropFiles(ByVal DF As Long)
    Var CN As Long

    CN = GetDropFileCount(DF)
    FileName = GetDropFileName(DF, 0)
    Edit2.SetWindowText FileName
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End