shopa_addproduct.asp

vb的一个事例,简单了一点,但实用的一个电子超市系统

<!--#include file="shop$db.asp"-->
<!--#include file="shopa_tools.asp"-->
<%
ShopCheckAdmin

Dim FeatureCount
Dim CategoryCount
Dim Categories
Dim CategoryNums
Dim SubCategoryCount
Dim SubCategories
Dim SubCategoryNums
Dim Features
Dim dbtable
Dim Actiontype
Dim Which
Dim arrFeatures
const cSelect="Select"
GetTable
Dim myconn
sError=""
ShopOpenDatabase myconn
GetCategories
GetSubcategories
GetFeatures
sAction=Request.form("Action")
If sAction = "" Then
     AdminPageHeader
     if which<>"" then            ' being called to update record
        GetExistingProduct          
     end if 
     ShopCloseDatabase myconn
     DisplayForm
     AdminPageTrailer
Else
     actiontype=ucase(left(sAction,3))
     GetFormData
     ValidateData()
     AdminPageHeader
     if sError = "" Then
          UpdateProduct
          if ActionType="ADD" then  
            serror= "Product " & strcname & " Added - catalogid=" & Session("Productid") & "<br>" 
          else
            sError= "Product " & strcname & " Updated - catalogid=" & Session("Productid") & "<br>" 
          end if
          GetExistingProduct
      end if 
      DisplayForm
      AdminPageTrailer
end if
Sub GetTable
database=request.querystring("database")
dbtable = request.querystring("table")
if dbtable="" then
   dbtable=request.form("dbtable")
end if
if dbtable="" then
   dbtable="Products"
end if
if database="" then
    database=request.form("database")
end if
Which=request.querystring("which")
if which<>"" then
   Session("Productid")=which
   ActionType="FIX"
end if
end sub
Sub GetFormData
	lngCatalogid = Request.Form("lngCatalogid")
	strCcode = Request.Form("strCcode")
	strCname = Request.Form("strCname")
	memCdescription = Request.Form("memCdescription")
	curCprice = Request.Form("curCprice")
	strFeatures = Request.Form("strFeatures")
	arrFeatures = Request.Form("arrFeatures")
	strCimageurl = Request.Form("strCimageurl")
	strButtonimage = Request.Form("strButtonimage")
	datCdateavailable = Request.Form("datCdateavailable")
	lngCstock = Request.Form("lngCstock")
	lngCcategory = Request.Form("lngCcategory")
	strCategory = Request.Form("strCategory")
	strWeight = Request.Form("strWeight")
	strMfg = Request.Form("strMfg")
	strCdescurl = Request.Form("strCdescurl")
	strPother1 = Request.Form("strPother1")
	strPother2 = Request.Form("strPother2")
	strPother3 = Request.Form("strPother3")
    strSyxs = Request.Form("strSyxs")
	strSubcategory = Request.Form("strSubcategory")
end sub
Sub ValidateData
sError=""
   if strcName="" Then
         sError = sError & "Product Name is a required field.<br>"   
    end if
   if memCdescription="" Then
         sError = sError & "Product description is a required field.<br>"   
    end if
   if curCPrice="" then
            sError = sError & "Price is a required field.<br>"   
   else
       if Not IsNumeric(curcPrice) then
              sError = sError & "Price must be numeric.<br>"   
       end if
   end if
   If strCategory="Select" then
            sError = sError & "Category must be selected.<br>"   
   end if
   if datCdateavailable<>"" then
      if Not IsDate(datCdateavailable) then
             sError = sError & "Date Available must be a date.<br>"   
      end if
    end if 
   if lngcStock<>"" then
       if Not IsNumeric(lngcStock) then
              sError = sError & "Stock must be numeric.<br>"   
       end if
   end if

end sub
Sub UpdateProduct
dim sqlo
dim rso
dim filtersql
Dim myconn
ShopOpenDatabase myconn
  GetProductFeatures
  GetProductCategory
  GetProductSubCategory
  Set objRS = Server.CreateObject("ADODB.Recordset")

If ActionType="FIX" then
   filtersql ="select * from products Where 目录ID=" & Session("productID")
'   debugwrite filtersql 
   objRS.open filtersql, myconn, adOpenKeyset, adLockOptimistic
   objRS.Update
else
  objRS.open "products", myconn, adOpenKeyset, adLockOptimistic
  objRS.AddNew
end if
  UpdateField  "编号", strCcode
  UpdateField  "名称", strCname
  UpdateField  "描述", memCdescription
  UpdateField  "价格", curCprice
  UpdateField  "类别ID", lngCcategory
  UpdateField  "类别", strCategory  
'
  UpdateField  "特征", strFeatures
  UpdateField  "小图片地址", strCimageurl
  UpdateField  "按钮图片", strButtonimage
  UpdateField  "大图片地址", strCdescurl
' 
  UpdateField  "有效日期", datCdateavailable
  UpdateField  "库存", lngCstock
  UpdateField  "重量", strWeight
  UpdateField  "体积", strMfg
' 
  UpdateField  "其他1", strPother1
  UpdateField  "其他2", strPother2
  UpdateField  "其他3", strPother3
  if strSyxs="yes" then
   strSyxs=True
  else
   strSyxs=False
  end if
  UpdateField  "首页显示",strSyxs
  UpdateField  "子类别ID", lngSubcategoryID
  objRS.Update
  objRS.close
If actiontype<>"FIX" then
  sqlo = "SELECT max(目录ID) FROM Products"
  Set rso = myconn.Execute(sqlo)	
  lngCatalogId = Cint(rso(0))
  session("ProductID")=rso(0)
  rso.Close
  set rso=nothing
end if
ShopCloseDatabase myconn
End Sub
Sub UpdateField (fieldname, fieldvalue)
if fieldvalue="" then
    exit sub
end if
'Debugwrite fieldname & "value=" & fieldvalue
if ucase(fieldvalue)="NULL" then
   objRS(Fieldname)=NULL
else
  objRS(Fieldname)=fieldvalue
end if

end sub
Sub DisplayForm
	Dim sRowColor
	sRowColor="#2A8662"
	Response.Write("<blockquote>")
	Response.Write("Please update product values and press the Update button.<p>")
	Response.Write("<font color=red>" & sError & "</font><p>")
if which="" then
	Response.Write("<form name=addproduct method=Post action=shopa_addproduct.asp>")
else
	Response.Write("<form name=addproduct method=Post action=shopa_addproduct.asp?which=" & which & ">")
end if
	Response.Write("<table border=1 cellspacing=0 cellpadding=0 bordercolorlight=#000000 bordercolordark=#FFFFFF align=center>")
if which<>"" then
	Response.Write("<tr bgcolor=" & sRowColor &"><td>Catalogid:</td><td><input size=50 name=lngCatalogid value=" & Chr(34) & lngCatalogid & Chr(34) & "></td></tr>")
end if
        RowHeader "△必选字段△"
	Response.Write("<tr bgcolor=" & sRowColor &"><td>名称:</td><td><input size=50 name=strCname value=" & Chr(34) & strCname & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>描述:</td><td><Textarea rows=3 cols=50  name=memCdescription>" & memCdescription  & "</textarea></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>价格:</td><td><input size=50 name=curCprice value=" & Chr(34) & curCprice & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>类别:</td><td>")
        GenerateSelectNV categories,strCategory,"strCategory",categorycount, "Select"
        response.write ("</td></tr>")
        GetProductCategory
        Response.Write("<tr bgcolor=" & sRowColor &"><td>类别ID:</td><td>" & lngcCategory & "</td><td></tr>")
        RowHeader "△可选字段△"
	Response.Write("<tr bgcolor=" & sRowColor &"><td>商品编号:</td><td><input size=50 name=strCcode value=" & Chr(34) & strCcode & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>子类别:</td><td>")
        GenerateSelectNV subcategories,strSubCategory,"strSubCategory",subcategorycount, "Select"
        response.write ("</td></tr>")
        GetProductSubCategory
        Response.Write("<tr bgcolor=" & sRowColor &"><td>子类别ID:</td><td>" & lngSubCategoryID & "</td><td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>商品大图片:</td><td><input size=50 name=strCdescurl value=" & Chr(34) & strCdescurl & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>特征号<br>或从下面列表中选择:</td><td><input size=50 name=strFeatures value=" & Chr(34) & strFeatures & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>特征:</td><td>")
        Featurevaluecount=0
        GenerateSelectMult features,featurecount, Featurevalues,Featurevaluecount,"arrFeatures", "None"
        response.write ("</td></tr>")
        Response.Write("<tr bgcolor=" & sRowColor &"><td>首页小图片:</td><td><input size=50 name=strCimageurl value=" & Chr(34) & strCimageurl & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>新商品图片表示:</td><td><input size=50 name=strButtonimage value=" & Chr(34) & strButtonimage & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>有效日期:</td><td><input size=50 name=datCdateavailable value=" & Chr(34) & datCdateavailable & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>库存:</td><td><input size=50 name=lngCstock value=" & Chr(34) & lngCstock & Chr(34) & "></td></tr>")
'	Response.Write("<tr bgcolor=" & sRowColor &"><td>类别ID:</td><td><input size=50 name=lngCcategory value=" & Chr(34) & lngCcategory & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>重量:</td><td><input size=50 name=strWeight value=" & Chr(34) & strWeight & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>体积:</td><td><input size=50 name=strMfg value=" & Chr(34) & strMfg & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>其他1:</td><td><input size=50 name=strPother1 value=" & Chr(34) & strPother1 & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>其他2:</td><td><input size=50 name=strPother2 value=" & Chr(34) & strPother2 & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>其他3:</td><td><input size=50 name=strPother3 value=" & Chr(34) & strPother3 & Chr(34) & "></td></tr>")
  if strSyxs=True then 
    Response.Write("<tr bgcolor=" & sRowColor &"><td>首页显示:</td><td><input type=checkbox name=strSyxs value=yes checked></td></tr>")
  else
    Response.Write("<tr bgcolor=" & sRowColor &"><td>首页显示:</td><td><input type=checkbox name=strSyxs value=yes></td></tr>")
  end if
    Response.Write("</table><p>")
if which="" then
	Response.Write("<P align=center><input type=submit name=action value=""Add record""></P>")
end if
	Response.Write("<P align=center><input type=submit name=action value=""Fix record""></P>")
	Response.Write("</form>")
	Response.Write("</blockquote>")
End Sub
'***********************
Sub GetCategories
' get categories from database and store in array for quicker access
dim sql
dim rsCat
If isarray(Session("ABCcategories")) then
   categories=Session("categories")
   categorycount=session("categorycount")
   categorynums=Session("categorynums")
   exit sub