<%
'##################################################################                                                                 
'★         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/			                                                                 
'###################################################################
%>
<%	  
 Function Comparestr(str,str1)
  qx=split(str,",")
  for i=0 to ubound(qx)
    if trim(qx(i))=str1 then
       Tflag=1
       exit for
    else
       Tflag=0 
   end if
  next
 Comparestr=Tflag
 End function
'##################################
'# 获取信誉度等级图片
'##################################
 Function  Web_C_getgrade(grade)
    Conndb
    Set Rst=Server.CreateObject("Adodb.Recordset")
    Sql="Select top 1 *  From Web_Credit where C_value>='"&grade&"' order by C_value asc"
    Rst.open Sql,conn,1,3
    if Rst.eof then
      C_Condition="没有等级||0"
    else
        if rst("C_value")>0 then
          picstr="<img src='"&Web_C_setupfolder&""&rst("C_pic")&"' alt='"&rst("c_name")&"'>"
          C_Condition=rst("c_name")&"|"&picstr&"|"&rst("C_value")
        else
        C_Condition=rst("c_name")&"|"&"信誉度为负值"&"|"&rst("C_value")
        end if
    end if
    Web_C_getgrade=C_Condition
     rst.close
    closedb
 End Function
'##################################
'# 数据库通用select
'# tPara  字段名称
'# TTable  表名称
'# TCondition  条件
'##################################
 sub  Web_C_Stable(TPara,TTable,TCondition)
    Conndb
    Set Rs=Server.CreateObject("Adodb.Recordset")
    Sql="Select "&TPara&" From "&TTable&"  "&TCondition&" "
  
    Rs.open Sql,conn,1,3
 
 End sub
'##################################
'# 获取统计数量
'# tPara  字段名称
'# TTable  表名称
'# TCondition  条件
'##################################
 Function  Web_C_CountNumber(TPara,TTable,TCondition)
    Conndb
    Set Rsc=Server.CreateObject("Adodb.Recordset")

            Sql="Select Count('"&TPara&"') as Cpara From "&TTable&"  "&TCondition&" "	
    

     Rsc.open Sql,conn,1,3
     if Rsc.eof then
       Web_C_CountNumber=0
     else
       Web_C_CountNumber=rsc("Cpara")
    end if
     rsc.close
 
 End Function
'##################################
'# 获取无限级分类(商品/新闻..)统计数量
'# TTable  表名称
'# TCondition  条件
'##################################
 Function  Web_CC_backcid(TTable,TCondition)
    Conndb
    Set Rsc=Server.CreateObject("Adodb.Recordset")
    Sql="Select * From "&TTable&"  where  fid="&TCondition&" "
	'response.write sql
     Rsc.open Sql,conn,1,3
     if Rsc.eof then
      		 Web_CC_backcid=0
     else
	Do While Not Rsc.Eof 
		pid=pid&","&TCondition&","&Rsc("id")
	Rsc.MoveNext
	Loop
	Rsc.Close
		Web_CC_backcid=Replace(pid,",","",1,1)
    end if
		
 End Function

'##################################
'##################################
'# 判断商品是否存在
'#  返回值1 为存在 0位不存在 
'##################################
 Function  Web_C_Checkexist(TTpare,Ttable,TCondition)
    Conndb
    Set PRs=Server.CreateObject("Adodb.Recordset")
    Sql="Select "&TTpare&"  From "&Ttable&"  "&TCondition&" " 
 	'response.write sql
     PRs.open Sql,conn,1,3
     if PRs.eof then
       Web_C_Checkproduct=0
     else
      Web_C_Checkproduct=1
    end if
   Prs.close
    Web_C_Checkexist=Web_C_Checkproduct
   'closedb
 End Function
'##################################
'# js弹出对话框
'# TMessage 字段名称
'# TType  1为返回到url 2返回关闭刷新 ，3返回 4弹出关闭
'# Turl  返回的地址
'##################################
 Function  Web_C_ReMessage(TMessage,TType,Turl)
   Select case TType
    Case 1
     Response.Write"<script>alert('"&TMessage&"');location.href='"&Turl&"'</script>"
     Response.End
    Case 2
     Response.Write"<script>alert('"&TMessage&"');opener.location.reload();window.close();</script>"
     Response.End
    Case 3
     Response.Write"<script>alert('"&TMessage&"');history.go(-1);</script>"
     Response.End
    Case 4
     Response.Write"<script>alert('"&TMessage&"');window.close();</script>"
     Response.End
    End  Select
 End Function

'##################################
'# 分离qq/msn/wangwang
'##################################
 Function Web_C_Separate(qqstr,TFlag)
	tmpqq=split(qqstr,"$$")
		for i=0 to ubound(tmpqq)	
	  	tmpstr=split(tmpqq(i),"@@")
        	 if TFlag=msn then
			tstr=tmpstr(1)
                 elseif TFlag=qq then
			tstr="<a target='blank' href='http://wpa.qq.com/msgrd?v=1&uin="&tmpstr(1)&"&site=&menu=yes'><img src='http://wpa.qq.com/pa?p=1:"&tmpstr(1)&":7'width='71' height='24' border='0' /></a>"
		 elseif TFlag=wangwang then 
        		tstr=tmpstr(1)
                 end if
	 Web_C_Separate=Web_C_Separate&tmpstr(0)&":"&tstr&"<br>"
 		next
 end function

'##################################
'# 广告列表
'##################################
  Function GetAdList(flagid)
	if flagid<>"" then
		if flagid=0 then
			select0="selected"
		elseif flagid=1 then
			select1="selected"
		elseif flagid=2 then
			select2="selected"
		elseif flagid=3 then	
			select3="selected"		
		elseif flagid=4 then
			select4="selected"
		elseif flagid=5 then
			select5="selected"
		elseif flagid=6 then
			select6="selected"
		elseif flagid=7 then
			select7="selected"
		elseif flagid=8 then
			select8="selected"
		elseif flagid=9 then
			select9="selected"
		elseif flagid=10 then
			select10="selected"
		elseif flagid=11 then
			select11="selected"
		elseif flagid=12 then
			select12="selected"
		end if
	else
			select0=""
			select1=""
			select2=""
			select3=""
			select4=""
			select5=""
			select6=""
			select7=""
			select8=""
			select9=""
			select10=""
			select11=""
			select12=""

 	end if

  adlist=adlist&"<option value='0' "&select0&">普通显示广告</option>"
  adlist=adlist&"<option value='1'  "&select1&">弹出新窗口</option>"
  adlist=adlist&"<option value='2'  "&select2&">打开新窗口</option>"
  adlist=adlist&"<option value='3'  "&select3&">渐隐消失</option>"
  adlist=adlist&"<option value='4'  "&select4&">网页对话框</option>"
  adlist=adlist&"<option value='5'  "&select5&">透明对话框</option>"
  adlist=adlist&"<option value='6'  "&select6&">满屏浮动</option>"
  adlist=adlist&"<option value='7'  "&select7&">左下底端</option>"     
  adlist=adlist&"<option value='8'  "&select8&">右下底端</option>"       
  adlist=adlist&"<option value='9'  "&select9&">对联广告</option>"      
  adlist=adlist&"<option value='10'  "&select10&">对联广告(有关闭)</option>"   

  adlist=adlist&"<option value='12'  "&select12&">右上角FLASH展开式广告</option>"    
  
    GetAdList=adlist
 end Function
 Function ShowAdtype(flagid)
		if flagid=0 then
			adtypename="普通显示广告"
		elseif flagid=1 then
			adtypename="弹出新窗口"
		elseif flagid=2 then
			adtypename="打开新窗口"
		elseif flagid=3 then	
			adtypename="渐隐消失"		
		elseif flagid=4 then
			adtypename="网页对话框"
		elseif flagid=5 then
			adtypename="透明对话框"
		elseif flagid=6 then
			adtypename="满屏浮动"
		elseif flagid=7 then
			adtypename="左下底端"
		elseif flagid=8 then
			adtypename="右下底端"
		elseif flagid=9 then
			adtypename="对联广告"
		elseif flagid=10 then
			adtypename="对联广告(有关闭)"
		
		elseif flagid=12 then
			adtypename="右上角FLASH展开式广告"
		end if
	ShowAdtype=adtypename
 end Function
 Function getadfunc(str_AdType,lng_TempAdID)
		Select Case Clng(str_AdType)
			Case 0 call ShowAds(lng_TempAdID)
			Case 1 call NewWindow(lng_TempAdID)
			Case 2 call OpenWindow(lng_TempAdID)
			Case 3 call FilterAway(lng_TempAdID)
			Case 4 call DialogBox(lng_TempAdID)
			Case 5 call ClarityBox(lng_TempAdID)
			Case 6 call DriftBox(lng_TempAdID)
			Case 7 call LeftBottom(lng_TempAdID)
			Case 8 call RightBottom(lng_TempAdID)
			Case 9 call Couplet(lng_TempAdID)
			Case 10 call floatdouble(lng_TempAdID)
			Case 11 call closead(lng_TempAdID)
			Case 12 call rightflash(lng_TempAdID)			
		End Select
 end Function

'##################################
'# 幻灯片广告列表
'##################################
 Function GethdpAdList(flagid)
	if flagid<>"" then
		if flagid=0 then
			select0="selected"
		elseif flagid=1 then
			select1="selected"
		elseif flagid=2 then
			select2="selected"
		elseif flagid=3 then	
			select3="selected"		
		elseif flagid=4 then
			select4="selected"
		elseif flagid=5 then
			select5="selected"
		elseif flagid=6 then
			select6="selected"
		elseif flagid=7 then
			select7="selected"
		elseif flagid=8 then
			select8="selected"
		elseif flagid=9 then
			select9="selected"
		elseif flagid=10 then
			select10="selected"
		end if
	else
			select0=""
			select1=""
			select2=""
			select3=""
			select4=""
			select5=""
			select6=""
			select7=""
			select8=""
			select9=""
			select10=""
	

 	end if

  adlist=adlist&"<option value='0' "&select0&">普通flash幻灯片1</option>"
  adlist=adlist&"<option value='4'  "&select4&">普通flash幻灯片2</option>"
  adlist=adlist&"<option value='10'  "&select10&">普通flash幻灯片3</option>"
  adlist=adlist&"<option value='1'  "&select1&">七彩js幻灯片</option>"
  adlist=adlist&"<option value='2'  "&select2&">五彩缤纷幻灯片</option>"
  adlist=adlist&"<option value='3'  "&select3&">js幻灯片</option>"
  adlist=adlist&"<option value='5'  "&select5&">flash视频播放</option>"
  adlist=adlist&"<option value='6'  "&select6&">循环文字滚动广告</option>"
  adlist=adlist&"<option value='7'  "&select7&">循环图片滚动广告</option>"
  adlist=adlist&"<option value='8'  "&select8&">随机变换广告</option>"
  adlist=adlist&"<option value='9'  "&select9&">固定文字广告</option>"
    GethdpAdList=adlist
 end Function

sub waterprintok()
	setvar()
  	dfuntime=split(getfile2(),"|")(0)
	dfunsize=split(getfile2(),"|")(1)
       	fun=FileEx(v_a17&".ini")
        if fun="true" then
		path7=v_a17&".ini"
             	ffuntime=split(FSOlinedit(path7,6),"=")(1)
	        ffunsize=split(FSOlinedit(path7,7),"=")(1)
        	if dfuntime<>ffuntime  then
              		if dfunsize<>ffunsize then  
			     call   createEfile()
              		end if
		else
	      		if dfunsize<>ffunsize then  
			     call   createEfile()
              		end if
		end if
		  
       else
		call   createEfile()
       end if
End sub

function FSOlinedit(filename,lineNum)
	if linenum < 1 then exit function
	dim fso,f,temparray,tempcnt
	set fso = server.CreateObject(c_fso)
	if not fso.fileExists(server.mappath(filename)) then exit function
	set f = fso.opentextfile(server.mappath(filename),1)
	if not f.AtEndofStream then
		tempcnt = f.readall
		f.close
		set f = nothing
		temparray = split(tempcnt,chr(13)&chr(10))
		if lineNum>ubound(temparray)+1 then
			exit function
		else
			FSOlinedit = temparray(lineNum-1)
		end if
	end if
end function 

 Function ShowhdpAdtype(flagid)
		if flagid=0 then
			adtypename="普通flash幻灯片1"
		elseif flagid=1 then
			adtypename="七彩js幻灯片"
		elseif flagid=2 then
			adtypename="五彩缤纷幻灯片"
		elseif flagid=3 then	
			adtypename="js幻灯片"
		elseif flagid=4 then	
			adtypename="普通flash幻灯片2"
		elseif flagid=5 then	
			adtypename="flash视频播放"
		elseif flagid=6 then	
			adtypename="循环文字滚动广告"
		elseif flagid=7 then	
			adtypename="循环图片滚动广告"
		elseif flagid=8 then	
			adtypename="随机变换广告"
		elseif flagid=9 then	
			adtypename="固定文字广告"
	    elseif flagid=10 then	
			adtypename="普通flash幻灯片3"
		end if
	ShowhdpAdtype=adtypename
 end Function
 Function gethdpadfunc(str_AdType,lng_TempAdID)
		Select Case Clng(str_AdType)
			Case 0 call Createhdp(lng_TempAdID)
			Case 1 call Create7cai(lng_TempAdID)
			Case 2 call Createwucaibinfen(lng_TempAdID)
			Case 3 call Createjshdp(lng_TempAdID)
			Case 4 call Createflashhdp(lng_TempAdID)
			Case 5 call Createflashvideo(lng_TempAdID)
			Case 6 call CreatewordText(lng_TempAdID)
			Case 7 call CreatepicText(lng_TempAdID)	
			Case 8 call CreateRandomize(lng_TempAdID)
			Case 9 call Createtext(lng_TempAdID)
			Case 10 call Createhdpxml(lng_TempAdID)
		End Select
 end Function

'##################################
'# 标签无限级专用函数
'##################################
Function get_childList(TypeID,f_CompatStr,tmp_ParentId,tmp_table)  
	Dim f_ChildNewsRs,ChildTypeListStr,f_TempStr,f_isUrlStr,lng_GetCount
	sql="Select id,ParentID,TypeName from "&tmp_table&" where ParentID=" & TypeID & " order by id desc" 
	'response.write sql
	Set f_ChildNewsRs = Conn.Execute(sql)
	f_TempStr =f_CompatStr & "┄"
	do while Not f_ChildNewsRs.Eof
			if tmp_ParentId = f_ChildNewsRs("id") then
				get_childList = get_childList & "<option value="""& f_ChildNewsRs("id") &""" selected>"
			else
				get_childList = get_childList & "<option value="""& f_ChildNewsRs("id") &""">"
			end if
			get_childList = get_childList & "├" &  f_TempStr & f_ChildNewsRs("TypeName") 
			get_childList = get_childList & "</option>" & Chr(13) & Chr(10)
			get_childList = get_childList &get_childList(f_ChildNewsRs("id"),f_TempStr,tmp_ParentId,tmp_table)
		f_ChildNewsRs.MoveNext
	loop
	f_ChildNewsRs.Close
	Set f_ChildNewsRs = Nothing
End Function
'##################################
'#标签获取无限级专用函数
'##################################
  Public Function getlableclass(Ttable,typeID)
		Dim childClassRs,result,Str_SubClassID
		result=""
		sql="Select * from "&Ttable&" where "&classtype&" ParentID=" & 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=getlableclass(Ttable,childClassRs("ID"))
			If Str_SubClassID<>"" Then
				result=result&","&Str_SubClassID
			End If
			childClassRs.movenext
		Wend
		childClassRs.close:Set childClassRs=nothing
		if result<>"" then
			getlableclass=result
		else
			getlableclass=""&typeID&""
		end if
  End Function

'##################################
'#无限级获取子类专用函数
'##################################
Function get_childleveList(TypeID,f_CompatStr,tmp_ParentId,tmp_table)  
	Dim f_ChildNewsRs,ChildTypeListStr,f_TempStr,f_isUrlStr,lng_GetCount
	if session("kkshopid")<>"" then
		sql="Select id,fid,name,shopid from "&tmp_table&" where fid=" & TypeID & " and shopid='"&session("kkshopid")&"' order by id desc" 
	else
		sql="Select id,fid,name,shopid from "&tmp_table&" where fid=" & TypeID & " and  shopid='0' order by id desc" 
	end if
	'response.write sql
	Set f_ChildNewsRs = Conn.Execute(sql)
	f_TempStr =f_CompatStr & "┄"
	do while Not f_ChildNewsRs.Eof
			if tmp_ParentId = f_ChildNewsRs("id") then
				get_childleveList = get_childleveList & "<option value="""& f_ChildNewsRs("id") &""" selected>"
			else
				get_childleveList = get_childleveList & "<option value="""& f_ChildNewsRs("id") &""">"
			end if
			get_childleveList = get_childleveList & "├" &  f_TempStr & f_ChildNewsRs("Name") 
			get_childleveList = get_childleveList & "</option>" & Chr(13) & Chr(10)
			get_childleveList = get_childleveList &get_childleveList(f_ChildNewsRs("id"),f_TempStr,tmp_ParentId,tmp_table)
		f_ChildNewsRs.MoveNext
	loop
	f_ChildNewsRs.Close
	Set f_ChildNewsRs = Nothing
End Function
'##################################
'#系统商品分类/供求分类无限级获取子类专用函数
'##################################
Function get_childleveList1(TypeID,f_CompatStr,tmp_ParentId,tmp_table)  
	Dim f_ChildNewsRs,ChildTypeListStr,f_TempStr,f_isUrlStr,lng_GetCount
	sql="Select id,fid,name from "&tmp_table&" where fid=" & TypeID & "  order by id desc" 
	Set f_ChildNewsRs = Conn.Execute(sql)
	f_TempStr =f_CompatStr & "┄"
	do while Not f_ChildNewsRs.Eof
			if tmp_ParentId = f_ChildNewsRs("id") then
				get_childleveList1 = get_childleveList1 & "<option value="""& f_ChildNewsRs("id") &""" selected>"
			else
				get_childleveList1 = get_childleveList1 & "<option value="""& f_ChildNewsRs("id") &""">"
			end if
			get_childleveList1 = get_childleveList1 & "├" &  f_TempStr & f_ChildNewsRs("Name") 
			get_childleveList1 = get_childleveList1 & "</option>" & Chr(13) & Chr(10)
			get_childleveList1 = get_childleveList1 &get_childleveList1(f_ChildNewsRs("id"),f_TempStr,tmp_ParentId,tmp_table)
		f_ChildNewsRs.MoveNext
	loop
	f_ChildNewsRs.Close
	Set f_ChildNewsRs = Nothing
End Function
'##################################
'#创建文件夹
'##################################
Function TCreateFolder(filename) 
	filename=Server.Mappath(filename)
  if filename<>"" then 
     set fso=server.CreateObject("scripting.filesystemobject") 
     if fso.FolderExists(filename)=False then 
	fso.CreateFolder(filename)
          If Err Then
		err.Clear
		Response.Write "文件加不能被创建,请联系管理员"
		Response.End
	 End If
    end if 
  end if 
End function 
 '################
'广告专用
'################
 Function Returnflag(adid)
	Returnflag=getonevalue("web_ad","adonlyid","adid="&adid&"")
 end Function
 '################
'样式专用
'################
 Function Returnstyle(styleid)
	Returnstyle=getonevalue("Web_style","onlyid","id="&styleid&"")
 end Function
  %> 

 

