shopa_addproduct.asp

来自「ASP+SQL Server动态网站开发从基础到实践教程」· ASP 代码 · 共 529 行 · 第 1/2 页

	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("Catdescription")
    categorynums(categorycount)= rscat("Categoryid")
'  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("SubCategory")
    Subcategorynums(Subcategorycount)= rscat("SubCategoryid")
'  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 FeatureNuM, FeatureCaption from ProdFeatures Order by FeatureCaption"
	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("FeatureCaption") & " [" & rscat("FeatureNum") & "]"
	'  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="FFFFFF"
	Response.Write("<tr bgcolor=" & sRowColor &"><td>" & header &"</td><td>")
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 

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 Catalogid=" & 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 = ""
                lngSubcategoryID=""
	Else
'		lngCatalogid = objRS("Catalogid")
		strCcode = objRS("Ccode")
		strCname = objRS("Cname")
		memCdescription = objRS("Cdescription")
		curCprice = objRS("Cprice")
		strFeatures = objRS("Features")
		strCimageurl = objRS("Cimageurl")
		strButtonimage = objRS("Buttonimage")
		datCdateavailable = objRS("Cdateavailable")
		lngCstock = objRS("Cstock")
		lngCcategory = objRS("Ccategory")
		strCategory = objRS("Category")
		strWeight = objRS("Weight")
		strMfg = objRS("Mfg")
		strCdescurl = objRS("Cdescurl")
		strPother1 = objRS("Pother1")
		strPother2 = objRS("Pother2")
		strPother3 = objRS("Pother3")
                lngSubcategoryID=objRS("SubcategoryID")
                GetSubCategoryName
                strcategory=  objRS("Category") 
                Session("ProductID")=lngcatalogid
'               debugwrite strcategory
	End If
End Sub
'objRS.close

%>