Question

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中，我似乎无法弄清楚如何传递文件前256个字符的pBuffer参数。当我尝试使用Dim buffer() As Byte并填充它并将其作为参数传递时，它会抛出错误参数的错误，即使定义为Any也是如此。

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

有人可以帮忙吗？

Answer 1

我玩了下面的Declare，并围绕它构建了一些代码。有两个包装器，GetMimeTypeFromUrl（）和GetMimeTypeFromData（）。我发现前者仅在您使用http://host.com/file.xtn等简单网址时才有效。你可能不得不玩其他旗帜。

但是，其他包装函数听起来就像你需要的那样。

请注意，所有字符串指针都声明为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

从VB6调用FindMimeFromData

1 个答案: