0 
Public Declare Function FindMimeFromData Lib "urlmon.dll" ( _
        ByVal pbc As Long, _
        ByVal pwzUrl As String, _
        pBuffer As Any, _
        cbSize As Long, _
        ByVal pwzMimeProposed As String, _
        dwMimeFlags As Long, _
        ppwzMimeOut As Long, _
        dwReserved As Long) As Long

在 VB6 中，我似乎无法弄清楚如何传递pBuffer文件前 256 个字符的参数。当我尝试使用 aDim buffer() As Byte并填充它并将其作为参数传递时，它会抛出错误参数的错误，即使定义为Any.

我尝试使用此示例，但从文件系统传递整个文件名似乎不起作用。所以我必须尝试像 C# 示例一样使用文件的前 256 个字节发送它。

任何人都可以帮忙吗？

4

1 回答 1

2

我玩弄了以下 Declare，并围绕它构建了一些代码。有两个包装器，GetMimeTypeFromUrl() 和 GetMimeTypeFromData()。我发现前者仅在您使用诸如http://host.com/file.xtn之类的简单 URL 时才有效。您可能不得不玩弄其他标志。

但是，其他包装函数听起来像您需要的。

请注意，所有字符串指针都声明为 As Long，并且我使用 StrPtr() 将底层 UTF-16 VB 字符串作为指针传递。

另请注意，您必须使用 CoTaskMemFree() 来释放输出 ppwzMimeOut 字符串指针，否则会泄漏内存。

Option Explicit

Private Declare Function FindMimeFromData Lib "Urlmon.dll" ( _
    ByVal pBC As Long, _
    ByVal pwzUrl As Long, _
    ByVal pBuffer As Long, _
    ByVal cbSize As Long, _
    ByVal pwzMimeProposed As Long, _
    ByVal dwMimeFlags As Long, _
    ByRef ppwzMimeOut As Long, _
    ByVal dwReserved As Long _
) As Long

'
' Flags:
'

' Default
Private Const FMFD_DEFAULT As Long = &H0

' Treat the specified pwzUrl as a file name.
Private Const FMFD_URLASFILENAME  As Long = &H1

' Internet Explorer 6 for Windows XP SP2 and later. Use MIME-type detection even if FEATURE_MIME_SNIFFING is detected. Usually, this feature control key would disable MIME-type detection.
Private Const FMFD_ENABLEMIMESNIFFING  As Long = &H2

' Internet Explorer 6 for Windows XP SP2 and later. Perform MIME-type detection if "text/plain" is proposed, even if data sniffing is otherwise disabled. Plain text may be converted to text/html if HTML tags are detected.
Private Const FMFD_IGNOREMIMETEXTPLAIN  As Long = &H4

' Internet Explorer 8. Use the authoritative MIME type specified in pwzMimeProposed. Unless FMFD_IGNOREMIMETEXTPLAIN is specified, no data sniffing is performed.
Private Const FMFD_SERVERMIME  As Long = &H8

' Internet Explorer 9. Do not perform detection if "text/plain" is specified in pwzMimeProposed.
Private Const FMFD_RESPECTTEXTPLAIN  As Long = &H10

' Internet Explorer 9. Returns image/png and image/jpeg instead of image/x-png and image/pjpeg.
Private Const FMFD_RETURNUPDATEDIMGMIMES  As Long = &H20

'
' Return values:
'
' The operation completed successfully.
Private Const S_OK          As Long = 0&

' The operation failed.
Private Const E_FAIL        As Long = &H80000008

' One or more arguments are invalid.
Private Const E_INVALIDARG  As Long = &H80000003

' There is insufficient memory to complete the operation.
Private Const E_OUTOFMEMORY As Long = &H80000002

'
' String routines
'

Private Declare Function lstrlen Lib "Kernel32.dll" Alias "lstrlenW" ( _
    ByVal lpString As Long _
) As Long

Private Declare Sub CopyMemory Lib "Kernel32.dll" Alias "RtlMoveMemory" (ByVal pDest As Long, ByVal pSrc As Long, ByVal nCount As Long)

Private Declare Sub CoTaskMemFree Lib "Ole32.dll" ( _
    ByVal pv As Long _
)

Private Function CopyPointerToString(ByVal in_pString As Long) As String

    Dim nLen            As Long

    ' Need to copy the data at the string pointer to a VB string buffer.
    ' Get the length of the string, allocate space, and copy to that buffer.

    nLen = lstrlen(in_pString)
    CopyPointerToString = Space$(nLen)
    CopyMemory StrPtr(CopyPointerToString), in_pString, nLen * 2

End Function

Private Function GetMimeTypeFromUrl(ByRef in_sUrl As String, ByRef in_sProposedMimeType As String) As String

    Dim pMimeTypeOut    As Long
    Dim nRet            As Long

    nRet = FindMimeFromData(0&, StrPtr(in_sUrl), 0&, 0&, StrPtr(in_sProposedMimeType), FMFD_DEFAULT, pMimeTypeOut, 0&)

    If nRet = S_OK Then
        GetMimeTypeFromUrl = CopyPointerToString(pMimeTypeOut)
        CoTaskMemFree pMimeTypeOut
    Else
        Err.Raise nRet
    End If

End Function

Private Function GetMimeTypeFromData(ByRef in_abytData() As Byte, ByRef in_sProposedMimeType As String) As String

    Dim nLBound          As Long
    Dim nUBound          As Long
    Dim pMimeTypeOut     As Long
    Dim nRet             As Long

    nLBound = LBound(in_abytData)
    nUBound = UBound(in_abytData)

    nRet = FindMimeFromData(0&, 0&, VarPtr(in_abytData(nLBound)), nUBound - nLBound + 1, StrPtr(in_sProposedMimeType), FMFD_DEFAULT, pMimeTypeOut, 0&)

    If nRet = S_OK Then
        GetMimeTypeFromData = CopyPointerToString(pMimeTypeOut)
        CoTaskMemFree pMimeTypeOut
    Else
        Err.Raise nRet
    End If

End Function

Private Sub Command1_Click()

    Dim sRet        As String
    Dim abytData()  As Byte

    sRet = GetMimeTypeFromUrl("http://msdn.microsoft.com/en-us/library/ms775107%28v=vs.85%29.aspx", vbNullString)

    Debug.Print sRet

    abytData() = StrConv("<HTML><HEAD><TITLE>Stuff</TITLE></HEAD><BODY>Test me</BODY></HTML>", vbFromUnicode)

    sRet = GetMimeTypeFromData(abytData(), vbNullString)

    Debug.Print sRet

End Sub
于 2013-04-11T00:15:40.203 回答