Hele asp-koden ser sådan ud:
<%
dim strAction
strAction = request("action")
select case strAction
case "show"
ShowBasket
case "add"
AddBasket request("itemid"), request("amount")
ShowBasket
case "delete"
DeleteBasket request("itemid")
ShowBasket
case else
ShowBasket
end select
' -------------------------------------
' Funktioner/procedurer
' -------------------------------------
sub ShowBasket
dim strSQL, objRS, arrRows, i, dblTotal
strSQL = "SELECT b.amount, b.itemid, i.itemtxt, i.price FROM " & _
"Basket AS b " & _
"INNER JOIN Items AS i " & _
"ON (b.itemid = i.itemid) " & _
"WHERE b.sessionid = '" & strSessionID & "'"
set objRS = server.createobject("ADODB.Recordset")
with objRS
.open strSQL, strConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
if not .EOF then
arrRows = .GetRows
end if
.close
end with
set objRS = Nothing
if isArray(arrRows) then
response.write "<p>Antal - Varenr - Varenavn - Pris - I alt <hr>"
dblTotal = 0
for i = 0 to ubound(arrRows,2)
response.write arrRows(0,i) & " - " & _
arrRows(1,i) & " - " & _
arrRows(2,i) & " - " & _
arrRows(3,i) & " - " & _
cdbl(arrRows(0,i)) * cdbl(arrRows(3,i)) & "<br>"
dblTotal = dblTotal + cdbl(arrRows(0,i)) * cdbl(arrRows(3,i))
next
response.write "I alt: " & dblTotal & "<hr></p>"
else
Response.write "<p>Din indkøbskurv er tom!</p>"
end if
' Forbedring
response.write "<p>Antal varer i kurv: " & cstr(CountBasket()) & "</p>"
end sub
sub AddBasket (strItemID, strAmount)
dim strSQL, objCMD, objRS
dim intFoundID
' Undersøg, om varen allerede findes
strSQL = "SELECT basketid FROM Basket WHERE " & _
"itemid = '" & strItemID & "' AND " & _
"sessionid = '" & strSessionID & "'"
set objRS = server.createobject("ADODB.Recordset")
with objRS
.open strSQL, strConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
if not .EOF then
intFoundID = .Fields("basketid")
else
intFoundID = 0
end if
.close
end with
set objRS = Nothing
if intFoundID > 0 then
strSQL = "UPDATE Basket SET Amount = Amount + " & cint(strAmount) & ", " & _
"lastaccess = getdate() " & _
"WHERE basketid = " & intFoundID
else
strSQL = "INSERT INTO Basket (itemid, amount, sessionid, lastaccess) " & _
"VALUES " & _
"('" & strItemID & "', " & _
cint(strAmount) & ", " & _
"'" & strSessionID & "', " & _
"now())"
end if
set objCMD = server.createobject("ADODB.Command")
with objCMD
.ActiveConnection = strConnect
.CommandType = adCmdText
.CommandText = strSQL
.Execute
end with
set objCMD = Nothing
' Forbedring
' CheckItem strItemID
end sub
sub DeleteBasket (strItemID)
dim strSQL, objCMD
strSQL = "DELETE FROM Basket " & _
"WHERE itemid ='" & strItemID & "' AND " & _
"sessionid = '" & strSessionid & "'"
set objCMD = server.createobject("ADODB.Command")
with objCMD
.ActiveConnection = strConnect
.CommandType = adCmdText
.CommandText = strSQL
.Execute
end with
set objCMD = Nothing
end sub
' -------------------------------------
' Forbedringer
' -------------------------------------
sub CheckItem (strItemID)
dim objRS, strSQL, intAmount
strSQL = "SELECT Amount FROM Basket " & _
"WHERE itemid = '" & strItemID & "' AND " & _
"sessionid = '" & strSessionID & "'"
set objRS = server.createobject("ADODB.Recordset")
with objRS
.open strSQL, strConnect, adOpenForwardOnly, adLockReadOnly
if not .EOF then
intAmount = .Fields("Amount")
else
intAmount = 1
end if
.close
end with
set objRS = Nothing
if intAmount < 1 then
DeleteBasket strItemID
end if
end sub
function CountBasket()
dim intRes, strSQL, objRS
strSQL = "SELECT sum(amount) as AntalVarer FROM Basket " & _
"WHERE sessionid = '" & strSessionID & "'"
set objRS = server.createobject("ADODB.Recordset")
with objRS
.open strSQL, strConnect, adOpenForwardOnly, adLockReadOnly, adCmdText
if isnull(.Fields("AntalVarer")) then
intRes = 0
else
intRes = .Fields("AntalVarer")
end if
.close
end with
set objRS = Nothing
CountBasket = intRes
end function
%>
