<%
'-------------------------------------------------
'描述: 读取当前IP地址
'-------------------------------------------------
Function GetIP()			
	GetIp = Request.ServerVariables("HTTP_X_FORWARDED_FOR") 
	If GetIp = "" Then GetIp = Request.ServerVariables("REMOTE_ADDR") 
End Function
'-------------------------------------------------
'描述: HTML代码转换
'-------------------------------------------------
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 
	set Matches=nothing
End Function 
''''''''''''''''''''''''''''''''''
Function EnCodeHtml(str)
	str = Replace(str, vbcrlf, "<br />")
	str = Replace(str, "　", "&nbsp;&nbsp;")
	str = Replace(str, " ", "&nbsp;")
	Str = Replace(Str, ">", "&gt;")
	Str = Replace(Str, "<", "&lt;")
	EnCodeHtml = str
End Function
''''''''''''''''''''''''''''''''''
Function DeCodeHtml(str)
	Str = Replace(Str, "&gt;", ">")
	Str = Replace(Str, "&lt;", "<")
	str = Replace(str, "&nbsp;", " ")
	str = Replace(str, "&nbsp;&nbsp;", "　")
	DeCodeHtml = str
End Function
''''''''''''''''''''''''''''''''''
Function ShowHtml(str)
	Str = Replace(Str, "&gt;", ">")
	Str = Replace(Str, "&lt;", "<")
	str = Replace(str, "&nbsp;", " ")
	str = Replace(str, "&nbsp;&nbsp;", "　")
	ShowHtml = str
End Function

Function ShowMYhtml(str)
	Str = Replace(Str, "&gt;", ">")
	Str = Replace(Str, "&lt;", "<")
	str = Replace(str, "&nbsp;", " ")
	str = Replace(str, "&nbsp;&nbsp;", "　")
	Str = Replace(Str, "<div>", "")
	Str = Replace(Str, "</div>", "")
	ShowMYhtml = str
End Function
'-------------------------------------------------
'描述: 错误信息提示
'-------------------------------------------------
Function Alert(message,gourl) 
    message = replace(message,"'","\'")
    If gourl="-1" then
        Response.Write ("<script language=javascript>alert('" & message & "');history.go(-1)</script>")
    ElseIf gourl="-2" then
        Response.Write ("<script language=javascript>alert('" & message & "');history.go(-2)</script>")
    ElseIf gourl="-3" then
        Response.Write ("<script language=javascript>alert('" & message & "');window.close();</script>")
    Else
        Response.Write ("<script language=javascript>alert('" & message & "');location='" & gourl &"'</script>")
    End If
    Response.End()
End Function
'-------------------------------------------------
Function backurl(goourl) 
    If goourl="-1" then
        Response.Write ("<script language=javascript>history.go(-1)</script>")
    ElseIf goourl="-2" then
        Response.Write ("<script language=javascript>history.go(-2)</script>")
    Else
        Response.Write ("<script language=javascript>location='" & goourl &"'</script>")
    End If
    Response.End()
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''
Function GZMONRY(s)
   Response.Write FormatCurrency(s,2)
End Function
'-------------------------------------------------
'描述: 关闭数据库连接
'语法: ConnClose()
'-------------------------------------------------
Sub ConnClose()
	On Error Resume Next
	oConn.Close
	Set oConn = Nothing
	If Err Then Exit Sub
End Sub
'-------------------------------------------------
'描述: IP地址只读取前三位
'语法: HideIp(s)
'-------------------------------------------------
Function HideIp(s)
	Dim HIP
	HIP = Split(s, ".")
	HideIp = HIP(0) & "." & HIP(1) & "." & HIP(2) & ".***"
End Function
'-----------------------------------------
'描述: 时间格式转换
'-----------------------------------------
Function GetCount2(i)
   GetCount2 = Replace(Space(2-Len(i)), " ", "0") & i
End Function
Function FormatTime(DateTime,Format)
If DateTime="" Then DateTime="2012-6-23 下午 06:22:44"
  select case Format
  case "1"
    FormatTime=""&year(DateTime)&"年"&month(DateTime)&"月"&day(DateTime)&"日"
  case "2"
    FormatTime=""&month(DateTime)&"月"&day(DateTime)&"日"
  case "3" 
    FormatTime=""&year(DateTime)&"-"&month(DateTime)&"-"&day(DateTime)&""
  case "4"
    FormatTime=""&month(DateTime)&"-"&day(DateTime)&""
  case "5"
    FormatTime=""&month(DateTime)&"月"&day(DateTime)&"日 "&FormatDateTime(DateTime,4)&""
  case "7" 
    FormatTime=""&year(DateTime)&""&GetCount2(month(DateTime))&""&GetCount2(day(DateTime))&""
  case "8"
    FormatTime="["&month(DateTime)&"-"&day(DateTime)&"]"
   case "9"
    FormatTime=""&month(DateTime)&"/"&day(DateTime)&"/"&FormatDateTime(DateTime,4)&""
  case "10" 
    FormatTime=""&month(DateTime)&"/"&day(DateTime)&"/"&year(DateTime)&""
  case "6"
	Dim temp
	temp="周日,周一,周二,周三,周四,周五,周六"
	temp=split(temp,",") 
	FormatTime=temp(Weekday(DateTime)-1)
case Else
FormatTime=DateTime
end select
End Function
'=================================================
'JmailSend
'=================================================
function JmailSend(Subject,Body,isHtml,HtmlBody,MailTo,FromName,Smtp,From,Username,Password)
dim JmailMsg
set JmailMsg=server.createobject("jmail.message")
JmailMsg.mailserverusername=Username
JmailMsg.mailserverpassword=Password

JmailMsg.addrecipient MailTo
JmailMsg.from=From
JmailMsg.fromname=FromName

JmailMsg.charset="gb2312"
JmailMsg.logging=true
JmailMsg.silent=true 

JmailMsg.subject=Subject
JmailMsg.body=Body
if isHtml=true then JmailMsg.htmlbody=HtmlBody
if not JmailMsg.send(Smtp) then
JmailSend="N"
else
JmailSend="Y"
end if
JmailMsg.close
set JmailMsg=nothing
end function
'=================================================
'分页函数Showpage
'=================================================
Sub Showpage(purl,nber)
If purl = "1" Then
	page = request("page")						'page的传递参数
	total=oRs.recordcount 						'读取信息数目
	oRs.PageSize=nber							'设置页码 
	pagecount=oRs.PageCount 					'获取总页码 
	page=int(page)								'接收页码 
	if page<=0 then page=1						'判断页码
	oRs.AbsolutePage=page 						'本页页码
	mypage = total-(page-1)*oRs.PageSize
	If mypage > oRs.PageSize Then
	mypage = oRs.PageSize
	Else
	mypage = total-(page-1)*oRs.PageSize
	End If
Else
	response.write "<div class='zzPage'><ul>"
	response.write "<li>共<span class='fred'>"&total&"</span>条</li><li>分<span class='fred'>"&pagecount&"</span>页</li><li>每页<span class='fred'>"&nber&"</span>条</li><li>第<span class='fred'>"&page&"</span>页</li> "
	if page=1 and not page=pagecount then
	response.write "<li>首页</li><li>上页</li><li><a href='"&purl&"&page="&page+1&"'>下页</a></li><li><a href='"&purl&"&page="&pagecount&"'>末页</a></li>"
	elseif page<>1 and not page=pagcount then
	response.write"<li><a href='"&purl&"&page=1'>首页</a></li><li><a href='"&purl&"&page="&page-1&"'>上页</a></li>"
		If page=pagecount Then
		response.write"<li>下页</li><li>末页</li>"
		Else
		response.write"<li><a href='"&purl&"&page="&page+1&"'>下页</a></li><li><a href='"&purl&"&page="&pagecount&"'>末页</a></li>"
		End If
	End If
	Response.Write "<li><a href='"&purl&"&page=1'>1</a></li>"
	If page >= 4 Then Response.Write "<li>...</li>"
	For i = page-3 To page-1
	If i<=0 Then Exit For
	If i > 1 Then Response.Write "<li><a href='"&purl&"&page="&i&"'>"&i&"</a></li>"
	Next
	If page > pagecount-3 Then Response.Write "<li>...</li>"
	For i = page To page+3
	If i > pagecount Then Exit For
	If i <= pagecount Then Response.Write "<li><a href='"&purl&"&page="&i&"'>"&i&"</a></li>"
	Next
	response.write"</ul></div>"
End If
End Sub
'=================================================
'搜索带红色
'=================================================
Function ADDRED(AAA,BBB)
ADDRED = replace(AAA, BBB, "<font color=red>"&BBB&"</font>")
End Function
'=================================================
'帮助大类
'=================================================
Function HELPTT(aaa)
If aaa ="" Then
Response.Write "所有分类"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,Atitle FROM [LstAloneT] where Id= "&aaa
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "无此分类"
	Else
		Response.write ""&oRsme(1)&""
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'产品大类
'=================================================
Function CLASSBNAME(aaa)
If aaa ="" Then
Response.Write "所有分类"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,Bigname FROM [LstProCb] where Id= "&aaa
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "无此分类"
	Else
		Response.write ""&oRsme(1)&""
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'产品小类
'=================================================
Function CLASSSNAME(aaa)
If aaa ="" Then
Response.Write "所有分类"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,SmallName FROM [LstProCs] where Id= "&aaa
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "无此分类"
	Else
		Response.write ""&oRsme(1)&""
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'产品小类
'=================================================
Function CLASSS3NAME(aaa)
If aaa ="" Then
Response.Write "所有分类"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,SmallName3 FROM [LstProCss] where Id= "&aaa
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "无此分类"
	Else
		Response.write ""&oRsme(1)&""
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'产品名称
'=================================================
Function PPPPNNNN(aaa)
If aaa ="" Then
Response.Write "所有分类"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,PTitle FROM [LstPro] where Id= "&aaa
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "无此分类"
	Else
		Response.write "<a href=/ProInfo.asp?Id="&oRsme(0)&">"&oRsme(1)&"</a>    &nbsp;"
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'处理结果
'=================================================
Function CHULINNN(lev) 
	select case lev
	case "0"
	CHULINNN="暂未处理"
	case "1"
	CHULINNN="已经发货"
	case "2"
	CHULINNN="无效订单"
	case "3"
	CHULINNN="缺货中..."
	case Else
end select
End Function

Function FAHUOS(lev) 
	select case lev
	case "0"
	FAHUOS="未发货"
	case "1"
	FAHUOS="已经发货"
	case "2"
	FAHUOS="已经收货"
	case "3"
	FAHUOS="缺货中..."
	case Else
end select
End Function
'=================================================
'降序排列
'=================================================
Function NewOrder(sz)
    Dim ali,icount,i,ii,j,itemp
    ali=split(sz,",")
    icount=UBound(ali)
    For i=0 To icount
        For j=icount - 1 To i Step -1
            If j+1 <= UBound(ali) Then '这时降序；升序把<改成>即可
                If int(ali(j))<int(ali(j+1)) Then
                    itemp=ali(j)
                    ali(j)=ali(j+1)
                    ali(j+1)=itemp
                End If
            End If
        Next
    Next
    For ii=0 to Ubound(ali)
        If ii = Ubound(ali) Then
            NewOrder = NewOrder & ali(ii)
        Else
            NewOrder = NewOrder & ali(ii) & ","
        End If
    Next
End Function
dim sj,sj1,yzm,myzm
sj = formatdatetime(now(),3)
sj1 = right(Replace(""&sj&"",":",""),4)
yzm= right((sj1*564)/342,4)
myzm= right((sj1*465456),8)
'=================================================
'生成订单号
'=================================================
function getOrdernum()
        dim yyear,mmonth,dday,min,hou,miao,ordernum
        yyear=year(now())
        mmonth=month(now())
        dday=day(now())
		hou=hour(now())
		min=minute(now())
		miao=second(now())
        if mmonth<10 then
            mmonth="0" & mmonth
        end if 
        if dday<10 then
            dday="0" & dday
        end if 
        ordernum= yyear & mmonth & dday & hou & min & miao
        getOrdernum=ordernum        '返回订单编号
end Function
'=================================================
'帮助信息
'=================================================
Function HELPSS(aaa)
If aaa ="" Then
	Response.Write "<li>没信息</li>"
else
	Dim oRsme,sqlme
	sqlme= "Select top 6 Id,Ntitle FROM [LstAlone] where Talone= "&aaa&" order by id desc"
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "<li>没信息</li>"
	Else
	While Not oRsme.EOF
		Response.Write "<li>·<a href=NewsInfo.asp?id="&oRsme(0)&">"&Left(oRsme(1),16)&"</a></li>"
	oRsme.MoveNext
	Wend
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'帮助信息3
'=================================================
Function HELPSS3(aaa)
If aaa ="" Then
	Response.Write "<li>没信息</li>"
else
	Dim oRsme,sqlme
	sqlme= "Select top 13 Id,Ntitle FROM [LstAlone] where Talone= "&aaa&" order by id desc"
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "<li>没信息</li>"
	Else
	While Not oRsme.EOF
		Response.Write "<a href=NewsInfo.asp?id="&oRsme(0)&">"&oRsme(1)&"</a>"
	oRsme.MoveNext
	Wend
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'帮助信息4
'=================================================
Function HELPSS2(aaa)
If aaa ="" Then
	Response.Write "<li>没信息</li>"
else
	Dim oRsme,sqlme
	sqlme= "Select top 5 Id,Ntitle FROM [LstAlone] where Talone= "&aaa&" order by id desc"
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "<li>没信息</li>"
	Else
	While Not oRsme.EOF
		Response.Write "<li>·<a href=NewsInfo.asp?id="&oRsme(0)&">"&Left(oRsme(1),10)&"</a></li>"
	oRsme.MoveNext
	Wend
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'产品小图片
'=================================================
Function PROPIC(aaa,bbb)
If aaa ="" Then
	Response.Write "--"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,PSmallPic,PHmoney,PSmoney,PBId FROM [LstPro] where Id= "&aaa
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "--"
	ElseIf bbb=1 Then
		Response.write "<a href=/ProInfo.asp?Id="&oRsme(0)&"><img width=""50"" height=""50"" src="&oRsme(1)&" border=""1""></a>"
	ElseIf bbb=2 Then
		Response.Write ""&oRsme(2)&""
	ElseIf bbb=3 Then
		Response.Write ""&oRsme(3)&""
	Else
		Response.Write "--"
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'用户小图片
'=================================================
Function USERPIC(aaa,bbb)
If aaa ="" Then
	Response.Write "--"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,UsrFace,UsrName FROM [LstUser] where Id= "&aaa
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "--"
	ElseIf bbb=1 Then
		Response.write "<img width=""50"" height=""50"" src="&oRsme(1)&" border=""0"">"
	Else
		Response.write ""&oRsme(2)&""
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'广告位置
'=================================================
Function BANNERSS(aaa,bbb,ccc)
If aaa ="" Then
	Response.Write "--"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,Bimg,Burl FROM [Lstbanner] where Id= "&aaa
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "--"
	Else
		Response.write "<a href="&oRsme(2)&"><img width="&bbb&" height="&ccc&" src="&oRsme(1)&" border=""0""></a>"
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'多少人购买
'=================================================
Function TUANNUM(aaa)
If aaa ="" Then
	Response.Write "0"
Else
	TUANNUM = oconn.execute("Select count(id) from LstOrder where OPro in ('"&aaa&"') ")(0)
End If
end Function
Function CHULINNN(lev) 
	select case lev
	case "0"
	CHULINNN="暂未处理"
	case "1"
	CHULINNN="已经发货"
	case "2"
	CHULINNN="无效订单"
	case "3"
	CHULINNN="缺货中..."
	case Else
end select
End Function
'=================================================
'知道编号读ID
'=================================================
Function BHID(aaa)
If aaa ="" Then
	Response.Write "0"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id FROM [LstOrder] where ONo= '"&aaa&"' "
	Set oRsme= Server.CreateObject("ADODB.Recordset")
	oRsme.open sqlme,oconn,1,1
	if oRsme.eof and oRsme.bof Then
		Response.Write "0"
	Else
		Response.write ""&oRsme(0)&""
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'星级
'=================================================
Function XXJI(lev) 
If lev = "" Then 
	Response.Write "未评分"
End If
	select case lev
	case "0"
	XXJI="未评分"
	case "1"
	XXJI="很不满意|差得太离谱，与卖家描述的严重不符，非常不满。"
	case "2"
	XXJI="不满意|部分有破损，与卖家描述的不符，不满意。"
	case "3"
	XXJI="一般|质量一般，没有卖家描述的那么好。"
	case "4"
	XXJI="满意|质量不错，与卖家描述的基本一致，还是挺满意的。"
	case "5"
	XXJI="非常满意|质量非常好，与卖家描述的完全一致，非常满意。"
	case Else
end select
End Function
%>