<%
'##################################################################                                                                 
'★         web08.net - 威博购物系统                                              
'★  版权所有: web08.net                                                                                                       
'★  程序制作: 威博网络技术公司                                     
'★           email:web08net@hotmail.com                           
'★            Q Q :645095280,475980829
'★	       电话:021-55520018                                                                                                         
'★  相关网址: [产品介绍] http://www.021web.com.cn/gwxt.html
'★            [支持论坛] http://bbs.web08.net/                                                                                     
'★  主页地址: http://www.web08.net/  
'★		http://www.021web.com.cn/			                                                                 
'###################################################################
%>
<%
'***********************************************
'过程名：showpage
'作  用：显示“上一页 下一页”等信息
'参  数：sfilename  ----链接地址
'       totalnumber ----总数量
'       maxperpage  ----每页数量
'       ShowTotal   ----是否显示总数量
'       ShowAllPages ---是否用下拉列表显示所有页面以供跳转。有某些页面不能使用，否则会出现JS错误。
'       strUnit     ----计数单位
'***********************************************
Function showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
	dim n, i,strTemp,strUrl
	if totalnumber mod maxperpage=0 then
    	n= totalnumber \ maxperpage
  	else
    	n= totalnumber \ maxperpage+1
  	end if
  	strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
	if ShowTotal=true then 
		strTemp=strTemp & "<font color=black>共 <b>" & totalnumber & "</b> " & strUnit & "&nbsp;&nbsp;"
	end if
	strUrl=JoinChar(sfilename)
  	if CurrentPage<2 then
    		strTemp=strTemp & "首页 上一页&nbsp;"
  	else
    		strTemp=strTemp & "<a href='" & strUrl & "page=1'>首页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一页</a>&nbsp;"
  	end if

  	if n-currentpage<1 then
    		strTemp=strTemp & "下一页 尾页"
  	else
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一页</a>&nbsp;"
    		strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾页</a>"
  	end if
   	strTemp=strTemp & "&nbsp;页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
    	strTemp=strTemp & "&nbsp;<b>" & maxperpage & "</b>" & strUnit & "/页</font>"
	strTemp=strTemp & "</td></tr></form></table>"
	showpage=strtemp
end Function

Function ChangeToHtmlStr(CTHStr)
  Dim TempStr,i,LenStr
  If IsNull(CTHStr) Then
     ChangeToHtmlStr=""
     Exit Function
  End If
  LenStr=Len(CTHStr)
  TempStr=""
  For i=1 To LenStr
      Select Case Mid(CTHStr,i,1)
             Case "<"
                TempStr=TempStr+"&lt;"
             Case ">"   
                TempStr=TempStr+"&gt;"
             Case "&"      
                TempStr=TempStr+"&amp;"
             Case Chr(34)
                TempStr=TempStr+"&quot;"
             Case Chr(13)
                TempStr=TempStr+"<br>"
             Case Chr(9)
                TempStr=TempStr+"&nbsp;&nbsp;&nbsp;&nbsp;"
             Case Chr(32)
                TempStr=TempStr+"&nbsp;"     
             Case Else
                TempStr=TempStr+Mid(CTHStr,i,1)
             End Select
    Next         
  ChangeToHtmlStr=TempStr                 
End Function

Function msglength(msg,length)
 if msg="" or isnull(msg) or IsNumeric(length)=False then
	msglength=""
	Exit Function
 else
	length=int(length)
	j=0
	for ii=1 to len(msg)
		if asc(mid(msg,ii,1))>0 then j=j+1 else j=j+2
			if j>length*2 then exit for
	next
	if j<=length*2 then 
		msglength=msg 
	else 
		msglength=left(msg,ii-1)&"..."
	end if
 end if
End function

Function ShowLength(msg)
	j=0
	for ii=1 to len(msg)
		if asc(mid(msg,ii,1))>0 then
			j=j+1 
		else 
			j=j+2
		end if
	next
	ShowLength=j
End Function

'+++++++++++++++++++++++++++++++
'countorders 统计用户定单数
'+++++++++++++++++++++++++++++++
Function countorders(uid)
 	set rec=server.createobject("adodb.recordset")
	sql="select count(orderid) as countorders from orders where userid='"&uid&"' "
	rec.open sql,conn,3,1
	countorders=rec("countorders")
	rec.close : set rec=nothing
End Function

'++++++++++++++++++++++++++++++
'ClassExist 判断某一类别是否存在
'参数说明：
'classname:要检查的类别名称 
'tabname:所在表名
'fldname:对应字段名
'strwhere:查询条件
'类别已存在 返回 classexist=0 
'类别不存在 返回 classexist=1
'++++++++++++++++++++++++++++++
Function ClassExist(ClassName,tabname,fldname,strwhere)
	set rec=server.createobject("adodb.recordset")
	sql="select "&fldname&" from "&tabname& " where " &  strwhere
	'response.end
	rec.open sql,conn
	if rec.eof then 
		classexist=1
	else
		classexist=0
	end if 
	rec.close : set rec=nothing
End Function

'++++++++++++++++++++++++++++++
'creatonlyid 生成购物车ID
'说明：直接调用
'++++++++++++++++++++++++++++++
Function CreateOnlyID()
	tmpid=right(year(now()),2)
	if month(now())<10 then
		tmpid=tmpid &"0"& month(now())
	else
		tmpid=tmpid & month(now())
	end if
	if day(now())<10 then
		tmpid=tmpid &"0"& day(now())
	else
		tmpid=tmpid & day(now())
	end if 
	tmpid=tmpid & hour(now())
	tmpid=tmpid & minute(now())
	tmpid=tmpid & second(now())
	Randomize
	upperbound=99999
	lowerbound=10000
	tmpid=tmpid & Int((upperbound - lowerbound + 1) * Rnd + lowerbound) 
	CreateOnlyID=tmpid
End Function

'++++++++++++++++++++++++++++++
' 生成店铺编号ID
'说明：直接调用
'++++++++++++++++++++++++++++++

'++++++++++++++++++++++++++++++
' 生成商品编号ID
'说明：直接调用
'++++++++++++++++++++++++++++++
Function CreateproductID()
	tmpid=right(year(now()),2)
	tmpid=tmpid & month(now())
	tmpid=tmpid & day(now())
	Randomize
	upperbound=99999
	lowerbound=10000
	tmpid=tmpid & Int((upperbound - lowerbound + 1) * Rnd + lowerbound) 
        tmpid="P"&tmpid
	CreateproductID=tmpid
End Function
'++++++++++++++++++++++++++++++
'GetOneValue 取得某一值
'参数说明：
'tabname:所在表名
'fldname:要取值的字段名
'strwhere:查询条件
'++++++++++++++++++++++++++++++
Function GetOneValue(tabname,fldname,strwhere)
         conndb	
        'on error resume next
	set ojbrss=server.createobject("adodb.recordset")
	if strwhere="" then
		sql="select ["&fldname&"] from " & tabname
	else
		sql="select ["&fldname&"] from "&tabname& " where " &  strwhere
	end if 
	'response.write sql&"<br>"
	'response.end
	ojbrss.open sql,conn,1,3
	if err.number<>0 then
		GetOneValue="-1EISERR"
		err.clear
		ojbrss.close : set ojbrss=nothing
		exit function 
		response.end
	end if 
	if ojbrss.eof then 
		Rem When the result is null return this value
		GetOneValue="-1NISNUL"
	else
		rem return value
		GetOneValue=ojbrss(fldname)
	end if 
	ojbrss.close : set ojbrss=nothing
End Function


'++++++++++++++++++++++++++++++
'CountTotal 计算总数
'参数说明：
'tabname:所在表名
'fldname:要取值的字段名
'strwhere:查询条件
'++++++++++++++++++++++++++++++
Function CountTotal(tabname,cc,fldname,strwhere)
	set rec=server.createobject("adodb.recordset")
	if strwhere="" then
		sql="select " & cc & " as " & fldname & " from " & tabname
	else
		sql="select " & cc & " as " & fldname & " from " & tabname & " where " &  strwhere
	end if 
	//response.write sql
	//response.end
	rec.open sql,conn
	do while not rec.eof 
	  tmp=tmp+rec(fldname)
	  rec.movenext
	loop 
	CountTotal=tmp
	rec.close : set rec=nothing
End Function
'++++++++++++++++++++++++++++++
'DateFormat 日期显示格式
'++++++++++++++++++++++++++++++
Function  DateFormat(DateStr,Types)
    Dim DateString
	if IsDate(DateStr) = False then
		DateString = ""
	end if
	Select Case Types
	  Case "1" 
		  DateString = Year(DateStr)&"-"&Month(DateStr)&"-"&Day(DateStr)
	  Case "2"
		  DateString = Year(DateStr)&"."&Month(DateStr)&"."&Day(DateStr)
	  Case "3"
		  DateString = Year(DateStr)&"/"&Month(DateStr)&"/"&Day(DateStr)
	  Case "4"
		  DateString = Month(DateStr)&"/"&Day(DateStr)&"/"&Year(DateStr)
	  Case "5"
		  DateString = Day(DateStr)&"/"&Month(DateStr)&"/"&Year(DateStr)
	  Case "6"
		  DateString = Month(DateStr)&"-"&Day(DateStr)&"-"&Year(DateStr)
	  Case "7"
		  DateString = Month(DateStr)&"."&Day(DateStr)&"."&Year(DateStr)
	  Case "8"
		  DateString = Month(DateStr)&"-"&Day(DateStr)
	  Case "9"
		  DateString = Month(DateStr)&"/"&Day(DateStr)
	  Case "10"
		  DateString = Month(DateStr)&"."&Day(DateStr)
	  Case "11"
		  DateString = Month(DateStr)&"月"&Day(DateStr)&"日"
	  Case "12"
		  DateString = Day(DateStr)&"日"&Hour(DateStr)&"时"
	  case "13"
		  DateString = Day(DateStr)&"日"&Hour(DateStr)&"点"
	  Case "14"
		  DateString = Hour(DateStr)&"时"&Minute(DateStr)&"分"
	  Case "15"
		  DateString = Hour(DateStr)&":"&Minute(DateStr)
	  Case "16"
		  DateString = Year(DateStr)&"年"&Month(DateStr)&"月"&Day(DateStr)&"日"
	  Case Else
	  	  DateString = DateStr
	 End Select
	 DateFormat = DateString
 End Function

'++++++++++++++++++++++++++++++
'FormatDateTime 格式化日期
'++++++++++++++++++++++++++++++
Function FormatDateTime(dtime)
	FormatDateTime=right(year(dtime),2) &"/"& month(dtime)&"/"& day(dtime)& " "& hour(dtime) &":"& minute(dtime)
End Function

'++++++++++++++++++++++++++++++++++
'FormatDateTime 格式化日期02/02/02
'+++++++++++++++++++++++++++++++++++
Function FormatDateTime_1(dtime)
	FormatDateTime_1=right(year(dtime),2) &"/"& month(dtime)&"/"& day(dtime)
End Function

'++++++++++++++++++++++++++++++
'Web_L_DUserscore 扣除用户积分
'++++++++++++++++++++++++++++++
Function Web_L_DUserscore(orderid)
	userid=trim(getonevalue("orders","userid","orderid='"&orderid&"'"))
	tmp=ClassExist("","dv_user","username","username='"&userid&"'")
	if tmp=0 then	'会员用户
		levstate=getonevalue("orders","levstate","orderid='"&orderid&"'")
		set objrec=server.createobject("adodb.recordset")
		sql="select * from score where lev_score<"&levstate&" order by lev_score desc"	
		objrec.open sql,conn
		if not objrec.eof then 
			disrate=objrec("lev_kcjf")
			'response.write disrate
			dscore=objrec("lev_jifen")
			objrec.close
		end if
		if disrate=1 then
		response.write "执行了吗"
			sql="select * from soldgoods where fee=0 and orderid='"&orderid&"'"
			objrec.open sql,conn
			do while not objrec.eof
				shopcount=objrec("shopcount")
				dscore_t=dscore*shopcount
				sql="insert into marktrade(userid,runner,traderaason,trademarks,tradetime,activeid,tradeflag) values('"&userid&"','"&session("admin")&"','购买商品，享受折扣,扣除积分',"&dscore_t&",'"&now()&"','"&orderid&"',0)"
				conn.execute(sql)
				conn.execute("update dv_user set score=score-"&dscore_t&" where username='"&userid&"'")
			objrec.movenext
			loop
			objrec.close
		end if 
	end if 
	set objrec=nothing
End Function

'++++++++++++++++++++++++++++++
'LargessMark 赠送用户积分
'++++++++++++++++++++++++++++++
Function LargessMark(orderid)
	
	set rec=server.createobject("adodb.recordset")
	sql="select * from web_soldgoods where orderid='"&orderid&"'"
	rec.open sql,conn
	userid=trim(rec("userid"))
	do while not rec.eof 
		shopid=rec("sc_goodid")
		other=split(rec("sc_other"),"~")
		'response.write ubound(other)
		if ubound(other)>0 then 
			select case right(other(0),1)
				case 0:
					'wait add program
				case 1:
					'wait add victure good
				case 2:
					actid=getonevalue("web_product","p_active","id="&shopid)
					if isnumeric(actid)=true then
						bfnid=getonevalue("web_activity","A_BenefitId","id="&actid)
						if bfnid<>"" and isnull(bfnid)=false then
							bfnnum=split(bfnid,",")
							for w_jj=0 to ubound(bfnnum)
								sql="select * from Web_Benefit where ID="&trim(bfnnum(w_jj))
								set rs_2=conn.execute(sql)
								if not rs_2.eof then
									sql="insert into Web_BenefitHistory(bh_codeid,bh_money,bh_flag,bh_type,bh_addtime,userid) values('"&rs_2("bg_codeid")&"','"&rs_2("bg_money")&"',"&rs_2("bf_flag")&",0,'"&now()&"','"&userid&"')"
									conn.execute(sql)
								end if 
							next
						end if
					end if 
				case 3:
					'折扣功能取消
					'actid=getonevalue("product","favoractivity","id="&shopid)
					'act_usemarks=getonevalue("activity","act_usemarks","id="&actid)
					'sql="update dv_user set score=score-"&act_usemarks&" where username='"&userid&"'"
					'conn.execute(sql)
					'sql="insert into marktrade(userid,runner,traderaason,trademarks,tradetime,activeid,tradeflag) values('"&userid&"','"&session("admin")&"','享受折扣，消耗积分',"&act_usemarks&",'"&now()&"','"&orderid&"',0)"
					'conn.execute(sql)
				case 4:
					scroes=split(trim(split(other(1),"|")(1)),"@@")(0)*rec("sc_shopcount")
					sql="update web_user set U_AvailScore=U_AvailScore+"&scroes&" where u_username='"&userid&"'"
					conn.execute(sql)
					call Scorehistory(scroes,10,userid)
			end select
		end if 
	rec.movenext
	loop
	rec.close : set rec=nothing
End Function

Function FileEx(path)
      	set fso=server.createobject(c_fso)
	filespec=server.MapPath(path)
	If (fso.FileExists(filespec)) Then
        	msg ="true"
        Else
          	 msg = "false"
        End If
     	FileEx = msg
     	set fso=nothing 
End function

Function FindNextPoint(s,j)
	for ii=0 to j
		ii=ii+1
	next
	FindNextPoint=s+ii
End Function

'+++++++++++++++++++++++++++++++++
'MPRO_count 修改商品卖出量和订单量 
'+++++++++++++++++++++++++++++++++
Function MPRO_count(orderid)
	set rec=server.createobject("adodb.recordset")
	sql="select * from web_soldgoods where orderid='"&orderid&"'"
	rec.open sql,conn
	do while not rec.eof 
		shopid=rec("sc_goodid")
		sql="update web_product set p_solded=p_solded+" & rec("sc_shopcount") &", p_ordernums=p_ordernums-" & rec("sc_shopcount") & " where id=" & shopid
		conn.execute(sql)
	rec.movenext
	loop
	rec.close : set rec=nothing
End Function

'++++++++++++++++++++++++++++++++++
'RiewRecord写产品浏览记录
'++++++++++++++++++++++++++++++++++
Function ViewRecord(pid,pname)
	if session("kkuid")<>"" then
		set rs=server.createobject("adodb.recordset")
		sql="select * from collection where userid='"&session("kkuid")&"' and shopid=" & pid
		rs.open sql,conn
		if rs.eof then
			sql="insert into collection(userid,shopid,shopname,act,adddate) values('"&session("kkuid")&"',"&pid&",'"&pname&"',0,'"&now()&"')"
			conn.execute(sql)
			rs.close : set rs=nothing
		else
			if rs("act")=0 then 
				sql="update collection set adddate='"&now()&"' where userid='"&session("kkuid")&"' and shopid=" & pid
				conn.execute(sql)
			end if 
			rs.close : set rs=nothing
		end if
	end if
End Function

'+++++++++++++++++++++++++++++++++++++++++++
'nolevel 无限级分类下拉菜单显示,添加分类使用
'+++++++++++++++++++++++++++++++++++++++++++
Function nolevel(tabname,id,level)
	set rec=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where fid="& id
	rec.open sql,conn
	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	for ii=1 to level
		name=name&"&nbsp;"
	next
	do while not rec.eof
		level=rec("level")
		'if clng(selectid)=clng(rec("id")) then
		'	ss="selected"
		'else
		'	ss=""
		'end if
		w_selected=w_selectid(rec("id"))
		response.write "<option value='"&rec("id")&"|"&rec("level")+1&"' "&w_selected&">"&name&"┝"&rec("name")&"</option>"&vbcrlf
		call nolevel(tabname,rec("id"),level)
	rec.movenext
	loop
	rec.close : set rec=nothing
	name="&nbsp;"
End Function

Function w_selectid(byval w_recid)
	w_sid=split(selectid,",")
	for i=0 to ubound(w_sid)
		if clng(w_sid(i))=w_recid then
			w_select_1="selected "
			exit for
		end if
	next
	w_selectid=w_select_1
End Function

'+++++++++++++++++++++++++++++++++++++++++++
'nolevel (商品编辑)特殊函数
'+++++++++++++++++++++++++++++++++++++++++++
Function nolevel_good(tabname,id,level)
	set rec=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where fid="& id
	rec.open sql,conn
	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	for ii=1 to level
		name=name&"&nbsp;"
	next
	do while not rec.eof
		level=rec("level")
		if clng(selectgoodid)=clng(rec("id")) then
			ss="selected"
		else
			ss=""
		end if
		response.write "<option value='"&rec("id")&"|"&rec("level")+1&"' "&ss&">"&name&"┝"&rec("name")&"</option>"&vbcrlf
		call nolevel_good(tabname,rec("id"),level)
	rec.movenext
	loop
	rec.close : set rec=nothing
	name="&nbsp;"
End Function
'+++++++++++++++++++++++++++++++++++++++++++
'nolevel 无限级分类下拉菜单显示,显示分类使用
'+++++++++++++++++++++++++++++++++++++++++++
Function nolevel_list(tabname,id,level)
	conndb
	fldname="id,name,fid,[level],v_order"
	sql="select "&fldname&" from "&tabname&" where fid="& id
	set rec=conn.execute(sql)
	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	iRs=rec.GetRows()
	rec.close : set rec=nothing

	for ii=1 to level
		name=name&"&nbsp;"
	next

	for i=0 to Ubound(iRs,2)
		level=iRs(3,i)
		if clng(selectid)=clng(iRs(0,i)) then
			ss="selected"
		else
			ss=""
		end if
		response.write "<option value='"&iRs(0,i)&"' "&ss&">"&name&"┝"&iRs(1,i)&"</option>"&vbcrlf
		call nolevel_list(tabname,iRs(0,i),level)
	next
	name="&nbsp;"
End Function

'+++++++++++++++++++++++++++++++++++++++++++
'nolevel 无限级分类下拉菜单显示,添加分类使用
'+++++++++++++++++++++++++++++++++++++++++++
Function nolevel_tpl(tabname,id,level)
	set rec=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where fid="& id
	rec.open sql,conn
	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	for ii=1 to level
		name=name&"&nbsp;"
	next
	do while not rec.eof
		level=rec("level")
		if clng(selectid)=clng(rec("id")) then
			ss="selected"
		else
			ss=""
		end if
		str1=str1&"<option value='"&rec("id")&"|"&rec("level")+1&"' "&ss&">"&name&"┝"&rec("name")&"</option>"&vbcrlf
		call nolevel_tpl(tabname,rec("id"),level)
	rec.movenext
	loop
	rec.close : set rec=nothing
	name="&nbsp;"
	nolevel_tpl=str1
End Function

Function nolevel_tpl_1(tabname,id,level)
	set rec=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where fid="& id
	rec.open sql,conn
	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	for ii=1 to level
		name=name&"&nbsp;"
	next
	do while not rec.eof
		level=rec("level")
		if clng(selectid)=clng(rec("id")) then
			ss="selected"
		else
			ss=""
		end if
		str1=str1&"<option value='"&rec("id")&"|"&rec("level")+1&"' "&ss&">"&name&"┝"&msglength(rec("name"),6)&"</option>"&vbcrlf
		call nolevel_tpl_1(tabname,rec("id"),level)
	rec.movenext
	loop
	rec.close : set rec=nothing
	name="&nbsp;"
	nolevel_tpl_1=str1
End Function

'+++++++++++++++++++++++++++++++++++++++++++++
'nolevel 无限级分类下拉菜单函数1 编辑分类使用
'++++++++++++++++++++++++++++++++++++++++++++
Function nolevel_1(tabname,id,level,selectid)
	set rec=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where fid="& id
	rec.open sql,conn
	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	for ii=1 to level
		name=name&"&nbsp;"
	next
	
	do while not rec.eof
		level=rec("level")
		if selectid=rec("id") then
			response.write "<option value='"&rec("fid")&"|"&rec("level")&"' selected>"&name&"┝"&rec("name")&"</option>"&vbcrlf
		else 
			response.write "<option value='"&rec("id")&"|"&rec("level")+1&"' >"&name&"┝"&rec("name")&"</option>"&vbcrlf
		end if 
		'w_selected=w_selectid(selectid,rec("id"))
		'response.write "<option value='"&rec("fid")&"|"&rec("level")&"' "&w_selected&">"&name&"┝"&rec("name")&"</option>"&vbcrlf		
		call nolevel_1(tabname,rec("id"),level,selectid)
	rec.movenext
	loop
	rec.close : set rec=nothing
	name="&nbsp;"
End Function

'++++++++++++++++++++++++++++++++++
'nolevel 无限级分类下树状显示
'++++++++++++++++++++++++++++++++++
Function nolevel_tree(tabname,id,level)
	set rec=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where fid="& id
	rec.open sql,conn
	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	for ii=1 to level
		name=name&"&nbsp;"
	next
	do while not rec.eof
		level=rec("level")
		response.write name&"┝"&rec("name")&"<br>"&vbcrlf
		call nolevel_tree(tabname,rec("id"),level)
	rec.movenext
	loop
	rec.close : set rec=nothing
	name="&nbsp;"
End Function

'++++++++++++++++++++++++++++++++++
'nolevel 无限级分类下树状显示1
'++++++++++++++++++++++++++++++++++
Function nolevel_tree1(tabname,id,level)
	set rec=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where fid="& id
	rec.open sql,conn
	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	for ii=1 to level
		name=name&"&nbsp;"
	next
	do while not rec.eof
		level=rec("level")
		classlist=classlist&"|"&name&"┝"&rec("name")
		v_classlist=v_classlist&"|"&name&"┝"&rec("name")
		sidlist=sidlist&"|"&rec("id")
		call nolevel_tree1(tabname,rec("id"),level)
	rec.movenext
	loop
	rec.close : set rec=nothing
	name="&nbsp;"
	classlist=replace(classlist,"|","",1,1)
	//v_classlist=replace(v_classlist,"|","",1,1)
	//sidlist=replace(sidlist,"|","",1,1)
	nolevel_tree1=classlist
End Function


'++++++++++++++++++++++++++++++++++
'nolevel 无限级分类下某一分类显示
'++++++++++++++++++++++++++++++++++
Function nolevel_show1(tabname,id,level)
	set ojbrss=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where id="& id
	ojbrss.open sql,conn
	if ojbrss.eof then
		ojbrss.close : set ojbrss=nothing
		exit function
	end if

	do while not ojbrss.eof
		level=ojbrss("level")
		namelist=">"&ojbrss("name")&namelist
		call nolevel_show1(tabname,ojbrss("fid"),level)
	ojbrss.movenext
	loop
	ojbrss.close : set ojbrss=nothing
	nolevel_show1=namelist
End Function
'################################################
'获取省市地址专用
'################################################
Function nolevel_showarea(tabname,id,level)
	set ojbrss=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where id="& id
	ojbrss.open sql,conn
	if ojbrss.eof then
		ojbrss.close : set ojbrss=nothing
		exit function
	end if
	ii=0
	do while not ojbrss.eof
		vlevel=ojbrss("level")
		if ii=0 then
			vnamelist=ojbrss("name")&"--"
		else
			vnamelist=vnamelist&ojbrss("name")
		end if
		
		call nolevel_showarea(tabname,ojbrss("fid"),vlevel)
	ojbrss.movenext
	ii=ii+1
	loop
	response.write	vnamelist
	'response.write replace(vnamelist,"---","")
	ojbrss.close : set ojbrss=nothing
End Function

'################################################
Function nolevel_showname(tabname,id,level)

	set ojbrss=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where id="& id
	ojbrss.open sql,conn
	if ojbrss.eof then
		ojbrss.close : set ojbrss=nothing
		exit function
	end if

	level=ojbrss("level")
	namelist=">"&trim(ojbrss("name"))&namelist
	call nolevel_showname(tabname,ojbrss("fid"),level)

	ojbrss.close : set ojbrss=nothing
	nolevel_showname=namelist

End Function

'++++++++++++++++++++++++++++++++++
'nolevel 无限级分类删除函数
'++++++++++++++++++++++++++++++++++
Function nolevel_del(tabname,id)
	set rec=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where fid="& id
	rec.open sql,conn
	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	do while not rec.eof
		id=rec("id")
		sql="delete from "&tabname&" where id in("&rec("id")&")"
		//response.write sql
		conn.execute(sql)
		call nolevel_del(tabname,id)
	rec.movenext
	loop
	rec.close : set rec=nothing
End Function

'++++++++++++++++++++++++++++++++++
'nolevel 无限级分类选择ID函数
'++++++++++++++++++++++++++++++++++
Function nolevel_selectid(tabname,id)
	set rec=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where fid in("& id &")"
	'response.write sql
	rec.open sql,conn

	if rec.eof then
		rec.close : set rec=nothing
		exit function
	end if
	do while not rec.eof
		id=rec("id")
		s_id=s_id&","&rec("id")
		rootidlist=rootidlist&","&rec("id")
		call nolevel_selectid(tabname,id)
	rec.movenext
	loop
	rec.close : set rec=nothing

	nolevel_selectid=s_id
	nolevel_selectid=replace(nolevel_selectid,",","",1,1)
End Function

Function GetSameLevelId(tabname,rootid1)
	rootid=rootid1
	p_id=trim(nolevel_selectid(tabname,rootid1))
	if p_id<>"" then
		p_id=p_id&","&rootid
		rootidlist=rootidlist&","&rootid
	else
		p_id=rootid
		rootidlist=rootid
	end if 
	GetSameLevelId=p_id
End Function

Function GetRootId(tabname,id)
	set ojbrss=server.createobject("adodb.recordset")
	sql="select * from "&tabname&" where id="& id
	'response.write sql
	ojbrss.open sql,conn
	'response.write sql&"<br>"
	fid=ojbrss("fid")
	id=ojbrss("id")
	if fid=0 then
		GetRootId=id
		v_rootid=id
		ojbrss.close :set ojbrss=nothing
		classrootid=id
		exit function
	end if
	ojbrss.close : set objrss=nothing
	call getrootid(tabname,fid)
End Function

 Function CreateStrList()
	const code="AaBbCcDdEeFfGgHhIiJjKkLlMmNnOoPpQqRrSsTtUuVvWwXxYyZz"
	for i=0 to 15
		Randomize
		tmp=Int((52 * Rnd) + 1)
		tmpid=tmpid & mid(code,tmp,1)
	next
	CreateStrList=tmpid
	tmpid=""
 End Function

 rem MoveChar GO
 Function StrMove_GO(p)
	for i=1 to 8
		tmp=asc(mid(p,i,1))
		tmp=StrMove_TO_GO(tmp,i)
		pi=pi&tmp
	next
	StrMove_GO=pi
	tmp=""
 End Function

 rem MoveChar BACK
 Function StrMove_Back(p)
	for i=1 to 8
		tmp=asc(mid(p,i,1))
		tmp=StrMove_TO_Back(tmp,i)
		pi=pi&tmp
	next
	StrMove_Back=pi
	tmp=""
 End Function

 REM process char move go
 Function StrMove_TO_GO(tmp,i)
	if tmp<=90 and (tmp+i)>90 then
		tmp=tmp-90+i+64
	elseif tmp<=122 and (tmp+i)>122 then
		tmp=tmp-122+i+96
	else
		tmp=tmp+i
	end if
	StrMove_TO_GO=chr(tmp)
	tmp=""
 End Function

 rem process char move back
 Function StrMove_TO_BACK(tmp,i)
	if (tmp-i)<65 then
		tmp=tmp-i+26
	elseif tmp>=97 and (tmp-i)<97 then
		tmp=tmp-i+26
	else
		tmp=tmp-i
	end if
	StrMove_TO_BACK=chr(tmp)
	tmp=""
 End Function

 Function Str16_To_32(p)
	for i=1 to 16
		tmp1=asc(mid(p,i,1))
		ii=len(p)-i+1
		tmp2=asc(mid(p,ii,1))
		tmp1=StrMove_TO_GO(tmp1,i)
		tmp2=StrMove_TO_BACK(tmp2,i)
		tmp=tmp2&tmp1
		pi=pi&tmp
	next
	Str16_To_32=right(pi,16)&left(pi,16)
	tmp=""
 End Function

 Function Str32_To_16(p)
	p=right(p,16)&left(p,16)
	for i=2 to 32 step 2
		tmp=mid(p,i,1)
		pi=pi&tmp
	next
	for i=1 to 16
		tmp=asc(mid(pi,i,1))
		tmp=StrMove_To_BACK(tmp,i)
		pii=pii&tmp
	next
	Str32_To_16=pii
	tmp=""
 End Function

 Function Bits32()
	p=CreateStrList
	p1=StrMove_GO(left(p,8))
	p2=StrMove_BACK(right(p,8))
	bits32=Str16_To_32(p1&p2)
 End Function

 Function Bits16_to_32(pwd32)
	p=pwd32
	p1=StrMove_GO(left(p,8))
	p2=StrMove_BACK(right(p,8))
	bits16_to_32=Str16_To_32(p1&p2)
 End Function

 Function Bits16(str32)
	p=Str32_To_16(str32)
	p1=StrMove_BACK(left(p,8))
	p2=StrMove_GO(right(p,8))
	p=p1&p2
	bits16=p
 End Function

 Function FolderExist(ByVal folderpath)
	Set fso = CreateObject(c_fso)
	folderpath=server.mappath(folderpath)
	'response.write folderpath&"<br>"
	if fso.folderexists(folderpath)=false then
		fso.createfolder(folderpath)
	end if
	set fso=nothing
 End Function

 Function Web_FileExist(byval w_Filepath)
	w1_Filepath=w_Filepath
	Set fso = CreateObject(c_fso)
	w1_Filepath=server.mappath(w1_Filepath)
	Web_FileExist=fso.FileExists(w1_Filepath)
	set fso=nothing
 End Function

 Function showimg(url,pic,w,h)
	if lcase(right(pic,3))="swf" then
		str=str& "<object classid='clsid:D27CDB6E-AE6D-11cf-96B8-444553540000' codebase='http://download.macromedia.com/pub/shockwave/cabs/flash/swflash.cab#version=6,0,29,0' width='"&w&"' height='"&h&"' >" & vbcrlf
 		str=str& "<param name='movie' value='"&pic&"'>" &vbcrlf
 		str=str& "<param name='quality' value='high'>" & vbcrlf
		str=str& "<param name='wmode' value='transparent'>" & vbcrlf
      		str=str& "<embed src='"&pic&"' quality='high' pluginspage='http://www.macromedia.com/go/getflashplayer' type='application/x-shockwave-flash' width='"&w&"' height='"&h&"'></embed>" & vbcrlf
     		str=str& "</object>" & vbcrlf
	else
		if url<>"" then 
		   str=str& "<a href='"&url&"' target=_blank><img src='"&pic&"' width='"&w&"' height='"&h&"' border='0'></a>"
		else 
		   str=str& "<img src='"&pic&"' width='"&w&"' height='"&h&"' border='0'>"
		end if 
	end if 
	showimg=str
 End Function

Function web_l_safecode(v_safecode)
	v_lencode=len(v_safecode)
	code1=v_safecode
	code1=replace(code1,left(code1,1),"",1,1)
	code1=code1&(v_lencode*(v_lencode+1))
	code1=md5(code1)
	code1=right(code1,8)&left(code1,8)
	web_l_safecode=code1
End Function

 Function getIP()
	Dim strIPAddr
	If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
		strIPAddr = Request.ServerVariables("REMOTE_ADDR")
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
		strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
	ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
		strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
	Else
		strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	End If
	getIP = Trim(Mid(strIPAddr, 1, 30))
 End Function

 Function LoginStop()
	Client_ip=getip()
	set rec=server.createobject("adodb.recordset")
	sql="select * from Web_loginlog where l_locked=1 and l_ip='"&client_ip&"' order by l_time desc"
	rec.open sql,conn
	if rec.eof then
		LoginStop="false"
	else
		l_time=rec("l_time")
		nowtime=now()
		//stop_time=DateDiff("m",l_time,nowtime)
		//response.write stop_time
		stop_time=cdbl((nowtime-l_time)*24*60)
		if stop_time>120 then
			LoginStop="false"		
		else
			LoginStop="true"
		end if 
	end if 
	rec.close : set rec=nothing
 End Function

 Function web_Getweightfee(wid,feelist)
	v_feelist=split(feelist,"||")
	for i=0 to ubound(v_feelist)	
		v_feelist_1=split(v_feelist(i),",")
		if clng(wid)=clng(v_feelist_1(0)) then
			web_getweightfee=v_feelist_1(1)
			exit function
		else
			web_getweightfee=0
		end if 
	next 
 End Function

 Function web_Getweightid(totalweight)
	set rec=server.createobject("adodb.recordset")
	sql="select top 1 * from weightlist where weight<"&totalweight&" order by weight desc "
	rec.open sql,conn
	if rec.eof then 
		web_Getweightid=0
	else
		web_Getweightid=rec("id")			
	end if
	'response.write "totalweight="&web_Getweightid
	'response.end
 End Function

Function GetFileContent(filepath)
	'on error resume next
	
	dim tempfile , createhtm
  	set createhtm=Server.CreateObject("Adodb.Stream")
	filepath=server.mappath(filepath)
	'response.write filepath
	Set fso = CreateObject(C_Web_FSO)
  	If (fso.FileExists(filepath))=false Then
    		response.write "文件不存在,请检查文件或者模版路径"
		response.end
 	End If

	createhtm.type=2
	createhtm.mode=3
 	createhtm.CharSet = "UTF-8"
	createhtm.open()
	createhtm.loadfromfile(filepath) '从模板文件装载
	tempfile=createhtm.size
	GetFileContent=createhtm.readtext(tempfile)
	createhtm.close : set createhtm=nothing
End Function

Function save_file(content,path)
	dim createhtm,recfile
	'response.write path
	Set fso = CreateObject(C_Web_FSO)
	set createhtm=Server.CreateObject("Adodb.Stream")
	if path="" then 
		recfile=server.mappath(dts)
	else
		recfile=server.mappath(path)
	end if 

	createhtm.open()
	createhtm.flush
 	createhtm.close
 	createhtm.type=2
 	createhtm.Mode = 3
 	createhtm.CharSet = "UTF-8"
 	createhtm.open
 	createhtm.position=0
 	createhtm.Writetext content,1	'写入数据到stream
	createhtm.SaveToFile recfile,2	'保存到文件
	createhtm.close : set createhtm=nothing
End  Function

Function Web_SetupFolder(var_folder)
	if var_folder="" then 
		var_folder="/"
	elseif var_folder="/" then
		var_folder="/"
	elseif var_folder="\" then
		var_folder="/"
	else
		if left(var_folder,1)="\" or left(var_folder,1)="/" then
			var_folder=replace(var_folder,left(var_folder,1),"")
		end if
	
		if right(var_folder,1)="\" or right(var_folder,1)="/" then
			var_folder=replace(var_folder,right(var_folder,1),"")
		end if
		var_folder="/"&var_folder&"/"
	end if 
	Web_SetupFolder=var_folder
End Function

Function CopyMyFolder(FolderName,FolderPath)
	sFolder=server.mappath(FolderName)
	oFolder=server.mappath(FolderPath)
	set fso=server.createobject("scripting.filesystemobject")
	if fso.folderexists(server.mappath(FolderName)) Then'检查原文件夹是否存在
	   if fso.folderexists(server.mappath(FolderPath)) Then'检查目标文件夹是否存在
	   fso.copyfolder sFolder,oFolder
	    Else '目标文件夹如果不存在就创建
	            CreateNewFolder = Server.Mappath(FolderPath)
	            fso.CreateFolder(CreateNewFolder)
	            fso.copyfolder sFolder,oFolder
	   End if
 	'CopyMyFolder="复制文件夹["&server.mappath(FolderName)&"]到["&server.mappath(FolderPath)&"]成功!"
	Else
	 'CopyMyFolder="错误,原文件夹["&sFolde&"]不存在!"
	  Response.Write "<script>alert('网站生成遇到错误！请联系管理员')</script>"
	End If
	set fso=nothing
End Function
function getshopSpace(drvpath)
 		dim fso,d,size,showsize
 		set fso=server.createobject("scripting.filesystemobject") 		
 		drvpath=server.mappath(drvpath) 
		if fso.FolderExists(drvpath) then		 		
 		     set d=fso.getfolder(drvpath) 		
 		     size=d.size
 		     showsize=size & "&nbsp;Byte" 
 		     if size>1024 then
 			size=(size\1024)
 			showsize=size & "&nbsp;KB"
 	             end if
 		     if size>1024 then
 		  	size=(size/1024)
 		       
			showsize=size & "&nbsp;MB"		
 		     end if
 		     if size>1024 then
 		       size=(size/1024)
 		       showsize=size & "&nbsp;GB"	   
 		     end if   
		else
		    showsize="0 Byte"
		end if

             getshopSpace=showsize
End Function
'##################################
'#获取自定义价格函数
'#Levelid等级编号 MyPrice 价格	
'##################################
  Function  Web_c_SetMyPrice(Levelid,MyPrice)

 	if trim(MyPrice)<>"" or isnull(myprice)=false then 
	  V_MyPrice=split(MyPrice,"$$")
	   For i=0 to ubound(V_MyPrice)
			T_MyPrice=split(V_MyPrice(i),"@@")
		if clng(trim(T_MyPrice(0)))=Int(Levelid) then
		  	strPrice=strPrice&T_MyPrice(1)
		end if
	    next
	 else
 	  strPrice=""
	end if
	Web_c_SetMyPrice=strPrice
  end function  
'##################################
'#判断组建是否安装
'#
'##################################
Function IsObjInstalled(strClassString)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)
	If Err = 0 Then IsObjInstalled = True
	If Err = -2147352567 Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function
'##################################
'#判断组建是否过期
'##################################
Function IsExpired(strClassString)
	On Error Resume Next
	IsExpired = True
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString)

	If 0 = Err Then
		Select Case strClassString
			Case "Persits.Jpeg"
				If xTestObj.Expires > Now Then
					IsExpired = False
				End if
			Case "wsImage.Resize"
				If instr(xTestObj.errorinfo,"已经过期") = 0 Then
					IsExpired = False
				End if
			Case "SoftArtisans.ImageGen"
				xTestObj.CreateImage 500, 500, rgb(255,255,255)
				If Err = 0 Then
					IsExpired = False
				End if
		End Select
	End if
	Set xTestObj = Nothing
	Err = 0
End Function
'##################################
'#字符串截取函数
'##################################
Function GetLeftChar(str,n) 
	Dim TStr 
	Dim l,t,c 
	Dim i 		
	If len(str)<=n/2 Then 
	 GetLeftChar=str 
	Else 
	 l=len(str) 
	 TStr="" 
	 t=0 
	for i=1 to l 
	 c=asc(mid(str,i,1)) 
	  If c<0 then c=c+65536 
		If c>255 then 
		   t=t+2 
		Else 
		   t=t+1 
		End If 
		If t>n Then exit for 
	TStr=TStr&(mid(str,i,1)) 
	next 
	GetLeftCharue = TStr & "..." 
	End If 
End Function
'##################################
'#获取无限级子类id号
'##################################
  Public Function getSubClass(Ttable,typeID)
		Dim childClassRs,result,Str_SubClassID
		result=""
		sql="Select * from "&Ttable&" where "&classtype&" Fid=" & TypeID & " order by id desc"
		'response.write sql
		Set childClassRs=Conn.execute(sql)
		While Not childClassRs.eof
			If result="" Then
				result=""&childClassRs("ID")&""
			Else
				result=result&","&childClassRs("ID")&""
			End If
			Str_SubClassID=getSubClass(Ttable,childClassRs("ID"))
			
			If Str_SubClassID<>"" Then
				result=result&","&Str_SubClassID
			End If
			childClassRs.movenext
		Wend
			
		childClassRs.close:Set childClassRs=nothing
		if result="" then
			getSubClass=typeID
		else
			if IsSqlDataBase =1 then
        			getSubClass="'"&typeID&"'"&","&result
			else
				getSubClass=""&typeID&""&","&result
			end if
			
		end if
		
  End Function
'##################################
'#获取商品分类无限级子类id号
'##################################
  Public Function getProSubClass(typeID)
		'response.write typeID&"<br>"
		Dim childClassRs,result,Str_SubClassID
		result=""
		sql="Select * from Web_ProClass where  Fid=" & TypeID & " order by id desc"
		
		Set childClassRs=Conn.execute(sql)
		While Not childClassRs.eof
			If result="" Then
				result="'"&childClassRs("ID")&"'"
			Else
				result=result&",'"&childClassRs("ID")&"'"
			End If
			Str_SubClassID=getProSubClass(childClassRs("ID"))
			If Str_SubClassID<>"" Then
				result=result&","&Str_SubClassID
			End If
			childClassRs.movenext
		Wend
		
		if result="" then
			getProSubClass=typeID
		else
			if IsSqlDataBase =1 then
				getProSubClass="'"&typeID&"'"&","&result
			else
				getProSubClass=""&typeID&""&","&result
			end if
		end if
	childClassRs.close:Set childClassRs=nothing
  End Function

'##################################
'#自定义属性
'##################################
Function GetSxList(detail)
	if detail<>"" then 
	dim arr1(),arr2()
	att=split(detail,"$$")
	j=0
	k=0
	for i=0 to ubound(att)
		tmpstr=split(att(i),"&")
		if cstr(tmpstr(0))="" then	'不需要加入定单的属性
			ReDim Preserve arr1(j)
			arr1(j)=tmpstr(1)
			j=j+1
		else				'需要加入定单的属性
			ReDim Preserve arr2(k)
			arr2(k)=tmpstr(1)
			k=k+1
		end if 
	next
	if j>0 then
	 for i=0 to ubound(arr1)		'输出不需要加入定单信息的商品属性
		tmpnv=split(arr1(i),"@@")
                str=str&"<table width='100%' height='22' border='0' cellpadding='0' cellspacing='0'>"&vbcrlf
		str=str&"<tr>"&vbcrlf
                str=str&"<td class='left_sxcss'>"&tmpnv(0)&"</td>"&vbcrlf
                str=str&"<td class='right_sxcss'>"&replace(tmpnv(1),"|"," ")&"</td>"&vbcrlf
                str=str&"</tr>"&vbcrlf
                str=str&"</table>"&vbcrlf
	 next
	end if
	if k>0 then 
		tmpnv=""
		for w_iii=0 to ubound(arr2)		'输出需要加入定单信息的商品属性
			tmpnv=split(arr2(w_iii),"@@")
			str1_1=""
                        str1=str1&"<table width='100%' height='22' border='0' cellpadding='0' cellspacing='0'><from name='ord' metohd='post'>"&vbcrlf
                        str1=str1&"<tr>"&vbcrlf
                        str1=str1&"<td class='left_sxcss'>"&tmpnv(0)&"</td>"&vbcrlf
			str1=str1&"<td class='right_sxcss'><select name='select"&w_iii&"' id='select"&w_iii&"' style='sx_select_css'>"&vbcrlf
			tmpvalue=split(tmpnv(1),"|")
			for jj=0 to ubound(tmpvalue)
				str1_1=str1_1&"<option value='"&tmpnv(0)&"|"&tmpvalue(jj)&"'>"&tmpvalue(jj)&"</option>"&vbcrlf
			next
			str1=str1&str1_1&"</select>"&vbcrlf
                        str1=str1&"</td>"&vbcrlf
                        str1=str1&"</tr>"&vbcrlf
                        str1=str1&"</form></table>"&vbcrlf
                      
 		next 
	end if
	end if 
	getsxlist=str&str1
  End Function
'##################################
'#多图
'##################################
 Function showpic(morepic,photo,id)
	str="<table width='100%' border='0' cellspacing='0' cellpadding='0'>"
	if morepic<>""  then
		picaddr=split(morepic,"|")
		piclen=ubound(picaddr)
		if piclen>=8 then
			piclen=8
		end if
		for ii=0 to piclen
                 	tmpstr1=tmpstr1&"<a href='"&Web_Get_RootDir(Web_C_setupfolder)&picaddr(ii)&"'  rel=lightbox[plants] ><img src="&Web_Get_RootDir(Web_C_setupfolder)&picaddr(ii)&" width='50' height='50' border='0' alt='点击查看效果'></a>"&"&nbsp;&nbsp;"
			if (ii+1) mod 4=0 then
				tmpstr1=tmpstr1&"<br>"
			end if
		next
	end if
       	if photo<>"" then
             str1=str1&"<tr>"
             str1=str1&"<td height='220' align='center' scope='col'>"
             str1=str1&"<img src='"&Web_Get_RootDir(Web_C_setupfolder)&photo&"' width='200' height='200' border='0' rel=lightbox[plants]>"
	     str1=str1&"</td>"
  	     str1=str1&"</tr>"
        end if
	str2=str1&str2
	str2=tmpstr&str2
	str2=str2&"<tr><td align=center>"&tmpstr1&"</td></tr>"
        str2=str2&"</table>"
	showpic=str&str2
  End Function%>