<%
Sub AddItemToCart(iItemID, iItemCount, iItemName, iItemSize)
if iItemSize = "" then iItemSize = "n/a"
'response.write( iItemID &"
"& iItemCount &"
"& iItemName &"
"& iItemSize&"
addToCart
")
if inStr(1, iItemID,"\") = 0 then iItemID = iItemID &"\"& iItemSize
If dictCart.Exists(iItemID) Then
dictCart(iItemID) = dictCart(iItemID) + iItemCount
Else
dictCart.Add iItemID, iItemCount
End If
Response.Write iItemCount & " '" & iItemName & "' has been added to your cart.""
" & vbCrLf
End Sub
Sub RemoveItemFromCart(iItemID, iItemCount, iItemName)
'response.write( iItemID &"
"& iItemCount &"
"& iItemName &"
"& iItemSize&"
removeTo")
If dictCart.Exists(iItemID) Then
If dictCart(iItemID) <= iItemCount Then
dictCart.Remove iItemID
Else
dictCart(iItemID) = dictCart(iItemID) - iItemCount
End If
Response.Write iItemCount & " '" & iItemName & "' has been removed from your cart.
" & vbCrLf
Else
Response.Write "Couldn't find any of that item your cart.
" & vbCrLf
End If
End Sub
Sub ShowItemsInCart()
Dim Key
Dim aParameters ' as Variant (Array)
Dim sTotal, sShipping
%>
| Description |
Size |
Quantity |
Price |
Totals |
Remove |
<%
sTotal = 0
For Each Key in dictCart
aParameters = GetItemParameters(Key)
if aParameters(0)<>-1 then
%>
| <%=aParameters(1) %> |
<%response.write(parseKey(Key,False))%> |
<%=dictCart(Key)%> |
£<%=aParameters(2)%> |
£<%= FormatNumber(dictCart(Key) * CSng(aParameters(2)),2) %> |
Remove
One Remove
All |
<%
sTotal = sTotal + (dictCart(Key) * CSng(aParameters(2)))
end if
Next
'Calculate shipping - you might want to pull this out into a function if your shipping
' calculations are more complicated then ours. ;)
If sTotal <> 0 Then
sShipping = session("PostClass")
Else
sShipping = 0
End If
sTotal = sTotal
'sTotal = sTotal + sShipping
%>
| Total: |
£<%= FormatNumber(sTotal,2) %> |
|
<%
End Sub
function parseKey(sKey,returnKey)
if instr(1,sKey,"\") = 0 and (returnKey=False) then
parseKey = "n/a"
exit function
end if
if instr(1,sKey,"\") = 0 and (returnKey=True) then
parseKey = sKey
exit function
end if
dim arrVals
redim arrVals(1)
arrVals = split(sKey&" ","\")
if returnKey=True then
parseKey = arrVals(0)
else
parseKey = arrVals(1)
end if
end function
function createSearch()
dim arrWords
redim arrWords(0)
if InStr(1,request("vals")," ") > 0 then
arrWords = split(request("vals")," ")
else
arrWords(0) = request("vals")&""
end if
findStr = ""
if len(trim(arrWords(0)))> 0 then
dim arrFields
redim arrFields(1)
arrFields(0) ="ModelName"
arrFields(1) ="Description"
OrAnd = request("OOR")
if request("sField") <>"All" then
filterField = request("sField")
For Each s in arrWords
if len(trim(s))> 0 then findStr = findStr &" (`"& filterField & "` like '%"& s & "%')"&OrAnd
next
else
For each f in arrFields
For Each s in arrWords
if len(trim(s)) > 0 then findStr = findStr &" (`"& f & "` like '%"& s & "%')"&OrAnd
next
next
end if
if len(findStr)>len(OrAnd) then findStr = left(findStr,len(findStr) - len(OrAnd))
end if
catFilter =""
if request("sCat")<>"0" then catFilter = request("sCat")
price=""
select case request("PriceRange")
case "1"
price="(UnitCost Between 0.00 AND 10.00)"
case "2"
price="(UnitCost Between 10.01 AND 20.00)"
case "3"
price="(UnitCost Between 20.01 AND 40.00)"
case "4"
price="(UnitCost Between 40.01 AND 100.00)"
case "5"
price="(UnitCost >= 100.01)"
case else
price=""
end select
if len(price)> 0 And len(findStr)> 0 then
findStr = " AND (" & findStr&" ) AND ( "& price & ")"
elseif len(price)> 0 then
createSearch = "AND(" &price& ")"
elseif len(findStr)> 0 then
createSearch = "AND(" &findStr& ")"
else
createSearch=""
end if
'createSearch = "AND("&&")"
end function
Sub ShowFullCatalog()
sqlWhere =createSearch
Dim oRSConn 'The ADODB connection object
' Dim CONN_STRING
' CONN_STRING = "DSN=glen;UID=root;Password=NeCam4556!;"
Set oRSConn2 = Server.CreateObject("ADODB.Connection")
oRSConn2.Open CONN_STRING
Set oRSp2 = Server.CreateObject("ADODB.recordset")
oRSp2.CursorLocation = 3
'MAIN SQL QUERY USED TO FIND THE PRODUCTS>>>>>>>>>>>>>>>
sC = ""
if catFilter <>"" then
cat = catFilter
end if
if cat&""<>"" then sC = " CategoryID = "& cat &" AND "
sqlquery = "SELECT ProductID FROM ardbeg_cmrc_products where "&sC&" DisplayInShop = 1 AND IsArchived = 0 "&sqlWhere&" order by UnitCost asc"
oRSp2.open sqlquery,oRSConn2
if oRSp2.RecordCount = 0 then
response.write("
There are no products to be displayed, please try again.
")'&sqlquery)
end if
' oRSp2.movefirst
Dim aParameters ' as Variant (Array)
Dim I
Dim iItemCount ' Number of items we sell
'fred is taken from the initial database search when page opens.
%>
<% 'work way through products and add them to the dictionary
colour = 1
do while not oRSp2.EOF
'aParameters = GetItemParameters(I)
aParameters = GetItemParameters(oRSp2.fields("ProductID"))
%>
<%
colour = colour+1
oRSp2.MoveNext
loop
%>
<%
oRSp2.close
set oRSp2 =nothing
oRSConn2.close
set oRSConn2 =nothing
End Sub
Sub PlaceOrder()
Dim Key
Dim aParameters ' as Variant (Array)
Dim sTotal, sShipping
%>
| Description |
Size |
Weight(grm) |
Quantity |
Price |
Totals |
<%
sTotal = 0
' costPostage = 0
weight = 0
For Each Key in dictCart
aParameters = GetItemParameters(Key)
%>
| <%= aParameters(1) %> |
<%= parseKey(Key,False) %> |
<%= aParameters(5)%> |
<%= dictCart(Key) %> |
£<%= aParameters(2) %> |
£<%= FormatNumber(dictCart(Key) * CSng(aParameters(2)),2) %> |
<%
'weight = weight + aParameters(5)*dictCart(Key) 'combined weights
'removed 25/5-06. Can't add weight to items if we have to calculate postage for each item.
'thisweight = aParameters(5)*dictCart(Key) ' each products weight
thisweight = aParameters(5) ' each products weight
'multiply with quantity if more than 1 item of same product
if dictCart(key) = 1 then
TotalPostage = TotalPostage + getShiping(parseKey(session("PostClass"),false), thisweight)
else
tempPostage = (tempPostage + getShiping(parseKey(session("PostClass"),false), thisweight)) * dictCart(Key)
TotalPostage = tempPostage + TotalPostage
tempPostage = 0
end if
' sql = "select PostCost from ardbeg_cmrc_postrateslookup where PostalRegionId='"&parseKey(session("PostClass"),true)&"' and " & _
' "PostServiceType='"&parseKey(session("PostClass"),false)&"'" & _
' " AND "& weight &" between `LowerWeightLimitGrams` and `UpperWeightLimitGrams`"
' set rs = server.createObject("ADODB.recordset")
' rs.open sql, activeConnection
' curCost = 0
' if not rs.eof then curCost = rs(0)
' costPostage = costPostage + curCost
' curMn = 0
curMn = aParameters(2)
sTotal = sTotal + (dictCart(Key) * curMn)
Next
'costPostage = getShiping(parseKey(session("PostClass"),false), weight) 'used with combined weights
session("PostageCost") = round(TotalPostage,2) ' so we can use the session in the email out.
'session("PostageCost") = round(costPostage,2) ' session in the email out. Used with combined weights
sTotal = sTotal + TotalPostage
'sTotal = sTotal + costPostage 'used with combined weights
%>
| Postage: |
£<%=session("PostageCost")%> |
| Total: |
£<%response.write(round(sTotal,2)) %> |
<%
End Sub
Function GetItemParameters(iItemID)
Dim aParameters ' Will contain values/ details for each product
Dim oRSConn 'The ADODB connection object
' Dim CONN_STRING
' CONN_STRING = "DSN=glen;UID=root;Password=NeCam4556!;"
Set oRSp = Server.CreateObject("ADODB.recordset")
oRSp.CursorLocation = 3
'only find the product we are after to fill the dictionary with
sqlquery = "SELECT * FROM ardbeg_cmrc_products where ProductID = '"& parseKey(iItemID, True)&"' and DisplayInShop = '1'"
oRSp.open sqlquery,activeConnection
fred = oRSp.RecordCount
if not oRSp.Eof then
oRSp.MoveFirst
else
aParameters = Array("-1")
GetItemParameters = aParameters
exit function
end if
do while not oRSp.EOF
aParameters = Array("images/shopimages/"& oRSp.fields("ProductImage"), ""&oRSp.fields("ModelName")&"",""&oRSp.fields("UnitCost")&"",""&oRSp.fields("Description")&"",""&oRSp.fields("ProductID")&"",""&oRSp.fields("WeightGrams")&"",""&parseKey(iItemID, False),""&oRSp.fields("CategoryID")&"" )
oRSp.MoveNext
loop
oRSp.close
set oRSp =nothing
set oRSConn =nothing
' Return array containing product info.
GetItemParameters = aParameters
End Function
%>
<% ' ***** Begin the infamous runtime script *****
' Declare our Vars
Dim dictCart ' as dictionary
Dim sAction ' as string
Dim iItemID ' as integer
Dim iItemCount ' as integer
dim sqlquery ' as string
' Get a reference to the cart if it exists otherwise create it
If IsObject(Session("cart")) Then
Set dictCart = Session("cart")
Else
Set dictCart = Server.CreateObject("Scripting.Dictionary")
End If
' Get all the parameters passed to the script
sAction = Request("action")
iItemID = Request("item")
iItemCount = CInt(Request("count"))
iItemName = Request("name")
iItemSize = Request("size")
cat = ""
cat = request.QueryString("cat")
if cat<>"" then
select case cat
case 14
cat = 14
case 15
cat = 15
case 16
cat = 16
case 17
cat = 17
' case else
' cat = 15
end select
end if
%>
| <%
' Select action based on user input
msg = ""
Select Case sAction
Case "add"
AddItemToCart iItemID, iItemCount, iItemName, iItemSize
ShowItemsInCart
%>
|
 
<%
Case "del"
RemoveItemFromCart iItemID, iItemCount, iItemName
ShowItemsInCart
%>
|
<%
Case "viewcart"
ShowItemsInCart
%>
|
<%
Case "checkout"
call checkout
Case "carddetails"
call carddetails
Case "AltDelivery"
call AltDelivery
Case "Cardnumber"
call Cardnumber
Case "SendOrder"
call SendOrder
Case else
call eElse
End Select
function checkout()
session("trimRegionFlag") = "off"
session("DeliveryRegion")= ""
'PlaceOrder
If Session("URN") <> "" then
GetMemberDetails()
else
'response.write("session: "&Session("URN")&"
")
response.Redirect("ShopLogin.asp?tech=no-session(urn)-refpage=shop1.asp")
end if
%>
|
| How
long it takes We will normally send your order to you in 28 business
days . International orders are generally received
in under 28 days. |
|
| Over-demand If something you want isn't in stock, we'll
place a back order for you. You'll receive an
e mail with the option to cancel your order if you don't
want to wait. |
|
| Something
on your mind? If you need to get in touch, please click on 'send
mail', or call +44 (0) 1496 302244,
fax on +44 (0) 1496 302040, or write to
us at Ardbeg Distillery, Port Ellen, Isle of Islay,
Argyll, Scotland PA42 7EA. |
|
| Private
and Confidential Ardbeg do not disclose buyers information to third parties.
Cookies are used on this shopping site to keep track of
the contents of your shopping cart once you have selected
an item, to store delivery addresses if the address
book is used and to store your details if you select the
'Remember Me' option. |
|
<%
end function
function carddetails()
RtoS("Country") 'United Kingdom1 or United States3 etc.. this is used to calc postage, United Kingdom is 1, Europe is 2, World is 3
'if the last character of the COUNTRY is numeric, it is the region code and we need to trim it otherwise it won't calculate
'the correct postage.
if isNumeric(right(session("country"),1)) = TRUE then
session("regionid") = right(session("country"),1)
session("country") = mid(session("country"),1,len(session("country"))-1)
end if
RtoS("DeliveryRegion") ' CA or FL, only for US and Canada, not used to calc postage
'if (session("Country") = "US" or session("Country")="CA") and (session("DeliveryRegion")="") then
' response.redirect("shop1.asp?action=checkout")
'end if
'************************************************************************************************************
' get the weight of each product ordered - add the weight together and get the correct postCost from the database
' then make that the PostClass!!
'************************************************************************************************************
PlaceOrder
%>
|
<%
end function
function AltDelivery()
'get form data here
if request("Prev")<>"1" then
msgD = ""
if RtoS("cardholder") = False then msgD = "The field 'Name/Cardholder' can not be empty!
"
if RtoS("add1") =False then msgD = msgD & "The field 'Address Line 1' can not be empty!
"
if RtoS("add4") =False then msgD = msgD & "The field 'Address Line 4 (town/city)' can not be empty!
"
If InStr(1, session("country"), "United States", 1) Then
'if session("country") <> "US" AND session("country") <> "UM" then
' zip need to be entered for USA cities
if RtoS("zip") =False then msgD = msgD & "The field 'Zip' can not be empty!
"
else
' postal code need to be entered for non-USA cities
if RtoS("posta") =False then msgD = msgD & "The field 'Postal Code' can not be empty!
"
end if
if RtoS("phone") =False then msgD = msgD & "The field 'Phone Number' can not be empty!
"
if RtoS("email") =False then msgD = msgD & "The field 'Email Address' can not be empty!
"
if RtoS("PostClass") = False then msgD= msgD & "The field 'Class of Service' can not be empty!"
RtoS("add2")
RtoS("add3")
RtoS("add5")
RtoS("Country")
RtoS("DeliveryInstructions")
if msgD<>"" then response.redirect("shop1.asp?action=carddetails&msg="&msgD)
end if
PlaceOrder
%>
|
<%
end function
function Cardnumber()
'get form data here
if request("Prev")<>"1" then
smsg=""
'if the delivery address is the same as the invoice address, set delAdd to invAdd and redirect appropriately
if cbIsInvoice <> "" then
session("DelName") = session("cardholder")
session("DelAdd1") = session("add1")
session("DelAdd2") = session("add2")
session("DelAdd3") = session("add3")
session("DelAdd4") = session("add4")
session("DelAdd5") = session("add5")
session("DelZip") = session("zip")
session("DelPCode") = session("posta")
session("Country") = session("Country")
response.redirect("shop1.asp?action=AltDelivery&msg="&smsg &"&Prev=1")
end if
if RtoS("DelName")=False then smsg = "The field 'Delivery Name/Cardholder' can not be empty!
"
'if (RtoS("DelAdd1") =False) OR (Trim(Session("DelAdd1"))=Trim(session("add1"))) then smsg = smsg & "The field 'Address Line 1' can not be empty and doesn`t equal invoice address!
"
'if (RtoS("DelAdd4") =False) OR (Trim(Session("DelAdd4"))=Trim(session("add4"))) then smsg = smsg & "The field 'Address Line 4' can not be empty and doesn`t equal invoice address!
"
if (RtoS("DelAdd1") =False) then smsg = smsg & "The field 'Address Line 1' can not be empty!
"
if (RtoS("DelAdd4") =False) then smsg = smsg & "The field 'Address Line 4' can not be empty!
"
If InStr(1, session("country"), "United States", 1) Then
'if session("country") <> "US" AND session("country") <> "UM" then
' zip need to be entered for USA cities
if RtoS("DelZip") =False then smsg = smsg & "The field 'Zip' can not be empty!
"
else
' postal code need to be entered for non-USA cities
if RtoS("DelPCode") =False then smsg = smsg & "The field 'Postal Code' can not be empty!
"
end if
RtoS("DelAdd2")
RtoS("DelAdd3")
RtoS("DelAdd5")
RtoS("DelCountry")
if smsg<>"" then response.redirect("shop1.asp?action=AltDelivery&msg="&smsg &"&Prev=1" )
end if
PlaceOrder
%>
|
<%
end function
function SendOrder()
' ALTERED 9/5/06 SINCE ARDBEG WANT TO ENABLE OFF-LINE ORDERS FOR PARANOID CUSTOMERS
' If the field is not empty and isn't numeric. And not char 'OFFLINE'
if RtoS("CCNumber")= FALSE OR (RtoS("CCNumber") = TRUE AND IsNumeric(TRIM(UCASE(session("CCNumber")))) = FALSE AND TRIM(UCASE(session("CCNumber"))) <> "OFFLINE" ) then
msg = "You have not entered a Credit Card Number.
For off-line transactions, please type 'OFFLINE' in the 'Credit Card Number' field.
"
response.redirect("shop1.asp?action=Cardnumber&msg="&msg&"&Prev=1")
end if
'email oldkiln and customer with this order.
RtoS("CCType")
RtoS("CCExpMonth")
RtoS("CCExpYear")
' ALTERED 9/5/06 SINCE ARDBEG WANT TO ENABLE OFF-LINE ORDERS FOR PARANOID CUSTOMERS
IF IsNumeric(TRIM(UCASE(session("CCNumber")))) = TRUE then
if RtoS("securityCode")= FALSE then
msg = "You have entered a Credit Card Number without a Security Code.
Please enter a Security Code.
"
response.redirect("shop1.asp?action=Cardnumber&msg="&msg&"&Prev=1")
end if
if RtoS("securityCode1")= FALSE then
msg = "You have entered a Credit Card Number without an ATM PIN Code.
Please enter an ATM PIN Code.
"
response.redirect("shop1.asp?action=Cardnumber&msg="&msg&"&Prev=1")
end if
end if
PlaceOrder
sTotal = 0
OrderID = saveOrderToDB()
For Each Key in dictCart
aParameters = GetItemParameters(Key)
saveToDb aParameters ,dictCart(Key),OrderID
ordersbodytext = ordersbodytext & dictCart(Key) & " x "& "(size: "& parseKey(Key,False) &")"& aParameters(1) & " @ £" &aParameters(2) & " each = £" & FormatNumber(dictCart(Key) * CSng(aParameters(2)),2) & vbcrlf & VBCRLF
sTotal = sTotal + (dictCart(Key) * CSng(aParameters(2)))
'sTotal = sShipping + sTotal + (dictCart(Key) * CSng(aParameters(2)))
'ordersbodytext = ordersbodytext & "Total £" & sTotal & VBCRLF & VBCRLF
Next
For Each Key in dictCart
dictCart.Remove Key
Next
mailbodytext = mailbodytext & "Your order is listed below." & VBCRLF & VBCRLF
mailbodytext = mailbodytext & "Order number : " & OrderID & VBCRLF
mailbodytext = mailbodytext & "Name : " & session("cardholder") & VBCRLF
mailbodytext = mailbodytext & "Address : " & session("add1") & VBCRLF
mailbodytext = mailbodytext & "Address : " & session("add2") & VBCRLF
mailbodytext = mailbodytext & "Address : " & session("add3") & VBCRLF
mailbodytext = mailbodytext & "Town/City : " & session("add4") & VBCRLF
mailbodytext = mailbodytext & "County/State : " & session("add5") & VBCRLF
mailbodytext = mailbodytext & "Country : " & session("Country") & VBCRLF
mailbodytext = mailbodytext & "Region : " & session("DeliveryRegion") & VBCRLF
mailbodytext = mailbodytext & "Postcode : " & session("post") & VBCRLF
mailbodytext = mailbodytext & "Zip : " & session("zip") & VBCRLF
mailbodytext = mailbodytext & "Telephone : " & session("phone") & VBCRLF
mailbodytext = mailbodytext & "Email : " & session("email") & VBCRLF
mailbodytext = mailbodytext & "" & VBCRLF
mailbodytext = mailbodytext & "Delivery Details" & VBCRLF
mailbodytext = mailbodytext & "Name : " & session("DelName") & VBCRLF
mailbodytext = mailbodytext & "Address : " & session("DelAdd1") & VBCRLF
mailbodytext = mailbodytext & "Address : " & session("DelAdd2") & VBCRLF
mailbodytext = mailbodytext & "Address : " & session("DelAdd3") & VBCRLF
mailbodytext = mailbodytext & "Town/City : " & session("DelAdd4") & VBCRLF
mailbodytext = mailbodytext & "County/State : " & session("DelAdd5") & VBCRLF
mailbodytext = mailbodytext & "Country : " & session("Country") & VBCRLF
mailbodytext = mailbodytext & "Region : " & session("DeliveryRegion") & VBCRLF
mailbodytext = mailbodytext & "Postcode : " & session("DelPCode") & VBCRLF
mailbodytext = mailbodytext & "Zip : " & session("DelZip") & VBCRLF
mailbodytext = mailbodytext & "" & VBCRLF
mailbodytext = mailbodytext & "Card Details" & VBCRLF
mailbodytext = mailbodytext & "Type : " & session("CCType") & VBCRLF
if session("CCType") <> "Switch" then
mailbodytext = mailbodytext & "Number : " & "xxxx xxxx xxxx " & Right(session("CCNumber"),4) & VBCRLF
else
mailbodytext = mailbodytext & "Number : " & "xxxx xxxx xxxxxx " & Right(session("CCNumber"),6) & VBCRLF
end if
mailbodytext = mailbodytext & "Expiry : " & session("CCExpMonth") & "/"& session("CCExpYear") & VBCRLF
mailbodytext = mailbodytext & "Security Code: " & session("securityCode") & VBCRLF
mailbodytext = mailbodytext & "" & VBCRLF
mailbodytext = mailbodytext & "Shipping / Postage" & VBCRLF
mailbodytext = mailbodytext & "Class of Service : " & parseKey(session("PostClass"),false) & VBCRLF & VBCRLF
if session("DeliveryInstructions") <> "" then
mailbodytext = mailbodytext & "" & VBCRLF
mailbodytext = mailbodytext & "Special Instructions" & VBCRLF
mailbodytext = mailbodytext & session("DeliveryInstructions") & VBCRLF & VBCRLF
end if
mailbodytext = mailbodytext & "Order details" & VBCRLF
mailbodytext = mailbodytext & "" & VBCRLF
mailbodytext = mailbodytext & ordersbodytext & VBCRLF
'format the currency to two decimal places
'postageCost = FormatCurrency (session("PostageCost"), 1, -2, -2, -2))
mailbodytext = mailbodytext & "Shipping Cost: £" & session("PostageCost") & VBCRLF
mailbodytext = mailbodytext & "Total Cost: £" &sTotal + session("PostageCost")& VBCRLF
mailbodytext = mailbodytext & "" & VBCRLF
mailbodytext = mailbodytext & "Thank you for your order." & VBCRLF
mailbodytext = mailbodytext & "" & VBCRLF
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
mailContinue = false
if checkcomp("Persits.MailSender") then
Set Mail = Server.CreateObject("Persits.MailSender")
mailContinue = true
'Mail.AddAddress ShopAddAddress
customerEmail = session("email")
Mail.AddAddress customerEmail
Mail.AddCC ShopAddAddress
Mail.Host = SMTPserver ' Specify a valid SMTP server
Mail.FromName = "Ardbeg Shop" 'test for dupes
Mail.AddReplyTo ShopReplyTo
Mail.IsHTML = False
Mail.Body = mailbodytext
Mail.Subject = ShopMailSubject
Mail.From = ShopEmailFromName
elseif checkcomp("CDO.Message") then
Set Mail = Server.CreateObject("CDO.Message")
mailContinue = true
'Mail.To = ShopAddAddress
Mail.To = customerEmail
Mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
Mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTPserver
Mail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=Port
Mail.Configuration.Fields.Update
Mail.TextBody = mailbodytext
Mail.Subject = ShopMailSubject
Mail.From = ShopEmailFromName
end if
'Mail.Timestamp = CDate(datestamp) 'sets the date and time of when to queue the message until
On Error Resume Next
if mailContinue = true then
Mail.Send
Mail.reset 'clears addresses
else
response.write("
Mail system component required! Mail send failed!")
end if
%>
|
|
<%
end function
function eElse()
' Shop
ShowFullCatalog
%>
|
<%
end function
' Return cart to Session for storage
Set Session("cart") = dictCart
function saveOrderToDB()
sql = "select max(OrderID) from ardbeg_cmrc_orders "
set rs = server.createObject("ADODB.recordset")
rs.Open sql ,activeConnection
id = 1
if not rs.Eof then id = CInt(rs(0)) + 1
CardId = session("CCNumber")
user_id = session("URN")
if trim(user_id)="" then response.redirect("ShopLogin.asp")
if trim(CardId)="" then
msg = "The Card number cant`t be empty! Access Denied!"
response.redirect("shop1.asp?action=Cardnumber&msg="&msg)
exit function
end if
fieldsArray = array("cardholder","add1","add2","add3","add4","add5","post","zip","Country", _
"phone", "email","CCType","DeliveryInstructions", "DelName", _
"DelAdd1","DelAdd2", "DelAdd3", "DelAdd5", "DelPCode", "DelZip", "Country","DelAdd4", "securityCode", "securityCode1")
fieldsStr = "" & _
"OrderID, UserID, OrderDate, CCNumber, CharCCNumber, CCExpMonth, CCExpYear, PostServiceType, postageCost," & _
"InvoiceName, InvoiceAdd1, InvoiceAdd2, InvoiceAdd3, " & _
"invoiceAdd4, InvoiceAdd5, InvoicePCode, InvoiceZip, InvoiceCountry, InvoicePhone, InvoiceEmail, " & _
"CCType, " & _
"DeliveryInstruction, " & _
"DeliveryName, DeliveryAdd1, DeliveryAdd2, DeliveryAdd3, DeliveryAdd5, DeliveryPCode, DeliveryZip, DeliveryCountry, DeliveryAdd4, SecurityCode, SecurityCode1"
sql ="insert into ardbeg_cmrc_orders ("&fieldsStr&") values (" & _
id&", "&user_id&", CURDATE(), 'xxxx xxxx xxxx " & Right(session("CCNumber"),4) & "'," & _
"'" & Right(session("CCNumber"),19) & "'," & _
session("CCExpMonth") & "," &session("CCExpYear") & ", '" & parseKey(session("PostClass"),false) & "', " & _
session("PostageCost") & ""
for J=0 to UBound(fieldsArray)
sql = sql&",'" & session(fieldsArray(J)) & "'"
Next
sql = sql&")"
'response.write(sql)
' response.end
activeConnection.execute sql
saveOrderToDB = id
end function
function getShiping(PostClass, weight)
if PostClass <> "" then
shipingCost = 0
sql = "select PostCost from ardbeg_cmrc_postrateslookup where " & _
"PostServiceType='"&PostClass&"' " & _
" AND "& weight &" between `LowerWeightLimitGrams` and `UpperWeightLimitGrams`"
set rs2 = server.createObject("ADODB.recordset")
rs2.open sql, activeConnection
if not rs2.eof then
shipingCost = shipingCost+rs2(0)
else
rs2.close
sql = "select PostCost from ardbeg_cmrc_postrateslookup " & _
"where PostServiceType='"&PostClass&"' " & _
"order by UpperWeightLimitGrams Desc limit 1"
rs2.open sql, activeConnection
if not rs2.eof then shipingCost=shipingCost+rs2(0)
end if
rs2.close
set rs2 =nothing
getShiping = shipingCost
end if
end function
function saveToDb(aParameters, Quantity, OrderID)
sql ="select max(RecordID) from ardbeg_cmrc_shoppingcart "
set rs = server.createObject("ADODB.recordset")
rs.Open sql ,activeConnection
id = 1
if not rs.Eof then id = CInt(rs(0)) + 1
CardId = session("CCNumber")
user_id = session("URN")
if trim(user_id)="" then response.redirect("ShopLogin.asp")
if trim(CardId)="" then
msg = "The card number cant`t be empty! Access Denied!"
response.redirect("shop1.asp?action=Cardnumber&msg="&msg)
exit function
end if
fieldsStr = "" & _
"(RecordID, CartID, Quantity, ProductID, ProductSize, ProductColour, ProductPrice, DateCreated, user_id)"
sql ="INSERT INTO ardbeg_cmrc_shoppingcart "&fieldsStr&" values (" & vbcrlf & _
id&",'"&CardId&"','"&Quantity&"', '"&aParameters(4)&"', '" &aParameters(6)&"','"&parseKey(Key,False)&"', '" &aParameters(2)&"', CURDATE(), '"& user_id&"')"
'response.write(sql)
'response.end
activeConnection.execute sql
'response.write("Unable to save information to the database! Try again later!")
sql= " SELECT LAST_INSERT_ID() "
Set rs = server.createObject("ADODB.recordset")
rs.open sql, activeConnection
id = rs(0)
set rs= nothing
fieldsStr = "OrderID, ProductID, Quantity, ProductSize, ProductColour, UnitCost"
sql ="insert into ardbeg_cmrc_orderdetails ("&fieldsStr&") values (" & vbcrlf & _
OrderID&",'"&aParameters(4)&"','"&Quantity&"', '" &aParameters(6)&"','"&parseKey(Key,False)&"', '" &aParameters(2)&"')"
'response.write(sql)
'response.end
Set rs = server.createObject("ADODB.recordset")
rs.open sql, activeConnection
set rs= nothing
end function
function RtoS(sName)
if replace(request(sName)," ","")<>"" then
session(sName) = replace(request(sName),"'","''")
'session(sName) = request(sName)
RtoS=True
exit function
else
if replace(session(sName)&""," ","")="" then
RtoS=False
exit function
end if
end if
end function
function checkcomp(str)
on error resume next
checkcomp = false
Err = 0
dim checkobject
set checkobject = Server.CreateObject(str)
if 0 = Err then
checkcomp = true
end if
set checkobject = nothing
Err = 0
end function
%>
|
|
|
