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

pBufferVB6 では、ファイルの最初の 256 文字のパラメーターを渡す方法がわかりません。a を使用してDim buffer() As Byteそれを設定し、それをパラメーターとして渡すと、定義のパラメーターが であっても間違ったパラメーターのエラーがスローされますAny。

この例を使用しようとしましたが、ファイル システムからファイル名全体を渡してもうまくいかないようです。そのため、ファイルの最初の 256 バイトを使用して C# の例のように送信する必要があります。

誰でも助けることができますか？

4

1 に答える 1

2

次の Declare をいじって、その周りにいくつかのコードを作成しました。GetMimeTypeFromUrl() と GetMimeTypeFromData() の 2 つのラッパーがあります。前者は、 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 に答える