Attribute VB_Name = "ModGetFileInfo"
Option Explicit
'*************************************************************************
'**模 块 名：ModGetFileInfo
'**说    明：取得指定文件相关信息
'**创 建 人：嗷嗷叫的老马
'**日    期：2006年8月27日
'**备    注: 摘于网络,紫水晶工作室 版权所有
'**          更多模块/类模块请访问我站:  http://www.m5home.com
'**版    本：V1.0
'**修    改：没有Translation节的情况下,尝试自己解析,得到代码页信息
'**          BY 嗷嗷叫的老马,2009-11-23
'*************************************************************************

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 Declare Function lstrcpy Lib "Kernel32" Alias "lstrcpyA" (ByVal lpString1 As String, ByVal lpString2 As Long) As Long
Private Declare Function VerLanguageName Lib "Kernel32" Alias "VerLanguageNameA" (ByVal wLang As Long, ByVal szLang As String, ByVal nSize As Long) As Long
Private Const Syn_kg = " "
Private Const Syn_pzh = "\"

Public Function GetFileVerInfo(FullFileName As String) As String()
    '返回的数组中各元素的说明:
    '0 = FileVersion, 1 = InternalName, 2 = CompanyName, 3 = LegalCopyright, 4 = FileDescription.
    
    Dim rc     As Long, lDummy       As Long, sBuffer()       As Byte
    Dim lBufferLen     As Long, lVerPointer       As Long
    Dim bytebuffer(260)     As Byte
    Dim Lang_Charset_String     As String
    Dim HexNumber     As Long, Buffer       As String
    Dim I     As Integer, strtemp       As String
    Dim strFileVer(5)     As String
  
    For I = 0 To 5
        strFileVer(I) = ""       '"No   Version   Info   available!"
    Next
    '***   Get   size   ****
    lBufferLen = GetFileVersionInfoSize(FullFileName, lDummy)
    If lBufferLen < 1 Then
        GetFileVerInfo = strFileVer
        Exit Function
    End If
    
    '****   Store   info   to   udtVerBuffer   struct   ****
    ReDim sBuffer(lBufferLen)
    rc = GetFileVersionInfo(FullFileName, 0&, lBufferLen, sBuffer(0))
    If rc = 0 Then
        GetFileVerInfo = strFileVer
        Exit Function     '"No   Version   Info   available!"
    End If
    
    rc = VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lVerPointer, lBufferLen)
    
    If rc = 0 Then
        '没有Translation节的情况下,尝试自己解析,得到代码页信息
        Dim sBuff As String, sBuffl() As String
        
        sBuff = sBuffer()
        Debug.Print sBuff
        
        sBuffl() = Split(sBuff, Chr(0))
        For I = 0 To UBound(sBuffl)
            If Len(sBuffl(I)) > 0 Then
                If InStr(1, sBuffl(I), "StringFileInfo", vbTextCompare) <> 0 Then
                    Debug.Print sBuffl(I + 1), sBuffl(I + 2), sBuffl(I + 3)
                    Lang_Charset_String = Right(sBuffl(I + 2), 8)               '自己解析,得到代码页信息
                    Exit For
                End If
                Debug.Print sBuffl(I)
            End If
        Next
        
        If I = UBound(sBuffl) + 1 Then      '还是没找到,就退出
            GetFileVerInfo = strFileVer
            Exit Function     '"No   Version   Info   available!"
        End If
    Else
        MoveMemory bytebuffer(0), lVerPointer, lBufferLen
        HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
        rc = CLng(bytebuffer(0) + bytebuffer(1) * &H100)
        Lang_Charset_String = Hex(HexNumber)
          
        Do While Len(Lang_Charset_String) < 8
            Lang_Charset_String = "0" & Lang_Charset_String
        Loop
          
        strtemp = String(260, Asc(Syn_kg))
        rc = VerLanguageName(rc, strtemp, CLng(255))
        strFileVer(5) = StripTerminator(strtemp)
    End If
              
    strFileVer(0) = "FileVersion"
    strFileVer(1) = "InternalName"
    strFileVer(2) = "CompanyName"
    strFileVer(3) = "LegalCopyright"
    strFileVer(4) = "FileDescription"
    
    strtemp = ""
    For I = 0 To 4
        Buffer = String(260, Asc(Syn_kg))
        strtemp = "\StringFileInfo\" & Lang_Charset_String & Syn_pzh & strFileVer(I)
        rc = VerQueryValue(sBuffer(0), strtemp, lVerPointer, lBufferLen)
        If rc <> 0 Then
            lstrcpy Buffer, lVerPointer
            Buffer = StripTerminator(Buffer)
        Else
            Buffer = ""
        End If
        strFileVer(I) = Buffer
    Next I
    GetFileVerInfo = strFileVer
End Function

Private Function StripTerminator(ByVal sInput As String) As String
    Dim ZeroPos     As Integer
    ZeroPos = InStr(1, sInput, vbNullChar)
    If ZeroPos > 0 Then
        StripTerminator = Left$(sInput, ZeroPos - 1)
    Else
        StripTerminator = sInput
    End If
End Function