<%
'-------------------------------------------------
'描述: 读取当前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 GetGUID()
	Dim oTypeLib
	Set oTypeLib = CreateObject("Scriptlet.TypeLib")
	GetGUID = Trim(oTypeLib.Guid)
	'GetGUID = Mid(GetGUID, 2, Len(GetGUID) - 4)
	GetGUID = Mid(oTypeLib.Guid,2,36)
	GetGUID = Replace(GetGUID,"-","")
	GetGUID = LCase(GetGUID)
End Function
Dim sGuid,sGlen
sGuid = GetGuid()
sGlen = len(sGuid)
'-------------------------------------------------
'描述: 全球唯一标识码II
'-------------------------------------------------
Function LtGetGUID()
	Dim oTypeLib
	Set oTypeLib = CreateObject("Scriptlet.TypeLib")
	LtGetGUID = Trim(oTypeLib.Guid)
	LtGetGUID = Mid(oTypeLib.Guid,2,12)
	LtGetGUID = Replace(LtGetGUID,"-","")
	'LtGetGUID = LCase(LtGetGUID)
End Function
Function LtGetGUID2()
	Dim oTypeLib
	Set oTypeLib = CreateObject("Scriptlet.TypeLib")
	LtGetGUID2 = Trim(oTypeLib.Guid)
	LtGetGUID2 = Mid(oTypeLib.Guid,6,20)
	LtGetGUID2 = Replace(LtGetGUID2,"-","")
	LtGetGUID2 = LCase(LtGetGUID2)
End Function
Dim slGuid,slGuid2
slGuid = LtGetGUID()
slGuid2 = LtGetGUID2()
'-------------------------------------------------
'描述: 关闭数据库连接
'语法: 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
	FormatTime=""
End If
  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
'=================================================
'分页函数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 "<table>"
	response.write "<td>共<span class='fred'>"&total&"</span>条</td><td>分<span class='fred'>"&pagecount&"</span>页</td><td>每页<span class='fred'>"&nber&"</span>条</td><td>第<span class='fred'>"&page&"</span>页</td> "
	if page=1 and not page=pagecount then
	response.write "<td>首页</td><td>上页</td><td><a href='"&purl&"&page="&page+1&"'>下页</a></td><td><a href='"&purl&"&page="&pagecount&"'>末页</a></td>"
	elseif page<>1 and not page=pagcount then
	response.write"<td><a href='"&purl&"&page=1'>首页</a></td><td><a href='"&purl&"&page="&page-1&"'>上页</a></td>"
		If page=pagecount Then
		response.write"<td>下页</td><td>末页</td>"
		Else
		response.write"<td><a href='"&purl&"&page="&page+1&"'>下页</a></td><td><a href='"&purl&"&page="&pagecount&"'>末页</a></td>"
		End If
	End If
	response.write"</table>"
End If
End Sub
'=================================================
'搜索带红色
'=================================================
Function ADDRED(AAA,BBB)
ADDRED = replace(AAA, BBB, "<font color=red>"&BBB&"</font>")
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 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 ""&oRsme(1)&""
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
'=================================================
'帮助大类
'=================================================
Function CLASSHELP(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 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
sj = formatdatetime(now(),3)
sj1 = right(Replace(""&sj&"",":",""),4)
yzm= right((sj1*564)/342,4)
'=================================================
'生成订单号
'=================================================
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 10 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),12)&"</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 CHULINNN(lev) 
	select case lev
	case "0"
	CHULINNN="<b style=""color:blue"">暂未处理</b>"
	case "1"
	CHULINNN="<b style=""color:red"">已经发货</b>"
	case "2"
	CHULINNN="<del><b style=""color:#747474;"">无效订单</b></del>"
	case "3"
	CHULINNN="<del><b style=""color:#85886E;"">缺货中..</b></del>"
	case Else
end select
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 CLASSSNAME3(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 FAHUOS(lev) 
	select case lev
	case "0"
	FAHUOS="未发货"
	case "1"
	FAHUOS="已经发货"
	case "2"
	FAHUOS="已经收货"
	case "3"
	FAHUOS="缺货中..."
	case Else
end select
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 SMALLNAME(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 TUANNUM(aaa)
If aaa ="" Then
	Response.Write "0"
Else
	TUANNUM = oconn.execute("Select count(id) from LstOrderTuan where OPro= "&aaa&" ")(0)
End If
end Function
'=================================================
'会员姓名
'=================================================
Function USERNAME(aaa)
If aaa ="" Then
	Response.Write "--"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,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 "--"
	Else
		Response.write ""&oRsme(1)&""
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function
Function PPPPMMMM(aaa)
If aaa ="" Then
Response.Write "所有分类"
else
	Dim oRsme,sqlme
	sqlme= "Select TOP 1 Id,PHmoney 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 ""&oRsme(1)&""
	End if
	oRsme.close
	set oRsme=Nothing
End If
end Function


function SaveFile(LocalFileName,RemoteFileUrl) 
Dim Ads, Retrieval, GetRemoteData 
On Error Resume Next 
Set Retrieval = Server.CreateObject("Microso" & "ft.XM" & "LHTTP") 
With Retrieval 
.Open "Get", RemoteFileUrl, False, "", "" 
.Send 
GetRemoteData = .ResponseBody 
End With 
Set Retrieval = Nothing 
Set Ads = Server.CreateObject("Ado" & "db.Str" & "eam") 
With Ads 
.Type = 1 
.Open 
.Write GetRemoteData 
.SaveToFile Server.MapPath(LocalFileName), 2 
.Cancel() 
.Close() 
End With 
Set Ads=nothing 
If err <> 0 then 
SaveFile = false 
err.clear 
Else 
SaveFile = true 
End If 
End Function





sub deletefile(struploadfiles) 
	if struploadfiles="" then exit sub
	dim fso,arruploadfiles,i
	set fso = createobject("scripting.filesystemobject")
	if fso.FileExists(server.mappath("" & struploadfiles)) then
	fso.deletefile(server.mappath("" & struploadfiles))
	'Response.Write "·"&struploadfiles&"<span style=""color:#00A60C"">删除成功o(∩_∩)o</span>"
	Else
	'Response.Write "⊙_⊙_" 
	End If
	set fso = nothing
end sub 
%>