Imports System.Runtime.InteropServices
<DllImport("urlmon.dll", CharSet:=CharSet.Auto)> _
Private Shared Function FindMimeFromData(pBC As System.UInt32, <MarshalAs(UnmanagedType.LPStr)> pwzUrl As System.String, <MarshalAs(UnmanagedType.LPArray)> pBuffer As Byte(), cbSize As System.UInt32, <MarshalAs(UnmanagedType.LPStr)> pwzMimeProposed As System.String, dwMimeFlags As System.UInt32, _
ByRef ppwzMimeOut As System.UInt32, dwReserverd As System.UInt32) As System.UInt32
End Function
Private Function GetMimeType(ByVal f As FileInfo) As String
'See http://stackoverflow.com/questions/58510/using-net-how-can-you-find-the-mime-type-of-a-file-based-on-the-file-signature
Dim returnValue As String = ""
Dim fileStream As FileStream = Nothing
Dim fileStreamLength As Long = 0
Dim fileStreamIsLessThanBByteSize As Boolean = False
Const byteSize As Integer = 255
Const bbyteSize As Integer = byteSize + 1
Const ambiguousMimeType As String = "application/octet-stream"
Const unknownMimeType As String = "unknown/unknown"
Dim buffer As Byte() = New Byte(byteSize) {}
Dim fnGetMimeTypeValue As New Func(Of Byte(), Integer, String)(
Function(_buffer As Byte(), _bbyteSize As Integer) As String
Dim _returnValue As String = ""
Dim mimeType As UInt32 = 0
FindMimeFromData(0, Nothing, _buffer, _bbyteSize, Nothing, 0, mimeType, 0)
Dim mimeTypePtr As IntPtr = New IntPtr(mimeType)
_returnValue = Marshal.PtrToStringUni(mimeTypePtr)
Marshal.FreeCoTaskMem(mimeTypePtr)
Return _returnValue
End Function)
If (f.Exists()) Then
Try
fileStream = New FileStream(f.FullName(), FileMode.Open, FileAccess.Read, FileShare.ReadWrite)
fileStreamLength = fileStream.Length()
If (fileStreamLength >= bbyteSize) Then
fileStream.Read(buffer, 0, bbyteSize)
Else
fileStreamIsLessThanBByteSize = True
fileStream.Read(buffer, 0, CInt(fileStreamLength))
End If
returnValue = fnGetMimeTypeValue(buffer, bbyteSize)
If (returnValue.Equals(ambiguousMimeType, StringComparison.OrdinalIgnoreCase) AndAlso fileStreamIsLessThanBByteSize AndAlso fileStreamLength > 0) Then
'Duplicate the stream content until the stream length is >= bbyteSize to get a more deterministic mime type analysis.
Dim currentBuffer As Byte() = buffer.Take(fileStreamLength).ToArray()
Dim repeatCount As Integer = Math.Floor((bbyteSize / fileStreamLength) + 1)
Dim bBufferList As List(Of Byte) = New List(Of Byte)
While (repeatCount > 0)
bBufferList.AddRange(currentBuffer)
repeatCount -= 1
End While
Dim bbuffer As Byte() = bBufferList.Take(bbyteSize).ToArray()
returnValue = fnGetMimeTypeValue(bbuffer, bbyteSize)
End If
Catch ex As Exception
returnValue = unknownMimeType
Finally
If (fileStream IsNot Nothing) Then fileStream.Close()
End Try
End If
Return returnValue
End Function