<%


'------------------------------------------------
'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=CLNG(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

'------------------------------------------------
'CheckInt(byval strNumber)
'检查并转换整形值
'------------------------------------------------
Function CheckInt(byval strNumber)
	If isNull(strNumber) OR Not IsNumeric(strNumber) Then
		CheckInt=""		
	Else
		CheckInt=CLNG(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



	
'------------------------------------------------
'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 =CLNG(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
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
    GetIP = ProtectSQL(Trim(Mid(strIPAddr, 1, 30)))
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 & "," & CLNG(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 '& CLNG(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.jsp" 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
%>
