从VB6调用FindMimeFromData

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，但是从文件系统传递整个文件名似乎不起作用。所以我必须尝试将它像C＃示例一样以文件的前256个字节发送。

任何人都可以帮忙吗？

Answer 1

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

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

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