How verify MIME type of file??

Discussion in 'ASP General' started by Vilmar Brazão de Oliveira, Jan 16, 2004.

  1. HI,
    How verify MIME type of file??

    Which components should I use?

    Still now I couldn't find anything!

    OBS.: I don´t to check file extensions!

    Thanks,
    --

    ««««««««»»»»»»»»»»»»»»
    Vlmar Brazão de Oliveira
    Desenvolvimento Web
    HI-TEC
     
    Vilmar Brazão de Oliveira, Jan 16, 2004
    #1
    1. Advertising

  2. Compile (and modify) this VB6 component. If you don't have VB6 I can compile
    this for you . Of course, that DLL is given to you 'AS IS'.


    ------------- start code
    Option Explicit
    Private Const GENERIC_READ As Long = &H80000000
    Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
    Private Const FILE_FLAG_SEQUENTIAL_SCAN As Long = &H8000000
    Private Const FILE_FLAG_NO_BUFFERING = &H20000000
    Private Const OPEN_EXISTING As Long = 3
    Private Const INVALID_HANDLE_VALUE As Long = -1
    Private Const vbComError As Long = &H80070000
    Private Declare Function getArrayPtr Lib "MSVBVM60.DLL" Alias "VarPtr"
    (btBytes() As Byte) As Long
    Private m_oResp As IResponse
    Private hFile As Long
    Public Sub DowloadFile(ByVal strBasePath As String, ByVal strFile As String)

    Dim lSize As Long, lBlocks As Long

    Const CHUNK As Long = 2048 'might be more optimal to get the NTFS cluster
    size
    Dim btChunk() As Byte
    ReDim btChunk(2047)

    Dim er As Long
    Dim vChunk As Variant
    Dim bytesread As Long
    Dim blnOresp As Boolean
    Dim sContentType As String
    Dim sExt As String
    Dim sTemp As String
    Dim lPoint As Long
    Dim hKey As Long
    Dim lBufLen As Long
    Dim lPtr As Long
    Dim lLen As Long
    lPoint = InStrRev(strFile, ".", , vbBinaryCompare)
    'On Local Error GoTo errlabel
    If lPoint Then
    sExt = Mid$(strFile, lPoint)
    hKey = RegOpenKeyEx(KEY_CLASSES_ROOT, sExt, 0, KEY_QUERY_VALUE)
    lBufLen = 128
    sContentType = SysAllocStringLen(ByVal 0, lBufLen)

    er = RegQueryValueExStr(hKey, "Content Type", ByVal 0, REG_SZ,
    sContentType, lBufLen)
    RegCloseKey hKey
    If er = 0 Then
    SysReAllocStringLen sContentType, sContentType, lBufLen \ 2 - 1
    Else
    er = GetLastError
    raiseeror er, "Error opening key: HKEY_CLASSES_ROOT\" + sExt
    End If
    End If

    lLen = SysStringLen(strBasePath)
    If Right$(strBasePath, 1) <> "\" Then
    strBasePath = VarBstrCat(strBasePath, "\")
    End If
    'm_oResp.Write VarBstrCat(strBasePath, strFile)
    'App.LogEvent VarBstrCat(strBasePath, strFile),
    vbLogEventTypeInformation
    sTemp = VarBstrCat(strBasePath, strFile)
    hFile = CreateFileW(sTemp, GENERIC_READ, 0, 0, OPEN_EXISTING,
    FILE_FLAG_SEQUENTIAL_SCAN, 0) 'FILE_FLAG_NO_BUFFERING


    If hFile = INVALID_HANDLE_VALUE Then
    er = GetLastError
    raiseeror er, "Error opening file: " + strFile
    End If

    lSize = GetFileSize(hFile, 0)
    If m_oResp Is Nothing Then
    blnOresp = False
    Else
    blnOresp = True
    m_oResp.Buffer = False
    'Set the content type to the specific type that you are sending.
    m_oResp.ContentType = sContentType
    m_oResp.AddHeader "Content-Length", CStr(lSize)
    'Content-disposition: attachment; filename=fname.ext
    'm_oResp.AddHeader "Content-Description", "a complete map of the
    human genome"
    m_oResp.AddHeader "Content-Disposition", "attachment; filename=" +
    strFile
    End If



    'the variant stealth method. VB does not know that vChunk and btChunk
    are referring to
    ' the *same* memory location
    ' this way we avoid pumping around bytes in RAM just because of
    *casting* from byte arrat to variant

    lPtr = VarPtr(vChunk) + 8
    kernel.MoveMemory ByVal lPtr, ByVal getArrayPtr(btChunk()), 4
    kernel.MoveMemory vChunk, CInt(vbArray Or vbByte), 2

    lBlocks = 1
    For lBlocks = lBlocks To lSize \ CHUNK + 1

    If ReadFile(hFile, btChunk(0), CHUNK, bytesread, ByVal 0&) = 0 Then
    er = GetLastError
    End If
    If bytesread = 0 Then Exit For
    If bytesread < CHUNK Then
    ReDim Preserve btChunk(bytesread - 1)
    kernel.MoveMemory ByVal lPtr, ByVal getArrayPtr(btChunk()), 4
    End If

    If blnOresp Then
    If m_oResp.IsClientConnected = False Then Exit For

    'BinaryWrite uses as much as CPU as a CGI application
    ' the only alternative seems to be ISAPI!
    m_oResp.BinaryWrite vChunk
    End If
    Next
    'lSize = lSize Mod CHUNK
    'clear the variant again so that VB won't clean the same byte array
    twice
    kernel.MoveMemory vChunk, vbEmpty, 2

    If hFile > 0 Then
    CloseHandle hFile
    hFile = -1
    End If

    Set m_oResp = Nothing
    Exit Sub
    ErrLabel:
    raiseeror Err.Number
    End Sub

    Private Function GetLastError() As Long
    GetLastError = Err.LastDllError
    End Function
    Private Sub raiseeror(ByVal er As Long, Optional ByRef sDescr As String =
    vbNullString)
    Dim oErr As ErrObject
    Set oErr = Information.Err
    If SysStringLen(sDescr) = 0 Then sDescr = oErr.Description
    App.LogEvent sDescr, vbLogEventTypeError
    If er Then oErr.Raise vbComError Or er, "clsDL", sDescr


    End Sub
    Public Sub OnStartPage(ctx As ScriptingContext)
    Set m_oResp = ctx.Response
    End Sub
    Public Sub OnEndPage()

    End Sub

    Private Sub Class_Terminate()
    If hFile > 0 Then CloseHandle hFile
    End Sub
    ------------ end code

    --
    compatible web farm Session replacement for Asp and Asp.Net
    http://www.nieropwebconsult.nl/asp_session_manager.htm

    "Vilmar Brazão de Oliveira" <> wrote in message
    news:...
    HI,
    How verify MIME type of file??
    Which components should I use?
    Still now I couldn't find anything!
    OBS.: I don´t to check file extensions!
    Thanks,
    --
    ««««««««»»»»»»»»»»»»»»
    Vlmar Brazão de Oliveira
    Desenvolvimento Web
    HI-TEC
     
    Egbert Nierop \(MVP for IIS\), Jan 16, 2004
    #2
    1. Advertising

  3. hi,
    could you compile for me?
    I am without vb6 in my job, I have only in my house.
    thanks
    "Egbert Nierop (MVP for IIS)" <> escreveu na
    mensagem news:...
    > Compile (and modify) this VB6 component. If you don't have VB6 I can

    compile
    > this for you . Of course, that DLL is given to you 'AS IS'.
    >
    >
    > ------------- start code
    > Option Explicit
    > Private Const GENERIC_READ As Long = &H80000000
    > Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
    > Private Const FILE_FLAG_SEQUENTIAL_SCAN As Long = &H8000000
    > Private Const FILE_FLAG_NO_BUFFERING = &H20000000
    > Private Const OPEN_EXISTING As Long = 3
    > Private Const INVALID_HANDLE_VALUE As Long = -1
    > Private Const vbComError As Long = &H80070000
    > Private Declare Function getArrayPtr Lib "MSVBVM60.DLL" Alias "VarPtr"
    > (btBytes() As Byte) As Long
    > Private m_oResp As IResponse
    > Private hFile As Long
    > Public Sub DowloadFile(ByVal strBasePath As String, ByVal strFile As

    String)
    >
    > Dim lSize As Long, lBlocks As Long
    >
    > Const CHUNK As Long = 2048 'might be more optimal to get the NTFS cluster
    > size
    > Dim btChunk() As Byte
    > ReDim btChunk(2047)
    >
    > Dim er As Long
    > Dim vChunk As Variant
    > Dim bytesread As Long
    > Dim blnOresp As Boolean
    > Dim sContentType As String
    > Dim sExt As String
    > Dim sTemp As String
    > Dim lPoint As Long
    > Dim hKey As Long
    > Dim lBufLen As Long
    > Dim lPtr As Long
    > Dim lLen As Long
    > lPoint = InStrRev(strFile, ".", , vbBinaryCompare)
    > 'On Local Error GoTo errlabel
    > If lPoint Then
    > sExt = Mid$(strFile, lPoint)
    > hKey = RegOpenKeyEx(KEY_CLASSES_ROOT, sExt, 0, KEY_QUERY_VALUE)
    > lBufLen = 128
    > sContentType = SysAllocStringLen(ByVal 0, lBufLen)
    >
    > er = RegQueryValueExStr(hKey, "Content Type", ByVal 0, REG_SZ,
    > sContentType, lBufLen)
    > RegCloseKey hKey
    > If er = 0 Then
    > SysReAllocStringLen sContentType, sContentType, lBufLen \ 2 -

    1
    > Else
    > er = GetLastError
    > raiseeror er, "Error opening key: HKEY_CLASSES_ROOT\" + sExt
    > End If
    > End If
    >
    > lLen = SysStringLen(strBasePath)
    > If Right$(strBasePath, 1) <> "\" Then
    > strBasePath = VarBstrCat(strBasePath, "\")
    > End If
    > 'm_oResp.Write VarBstrCat(strBasePath, strFile)
    > 'App.LogEvent VarBstrCat(strBasePath, strFile),
    > vbLogEventTypeInformation
    > sTemp = VarBstrCat(strBasePath, strFile)
    > hFile = CreateFileW(sTemp, GENERIC_READ, 0, 0, OPEN_EXISTING,
    > FILE_FLAG_SEQUENTIAL_SCAN, 0) 'FILE_FLAG_NO_BUFFERING
    >
    >
    > If hFile = INVALID_HANDLE_VALUE Then
    > er = GetLastError
    > raiseeror er, "Error opening file: " + strFile
    > End If
    >
    > lSize = GetFileSize(hFile, 0)
    > If m_oResp Is Nothing Then
    > blnOresp = False
    > Else
    > blnOresp = True
    > m_oResp.Buffer = False
    > 'Set the content type to the specific type that you are sending.
    > m_oResp.ContentType = sContentType
    > m_oResp.AddHeader "Content-Length", CStr(lSize)
    > 'Content-disposition: attachment; filename=fname.ext
    > 'm_oResp.AddHeader "Content-Description", "a complete map of the
    > human genome"
    > m_oResp.AddHeader "Content-Disposition", "attachment; filename=" +
    > strFile
    > End If
    >
    >
    >
    > 'the variant stealth method. VB does not know that vChunk and btChunk
    > are referring to
    > ' the *same* memory location
    > ' this way we avoid pumping around bytes in RAM just because of
    > *casting* from byte arrat to variant
    >
    > lPtr = VarPtr(vChunk) + 8
    > kernel.MoveMemory ByVal lPtr, ByVal getArrayPtr(btChunk()), 4
    > kernel.MoveMemory vChunk, CInt(vbArray Or vbByte), 2
    >
    > lBlocks = 1
    > For lBlocks = lBlocks To lSize \ CHUNK + 1
    >
    > If ReadFile(hFile, btChunk(0), CHUNK, bytesread, ByVal 0&) = 0

    Then
    > er = GetLastError
    > End If
    > If bytesread = 0 Then Exit For
    > If bytesread < CHUNK Then
    > ReDim Preserve btChunk(bytesread - 1)
    > kernel.MoveMemory ByVal lPtr, ByVal getArrayPtr(btChunk()), 4
    > End If
    >
    > If blnOresp Then
    > If m_oResp.IsClientConnected = False Then Exit For
    >
    > 'BinaryWrite uses as much as CPU as a CGI application
    > ' the only alternative seems to be ISAPI!
    > m_oResp.BinaryWrite vChunk
    > End If
    > Next
    > 'lSize = lSize Mod CHUNK
    > 'clear the variant again so that VB won't clean the same byte array
    > twice
    > kernel.MoveMemory vChunk, vbEmpty, 2
    >
    > If hFile > 0 Then
    > CloseHandle hFile
    > hFile = -1
    > End If
    >
    > Set m_oResp = Nothing
    > Exit Sub
    > ErrLabel:
    > raiseeror Err.Number
    > End Sub
    >
    > Private Function GetLastError() As Long
    > GetLastError = Err.LastDllError
    > End Function
    > Private Sub raiseeror(ByVal er As Long, Optional ByRef sDescr As String =
    > vbNullString)
    > Dim oErr As ErrObject
    > Set oErr = Information.Err
    > If SysStringLen(sDescr) = 0 Then sDescr = oErr.Description
    > App.LogEvent sDescr, vbLogEventTypeError
    > If er Then oErr.Raise vbComError Or er, "clsDL", sDescr
    >
    >
    > End Sub
    > Public Sub OnStartPage(ctx As ScriptingContext)
    > Set m_oResp = ctx.Response
    > End Sub
    > Public Sub OnEndPage()
    >
    > End Sub
    >
    > Private Sub Class_Terminate()
    > If hFile > 0 Then CloseHandle hFile
    > End Sub
    > ------------ end code
    >
    > --
    > compatible web farm Session replacement for Asp and Asp.Net
    > http://www.nieropwebconsult.nl/asp_session_manager.htm
    >
    > "Vilmar Brazão de Oliveira" <> wrote in message
    > news:...
    > HI,
    > How verify MIME type of file??
    > Which components should I use?
    > Still now I couldn't find anything!
    > OBS.: I don´t to check file extensions!
    > Thanks,
    > --
    > ««««««««»»»»»»»»»»»»»»
    > Vlmar Brazão de Oliveira
    > Desenvolvimento Web
    > HI-TEC
    >
     
    Vilmar Brazão de Oliveira, Jan 16, 2004
    #3
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Stephen Riek
    Replies:
    0
    Views:
    4,498
    Stephen Riek
    Sep 19, 2003
  2. CJ
    Replies:
    1
    Views:
    1,626
    Andrew Thompson
    Oct 29, 2004
  3. Jan Arickx
    Replies:
    0
    Views:
    235
    Jan Arickx
    Aug 25, 2003
  4. joe
    Replies:
    0
    Views:
    228
  5. ecureuil
    Replies:
    0
    Views:
    365
    ecureuil
    May 28, 2006
Loading...

Share This Page