<%
Response.Expires = 0
'Response.AddHeader "pragma","no-cache"
'Response.CacheControl = "no-cache"
%>
<%
'this file expects
' 1) dirname - the name of the directory where the image exists under 'Const imageLocation' defined in configuration.asp
' 2) imagename - the name of the image including extension
' 3) id - optional, id of the job found in the job table. Here in case it's needed.
' 4) auth_string - A unique key to disallow the unauthorized download of images
'objConn.Execute("insert into messages set message = 'Grab Image ln 15: beginning of script'")
strAuthString = Request("auth_string")
image_id = Request("image_id")
'sd = EnDeCrypt(Base64Decode(Request("sd")))
'il = EnDeCrypt(Base64Decode(Request("il")))
if CONST_viewer = "acordex" and strAuthString <> "" then
strAuthString = Right(strAuthString, Len(strAuthString)-1)
response.write strAuthString
' objConn.Execute("insert into messages set message = 'Grab Image ln 23: acordex if statement " & strAuthString & "'")
end if
'objConn.Execute("insert into messages set message = 'Grab Image ln 206 " & Request("auth_string") & "'")
Set logRS = objConn.Execute("SELECT * From log where unique_key='"&strAuthString&"'")
set imageRS = objConn.Execute("Select * from images where id="&request("image_id"))
If imageRS.EOF then
response.Write("Invalid Image Id")
response.End()
end if
set jobRS = objConn.Execute("Select * from job where id="&imageRS("job_id"))
'if jobRS("No_Viewable_Images") = -1 then
' response.Write("This job's images are not permitted to be viewed")
' response.End()
'end if
fileName = imageRS("filename")
dirName = imageRS("directory_name")
select case fileExtension(lcase(base64DeCode(fileName)))
case "pdf", "doc"
' do nothing (continue)
case else
if (logRS.EOF and imageRS("allow_download")="0") Then
UnauthorizedAlert()
response.End()
end if
end select
'Read in the filename
Dim strFileName
Dim Extension
'Form the file path and name
passFile dirName, fileName
strQuery = "delete from log where unique_key='" & strAuthString & "'"
objConn.Execute(strQuery)
Function ReadBinaryFile(FileName)
Const adTypeBinary = 1
'ForReading = 1
'Set fs = CreateObject("Scripting.FileSystemObject")
'Set ts = fs.OpenTextFile(FileName, ForReading)
'Create Stream object
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
'Specify stream type - we want To get binary data.
BinaryStream.Type = adTypeBinary
'Open the stream
BinaryStream.Open
'Load the file data from disk To stream object
BinaryStream.LoadFromFile FileName
'Open the stream And get binary data from the object
ReadBinaryFile = BinaryStream.Read
'ReadBinaryFile = ts.ReadAll
End Function
function passFile(dirName, fileName)
Dim objBinFile, vntStream
response.write CONST_imageLocation & dirName & "/" & fileName & "
" & vbcrlf
vntStream = ReadBinaryFile(CONST_imageLocation & dirName & "/" & fileName)
tempFileName = lcase(base64DeCode(fileName))
extension = lcase(fileExtension(tempFileName))
select case extension
case "jpg"
Response.ContentType = "image/jpeg"
case "tif"
Response.ContentType = "image/tiff"
case "gif"
Response.ContentType = "image/gif"
case "doc"
Response.ContentType = "application/msword"
case "pdf"
Response.ContentType = "application/pdf"
case else
Response.ContentType = "Text/HTML"
end select
' Response.ContentType = "Text/HTML"
Response.Addheader "Content-Disposition", "inline; filename=" & "grabimage." & extension
Response.BinaryWrite(vntStream)
Response.End
Set objBinFile = Nothing
End function
function fileExtension(filename)
a = split(filename,".")
fileExtension = trim(a(ubound(a)))
end function
function UnauthorizedAlert
Response.ContentType = "Text/HTML"
Response.Write "Error - Invalid File Download Attempt
"
cdoBody = "An attempt to download an image improperly has failed. A 'session variables' and 'server variables' dump follow:
"
cdoBody = cdoBody & "Job Name : " & request.querystring("dirname") & "
"
cdoBody = cdoBody & "Image Name : " & request.querystring("imagename") & "
"
cdoBody = cdoBody & "Auth String : " & strAuthString & "
"
cdoBody = cdoBody & "Active session variables :
"
cdoBody = cdoBody & Fdumpsessions & "
"
cdoBody = cdoBody & "Active server variables :
"
cdoBody = cdoBody & Fdumpservervariables
cdoBody = Replace(cdoBody, "
", vbcrlf)
' sendMail fromdistributionEmail, "choward@boxlake.com", "Error - Invalid File Download Attempt" , cdoBody
Response.write cdoBody
End function
Function Fdumpservervariables()
a = ""
For Each key In Request.ServerVariables
a = a & Key & " = " & Request.Servervariables(Key) & "
"
Next
Fdumpservervariables = a
End Function
Function FdumpSessions()
a = ""
for each i in session.Contents
a = a & session.Contents.key(i) & ":" & session.Contents.Item(i) & "
"
next
Fdumpsessions = a
End Function
%>