老李's Blog

前段时间给客户做一个网站，涉及到在线订单功能。这是我写的购物车类，功能比较简单，仅供参考。

<%
'--------------------------------
'类名：简易购物车类
'作者：李思杰 lsj86@163.com
'主页：www.lisijie.com.cn
'更新：2007-9-20
'--------------------------------

Class CartClass

 '添加产品
 Public Sub Add(PID)
  Dim IDArr,i,P
  If Not isInteger(PID) Or PID = "" Then Exit Sub
  If Not Execute("Select * From YL_Product Where ID = " & PID).Eof Then
   If isNull(Session("Cart")) Or Session("Cart")="" Then
    Session("Cart") = PID&"*1"
   Else
    IDArr = GetProID
    For i = 0 To Ubound(IDArr)
      P = Split(IDArr(i),"*")
     If PID = P(0) Then
      Response.Redirect("order.asp")
     End If
    Next
    Session("Cart") = Session("Cart") & "|" & PID&"*1"
   End If
   Response.Redirect("order.asp")  
  End If
 End Sub
 
 '移除商品
 Public Sub Remove(PID)
  Dim PList,TempList,i,P
  PList = GetProID()
  For i = 0 To Ubound(PList)
   P = Split(PList(i),"*")
   If Clng(P(0))<>Clng(PID) Then
    If TempList = "" Then
     TempList = PList(i)
    Else
     TempList = TempList & "|" & PList(i)
    End If
   End If
  Next
  Session("Cart") = TempList
 End Sub
 
 '更新统计
 Public Sub UpdateCart(Pro)
  Session("Cart") = Pro
 End Sub
 
 '保存订单
 Public Sub SaveOrder()
  Dim Rs
  Dim UserName,Address,PostCode,Phone
  UserName = HTMLEncode(Request.Form("UserName"))
  Address = HTMLEncode(Request.Form("Address"))
  PostCode = HTMLEncode(Request.Form("PostCode"))
  Phone = HTMLEncode(Request.Form("Phone"))
  If UserName = "" Or Address = "" Or PostCode = "" Or Phone = "" Then
   Response.Write("<script>alert('所有项目都必须填写！');history.back();</script>")
   Response.End
  End If
  
  Set Rs = Server.CreateObject("Adodb.RecordSet")
  Rs.Open "Select * From YL_Order",Conn,1,3
  Rs.AddNew
  Rs("UserName") = UserName
  Rs("Address") = Address
  Rs("PostCode") = PostCode
  Rs("Phone") = Phone
  Rs("Order") = Session("Cart")
  Rs.Update
  Rs.Close : Set Rs = Nothing
  Session("Cart") = ""
  Response.Write("<script>alert('订单提交成功！我们将尽快与您取得联系！');window.location='order.asp';</script>") 
 End Sub
 
 '获取购买物品列表
 Public Function GetProID()
  Dim Product,ProductArr
  Product = Session("Cart")
  If Product ="" Then  Exit Function
  ProductArr = Split(Product,"|")
  GetProID = ProductArr
 End Function
 
 '过滤字符串
 Function HTMLEncode(fString)
  If fString="" or IsNull(fString) Then
   Exit Function
  Else
   If Instr(fString,"'")>0 Then
    fString = Replace(fString, "'","&#39;")
   End If
   fString = Replace(fString, ">", "&gt;")
   fString = Replace(fString, "<", "&lt;")
   fString = Replace(fString, CHR(32), "&nbsp;")
   fString = Replace(fString, CHR(9), "&nbsp;")
   fString = Replace(fString, CHR(34), "&quot;")
   fString = Replace(fString, CHR(13),"")
   fString = Replace(fString, CHR(10) & CHR(10), "</P><P>")
   fString = Replace(fString, CHR(10), "<BR>")
   fString = Replace(fString, CHR(39), "&#39;")
   fString = Replace(fString, CHR(0), "")
   HTMLEncode = fString
  End If
 End Function
 
End Class
%>