<%
'*********************************************************
'File: 			Inc_Functions.asp
'Description:	公用函数模块 For oBlog4.0
'Author: 		阿泰 
'Copyright:		http://www.oblog.cn
'LastUpdate:	20060405
'*********************************************************
'此处为非Bool型判断，也可以用于基本的Bool型判定
'如果目标值为空或者Null,则指定一个默认值,不指定则默认为空
Function ob_IIF(byval var1,byval dValue)
	Dim sReturn
	If IsNull(var1) Then
		sReturn=""
	Else
		sReturn=Trim(var1)
	End If
	If sReturn="" Then sReturn=dValue
	ob_IIF=sReturn
End Function

'此处用于布尔型判断，如果为真，则设置为A，否则设置为B
'如果目标值为空或者为Null，则默认为false
Function ob_IIF2(byval var1,byval dValue1,byval dValue2)
	Dim bValue,sReturn
	If IsNull(var1) Or var1="" Then
		bValue=false
	Else
		If var1="0" or var1=false Then
			bValue=false
		Else
			bValue=true
		End If
	End If
	If bValue Then
		sReturn=dValue1
	Else
		sReturn=dValue2
	End If
	ob_IIF2=sReturn
End Function

'根据纪录集过滤获得指定值
Function GetRsValue(byval rst1,field1,field2,value1,type1)
	rst1.Filter=""
	If rst1.Eof Then Exit Function
	rst1.Movefirst
	If rst1.Eof Then
		GetRsValue=""
	Else
		'数值型
		If type1="0" Or type1="" Then
			rst1.Filter=field1 & "=" & value1
		'字符型
		Else
			rst1.Filter=field1 & "='" & value1 & "'"
		End If
		If Not rst1.Eof Then
			GetRsValue=rst1(field2)
		Else
			GetRsValue=""
		End If
	End if
End Function

'调试模式
Sub OB_Debug(str,iend)
	Response.Write "---------------------------------调试信息开始---------------------------------<br/>"
	If IsNull(str) Then
		Response.Write "值为Null"
	Else
		If str="" Then
			Response.Write "系统提示：执行到这里来了"
		Else
			Response.Write str
		End if
	End If
	Response.Write "<p>调试时间:" & Now & "</p>"
	Response.Write "<br/>---------------------------------调试信息结束---------------------------------"
	If iend="1" Then Response.End	
End Sub

Sub ReturnClientMsg(byval divid,byval msg,byval iferr)
	Dim sReturn
	sReturn= "<script language=javascript>if(chkdiv("""& divid &""")==true) { document.getElementById(""" & divid &""").innerHTML="""& msg &""";}</script>"
End Sub


Function ob_Int(sInt)
	If IsNull(sInt) Or IsEmpty(sInt) Or Len(sInt)=0 Or Not IsNumeric(sInt) Then 
		ob_Int=""
		Exit Function 
	End If
	'Not support with dot.
	If InStr(sInt,".")>0 Then 
		ob_Int=""
		Exit Function
	End If
	ob_Int=Int(sInt)
End Function

Function unHtml(content)
    On Error Resume Next
    unHtml = content
    If content <> "" Then
        unHtml = Server.HTMLEncode(unHtml)
        unHtml = Replace(unHtml, vbCrLf, "<br>")
        unHtml = Replace(unHtml, Chr(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
        unHtml = Replace(unHtml, " ", "&nbsp;")
        unHtml = Replace(unHtml, "&", "")
        unHtml = Replace(unHtml, "?", "")
    End If
End Function

'x<60     -Minutes
'60<=x<1440 -Hours
'x>=24 -Days
'Response.Write FmtMinutes("2006-4-30 12:21")
Function FmtMinutes(sTime)
	Dim i,j,sReturn,iMinutes
	'iMinutes=Datediff("n",sTime,ServerTime(Now))
	If IsNull(sTime) Or sTime="" Then 
		FmtMinutes="-"
		Exit Function
	End If
	iMinutes=Datediff("n",sTime,Now)
	If iMinutes<60 Then 
		FmtMinutes=iMinutes & "分钟"
		Exit Function
	End If
	i=iMinutes Mod 60
	j=iMinutes \ 60
	If j<24 Then
		FmtMinutes=j & "小时"' & i & "&nbsp;分钟"
	Else
		'Re do
		i = i Mod 24
		j = j \ 24
		FmtMinutes=j & "天"' & i & "&nbsp;小时"
	End If	
End Function

'------------------------------------------------
'EncodeJP(byval strContent)
'日文编码
'10k文章编码过程小于0.01秒，不会影响到执行效率
'目前需要更新的位置为：
'站点配置里的各个项目：名称、描述
'发布文章时的标题、内容、关键字
'发布留言/评论时的内容
'搜索时对关键字进行编码
'暂时不考虑注册名问题
'可与其他函数配合使用
'------------------------------------------------
Function EncodeJP(byval strContent)

	If strContent="" Then Exit Function
	
	'SQL版本不进行编码
	If IS_SQLDATA=1 Then 
		EncodeJP=strContent
		Exit Function
	End If
	
	strContent=Replace(strContent,"ガ","&#12460;")
    strContent=Replace(strContent,"ギ","&#12462;")
    strContent=Replace(strContent,"グ","&#12464;")
    strContent=Replace(strContent,"ア","&#12450;")
    strContent=Replace(strContent,"ゲ","&#12466;")
    strContent=Replace(strContent,"ゴ","&#12468;")
    strContent=Replace(strContent,"ザ","&#12470;")
    strContent=Replace(strContent,"ジ","&#12472;")
    strContent=Replace(strContent,"ズ","&#12474;")
    strContent=Replace(strContent,"ゼ","&#12476;")
    strContent=Replace(strContent,"ゾ","&#12478;")
    strContent=Replace(strContent,"ダ","&#12480;")
    strContent=Replace(strContent,"ヂ","&#12482;")
    strContent=Replace(strContent,"ヅ","&#12485;")
    strContent=Replace(strContent,"デ","&#12487;")
    strContent=Replace(strContent,"ド","&#12489;")
    strContent=Replace(strContent,"バ","&#12496;")
    strContent=Replace(strContent,"パ","&#12497;")
    strContent=Replace(strContent,"ビ","&#12499;")
    strContent=Replace(strContent,"ピ","&#12500;")
    strContent=Replace(strContent,"ブ","&#12502;")
    strContent=Replace(strContent,"ブ","&#12502;")
    strContent=Replace(strContent,"プ","&#12503;")
    strContent=Replace(strContent,"ベ","&#12505;")
    strContent=Replace(strContent,"ペ","&#12506;")
    strContent=Replace(strContent,"ボ","&#12508;")
    strContent=Replace(strContent,"ポ","&#12509;")
    strContent=Replace(strContent,"ヴ","&#12532;")

    EncodeJP=strContent
End Function

'------------------------------------------------
'Pause(byval iCount)
'暂停功能
'用于批量转移，转换，生成过程中，防止持续耗费系统资源
'------------------------------------------------
Sub Pause()
	Dim i,lStep,iCount
	iCount=P_BLOG_UPDATEPAUSE
	'本机测试执行时间为0.03~0.05
	lStep=200000	
	'如果为0或者非数值则不限制
	If  Not IsNumeric(iCount) OR iCount=0 Then Exit Sub
	iCount=Int(iCount)
	'Response.Write timer & "<br>"
	'本机测试3~5秒
	If iCount>100 Then iCount=100
	For i=1 To iCount * lStep
	Next
	'Response.Write timer 
End Sub

'------------------------------------------------
'CheckValidEnName(byval strName)
'只允许数字(48~57)+大(65~90)小(97~122)写字母和下划线
'------------------------------------------------
Function CheckValidEnName(byval strName)
	Dim objReg
	CheckValidEnName = True
	
	If IsNull(strName) OR strName="" Then Exit Function
		
	Set objReg=New RegExp
	objReg.IgnoreCase =True
	objReg.Global=True	
	objReg.Pattern="^\w+$"
	CheckValidEnName = objReg.Test(strName)
	'如果不允许数字ID
'	If en_nameisnum=0 Then
'		If IsNumeric(strName) Then 	CheckValidEnName=False		
'	End If
	Set objReg=Nothing
End Function

'------------------------------------------------
'FilterJS(strHTML)
'过滤脚本
'------------------------------------------------
Function FilterJS(byval strHTML)
	Dim objReg,strContent		
	If IsNull(strHTML) OR strHTML="" Then Exit Function		
	Set objReg=New RegExp
	objReg.IgnoreCase =True
	objReg.Global=True
	objReg.Pattern="(&#)"
	strContent=objReg.Replace(strHTML,"")
	objReg.Pattern="(function|meta|value|window\.|script|js:|about:|file:|Document\.|vbs:|frame|cookie)"
	strContent=objReg.Replace(strContent,"")
	objReg.Pattern="(on(finish|mouse|Exit=|error|click|key|load|focus|Blur))"
	strContent=objReg.Replace(strContent,"")
	FilterJS=strContent
	strContent=""
	Set objReg=Nothing		
End Function

'------------------------------------------------
'CheckInt(byval strNumber)
'检查并转换整形值
'------------------------------------------------
Function CheckInt(byval strNumber)
	If isNull(strNumber) OR Not IsNumeric(strNumber) Then
		CheckInt=""		
	Else
		CheckInt=Int(strNumber)
	End If
End Function

'------------------------------------------------
'ProtectSql(sSql)
'用于接收地址栏参数传递时SQL组合保护
'------------------------------------------------
'防止SQL注入
Function ProtectSQL(sSql)
	If ISNull(sSql) Then Exit Function
	sSql=Trim(sSql)
	If sSql="" Then Exit Function 
	sSql=Replace(sSql,Chr(0),"")	
	sSql=Replace(sSql,"'","‘")
	sSql=Replace(sSql," ","")
	sSql=Replace(sSql,"%","％")
	sSql=Replace(sSql,"-","－")		
	ProtectSQL=sSql
End Function

'用于用户发布的各种信息过滤，带脏话过滤
Function HTMLEncode(fString)
	If Not IsNull(fString) Then
		fString = replace(fString, ">", "&gt;")
		fString = replace(fString, "<", "&lt;")
		fString = Replace(fString, CHR(32), " ")		'&nbsp;
		fString = Replace(fString, CHR(9), " ")			'&nbsp;
		fString = Replace(fString, CHR(34), "&quot;")
		'fString = Replace(fString, CHR(39), "&#39;")	'单引号过滤
		fString = Replace(fString, CHR(13), "")
		fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
		fString = Replace(fString, CHR(10), "<BR> ")
		'fString=ChkBadWords(fString)
		HTMLEncode = fString
	End If
End Function

'------------------------------------------------	
'RemoveHtml(byval strContent)
'移除HTML标记
'主要用户保存到数据库前的过滤
'------------------------------------------------	
Function RemoveHtml(byval strContent)
	Dim objReg ,strTmp
	If strContent="" OR ISNull(strContent) Then Exit Function	
	Set objReg=new RegExp
	objReg.IgnoreCase =True
	objReg.Global=True
	objReg.Pattern="<(.[^>]*)>"
	strTmp=objReg.Replace(strContent, "")
	Set objReg=Nothing
	RemoveHtml=strTmp
	strTmp=""
End Function
'------------------------------------------------	
'RemoveUBB(byval strContent)
'移除UBB标记
'主要用户保存到数据库前的过滤
'------------------------------------------------	
Function RemoveUBB(byval strContent)
	Dim objReg ,strTmp
	If strContent="" OR ISNull(strContent) Then Exit Function	
	Set objReg=new RegExp
	objReg.IgnoreCase =True
	objReg.Global=True
	objReg.Pattern="[.+?]"
	strTmp=objReg.Replace(strContent, "")
	Set objReg=Nothing
	RemoveUBB=strTmp
	strTmp=""
End Function	
'------------------------------------------------
'RedirectBy301(strURL)
'针对搜索引擎进行301重定向，立即更新目标地址
'------------------------------------------------
Sub RedirectBy301(byval strURL)
	Response.Clear
	Response.Status="301 Moved Permanently"
	Response.AddHeader "Location",strURL
	Response.End
End Sub

'------------------------------------------------
'ServerDate(byval strDate)
'服务器时差设置
'回复/留言及发表日志
'接收Trackback
'------------------------------------------------
Function ServerDate(byval strDate)
	Dim intHours
	If Not isDate(strDate) Then Exit Function
	intHours=P_Site_Hours
	If Not isNumeric(intHours) Then 
		intHours=0
		ServerDate=strDate
		Exit Function
	End If
	intHours =Int(intHours)
	If intHours>24 OR intHours<-24 Then 
		intHours=0
		ServerDate=strDate
		Exit Function
	End If
	ServerDate=Dateadd("h",intHours,strDate)	
End Function

'经测试使用此方法比include方法还要慢
Function ReadFileToString(byval oFSO,byval userpath,byval sFile)
'对目录进行处理
'该文件是从最底部开始的
'On Error Resume Next
	Dim oStream
	'处理最顶层的inc
	sFile=Replace(sFile,"..\..\..\..\","")	
	sFile=Replace(sFile,"..\inc\",userpath & "\inc\")
	sFile=Replace(sFile,"calendar\",userpath & "\calendar\")
	sFile=Replace(sFile,"subject\",userpath & "\subject\")
	sFile=Replace(sFile,"archives\",userpath & "\archives\")	
	sFile=Replace(sFile,"\\","\")
	sFile=Replace(sFile,"..\","")
	sFile=Replace(sFile,"\","/")
	sFile=Replace(sFile,"..","")
	'Response.Write "sFile:" & sFile
	'此处暂时不必判断文件是否真实存在
	Set oStream=oFSO.OpenTextFile(Server.Mappath(sFile),1,False)
	ReadFileToString = oStream.ReadAll
	Set oStream=Nothing
	'If Err.Number>0 Then ReadFileToString=""
End Function

	'获取访问者IP
	'Response.Write GetIP
	Function GetIP()
	    Dim sIP
	    If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
	        sIP = Request.ServerVariables("REMOTE_ADDR")
	    ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
	        sIP = 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
	        sIP = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
	    Else
	        sIP = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
	    End If			
	    GetIP = CheckIP(sIP)
	End Function

Function CheckIP(sIP)
	sIP=Trim(sIP)
	sIP=Replace(sIP,".",",")
	sIP=ChkIDs(sIP)
	If sIP<>"" Then sIP=Replace(sIP,",",".")
	CheckIP=sIP
End Function

Function ChkIDs(byval sIDs)
	Dim aIDs,i,sReturn
	sIDs=Trim(sIDs)
	If Len(sIDs)=0  Then Exit Function
	aIDs=Split(sIDs,",")
	For i=0 To Ubound(aIDs)
		'发现任意不符合的字符，直接跳出
		If Not IsNumeric(aIDs(i)) Then
			Exit Function
		Else
			sReturn=sReturn & "," & Int(aIDs(i))
		End If	
	Next
	If Left(sReturn,1)="," Then sReturn=Right(sReturn,Len(sReturn)-1)
	ChkIDs=sReturn	
	sReturn=""
End Function

Function FilterIDs(byval strIDs)
	Dim arrIDs,i,strReturn
	strIDs=Trim(strIDs)
	If Len(strIDs)=0  Then Exit Function
	arrIDs=Split(strIDs,",")
	For i=0 To Ubound(arrIds)
		If IsNumeric(arrIDs(i)) Then
			strReturn=strReturn & "," & Int(arrIDs(i))
		End If	
	Next
	If Left(strReturn,1)="," Then strReturn=Right(strReturn,Len(strReturn)-1)
	FilterIDs=strReturn	
End Function

Function RndPassword(myLength)
	Const minLength = 6
	Const maxLength = 12
	Randomize
	Dim X, Y, strPW
	
	If myLength = 0 Then
		Randomize
		myLength = Int((maxLength * Rnd) + minLength)
	End If

	
	For X = 1 To myLength
		Y = Int((3 * Rnd) + 1) '(1) Numeric, (2) Uppercase, (3) Lowercase
		
		Select Case Y
			Case 1
				'Numeric character
				Randomize
				strPW = strPW & CHR(Int((9 * Rnd) + 48))
			Case 2
				'Uppercase character
				Randomize
				strPW = strPW & CHR(Int((25 * Rnd) + 65))
			Case 3
				'Lowercase character
				Randomize
				strPW = strPW & CHR(Int((25 * Rnd) + 97))
		End Select
	Next
	RndPassword = strPW '& Int(rnd*timer)

End Function	

'将时间解析成字串
'0:天;1:时;2:分;3:秒
Function GetDateCode(sMode)
	Dim sReturn
	sReturn=Year(Date) & Right("0" & Month(Date),2) & Right("0" & Day(Date),2)
	Select Case sMode
		Case "1"
			sReturn=sReturn & Right("0" & Hour(Now),2)
		Case "2"
			sReturn=sReturn & Right("0" & Hour(Now),2) & Right("0" & Minute(Now),2)
		Case "3"
			sReturn=sReturn & Right("0" & Hour(Now),2) & Right("0" & Minute(Now),2) & Right("0" & Second(Now),2)
	End Select
	GetDateCode=sReturn
End Function

'将字串分解为时间
Function DeDateCode(sDateCode)
	Dim iLen,sReturn
	iLen=Len(sDateCode)
	Select Case iLen
		Case 8
			sReturn=Left(sDateCode,4) & "-" & Mid(sDateCode,5,2) & "-" & Right(sDateCode,2)
		Case 10
			sReturn=Left(sDateCode,4) & "-" & Mid(sDateCode,5,2) & "-" & Mid(sDateCode,7,2) & " " & Right(sDateCode,2)& ":00:00"
		Case 12
			sReturn=Left(sDateCode,4) & "-" & Mid(sDateCode,5,2) & "-" & Mid(sDateCode,7,2) & " " & Mid(sDateCode,9,2) & ":" &  Right(sDateCode,2)& ":00"
		Case 14
			sReturn=Left(sDateCode,4) & "-" & Mid(sDateCode,5,2) & "-" & Mid(sDateCode,7,2) & " " & Mid(sDateCode,9,2) & ":" & Mid(sDateCode,11,2) & ":" & Right(sDateCode,2)
	End Select
	If Not IsDate(sReturn) Then sReturn=""
	DeDateCode=sReturn
End Function

Sub SystemState()
	If Application(cache_name_user&"_systemstate")="stop"  Then
		If Session("adminname")="" Then
			If Right(LCase(Request.ServerVariables("SCRIPT_NAME")),16)<>"/admin_login.asp" Then
	%>
	<style type="text/css">
		.border
			{
				border: 1px dashed #000066;
			}
			.tdbg{
				background:#EEEEEE;
				line-height: 120%;
				font: normal 14px "TArial", "Helvetica", "sans-serif";
			}
			.topbg
			{
				background:#6699cc;
				color: #FFFFFF;
				font: normal 14px "TArial", "Helvetica", "sans-serif";
				text-align: center;
			
			}
			.bgcolor {
				background-color: #BFC1AE;
			}
	</style>
	<p>&nbsp; </p>
	<table width="300" border="0" align=center cellpadding="2" cellspacing="1" bgcolor="#FFFFFF" class="border">
		  	<tr align="center"> 
				<td height=25 colspan=2 class="topbg"><strong>系统暂时关闭:</strong></td>
			</tr> 
		    <tr> 
		    <td class="tdbg">
		    <%
		    If Application(cache_name_user&"_systemnote")<>"" Then
		    	Response.Write Application(cache_name_user&"_systemnote")
			Else
				Response.Write "请稍后访问，谢谢。"
			End If
		    %>
		    </td>
		  	</tr>
	 </table>
		<%	
				Response.End
			End If
		End If
	End If
End Sub

Function GetGUID()
    Dim sRet,obj
	Set obj=Server.CreateObject("Scriptlet.Typelib")
    sRet= Mid(LCase(Replace(obj.Guid,"-","")),2,32) 
    'Response.Write i &":" & sReturn & "<br>"
    Set obj=Nothing
    GetGUID=sRet
End Function

Function BytesToBstr(body,Cset)
		on error resume next
        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 = Cset
        BytesToBstr = objstream.ReadText 
        objstream.Close
        set objstream = nothing
End Function

Function PageBar(total,perpage,current,filename,seed,bShow)
	'startPage:循环开始/endPage:循环结束/totalPage:总页数
	'处理URL中的空格
	Dim sRet,i
	sRet=""
	filename=Replace(filename," ","%20")
	Dim startPage,endPage,totalPage 
	sRet= "<form name=jumpPage mothod=post action=>"
	sRet= sRet &  "<font class=tcat2>共"&total&"条 "&"每页"&perpage&"条 "
	
	If total mod perPage=0 Then
		totalPage=total/perPage
	Else
		totalPage=INT(total/perpage)+1
	ENd If
	
	If totalPage<=10 Then
		startPage=1
	Else
		If current-seed >0 Then
			startPage=current-seed
		Else
			startPage=1
		End If
	End If	
	If totalPage<=10 Then
		endPage=totalPage
	Else
		If (current+seed)<totalPage Then
			endPage=current+seed
		Else
			endPage=totalPage
		End If			
	End If
	if current<seed then
		if totalPage>10 THen
			endPage=10
		End If
	End if
	
	
	sRet= sRet &  "第"&current&"页/共" & totalPage&"页, <a href="& filename&"1>第一页</a> "
	if current=1 and CLNG(current)<>CLNG(totalPage)then
		sRet= sRet & " 上一页 <a href="& filename&""&current+1&">下一页</a>"
	elseif CLNG(current)>1  then
		'Response.Write Typename(current)
		If  CLNG(current)< CLNG(totalPage) Then
			sRet= sRet & " <a href="& filename&""&current-1&">上一页</a> <a href="& filename&""&current+1&">下一页</a>"
		elseif CLNG(current)=CLNG(totalPage) then
			sRet= sRet & " <a href="& filename&""&current-1&">上一页</a> 下一页"
		end if
	else
		sRet= sRet & " 上一页 下一页"
	End If
	sRet= sRet & "  <a href="& filename&totalPage&">最末页</a>"
	sRet= sRet &  "<input type=hidden name=wheretogo value=go>&nbsp;"
	'Response.write  "<input type=hidden name=wherefile value="&filename&">"
	sRet= sRet &  "  跳转到<input name=currentPage class=border1px size=5>页 <input type=button value=GO class=border1px onclick='jump()'>&nbsp;"
	'Response.write  " <BR>"
	If bShow Then
		For i=startPage to endPage
			if i=cint(current) then
				sRet= sRet & "<b>"&current&"</b> "
			Else
				sRet= sRet & "<a href="&filename&i&">"&i&"</a> "
			End If
		Next
	End If
	sRet= sRet & "</font>"
	sRet= sRet & "</form>"

	sRet= sRet & "<script language=javascript>"&chr(13)
	sRet= sRet & "function jump(){"&chr(13)
	sRet= sRet & "window.location.href='"& filename & "'+document.jumpPage.currentPage.value;"&chr(13)
	sRet= sRet & "}"&chr(13)
	sRet= sRet & "</script>"&chr(13)
	PageBar=sRet
	sRet=""
End Function


function PageBarNum(total,perpage,current,filename)
	dim sRet,pageListCount,i,className
	pageListCount=10
	If total mod perPage=0 Then
		total=total/perPage
	Else
		total=INT(total/perpage)+1
	ENd If
	'response.Write(total)
	'response.End()
	if total>0 then
		dim startNum
		startNum=int((current-1)/pageListCount)*pageListCount+1
		'公式：int((n-1)/col)*col+1	n给定的参数	col每行显示几个数字		从1开始，顺序排		
		if current<>1 then			
			sRet="<span class='inactivePage'><a href='"&filename&"1' alt='第一页'>|&lt;</a></span>"
		end if
			
			if startNum-pageListCount>0 then
				rsRet=sRet&"<span class='inactivePage'><a href='"&filename&""&(startNum-pageListCount)&" alt='前"&pageListCount&"页'>&lt;&lt</a></span>"
			end if
			
			for i=startNum to startNum+pageListCount-1
				
				if i=current then
					className="activePage"
				else
					className="inactivePage"
				end if
				
				sRet=sRet&"<span class='"&className&"'><a href='"&filename&i&"'>"&i&"</a></span>"
				
				if i>=total then
					exit for
				end if
			Next
			
			if startNum+pageListCount<=total then
				sRet=sRet&"<span class='inactivePage'><a href='"&filename&(startNum+pageListCount)&"' alt='后"&pageListCount&"页'>&gt;&gt</a></span>"		
			end if
			
			if current<>total then
				sRet=sRet&"<span class='inactivePage'><a href='"&filename&total&"' alt='最后一页'>&gt;|</a></span>"
			end if
		END IF
	PageBarNum=sRet
end function

Function MakeMiniPageBar(iAll,iPer,iThis,sFileName)
	Dim sRet,i,iPages,sSeleted
	sRet=""
	sFileName=Replace(sFileName," ","%20")
	sRet= "<form name=jumpPage mothod=post action=>"
	sRet= sRet &  "共"&iAll&"条,转到 "
	If iThis="" Or iThis="0" Then iThis=1
	If iAll mod iPer=0 Then
		iPages=iAll/iPer
	Else
		iPages=INT(iAll/iPer)+1
	End If
	
	sRet= sRet & "<select name=""currentPage"" onchange=""jump()"">"
	For i=1 to iPages
		If i=iThis Then 
			sSeleted=" Selected"
		Else
			sSeleted=" "
		End If
		sRet= sRet & "<option value=""" & i & """" & sSeleted & ">" & i & "/" & iPages & "</option>"
	Next
	sRet= sRet & "</select></form>"
	sRet= sRet & "<script language=javascript>"&chr(13)
	sRet= sRet & "function jump(){"&chr(13)
	sRet= sRet & "window.location.href='"& sFileName & "'+document.jumpPage.currentPage.value;"&chr(13)
	sRet= sRet & "}"&chr(13)
	sRet= sRet & "</script>"&chr(13)
	MakeMiniPageBar=sRet
	sRet=""
End Function

'处理用户及群组头像(sType,1-用户;2-群组)
Function ProIco(byval sIco,byval sType)
	If IsNull(sIco) Or IsEmpty(sIco) Then sIco=""
	sIco=Trim(sIco)
	If sIco="" Then 
		If sType="1" Then
			sIco="images/ico_default.gif"
		ElseIf sType="2" Then
			sIco="images/default_groupico.gif"
		ElseIf sType="3" Then
			sIco="images/nopic.gIf"
		End If
	End If
	If Left(LCase(sico),7)<>"http://" Then sico=blogurl & sico
	ProIco=sico
End Function

'处理样式表，将样式表纳入到<head></head>节
'在系统自定义的Head节增加一个{OB_STYLE}标签
'将提取出的Style填充到该节
'用于用户界面/系统页面的输出
Function OB_PickUpCss(byref sContent)
	Dim oRegExp,sRet,Match,Matches
	Set oRegExp = New Regexp
	oRegExp.IgnoreCase = True
	oRegExp.Global = True
	
	oRegExp.Pattern = "<link.+?>"
	Set Matches =oRegExp.Execute(sContent)
	For Each Match in Matches
		sRet = sRet & Match.Value & Vbcrlf
	Next 
	sContent=oRegExp.Replace(sContent,"")
	oRegExp.Pattern = "\<style(.[^\[]*)\/style\>"
	Set Matches =oRegExp.Execute(sContent)
	For Each Match in Matches
		sRet = sRet & Match.Value & Vbcrlf
	Next 
	sContent=oRegExp.Replace(sContent,"")
	'切掉这个页面上的<body标签>
	'oRegExp.Pattern = "<body>"
	'sContent =oRegExp.Replace(sContent,"")
	Set oRegExp=Nothing
	OB_PickUpCss=sRet
End Function
%>
