How to get file properties in vb6? - vb6

Question

I want to get the file properties like "Description"、"ProductName"
How to get these properties in vb6?
I've tried use FileSystemObject, but it seems like can't get the "Description" properties.
Thanks for reply.
I use code below to get the file properties.
Hope this will help others who have the same problem with me.
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
Public Function GetFileInformation(ByVal fileFullPath As String) As String
Dim lDummy As Long, lSize As Long, rc As Long
Dim lVerbufferLen As Long
Dim sBuffer() As Byte
Dim lBufferLen As Long
Dim bytebuffer(255) As Byte
Dim Lang_Charset_String As String
Dim HexNumber As Long
Dim buffer As String
Dim lVerPointer As Long
Dim ProdName As String
GetFileInformation = ""
buffer = String(255, 0)
lBufferLen = GetFileVersionInfoSize(fileFullPath, lDummy)
If lBufferLen >= 1 Then
ReDim sBuffer(lBufferLen)
rc = GetFileVersionInfo(fileFullPath, 0&, lBufferLen, sBuffer(0))
If rc <> 0 Then
rc = VerQueryValue(sBuffer(0), "\VarFileInfo\Translation", lVerPointer, lBufferLen)
If rc <> 0 Then
MoveMemory bytebuffer(0), lVerPointer, lBufferLen
HexNumber = bytebuffer(2) + bytebuffer(3) * &H100 + bytebuffer(0) * &H10000 + bytebuffer(1) * &H1000000
Lang_Charset_String = Hex(HexNumber)
Do While Len(Lang_Charset_String) < 8
Lang_Charset_String = "0" & Lang_Charset_String
Loop
.sCompanyName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "CompanyName", lVerPointer, lBufferLen, sBuffer)
.sFileDescription = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "FileDescription", lVerPointer, lBufferLen, sBuffer)
.sFileVersion = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "FileVersion", lVerPointer, lBufferLen, sBuffer)
.sInternalName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "InternalName", lVerPointer, lBufferLen, sBuffer)
.sLegalCopyright = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "LegalCopyright", lVerPointer, lBufferLen, sBuffer)
.sOriginalFileName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "OriginalFileName", lVerPointer, lBufferLen, sBuffer)
.sProductName = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "ProductName", lVerPointer, lBufferLen, sBuffer)
.sProductVersion = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "ProductVersion", lVerPointer, lBufferLen, sBuffer)
GetFileInformation = GetStringValue("\StringFileInfo\" & Lang_Charset_String & "\" & "ProductName", lVerPointer, lBufferLen, sBuffer)
End If
End If
End If
End Function
Private Function GetStringValue(ByRef searchString As String, ByVal lVerPointer As Long, ByVal lBufferLen As Long, ByRef sBuffer() As Byte) As String
Dim buffer As String
Dim strTemp As String
Dim rc As Long
GetStringValue = ""
buffer = String(255, 0)
rc = VerQueryValue(sBuffer(0), searchString, lVerPointer, lBufferLen)
If rc <> 0 Then
lstrcpy buffer, lVerPointer
GetStringValue = Mid$(buffer, 1, InStr(buffer, Chr(0)) - 1)
End If
End Function

Answer 1

This requires Windows 2000 or later. I'm not sure the property system had been extended to this level of coverage in older OSs like Windows XP yet so you may need Windows Vista or later:
Option Explicit
Private Sub Form_Load()
Const ssfDESKTOP = 0
Const COL2 = 20
Show
With CommonDialog1
.DialogTitle = "Select a PE file"
.CancelError = True
.Flags = cdlOFNExplorer _
Or cdlOFNFileMustExist _
Or cdlOFNPathMustExist _
Or cdlOFNLongNames _
Or cdlOFNShareAware
.InitDir = App.Path
.Filter = "Programs (*.exe)|*.exe|Libraries (*.dll;*.ocx)|*.dll;*.ocx"
On Error Resume Next
.ShowOpen
If Err Then
Unload Me
Exit Sub
End If
On Error GoTo 0
End With
With CreateObject("Shell.Application")
With .NameSpace(ssfDESKTOP).ParseName(CommonDialog1.FileName)
AutoRedraw = True
Print "Name:"; Tab(COL2);
Print .Name
Print "Product Name:"; Tab(COL2);
Print .ExtendedProperty("System.Software.ProductName")
Print "Size:"; Tab(COL2);
Print Format$(.Size, "#,##0"); " bytes"
Print "File Version:"; Tab(COL2);
Print .ExtendedProperty("System.FileVersion")
Print "Date Accessed:"; Tab(COL2);
Print .ExtendedProperty("System.DateAccessed")
Print "Date Created:"; Tab(COL2);
Print .ExtendedProperty("System.DateCreated")
Print "Date Modified:"; Tab(COL2);
Print .ExtendedProperty("System.DateModified")
Print "Company:"; Tab(COL2);
Print .ExtendedProperty("System.Company")
Print "Copyright:"; Tab(COL2);
Print .ExtendedProperty("System.Copyright")
Print "File Description:"; Tab(COL2);
Print .ExtendedProperty("System.FileDescription")
End With
End With
End Sub
See propkey.h in a recent Windows SDK for the definitions of the available extended properties.