<% '***************************************************** ' Validate credit cards ' VP-ASP 6.50 add month year subs ' Jan 23, 2004 Check valid order '***************************************************** 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=ucase(left(strocardtype,5)) if testtype="DINER" then cctype="I" 'VP-ASP 6.5.1 - added code to handle Maestro cards instead of interpreting them as Mastercards if testtype="MAESTRO" then cctype="S" 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="16;18;19" 'VP-ASP 6.50 - added extra card lengths ccprefix="6759;5641" 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 & getlang("LangCheckoutError02") & "
" exit sub end if if right(strocardno,8)="11111111" then SError= SError & getlang("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 dim yearnum, year If len(strocardexpires)<>5 then Serror = Serror & getlang("LangCheckoutExpiryError") & "
" exit sub end if mm = left(strocardexpires,2) yy=right(strocardexpires,2) if not IsNumeric(mm) or Not Isnumeric(yy) then Serror = Serror & getlang("LangCheckoutExpiryNum") & "
" end if If serror="" then monthnum=month(date()) year=datepart("yyyy",date()) yearnum=right(year,2) if clng(yearnum)=clng(yy) then if clng(monthnum)> clng(mm) then Serror = Serror & getlang("LangInvaliddate") & "
" end if end if end if end sub ' Sub ValidateCVN if len(strocardCVN) = 0 then exit sub If len(strocardCVN)<3 then Serror = Serror & getlang("LangCheckoutCVNError") & "
" exit sub end if If len(strocardCVN)>4 then Serror = Serror & getlang("LangCheckoutCVNError") & "
" exit sub end if if not isnumeric(strOCardCVN) then Serror = Serror & getlang("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 'VP-ASP 6.50 - From date no longer required 'If strvalidfrom="" then ' serror=serror & "Valid From date is required for Switch
" 'end if end sub '*********************************************************************** ' Generate a select list for months '************************************************************************* Function GenerateMM (name, currentvalue) dim value value="" 'VP-ASP 6.50 - add blank option to top of list value = value & " " dim i, month, selected 'VP-ASP 6.50 - remove default selection 'month=datepart("m",date()) If currentvalue<>"" then month=currentvalue end if for i =1 to 12 name=i If len(Name)=1 then name="0" & name end if If name = month then Selected=" selected=""selected""" else Selected="" end if value=value & "" & Name & "" Next value=value & "" generatemm=value end function '*********************************************************************** ' Generate a select list for Years '************************************************************************* Function GenerateYY (name, currentvalue) dim value dim i, year, currentyear, selected, yearpart value="" 'VP-ASP 6.50 - add blank option to top of list value = value & " " year=datepart("yyyy",date()) 'VP-ASP 6.50 - remove default selection 'currentyear=year If currentvalue<>"" then currentyear=currentvalue end if for i =1 to 10 yearpart=right(year,2) if currentyear=Yearpart then Selected="selected=""selected""" else Selected="" end if value=value & "" & Yearpart & "" Year=year+1 Next value=value & "" Generateyy=value end function '*************************************************************************** ' if oid is lost, see if it really exists to protect against hacking '*************************************************************************** Sub Checkvalidorder (poid) dim rs, sql, dbc, orderid, cardtype poid=request("oid") If poid="" then exit sub end if If not isnumeric(poid) then poid="" exit sub end if poid=clng(poid) openorderdb dbc sql="select max(orderid) from orders" set rs=dbc.execute(sql) orderid=rs(0) closerecordset rs sql="select * from orders where orderid=" & orderid set rs=dbc.execute(sql) If not rs.eof then cardtype=rs("ocardtype") if isnull(cardtype) then cardtype="" else cardtype="unknown" end if closerecordset rs shopclosedatabase dbc ' If we have already paid, we cannot redo this order if orderid=poid and cardtype="" then setsess "oid",poid exit sub end if poid="" end sub %>