<%
'**************************************************************************
' Version 6.50
' we are now secure and in different session to need to reget info'
' after getting credit card details we update database with them
' unless the user has cancelled, in that case we delete order and items
' from the database
' If no prices, bypass asking for anything
' March 28, 2004 Support cookieless
'*************************************************************************
' Change these
dim sqltemp
dim ScancelAction
Dim AllowOtherPayment
Dim AllowCreditCards, AllowInvalidCreditCards
Dim encryptkey
dim strocardissue
dim oid
dim dbc
dim rstemp
Dim strOcardtype
Dim strOcardno
Dim strOcardname
Dim strOcardexpires
Dim strOcardaddress
Dim strOOther
Dim StroMore
Dim StrOAuthorization
dim strOCardCVN
dim sAction
Dim CardTypes(10)
Dim CardCount
Dim OtherTypes(10)
Dim OtherCount
Dim PaymentURL
dim strvalidfrom
dim strocardmm,strocardyy
Dim gateways
'
'*******************************************************
' Specify credit cards, non credit cards and whether credit cards should be checked
'********************************************************
AllowCreditCards=Getconfig("xallowcreditcards") ' Select credit Cards
AllowOtherPayment=Getconfig("xallowotherpayments") ' Other payment types
AllowInvalidCreditCards=Getconfig("xallowinvalidcards") ' validate credit card information
gateways=getconfig("xgateways")
paymenturl=getconfig("xpaymenturl")
EncryptKey=getconfig("xEncryptKey") ' Get encrypt key
Setsess "currenturl","shopcheckout.asp"
setsess "followonurl","shopthanks.asp"
SetSess "PaymentURL",paymentURL
'
cardcount=0
If getconfig("Xcreditcardtypes")<>"" then
parserecord getconfig("xcreditcardtypes"),cardtypes,cardcount,","
end if
othercount=0
If getconfig("XOtherpaymenttypes")<>"" then
parserecord getconfig("xotherpaymenttypes"),othertypes,othercount,","
end if
GetOrderInfo ' get orderid
sError=GetSess("PaymentError") ' on return for authorization there may be an error
SetSess "PaymentError","" ' reset
If getconfig("xDisplayPrices")<>"Yes" then
responseredirect GetSess("followonurl") ' go to shopthanks
end if
sAction=Request.form("Action")
if sAction="" then
sAction=Request.form("Action.x")
end if
sCancelAction=Request.form("Cancel")
if sCancelAction="" then
sCancelAction=Request.form("Cancel.x")
end if
'*****************************************************
' see they pushed button or want form displayed
'***************************************************
If sAction = "" and sCancelaction="" Then
ShopPageHeader ' put out normal header
SetDefaultvalues
DisplayForm() ' credit card form
ShopPagetrailer ' trailer
Else
GetFormFields
ValidateData
if sError = "" Then
UpdateCreditInfo ' add payment to daat base
if paymentURL<>"" then ' if there is an authorization
responseredirect PaymentURL & "?oid=" & oid
else
responseredirect GetSess("followonurl") ' go to shopthanks
end if
end if
ShopPageHeader
DisplayForm
ShopPageTrailer
end if
'****************************************************
' Put our credit card and non credit card form
'*************************************************
Sub DisplayForm
if getconfig("xbreadcrumbs") = "Yes" then
response.write "
"
If SError<>"" then
shopwriteError sError
end if
Displaygateways
Displaycreditcard
DisplayOtherPayment
Displaycancelbutton
End sub
Sub Displaygateways
Performgateway
If gateways="" Then exit sub
'exit sub
'dim i, files(10), filecount
'parserecord gateways,files, filecount,","
'for i = 0 to filecount-1
' Executefile files(i)
'next
end sub
'
Sub Executefile (filename)
'on error resume next
server.execute(filename)
if err.number>0 then
shopwriteerror err.description
shopwriteerror getlang("langmenufilename") & " " & filename
end if
end sub
'
Sub DisplayCreditcard
If AllowCreditCards<>"Yes" then exit sub
shopwriteheaderpic getlang("langCheckoutCreditCard"),"images/icons/creditcards.gif"
AddCreditImages
Response.Write(""
end Sub
'***************************************************
' Non credit card form
'***************************************************
Sub DisplayOtherPayment
If AllowOtherPayment<>"Yes" Then exit sub
shopwriteheaderpic getlang("langCheckoutOtherPaymentType"),"images/icons/cashier.gif"
Response.Write(""
end Sub
'
'***************************************************
' Non credit card form
'***************************************************
Sub DisplayCancelButton
Response.Write(""
end Sub
Sub GetorderInfo
' Either comes on querystring or on rentry is in session variables
oid=GetSess("oid")
If oid="" then
Checkvalidorder oid
If oid="" then
shoperror getlang("langSessionlost")
end if
end if
end sub
'
'**********************************************************
' did they select credit card or non credit card
'*********************************************************
Sub ValidateData
' see if user cancelled order
dim rc, action
dim cancelaction
if sCancelaction <>"" then
DeleteOrders ' delete order from database
shoperror getlang("langCheckoutCancelled")
end if
If stroCardtype=getlang("langCommonSelect") then
stroCardtype=""
end if
if stroOther=getlang("langCommonSelect") then
stroOther=""
end if
If stroOther="" and stroCardType="" then
sError=getlang("langCheckoutError01") & " "
exit sub
end if
If AllowCreditCards="Yes" and stroCardtype<>"" Then
ValidateCreditCards
exit sub
end if
If AllowOtherPayment="Yes" and stroOther<>"" Then
ValidateOtherPayment
exit sub
end if
end sub
'
Sub ValidateOtherPayment
' No validate needed we just accept it
end sub
'
Sub ValidateCreditCards
If strOcardtype = "" then
sError = sError & getlang("langCheckoutCardType") & " "
End if
If strOcardno = "" Then
sError = sError & getlang("langCheckoutCardNumber") & " "
end if
If strOcardname = "" Then
sError = sError & getlang("langCheckoutCardName") & " "
End If
If strOcardaddress = "" Then
sError = sError & getlang("langcheckoutaddress") & " "
End If
If getconfig("xCVNRequired")="Yes" and strOCardCVN = "" Then
sError = sError & getlang("langcheckoutCVN") & " "
end if
If Serror<>"" then
Serror = getlang("langCommonrequired") & " " & Serror
exit sub
end if
VerifyCreditCard
ValidateExpiry
ValidateCVN
ValidateSwitch
End Sub
'
Sub VerifyCreditCard
If AllowInvalidCreditCards="Yes" then
exit sub
end if
ShopValidatecreditcard strocardno, strocardtype, serror
end sub
'***************************************************************************
' add credit card info to order
'**************************************************************************
Sub UpdateCreditInfo
'VP-ASP 6.50 - broadened defintion of IF statement to cover cases where xmysql hasn't been set
if ucase(xdatabasetype) = "MYSQL" OR ucase(xdatabasetype) = "MYSQL351" OR getconfig("xMYSQL")="Yes" then
MYSQLUpdateCreditInfo
exit sub
end if
dim CVN, newcardno, oauthorization
Dim dbc
dim ucardno
OpenOrderDB dbc
ucardno=strocardno
Encryptkey=Getencryptkey
If getconfig("xEncryptCreditcard")="Yes" and encryptkey<>"" then
newcardno=EnDecrypt(strocardno, encryptkey)
ucardno=Converttoplain(newcardno)
end if
sqltemp="select * from orders where orderid=" & getsess("oid")
Set rstemp = Server.CreateObject("ADODB.Recordset")
rstemp.open sqltemp, dbc, 1, 3
if strOCardType<> "" then
' Credit card
updatefield "ocardtype",strocardtype
updatefield "ocardno",ucardno
updatefield "ocardname", strocardname
updatefield "ocardexpires",strocardexpires
updatefield "ocardaddress", strocardaddress
if strOCardCVN<>"" then
CVN="CVN " & stroCardCVN
Setsess "CVN",strocardcvn
oauthorization=cvn
end if
if strocardissue<>"" Then
If oauthorization="" Then
oauthorization=getlang("langcardissue") &"=" & strocardissue
else
oauthorization=oauthorization & " " & getlang("langcardissue") &"=" & strocardissue
end if
end if
if strvalidfrom<>"" then
oauthorization=oauthorization & " " & getlang("langvalidfromdate") &"=" & strvalidfrom
end if
updatefield "oauthorization", oauthorization
else
' Other payment
paymenturl=""
updatefield "ocardtype",stroother
updatefield "ocardname", stromore
end if
rstemp.update
rstemp.close
set rstemp=nothing
ShopcloseDatabase dbc
End Sub
Sub UpdateField (fieldname, fieldvalue)
if fieldvalue="" then
exit sub
end if
if ucase(fieldvalue)="NULL" then
rstemp(Fieldname)=NULL
else
rstemp(Fieldname)=fieldvalue
end if
end sub
Sub DeleteOrders
OpenOrderDB dbc
CancelOrderRecord dbc,oid
shopCloseDatabase dbc
ShopCancelOrder
end sub
'
Sub GetFormFields
'VP-ASP 6.50 - precautionary security fix
strOcardtype = cleanchars(Request.Form("strOcardtype"))
strOcardno = cleanchars(Request.Form("strOcardno"))
strOcardname = cleanchars(Request.Form("strOcardname"))
strOcardmm = cleanchars(Request.Form("strOcardmm"))
strOcardyy = cleanchars(Request.Form("strOcardyy"))
strocardexpires=strocardmm & "/" & strocardyy
strOcardaddress = cleanchars(Request.Form("strOcardaddress"))
StroOther=cleanchars(Request.Form("stroOther"))
StroMore=cleanchars(Request.form("StroMore"))
stroCardcvn=cleanchars(request.form("strOCardCVN"))
stroCardIssue=cleanchars(request.form("strOCardIssue"))
strvalidfrom=cleanchars(request.form("strvalidfrom"))
End Sub
Sub SetDefaultvalues
'***************************************************************************
' Set default values from session variables
'**************************************************************************
If strocardname<>"" then exit sub
strocardname=getsess("firstname") & " " & getsess("lastname")
strocardaddress=getsess("address")
end sub
'
Sub addCreditImages
dim images, i,words(10), wordcount
images=getconfig("xcreditcardimages")
if images="" then exit sub
parserecord images, words, wordcount,","
Response.write "
"
for i = 0 to wordcount-1
If i >0 then
response.write " "
end if
Response.write ""
next
Response.write "