<%
'--JinCms Function
'--Last Update:2015-06-01
'--My Blog:www.oywork.com

'=====================================================
'获取页面URL
Function GetUrl()
	GetUrl="http://"&Request.ServerVariables("SERVER_NAME")&Request.ServerVariables("URL")
	If Request.ServerVariables("QUERY_STRING")<>"" Then GetURL=GetUrl&"?"& Request.ServerVariables("QUERY_STRING")
End Function

'=========================================================================
'简单防注入
Function request_Form(str)
	request_Form=replace(trim(request.Form(str)),"'","")
End Function
Function request_QueryString(str)
	request_QueryString=replace(trim(request.QueryString(str)),"'","")
End Function
Function request_ServerVariables()
     request_ServerVariables=Replace(Replace(Trim(Request.ServerVariables("QUERY_STRING")),"'","")," ","")
End Function

'=========================================================================
'修正图片绝对地址   解决了因为更换空间而导致图片无法显示的问题
'去掉了Upload之前的字符，包括"/"
Function sub_str(str, pstr)	'str为要截取的字符串，pstr限定的字符
    pos = instr(str, pstr)
    If pos > 0 then str = right(str, len(str) - pos + 1)
    sub_str = str
End Function
'修正图片地址,给加上"/"
Function sub_stra(str, pstr)
	sub_stra=replace(str,pstr,"/"&pstr)
End Function
'获取图片略缩图地址
Function sub_strb(str)
    pos = InStrRev(str, "/") + 1  
    s_FilePath = Left(str, pos-1)		'文件名
    s_FileName = Mid(str, pos)			'文件名
    pos = InStrRev(s_FileName, ".")		'去后缀文件名长度
    s_FileExt = Mid(s_FileName, pos)  	'文件后缀
	s_FileName = Replace(s_FileName, s_FileExt, "") & Web_EndFlag & s_FileExt  
	sub_strb = s_FilePath & s_FileName
End Function

'=========================================================================
'判断后台表单字段是否开放
Function IsProField(str)
	If Instr(Web_ProField,str)>0 Then IsProField=true else IsProField=false
End Function
Function IsWzField(str)
	If Instr(Web_WzField,str)>0 Then IsWzField=true else IsWzField=false
End Function
Function IsJobsField(str)
	If Instr(Web_JobsField,str)>0 Then IsJobsField=true else IsJobsField=false
End Function
Function IsMsgField(str)
	If Instr(Web_MsgField,str)>0 Then IsMsgField=true else IsMsgField=false
End Function
Function IsDyField(str)
	If Instr(Web_DyField,str)>0 Then IsDyField=true else IsDyField=false
End Function

'网站Url初始化
Function getPageUrl(asp,html)
	If Web_PageType=1 Then : getPageUrl=web_root&asp
	If Web_PageType=2 Then : getPageUrl=web_root&html
End Function

'获得文章内页Url
Function getNewsUrl(Id)
	If Web_PageType=1 Then getNewsUrl=web_root&"?page:Article@"&Id&""
	If Web_PageType=2 Then
		If Web_HtmlType=1 Then getNewsUrl=web_root&"Article/"&Id&".Html"
		If Web_HtmlType=2 Then getNewsUrl=web_root&"Article/"&getDate(getArticleValue(Id,"Addtime"),"YMDHMS")&".Html"
		If Web_HtmlType=3 Then 
		If getArticleValue(Id,"PageName")<>"" Then getNewsUrl=web_root&"Article/"&getArticleValue(Id,"PageName")&".Html" else getNewsUrl=web_root&"Article/"&getArticleValue(Id,"Title")&".Html"
		End If
	End If
End Function

'获得产品内页Url
Function getProUrl(Id)
	If Web_PageType=1 Then getProUrl=web_root&"?page:Product@"&Id&""
	If Web_PageType=2 Then
		If Web_HtmlType=1 Then getProUrl=web_root&"Product/"&Id&".Html"
		If Web_HtmlType=2 Then getProUrl=web_root&"Product/"&getDate(getPhotoValue(Id,"Addtime"),"YMDHMS")&".Html"
		If Web_HtmlType=3 Then 
		If getPhotoValue(Id,"PageName")<>"" Then getProUrl=web_root&"Product/"&getPhotoValue(Id,"PageName")&".Html" else getProUrl=web_root&"Product/"&getPhotoValue(Id,"Title")&".Html"
		End If
	End If
End Function

'获得分类Url
Function getClassUrl(pagename,Id)
	If Web_PageType=1 Then getClassUrl=web_root&"?page:"&pagename&"@"&Id&""
	If Web_PageType=2 Then
		If Web_HtmlType=1 Then getClassUrl=web_root&"Class"&Id&".Html"
		If Web_HtmlType=2 Then getClassUrl=web_root&pagename&".Html"
		If Web_HtmlType=3 Then 
		If getClassValue(Id,"ClassName_en")<>"Null" Then getClassUrl=web_root&pagename&".Html" else getClassUrl=web_root&getClassValue(Id,"ClassName")&".Html"
		End If
	End If
End Function

'获得招聘内页Url
Function getJobsUrl(Id)
	If Web_PageType=1 Then getJobsUrl=web_root&"?page:Job@"&Id&""
	If Web_PageType=2 Then
		If Web_HtmlType=1 Then getJobsUrl=web_root&"Job/"&Id&".Html"
		If Web_HtmlType=2 Then getJobsUrl=web_root&"Job/"&getDate(getJobsValue(Id,"Addtime"),"YMDHMS")&".Html"
		If Web_HtmlType=3 Then 
		If getJobsValue(Id,"PageName")<>"" Then getJobsUrl=web_root&"Job/"&getJobsValue(Id,"PageName")&".Html" else getJobsUrl=web_root&"Job/"&getJobsValue(Id,"Position")&".Html"
		End If
	End If
End Function

'获得单页Url
Function getJinCmsUrl(Id)
	If Web_PageType=1 Then getJinCmsUrl=web_root&"?page:JinCms@"&Id&""
	If Web_PageType=2 Then
		If Web_HtmlType=1 Then getJinCmsUrl=web_root&"JinCms/"&Id&".Html"
		If Web_HtmlType=2 Then getJinCmsUrl=web_root&"JinCms/"&getDate(getPageValue(Id,"Addtime"),"YMDHMS")&".Html"
		If Web_HtmlType=3 Then 
		If getPageValue(Id,"PageName")<>"" Then getJinCmsUrl=web_root&"JinCms/"&getPageValue(Id,"PageName")&".Html" else getJinCmsUrl=web_root&"JinCms/"&getPageValue(Id,"Title")&".Html"
		End If
	End If
End Function


'=========================================================================
'获取上一条记录
Function get_pre(tb,id,pid,wherestr)
	pid=getClassValue(pid,"ChildStr")
	If tb=1 Then : table="Jin_Article" : End If : If tb=2 Then table="Jin_Class" : End If : If tb=3 Then table="Jin_Flash" : End If : If tb=4 Then table="Jin_Page" : End If : If tb=5 Then table="Jin_Photos" : End If : If tb=6 Then table="Jin_Message" : End If : If tb=7 Then table="Jin_Jobs" : End If
	set Rs=server.CreateObject("adodb.recordset")
	Rs.open "select * from ["&table&"] where "&wherestr&" Pid in("&pid&") And sysID<"&id&" order by sysID desc",conn,1,1
	If Rs.eof and Rs.bof Then 
		get_pre = "<a href=""javascript:;"" class=""pre"">无</a>"
	Else           
		If tb=1 then get_pre="<a href="&getNewsUrl(Rs("sysID"))&" title="&Rs("Title")&" class=""pre"">"&CutStr(Rs("Title"),14)&"</a>"  
		If tb=5 then get_pre="<a href="&getProUrl(Rs("sysID"))&" title="&Rs("Title")&" class=""pre"">"&CutStr(Rs("Title"),14)&"</a>"  
		If tb=7 then get_pre="<a href="&getJobsUrl(Rs("sysID"))&" title="&Rs("Position")&" class=""pre"">招聘: "&CutStr(Rs("Position"),14)&"</a>"  
	End If
	RsClose()
End Function
'获取下一条记录
Function get_next(tb,id,pid,wherestr)
	pid=getClassValue(pid,"ChildStr")
	If tb=1 Then : table="Jin_Article" : End If : If tb=2 Then table="Jin_Class" : End If : If tb=3 Then table="Jin_Flash" : End If : If tb=4 Then table="Jin_Page" : End If : If tb=5 Then table="Jin_Photos" : End If : If tb=6 Then table="Jin_Message" : End If : If tb=7 Then table="Jin_Jobs" : End If
	set Rs=server.CreateObject("adodb.recordset")
	Rs.open "select * from ["&table&"] where "&wherestr&" Pid in("&pid&") And sysID>"&id&" order by sysID",conn,1,1
	If Rs.eof and Rs.bof Then 
		get_next = "<a href=""javascript:;"" class=""next"">无</a>"
	Else           
		If tb=1 then get_next="<a href="&getNewsUrl(Rs("sysID"))&" title="&Rs("Title")&" class=""next"">"&CutStr(Rs("Title"),14)&"</a> "
		If tb=5 then get_next="<a href="&getProUrl(Rs("sysID"))&" title="&Rs("Title")&" class=""next"">"&CutStr(Rs("Title"),14)&"</a> "
		If tb=7 then get_next="<a href="&getJobsUrl(Rs("sysID"))&" title="&Rs("Position")&" class=""next"">招聘: "&CutStr(Rs("Position"),14)&"</a>"  
	End If
	RsClose()
End Function

'=========================================================================
'获取编号
Function get_num(tablename,zdname,Prefix)  'Prefix表示编号前缀
	nowday=Year(now()) & Right("00"&Month(now()),2) & Right("00"&Day(now()),2)
	Set Rs=server.createobject("adodb.recordSet")
	Sql="select top 1 * from ["&tablename&"] where "&zdname&" like '%"&Prefix&""&nowday&"%' order by "&zdname&" desc"
	Rs.open Sql,conn,1,1
	If Rs.eof then
	pro_num= Prefix & nowday & Right( "0001", 4)
	Else
	pro_num= Right( "0000" & Right(Rs(zdname),4)+1 , 4 )
	pro_num= Prefix & nowday & pro_num
	End If
	Rs.close
	Set Rs=nothing
	get_num=pro_num
End Function

'=========================================================================
'截取字符串，支持中英文混用
Function CutStr(Str,StrLen) 
     l=Len(str) : t=0 
     For k=1 To l 
		c=AscW(Mid(str,k,1)) 
		'If c<0 Or c>255 Then t=t+2 Else t=t+1    ==== 1个中文2个字符，1个英文1个字符
		If c<0 Or c>255 Then t=t+1 Else t=t+0.5   '=== 1个中文(中文符号)1个字符，1个英文(英文符号)0.5个字符  
		If t>=StrLen Then 
			CutStr=left(Str,k)&"..." : Exit For 
		Else 
			CutStr=Str 
		End If 
     Next 
	 CutStr=Replace(Replace(Replace(Trim(CutStr),"&nbsp;",""),vbcrlf,"")," ","")
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
End Function

'========================================================================
'时间格式化
Function getDate(ExpStr,TypeStr)	' --  2015/03/12 11:53:18
	Dim DateYear,DateMonth,DateDay,DateHour,DateMinute,DateSecond
	DateYear=Year(ExpStr) : DateMonth=Month(ExpStr) : DateDay=Day(ExpStr) : DateHour=Hour(ExpStr) : DateMinute=Minute(ExpStr) : DateSecond=Second(ExpStr)
	If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
	If Len(DateDay)<2 Then DateDay="0"&DateDay
	If Len(DateHour)<2 Then DateHour="0"&DateHour	
	If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
	If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
	If TypeStr="M-D" Then getDate = DateMonth&"-"&DateDay
	If TypeStr="M/D" Then getDate = DateMonth&"/"&DateDay
	If TypeStr="Y-M-D" Then getDate = DateYear&"-"&DateMonth&"-"&DateDay
	If TypeStr="Y/M/D" Then getDate = DateYear&"/"&DateMonth&"/"&DateDay
	If TypeStr="Y-M-D H:M:S" Then getDate = DateYear&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
	If TypeStr="Y/M/D H:M:S" Then getDate = DateYear&"/"&DateMonth&"/"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
	If TypeStr="YMDHMS" Then getDate = Right(DateYear,2)&DateMonth&DateDay&DateHour&DateMinute&DateSecond
End Function

'========================================================================
'显示错误信息
Sub ShowMsg(msg,mode)	'Mod说明：0表示直接关闭提示 - 1表示返回 - 2表示提示并刷新页面
	If msg<>"" Then : Response.Write "<script language='javascript'>alert('"&msg&"');" : Else : Response.Write "<script language='javascript'>" : End If
	If mode=0 Then 
	Response.Write "window.close();</script>"
	ElseIf mode=1 Then 
	Response.Write "history.go(-1);</script>"
	ElseIf mode=2 Then 
	Response.Write "window.location=document.referrer;</script>"
	Else
	Response.Write "window.location='"&mode&"';</script>"
	End If
	Response.End()
End Sub

'========================================================================
'获取IP地址
Function getIP() 
	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 
	getIP = Trim(Mid(strIPAddr, 1, 30)) 
End Function

'========================================================================
'文字水印
Function WordWatermark(ImagePath,FontColor,FontFamily,FontSize)
	Set Image= Server.CreateObject("PeRsits.Jpeg")  ' 建立对象
	Image.Open server.mappath(ImagePath)  ' 图片所在位置
	Image.Canvas.Font.Color =  FontColor ' 颜色,这里是设置成:黑 
	Image.Canvas.Font.Family = FontFamily  ' 设置字体 
	Image.Canvas.Font.Bold = False '是否设置成粗体 
	Image.Canvas.Font.Size = FontSize '字体大小 
	Image.Canvas.Font.Quality = 10 ' 文字清晰度
	Image.Canvas.Print Image.OriginalWidth-210,Image.OriginalHeight-50, "@一捧阳光"   '水印文字
	Image.Save server.mappath(ImagePath)  '保存文件
	Set Image= Nothing
End Function
'图片水印
Function ImageWatermark(ImagePath)
    Set Image = Server.CreateObject("PeRsits.Jpeg")
    PhotoPath = Server.MapPath(ImagePath)	'确定要加入水印的图片路径
    Image.Open PhotoPath	'打开水印图片
    Set Logo = Server.CreateObject("PeRsits.Jpeg")
    LogoPath = Server.MapPath("/Images/Watermark.jpg") '水印的图片  请使用jpg格式图片 不要使用png格式图片！！
    Logo.Open LogoPath    
    Logo.Width = 120 '水印图片的大小
    Logo.Height = 35
    Transition_Color = &h0066cc
    '将水印放置于上传图片中
    Image.DrawImage Image.width-120, Image.height-35, Logo,1,Transition_Color,100
	'在这里可以更改水印所在的位置（photo.width-210,photo.height-40 这里我是放在了图片的右下角）还可以更改水印的透明度 
    Image.Save Server.MapPath(ImagePath)	'保存增加水印后的图片
	Set Photo = Nothing
End Function  

'========================================================================
'生成缩略图
Function BuildSmallPic(s_OriginalPath, s_BuildBasePath, n_MaxWidth, n_MaxHeight)  '生成略缩图并返回信息 
    Err.Clear : On Error Resume Next  
    '检查组件是否已经注册  
    Dim AspJpeg  
    Set AspJpeg = Server.Createobject("Persits.Jpeg")  
    If Err.Number <> 0 Then : Err.Clear : BuildSmallPic = "Error_01" : Exit Function : End If  
    '检查原图片是否存在  
    Dim s_MapOriginalPath  
    s_MapOriginalPath = Server.MapPath(s_OriginalPath)  
    AspJpeg.Open s_MapOriginalPath	'打开原图片  
    If Err.Number <> 0 Then : Err.Clear : BuildSmallPic = "Error_02" : Exit Function : End If  
    '按比例取得缩略图宽度和高度  
    Dim n_OriginalWidth, n_OriginalHeight	'原图片宽度、高度  
    Dim n_BuildWidth, n_BuildHeight	'缩略图宽度、高度  
    Dim div1, div2 , n1, n2  
    n_OriginalWidth = AspJpeg.Width : n_OriginalHeight = AspJpeg.Height : div1 = n_OriginalWidth / n_OriginalHeight : div2 = n_OriginalHeight / n_OriginalWidth : n1 = 0 : n2 = 0  
    If n_OriginalWidth > n_MaxWidth Then : n1 = n_OriginalWidth / n_MaxWidth : Else : n_BuildWidth = n_OriginalWidth : End If  
    If n_OriginalHeight > n_MaxHeight Then : n2 = n_OriginalHeight / n_MaxHeight : Else : n_BuildHeight = n_OriginalHeight : End If  
    If n1 <> 0 Or n2 <> 0 Then : If n1 > n2 Then : n_BuildWidth = n_MaxWidth : n_BuildHeight = n_MaxWidth * div2 : Else : n_BuildWidth = n_MaxHeight * div1 : n_BuildHeight = n_MaxHeight : End If : End If  
    '指定宽度和高度生成  
    AspJpeg.Width = n_BuildWidth : AspJpeg.Height = n_BuildHeight  
    '--将缩略图存盘开始--  
    Dim pos, s_OriginalFileName, s_OriginalFileExt '位置、原文件名、原文件扩展名  
    pos = InStrRev(s_OriginalPath, "/") + 1  
    s_OriginalFileName = Mid(s_OriginalPath, pos)  
    pos = InStrRev(s_OriginalFileName, ".")  
    s_OriginalFileExt = Mid(s_OriginalFileName, pos)  
    Dim s_MapBuildBasePath, s_MapBuildPath, s_BuildFileName '缩略图绝对路径、缩略图文件名 
    If Right(s_BuildBasePath, 1) <> "/" Then s_BuildBasePath = s_BuildBasePath & "/"  
    s_MapBuildBasePath = Server.MapPath(s_BuildBasePath)    
    s_BuildFileName = Replace(s_OriginalFileName, s_OriginalFileExt, "") & Web_EndFlag & s_OriginalFileExt  
    s_MapBuildPath = s_MapBuildBasePath & "\" & s_BuildFileName  
      
    AspJpeg.Save s_MapBuildPath '保存  
    If Err.Number <> 0 Then : Err.Clear : BuildSmallPic = "Error_03" : Exit Function : End If	'将缩略图存盘结束 
    Set AspJpeg = Nothing	'注销实例  
    If Err.Number <> 0 Then : BuildSmallPic = "Error_Other" : Err.Clear : End If  
    BuildSmallPic = s_BuildBasePath & s_BuildFileName  
End Function  
Sub getSmallPic(sOriginalPath,savePath,width,height)  '生成略缩图并返回详细信息	
	'sOriginalPath原图路劲  savePath略缩图保存位置  EndFlag略缩图后缀  width略缩图宽度  height略缩图高度   
	sReturnInfo = BuildSmallPic(sOriginalPath, savePath , width , height)  
	'Response.Write "返回信息:" & sReturnInfo & "<br/>"  
	If InStr(sReturnInfo, "Error_") <= 0 Then  
		sSmallPath = sReturnInfo '返回信息就是   
	Else  
		Response.Write "详细错误:"   
		Select Case sReturnInfo  
		Case "Error_01" : Response.Write "<font color='red'>创建AspJpeg组件失败,没有正确安装注册该组件</font>" & "<br/>"  
		Case "Error_02" : Response.Write "<font color='red'>原图片不存在,检查s_OriginalPath参数传入值</font>" & "<br/>"  
		Case "Error_03" : Response.Write "<font color='red'>缩略图存盘失败.可能原因:缩略图保存基地址不存在,检查s_OriginalPath参数传入值;对目录没有写权限;磁盘空间不足</font>" & "<br/>"  
		Case "Error_Other" : Response.Write "<font color='red'>未知错误</font>" & "<br/>"  
		End Select  
		Response.End  
	End If 
End Sub  
'--call getSmallPic("../../Images/Nopic.jpg", "../../", 200, 100)


'最简单生成略缩图
Function getSmallPic1(pic,smallpic)
	Dim Jpeg ''''//声明变量 
	Set Jpeg = Server.CreateObject("Persits.Jpeg") ''''//调用组件 
	Jpeg.Open Server.MapPath("/test.jpg") ''''//原图位置 
	Jpeg.Width = Jpeg.OriginalWidth/4 ''''//设图片宽度为原图的四分之一 
	Jpeg.Height = Jpeg.OriginalHeight/4 ''''//设图片高度为原图的四分之一 
	Jpeg.Sharpen 1, 130 ''''//设定锐化效果 
	Jpeg.Save Server.MapPath("/test_small1.jpg") ''''//生成缩略图位置及名称 
	Set Jpeg = Nothing ''''//注销组件，释放资源 
	Response.Write "<img src=/test_small1.jpg>" ''''//在该页显示生成缩略图
End Function   

'简单的删除文件功能
Sub FileDeleting(FileFullPath)
	If(FileFullPath<>"" and FileFullPath<>"../" and instr(FileFullPath,".")<>-1) then
		Set fs=Server.CreateObject("Scripting.FileSystemObject") 
		If fs.FileExists(server.MapPath(FileFullPath)) then
			fs.DeleteFile(server.MapPath(FileFullPath))
		Else
			'say("文件不存在！"&FileFullPath)
		End If
		Set fs=nothing
	End If
End Sub

'========================================================================
'分页函数    Edit By Jin    2015-03-12 16:13 
'太长看的累，然后我就缩了，一开始缩了一段，看着很累，又不想还原，然后…… 缩的根本停不下来
'最后缩成这样了，建议此段分页函数能不改就别改了，省电脑细胞……
Function ShowPages(Pages,Page,Url)	'Pages总页数    Page当前页数    Url页面Url
	Dim i,Str,FrontStr,BackStr,ShowStr,StartNum,EndNum
	If Replace(Url,"?","")<>Url Then : Url=Url & "&page=" : Else : Url=Url & "?page=" : End If
	If Page<2 Then : FrontStr="<li class=""paginItem""><a><span class=""pagepre""></span></a></li>" : Else : FrontStr="<li class=""paginItem""><a href=""" & Url & Page-1 & """><span class=""pagepreo""></span></a></li>" : End If
	If Page>Pages-1 Then : BackStr="<li class=""paginItem""><a><span class=""pagenxt""></span></a></li>" : Else : BackStr="<li class=""paginItem""><a href=""" & Url & Page+1 & """><span class=""pagenxto""></span></a></li>" : End If
	If Pages<=1 Then : ShowPages="" : Exit Function : End If
	If Pages<=8 Then : For i=1 To Pages : If i<>Page Then : ShowPages=ShowPages & "<li class=""paginItem""><a href="""& Url & i & """>" & i & "</a></li> " : Else : ShowPages=ShowPages & "<li class=""paginItem current""><a href="""& Url & i & """>" & i & "</a></li>" : End If : Next : ShowPages=FrontStr & " " &  ShowPages & " " & BackStr : Exit Function : End If
	If Pages>8 Then : StartNum=Page-5 : EndNum=StartNum+7 : If StartNum<=0 Then : StartNum=1 : EndNum=StartNum+7 : End If : If EndNum>Pages Then : EndNum=Pages : StartNum=EndNum-7 : End If : For i=StartNum To EndNum : If i<>Page Then : If i=Pages Then : ShowPages=ShowPages & "<li class=""paginItem""><a href=""" & Url & Pages & """>" & Pages & "</a></li>" : ShowPages=ShowPages & "<li class=""paginItem""><a href=""" & Url & Page+1 & """><span class=""pagenxto""></span></a></li>" : Else : ShowPages=ShowPages & "<li class=""paginItem""><a href=""" & Url & i & """>" & i & "</a> " : End If : Else : If i=Pages Then : ShowPages=ShowPages & "<li class=""paginItem current""><a href=""javascript:;"">" & Pages & "</a></li>" : ShowPages=ShowPages & "<li class=""paginItem""><a href=""javascript:;""><span class=""pagenxt""></span></a></li>" : Else : ShowPages=ShowPages & "<li class=""paginItem current""><a href=""javascript:;"">" & i & "</a></li> " : End If : End If : Next : ShowPages=FrontStr & " " & ShowPages : If EndNum<Pages Then : ShowPages=ShowPages & "<li class=""paginItem more""><a>...</a></li><li class=""paginItem""><a href=""" & Url & Pages & """>" & Pages & "</a></li><li class=""paginItem""><a href=""" & Url & Page+1 & """><span class=""pagenxto""></span></a></li>" : End If : End If
End Function

Function ShowPagesA(Pages,Page,Url)	'Pages总页数    Page当前页数    Url页面Url
	If Web_PageType=1 Then Url=Url:Suffix=""
	If Web_PageType=2 Then Urla=split(Url,":")(1) : Url=split(Urla,"@")(0)&"_" : Suffix=".Html"
	If Page<2 Then : FrontStr="<li class=""paginItem""><a><span class=""pagepre""></span></a></li>" : Else : FrontStr="<li class=""paginItem""><a href=""" & Url & Page-1 & Suffix & """><span class=""pagepreo""></span></a></li>" : End If
	If Page>Pages-1 Then : BackStr="<li class=""paginItem""><a><span class=""pagenxt""></span></a></li>" : Else : BackStr="<li class=""paginItem""><a href=""" & Url & Page+1 & Suffix & """><span class=""pagenxto""></span></a></li>" : End If
	If Pages<=1 Then : ShowPagesA="" : Exit Function : End If
	If Pages<=8 Then : For i=1 To Pages : If i<>Page Then : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href="""& Url & i & Suffix & """>" & i & "</a></li> " : Else : ShowPagesA=ShowPagesA & "<li class=""paginItem current""><a href="""& Url & i & Suffix & """>" & i & "</a></li>" : End If : Next : ShowPagesA=FrontStr & " " &  ShowPagesA & " " & BackStr : Exit Function : End If
	If Pages>8 Then : StartNum=Page-5 : EndNum=StartNum+7 : If StartNum<=0 Then : StartNum=1 : EndNum=StartNum+7 : End If : If EndNum>Pages Then : EndNum=Pages : StartNum=EndNum-7 : End If : For i=StartNum To EndNum : If i<>Page Then : If i=Pages Then : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href=""" & Url & Pages & Suffix & """>" & Pages & "</a></li>" : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href=""" & Url & Page+1 & Suffix & """><span class=""pagenxto""></span></a></li>" : Else : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href=""" & Url & i & Suffix & """>" & i & "</a> " : End If : Else : If i=Pages Then : ShowPagesA=ShowPagesA & "<li class=""paginItem current""><a href=""javascript:;"">" & Pages & "</a></li>" : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href=""javascript:;""><span class=""pagenxt""></span></a></li>" : Else : ShowPagesA=ShowPagesA & "<li class=""paginItem current""><a href=""javascript:;"">" & i & "</a></li> " : End If : End If : Next : ShowPagesA=FrontStr & " " & ShowPagesA : If EndNum<Pages Then : ShowPagesA=ShowPagesA & "<li class=""paginItem more""><a>...</a></li><li class=""paginItem""><a href=""" & Url & Pages & Suffix & """>" & Pages & "</a></li><li class=""paginItem""><a href=""" & Url & Page+1 & Suffix & """><span class=""pagenxto""></span></a></li>" : End If : End If
End Function

Function ShowPagesB(Pages,Page,Url)	'Pages总页数    Page当前页数    Url页面Url     =====================备份！ 20150428
	If Page<2 Then : FrontStr="<li class=""paginItem""><a><span class=""pagepre""></span></a></li>" : Else : FrontStr="<li class=""paginItem""><a href=""" & Url & Page-1 & """><span class=""pagepreo""></span></a></li>" : End If
	If Page>Pages-1 Then : BackStr="<li class=""paginItem""><a><span class=""pagenxt""></span></a></li>" : Else : BackStr="<li class=""paginItem""><a href=""" & Url & Page+1 & """><span class=""pagenxto""></span></a></li>" : End If
	If Pages<=1 Then : ShowPagesA="" : Exit Function : End If
	If Pages<=8 Then : For i=1 To Pages : If i<>Page Then : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href="""& Url & i & """>" & i & "</a></li> " : Else : ShowPagesA=ShowPagesA & "<li class=""paginItem current""><a href="""& Url & i & """>" & i & "</a></li>" : End If : Next : ShowPagesA=FrontStr & " " &  ShowPagesA & " " & BackStr : Exit Function : End If
	If Pages>8 Then : StartNum=Page-5 : EndNum=StartNum+7 : If StartNum<=0 Then : StartNum=1 : EndNum=StartNum+7 : End If : If EndNum>Pages Then : EndNum=Pages : StartNum=EndNum-7 : End If : For i=StartNum To EndNum : If i<>Page Then : If i=Pages Then : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href=""" & Url & Pages & """>" & Pages & "</a></li>" : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href=""" & Url & Page+1 & """><span class=""pagenxto""></span></a></li>" : Else : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href=""" & Url & i & """>" & i & "</a> " : End If : Else : If i=Pages Then : ShowPagesA=ShowPagesA & "<li class=""paginItem current""><a href=""javascript:;"">" & Pages & "</a></li>" : ShowPagesA=ShowPagesA & "<li class=""paginItem""><a href=""javascript:;""><span class=""pagenxt""></span></a></li>" : Else : ShowPagesA=ShowPagesA & "<li class=""paginItem current""><a href=""javascript:;"">" & i & "</a></li> " : End If : End If : Next : ShowPagesA=FrontStr & " " & ShowPagesA : If EndNum<Pages Then : ShowPagesA=ShowPagesA & "<li class=""paginItem more""><a>...</a></li><li class=""paginItem""><a href=""" & Url & Pages & """>" & Pages & "</a></li><li class=""paginItem""><a href=""" & Url & Page+1 & """><span class=""pagenxto""></span></a></li>" : End If : End If
End Function

'========================================================================
'分页附属函数集
'值数字化
Function Cnum(Num)
	If IsNumeric(Num) Then Cnum=Clng(Num) Else Cnum=0 End If
End Function
'去漏洞查询
Function sqlshow(Str)
	sqlshow=Replace(Str,"'","''")
End Function
'求两数大或小
Function Max(Num1,Num2)
	If Num1>Num2 Then Max=Num1 Else Max=Num2 End If
End Function
Function Min(Num1,Num2)
	If Num1>Num2 Then Min=Num2 Else Min=Num1 End If
End Function

'========================================================================
'Jmail邮件发送	'亲测正常
Function Send_Mail(Send_domain,Send_name,Send_email,Send_password,to_email,to_name,email_title,email_content,test)
	On Error Resume Next
	Set Jmail=server.createobject("Jmail.Message")
	Jmail.ChaRSet = "utf-8"							'发送编码  
	JMail.logging = true							'启用邮件日志 
	Jmail.ContentTransferEncoding="base64"   
	Jmail.Encoding="base64"   
	Jmail.ISOEncodeHeadeRs=false					'是否将信头编码成iso-8859-1字符集. 缺省是True
	jmail.ContentType="text/html"					'如果发内嵌附件一定要注释掉这行，重要！	'jmail.ContentType="multipart/mixed" '   
	Jmail.Silent=true                               '如果JMail.silent设置为true,ErrorCode包含的是错误代码
	Jmail.Priority=3                                '邮件等级，1为加急，3为普通，5为低级	
	Jmail.MailServerUserName =Send_email            '邮箱用户名,需要根据实际修改'
	Jmail.MailServerPassword =Send_password         '邮箱密码,需要根据实际修改'
	Jmail.From =Send_email                          '发件人邮箱
	JMail.FromName =Send_name						'发送者姓名  	
	Jmail.Subject=email_title						'发件主题
	Jmail.AddRecipient to_email,to_name 			'收件人地址，姓名  
	JMail.AddRecipientCC "",""						'邮件抄送人的地址，姓名 	
	JMail.HtmlBody=email_content 					'邮件内容	
	ok= Jmail.Send(Send_domain)						'ok= Jmail.Send("smtp.sina.com")   'SMTP服务器,需要根据实际修改	
	If test=1 Then
		If ok then : response.Write("<script>alert('邮箱设置成功！');history.back();</script>") : Else : response.Write("<script>alert('邮件设置错误！');history.back();</script>") : End If
	End If
	JMail.Close										'关闭对象
	Set Jmail=nothing
End Function

'========================================================================
'Html静态化函数
Function getHtml(url,filename)
    Dim Http
	Set http=Server.createobject("Microsoft.XMLHTTP")			'保险起见，写出一个服务器一般都支持的版本
	aspurl="http://"&Request.ServerVariables("HTTP_HOST") & web_root & url
	Http.open "GET",aspurl,false								'打开对象 用GET方式 等待服务器响应 
    Http.Send()
    If Http.readystate<>4 then									'如果服务器没反应,则退出函数 
        exit Function
    End If
    getHtml=BytesToBstr(Http.responseBody,"utf-8",filename)		'把得到的数据流二进制文件 转化成文本字符格式 (utf-8) 
    Set http=nothing                                            '删除对象 
    If err.number<>0 then err.Clear                             '如果有错误,清除错误 
End Function
Function BytesToBstr(body,CSet,filename)
	Dim objstream
	Set objstream = Server.CreateObject("adodb.stream")
	objstream.Type = 1											'1为二进制数据 2为文本数据
	objstream.Mode = 3											'1 adModeRead 2 adModeWrite 3 adModeReadWrite 4 ....
	objstream.Open
	objstream.Write body
	objstream.SaveToFile server.MapPath(web_root&filename),2				'保存文件
	objstream.Position = 0										'返回当前文件的文件指针位置(Position属性是只读,不能写）
	objstream.CharSet = CSet
	BytesToBstr = objstream.ReadText							'2为文本数据,所有这里读取文本
	objstream.Close
	Set objstream = nothing
End Function

'========================================================================
'URL转码
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
%>

