<%
'**************************************************************************
' Version 4.00 Sept 19, 2001
' 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
' add issue number
'*************************************************************************
' Change these
dim sqltemp
dim ScancelAction
Dim AllowOtherPayment
Dim AllowCreditCards, AllowInvalidCreditCards
Dim encryptkey
dim strocardissue
AllowCreditCards=Getconfig("xallowcreditcards") ' Select credit Cards
AllowOtherPayment=Getconfig("xallowotherpayments") ' Other payment types
AllowInvalidCreditCards=Getconfig("xallowinvalidcards") ' validate credit card information
EncryptKey=getconfig("xEncryptKey") ' Get encrypt key
Setsess "currenturl","shopcheckout.asp"
' Change for your credit card
Dim CardTypes(10)
Dim CardCount
cardcount=0
If getconfig("Xcreditcardtypes")<>"" then
parserecord getconfig("xcreditcardtypes"),cardtypes,cardcount,","
end if
' Change for your other types
Dim OtherTypes(10)
Dim OtherCount
othercount=0
If getconfig("XOtherpaymenttypes")<>"" then
parserecord getconfig("xotherpaymenttypes"),othertypes,othercount,","
end if
Dim PaymentURL
PaymentURL="" ' to authorize payment
'
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
'
setsess "currenturl","shopcheckout.asp"
setsess "followonurl","shopthanks.asp"
SetSess "PaymentURL",paymentURL
GetOrderInfo ' get orderid
sError=GetSess("PaymentError") ' on return for authorization there may be an error
SetSess "PaymentError","" ' reset
If getconfig("xDisplayPrices")<>"Yes" then
response.redirect 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
If sAction = "" and sCancelaction="" Then
ShopPageHeader ' put out normal header
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
response.redirect PaymentURL & "?oid=" & oid
else
response.redirect GetSess("followonurl") ' go to shopthanks
end if
end if
ShopPageHeader
DisplayForm
ShopPageTrailer
end if
Sub DisplayForm
If SError<>"" then
Response.Write(getconfig("xfont") & " " & sError & "")
end if
PerformGateway
Response.Write("" & getconfig("xfont") & LangCheckout01 & " ")
Response.Write("")
End Sub
'
Sub AddCreditCard
If AllowCreditCards="Yes" Then
Response.Write("
")
end if
end Sub
Sub GetorderInfo
' Either comes on querystring or on rentry is in session variables
oid=getsess("oid")
if oid="" then
oid=GetSess("oid")
else
SetSess "oid", oid
end if
If oid="" then
Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (LangCheckoutProcessed)
end if
SetSess "oid", oid ' debug only
end sub
'
Sub ValidateData
' see if user cancelled order
dim rc, action
dim cancelaction
if sCancelaction <>"" then
DeleteOrders ' delete order from database
Response.Redirect "shoperror.asp?msg=" & Server.URLEncode (LangCheckoutCancelled)
end if
If stroCardtype=LangCommonSelect then
stroCardtype=""
end if
if stroOther=LangCommonSelect then
stroOther=""
end if
If stroOther="" and stroCardType="" then
sError=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 & LangCheckoutCardType & " "
End if
If strOcardno = "" Then
sError = sError & LangCheckoutCardNumber & " "
end if
If strOcardname = "" Then
sError = sError & LangCheckoutCardName & " "
End If
If strOcardexpires = "" Then
sError = sError & LangCheckoutExpiry & " "
end if
If strOcardaddress = "" Then
sError = sError & Langcheckoutaddress & " "
End If
If getconfig("xCVNRequired")="Yes" and strOCardCVN = "" Then
sError = sError & LangcheckoutCVN & " "
end if
If Serror<>"" then
Serror = LangCommonrequired & " " & Serror
exit sub
end if
VerifyCreditCard
ValidateExpiry
ValidateCVN
End Sub
'
Sub VerifyCreditCard
dim cctype, ctype, cclength, ccprefix, prefixes, lengths
dim ccNumber, number, prefixvalid, lengthvalid, prefix
Dim cccheck, length, result, qsum, x, ch, sum, checkcc
If AllowInvalidCreditCards="Yes" then
exit sub
end if
ccType = ucase(Left(StrocardType,1))
ccnumber=strocardno
ctype=ucase(cctype)
select case ctype
case "V"
cclength="13;16"
ccprefix="4"
case "M"
cclength="16"
ccprefix="51;52;53;54;55"
case "A"
cclength="15"
ccprefix="34;37"
case "C"
cclength="14"
ccprefix="300;301;302;303;304;305;36;38"
case "D"
cclength="16"
ccprefix="6011"
case "E"
cclength="15"
ccprefix="2014;2149"
case "J"
cclength="15;16"
ccprefix="3;2131;1800"
case else
cclength=""
ccprefix=""
end select
prefixes=split(ccprefix,";",-1)
lengths=split(cclength,";",-1)
number=trimtodigits(ccnumber)
prefixvalid=false
lengthvalid=false
for each prefix in prefixes
if instr(number,prefix)=1 then
prefixvalid=true
end if
next
for each length in lengths
if cstr(len(number))=length then
lengthvalid=true
end if
next
result=0
if not prefixvalid then
result=result+1
end if
if not lengthvalid then
result=result+2
end if
qsum=0
for x=1 to len(number)
ch=mid(number,len(number)-x+1,1)
'response.write ch
if x mod 2=0 then
sum=2*cint(ch)
qsum=qsum+(sum mod 10)
if sum>9 then
qsum=qsum+1
end if
else
qsum=qsum+cint(ch)
end if
next
'response.write qsum
if qsum mod 10<>0 then
result=result+4
end if
if cclength="" then
result=result+8
end if
checkcc=result
if checkcc<> 0 then
SError= SError & LangCheckoutError02 & " "
exit sub
end if
if right(strocardno,8)="11111111" then
SError= SError & LangCheckoutError02 & " "
end if
end sub
' add credit card info to order
Sub UpdateCreditInfo
dim CVN, newcardno
Dim dbc
OpenOrderDB dbc
Encryptkey=Getencryptkey
If getconfig("xEncryptCreditcard")="Yes" and encryptkey<>"" then
newcardno=EnDecrypt(strocardno, encryptkey)
newcardno=replace(newcardno,"'","''")
strocardno=newcardno
end if
sqltemp=""
if strOCardType<> "" then
' Credit card
updatefield "ocardtype",strocardtype
updatefield "ocardno",strocardno
updatefield "ocardname", strocardname
updatefield "ocardexpires",strocardexpires
updatefield "ocardaddress", strocardaddress
if strOCardCVN<>"" then
CVN="CVN " & stroCardCVN
updatefield "oauthorization", cvn
end if
if strocardissue<>"" Then
If oauthorization="" Then
oauthorization=langcardissue &"=" & strocardissue
else
oauthorization=oauthorization & " " & langcardissue &"=" & strocardissue
end if
UpdateField "OAuthorization", oauthorization
end if
else
' Other payment
updatefield "ocardtype",stroother
updatefield "ocardname", stromore
end if
sqltemp="update orders " & sqltemp & " where orderid=" & oid
debugwrite sqltemp
dbc.execute(sqltemp)
ShopcloseDatabase dbc
End Sub
Sub UpdateField (fieldname, fieldvalue)
if fieldvalue="" then
exit sub
end if
if sqltemp="" then
sqltemp="SET "
else
sqltemp=sqltemp &","
end if
sqltemp=sqltemp & fieldname & "='" & fieldvalue & "'"
end sub
Sub DeleteOrders
OpenOrderDB dbc
CancelOrderRecord dbc,oid
shopCloseDatabase dbc
ShopCancelOrder
end sub
'
Sub GetFormFields
strOcardtype = Request.Form("strOcardtype")
strOcardno = Request.Form("strOcardno")
strOcardname = Request.Form("strOcardname")
strOcardexpires = Request.Form("strOcardexpires")
strOcardaddress = Request.Form("strOcardaddress")
StroOther=Request.Form("stroOther")
StroMore=Request.form("StroMore")
stroCardcvn=request.form("strOCardCVN")
stroCardIssue=request.form("strOCardIssue")
End Sub
'
function trimtodigits(tstring)
dim s, ts, x, ch
'removes all chars except of 0-9
s=""
ts=tstring
for x=1 to len(ts)
ch=mid(ts,x,1)
if asc(ch)>=48 and asc(ch)<=57 then
s=s & ch
end if
next
trimtodigits=s
end function
'
Sub ValidateExpiry
dim mm
dim yy
If len(strocardexpires)<>5 then
Serror = Serror & LangCheckoutExpiryError & " "
exit sub
end if
mm = left(strocardexpires,2)
yy=right(strocardexpires,2)
if not IsNumeric(mm) or Not Isnumeric(yy) then
Serror = Serror & LangCheckoutExpiryNum & " "
end if
end sub
'
Sub ValidateCVN
If getconfig("xCVNRequired")<>"Yes" then
exit sub
end if
If len(strocardCVN)<>3 then
Serror = Serror & LangCheckoutCVNError & " "
exit sub
end if
if not isnumeric(strOCardCVN) then
Serror = Serror & LangCheckoutCVNError & " "
exit sub
end if
end sub
%>