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
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,
