<%
'==========================
'  Common Functions
'==========================

SUB errorForm( errorMSG, backpage )
  %>
<head>
<title>Data Entry Problem</title>
</head>
<center>  
<h1>Data Entry Problem</h1>
<p>
Please press 'Return' to go back to the previous screen to correct the highlighted error
<p>
<font color="red"><b><%=errorMSG%></b></font>
<br>
<form method="post" action="<%=backpage%>">
<input name="error" type="hidden" value="1">
<% formFields %>
<input type="submit" value="Return"> 
</form>
</center>
<%
Response.End
END SUB


SUB formFields
  FOR each item in Request.Form
  %>
  <input name="<%=item%>" type="hidden"
    value="<%=Server.HTMLEncode( Request( item ) )%>">
  <%
  NEXT
END SUB


Function Defstyles
'define default styles for page
%>
h1		{ margin-top: 0; margin-bottom: 0 }
body	{ margin-top: 0; margin-bottom: 0 }
<%
end function


Function Parentfolder(cfilename)
' return the parent folder name of a selected file
Dim fs, f
lcrealpath = server.mappath(cfilename)
set fs = CreateObject("Scripting.FileSystemObject")
set f = fs.getfile(lcrealpath)
parentfolder = lcase(f.parentfolder)
set fs = nothing
set f = nothing
end function


Function Fileexists(cfilename)
' Check if a specific file exists eg fileexists("status\Uploading.txt")
' get physical path of a known file name first then strip file name
' so just have directory then look for a file in same directory
lcrealpath = server.mappath("bkiteventavail.asp")
lcrealpath = left(lcrealpath,len(lcrealpath)-18)
Set fs = CreateObject("Scripting.FileSystemObject")
fileexists = fs.fileexists(lcrealpath & cfilename)
set fs = nothing
end function

Function Createfile(cfilename, ccontents)
' Create a textfile in the main Book-It asp directory
lcrealpath = server.mappath("bkiteventavail.asp")
lcrealpath = left(lcrealpath,len(lcrealpath)-18)
Set fs = CreateObject("Scripting.FileSystemObject")
set textfile = fs.createtextfile(lcrealpath & cfilename)
textfile.writeline(ccontents)
textfile.close
set textfile = Nothing
set fs = Nothing
createfile = True
end function

Function Deletefile(cfilename)
' Delete a file in the main Book-It asp directory
lcrealpath = server.mappath("bkiteventavail.asp")
lcrealpath = left(lcrealpath,len(lcrealpath)-18)
Set fs = CreateObject("Scripting.FileSystemObject")
fs.deletefile(lcrealpath & cfilename)
set fs = Nothing
end function


Sub Sendemail (cto, csubject, cfrom, cbody)
' send a cdonts email
Set objMail 		= Server.CreateObject("CDONTS.Newmail")
objMail.To 		= cto
objMail.Subject 	= csubject
objMail.From 		= cfrom
objMail.Body 		= cbody
objMail.Send
Set objMail = Nothing
end sub



Function Showbutton (cbutton, caction)
if cbutton = "Change Login" then
	ref = ""
end if
cbutton = space((14 - len(cbutton))/2) & cbutton & space((14 - len(cbutton))/2)
%>
<form method="POST" action="<%= caction %>">
  <input name="ref" type="hidden" value=<%= ref %> >
  <p align="center">
  <input type="submit" value="<%= cbutton %>" name="B1">
</form>
<%
end function

Function Pagefooter
%>
<center>
<font face="Times New Roman" size="2">Page automatically generated by <a href="http://www.instinctive.co.uk" target="_blank">Book-It</a> 
membership booking software</font>
</center>
<%
end function

Function Datecreated(filespec)
    Dim fs, f, s
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(filespec)
	 Datecreated = f.DateCreated
End Function


Function getpath(ppathtype)
' returns the path of the home page upload directory or the secure server
' directory depending on parameter passed

	select case ucase(ppathtype)
		case "WEB"
			lcpath = trim(defaultsrs("cweb"))
			if len(trim(defaultsrs("cftpupdir"))) > 0 then
				lcpath = lcpath & "/" & trim(defaultsrs("cftpupdir"))
			end if
			if not ucase(left(lcpath,4)) = "HTTP" then
				lcpath = "http://" & lcpath
			end if
		case "HOME"
			if len(trim(defaultsrs("chomepage"))) > 0 then
				lcpath = trim(defaultsrs("chomepage"))
				if not ucase(left(lcpath,4)) = "HTTP" then
					lcpath = trim(defaultsrs("cweb"))+"/"+lcpath
				end if
			else
				lcpath = trim(defaultsrs("cweb"))
			end if
			if not ucase(left(lcpath,4)) = "HTTP" then
				lcpath = "http://" & lcpath
			end if
		case "SSL"
			if len(trim(defaultsrs("cssl"))) > 0 then
				lcpath = trim(defaultsrs("cssl"))
				if len(trim(defaultsrs("cftpupdir"))) > 0 then
					lcpath = lcpath & "/" & trim(defaultsrs("cftpupdir"))
				end if
			else
				lcpath = trim(defaultsrs("cweb"))
				if len(trim(defaultsrs("cftpupdir"))) > 0 then
					lcpath = lcpath & "/" & trim(defaultsrs("cftpupdir"))
				end if
			end if
		case else
			lcpath = "Bad path call"
	end select
	getpath = lcase(lcpath)

end function


Function Nextno(cdbftype)
  sqlString = "SELECT inextno, nfldsize from bkitnextid where cdbfname = '" & cdbftype & "'"
  SET RS = Con.Execute( sqlString )
  nextno = string(cint(rs("nfldsize"))-len(trim(rs("inextno"))),"0") & trim(rs("inextno"))
  sqlString = "update bkitnextid set inextno=inextno+1 where cdbfname='" & cdbftype & "'"
  SET RS = Con.Execute( sqlString )
End Function




FUNCTION fixQuotes( theString )
  fixQuotes = REPLACE( theString, "'", "''" )
END FUNCTION


SUB addCookie( theName, theValue )
	Response.Cookies( theName ) = theValue
	Response.Cookies( theName ).Expires = "July 31, 2001"
	Response.Cookies( theName ).Path = "/"
	Response.Cookies( theName ).Secure = FALSE
END SUB



FUNCTION checkpassword( byVal username, byVal password, byRef Con )
  sqlString = "SELECT user_id FROM users " &_
    "WHERE user_username='" & username & "' " &_
    "AND user_password='" & password & "'"
  SET RS = Con.Execute( sqlString )
  IF RS.EOF THEN 
    checkpassword = - 1
  ELSE
    checkpassword = RS( "user_id" )
    addCookie "username", username
	addCookie "password", password
  END IF
END FUNCTION


FUNCTION SELECTED( firstVal, secondVal )
  IF cSTR( firstVal ) = cSTR( secondVal ) THEN
    SELECTED = " SELECTED "
  ELSE
    SELECTED = ""
  END IF
END FUNCTION


'===========================
' Registration Functions
'===========================


SUB addUser
  ' Get Registration Fields
  newusername = TRIM( Request( "newusername" ) )
  newpassword = TRIM( Request( "newpassword" ) )
  email = TRIM( Request( "email" ) )
  street = TRIM( Request( "street" ) )
  city = TRIM( Request( "city" ) )
  state = TRIM( Request( "state" ) )
  zip = TRIM( Request( "zip" ) )
  cctype = Request( "cctype" ) 
  ccnumber = TRIM( Request( "ccnumber" ) )
  ccexpires = TRIM( Request( "ccexpires" ) )
  ccname = TRIM( Request( "ccname" ) )
  
  ' Check For Required Fields
  backpage = Request.ServerVariables( "SCRIPT_NAME" )
  IF newusername = "" THEN
    errorForm "You must enter a username.", backpage
  END IF
  IF newpassword = "" THEN
    errorForm "You must enter a password.", backpage
  END IF
  IF email = "" THEN
    errorForm "You must enter your email address.", backpage
  END IF
  IF street = "" THEN
    errorForm "You must enter your street address.", backpage
  END IF
  IF city = "" THEN
    errorForm "You must enter your city.", backpage
  END IF
  IF state = "" THEN
    errorForm "You must enter your state.", backpage
  END IF
  IF zip = "" THEN
    errorForm "You must enter your zip code.", backpage
  END IF
  IF ccnumber = "" THEN
    errorForm "You must enter your credit card number.", backpage
  END IF
  IF ccexpires = "" THEN
    errorForm "You must enter your credit card expiration date.", backpage
  END IF
  IF ccname = "" THEN
    errorForm "You must enter the name that appears on your credit card.", backpage
  END IF

  ' Check for Necessary Field Values
  IF invalidEmail( email ) THEN
    errorForm "You did not enter a valid email address", backpage
  END IF
  IF NOT validCCNumber( ccnumber ) THEN
    errorForm "You did not enter a valid credit card number", backpage
  END IF
  IF NOT isDATE( ccexpires ) THEN
    errorForm "You did not enter a valid credit card expiration date", backpage
  END IF

  ' Check whether username already registered
  IF alreadyUser( newusername ) THEN
    errorForm "Please choose a different username.", backpage
  END IF

  ' Add New User to Database
  sqlString = "INSERT INTO users ( " &_
    "user_username, " &_
    "user_password, " &_
    "user_email," &_
    "user_street, " &_
    "user_city," &_
    "user_state," &_
    "user_zip," &_
    "user_ccnumber, " &_
    "user_cctype, " &_
    "user_ccexpires," &_
    "user_ccname" &_
    ") VALUES ( " &_
    " '" & fixQuotes( newusername ) & "', " &_
    " '" & fixQuotes( newpassword ) & "', " &_
    " '" & fixQuotes( email ) & "', " &_
    " '" & fixQuotes( street ) & "', " &_
    " '" & fixQuotes( city ) & "', " &_
    " '" & fixQuotes( state ) & "', " &_
    " '" & fixQuotes( zip ) & "', " &_
    " '" & fixQuotes( ccnumber ) & "', " &_
    " '" & cctype & "', " &_
    " '" & ccexpires & "', " &_
    " '" & fixQuotes( ccname ) & "' " &_
    ")"

  Con.Execute sqlString

  ' Use the new username and password
  username = newusername
  password = newpassword

  ' Add Cookies
  addCookie "username", username
  addCookie "password", password
END SUB


SUB updateUser
  ' Get Registration Fields
  street = TRIM( Request( "street" ) )
  city = TRIM( Request( "city" ) )
  state = TRIM( Request( "state" ) )
  zip = TRIM( Request( "zip" ) )
  cctype = Request( "cctype" ) 
  ccnumber = TRIM( Request( "ccnumber" ) )
  ccexpires = TRIM( Request( "ccexpires" ) )
  ccname = TRIM( Request( "ccname" ) )
  
  ' Check For Required Fields
  backpage = "checkout.asp"
  IF street = "" THEN
    errorForm "You must enter your street address.", backpage
  END IF
  IF city = "" THEN
    errorForm "You must enter your city.", backpage
  END IF
  IF state = "" THEN
    errorForm "You must enter your state.", backpage
  END IF
  IF zip = "" THEN
    errorForm "You must enter your zip code.", backpage
  END IF
  IF ccnumber = "" THEN
    errorForm "You must enter your credit card number.", backpage
  END IF
  IF ccexpires = "" THEN
    errorForm "You must enter your credit card expiration date.", backpage
  END IF
  IF ccname = "" THEN
    errorForm "You must enter the name that appears on your credit card.", backpage
  END IF

  ' Check for Necessary Field Values
  IF INSTR( ccnumber, "*" ) = 0 THEN
    IF NOT validCCNumber( ccnumber ) THEN
      errorForm "You did not enter a valid credit card number", backpage
    ELSE
	  ccnumber = "'" & ccnumber & "'"
    END IF
  ELSE
    ccnumber = "user_ccnumber"
  END IF
  IF NOT isDATE( ccexpires ) THEN
    errorForm "You did not enter a valid credit card expiration date", backpage
  END IF

  ' Update user information in the database
  sqlString = "UPDATE users SET " &_
    "user_street='" & fixQuotes( street ) & "', " &_
    "user_city='" & fixQuotes( city ) & "'," &_
    "user_state='" & fixQuotes( state ) & "'," &_
    "user_zip='" & fixQuotes( zip ) & "'," &_
    "user_ccnumber=" & ccnumber & ", " &_
    "user_cctype=" & cctype & ", " &_
    "user_ccexpires='" & ccexpires & "'," &_
    "user_ccname='" & fixQuotes( ccname ) & "' " &_
    "WHERE user_id=" & userID

  Con.Execute sqlString
END SUB

SUB updateFavorites( strFavorites )

	' Update user information in the database
	
	sqlString = "UPDATE users SET " &_
    "user_favorites='" & fixQuotes( strFavorites ) & "' " &_
    "WHERE user_id=" & userID
	
	Con.Execute sqlString
	
END SUB

FUNCTION retrieveFavorites

	sqlString = "SELECT user_Favorites FROM users WHERE user_id=" & userID

	SET RS = Con.Execute( sqlString )
	
	strFavorites = RS("user_favorites")
	
	retrieveFavorites = strFavorites

END FUNCTION

FUNCTION invalidEmail( email )
  IF INSTR( email, "@" ) = 0 OR INSTR( email, "." ) = 0 THEN
    invalidEmail = TRUE
  ELSE
    invalidEmail = FALSE
  END IF
END FUNCTION

FUNCTION validCCNumber( ccnumber )
  ccnumber = CleanCCNum( ccnumber )
  IF ccnumber = "" THEN
    validCCNumber = FALSE
  ELSE
  isEven = False
  digits = ""        
  for i = Len( ccnumber ) To 1 Step -1
  if isEven Then
    digits = digits & CINT( MID( ccnumber, i, 1) ) * 2
  Else                
    digits = digits & CINT( MID( ccnumber, i, 1) )
  End If            
  isEven = (Not isEven)
  Next
  checkSum = 0
  For i = 1 To Len( digits) Step 1
    checkSum = checkSum + CINT( MID( digits, i, 1 ) )        
  Next
  validCCNumber = ( ( checkSum Mod 10) = 0 )
  END IF
End Function

Function validswitchno (ccardno )
if not isnumeric (ccardno) then
	validswitchno = false
elseif not len(trim(ccardno)) = 16 and not len(trim(ccardno)) = 18 and _
not len(trim(ccardno)) = 19 then 
	validswitchno = false
else
	validswitchno = true
end if
end function

Function validissue ( cissue )
if not isnumeric( cissue ) then
	validissue = false
elseif not cissue > 0 or not cissue < 99 then
	validissue = false
else
	validissue = true
end if
end function


Function validccexpires (cmexpires, cyexpires )
if not isnumeric(cmexpires) or not isnumeric(cyexpires) then
	validccexpires = false
elseif not cmexpires > 0 or not cmexpires < 13 or not cyexpires > 0 or not cyexpires < 15  then
	validccexpires = false
elseif cint(cyexpires) < cint(right(year(date),2)) then
	validccexpires = false
elseif cint(cyexpires) = cint(right(year(date),2)) and cint(cmexpires) < cint(month(date)) then 
	validccexpires = false
else
	validccexpires = true
end if
end function


Function validccfrom (cmfrom, cyfrom )
if not isnumeric(cmfrom) or not isnumeric(cyfrom) then
	validccfrom = false
elseif not cmfrom > 0 or not cmfrom < 13 or not cyfrom > -1 or not cyfrom < 100  then
	validccfrom = false
elseif cint(cyfrom) > cint(right(year(date),2)) and cint(cyfrom) < 95 then
	validccfrom = false
elseif cint(cyfrom) = cint(right(year(date),2)) and cint(cmfrom) > cint(month(date)) then 
	validccfrom = false
else
	validccfrom = true
end if
end function



'if not validccexpire(cmexpire, cyexpire) then errorform "The card expiry date is not valid", "bkitcheckout.asp"

'if ccardtype = "Switch" then
'	if not validswitchnumber(ccardno) then errorform "This is not a valid credit card number", "bkitcheckout.asp"
'	if cissue = "" then errorform "An issue number is required for switch cards", "bkitcheckout.asp"
'	if not validccissue(cissue) then errorform "The card issue number is not valid or not appropriate for the selected card type", "bkitcheckout.asp"
'	if cmfrom = "" or cyfrom = "" then errorform "A from date is required for switch cards", "bkitcheckout.asp"
'	if not validccfrom(cmfrom, cyfrom) then errorform "The card from date is not valid", "bkitcheckout.asp"
'else
'	if not validccnumber(ccardno) then errorform "This is not a valid credit card number", "bkitcheckout.asp"
'	if not cmfrom & cyfrom = "" then errorform "A from date is not required for this card type", "bkitcheckout.asp"
'	if not cissue = "" then errorform "An issue number is not required for this card type", "bkitcheckout.asp"


FUNCTION alreadyUser( theUsername )
  sqlString = "SELECT user_username FROM users " &_
    "WHERE user_username='" & fixQuotes( theUsername ) & "'"
  SET RS = Con.Execute( sqlString )
  IF RS.EOF THEN
    alreadyUser = FALSE
  ELSE
    alreadyUser = TRUE
  END IF
  RS.Close
END FUNCTION



FUNCTION CleanCCNum( ccnumber )
  FOR i = 1 TO LEN( ccnumber )
    IF isNumeric( MID( ccnumber, i, 1 ) ) THEN
      CleanCCNum = CleanCCNum & MID( ccnumber, i, 1 )
    END IF
  NEXT
END FUNCTION
 
 
'Function U1nicedates
'*****************************************************************************
'*	Receives from and to dates in date format and returns them in the format
'*	
'*	Saturday 1st March 2001					(Long)
'*	Sat 1st Mar 2001						(Short)
'*	Sat 1st Mar 2001 - Sat 8th Mar 2001		(Short and multiple dates passed)
'*
'*	Parameters	tctype		-	"Short" or "Long"	(note Web shortens Saturday to Sat etc!)
'*				tcdatefrom	-	from date in date format
'*				tcdateto	-	to date in date format (could be the same!) (optional)
'*****************************************************************************
'Parameters tctype, tcdatefrom, tcdateto'''

'local lcreturn, llshorten
'if vartype(tcdateto) <> "D"'
'	tcdateto = tcdatefrom
'endif

'llshorten = iif(upper(tctype)="SHORT" or tcdatefrom <> tcdateto, .t., .f.)			&& use shortened date if requested and if from and to different

'lcreturn = iif(llshorten, left(cdow(tcdatefrom),3),;
'						 cdow(tcdatefrom))+" "+;
'		   isday(tcdatefrom)+" "+;
'		   iif(llshorten, left(cmonth(tcdatefrom),3),;
'		   				 cmonth(tcdatefrom))+" "+;
'		   str(year(tcdatefrom),4)
'if tcdatefrom = tcdateto
'	return lcreturn
'else
'	return lcreturn + " - "+;
'		   iif(llshorten, left(cdow(tcdateto),3),;
'		   				 cdow(tcdateto))+" "+;
'		   isday(tcdateto)+" "+;
'		   iif(llshorten, left(cmonth(tcdateto),3),;
'		   				 cmonth(tcdateto))+" "+;
' 		   str(year(tcdateto),4)
'endif
'return .t.
 

Function nicedates( tctype, tcdatefrom, tcdateto )
lcyear = datePart("yyyy", tcdatefrom)
lcmonth = datePart("m",tcdatefrom)
lcday = datePart("w",tcdatefrom)
nicedates = lcyear
end function

 
FUNCTION displayDate( time )

	themonth = datePart("m", time)
	theweekday = datePart("w", time)
	
	Select Case themonth
	Case 1
		themonth = "January"
	Case 2
		themonth = "February"
	Case 3
		themonth = "March"
	Case 4
		themonth = "April"
	Case 5
		themonth = "May"
	Case 6
		themonth = "June"
	Case 7
		themonth = "July"
	Case 8
		themonth = "August"
	Case 9
		themonth = "September"
	Case 10
		themonth = "October"
	Case 11
		themonth = "November"
	Case 12
		themonth = "December"
	End Select

	Select Case theweekday
	Case 1
		theweekday = "Sunday"
	Case 2
		theweekday = "Monday"
	Case 3
		theweekday = "Tuesday"
	Case 4
		theweekday = "Wednesday"
	Case 5
		theweekday = "Thursday"
	Case 6
		theweekday = "Friday"
	Case 7
		theweekday = "Saturday"
	End Select
	
	displayDate = theweekday & " " & themonth & " " & datePart("d", time) & ", " & datePart("yyyy", time)
	
END FUNCTION


'======================
' ACCOUNT FUNCTIONS    
'======================

FUNCTION showOrderStatus( theStatus, theShipDate )
  SELECT CASE theStatus
  CASE 0 
    showOrderStatus = "Pending"
  CASE 1
    showOrderStatus = "Problem with Credit Card"
  CASE 2
    showOrderStatus = "Product not in stock"
  CASE 3
    showOrderStatus = "Shipped on " & theShipDate
  CASE ELSE
    showOrderStatus = "Unknown"
  END SELECT
END FUNCTION



%>