Private Declare Function GetLocaleInfoA Lib "kernel32.dll" (ByVal lLCID As Long, ByVal lLCTYPE As Long, ByVal strLCData As String, ByVal lDataLen As Long) As Long

 

Private Declare Sub lstrcpyn Lib "kernel32.dll" (ByVal strDest As String, ByVal strSrc As Any, ByVal lBytes As Long)

 

Private Declare Function GetFileVersionInfoSize Lib "version.dll" Alias "GetFileVersionInfoSizeA" (ByVal sFile As String, lpLen As Long) As Long

 

Private Declare Function GetFileVersionInfo Lib "version.dll" Alias "GetFileVersionInfoA" (ByVal sFile As String, ByVal lpIgnored As Long, ByVal lpSize As Long, ByVal lpBuf As Long) As Long

 

Private Declare Function VerQueryValue Lib "version.dll" Alias "VerQueryValueA" (ByVal lpBuf As Long, ByVal szReceive As String, lpBufPtr As Long, lLen As Long) As Long

 

Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal ByteLen As Long)

 

Private Declare Function GetUserDefaultLCID Lib "kernel32.dll" () As Long

 

 

 

Public Function StringFromBuffer(buffer As String) As String

 

Dim nPos As Long

 

nPos = InStr(buffer, vbNullChar)

 

If nPos > 0 Then

 

StringFromBuffer = Left$(buffer, nPos - 1)

 

Else

 

StringFromBuffer = buffer

 

End If

 

End Function

 

 

 

Public Function GetFileDescription(ByVal sFile As String) As String

 

Dim lVerSize As Long

 

Dim lTemp As Long

 

Dim lRet As Long

 

Dim bInfo() As Byte

 

Dim lpBuffer As Long

 

Dim sDesc As String

 

Dim sKEY As String

 

lVerSize = GetFileVersionInfoSize(sFile, lTemp)

 

ReDim bInfo(lVerSize)

 

If lVerSize > 0 Then

 

lRet = GetFileVersionInfo(sFile, lTemp, lVerSize, VarPtr(bInfo(0)))

 

If lRet <> 0 Then

 

sKEY = GetNLSKey(bInfo)

 

lRet = VerQueryValue(VarPtr(bInfo(0)), sKEY & "\FileDescription", lpBuffer, lVerSize)

 

If lRet <> 0 Then

 

sDesc = Space$(lVerSize)

 

lstrcpyn sDesc, lpBuffer, lVerSize

 

GetFileDescription = StringFromBuffer(sDesc)

 

End If

 

End If

 

End If

 

End Function

 

 

 

Public Function GetNLSKey(byteVerData() As Byte) As String

 

Static strLANGCP As String

 

Dim lpBufPtr As Long

 

Dim strNLSKey As String

 

Dim fGotNLSKey As Integer

 

Dim intOffset As Integer

 

Dim lVerSize As Long

 

Dim lTmp As Long

 

Dim lBufLen As Long

 

Dim lLCID As Long

 

Dim strTmp As String

 

On Error GoTo GNLSKCleanup

 

If VerQueryValue(VarPtr(byteVerData(0)), "\VarFileInfo\Translation", lpBufPtr, lVerSize) <> 0 Then

 

If Len(strLANGCP) = 0 Then

 

lLCID = GetUserDefaultLCID()

 

If lLCID > 0 Then

 

strTmp = Space$(8)

 

GetLocaleInfoA lLCID, 11, strTmp, 8

 

strLANGCP = StringFromBuffer(strTmp)

 

Do While Len(strLANGCP) < 4

 

strLANGCP = "0" & strLANGCP

 

Loop

 

GetLocaleInfoA lLCID, 9, strTmp, 8

 

strLANGCP = StringFromBuffer(strTmp) & strLANGCP

 

Do While Len(strLANGCP) < 8

 

strLANGCP = "0" & strLANGCP

 

Loop

 

End If

 

End If

 

If VerQueryValue(VarPtr(byteVerData(0)), strLANGCP, lTmp, lBufLen) <> 0 Then

 

strNLSKey = strLANGCP

 

Else

 

For intOffset = 0 To lVerSize - 1 Step 4

 

CopyMemory lTmp, ByVal lpBufPtr + intOffset, 4

 

strTmp = Hex$(lTmp)

 

Do While Len(strTmp) < 8

 

strTmp = "0" & strTmp

 

Loop

 

strNLSKey = "\StringFileInfo\" & Right$(strTmp, 4) & Left$(strTmp, 4)

 

If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then

 

fGotNLSKey = True

 

Exit For

 

End If

 

Next

 

If Not fGotNLSKey Then

 

strNLSKey = "\StringFileInfo\040904E4"

 

If VerQueryValue(VarPtr(byteVerData(0)), strNLSKey, lTmp, lBufLen) <> 0 Then

 

fGotNLSKey = True

 

End If

 

End If

 

End If

 

End If

 

GNLSKCleanup:

 

If fGotNLSKey Then

 

GetNLSKey = strNLSKey

 

End If

 

End Function

 

 

 

Private Sub Form_Load()

 

Me.Caption = GetFileDescription("c:\windows\system32\shell32.dll")

 

End Sub