<% 'VP-ASP 6.50 - removed and added to shopmail.asp 'Dim arrayemaillinks(50,2) ' for use in emailing download links 'Dim arrayemaillinkscount Sub ShopThanksLinks (myconn,OrderID, attachmentarray, attachmentcount) '**************************************************************** ' VP-ASP 6.50 ' Merchant can add additional messages ' analyze fields in the order ' set the name of an attachment file ' attachment must be full path name such as c:\images\abc.gif ' Inputs Orderid = number of the order ' OrderRs = already open recordset to the order. Do not close it ' Outputs ' Orderattachment - file to be attached (only works with ASPMAIL) ' April 7, 2004 Fix feature based download ' VP-ASP 6.50 ' Sept 18, 2004 handle split database ' Oct 2, 2004 Fix case on ocardtype ' July 6, 2005 Capture Download Links for emailing ' Dec 7, 2006 Email secure downloads '****************************************************************** attachmentcount=0 arrayemaillinkscount=0 If Getconfig("Xhackeriptocountry")="Yes" Then dim ipaddress, ipcountry, ipcountryname ipaddress=request.servervariables("REMOTE_ADDR") Iptocountry ipaddress, ipcountry, ipcountryname ShopCountryUpdate myconn, orderid, ipcountry, ipcountryname end if If Getconfig("xdownloads")="Yes" then GenerateSecureHyperlinks myconn,Orderid end if If Getconfig("xendoforderhyperlinks")="Yes" then GenerateHyperlinks myconn,Orderid end if If Getconfig("xendoforderattachments")="Yes" then GenerateAttachments myconn,Orderid, attachmentarray, attachmentcount end if If Getconfig("xpoints")="Yes" then Generatepoints myconn, orderid end if end sub Sub GenerateHyperlinks (Orderconn,Orderid) dim rc dim ProductRS Dim strSQL dim orderRS dim productcatalogid, downloadcount If getconfig("xdownloadblock")="Yes" then exit sub end if InternalOpenOrder Orderconn, OrderRs, orderid ValidatePurchase OrderRS, rc downloadcount=0 If rc<>0 then Closerecordset orderRs exit sub end if strSQL = "select * FROM oitems where orderid = " & OrderRS("orderid") Set ProductRS = orderconn.Execute(strSQL) ' Do While Not ProductRS.EOF Productcatalogid=productrs("catalogid") GenerateHyperlink orderconn,Productcatalogid, downloadcount ProductRS.MoveNext Loop closerecordset productrs Closerecordset orderrs Response.write "
" end sub ' Sub InternalOpenOrder (myconn,rsorder, ordernumber) dim sql sql = "select * from orders where orderid=" & clng(ordernumber) Set rsorder = myconn.Execute(SQL) end sub ' Sub GenerateHyperlink (myconn,catalogid, count) dim productlink, pconn, pconnflag 'VP-ASP 6.50 - email secure links dim url, prefix productlink=getconfig("xendoforderhyperlinkfield") dim productsql, rs, cname, filename If catalogid= 0 then exit sub OpenProductDatabaseOrder pconn, pconnflag Productsql="select * from products where catalogid=" & catalogid If pconnflag=true then set rs=pconn.execute(productsql) else set rs=myconn.execute(productsql) end if if rs.eof then closeRecordset rs CloseProductDatabaseOrder pconn, pconnflag exit sub end if cname=rs("cname") cname=translatelanguage(pconn, "products", "cname","catalogid", catalogid, cname) filename=rs(productlink) if isnull(filename) then closerecordset rs CloseProductDatabaseOrder pconn, pconnflag exit sub end if If count=0 then shopwriteheader getlang("LangdownloadFiles") end if %>
<%=cname%> <% 'VP-ASP 6.50 - email secure links url=filename prefix=left(filename,4) if lcase(prefix)<>"http" then url=getconfig("xmysite") & filename end if ' 6.0 'Capture the download link in a two dimensional array so it can be easily called with catalogid paramater arrayemaillinks(arrayemaillinkscount,0)=catalogid 'VP-ASP 6.50 - email secure links arrayemaillinks(arrayemaillinkscount,1)=url arrayemaillinkscount=arrayemaillinkscount+1 CloseRecordset rs CloseProductDatabaseOrder pconn, pconnflag count=count+1 end sub ' Sub ValidatePurchase (orderRS, rc) '******************************************************* ' See if payment type matches any of the valid payments allowed ' '******************************************************* Dim cardtype, cardarray(20),cardcount,paymenttype,i rc=0 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 exit sub end if next rc=4 end sub ' Sub GenerateAttachments (orderconn, Orderid, attachmentarray, attachmentcount) dim rc dim ProductRS, orderRS Dim strSQL dim productcatalogid If getconfig("xdownloadblock")="Yes" then exit sub end if InternalOpenOrder Orderconn, OrderRs, orderid ValidatePurchase OrderRS, rc If rc<>0 then Closerecordset orderRS exit sub end if strSQL = "select * FROM oitems where orderid = " & OrderRS("orderid") Set ProductRS = orderconn.Execute(strSQL) ' Do While Not ProductRS.EOF Productcatalogid=productrs("catalogid") GenerateAttachment orderconn, Productcatalogid, attachmentarray,attachmentcount ProductRS.MoveNext Loop CloseRecordset productrs CloseRecordset OrderRS end sub ' Sub GenerateAttachment (myconn, catalogid, attachmentarray, attachmentcount) dim productlink, pconn, pconnflag productlink=getconfig("xendoforderattachmentfield") dim productsql, rs, cname, filename If catalogid= 0 then exit sub OpenProductDatabaseOrder pconn, pconnflag Productsql="select * from products where catalogid=" & catalogid If pconnflag=true then set rs=pconn.execute(productsql) else set rs=myconn.execute(productsql) end if if rs.eof then closerecordset rs CloseProductDatabaseOrder pconn, pconnflag exit sub end if filename=rs(productlink) if isnull(filename) then closerecordset rs CloseProductDatabaseOrder pconn, pconnflag exit sub end if attachmentarray(attachmentcount)=filename attachmentcount=attachmentcount+1 closerecordset rs CloseProductDatabaseOrder pconn, pconnflag end sub '****************************************************************** '" secure hyperlink goes to shopdownload.asp '******************************************************************** Sub GenerateSecureHyperlinks (Orderconn,Orderid) dim rc dim ProductRS Dim strSQL dim orderRS dim productcatalogid, downloadcount InternalOpenOrder Orderconn, OrderRs, orderid ValidatePurchase OrderRS, rc downloadcount=0 If rc<>0 then Closerecordset orderRs exit sub end if strSQL = "select * FROM oitems where orderid = " & OrderRS("orderid") Set ProductRS = orderconn.Execute(strSQL) ' Do While Not ProductRS.EOF Productcatalogid=productrs("catalogid") GenerateSecureHyperlink orderconn,Productcatalogid, downloadcount, orderid, orderrs, productRS ProductRS.MoveNext Loop closerecordset productrs Closerecordset orderrs end sub '******************************************************************************** ' Generate secure hyperlink to shopdownload.asp '******************************************************************************* Sub GenerateSecureHyperlink (myconn,catalogid, count, orderid, orderRS,oitems) dim productlink, oid, customerid, url dim restorereallinks dim Pconn, pconnflag customerid=orderrs("ocustomerid") productlink=getconfig("xendoforderhyperlinkfield") dim productsql, rs, cname, filename If catalogid= 0 then exit sub OpenProductDatabaseOrder pconn, pconnflag Productsql="select * from products where catalogid=" & catalogid If pconnflag=True then set rs=pconn.execute(productsql) else set rs=myconn.execute(productsql) end if if rs.eof then closeRecordset rs CloseProductDatabaseOrder pconn, pconnflag exit sub end if cname=rs("cname") url=rs(productlink) if isnull(url) then closerecordset rs CloseProductDatabaseOrder pconn, pconnflag exit sub end if dim item, features, featurename item=oitems("orderitemid") features=oitems("features") If not isnull(features) then featurename=Getfeaturename(myconn, features, pconn, pconnflag) cname = cname & " " & featurename end if Restorereallinks=getconfig("xdownloadreallinks") If RestorerealLinks="Yes" then filename="shopdownloadreal.asp?oid=" & orderid & "&catalogid=" & catalogid & "&item=" & item else filename="shopdownload.asp?oid=" & orderid & "&catalogid=" & catalogid & "&item=" & item end if If count=0 then shopwriteheader getlang("LangdownloadFiles") end if %>
<%=cname%>
<% CloseRecordset rs CloseProductDatabaseOrder pconn, pconnflag count=count+1 'VP-ASP 6.50 - email secure links If getconfig("xdownloadsemail")="Yes" then 'Capture the download link in a two dimensional array so it can be easily called with catalogid paramater url=getconfig("xmysite") & filename & "&cid=" & customerid arrayemaillinks(arrayemaillinkscount,0)=catalogid arrayemaillinks(arrayemaillinkscount,1)=url arrayemaillinkscount=arrayemaillinkscount+1 end if end sub Function getfeaturename(myconn, strfeatures, pconn, pconnflag) dim features(10), featurecount, frs, fsql, featurename parserecord strfeatures, features, featurecount,"," fsql="select * from prodfeatures where id=" & features(0) if pconnflag=True then set frs=pconn.execute(fsql) else set frs=myconn.execute(fsql) end if featurename=frs("featurename") closerecordset frs getfeaturename=featurename end function Sub OpenProductdatabaseOrder (pconn, pconnflag) pconnflag=false If getconfig("xproductdb")<>"" or getconfig("xorderdb")<>"" then shopopendatabasep pconn pconnflag=true end if end sub Sub CloseProductdatabaseOrder (pconn, pconnflag) If pconnflag=true then shopclosedatabase pconn end if end sub %>