<%
' (SS,21/9/10) modified to send files bigger than 1MB in chunks of 1MB, overcomes an internal 4MB buffer limit
' http://support.microsoft.com/kb/173308
' http://support.microsoft.com/kb/944886
' (SS,21/3/11) added png type
' (SS,16/5/12) fixed issue when FileSize is null, treat as zero, instead of failing in CLng(oRS("FileSize")), later replaced FileSize with LENGTH(File) AS FileSize
' (SS,12/6/12) added CleanSQLStr before LType, LCode, LCode2 to prevent SQL injection
' (SS,12/9/12) added cache querystring parameter, cache=y, means cache for 60 minutes, no cache if not specified

Dim LType, LCode, LCode2, LFileType, LFileSize, LCache
LType = UCase(Request.QueryString("type"))
LCode = Request.QueryString("code")
LCode2 = Request.QueryString("code2")
LCache = Request.QueryString("cache") ' (SS,12/9/12)
If LType = "" then LType = "P"
Dim oConn, oRs, nRecs, LBlob, LFound
Set oConn = Server.CreateObject("ADODB.Connection")
oConn.ConnectionString = Application("ConnectionString")
oConn.Open
' (SS,21/9/10) added FileSize
' (SS,16/5/12) replaced FileSize with LENGTH(File) AS FileSize, found that FileSize sometimes ending up Null value, may remove this field in future
' (SS,12/6/12) added CleanSQLStr to prevent SQL injection
Set oRS = oConn.Execute("SELECT FileName, File, LENGTH(File) AS FileSize FROM files WHERE Type = '" & CleanSQLStr(LType) & "' AND Code = '" & CleanSQLStr(LCode) & "' AND Code2 = '" & CleanSQLStr(LCode2) & "'", nRecs, &H0001)
LFound = Not oRS.Eof
If LFound Then
	LPos = InStrRev(oRS("FileName"), ".")
	If LPos > 0 Then
		LFileType = LCase(Trim(Mid(oRS("FileName"), LPos + 1, 20)))
	Else
		LFileType = "pdf"
	End If	 
	LBlob = oRS("File")
  ' (SS,16/5/12) added check for null and setting to zero, to fix issue where banner images for galleonie were not downloading due to null value in this field, LENGTH(File) will also return null if file is null
  If IsNull(oRS("FileSize")) Then
    LFileSize = 0
  Else
    LFileSize = CLng(oRS("FileSize")) ' (SS,21/9/10)
  End If
End If
oRS.Close
Set oRS = Nothing
oConn.Close
Set oConn = Nothing
If LFound Then
	Dim LContentType
	
	If LFileType = "pdf" Then
		LContentType = "application/pdf"
	ElseIf LFileType = "doc" Then
		LContentType = "application/msword"
	ElseIf LFileType = "xls" Then	
		LContentType = "vnd.ms-excel"
	ElseIf LFileType = "ppt" Then	
		LContentType = "application/vnd.ms-powerpoint"
	ElseIf LFileType = "txt" Then	
		LContentType = "text/plain"			
	ElseIf LFileType = "gif" Then	
		LContentType = "image/GIF"
	ElseIf LFileType = "jpg" OR LFileType = "jpeg" Then	
		LContentType = "image/JPEG"	
	ElseIf LFileType = "png" Then	 ' (SS,21/3/11) added PNG
		LContentType = "image/png"
	Else ' i.e. LFileType = "htm" OR LFileType = "html" OR LFileType = ""	OR something else
		LContentType = "text/HTML"	
	End If		
		
	Response.ContentType = LContentType
  ' (SS,12/9/12) now cache for 60 minutes if cache query string value isn't blank
  If LCache = "" Then
    Response.Expires = -1 ' (SS,27/2/09) changed from 60 to -1 to expire immediately
  Else
    Response.Expires = 60
  End If
  
	' (SS,21/9/10) there is a limit of 4MB, although this can be changed (not easily), if more than 1MB then send in chunks of 1MB	
	Const clChunkSize = 1048576 ' 1MB
	If LFileSize <= clChunkSize Then
		Response.BinaryWrite LBlob
	Else								
		Dim oStream, i
		Response.Buffer = False
		' copy blob to stream to allow it to be sent in chunks
		Set oStream = Server.CreateObject("ADODB.Stream")
		oStream.Type = 1 ' Binary
		oStream.Open
		oStream.Write(LBlob)
		oStream.Position = 0				
		For i = 1 To oStream.Size \ clChunkSize
			Response.BinaryWrite oStream.Read(clChunkSize)
		Next
		If (oStream.Size Mod clChunkSize) <> 0 Then
			Response.BinaryWrite oStream.Read(oStream.Size Mod clChunkSize)
		End If
		oStream.Close
		SET oStream = Nothing		
	End If
End If
Response.End

' (SS,13/6/11) added following from dbfunctions.asp because query would fail if code contained a quote
Function CleanSQLStr(AValue)
  Dim LNewValue
  If IsNull(AValue) Then AValue = ""
  LNewValue = AValue
  LNewValue = Replace(LNewValue, "\", "\\")
  LNewValue = Replace(LNewValue, "'", "\'")
  LNewValue = Replace(LNewValue, """", "\""")
  LNewValue = Replace(LNewValue, Chr(0), "\0") ' An ASCII NUL (0x00) character.
  LNewValue = Replace(LNewValue, Chr(8), "\b") ' A backspace character.
  LNewValue = Replace(LNewValue, Chr(9), "\t") ' A tab character. 
  LNewValue = Replace(LNewValue, Chr(10), "\n") ' A newline (linefeed) character.
  LNewValue = Replace(LNewValue, Chr(13), "\r") ' A carriage return character.
  LNewValue = Replace(LNewValue, Chr(26), "\Z") ' ASCII 26 (Control-Z).
  CleanSQLStr = LNewValue
End Function
%>