<%
function SaveRequest(ParaName,ParaType)
'防止注入函数
Dim ParaValue
'ParaName:参数名称-字符型 
 'ParaType:参数类型-数字型(1表示以上参数是数字，0表示以上参数为字符)
 ParaValue=Request(ParaName) 
  If ParaType=1 then 
    If not isNumeric(ParaValue) then 
       Response.write "参数" & ParaName & "必须为数字型！" 
       Response.end 
    End if 
  Else 
  ParaValue=replace(ParaValue,"'","''") 
  End if 
  SaveRequest=ParaValue 
end function

public function fillzero(l1) 
if len(l1)=1 then 
fillzero="0"&l1 
else 
fillzero=l1 
end if 
end function 

'自动分行
Function UnCheckStr(Str)
If Str="" or IsNull(Str) Then
UnCheckStr=Str
Exit Function
End If
Str = Replace(Str, CHR(13), "") 
Str = Replace(Str, CHR(10) & CHR(10), "</P><P>") 
Str = Replace(Str, CHR(10), "<BR>") 
UnCheckStr=Str 
end function 

'文章内容太多分页
Function textpage(str,canshu)
If Request("page")="" Then 
pageNum=0 
Else 
pageNum=Request("page") 
End if 
Content=Replace(str,"||||","｜｜｜｜") 
ContentStr=split(Content,"｜｜｜｜") 
For i=pageNum to pageNum 
response.Write ""&ContentStr(i)&"" 
Next

if ubound(ContentStr)>=1 then
response.write "<br><table border=0 cellspacing=2 cellpadding=1 align=center><tr>"
response.write "<td class=page_td>共分"&ubound(ContentStr)+1&"页</td>"
 
For p = 0 to ubound(ContentStr) 
if p+1= Request("page")+1 then 
response.write"<td class=page_td><a href=?"&canshu&"page="&p&"><font color=red>"&p+1&"</font></a></td>"
else 
response.write"<td class=page_tdbg><a href=?"&canshu&"page="&p&">"&p+1&"</a></td>"
end if 
Next
response.write "</tr></table>"
end if
end function 
'textpage(subCenterText,"id="&subCenterID&"&")

'文章内容太多分页
Function textpageHtml(str,canshu,pagename)
If Request("page")="" Then 
pageNum=0 
Else 
pageNum=Request("page") 
End if 
Content=Replace(str,"||||","｜｜｜｜") 
ContentStr=split(Content,"｜｜｜｜") 
For i=pageNum to pageNum 
response.Write ""&ContentStr(i)&"" 
Next

if ubound(ContentStr)>=1 then
response.write "<br><table border=0 cellspacing=2 cellpadding=1 align=center><tr>"
response.write "<td class=page_td>共分"&ubound(ContentStr)+1&"页</td>"
 
For p = 0 to ubound(ContentStr) 
if p+1= Request("page")+1 then 
response.write"<td class=page_td><a href="&pagename&"?"&canshu&"page="&p&"><font color=red>"&p+1&"</font></a></td>"
else 
response.write"<td class=page_tdbg><a href="&pagename&"?"&canshu&"page="&p&">"&p+1&"</a></td>"
end if 
Next
response.write "</tr></table>"
end if
end function 


Function textpageHtmlEn(str,canshu,pagename)
If Request("page")="" Then 
pageNum=0 
Else 
pageNum=Request("page") 
End if 
Content=Replace(str,"||||","｜｜｜｜") 
ContentStr=split(Content,"｜｜｜｜") 
For i=pageNum to pageNum 
response.Write ""&ContentStr(i)&"" 
Next

if ubound(ContentStr)>=1 then
response.write "<br><table border=0 cellspacing=2 cellpadding=1 align=center><tr>"
response.write "<td class=page_td>All:"&ubound(ContentStr)+1&"</td>"
 
For p = 0 to ubound(ContentStr) 
if p+1= Request("page")+1 then 
response.write"<td class=page_td><a href="&pagename&"?"&canshu&"page="&p&"><font color=red>"&p+1&"</font></a></td>"
else 
response.write"<td class=page_tdbg><a href="&pagename&"?"&canshu&"page="&p&">"&p+1&"</a></td>"
end if 
Next
response.write "</tr></table>"
end if
end function 


Function RemoveHTML(strHTML) 
Dim objRegExp, Match, Matches 
Set objRegExp = New Regexp 
objRegExp.IgnoreCase = True 
objRegExp.Global = True 
'取闭合的<> 
objRegExp.Pattern = "<.+?>" 
'进行匹配 
Set Matches = objRegExp.Execute(strHTML) 
' 遍历匹配集合，并替换掉匹配的项目 
For Each Match in Matches 
strHtml=Replace(strHTML,Match.Value,"") 
Next 
RemoveHTML=strHTML 
Set objRegExp = Nothing 
End Function
'调用 str=RemoveHTML(str)


'调用栏目位置
Function pagelocal(pgid) 
set rsloc=server.CreateObject("adodb.recordset")
rsloc.open "select * from com_nav where id="&pgid&"",conn,1,1
news_title=rsloc("title"&Language)
news_link=rsloc("link"&Language)
response.Write("<A  href="&news_link&" target=_self>"&news_title&"</A>")
rsloc.close
set rsloc=nothing
End Function


' ***********************************************
'	过滤HTML标签
' ***********************************************
Function RemoveHTML( strText )
Dim RegEx
Set RegEx = New RegExp
RegEx.Pattern = "<[^>]*>"
RegEx.Global = True
RemoveHTML = Replace(Replace(Replace(RegEx.Replace(strText, ""),"　","")," ",""),"&nbsp;","")
End Function

Function FilterHtmlTags(ByVal s_Description)
	If s_Description="" Then Exit Function
	Dim FaStr, re
	Set re = New RegExp
		re.IgnoreCase = True
		re.Global = True
		re.Pattern = "<[^>]*?>"
		'去掉 尖括号和换行
		FaStr = re.replace(s_Description, "")
		FaStr = replace(FaStr,Chr(13), "")
		FaStr = replace(FaStr,Chr(10), "")
	Set re = nothing
	FilterHtmlTags = FaStr
End Function


'用ID读取分类名称
sub TextPath(ID)
  Dim rs,sql,SortTextPath
  Set rs=server.CreateObject("adodb.recordset")
  sql="Select * From com_class where ID="&ID
  rs.open sql,conn,1,1
  SortTextPath=rs("classname"&Language)&"&nbsp;>&nbsp;"
  if rs("ParentID")<>0 then call TextPath(rs("ParentID"))
  response.write(SortTextPath)
End sub

'无限级分类树===========================
sub ListSort(id,tid,weburl,ListType)

  Set rslist=server.CreateObject("adodb.recordset")
  sql="Select * From com_class where type="&tid&" and ParentID="&id&" order by pid,id"
  rslist.open sql,conn,1,1
  if id=0 and rslist.recordcount=0 then
    response.write "<option value=''>暂无分类</option>"
    response.end
  end if  
  i=1
while not rslist.eof
    ChildCount=conn.execute("select count(*) from com_class where type="&tid&" and ParentID="&rslist("id"))(0)

    if ChildCount=0 then
	  FolderType="- "
	  FolderName=rslist("classname"&Language)
    else
	  FolderType="+ "
	  FolderName=rslist("classname"&Language)
    end if

    response.Write "<li>"
	response.Write "<a href="&weburl&".asp?cid="&rslist("id")&"&sortpath="&rslist("sortpath")&">"&ListType&FolderType&FolderName&"</a>"	
	response.Write "</li>"

	if ChildCount>0 then
	call ListSort(rslist("id"),tid,weburl,"&nbsp;&nbsp;&nbsp;&nbsp;"&ListType)
	end if
rslist.movenext
i=i+1
wend
rslist.close
set rslist=nothing
end sub

'分割
sub Split_scj(FileName,SplitType)
FileNameS=split(FileName,SplitType)
response.write(FileNameS(0)&"_thumb."&FileNameS(1))
end sub
sub Splitm_scj(FileName,SplitType)
FileNameS=split(FileName,SplitType)
response.write(FileNameS(0)&"_thumbm."&FileNameS(1))
end sub


'asp的escape和unescape转码
Function vbsEscape(str) 
    dim i,s,c,a 
    s="" 
    For i=1 to Len(str) 
        c=Mid(str,i,1) 
        a=ASCW(c) 
        If (a>=48 and a<=57) or (a>=65 and a<=90) or (a>=97 and a<=122) Then 
            s = s & c 
        ElseIf InStr("@*_+-./",c)>0 Then 
            s = s & c 
        ElseIf a>0 and a<16 Then 
            s = s & "%0" & Hex(a) 
        ElseIf a>=16 and a<256 Then 
            s = s & "%" & Hex(a) 
        Else 
            s = s & "%u" & Hex(a) 
        End If 
    Next 
    vbsEscape = s 
End Function
Function vbsUnEscape(str) 
    dim i,s,c 
    s="" 
    For i=1 to Len(str) 
        c=Mid(str,i,1) 
        If Mid(str,i,2)="%u" and i<=Len(str)-5 Then 
            If IsNumeric("&H" & Mid(str,i+2,4)) Then 
                s = s & CHRW(CInt("&H" & Mid(str,i+2,4))) 
                i = i+5 
            Else 
                s = s & c 
            End If 
        ElseIf c="%" and i<=Len(str)-2 Then 
            If IsNumeric("&H" & Mid(str,i+1,2)) Then 
                s = s & CHRW(CInt("&H" & Mid(str,i+1,2))) 
                i = i+2 
            Else 
                s = s & c 
            End If 
        Else 
            s = s & c 
        End If 
    Next 
    vbsUnEscape = s 
End Function 

'查询地名
sub showAddName(swid)
if swid<>"" then
Set rss=server.CreateObject("adodb.recordset")
sql="Select * From com_china where id="&swid
rss.open sql,conn,1,1
	if rss.bof or rss.eof then
    response.write ""
	else
	response.write rss("name")
  end if  
rss.close
set rss=nothing
end if
end sub

'记录积份消费
sub jifen_record(jfusername,jfacquisition,jfconsumption,jftextms)
set rsjf=server.CreateObject("adodb.recordset")
	rsjf.open "select * from [com_jf] ",conn,1,3
	rsjf.addnew
	rsjf("username")=jfusername
	rsjf("acquisition")=jfacquisition
	rsjf("consumption")=jfconsumption
	rsjf("textms")=jftextms
	rsjf.update
	rsjf.close
	set rsjf=nothing
end sub

'状态数量
function shownum(said)
set rs=server.CreateObject("adodb.recordset")
rs.open "select distinct(dingdan) from shopxp_action where username='"&session("user_xxx_name")&"' and zhuangtai="&said&"",conn,1,1
response.Write(rs.recordcount)
rs.close
set rs=nothing
end function

'评论咨询
function showBBS(Chfid,classid)
set rsbbs=server.CreateObject("adodb.recordset")
rsbbs.open "select * from com_message where yname='"&session("user_xxx_name")&"' and hf_ck="&Chfid&" and type="&classid&"",conn,1,1
response.Write(rsbbs.recordcount)
rsbbs.close
set rsbbs=nothing
end function

'读出某个字段值
function showTbName(proid,tablename,classname)
set rsbbs=server.CreateObject("adodb.recordset")
rsbbs.open "select "&classname&" from "&tablename&" where id="&proid&"",conn,1,1
response.Write(rsbbs(classname))
rsbbs.close
set rsbbs=nothing
end function

'销量
sub rsxl_sl(subId)
	set rsxl=server.createobject("adodb.recordset")
	rsxl.open "select * from shopxp_action where (zhuangtai>2 and zhuangtai<9) and shopxpptid="&subId&"",conn,1,1
	xs_sl=0
	xs_je=0
	while not rsxl.eof
	xs_sl=xs_sl+rsxl("productcount")
	xs_je=xs_je+rsxl("zonger")
	rsxl.movenext
	wend
	rsxl.close
	set rsxl=nothing
	response.write(xs_sl)
end sub

'评价
sub rsxl_bbs(subId)
	xs_bbs=0
	sql00 = "select * from com_message where proid="&subId&" and lookcn=1  order by ID desc"
	Set rs00=server.CreateObject("adodb.recordset")
	rs00.open sql00,conn,1,1
	xs_bbs=rs00.RecordCount
	rs00.close
	set rs00=nothing
	response.write(xs_bbs)
end sub
%>