<%option explicit%>
<!-- #include file="shop$db.asp" -->
<%
const xdownloadlimitcountdefault=2
const xdownloadlimitdaysdefault=365
'*********************************************************************
' Secure download facility
' VP-ASP 6.50
' oid=, cid=,catalogid
' xdownloadfeature=Yes for feature based downloads
' April 7, 2004
' Sept 18, 2004 support split products database
' Oct 10, 2004  Redo split database
' Because there can be a base database, order database and products database
' the down needs to reference up to three different database. These are
' so we either have open connection or three
' dbc= main database
' pconn = products
' oconn=orders
'***********************************************************************
Dim ifile, filename, oid, cid, catalogid, rc
dim pconn, oconn, dbc, dconnflag
dim xdownloadlimitcount, xdownloadlimitdays
dim authorized, blockdownloads, ydebug, itemid
GetInputsandDefaults
Opendownloaddatabase dconnflag
Locateorder rc
If rc<>0 then
  closedownloaddatabase dconnflag
  shoperror getlang("LangOrderNone")
End if
Getdownloadfile rc, catalogid, filename, oid, itemid
Normalizedownloadfile ifile, filename
If Serror="" then
    Updatedownloadfile rc, dbc, oid,cid, catalogid
    closedownloaddatabase dconnflag
    If serror="" then
  	Downloadfile  ifile, filename
    End if
else
     closedownloaddatabase dconnflag
end if            
If serror<>"" then
  shoppageheader
  shopwriteerror serror
  shoppagetrailer
end if
'*****************************************************************
' get oid, cid, catalogid from querystring
' get defaults from configuration
'*******************************************************************
Sub GetinputsandDefaults
If getconfig("xdownloadblock")="Yes" then
   shoperror getlang("LangCustNotAllowed")
end if   
oid=getintfield("oid")
cid=getsess("customerid")
catalogid=getintfield("catalogid")
itemid=getintfield("itemid")
ydebug=getconfig("xdebug")
If getsess("customerid")="" then
     responseredirect "shopcustadminlogin.asp"
end if     
xdownloadlimitdays=getconfig("xdownloadlimitdays")
if xdownloadlimitdays="" then 
  xdownloadlimitdays=xdownloadlimitdaysdefault
end if
xdownloadlimitcount=getconfig("xdownloadlimitcount")
if xdownloadlimitcount="" then 
  xdownloadlimitcount=xdownloadlimitcountdefault
end if
If oid="" or cid="" or catalogid="" then
   shoperror getlang("LangOrderMissing")
end if
end sub
'*******************************************************************
' verify order exists
'*******************************************************************
Sub Locateorder (rc)
dim sql, rs
If cid="" or oid="" then
   rc=4
   exit sub
end if   
sql=" SELECT orders.* FROM oitems INNER JOIN orders ON oitems.orderid = orders.orderid"
sql=sql & " WHERE oitems.orderid=" & oid & " and oitems.catalogid=" & catalogid & " AND orders.ocustomerid=" & cid
If dconnflag=false then 
   set rs=dbc.execute(sql)
else
   set rs=oconn.execute(sql)
end if   
if rs.eof then
   rc=4
else
   rc=0
   validatepurchase rs, authorized
end if
closerecordset rs
end sub
'*******************************************************************
' look in product record for download link location
'*******************************************************************
Sub Getdownloadfile (rc, catalogid, filename, orderid, itemid)
dim productlink, rs
productlink=getconfig("xendoforderhyperlinkfield")   
sql="select * from products where catalogid=" & catalogid
If dconnflag=false then 
  set rs=dbc.execute(sql)
else
    set rs=pconn.execute(sql)
end if    
if rs.eof then
   rc=4
else
   rc=0
   filename=rs(productlink)
end if
If isnull(filename) then
    rc=4
else    
  GetProductlink filename,rs, catalogid, orderid, itemid 
end if    
closerecordset rs
end sub

'**************************************************************************
' need filename to have an absolute path. if it has one already use it
' otherwise mappath to it
'*********************************************************************
Sub Normalizedownloadfile (ifile, filename)
dim drivechar, fso
drivechar=mid(filename,2,1)
If drivechar=":" then
    ifile=filename
else
   ifile=server.mappath(filename)
end if
Set fso = CreateObject("Scripting.FileSystemObject")
If not (fso.FileExists(ifile)) Then
	serror = serror & getlang("LangDownloadNotExist") & "<br />"
End if
dim savename,savepos
savename=replace(filename,"/","\")
savepos=instrrev(savename,"\")
if savepos>0 then
	savename=right(savename,len(savename)-savepos)
end if
filename=savename
if ydebug="Yes" then 
  Debugwrite "real file name=" & filename
end if  
end sub

'*************************************************************************
' we need to update the download record in downloads table
' if it is first time we create one. otherwise we use on
'**************************************************************************
Sub Updatedownloadfile (rc, dbc, oid,cid, catalogid)
dim sql, rs, downloadcount, downloaddate, downloadlimit, today
dim downloadauth
sql="select * from downloads where orderid=" & oid
sql=sql & " and customerid=" & cid
sql=sql & " and catalogid=" & catalogid
set rs=dbc.execute(sql)
if rs.eof then
   closerecordset rs
   Createdownloadrecord oid,cid, catalogid 
   set rs=dbc.execute(sql)
end if
downloadcount=rs("downloadcount")
downloadlimit=rs("downloadmaxcount")
if downloadcount>=downloadlimit then 
   serror=serror & getlang("langdownloadmaxcount")
end if
downloaddate=rs("downloaddatelimit")
downloaddate=datedelimit(downloaddate)
today=datedelimit(date())
If today> downloaddate then
   serror=serror & getlang("langdownloadmaxdate") & "<br />"
end if
downloadauth=rs("authorized")   
if isnull(downloadauth) then
    serror=serror & getlang("langdownloadnotauthorized") & "<br />"
end if    
closerecordset rs
If serror="" then 
    Updatedownloadrecord rc, oid,cid, catalogid, downloadcount
end if  
end sub

'***************************************************************************
' Create download record
'**************************************************************************
Sub Createdownloadrecord (oid,cid, catalogid)
dim sql, fields, values, datelimit
datelimit=date
datelimit=date+clng(xdownloadlimitdays)
datelimit=datedelimit(datelimit)
Generatesql fields,values, "orderid",oid
Generatesql fields,values, "customerid",cid
Generatesql fields,values, "catalogid",catalogid
Generatesql fields,values, "downloadcount",0
Generatesql fields,values, "filename","'" & ifile & "'"
Generatesql fields,values, "downloaddatelimit",datelimit
Generatesql fields,values, "downloadmaxcount",xdownloadlimitcount
Generatesql fields,values, "downloadcreatedate",datedelimit(date)
If authorized<>"" Then
  Generatesql fields,values, "authorized","'Yes'"
end if  
sql="insert into downloads (" & fields & ") values(" & values & ")"
if ydebug="Yes" then 
  debugwrite sql
end if  	
dbc.execute(sql)
end sub

Sub Generatesql(fields,values, fieldname, fieldvalue)
if fields<>"" then
   fields=fields & ","
   values=values & ","
end if
fields=fields & fieldname
values=values & fieldvalue
end sub    
'*************************************************************************
' this is code that actually does the download file
' real file is mapped to real address
' filename was original file
'*************************************************************************

Sub DownloadFile (realfile, filename)
dim blockof, countof, ContentTypeOf, fso, sizeof, fileobject,BinaryStream
        Server.ScriptTimeout = 7200
	BlockOf = 100000
	CountOf = 0
	ContentTypeOf = "application/octet-stream"
	Set fso = CreateObject("Scripting.FileSystemObject")
	Set fileObject = fso.GetFile(realfile)
	SizeOf = fileObject.Size
	Set fileObject = nothing  
        set fso = nothing
	Response.Expires = 0
	Response.Buffer  = True
	Response.Clear
	Response.ContentType = ContentTypeOf
	Response.AddHeader "content-disposition", "attachment; filename=" & FileName
	Response.AddHeader "Content-Length", SizeOf
	Response.Flush
	Set BinaryStream = Server.CreateObject("ADODB.Stream")
	BinaryStream.Open
	BinaryStream.Type = 1
	BinaryStream.LoadFromFile(realfile)
	'Loop through data and send to browser
	While SizeOf > BlockOf + CountOf
	  CountOf = CountOf + BlockOf
	  Response.BinaryWrite BinaryStream.Read(BlockOf)
	  Response.Flush
	  Server.ScriptTimeout = 3200
   	Wend
	'Process last Block
	Response.BinaryWrite BinaryStream.Read(SizeOf - CountOf)
	Response.Flush
   	Response.End
   	BinaryStream.Close
	Set BinaryStream = Nothing
end sub
'
'
Sub ValidatePurchase (orderRS, authorized)
'*******************************************************
' See if payment type matches any of the valid payments allowed
'
'*******************************************************
Dim cardtype, cardarray(20),cardcount,paymenttype,i
authorized=""
CardType=Getconfig("xendofordervalidpayments")
paymenttype =ucase(orderrs("ocardtype"))
If cardtype="" then
   exit sub
end if
parserecord cardtype, cardarray,cardcount,","
for i = 0 to cardcount-1
   If ucase(cardarray(i))=paymenttype then
       Authorized="Yes"
       exit sub
   end if
next       
end sub

Sub Updatedownloadrecord (rc, oid,cid, catalogid, downloadcount)
dim lastdate, sql
lastdate=date()
lastdate=datedelimit(lastdate)
downloadcount=downloadcount+1
sql="update downloads set downloadcount=" & downloadcount
sql=sql & ",lastdownloaddate=" & lastdate
sql=sql & " where orderid=" & oid & " and catalogid=" & catalogid
dbc.execute(sql)
end sub   

'******************************************************************
' get link based on product feature
' Featureother1 can have field name to be used in the product record to get downaload link
' pother5 for example
'******************************************************************
Sub GetProductlink (link,rs, catalogid, orderid, itemid)   
dim orderdbc
If getconfig("xdownloadfeature")<>"Yes" then exit sub
dim itemrs, itemsql, flink, strfeatures, fsql, frs
dim featurecount, features(50), i, tlink
itemsql="select * from oitems where orderid=" & orderid & " and catalogid=" & catalogid
If itemid<>"" then 
  itemsql=itemsql & " and orderitemid=" & itemid
end if  
If dconnflag=false then
   set itemrs=dbc.execute(itemsql) 
else   
     set itemrs=oconn.execute(itemsql)    
end if         
if itemrs.eof then
    closerecordset itemrs
    exit sub
end if
strfeatures=itemrs("features")
closerecordset itemrs
If isnull(strfeatures) then exit sub
flink=""
parserecord strfeatures, features, featurecount,","
for i = 0 to featurecount-1
  fsql="select * from prodfeatures where id=" & features(i)
  'VP-ASP 6.09 - line below mistakenly reference dconn instead of dconnflag
  If dconnflag=false then 
    set frs=dbc.execute(fsql)
  else
    set frs=pconn.execute(fsql)
  end if
  if not frs.eof then
      flink=frs("featureother1")
      closerecordset frs
      if not isnull(flink) then
            exit for
       end if
   else
      closerecordset frs
   end if
next
If flink<>"" then
   tlink=rs(flink)
   If not isnull(tlink) then
      link=tlink
   end if   
end if
end sub

Sub OpenDownloadDatabase (dconnflag)
dconnflag=false
shopopendatabase dbc
If getconfig("xproductdb")<>"" or getconfig("xorderdb")<>""  then 
   Openorderdb oconn
   shopopendatabasep pconn
   dconnflag=true
end if   
end sub
Sub CloseDownloaddatabase (dconnflag)
shopclosedatabase dbc
If dconnflag=true then
   shopclosedatabase oconn
   shopclosedatabase pconn
end if   
end sub
%>