<%
const CVNDisplay="Yes"
const CVNRequired="No"
const xcardissuenumber="No"
'**************************************************************************
' Version 4.50 obtain Payment details Avoid security popup
' Used when SSL is on a different Server.
' Goes to sslresult.asp Task=CC, task=NOCC, task=Cancel
' oid=nnn
' July 8, 2002
' add solo, switch and new subroutine to validate credit cards
'*************************************************************************
' Change this line
const MYSITE="http://www.yourshoppingsite.com/shopping"
'
const xEncryptkey="agabAhjBcG"
const xlanguage=""
'
Dim AllowOtherpayment
Dim AllowCreditCards, allowinvalidcreditcards, Serror
AllowCreditCards="Yes" ' Select credit Cards
AllowOtherPayment="Yes" ' Other payment types
AllowInvalidCreditCards="No" ' validate credit card information
' Change for your credit card
Dim CardTypes(10)
Dim CardCount
CardTypes(0)="Visa"
CardTypes(1)="Mastercard"
CardTypes(2)="American Express"
cardcount=3
dim Resultinfo
' Change for your other types
Dim OtherTypes(10)
Dim OtherCount
OtherTypes(0)="Check"
OtherTypes(1)="Cash"
OtherTypes(2)="Phone Order"
othercount=3
Dim PaymentURL
PaymentURL= MYSITE & "/sslresult.asp" ' 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 strvalidfrom,strocardissue
Dim sAction
'
SetSess "CurrentURL","sslShopCheckout.asp"
GetOrderInfo ' get orderid
sError=Session("PaymentError") ' on return for authorization there may be an error
SetSess "PaymentError","" ' reset
sAction=Request.form("Action")
If sAction = "" Then
NewShopPageHeader ' put out normal header
DisplayForm() ' credit card form
NewShopPagetrailer ' trailer
Else
GetFormFields
ValidateData
if sError = "" Then
UpdateCreditInfo ' add payment to daat base
GenerateLink paymenturl & "?" & Resultinfo
'response.redirect PaymentURL & "?" & ResultInfo
else
NewShopPageHeader
DisplayForm
NewShopPageTrailer
end if
end if
Sub DisplayForm
Response.Write("" & zfont & LangCheckout01 & " ")
If SError<>"" then
Response.Write("" & " " & sError & "")
end if
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=request("oid")
if oid="" then
oid=Session("oid")
else
Session("oid") = oid
end if
If oid="" then
Response.Redirect MYSITE & "/shoperror.asp?msg=" & Server.URLEncode (LangCheckoutProcessed)
end if
end sub
'
Sub ValidateData
' see if user cancelled order
dim rc, action
dim cancelaction
action = ucase(left(request.form("action"),6))
cancelaction=ucase(left(langCommonCancelOrder,6))
if action = cancelaction then
DeleteOrders ' delete order from database
response.redirect PaymentURL & "?" & ResultInfo
exit sub
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 CVNRequired="Yes" and strOCardCVN = "" Then
sError = sError & LangcheckoutCVN & " "
end if
If Serror<>"" then
Serror = 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
dim hashkey, CVN
dim oauthorization
hashkey=xEncryptKey
dim temp
if strOCardType<> "" then
' Credit card
Resultinfo="Task=CC&oid=" & oid
UpdateField "Ocardtype",strOcardtype
temp=enDecrypt(strocardno, hashkey)
Temp=replace(temp,chr(0),"AAAA")
UpdateField "Ocardno",temp
UpdateField "Ocardname", strocardname
UpdateField "Ocardexpires",strOcardexpires
UpdateField "Ocardaddress", strOcardaddress
if strOCardCVN<>"" then
CVN="CVN " & stroCardCVN
oauthorization=cvn
end if
if strocardissue<>"" Then
If oauthorization="" Then
oauthorization=langcardissue &"=" & strocardissue
else
oauthorization=oauthorization & " " & langcardissue &"=" & strocardissue
end if
end if
if strvalidfrom<>"" then
oauthorization=oauthorization & " " & langvalidfromdate &"=" & strvalidfrom
end if
UpdateField "OAuthorization", oauthorization
else
' Other payment
Resultinfo="Task=NOCC&oid=" & oid
UpdateField "Ocardtype",strOOther
UpdateField "Ocardname", strOMore
end if
End Sub
'
Sub UpdateField (fieldname, fieldvalue)
if fieldvalue="" then
exit sub
end if
Resultinfo=Resultinfo & "&" & fieldname & "=" & Server.urlencode(fieldvalue)
end sub
'
Sub DeleteOrders
resultinfo="Task=Cancel&oid=" & Session("oid")
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")
strvalidfrom=request.form("strvalidfrom")
End Sub
Sub NewShopPageHeader
%>
VP-ASP Shopping Cart
<%
end sub
Sub NewShopPageTrailer
%>
<%
End Sub
Sub GenerateSelectNV (iFieldnames,currentvalue,selectname, count,firstfield)
' Generates select with no values
dim i
%>
<%
end sub
Function LanguageGet
if session("Language")="" then
Setsess ("Language")=xlanguage
end if
languageGet=Session("Language")
end function
'*****************************************************
' Validate credit cards
' VP-ASP 4.50
'*****************************************************
Sub ShopValidatecreditcard (strocardno, strocardtype, serror)
dim cctype, ctype, cclength, ccprefix, prefixes, lengths
dim ccNumber, number, prefixvalid, lengthvalid, prefix
Dim cccheck, length, result, qsum, x, ch, sum, checkcc
dim testtype
ccType = ucase(Left(StrocardType,1))
testtype=left(strocardtype,5)
if testtype="DINER" then cctype=I
ccnumber=strocardno
ctype=ucase(cctype)
select case ctype
case "V" ' Visa
cclength="13;16"
ccprefix="4"
case "M" ' Mastercard
cclength="16"
ccprefix="51;52;53;54;55"
case "A" ' American express
cclength="15"
ccprefix="34;37"
case "I" ' Diners
cclength="14"
ccprefix="300;301;302;303;304;305;36;38"
case "D" ' discover/Novus
cclength="16"
ccprefix="6011"
case "E" ' ?
cclength="15"
ccprefix="2014;2149"
case "J" ' JCB
cclength="15;16"
ccprefix="3;2131;1800"
case "C" ' Connect
cclength="16"
ccprefix="4539"
case "S" ' Solo Switch
cclength="19"
ccprefix="6759"
case "B" ' Bankcard
cclength="16"
ccprefix="5610"
case else
cclength=""
ccprefix=""
end select
prefixes=split(ccprefix,";",-1)
lengths=split(cclength,";",-1)
number=trimtodigits(ccnumber)
prefixvalid=false
lengthvalid=false
if ccprefix<>"" then
for each prefix in prefixes
if instr(number,prefix)=1 then
prefixvalid=true
end if
next
else
prefixvalid=true
end if
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
function trimtodigits(tstring)
'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 CVNRequired<>"Yes" then
exit sub
end if
If len(strocardCVN)>4 then
Serror = Serror & LangCheckoutCVNError & " "
exit sub
end if
if not isnumeric(strOCardCVN) then
Serror = Serror & LangCheckoutCVNError & " "
exit sub
end if
end sub
'
Sub ValidateSWitch
if ucase(strocardtype)<>"SWITCH" then exit sub
if strocardissue="" then
serror=serror & "Issue number is required for Switch "
else
if not isnumeric(strocardissue) then
Serror = Serror & "Issue Number must be numeric" & " "
end if
end if
If strvalidfrom="" then
serror=serror & "Valid From date is required for Switch "
end if
end sub
Sub GenerateLink (url)
'NewShopPageHeader
%>
VP-ASP Shopping Cart
Please use this >Link if you are not autmatically transferred.
<%
NewShopPageTrailer
end sub
%>