[VB] 파일 속성/버전 읽기

파일의 등록정보에 버전 텝이 있는 파일에 대한 버전 정보를 얻는 방법이다.
GetFileVersionInfo을 사용해서 파일의 경로를 얻으면 파일 버전 정보 블럭을 얻고
VerQueryValue를 다시 호출해서 파일 버전 정보 블럭에서 원하는 정보 블럭을 지정할 수 있다.

' 파일 버전 정보를 얻는다
Option Explicit

Private Type VersionInformationType ' 파일 버전 정보
    StructureVersion As String ' 구조 버전
    FileVersion As String ' 파일 버전
    ProductVersion As String ' 개발 버전
    FileFlags As String ' 파일 플래그
    TargetOperatingSystem As String ' OS 정보
    FileType As String ' 파일 타입
    FileSubtype As String ' 파일 서브 타입
End Type

Private Type VS_FIXEDFILEINFO
    dwSignature As Long
    dwStrucVersion As Long
    dwFileVersionMS As Long
    dwFileVersionLS As Long
    dwProductVersionMS As Long
    dwProductVersionLS As Long
    dwFileFlagsMask As Long
    dwFileFlags As Long
    dwFileOS As Long
    dwFileType As Long
    dwFileSubtype As Long
    dwFileDateMS As Long
    dwFileDateLS As Long
End Type

Private Declare Function GetFileVersionInfo Lib "Version.dll" Alias "GetFileVersionInfoA" (ByVal lptstrFilename As String, ByVal dwhandle As Long, ByVal dwlen As Long, lpData As Any) As Long
Private Declare Function GetFileVersionInfoSize Lib "Version.dll" Alias "GetFileVersionInfoSizeA" (ByVal lptstrFilename As String, lpdwHandle As Long) As Long
Private Declare Function VerQueryValue Lib "Version.dll" Alias "VerQueryValueA" (pBlock As Any, ByVal lpSubBlock As String, lplpBuffer As Any, puLen As Long) As Long
Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, ByVal Source As Long, ByVal length As Long)

Private Const VersionSeperator As String = "."

Private Const VS_FF_DEBUG = &H1
Private Const VS_FF_INFOINFERRED = &H10
Private Const VS_FF_PATCHED = &H4
Private Const VS_FF_PRERELEASE = &H2
Private Const VS_FF_PRIVATEBUILD = &H8
Private Const VS_FF_SPECIALBUILD = &H20

Private Const VOS_DOS = &H10000
Private Const VOS_NT = &H40000
Private Const VOS__WINDOWS16 = &H1
Private Const VOS__WINDOWS32 = &H4
Private Const VOS_OS216 = &H20000
Private Const VOS_OS232 = &H30000
Private Const VOS__PM16 = &H2
Private Const VOS__PM32 = &H3

Private Const VFT_APP = &H1
Private Const VFT_DLL = &H2
Private Const VFT_DRV = &H3
Private Const VFT_FONT = &H4
Private Const VFT_STATIC_LIB = &H7
Private Const VFT_UNKNOWN = &H0
Private Const VFT_VXD = &H5

Private Const VFT2_DRV_COMM = &HA
Private Const VFT2_DRV_DISPLAY = &H4
Private Const VFT2_DRV_INSTALLABLE = &H8
Private Const VFT2_DRV_KEYBOARD = &H2
Private Const VFT2_DRV_LANGUAGE = &H3
Private Const VFT2_DRV_MOUSE = &H5
Private Const VFT2_DRV_NETWORK = &H6
Private Const VFT2_DRV_PRINTER = &H1
Private Const VFT2_DRV_SOUND = &H9
Private Const VFT2_DRV_SYSTEM = &H7
Private Const VFT2_DRV_VERSIONED_PRINTER = &HC
Private Const VFT2_UNKNOWN = &H0

Private Const VFT2_FONT_RASTER = &H1
Private Const VFT2_FONT_TRUETYPE = &H3
Private Const VFT2_FONT_VECTOR = &H2

Private Sub Form_Activate()
    txtFileName.SetFocus
End Sub

Private Sub Label2_Click()

End Sub

Private Sub txtFileName_KeyDown(KeyCode As Integer, Shift As Integer)
    Dim Result As VersionInformationType ' 파일 버전 정보
    
    If Not KeyCode = vbKeyReturn Then Exit Sub
    If Len(Trim(txtFileName.Text)) = 0 Then Exit Sub
    If VersionInformation(txtFileName.Text, Result) Then   ' 파일 버전 정보를 얻는다.
        With Result ' 버전 정보 문자열을 생성한다.
            labResults.Caption = "File:                " & txtFileName.Text & vbCrLf
            labResults.Caption = labResults.Caption & "File Version:        " & .FileVersion & vbCrLf
            labResults.Caption = labResults.Caption & "Product Version:     " & .ProductVersion & vbCrLf
            labResults.Caption = labResults.Caption & "Structure Version:   " & .StructureVersion & vbCrLf
            labResults.Caption = labResults.Caption & "File Type:           " & .FileType & vbCrLf
            labResults.Caption = labResults.Caption & "File Subtype:        " & .FileSubtype & vbCrLf
            labResults.Caption = labResults.Caption & "File Flags:          " & .FileFlags & vbCrLf
            labResults.Caption = labResults.Caption & "Target OS:           " & .TargetOperatingSystem & vbCrLf
        End With
    Else ' 파일 버전 정보를 얻지 못했다면
        MsgBox " 파일 정보를 얻지 못했읍니다."
    End If
End Sub

Private Sub Form_Load()
    txtFileName.Text = Environ("ComSpec")
End Sub

Private Function VersionInformation(ByVal FileName As String, ByRef Result As VersionInformationType) As Boolean ' 파일 정보를 얻는다.
    Dim Buffer() As Byte ' 파일 정보 저장할 버퍼
    Dim InfoSize As Long ' 파일 정보 크기
    Dim InfoBlockAddress As Long ' 파일 정보의 블럭 주소
    Dim InfoBlock As VS_FIXEDFILEINFO ' 파일 정보 블럭
    Dim InfoBlockSize As Long ' 파일 정보의 블럭 크기
    Dim TempWord(1) As Integer ' 더블 워드를 워드로

    VersionInformation = False ' 초기화
    InfoSize = GetFileVersionInfoSize(FileName, 0&) ' 파일 정보 크기를 얻는다.
    If InfoSize = 0 Then Exit Function ' 파일 정보 크기를 얻지 못했다면

    ReDim Buffer(1 To InfoSize) ' 버퍼 할당
    If GetFileVersionInfo(FileName, 0&, InfoSize, Buffer(1)) = 0 Then Exit Function  ' 파일 정보를 얻지 못햇다면
    If VerQueryValue(Buffer(1), "\", InfoBlockAddress, InfoBlockSize) = 0 Then Exit Function ' 파일 정보 블럭을 얻지 못했다면

    MoveMemory InfoBlock, InfoBlockAddress, InfoBlockSize ' 얻은 파일 정보 블럭 복사

    With InfoBlock
        MoveMemory TempWord(0), VarPtr(.dwStrucVersion), LenB(.dwStrucVersion) ' 구조 버전 정보
        Result.StructureVersion = TempWord(1) & VersionSeperator & TempWord(0)
        MoveMemory TempWord(0), VarPtr(.dwFileVersionMS), LenB(.dwFileVersionMS) ' 파일 버전 정보
        Result.FileVersion = TempWord(1) & VersionSeperator & TempWord(0)
        MoveMemory TempWord(0), VarPtr(.dwFileVersionLS), LenB(.dwFileVersionLS)
        Result.FileVersion = Result.FileVersion & VersionSeperator & TempWord(1) & VersionSeperator & TempWord(0)
        
        MoveMemory TempWord(0), VarPtr(.dwProductVersionMS), LenB(.dwProductVersionMS) ' 파일 버전 정보
        Result.ProductVersion = TempWord(1) & VersionSeperator & TempWord(0)
        MoveMemory TempWord(0), VarPtr(.dwProductVersionLS), LenB(.dwProductVersionLS)
        Result.ProductVersion = Result.ProductVersion & VersionSeperator & TempWord(1) & VersionSeperator & TempWord(0)

        If (.dwFileFlags And VS_FF_DEBUG) = VS_FF_DEBUG Then Result.FileFlags = Result.FileFlags & " Debug " ' 파일 플래그
        If (.dwFileFlags And VS_FF_INFOINFERRED) = VS_FF_INFOINFERRED Then Result.FileFlags = Result.FileFlags & " Info "
        If (.dwFileFlags And VS_FF_PATCHED) = VS_FF_PATCHED Then Result.FileFlags = Result.FileFlags & " Patched "
        If (.dwFileFlags And VS_FF_PRERELEASE) = VS_FF_PRERELEASE Then Result.FileFlags = Result.FileFlags & " PreRel "
        If (.dwFileFlags And VS_FF_PRIVATEBUILD) = VS_FF_PRIVATEBUILD Then Result.FileFlags = Result.FileFlags & " Private "
        If (.dwFileFlags And VS_FF_SPECIALBUILD) = VS_FF_SPECIALBUILD Then Result.FileFlags = Result.FileFlags & " Special "
        If Result.FileFlags = "" Then Result.FileFlags = "Unknown"
        Result.FileFlags = Trim(Replace(Result.FileFlags, "  ", " "))

        If (.dwFileOS And VOS_DOS) = VOS_DOS Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " DOS " ' 파일 OS
        If (.dwFileOS And VOS_NT) = VOS_NT Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " NT "
        If (.dwFileOS And VOS__WINDOWS16) = VOS__WINDOWS16 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 16Bit Windows "
        If (.dwFileOS And VOS__WINDOWS32) = VOS__WINDOWS32 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 32Bit Windows "
        If (.dwFileOS And VOS_OS216) = VOS_OS216 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 16Bit OS/2 "
        If (.dwFileOS And VOS_OS232) = VOS_OS232 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 32Bit OS/2 "
        If (.dwFileOS And VOS__PM16) = VOS__PM16 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 16Bit Presentation Manager "
        If (.dwFileOS And VOS__PM32) = VOS__PM32 Then Result.TargetOperatingSystem = Result.TargetOperatingSystem & " 32Bit Presentation Manager "
        If Result.TargetOperatingSystem = "" Then Result.TargetOperatingSystem = "Unknown"
        Result.TargetOperatingSystem = Trim(Replace(Result.TargetOperatingSystem, "  ", " "))
        
        On Error Resume Next ' 파일 타입
        Result.FileType = Switch(.dwFileType = VFT_APP, "App", _
                                .dwFileType = VFT_DLL, "DLL", _
                                .dwFileType = VFT_DRV, "Driver", _
                                .dwFileType = VFT_FONT, "Font", _
                                .dwFileType = VFT_VXD, "VxD", _
                                .dwFileType = VFT_STATIC_LIB, "Lib")
        If Err.Number > 0 Then Result.FileType = "Unknown"
        On Error GoTo 0

        Select Case .dwFileType ' 파일 서브 타입
            Case VFT_DRV
                Result.FileSubtype = Switch(.dwFileSubtype = VFT2_DRV_PRINTER, "Printer drv", _
                                            .dwFileSubtype = VFT2_DRV_KEYBOARD, "Keyboard drv", _
                                            .dwFileSubtype = VFT2_DRV_LANGUAGE, "Language drv", _
                                            .dwFileSubtype = VFT2_DRV_DISPLAY, "Display drv", _
                                            .dwFileSubtype = VFT2_DRV_MOUSE, "Mouse drv", _
                                            .dwFileSubtype = VFT2_DRV_NETWORK, "Network drv", _
                                            .dwFileSubtype = VFT2_DRV_SYSTEM, "System drv", _
                                            .dwFileSubtype = VFT2_DRV_INSTALLABLE, "Installable", _
                                            .dwFileSubtype = VFT2_DRV_SOUND, "Sound drv", _
                                            .dwFileSubtype = VFT2_DRV_COMM, "Comm drv", _
                                            .dwFileSubtype = VFT2_UNKNOWN, "Unknown")
            Case VFT_FONT
                Result.FileSubtype = Switch(.dwFileSubtype = VFT2_FONT_RASTER, "Raster Font", _
                                                .dwFileSubtype = VFT2_FONT_TRUETYPE, "TrueType Font", _
                                                .dwFileSubtype = VFT2_FONT_VECTOR, "Vector Font", _
                                                .dwFileSubtype = VFT2_UNKNOWN, "Unknown")
        End Select
    End With

    VersionInformation = True
End Function