Question

我想获取文件属性，例如＆＃34;描述＆＃34;，＆＃34; ProductName＆＃34;

如何在vb6中获取这些属性？

我尝试过使用FileSystemObject，但似乎无法获得＆＃34;描述＆＃34;属性。

感谢您的回复。我使用下面的代码来获取文件属性。希望这能帮助那些与我有同样问题的人。

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

这需要Windows 2000或更高版本。我不确定属性系统是否已扩展到Windows XP等旧操作系统的覆盖范围，因此您可能需要Windows Vista或更高版本：

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

有关可用扩展属性的定义，请参阅最近的Windows SDK中的propkey.h。

如何在vb6中获取文件属性？

1 个答案: