shopa_addsubcategory.asp

本软件可以实现的功能如下： 用户管理

<!--#include file="shop$db.asp"-->
<!--#include file="shopa_tools.asp"-->
<%
'ShopCheckAdmin
'*************************************************************
' shop administration only
' adds/updates a subcategory to the database
' New Version 2.3  06/04/00
'
'***************************************************************
Dim CategoryCount
Dim Categories
Dim CategoryNums
Dim SubCategoryCount
Dim SubCategories
Dim SubCategoryNums
Dim dbtable
Dim Actiontype
Dim Which
const cSelect="Select"
GetTable
Dim myconn
sError=""
ShopOpenDatabase myconn
GetCategories
'GetSubCategories
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= strsubcategory & " Added - 子类别Id=" & Session("SubCategoryID") & "<br>" 
          else
            sError= strsubcategory & " Updated - 子类别Id=" & Session("SubCategoryID") & "<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="SubCategories"
end if
if database="" then
    database=request.form("database")
end if
Which=request.querystring("which")
if which<>"" then
   Session("SubcategoryID")=which
   ActionType="FIX"
end if
end sub
'*******************
Sub GetFormData
strSubCategory=request.Form("strSubCategory")
lngSubcategoryid = Request.Form("lngSubcategoryid")
strSubcatOther = Request.Form("strSubcatOther")
strCategory = Request.Form("strCategory")
end sub
Sub ValidateData
sError=""
If strSubcategory = "" Then
	sError = sError & "Subcategory is a required field.<br>"
end if
If strCategory = ""  or strCategory=cSelect Then
		sError = sError & "Category is a required field. " &  strcategory & "<br>"
End If 
end sub
' ************************
Sub UpdateProduct
dim sqlo
dim rso
dim filtersql
Dim myconn
ShopOpenDatabase myconn
GetProductCategory
Set objRS = Server.CreateObject("ADODB.Recordset")

If ActionType="FIX" then
   filtersql ="select * from subcategories Where 子类别id=" & Session("SubCategoryID")
'   debugwrite filtersql 
   objRS.open filtersql, myconn, adOpenKeyset, adLockOptimistic
   objRS.Update
else
  objRS.open "subcategories", myconn, adOpenKeyset, adLockOptimistic
  objRS.AddNew
end if
  UpdateField  "子类别", strSubcategory
  UpdateField  "其他", strSubcatOther
  UpdateField  "类别ID", lngCategoryid
  objRS.Update
  objRS.close
If actiontype<>"FIX" then
  sqlo = "SELECT max(子类别ID) FROM Subcategories"
  Set rso = myconn.Execute(sqlo)	
  lngSubcategoryID = Cint(rso(0))
  session("SubCategoryID")=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="#C4CEE5"
	Response.Write("<blockquote>")
	Response.Write("Please update 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_addsubcategory.asp>")
else
	Response.Write("<form name=addproduct method=Post action=shopa_addsubcategory.asp?which=" & which & ">")
end if
	Response.Write("<table cellpadding=2 cellspacing=2>")
if which<>"" or ActionType="ADD" then
	Response.Write("<tr bgcolor=" & sRowColor &"><td>子类别ID:</td><td><input size=50 name=lngSubcategoryID value=" & Chr(34) & lngsubcategoryID & Chr(34) & "></td></tr>")
end if
       	Response.Write("<tr bgcolor=" & sRowColor &"><td>子类别:</td><td><input size=50 name=strSubcategory value=" & Chr(34) & strSubcategory & Chr(34) & "></td></tr>")
	Response.Write("<tr bgcolor=" & sRowColor &"><td>类别:</td><td>")
        GenerateSelectNV categories,strCategory,"strCategory",categorycount, "Select"
        response.write ("</td></tr>")
        Response.Write("<tr bgcolor=" & sRowColor &"><td>其他:</td><td><input size=20 name=strSubcatOther value=" & Chr(34) & strSubcatOther & Chr(34) & "></td></tr>")
	Response.Write("</table><p>")
if which="" then
	Response.Write("<input type=submit name=action value=""Add record"">")
end if
	Response.Write("<input type=submit name=action value=""Fix record"">")
	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("categories")) then
   categories=Session("categories")
   categorycount=session("categorycount")
   categorynums=Session("categorynums")
   exit sub
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
If IsArray(Session("Subcategories"))  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
    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 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
'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
       lngCategoryID=categorynums(i)
       exit sub
  end if
next 
lngcCategory=0
Debugwrite "GetProductCategory Failed to find =" & strcategory 
end sub
Sub GetExistingProduct
ShopOpenDatabase myconn
dim getsql
lngsubcategoryid=Session("SubCategoryID")
lngsubcategoryid=cint(lngsubcategoryID)
getsql="select * from SubCategories Where 子类别id=" & lngSubCategoryid
Set objRS = myconn.Execute(getsql)
	If objRS.EOF Then
		lngSubcategoryid = ""
		strSubcategory = ""
		strSubcatname = ""
		lngCategoryid = ""
	Else
		lngSubcategoryid = objRS("子类别id")
		strSubcategory = objRS("子类别")
		strSubcatOther = objRS("其他")
		lngCategoryid = objRS("类别id")
                GetCategoryName  
	End If
objRS.close
ShopCloseDatabase myconn
End Sub
Sub GetCategoryName
'locate category in category table
for i = 0 to categorycount-1
  if lngcategoryid=categorynums(i) then
       strcategory=categories(i)
       exit sub
  end if
next 
Debugwrite "Category not found =" & lngcategoryid 
end sub

%>