<%
'**************************************
'* 最后更新 2014/4/25 by 56770.Kingdge
'* Copyright www.56770.com
'**************************************
Public Function Safereplace(Str)
	    If Isnull(Str) Then
	    	    Safereplace = ""
	    	    Exit Function
	    End If
	    Str = Replace(Str,";","")
	    Str = Replace(Str,"'","&#180;")
	    Str = Replace(Str,"%","")
	    Str = Replace(Str,"""","&#34;")
        Str = Replace(Str,"<","&lt;")
        Str = Replace(Str,">","&gt;")
	    Str = Replace(Str,"$","")
	    Safereplace = Str
End Function

Public Function change(Str)
	    Str = Replace(Str,"{","<%=")
	    Str = Replace(Str,"]","%")
		Str = Replace(Str,"}",">")
	    change = Str
End Function

Function RemoveHTML(strHTML)
		If IsNull(strHTML) Then 
				RemoveHTML = ""
				Exit Function 
		End If 
	    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

Public function IsValidEmail(email)
		If IsNull(email) Then 
				IsValidEmail = False
				Exit Function 
		End If 
		Dim Plt,Pgt : Plt = False : Pgt = False
		For x = 2 To Len(email) - 1
				If Mid(email,x,1) = "@" Then Plt = True
				If Mid(email,x,1) = "." And Plt = True Then Pgt = True
		Next
		If Plt = True And Pgt = True Then 
				IsValidEmail = True
		Else
				IsValidEmail = False
		End if
end Function

function check_name(str)
	    'check_name = false
	    'dim regEx, Match
	    'Set regEx = New RegExp
	    'regEx.Pattern = "^[\u4e00-\u9fa5a-z0-9][\u4e00-\u9fa5a-z0-9_]+$"
	    'regEx.IgnoreCase = True '不区分大小写
	    'Set Match = regEx.Execute(str)
	    'if match.count then check_name = true
		check_name = true
End Function
Public function formatnumber2(num)
		Langdecimal = checknum(Langdecimal,2)
        If IsNull(num) Or Not IsNumeric(num) Then
		        Exit Function
	    End If
		If Langdecimal = 0 Then 
				If num < 1 Then 
						num = formatnumber(num,2)
				Else 
						num = formatnumber(num,Langdecimal)
				End If 
		Else 
				num = formatnumber(num,Langdecimal)
		End If 
	    if num <1 And num >= 0 then
	            num= 0&num
	            num = replace(num,"00.","0.")
		ElseIf num = 0 Then
				num= 0&num
	    end If
	    If Langdecimal = 0 Then num = replace(num,".00","")
	    formatnumber2 = Replace(num,",","")
end Function

Public function outhtml(fString)
		fString=replace(fString,";","&#59;")
		fString=replace(fString,"<","&lt;")
		fString=replace(fString,">","&gt;")
		fString=replace(fString,"\","&#92;")
		fString=replace(fString,"--","&#45;&#45;")
		fString=replace(fString,"'","&#39;")
		fString=replace(fString,CHR(34),"&quot;")
		fString=replace(fString,vbCrlf,"<br>")
		Safereplace=fString
end Function

Public Function ChkLoginIP(AcceptIP,ChkIp)
		Dim i,LoginIP,TempIP
		ChkLoginIP = False
		If Instr(""&AcceptIP&"",""&ChkIp&"") Then ChkLoginIP = True : Exit Function
		LoginIP = Split(ChkIp,".")
		TempIP = LoginIP(0)&"."&LoginIP(1)&"."&LoginIP(2)&".*"
		If Instr(""&AcceptIP&"",""&TempIP&"") Then ChkLoginIP = True : Exit Function
		TempIP = LoginIP(0)&"."&LoginIP(1)&".*.*"
		If Instr(""&AcceptIP&"",""&TempIP&"") Then ChkLoginIP = True : Exit Function
		TempIP = LoginIP(0)&".*.*.*"
		If Instr(""&AcceptIP&"",""&TempIP&"") Then ChkLoginIP = True : Exit Function
End Function
'****  End   *************************************************************************************************************************

Public function judge(a,b)
	    dim res
	    if instr(a,b)>0 then
	    	    res ="checked"
	    end if
	    judge = res
end Function

'处理商品节省价格为负值的情况 2005-12-22 by 56770.kingdge
'****  Start  ************************************************************************************************************************
Public function js_price(str,str1)
        Dim str2
		str2=formatnumber2(str1-str)
		If Left(str2,2)="0-" Then
		         str2=formatnumber2(str-str1)
        End If
		js_price=str2
end function
'****  End   *************************************************************************************************************************

'价格首位数字体放大 2005-12-22 by 56770.kingdge
'****  Start  ************************************************************************************************************************
Public function font_price(str)
        Dim str_1,str_2
        str_1=Left(formatnumber2(str),1)
		str_2=Right(formatnumber2(str),Len(formatnumber2(str))-1)
		str="<font size=4px color=red>"&str_1&"</font><font size=2px>"&str_2&"</font>"
		font_price=str
end function
'****  End   *************************************************************************************************************************

'图片按比例缩放函数 2006-6-3 修正 56770.kingdge
'****  Start  ************************************************************************************************************************
Public Function showpicsize(Owidth,Oheight,Vwidth,Vheight)
	    Dim str_1,str_2
        If Owidth="" Then
	    	    showpicsize="100|100"
        Exit Function
        End If
	    If clng(Owidth)<clng(Vwidth) And clng(Oheight)<clng(Vheight) Then
	    	    showpicsize=Owidth&"|"&Oheight
        Exit Function
        End If
        If clng(Owidth)>clng(Oheight) Then
	    	    str_1 = Vwidth
	    	    str_2 = clng(Vwidth * Oheight / Owidth)
        Else
	    	    str_1 = clng(Vheight * Owidth / Oheight)
	    	    str_2 = Vheight
	    End If
        showpicsize=str_1&"|"&str_2
End Function
'****  End   *************************************************************************************************************************

rem 截取字符串长度函数
rem UTF-8编码下 截取中英文混排长度
Public Function cutchar(Title,TLen)
		If title = "" Or IsNull(title) Then
				Exit Function
		End If
		Dim k,i,d,c
		Dim iStr
		Dim ForTotal
		If CDbl(TLen) > 0 Then
				k=0
				d=StrLen(Title)
				iStr=""
				ForTotal = Len(Title)
				For i=1 To ForTotal
						c=Abs(AscW(Mid(Title,i,1)))
						If c>255 Then
								k=k+2
						Else
								k=k+1
						End If
						iStr=iStr&Mid(Title,i,1)
						If CLng(k)>CLng(TLen*2) Then
								iStr=iStr&".."
								Exit For
						End If
				Next
				cutchar=iStr
		Else
				cutchar=""
		End If
		TLen = TLen
End Function
'*******************************
'检测文字长度函数，支持UTF-8
'*******************************
Public Function StrLen(strText)
		Dim k,i,c
		Dim ForTotal
		k=0
		ForTotal = Len(strText)
		For i=1 To ForTotal
				c=Abs(AscW(Mid(strText,i,1)))
				If c>255 Then
						k=k+2
				Else
						k=k+1
				End If
		Next
		StrLen=k
End Function

'**************************************************
'函数名：strLength
'作  用：求字符串长度。汉字算一个字符，英文算两个字符。
'参  数：str  ----要求长度的字符串
'返回值：字符串长度
'**************************************************
function strLength(str)
			Dim Rep,lens,i
			Set rep=new regexp
			rep.Global=true
			rep.IgnoreCase=true
			rep.Pattern="[\u4E00-\u9FA5\uF900-\uFA2D]"
			For each i in rep.Execute(str)
				lens=lens+1
			Next
			Set Rep=Nothing
			lens=lens + len(str)
			strLength=lens
end function
'****************************************************

Public Function connerror

End Function

rem 取一个字符串在一个数组中的位置
rem 2006-2-12 56770.kingdge
Public Function online_num(str,str1)
        If str="" Then
		      Exit Function
		End If
		B=Split(str1,":")
		For I = 0 To UBound(B)
		If InStr(B(i),STR)>0 Then
		 online_num=i
		End If
		Next
End Function

rem 去掉最后一位
rem 2006-2-13 56770.kingdge
Public Function cut_Right(str)
        If str="" Then
		       Exit Function
	    End If
        cut_Right=Left(str,(Len(str)-1))
End Function

rem 转转购物折扣
rem 2008-1-10 56770.kingdge
Public Function inttotext(str)
        If isempty(str) Or not isnumeric(str) Then
	        exit Function
	End If
	inttotext = str*100&"%"
End Function

Public Function getlisttypeurl(str,str1,str2)
        If isempty(str) Then:exit Function:End If
        listtypeurl = "?listtype="& str
	    If str1 = "" Then listtypeurl = listtypeurl &"&listprice="& str1
	    If str2 = "" Then listtypeurl = listtypeurl &"&listtime="& str2
	    getlisttypeurl = listtypeurl
End Function

Public Sub Write_Lebi_Eshop(value)
	    Response.Write(value)
End Sub

Function GetUserId()
        Dim ranNum,userip
        randomize:ranNum = Int(90*rnd) + 10
	    userip = GetIP()
        userip = Left(Replace(userip,".",""),6)
        If request.cookies(cookiesname&"_user")("cookiesid")="" Then
'				Dim rs
'				Set rs = server.CreateObject("adodb.recordset")
'				rs.open "select sessionid,basket_date,coupon_num from [Lebi_lshy] where sessionid = "& CheckNum(request.cookies(cookiesname&"_user")("cookiesid"),0) &"",conn,1,3
'				If rs.eof Then
'				rs.addnew
'						rs("sessionid") = CLng(userip&ranNum)
'						rs("basket_date") = Now()
'						rs("coupon_num") = ""
'				rs.update
'				End If
'				rs.close : Set rs = Nothing
				If session(cookiesname&"_user"&"cookiesid") = "" Then 
						session(cookiesname&"_user"&"cookiesid") = cdbl(userip&ranNum)
				End If 
                response.cookies(cookiesname&"_user")("cookiesid") = session(cookiesname&"_user"&"cookiesid")
				Response.Cookies(cookiesname&"_user").Expires = Date() + 1
        End If
		GetUserId = CLng(request.cookies(cookiesname&"_user")("cookiesid"))
End Function

public Sub checkuser()
        Dim rs,sql
        If Lebi_UserId<>"" Then
	        sql = "select user_grade,RndPass from [Lebi_user] where user_id = '"& Lebi_UserId &"'"
	        set Rs = conn.execute(sql)
	        If not rs.eof Then
	                If clng(rs(0))<>clng(Lebi_UserGrade) Or CStr(Lebi_UserKey) <> CStr(rs(1)) Then
	                        response.cookies(cookiesname&"_user")("user_id") = ""
							response.cookies(cookiesname&"_user")("user_grade") = ""
							response.cookies(cookiesname&"_user")("cookiesid") = ""
							response.cookies(cookiesname&"_user")("user_key") = ""
	                End If
            Else
	                response.cookies(cookiesname&"_user")("user_id") = ""
					response.cookies(cookiesname&"_user")("user_grade") = ""
					response.cookies(cookiesname&"_user")("cookiesid") = ""
					response.cookies(cookiesname&"_user")("user_key") = ""
			End If
	        rs.close:set rs=nothing
	End If
End Sub

Private Function tmp(a,b)
        Dim tmp_i
        For tmp_i = 1 To a
            tmp = tmp & "&nbsp; |&nbsp;&nbsp;"
        Next
	tmp = tmp & b
End Function

Function Savehtml(filename,filebody)
        Dim objStream,adTypeText,adSaveCreateOverWrite,adModeReadWrite
        filename = server.mappath(filename)
		filebody = Replace(filebody,"&lt;","<")
		filebody = Replace(filebody,"&gt;",">")
		filebody = Replace(filebody,"&quot;","""")
		filebody = Replace(filebody,"&amp;","&")
		filebody = Replace(filebody,"&middot;","·")
        adTypeText=2
        adSaveCreateOverWrite=2
		On Error Resume Next
        Set objStream = Server.CreateObject("ADODB.Stream")
        With objStream
                .Type = adTypeText
                .Mode = adModeReadWrite
                .Open
                .Charset = "utf-8"
                .Position = objStream.Size
                .WriteText= filebody
                .SaveToFile FileName,adSaveCreateOverWrite
                .Close
        End With
		If Err Then
        response.write("<font color=red>"& filename &"错误：写入文件失败，原因"& Err.Description &"</font> <a href=""http://www.56770.com/faq/list/?id=116"" target=""_blank""><font color=blue>查找解决办法？</font></a>")
		response.End
		End If
End Function

Function htmltojs(str)
	    'str = replace(str, "'", """")
        str = replace(str,"=""","=\""")
        str = replace(str,""" ","\"" ")
        str = replace(str,""">","\"">")
	    str = replace(str, "	", "")
	    str = replace(str, "/script", "\/script")
	    'str = replace(str, "'", "\'")
	    dim i,c,tempcode
	    c = split(str,vbnewline)
	    for i = 0 to ubound(c)
		        c(i) = trim(c(i))
		        if c(i)<>"" then
			            htmltojs = htmltojs & "document.writeln (""" & c(i) & """);"&vbcrlf
		        end if
	    Next
End Function

Dim url_1,url_2,url_3,url_4,url_5,url_6,url_7,url_8,url_9,url_10,PagePath(30),url_search,url_searchlist,url_book,url_link,HTTP_REFERER
If Request.QueryString("HTTP_REFERER") = "" Then
		HTTP_REFERER = GetFileUrl()
		If (InStr(HTTP_REFERER,"login")>0 Or InStr(HTTP_REFERER,"reg")>0) Then HTTP_REFERER = Request.ServerVariables("HTTP_REFERER")
Else
		HTTP_REFERER = Request.QueryString("HTTP_REFERER")
End If
Select Case Config_Lebi_Eshop(16)
	   Case "0"
			PagePath(0) = LangPath &"user/"
			PagePath(3) = LangPath &"Basket/"
			PagePath(4) = LangPath &"brand/list/"
			PagePath(5) = LangPath &"brand/"
			PagePath(8) = LangPath &"unite/show/"
			PagePath(9) = LangPath &"searchshop.asp"
			PagePath(10) = LangPath &"showproduct.asp"
			PagePath(11) = LangPath &"rss.asp"
			PagePath(12) = LangPath &"showpic.asp"
	   Case "1"
			PagePath(0) = LangPath &"user/"
			PagePath(3) = LangPath &"Basket/"
			PagePath(4) = LangPath &"brand/list/"
			PagePath(5) = LangPath &"brand/"
			PagePath(8) = LangPath &"unite/show/"
			PagePath(9) = LangPath &"search/list/"
			PagePath(10) = LangPath &"product/"
			PagePath(11) = LangPath &"category/rss/"
			PagePath(12) = LangPath &"product/showpic/"
	   Case "2"
			PagePath(0) = LangPath &"user/default.asp"
			PagePath(3) = LangPath &"Basket/default.asp"
			PagePath(4) = LangPath &"brand/list/default.asp"
			PagePath(5) = LangPath &"brand/default.asp"
			PagePath(8) = LangPath &"unite/show/default.asp"
			PagePath(9) = LangPath &"search/list/default.asp"
			PagePath(10) = LangPath &"product/default.asp"
			PagePath(11) = LangPath &"category/rss/default.asp"
			PagePath(12) = LangPath &"product/showpic/default.asp"
End Select
PagePath(1) = LangPath &"Message/Error.asp"
PagePath(2) = LangPath &"Message/Success.asp"
PagePath(6) = LangPath &"user/login.asp"
PagePath(7) = LangPath &"user/reg.asp"
PagePath(13) = LangPath &"basket/pay.asp"
PagePath(14) = LangPath &"Message/WriteMsg.asp"
PagePath(15) = LangPath &"user/regok.asp"
PagePath(16) = LangPath &"user/cklogin.asp"
PagePath(17) = LangPath &"basket/cash.asp"
PagePath(18) = LangPath &"basket/cashview.asp"
PagePath(19) = LangPath &"basket/cashsave.asp"
PagePath(20) = Eshop_url & LangPath &"basket/paymoney.asp"   '绝对路径
PagePath(21) = Eshop_url & LangPath &"basket/print.asp"      '绝对路径
PagePath(22) = LangPath &"link/post.asp"
PagePath(23) = Eshop_url & LangPath &"Message/vote.asp"
PagePath(24) = LangPath &"basket/post.asp"
PagePath(25) = LangPath &"user/post.asp"
PagePath(26) = LangPath &"user/pay.asp"
PagePath(27) = LangPath &"book/post.asp"
PagePath(28) = LangPath &"product/post.asp"
PagePath(29) = LangPath &"search/order.asp"
Select Case show_html
	   Case "0"
			Select Case Config_Lebi_Eshop(16)
				   Case "0" : url_1 = LangPath : url_2 = LangPath &"mulu.asp" : url_3 = LangPath &"brand.asp" : url_4 = LangPath &"newproduct.asp" : url_5 = LangPath &"recom.asp" : url_6 = LangPath &"tjia.asp" : url_7 = LangPath &"zhuanti.asp" : url_8 = LangPath &"help.asp" : url_9 = LangPath &"gift.asp" : url_10 = LangPath &"unite/" : url_search = LangPath &"search.asp" : url_searchlist = LangPath &"searchshop.asp" : url_book = LangPath &"book.asp" : url_link = LangPath &"links.asp"
				   Case "1" : url_1 = LangPath : url_2 = LangPath &"category/" : url_3 = LangPath &"brand/" : url_4 = LangPath &"new/" : url_5 = LangPath &"recom/" : url_6 = LangPath &"sale/" : url_7 = LangPath &"news/" : url_8 = LangPath &"help/" : url_9 = LangPath &"gift/" : url_10 = LangPath &"unite/" : url_search = LangPath &"search/" : url_searchlist = LangPath &"search/list/" : url_book = LangPath &"book/" : url_link = LangPath &"link/"
				   Case "2" : url_1 = LangPath : url_2 = LangPath &"category/default.asp" : url_3 = LangPath &"brand/default.asp" : url_4 = LangPath &"new/default.asp" : url_5 = LangPath &"recom/default.asp" : url_6 = LangPath &"sale/default.asp" : url_7 = LangPath &"news/default.asp" : url_8 = LangPath &"help/default.asp" : url_9 = LangPath &"gift/default.asp" : url_10 = LangPath &"unite/default.asp" : url_search = LangPath &"search/default.asp" : url_searchlist = LangPath &"search/list/default.asp" : url_book = LangPath &"book/default.asp" : url_link = LangPath &"link/default.asp"
			End Select
			If ISAPI_Rewrite = 1 Then
					url_2 = LangPath &"category.html" : url_3 = LangPath &"brand.html" : url_4 = LangPath &"new.html" : url_5 = LangPath &"recom.html" : url_6 = LangPath &"sale.html" : url_7 = LangPath &"news.html" : url_8 = LangPath &"help.html" : url_9 = LangPath &"gift.html" : url_10 = LangPath &"unite.html" : url_search = LangPath &"search.html" : url_book = LangPath &"book.html" : url_link = LangPath &"links.html"

			End If
        Case "1"
			 url_1 = LangPath&"default."& Sys_Ext : url_2 = LangPath &"html/category."& Sys_Ext : url_3 = LangPath &"html/brand."& Sys_Ext : url_4 = LangPath & Folder(3) &"list.1."& Sys_Ext : url_5 = LangPath & Folder(4) &"list.1."& Sys_Ext : url_6 = LangPath & Folder(5) &"list.1."& Sys_Ext : url_7 = LangPath & Folder(1) &"index."& Sys_Ext : url_8 = LangPath & Folder(6) &"index."& Sys_Ext : url_9 = LangPath & Folder(7) &"list.1."& Sys_Ext : url_10 = LangPath & Folder(8) &"list.1."& Sys_Ext
			Select Case Config_Lebi_Eshop(16)
				   Case "0" : url_search = LangPath &"search.asp" : url_searchlist = LangPath &"searchshop.asp" : url_book = LangPath &"book.asp" : url_link = LangPath &"links.asp"
				   Case "1" : url_search = LangPath &"search/" : url_searchlist = LangPath &"search/list/" : url_searchorder = LangPath &"search/order/" : url_book = LangPath &"book/" : url_link = LangPath &"link/"
				   Case "2" : url_search = LangPath &"search/default.asp" : url_searchlist = LangPath &"search/list/default.asp" : url_book = LangPath &"book/default.asp" : url_link = LangPath &"link/default.asp"
			End Select
End Select

rem 2008-1-18 二层模板中处理<-{if then}->标签 by 56770.icystar
Private Function Exec_if_then(strBlock)
		On Error Resume Next
		If strBlock = "" Or IsNull(strBlock) Then Exit Function
		Dim strContent,strValue,strValuestr,Exec_value
		strContent = Replace(strBlock,"[[","'")
		strContent = Replace(Replace(strContent,Chr(10),"[\u000A]"),Chr(13),"[\u000D]")
		strContent = Replace(Replace(strContent,Chr(10),""),Chr(13),"")
        Dim p_RegExp
        Set p_RegExp = New RegExp
		Dim objRegExp,objValue
		p_RegExp.ignorecase = True
		p_RegExp.global = True
		p_RegExp.pattern = "\}->(.+?)<-\{"
		Set objRegExp = p_RegExp.Execute(strContent)
			For Each objValue In objRegExp
			    strValue	= Replace(Replace(objValue.value,"<-{",""),"}->","")
				strValue	= ":Exec_value="""&Replace(strValue,"""","""""")&""":"
				strContent	= Replace(strContent,objValue.value,strValue)
			Next
		Set objRegExp = Nothing
		strValuestr = Replace(Replace(strContent,"<-{",""),"}->","")
		Exec_value = ""
		execute(strValuestr)
		If Err Then
			Err.Clear
			Exec_value = Replace(Replace(strBlock,"<-{","<--{"),"}->","}-->")
		End If
		Exec_value = Replace(Exec_value,"[\u000D][\u000A]",Chr(13)&Chr(10))
		Exec_if_then = Replace(Replace(Exec_value,"[\u000A]",""),"[\u000D]","")
End Function

Private Function Splits(strBlock)
		If strBlock = "" Or IsNull(strBlock) Then Exit Function
		Dim strContent,strValue,strValuestr
		strContent = Replace(strBlock,"[[","'")
		strContent = Replace(strContent,"&#180;","'")
        Dim p_RegExp
        Set p_RegExp = New RegExp
		Dim objRegExp,objValue

		p_RegExp.ignorecase = True
		p_RegExp.global = True
		p_RegExp.pattern = "{\[(.+?)\]}"
		Set objRegExp = p_RegExp.Execute(strContent)
			For Each objValue In objRegExp
			    On Error Resume Next
			    If show_html = 1 Then
				strValue	= Replace(Replace(objValue.value,"{[",""),"]}","")
				strContent	= Replace(strContent,objValue.value,execute(strValue))
				Else
			    strValue	= Replace(Replace(objValue.value,"{[",""),"]}","")
				strContent	= Replace(strContent,objValue.value,strValue)
				End If
			Next
		Set objRegExp = Nothing

		p_RegExp.ignorecase = True
		p_RegExp.global = True
		p_RegExp.pattern = "{\$(.+?)\}"
		Set objRegExp = p_RegExp.Execute(strContent)
		For Each objValue In objRegExp
			On Error Resume Next
			strValuestr    = Replace(Replace(objValue.value,"{$",""),"}","")
			strContent	= Replace(strContent,objValue.value,eval(strValuestr))
		Next
		p_RegExp.pattern = "(<(script|link|img|input|embed|param|object|base|area|map|table|td|a|form).+?(href|src|lb-lazyload|background|action)=.+?)(.+?\>)"
		rem 2007-11-5 区分内外部连接URL by 56770.kingdge
		rem 2007-11-6 增加对https的识别 by 56770.kingdge
		Set objRegExp = p_RegExp.Execute(strContent)
		For Each objValue In objRegExp
			If instr(LCase(objValue.value),"http") = 0 And instr(LCase(objValue.value),"msnim:") = 0 And instr(LCase(objValue.value),"tencent:") = 0 And instr(LCase(objValue.value),"skype:") = 0 And instr(LCase(objValue.value),"wangwang:") = 0 Then
			        If ESHOP_URL = "/" Then
							strValue	= p_RegExp.Replace(objValue.value,"$1" & ESHOP_URL & "$4")
					Else
							strValue	= p_RegExp.Replace(Replace(objValue.value,ESHOP_URL,""),"$1" & ESHOP_URL & "$4")
					End If
					strContent = Replace(strContent,objValue.value,strValue)
			End If
		Next
		Set objRegExp = Nothing
		strContent = Replace(strContent,"""//","""/")
		strContent = Replace(strContent,"'//","'/")
		Splits = strContent
End Function

Function html_splits(strBlock)
		If strBlock = "" Or IsNull(strBlock) Then Exit Function
		Dim strContent,strValue,strValuestr
		strContent = Replace(strBlock,"[[","'")
		strContent = Replace(strContent,"&#180;","'")
        Dim p_RegExp
        Set p_RegExp = New RegExp
		Dim objRegExp,objValue
		p_RegExp.ignorecase = True
		p_RegExp.global = True
		p_RegExp.pattern = "<!--#include(.+?)-->"
		Set objRegExp = p_RegExp.Execute(strContent)
			For Each objValue In objRegExp
				strValue	= LoadHtml(Eshop_url &"skins/"& template &"/template/"& Replace(Replace(objValue.value,"<!--#include(",""),")-->",""))
				strContent	= Replace(strContent,objValue.value,strValue)

'				strValue	= Replace(Replace(objValue.value,"<!--#include(","<!--#include file="""& Fatherpath &""),")-->","""-->")
'				strContent	= Replace(strContent,objValue.value,strValue)
			Next
		Set objRegExp = Nothing
		p_RegExp.ignorecase = True
		p_RegExp.global = True
		p_RegExp.pattern = "(<(script|link|img|input|embed|param|object|base|area|map|table|td|a|form).+?(href|src|lb-lazyload|background|action)=.+?)(.+?\>)"
		rem 2007-11-5 区分内外部连接URL by 56770.kingdge
		rem 2007-11-6 增加对https的识别 by 56770.kingdge
		Set objRegExp = p_RegExp.Execute(strContent)
		For Each objValue In objRegExp
			If instr(LCase(objValue.value),"http") = 0 And instr(LCase(objValue.value),"msnim:") = 0 And instr(LCase(objValue.value),"tencent:") = 0 And instr(LCase(objValue.value),"skype:") = 0 And instr(LCase(objValue.value),"wangwang:") = 0 Then
			        If ESHOP_URL = "/" Then
							strValue	= p_RegExp.Replace(objValue.value,"$1" & ESHOP_URL & "$4")
					Else
							strValue	= p_RegExp.Replace(Replace(objValue.value,ESHOP_URL,""),"$1" & ESHOP_URL & "$4")
					End If
					strContent = Replace(strContent,objValue.value,strValue)
			End If
		Next
		Set objRegExp = Nothing
		p_RegExp.pattern = "{\[(.+?)\]}"
		Set objRegExp = p_RegExp.Execute(strContent)
			For Each objValue In objRegExp
			    On Error Resume Next
			    If show_html = 1 Then
				strValue	= Replace(Replace(objValue.value,"{[",""),"]}","")
				strContent	= Replace(strContent,objValue.value,execute(strValue))
				Else
			    strValue	= Replace(Replace(objValue.value,"{[",""),"]}","")
				strContent	= Replace(strContent,objValue.value,strValue)
				End If
			Next
		Set objRegExp = Nothing

		p_RegExp.ignorecase = True
		p_RegExp.global = True
		p_RegExp.pattern = "{\$(.+?)\}"
		Set objRegExp = p_RegExp.Execute(strContent)
		For Each objValue In objRegExp
			On Error Resume Next
			strValuestr    = Replace(Replace(objValue.value,"{$",""),"}","")
			strContent	= Replace(strContent,objValue.value,eval(strValuestr))
		Next
		Set objRegExp = Nothing

		Dim FileName:FileName	= strFilename
		If InStr(FileName,"/")>0 Then
				For i = 0 To UBound(Split(FileName,"/"))-1
						Fatherpath = Fatherpath & "../"
				Next
		Else
				Fatherpath = ""
		End If
		strContent = Replace(Replace(strContent,"<$","<%"),"$>","%\>")
		strContent = Replace(strContent,"""/""""","""""""")
		strContent = Replace(strContent,"""//","""/")
		strContent = Replace(strContent,"'//","'/")
		html_splits = strContent
End Function

Function Format(strContent,strUrl)
        Dim p_RegExp,objRegExp,objValue,strValue
        Set p_RegExp = New RegExp
	    strcontent = Replace(strcontent,"|","┊")
		p_RegExp.pattern = "(<(script|link|img|input|embed|param|object|base|area|map|table|td|a|form).+?(href|src|lb-lazyload|background|action)=.+?)(.+?\>)"
		p_RegExp.ignorecase = True
		p_RegExp.global = True
		rem 2007-11-5 区分内外部连接URL by 56770.kingdge
		rem 2007-11-6 增加对https的识别 by 56770.kingdge
		Set objRegExp = p_RegExp.Execute(strContent)
			For Each objValue In objRegExp
			    'If instr(LCase(objValue.value),"http") = 0 And instr(LCase(objValue.value),"msnim:") = 0 And instr(LCase(objValue.value),"tencent:") = 0 And instr(LCase(objValue.value),"skype:") = 0 And instr(LCase(objValue.value),"wangwang:") = 0 Then
				        strValue	= p_RegExp.Replace(objValue.value,"$1" & strUrl & "$4")
				        strContent = Replace(strContent,objValue.value,strValue)
				'End If
		Next
		Format = strContent
End Function

rem 按指定参数格式化显示时间。
rem format=0:不显示时间
rem format=1:将时间转化为年月日格式。
rem format=2:将时间转化为月日格式。
rem format=3:将时间转化为yyyy/m/d格式。
rem format=4:将时间转化为m/d格式。
rem format=5:将时间转化为月日小时分钟格式。
rem format=6:将时间转化星期格式。
rem format=7:不格式化时间。
Function Formatdate(DateTime,Format)
		select case Format
		case "0"
			 Formatdate=""
		case "1"
			 Formatdate=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日"
		case "2"
			 Formatdate=""&month(DateTime)&"月"&day(DateTime)&"日"
		case "3"
			 Formatdate=""&year(DateTime)&"/"&month(DateTime)&"/"&day(DateTime)&""
		case "4"
			 Formatdate=""&month(DateTime)&"/"&day(DateTime)&""
		case "5"
			 Formatdate=""&month(DateTime)&"月"&day(DateTime)&"日"&FormatDateTime(DateTime,4)&""
		case "6"
		     temp="周日,周一,周二,周三,周四,周五,周六"
		     temp=split(temp,",")
		     Formatdate=temp(Weekday(DateTime)-1)
		case "7"
		     Formatdate=DateTime
		case Else
		     Formatdate=Year(DateTime)&"-"&Month(DateTime)&"-"&Day(DateTime)&" "&Hour(DateTime)&":"&Minute(DateTime)&":"&Second(DateTime)
		end select
End Function

Function LoadStyle(strFile)
		On Error Resume Next
		Dim strTempPath,objFSO,objStm,Filename,App_Style
		'Filename = Replace(LCase(Split(strFile,"/")(UBound(Split(strFile,"/")))),".style","")
		Filename = Replace(strFile,".style","")
		App_Style = Application(cookiesname&"_"&Filename)
		If App_Style = "" Then
				strTempPath = Server.MapPath(strFile)
				Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
				Set objStm = Server.CreateObject("ADODB.Stream")
					If objFso.FileExists(strTempPath) Then
						objStm.charset = "UTF-8"
						objStm.open
						objStm.LoadFromFile strTempPath
						Application(cookiesname&"_"&Filename) = objStm.ReadText
					End If
				Set objStm = Nothing
				Set objFSO = Nothing
				LoadStyle = Application(cookiesname&"_"&Filename)
		Else
		        LoadStyle = App_Style
		End If
		If Err Then
			    Err.Clear
		End If
End Function

Function LoadHtml(strFile)
		On Error Resume Next
		Dim strTempPath,objFSO,objStm
		strTempPath = Server.MapPath(strFile)
		Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
		Set objStm = Server.CreateObject("ADODB.Stream")
			If objFso.FileExists(strTempPath) Then
				objStm.charset = "UTF-8"
				objStm.open
				objStm.LoadFromFile strTempPath
				LoadHtml = objStm.ReadText
			End If
		Set objStm = Nothing
		Set objFSO = Nothing
		If Err Then
				Err.Clear
		End If
End Function

Function ReplaceStyle(sTag,sReplaceValue,ByRef sWebcontent)
        on error resume next
	    If InStr(sWebcontent,"{@"&sTag&"}") > 0 Then
		        sWebcontent = Replace(sWebcontent,"{@"&sTag&"}",sReplaceValue & "")
	    End If
End Function

rem 2008-1-11 if_then 函数 by 56770.icystar
Function if_then(ok,str)
		if_then = "" : If ok Then if_then = str
End Function

rem	<-{ 过滤敏感文字 2008-3-8 by 56770.WangLei
Function reBadWord(cntstr)
		Dim regEx
		If Trim(word_filter) <> "" Then
				Set regEx = New RegExp
				regEx.Pattern = Replace(word_filter,"/","|")
				regEx.IgnoreCase = True
				regEx.Global = True
				reBadWord = regEx.replace(cntstr,"***")
		Else
				reBadWord = cntstr
		End If
End Function
rem	}->

Function CheckNum(num,back)
		num = Trim(num)
		If Not IsNumeric(num) Or IsEmpty(num) Then
				CheckNum = CLng(back)
		Else
				CheckNum = num
		End If
End Function

function judge(a,b)
        dim res
        if instr(","& a &",",","& b &",")>0 then
                res ="checked"
        end if
        judge = res
end Function

function judge2(a,b)
        dim res
        if instr(","& a &",",","& b &",")>0 then
               res ="selected"
        end if
        judge2= res
end Function

Function CallBack(tl,mes,url,times)
		If url = "0" Then url = "javascript:history.back()"
		If url = "1" Then url = "javascript:window.close()"
		CallBack = "<div class='otherbox'>"
		CallBack = CallBack &"<h2>"& tl &"</h2>"
		CallBack = CallBack &"<p class='list'>"& mes &"</p>"
		if url = "1" Then
				CallBack = CallBack &"<p class='list'>·<a href='javascript:window.close()'><font color=red><span id=""backtime"">0</span></font> "&Lebi_word(67)&"</a></p>"
				'CallBack = CallBack &"<p class='list'><a href='javascript:window.close()'><img border=0 src="&Eshop_url&"images/close.gif align=absmiddle> "& Lebi_word(5) &"</a></td></tr>"
		Else
				CallBack = CallBack &"<p class='list'>·<a href='javascript:history.go(-1)'><font color=red><span id=""backtime"">0</span></font> "&Lebi_user(75)&"</a></p>"
				'CallBack = CallBack &"<tr><td height='25' class='list' align='right'><a href='javascript:history.go(-1)'><img border=0 src="&Eshop_url&"images/re.gif align=absmiddle> "& Lebi_word(4) &"</a></td></tr>"
		End If
		CallBack = CallBack &"</div>"
		CallBack = CallBack &"<script language=""JavaScript"">Url="""& url &""";if (!Url){Url=document.referrer}function countDown(secs){document.getElementById(""backtime"").innerHTML=secs;if(--secs>0) {setTimeout(""countDown(""+secs+"")"",1000);}else {window.location.href=Url;}}countDown("& times &");</script>"
End Function

Function Urlencode(str)
		If IsNull(str) Then
				Exit Function
		End If
		Urlencode = server.urlencode(str)
End Function
Function ArchiveHtml(Textstr)
		Str=Textstr
		If ISAPI_Rewrite = 1 Then
				Dim Str,re,Matches,Match
				Set re=new RegExp
				re.IgnoreCase =True
				re.Global=True
				rem category/id/
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)sle_type=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"category-$1-t$2-$4$5-st$7-$9.html")
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)sle_type=(\d+)?"
				str = re.Replace(str,"category-$1-t$2-$4$5-st$7.html")
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"category-$1-t$2-$4$5-$7.html")
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?"
				str = re.Replace(str,"category-$1-t$2-$4$5.html")
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)sle_type=(.[^<>""\'\s]*)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"category-$1-t$2-st$4-$6.html")
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)sle_type=(.[^<>""\'\s]*)?"
				str = re.Replace(str,"category-$1-t$2-st$4.html")
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"category-$1-t$2-$4.html")
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp\?listtype=(.[^<>""\'\s]*)?"
				str = re.Replace(str,"category-$1-t$2.html")
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp\?page=(\d+)?"
				str = re.Replace(str,"category-$1-$2.html")
				re.Pattern = "category/(.[^<>""\'\s]*)?/default\.asp"
				str = re.Replace(str,"category-$1.html")

				rem new/
				re.Pattern = "new/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)addtime=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"new-t$1-$3$4-time$6-$8.html")
				re.Pattern = "new/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)addtime=(\d+)?"
				str = re.Replace(str,"new-t$1-$3$4-time$6.html")
				re.Pattern = "new/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)addtime=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"new-t$1-time$3-$5.html")
				re.Pattern = "new/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)addtime=(\d+)?"
				str = re.Replace(str,"new-t$1-time$3.html")
				re.Pattern = "new/default\.asp\?addtime=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"new-time$1-$3.html")
				re.Pattern = "new/default\.asp\?addtime=(\d+)?"
				str = re.Replace(str,"new-time$1.html")
				re.Pattern = "\?addtime=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"new-time$1-$3.html")
				re.Pattern = "\?addtime=(\d+)?"
				str = re.Replace(str,"new-time$1.html")
				re.Pattern = "new/default\.asp\?page=(\d+)?"
				str = re.Replace(str,"new-$1.html")
				re.Pattern = "new/default\.asp"
				str = re.Replace(str,"new.html")
				rem recom/
				re.Pattern = "recom/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)retime=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"recom-t$1-$3$4-time$6-$8.html")
				re.Pattern = "recom/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)retime=(\d+)?"
				str = re.Replace(str,"recom-t$1-$3$4-time$6.html")
				re.Pattern = "recom/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)retime=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"recom-t$1-time$3-$5.html")
				re.Pattern = "recom/default\.asp\?listtype=(.[^<>""\'\s]*)?(&|&amp;)retime=(\d+)?"
				str = re.Replace(str,"recom-t$1-time$3.html")
				re.Pattern = "recom/default\.asp\?retime=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"recom-time$1-$3.html")
				re.Pattern = "recom/default\.asp\?retime=(\d+)?"
				str = re.Replace(str,"recom-time$1.html")
				re.Pattern = "\?retime=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"recom-time$1-$3.html")
				re.Pattern = "\?retime=(\d+)?"
				str = re.Replace(str,"recom-time$1.html")
				re.Pattern = "recom/default\.asp\?page=(\d+)?"
				str = re.Replace(str,"recom-$1.html")
'				re.Pattern = "recom/default\.asp"
'				str = re.Replace(str,"recom.html")
				rem sale/
				re.Pattern = "sale/default\.asp\?Sort_id=(\d+)?(&|&amp;)listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"sale-s$1-t$3-$5$6-$8.html")
				re.Pattern = "sale/default\.asp\?Sort_id=(\d+)?(&|&amp;)listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?"
				str = re.Replace(str,"sale-s$1-t$3-$5$6.html")
				re.Pattern = "sale/default\.asp\?Sort_id=(\d+)?(&|&amp;)listtype=(.[^<>""\'\s]*)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"sale-s$1-t$3-$5.html")
				re.Pattern = "sale/default\.asp\?Sort_id=(\d+)?(&|&amp;)listtype=(.[^<>""\'\s]*)?"
				str = re.Replace(str,"sale-s$1-t$3.html")
				re.Pattern = "sale/default\.asp\?page=(\d+)?"
				str = re.Replace(str,"sale-$1.html")
				re.Pattern = "sale/default\.asp"
				str = re.Replace(str,"sale.html")
				rem brand/list/
				re.Pattern = "brand/list/default\.asp\?Sort_id=(\d+)?(&|&amp;)listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)sle_type=(\d+)?(&|&amp;)brand=(.[^<>""\'\s]*)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"brand-s$1-t$3-$5$6-st$8-$10-$12.html")
				re.Pattern = "brand/list/default\.asp\?Sort_id=(\d+)?(&|&amp;)listtype=(.[^<>""\'\s]*)?(&|&amp;)(listprice|listview|listbuy|listtime)=(.[^<>""\'\s]*)?(&|&amp;)sle_type=(\d+)?(&|&amp;)brand=(.[^<>""\'\s]*)?"
				str = re.Replace(str,"brand-s$1-t$3-$5$6-st$8-$10.html")
				re.Pattern = "brand/list/default\.asp\?Sort_id=(\d+)?(&|&amp;)listtype=(.[^<>""\'\s]*)?(&|&amp;)sle_type=(\d+)?(&|&amp;)brand=(.[^<>""\'\s]*)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"brand-s$1-t$3-st$5-$7-$9.html")
				re.Pattern = "brand/list/default\.asp\?Sort_id=(\d+)?(&|&amp;)listtype=(.[^<>""\'\s]*)?(&|&amp;)sle_type=(\d+)?(&|&amp;)brand=(.[^<>""\'\s]*)?"
				str = re.Replace(str,"brand-s$1-t$3-st$5-$7.html")
				re.Pattern = "brand/list/default\.asp\?sle_type=(\d+)?(&|&amp;)brand=(.[^<>""\'\s]*)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"brand-st$1-$3-$5.html")
				rem product/
				re.Pattern = "product/default\.asp\?id=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"product-$1-$3.html")
				re.Pattern = "product/default\.asp\?id=(\d+)?"
				str = re.Replace(str,"product-$1.html")
				rem unite/
				re.Pattern = "unite/default\.asp\?page=(\d+)?"
				str = re.Replace(str,"unite-$1.html")
				rem gift/
				re.Pattern = "gift/default\.asp\?page=(\d+)?"
				str = re.Replace(str,"gift-$1.html")
				rem book/
				re.Pattern = "book/default\.asp\?page=(\d+)?"
				str = re.Replace(str,"book-$1.html")
				rem help/
				re.Pattern = "help/class/default\.asp\?id=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"help_class-$1-$3.html")
				re.Pattern = "help/class/default\.asp\?id=(\d+)?"
				str = re.Replace(str,"help_class-$1.html")
				rem news/
				re.Pattern = "news/class/default\.asp\?id=(\d+)?(&|&amp;)page=(\d+)?"
				str = re.Replace(str,"news_class-$1-$3.html")
				re.Pattern = "news/class/default\.asp\?id=(\d+)?"
				str = re.Replace(str,"news_class-$1.html")
				Set Re=Nothing
		End If
		ArchiveHtml = Str
End Function

Function HackSql()
		Dim badwords,badword
		HackSql=""
		badwords= "'|;|exec|insert|select|delete|count|*|%|chr|mid|master|truncate|char|declare"
		badword=split(badwords,"|")
'		If Request.Form<>"" Then
'				For Each LB_Post In Request.Form
'						For i=0 To Ubound(badword)
'								If Instr(LCase(Request.Form(LB_Post)),badword(i))>0 Then
'										HackSql=badword(i)
'										response.write HackSql
'										exit Function
'								End If
'						Next
'				Next
'		End If
		If Request.QueryString<>"" Then
				For Each LB_Get In Request.QueryString
						For i=0 To Ubound(badword)
								If Instr(LCase(Request.QueryString(LB_Get)),badword(i))>0 Then
										HackSql=badword(i)
										exit function
								End If
						Next
				Next
		End If
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
		If InStr(strIPAddr,".") = 0 Or strIPAddr = "localhost" Then strIPAddr = "127.0.0.1"
		getIP = Trim(Mid(strIPAddr, 1, 30))
End Function

Function CheckMobile(x)
		If IsNull(x) Then
				CheckMobile = False
				Exit Function
		End If
		Dim i,strCurrentChar,strTemp
		CheckMobile = True
		For i = 1 To len(x)
				If IsNumeric(Mid(x, i, 1)) = False And Mid(x, i, 1) <> "-" And Mid(x, i, 1) <> "(" And Mid(x, i, 1) <> ")" Then
						CheckMobile = False
						Exit Function
				End If
		Next
		For i = 1 To len(x)
				strCurrentChar = Mid(x, i, 1)
				If Asc("0") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("9") Then
						strTemp = strTemp & strCurrentChar
				End If
				If Asc("A") <= Asc(strCurrentChar) And Asc(strCurrentChar) <= Asc("Z") Then
						strTemp = strTemp & strCurrentChar
				End If
		Next
		x = strTemp
		If len(x) = 10 And Left(x, 1) = "1" Then
				CheckMobile = False
				Exit Function
		End If
		If len(x) < 10 Then
				CheckMobile = False
				Exit Function
		End If
		If len(x) > 11 Then
				CheckMobile = False
				Exit Function
		End If
End Function

Function RedirectSendSMS(mobile,Msg,Msgno,sendtime,sendtype)
		Dim i
		session("msg"& Msgno) = Msg
		Msg = Left(safereplace(Msg),200)
		If sendtime = "" Then sendtime = Now()
		Response.write("<script src="""& Eshop_url &"API/SMS.Send.asp?mobile="& mobile &"&msgno="& msgno &"&msg="& Msg &"&sendtime="& sendtime &"&sendtype="& sendtype &""" charset=""gb2312""></script>")
		If InStr(mobile,",") > 0 Then
				For i = 0 To UBound(Split(mobile,","))
						If CheckMobile(Split(mobile,",")(i)) Then
								conn.execute("insert into [Lebi_SMSLog](l_mobile,l_content,l_time)values('"& Split(mobile,",")(i) &"','"& Msg &"','"& sendtime &"')")
						End If
				Next
		Else
				conn.execute("insert into [Lebi_SMSLog](l_mobile,l_content,l_time)values('"& mobile &"','"& Msg &"','"& sendtime &"')")
		End If
End Function

Function GetUrl()
        GetUrl="http://"&Request.ServerVariables("SERVER_NAME")&":"&request.ServerVariables("SERVER_PORT")&Request.ServerVariables("URL")
		If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function

Function GetLicense(key,license)
		On Error Resume Next
		Dim objStream,ConnLicense,data,a,b
		Set objStream = Server.CreateObject("ADODB.Stream")
		objStream.Open : objStream.Type=1 : objStream.LoadFromFile server.MapPath(Eshop_url&"Include/lebi_license/"& license &".license")
		Set ConnLicense = Server.CreateObject("ADODB.Connection")
		ConnLicense.open "Provider = Microsoft.Jet.OLEDB.4.0;Jet OLEDB:Database Password="&left(objStream.Read,19)&";Data Source="& Server.MapPath(Eshop_url&"Include/lebi_license/"& key &".key")
		If Err Then
				err.Clear : Set ConnLicense = Nothing : Response.End
		End If
		cache.name="Lebi_sys_license"
		cache.reloadtime= 5000
		If cache.objisempty() Then
				set Rs = ConnLicense.execute("select a,c from [56770_license]")
				cache.value = rs.getstring(,1,"><$><","","")
				rs.close:Set rs=Nothing
		End If
		data = Split(cache.value,"><$><")
		a = data(0)
		b = data(1)
		If Md6Back(lcase(Replace(Replace(Request.ServerVariables("SERVER_NAME"),".",""),"www","")),a) = 1 Then
				If Split(b,"|")(9) = "1" Then
						GetLicense = 0
				Else
						GetLicense = 1
				End If
		Else
				GetLicense = 0
		End If
End Function

Function GetCategoryRate(id)
		Dim arr_id
		If InStr(id,",") > 0 Then
				arr_id = Split(id,",")
				For ii = 0 To UBound(arr_id)
						If checknum(arr_id(ii),0) > 0 Then
								Set gs = conn.execute("select c_parentid,c_father,c_rate from [Lebi_category] where c_id = "& arr_id(ii) &"")
								If Not gs.eof Then
										If CLng(gs(1)) = 1 Then
												GetCategoryRate = gs(2)
												Exit Function
										Else
												GetCategoryRate = GetCategoryRate(gs(0))
										End If
								Else
										GetCategoryRate = "1|1|1|1|1|1|1|1|1|1"
								End If
								gs.close
						End If
				Next
		Else
				Set gs = conn.execute("select c_parentid,c_father,c_rate from [Lebi_category] where c_id = "& checknum(id,0) &"")
				If Not gs.eof Then
						If CLng(gs(1)) = 1 Then
								GetCategoryRate = gs(2)
								Exit Function
						Else
								GetCategoryRate = GetCategoryRate(gs(0))
						End If
				Else
						GetCategoryRate = "1|1|1|1|1|1|1|1|1|1"
				End If
				gs.close
		End If
End Function

Function SaveOrderNo()
		randomize
		ranNum = int((99-10)*rnd+10)
		yy = Right(year(date),2):mm = right("00"&month(date),2):dd = right("00"&day(date),2):xiaoshi = right("00"&hour(time),2):fenzhong = right("00"&minute(time),2):miao = right("00"&second(time),2)
		SaveOrderNo = yy & mm & dd & xiaoshi & fenzhong & miao & ranNum
End Function 

Function CheckUrl(url) 
		If InStr(LCase(url),"http") = 0 Then 
				CheckUrl = url
				Exit Function 
		Else 
				If InStr(LCase(url),"http://"& Request.ServerVariables("SERVER_NAME")) > 0 Then 
						CheckUrl = url
						Exit Function 
				Else
						CheckUrl = Eshop_url & LangPath
				End if 
		End if 
End Function 

Function getN(str,keyword,splits) 
		getN = 0 
		arr = Split(str,splits) 
		getN = UBound(arr) 
		For n = 0 To UBound(arr) 
		if CStr(arr(n)) = CStr(keyword) then 
				getN = (n-1) + 1 
				Exit Function  
		End If  
		Next  
End Function 

Function Kuadi100API(com,nu,valicode)
	If Split(sys_kuaidi100,"|")(0) = 1 Then 
		SendURL = "http://api.kuaidi100.com/api?id="& Split(sys_kuaidi100,"|")(1) &"&com="& safereplace(com) &"&nu="& safereplace(nu) &"&valicode="& safereplace(valicode) &"&show=2&muti=1&order=asc"
		Kuadi100API = GetHTTPPage(SendURL)
	End If 
End Function 
Function GetHTTPPage(URL) 
    Dim objXML 
    Set objXML=CreateObject("MSXML2.SERVERXMLHTTP.3.0")  '调用XMLHTTP组件，测试空间是否支持XMLHTTP，如果服务不支持，请测试下面两个。
	'Set objXML=Server.CreateObject("Microsoft.XMLHTTP") 
	'Set objXML=Server.CreateObject("MSXML2.XMLHTTP.4.0") 
	objXML.SetTimeouts 5000, 5000, 30000, 10000' 解析DNS名字的超时时间，建立Winsock连接的超时时间，发送数据的超时时间，接收response的超时时间。单位毫秒
    objXML.Open "GET",URL,False 'false表示以同步的方式获取网页代码，了解什么是同步？什么是异步？
    objXML.Send() '发送
	If objXML.Readystate<>4 Then
		Exit Function 
	End If
	'Readystate属性,传回XML文件资料的目前状况,返回值分别有以下：
	'0-UNINITIALIZED：XML 对象被产生，但没有任何文件被加载。
	'1-LOADING：加载程序进行中，但文件尚未开始解析。
	'2-LOADED：部分的文件已经加载且进行解析，但对象模型尚未生效。
	'3-INTERACTIVE：仅对已加载的部分文件有效，在此情况下，对象模型是有效但只读的。
	'4-COMPLETED：文件已完全加载，代表加载成功。
	'GetHTTPPage=objXML.ResponseBody
	GetHTTPPage=BytesToBstr(objXML.ResponseBody)'返回信息，同时用函数定义编码，如果您需要转码请选择 
    Set objXML=Nothing'关闭 
	If Err.number<>0 Then 
'		Response.Write "<p align='center'><font color='red'><b>服务器获取文件内容出错，请稍后再试！</b></font></p>" 
		Err.Clear
	Else
		GetHTTPPage = GetHTTPPage &"<span style=""font-size:12px"">查询数据由：快递100(<a href='http://kuaidi100.com' target='_blank'>www.kuaidi100</a>) 提供</span>"
	End If
End Function
Function BytesToBstr(body) 
	On Error Resume Next 
	If IsNull(body) Then 
		BytesToBstr = ""
		Exit Function 
	End If 
    Dim objstream 
    Set objstream = Server.CreateObject("Adodb.Stream")
    objstream.Type = 1 
    objstream.Mode =3 
    objstream.Open 
    objstream.Write body 
    objstream.Position = 0 
    objstream.Type = 2 
    objstream.Charset = "UTF-8"
    BytesToBstr = objstream.ReadText 
    objstream.Close 
    Set objstream = Nothing 
End Function
Function CheckTable(myTable)
	dim rs,getTableName
	set rs=conn.openSchema(20) 
	rs.movefirst 
	do Until rs.EOF 
	if rs("TABLE_TYPE")="TABLE" then 
	   getTableName=getTableName+rs("TABLE_NAME")&","
	end if 
	rs.movenext
	loop
	rs.close
	set rs=nothing
	dim getTableName2,myTable2
	getTableName2=","&getTableName
	myTable2=","&myTable&","
	If instr(getTableName2,myTable2)<>0 Then
	   CheckTable=1
	else
	   CheckTable=0
	end if
End Function
Function GetPageURL(Filename,paramname,paramvalue)
	Dim strurl,str_url,i,j,search_str,result_url,str_params,PagePath
	If request.ServerVariables("SERVER_PORT") <> 80 Then 
			PagePath = "http://"&Request.ServerVariables("SERVER_NAME")&":"&request.ServerVariables("SERVER_PORT")
	Else
			PagePath = "http://"&Request.ServerVariables("SERVER_NAME")
	End If 
	PagePath = PagePath & LCase(Request.ServerVariables("URL"))
	PagePath = Replace(PagePath,"default.asp","")
	search_str=""& paramname &"="
	strurl=Request.ServerVariables("URL")
	Strurl=split(strurl,"/")
	i=UBound(strurl,1)
	str_url="" 'strurl(i)'得到当前页文件名
	str_params=Trim(Request.ServerVariables("QUERY_STRING"))
	If str_params="" Then
			Select Case paramvalue
				   Case "0" : result_url=str_url
				   Case Else
						result_url=str_url & "?"& paramname &"="& paramvalue
			End Select
	Else
			If InstrRev(str_params,search_str)=0 Then
					Select Case paramvalue
						   Case "0" : result_url=str_url & "?" & str_params
						   Case Else
								result_url=str_url & "?" & str_params &"&"& paramname &"="& paramvalue
					End Select
			Else
					j=InstrRev(str_params,search_str)-2
					If j=-1 Then
							Select Case paramvalue
								   Case "0" : result_url=str_url
								   Case Else
										result_url=str_url & "?"& paramname &"="& paramvalue
							End Select
					Else
							str_params=Left(str_params,j)
							Select Case paramvalue
								   Case "0" : result_url=str_url & "?" & str_params
								   Case Else
										result_url=str_url & "?" & str_params &"&"& paramname &"="& paramvalue
							End Select
					End If
			End If
	End If
	result_url = PagePath & result_url
	GetPageURL=result_url
End Function
Function paramurl(url)
	If request("perpage") <> "" And InStr(url,"perpage=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&perpage="& request("perpage")
		Else
			url = url &"?perpage="& request("perpage")
		End If 
	End If 
	If request("color") <> "" And InStr(url,"color=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&color="& request("color")
		Else
			url = url &"?color="& request("color")
		End If 
	End If 
	If request("listprice") <> "" And InStr(url,"listprice=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&listprice="& request("listprice")
		Else
			url = url &"?listprice="& request("listprice")
		End If 
	End If 
	If request("listtype") <> "" And InStr(url,"listtype=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&listtype="& request("listtype")
		Else
			url = url &"?listtype="& request("listtype")
		End If 
	End If 
	If request("listtime") <> "" And InStr(url,"listtime=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&listtime="& request("listtime")
		Else
			url = url &"?listtime="& request("listtime")
		End If 
	End If 
	If request("listview") <> "" And InStr(url,"listview=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&listview="& request("listview")
		Else
			url = url &"?listview="& request("listview")
		End If 
	End If 
	If request("listbuy") <> "" And InStr(url,"listbuy=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&listbuy="& request("listbuy")
		Else
			url = url &"?listbuy="& request("listbuy")
		End If 
	End If 
	If request("pricetype") <> "" And InStr(url,"pricetype=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&pricetype="& request("pricetype")
		Else
			url = url &"?pricetype="& request("pricetype")
		End If 
	End If 
	If request("price1") <> "" And InStr(url,"price1=") =< 0 And InStr(url,"price2=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&price1="& request("price1") &"&price2="& request("price2")
		Else
			url = url &"?price1="& request("price1") &"&price2="& request("price2")
		End If 
	End If 
	If request("material") <> "" And InStr(url,"material=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&material="& request("material")
		Else
			url = url &"?material="& request("material")
		End If 
	End If 
	If request("design") <> "" And InStr(url,"design=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&design="& request("design")
		Else
			url = url &"?design="& request("design")
		End If 
	End If 
	If request("brand") <> "" And InStr(url,"brand=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&brand="& server.urlencode(request("brand"))
		Else
			url = url &"?brand="& server.urlencode(request("brand"))
		End If 
	End If 
	If request("sle_type") <> "" And InStr(url,"sle_type=") =< 0 Then
		If InStr(url,"?") > 0 Then 
			url = url &"&sle_type="& request("sle_type")
		Else
			url = url &"?sle_type="& request("sle_type")
		End If 
	End If 
	paramurl = url
End Function 
Function URLDecode(ByVal urlcode)
Dim start,final,length,char,i,butf8,pass
Dim leftstr,rightstr,finalstr
Dim b0,b1,bx,blength,position,u,utf8
On Error Resume Next
b0 = Array(192,224,240,248,252,254)
urlcode = Replace(urlcode,"+"," ")
pass = 0
utf8 = -1
length = Len(urlcode) : start = InStr(urlcode,"%") : final = InStrRev(urlcode,"%")
If start = 0 Or length < 3 Then URLDecode = urlcode : Exit Function
leftstr = Left(urlcode,start - 1) : rightstr = Right(urlcode,length - 2 - final)
For i = start To final
char = Mid(urlcode,i,1)
If char = "%" Then
bx = URLDecode_Hex(Mid(urlcode,i + 1,2))
If bx > 31 And bx < 128 Then
i = i + 2
finalstr = finalstr & ChrW(bx)
ElseIf bx > 127 Then
i = i + 2
If utf8 < 0 Then
butf8 = 1 : blength = -1 : b1 = bx
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
b1 = URLDecode_Hex(Mid(urlcode,i + position * 3 + 2,2))
If b1 < 128 Or b1 > 191 Then butf8 = 0 : Exit For
Next
Else
butf8 = 0
End If
If butf8 = 1 And blength = 0 Then butf8 = -2
If butf8 > -1 And utf8 = -2 Then i = start - 1 : finalstr = "" : pass = 1
utf8 = butf8
End If
If pass = 0 Then
If utf8 = 1 Then
b1 = bx : u = 0 : blength = -1
For position = 4 To 0 Step -1
If b1 >= b0(position) And b1 < b0(position + 1) Then
blength = position
b1 = (b1 xOr b0(position)) * 64 ^ (position + 1)
Exit For
End If
Next
If blength > -1 Then
For position = 0 To blength
bx = URLDecode_Hex(Mid(urlcode,i + 2,2)) : i = i + 3
If bx < 128 Or bx > 191 Then u = 0 : Exit For
u = u + (bx And 63) * 64 ^ (blength - position)
Next
If u > 0 Then finalstr = finalstr & ChrW(b1 + u)
End If
Else
b1 = bx * &h100 : u = 0
bx = URLDecode_Hex(Mid(urlcode,i + 2,2))
If bx > 0 Then
u = b1 + bx
i = i + 3
Else
If Left(urlcode,1) = "%" Then
u = b1 + Asc(Mid(urlcode,i + 3,1))
i = i + 2
Else
u = b1 + Asc(Mid(urlcode,i + 1,1))
i = i + 1
End If
End If
finalstr = finalstr & Chr(u)
End If
Else
pass = 0
End If
End If
Else
finalstr = finalstr & char
End If
Next
URLDecode = leftstr & finalstr & rightstr
End Function
Function URLDecode_Hex(ByVal h)
On Error Resume Next
h = "&h" & Trim(h) : URLDecode_Hex = -1
If Len(h) <> 4 Then Exit Function
If isNumeric(h) Then URLDecode_Hex = cInt(h)
End Function
Function GetFileUrl()
        GetFileUrl = Request.ServerVariables("URL")
		If Request.ServerVariables("QUERY_STRING")<>"" Then GetFileUrl = GetFileUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function
%>