<style type="text/css">
<!--
.calendar-today {
	color: #66666;
	background-image: url(../img/blog/bg_today.gif); 
	text-align: center;
	font: 9px Verdana;
}
.calendar-thisday {
	color: #666666;
	background-image: url(../img/blog/bg_thisday.gif);
	text-align: center;
	font: 9px Verdana;
}
.calendar {
	color: #333333;
	text-align: center;
	font: 9px Verdana;
}
.arrow {
	font-family: webdings;
}

.code_main {
	color: #666666;
	padding: 4px;
	margin: 2px;
	border: 1px dashed #666;
	background: #FAFAFA;
	font: 12px Georgia;
}
.code_head {
        margin: 2px;
	font: bold 12px Georgia,Arial, "宋体";
}
-->
</style>
<%
Dim Arr_Cat
Dim rscat
	Set rscat=Server.CreateObject("ADODB.RecordSet")
	SQL="SELECT cate_ID,cate_Name,cate_Order FROM b_cat ORDER BY cate_Order ASC"
	rscat.Open SQL,Conn,1,1
	If rscat.EOF And rscat.BOF Then
		Redim Arr_Cat(3,0)
	Else
		Arr_Cat=rscat.GetRows
	End If
rscat.Close
Set rscat=Nothing
Dim Arr_Keys
Dim rskey
	Set rskey=Server.CreateObject("ADODB.RecordSet")
	SQL="SELECT key_ID,key_Text,key_URL,key_Image FROM b_Keys ORDER BY key_ID ASC"
	rskey.Open SQL,Conn,1,1
	If rskey.EOF And rskey.BOF Then
		Redim Arr_Keys(4,0)
	Else
		Arr_Keys=rskey.GetRows
	End If
rskey.Close
Set rskey=Nothing
Dim Arr_Emot
Dim rssm
	Set rssm=Server.CreateObject("ADODB.RecordSet")
	SQL="SELECT sm_ID,sm_Image,sm_Text FROM b_emot ORDER BY sm_ID ASC"
	rssm.Open SQL,Conn,1,1
	If rssm.EOF And rssm.BOF Then
		Redim Arr_Emot(3,0)
	Else
		Arr_Emot=rssm.GetRows
	End If
rssm.Close
Set rssm=Nothing
Dim Arr_Tags
Dim rstag
	Set rstag=Server.CreateObject("ADODB.RecordSet")
	SQL="SELECT TagID,TagName,TagBlogCount FROM b_tags ORDER BY TagID ASC"
	rstag.Open SQL,Conn,1,1
	If rstag.EOF And rstag.BOF Then
		Redim Arr_Tags(3,0)
	Else
		Arr_Tags=rstag.GetRows
	End If
rstag.Close
Set rstag=Nothing
Sub Calendar(H_Year,H_Month,H_Day)
	ReDim Link_Days(2,0)
	Dim Link_Count
	Link_Count=0
	Dim This_Year,This_Month,This_Day,RS_Month,Link_TF
	IF H_Year=Empty Then H_Year=Year(Now())
	IF H_Month=Empty Then H_Month=Month(Now())
	IF H_Day=Empty Then H_Day=0
	H_Year=Cint(H_Year)
	H_Month=Cint(H_Month)
	H_Day=Cint(H_Day)
	This_Year=H_Year
	This_Month=H_Month
	This_Day=H_Day
	Dim To_Day,To_Month,To_Year
	To_Day=Cint(Day(Now()))
	To_Month=Cint(Month(Now()))
	To_Year=Cint(Year(Now()))
	SQL="SELECT blog_PostYear,blog_PostMonth,blog_PostDay FROM b_Content WHERE blog_PostYear="&H_Year&" AND blog_PostMonth="&H_Month&" ORDER BY blog_PostDay"
	Set RS_Month=Server.CreateObject("ADODB.RecordSet")
	RS_Month.Open SQL,Conn,1,1
	Dim the_Day
	the_Day=0
	Do While NOT RS_Month.EOF
		IF RS_Month("blog_PostDay")<>the_Day Then
			the_Day=RS_Month("blog_PostDay")
			ReDim PreServe Link_Days(2,Link_Count)
			Link_Days(0,Link_Count)=RS_Month("blog_PostMonth")
			Link_Days(1,Link_Count)=RS_Month("blog_PostDay")
			Link_Days(2,Link_Count)="blog.asp?Hx_Year="&RS_Month("blog_PostYear")&"&Hx_Month="&RS_Month("blog_PostMonth")&"&Hx_Day="&RS_Month("blog_PostDay")
			Link_Count=Link_Count+1
		End IF
		RS_Month.MoveNext
	Loop
	RS_Month.Close
	Set RS_Month=Nothing
	Dim Month_Name(12)
	Month_Name(0)=""
	Month_Name(1)="1"
	Month_Name(2)="2"
	Month_Name(3)="3"
	Month_Name(4)="4"
	Month_Name(5)="5"
	Month_Name(6)="6"
	Month_Name(7)="7"
	Month_Name(8)="8"
	Month_Name(9)="9"
	Month_Name(10)="10"
	Month_Name(11)="11"
	Month_Name(12)="12"
	
	Dim Month_Days(12)
	Month_Days(0)=""
	Month_Days(1)=31
	Month_Days(2)=28
	Month_Days(3)=31
	Month_Days(4)=30
	Month_Days(5)=31
	Month_Days(6)=30
	Month_Days(7)=31
	Month_Days(8)=31
	Month_Days(9)=30
	Month_Days(10)=31
	Month_Days(11)=30
	Month_Days(12)=31
	
	If IsDate("February 29, " & This_Year) Then Month_Days(2)=29
	Dim Start_Week
	Start_Week=WeekDay(H_Month&"-1-"&H_Year)-1
	
	Dim Next_Month,Next_Year,Pro_Month,Pro_Year
	Next_Month=H_Month+1
	Next_Year=H_Year
	IF Next_Month>12 then 
		Next_Month=1
		Next_Year=Next_Year+1
	End IF
	Pro_Month=H_Month-1
	Pro_Year=H_Year
	IF Pro_Month<1 then 
		Pro_Month=12
		Pro_Year=Pro_Year-1
	End IF
	
        Response.Write("<table width=""98%"" border=""0"" align=""center"" cellpadding=""2"" cellspacing=""2"" background=""img/blog/month"&Month_Name(H_Month)&".gif""><tr><td colspan=""7"" align=""center""><a href=""blog.asp?Hx_Year="&H_Year-1&""" title=""上一年""><span class=""arrow"">7</span></a><a href=""blog.asp?Hx_Year="&Pro_Year&"&Hx_Month="&Pro_Month&""" title=""上一月""><span class=""arrow"">3</span></a> <strong>"&H_Year&" - "&Month_Name(H_Month)&"</strong> <a href=""blog.asp?Hx_Year="&Next_Year&"&Hx_Month="&Next_Month&""" title=""下一月""><span class=""arrow"">4</span></a><a href=""blog.asp?Hx_Year="&H_Year+1&""" title=""下一年""><span class=""arrow"">8</span></a></td></tr><tr bgcolor=""#F8F8F8"" align=""center"">")
        Response.Write("<td style=""bold 11px; color:red"">日</td><td style=""bold 11px;"">一</td><td style=""bold 11px;"">二</td><td style=""bold 11px;"">三</td><td style=""bold 11px;"">四</td><td style=""bold 11px;"">五</td><td style=""bold 11px; color:green"">六</td></tr><tr>")
	Dim i,j,k,l,m
	For  i=0 TO Start_Week-1
		Response.Write("<td class=""calendar"">&nbsp;</td>")
	Next
	Dim This_BGColor
	j=1
	While j<=month_Days(This_Month)
	 	For k=start_Week To 6
			This_BGColor="calendar"
			IF j=To_Day AND This_Year=To_Year AND This_Month=To_Month Then This_BGColor="calendar-today"
			IF j=This_Day Then This_BGColor="calendar-thisday"
			Response.Write("<td class="""&This_BGColor&""">")
			Link_TF="Flase"
			For l=0 TO Ubound(Link_Days,2)
				IF Link_Days(0,l)<>"" Then
					IF Link_Days(0,l)=This_Month AND Link_Days(1,l)=j Then
						Response.Write("<a href="""&Link_Days(2,l)&""">")
						Link_TF="True"
					End IF
				End IF
			Next
		IF j<=Month_Days(This_Month) Then Response.Write(j)
		IF Link_TF="True" Then Response.Write("</font></a>")
        Response.Write("</td>")
		j=j+1
	Next
	Start_Week=0
	Response.Write("</tr><tr>")
	Wend
	Response.Write("</tr></table>")
End Sub

Function ShowTag(blogID,TagMode)
  sql="select TagsName,BlogID from b_tag where blogID="&blogID&""
  DIM STAG,STARR,STNUM,STI,taglist
  Set STAG=SERVER.CREATEOBJECT("ADODB.RECORDSET")
  STAG.OPEN sql,conn,1,1
  IF STAG.EOF AND STAG.BOF THEN
     Else
     STARR=STAG.GetRows
     STNUM=Ubound(STARR,2)
     For STI=0 To STNUM
	   IF TagMode="Edit" then
	        IF STI=STNUM Then
	            ShowTag=ShowTag&STARR(0,STI)
	        Else
		    ShowTag=ShowTag&STARR(0,STI)&"|"
		End IF
	   Else
	        IF ucase(Trim(CheckStr(Trim(Request.QueryString("tags")))))=ucase(Trim(STARR(0,STI))) Then
		    taglist="<font color=#ff0000>"&STARR(0,STI)&"</font>"
		Else
		    taglist=STARR(0,STI)
		End IF
                IF STI=STNUM Then
	            ShowTag=ShowTag&"<a href=""blog.asp?tags="&Server.URLEncode(STARR(0,STI))&""">"&taglist&"</a>"
		Else
	            ShowTag=ShowTag&"<a href=""blog.asp?tags="&Server.URLEncode(STARR(0,STI))&""">"&taglist&"</a>"&" → "
	        End IF
	  End IF
     Next
	 IF TagMode="Edit" then
	    Else
	    ShowTag = "<img src=""img/blog/icon_tags.gif"" border=""0"" align=""absmiddle""><b>TAGs："&ShowTag&"</b>"
         End IF
  END IF
  STAG.CLOSE
  SET STAG=NOTHING
End Function


Sub EditTags(tblog_ID)  
    SQL="Select * from b_tag where blogID="&tblog_ID&""
    Set deltag=Server.CreateObject("Adodb.Recordset")
	deltag.OPEN SQL,CONN,1,1
	DO While NOT deltag.Eof
	conn.execute ("update b_tags set TagBlogCount=TagBlogCount-1 where TagName='"&deltag("TagsName")&"'")
	deltag.MoveNext
	LOOP
    deltag.Close
    set deltag=nothing
	conn.execute ("Delete * from b_tag where blogID="&tblog_ID&"")
	conn.execute ("Delete * from b_tags where TagBlogCount=0")
End Sub


Function UBBCode(strContent,DisSM,DisUBB,DisIMG,AutoURL,AutoKEY)
	If isEmpty(strContent) Or isNull(strContent) Then
        Exit Function
	ElseIF DisUBB=1 Then
		strContent=Replace(strContent,"[#seperator#]","")
		UBBCode=strContent
		Exit Function
	Else
		strContent=Replace(strContent,"[#seperator#]","")
		Dim re, strMatches, strMatch, tmpStr1, tmpStr2, tmpStr3, tmpStr4, RNDStr
		Set re=new RegExp
		re.IgnoreCase =True
		re.Global=True

		re.Pattern="\[code\](<br>)+"
		strContent=re.Replace(strContent,"[code]")
		re.Pattern="\[quote\](<br>)+"
		strContent=re.Replace(strContent,"[quote]")

		IF AutoURL=1 Then
                      re.Pattern="([^=\]][\s]*?|^)(https?|ftp|gopher|news|telnet|mms|rtsp)://([a-z0-9/\-_+=.~!%@?#%&;:$\\()|]+)"
		      StrContent=re.Replace(StrContent,"$1[url]$2://$3[/url]")
                End IF

		IF Not DisIMG=1 Then

			re.Pattern="\[img\](.*?)\[\/img\]"
			Set strMatches=re.Execute(strContent)
			For Each strMatch In strMatches
				tmpStr1=CheckLinkStr(strMatch.SubMatches(0))
				strContent=Replace(strContent,strMatch.Value,"<img src="""&tmpStr1&""" border=""0"" onload=""javascript:DrawImage(this);""  alt=""按此在新窗口打开图片"" onmouseover=""this.style.cursor='hand';"" onclick=""window.open(this.src);"" />")
			Next
			Set strMatches=Nothing

			re.Pattern="\[img=(left|right|center|absmiddle)\](.*?)\[\/img\]"
			Set strMatches=re.Execute(strContent)
			For Each strMatch In strMatches
				tmpStr1=strMatch.SubMatches(0)
				tmpStr2=CheckLinkStr(strMatch.SubMatches(1))
				strContent=Replace(strContent,strMatch.Value,"<img src="""&tmpStr2&""" align="""&tmpStr1&"""  onload=""javascript:DrawImage(this);""  border=""0"" alt=""按此在新窗口打开图片"" onmouseover=""this.style.cursor='hand';"" onclick=""window.open(this.src);"" />")
			Next
			Set strMatches=Nothing

			strContent=replace(strContent,"[swf]","[swf=540,400]")
			strContent=replace(strContent,"[wmv]","[wmv=540,400]")
			strContent=replace(strContent,"[wma]","[wma=540,30]")
			strContent=replace(strContent,"[rm]","[rm=540,400]")
			strContent=replace(strContent,"[ra]","[ra=450,60]")
                        re.Pattern="\[(swf|wma|wmv|rm|ra|qt)=(\d*?|),(\d*?|)\](.*?)\[\/(swf|wma|wmv|rm|ra|qt)\]"
			Set strMatches=re.Execute(strContent)
			For Each strMatch in strMatches
				RNDStr=Int(7999 * Rnd + 2000)
				tmpStr1=CheckLinkStr(strMatch.SubMatches(3))
				strContent= Replace(strContent,strMatch.Value,"<div class=""code_head""><input id=""VOBJ_"&RNDStr&""" type=""hidden"" value=""-1"" /><a href=""javascript:makemedia('"&strMatch.SubMatches(0)&"','OBJ_"&RNDStr&"','"&strMatch.SubMatches(3)&"','"&strMatch.SubMatches(1)&"','"&strMatch.SubMatches(2)&"');""><img src=""img/blog/media.gif"" alt=""显示影音文件"" align=""absmiddle"" border=""0"" /> 点击显示/隐藏影音文件</a></div><div style=""margin-top:8px;""></div><div id=""OBJ_"&RNDStr&""" class=""code_main"">影音源文件地址：<a href="""&strMatch.SubMatches(3)&""" target=""_blank"">"&strMatch.SubMatches(3)&"</a></div>")
			Next
			Set strMatches=Nothing
		End IF

		re.Pattern = "\[url=(.[^\]]*)\](.*?)\[\/url]"
		Set strMatches=re.Execute(strContent)
		For Each strMatch In strMatches
			tmpStr1=CheckLinkStr(strMatch.SubMatches(0))
			tmpStr2=strMatch.SubMatches(1)
			strContent=Replace(strContent,strMatch.Value,"<a target=""_blank"" href="""&tmpStr1&""">"&tmpStr2&"</a>")
		Next
		Set strMatches=Nothing
		re.Pattern = "\[url](.*?)\[\/url]"
		Set strMatches=re.Execute(strContent)
		For Each strMatch In strMatches
			tmpStr1=CheckLinkStr(strMatch.SubMatches(0))
			tmpStr2=CutURL(tmpStr1)
			strContent=Replace(strContent,strMatch.Value,"<a target=""_blank"" href="""&tmpStr1&""">"&tmpStr2&"</a>")
		Next
		Set strMatches=Nothing

		re.Pattern="\[fly\](.*)\[\/fly\]"
		strContent=re.Replace(strContent,"<marquee width=90% behavior=alternate scrollamount=3>$1</marquee>")
		re.Pattern="\[move\](.*)\[\/move\]"
		strContent=re.Replace(strContent,"<MARQUEE scrollamount=3>$1</marquee>")	
		re.Pattern="\[SHADOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/SHADOW]"
		strContent=re.Replace(strContent,"<table width=$1 ><tr><td style=""filter:shadow(color=$2, 			strength=$3)"">$4</td></tr></table>")
		re.Pattern="\[GLOW=*([0-9]*),*(#*[a-z0-9]*),*([0-9]*)\](.[^\[]*)\[\/GLOW]"
		strContent=re.Replace(strContent,"<table width=$1 ><tr><td style=""filter:glow(color=$2, 			strength=$3)"">$4</td></tr></table>")
		re.Pattern = "\[email=(.[^\]]*)\](.*?)\[\/email]"
		strContent = re.Replace(strContent,"<a href=""mailto:$1"">$2</a>")
		re.Pattern = "\[email](.*?)\[\/email]"
		strContent = re.Replace(strContent,"<a href=""mailto:$1"">$1</a>")

                strContent = Replace(strContent,"[sub]","<sub>")
		strContent = Replace(strContent,"[/sub]","</sub>")

		strContent = Replace(strContent,"[sup]","<sup>")
		strContent = Replace(strContent,"[/sup]","</sup>")
		strContent = Replace(strContent,"[list]","<ul>")
		strContent = Replace(strContent,"[list=1]","<ol type=""1"">")
		strContent = Replace(strContent,"[list=a]","<ol type=""a"">")
		strContent = Replace(strContent,"[list=A]","<ol type=""A"">")
		strContent = Replace(strContent,"[*]","<li>")
		strContent = Replace(strContent,"[/list]","</ul></ol>")

		re.Pattern="\[face=([^<>\]]*?)\](.*?)\[\/face]"
		strContent=re.Replace(strContent,"<font face=""$1"">$2</font>")
		re.Pattern="\[color=([^<>\]]*?)\](.*?)\[\/color]"
		strContent=re.Replace(strContent,"<font color=""$1"">$2</font>")
		re.Pattern="\[align=([^<>\]]*?)\](.*?)\[\/align]"
		strContent=re.Replace(strContent,"<div align=""$1"">$2</div>")
		re.Pattern="\[size=(\d*?)\](.*?)\[\/size]"
		strContent=re.Replace(strContent,"<font size=""$1"">$2</font>")
		re.Pattern="\[b\](.*?)\[\/b]"
		strContent=re.Replace(strContent,"<strong>$1</strong>")	
		re.Pattern="\[i\](.*?)\[\/i]"
		strContent=re.Replace(strContent,"<em>$1</em>")	
		re.Pattern="\[u\](.*?)\[\/u]"
		strContent=re.Replace(strContent,"<u>$1</u>")

		re.Pattern="\[code\](.*?)\[\/code\]"
		Set strMatches=re.Execute(strContent)
		For Each strMatch In strMatches
			RNDStr=Int(7999 * Rnd + 2000)
			tmpStr1=strMatch.SubMatches(0)
			strContent= Replace(strContent,strMatch.Value,"<table width=""100%"" border=""0"" align=""center"" cellpadding=""0"" cellspacing=""0"" class=""code_head""><tr><td>程序代码：</td><td align=""right""><a href=""javascript:CopyText(document.all.CODE_"&RNDStr&");"">[ 复制代码到剪贴板 ]</a> </td></tr></table><div class=""code_main"" id=""CODE_"&RNDStr&""" style=""overflow-y: auto;overflow-x:hidden;height:120px;"">"&tmpStr1&"</div>")
		Next
		Set strMatches=Nothing

		re.Pattern="\[quote\](.*?)\[\/quote\]"
		strContent= re.Replace(strContent,"<fieldset style=""border: 1 solid #999999;padding: 4px;background: #FAFAFA;""><legend>引用内容：</legend>$1</fieldset>")
                
                re.Pattern = "\[down=(.[^\]]*)\](.*?)\[\/down]"
		strContent = re.Replace(strContent,"<img src=""img/blog/download.gif"" align=""absmiddle"" /><a href=""$1"" target=""_blank"">$2</a>")

		IF Not DisSM=1 Then
			Dim blog_EmotNums,blog_EmotI
			blog_EmotNums=Ubound(Arr_Emot,2)
			For blog_EmotI=0 To blog_EmotNums
				strContent=Replace(strContent,Arr_Emot(2,blog_EmotI)," <img src=""img/blog/emot/"&Arr_Emot(1,blog_EmotI)&""" border=""0"" align=""absmiddle"" />")
			Next
		End IF

		IF AutoKEY=1 Then
			Dim blog_KeyNums,blog_KeyI
			blog_KeyNums=Ubound(Arr_Keys,2)
			For blog_KeyI=0 To blog_KeyNums
				IF Arr_Keys(3,blog_KeyI)<>Empty Then
					strContent=Replace(strContent,Arr_Keys(1,blog_KeyI),"<a href="""&Arr_Keys(2,blog_KeyI)&""" target=""_blank""><img src=""img/blog/"&Arr_Keys(3,blog_KeyI)&""" border=""0"" align=""absmiddle"" />"&Arr_Keys(1,blog_KeyI)&"</a>")
				Else
					strContent=Replace(strContent,Arr_Keys(1,blog_KeyI),"<a href="""&Arr_Keys(2,blog_KeyI)&""" target=""_blank"">"&Arr_Keys(1,blog_KeyI)&"</a>")
				End IF
			Next
		End IF
		Set re=Nothing
		UBBCode=strContent
	End IF
End Function

Function IsInteger(Para) 
	IsInteger=False
	If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
		IsInteger=True
	End If
End Function

Function CheckLinkStr(Str)
	Str = Replace(Str, "document.cookie", ".")
	Str = Replace(Str, "document.write", ".")
	Str = Replace(Str, "javascript:", "javascript ")
	Str = Replace(Str, "vbscript:", "vbscript ")
	Str = Replace(Str, "javascript :", "javascript ")
	Str = Replace(Str, "vbscript :", "vbscript ")
	Str = Replace(Str, "[", "&#91;")
	Str = Replace(Str, "]", "&#93;")
	Str = Replace(Str, "<", "&#60;")
	Str = Replace(Str, ">", "&#62;")
	Str = Replace(Str, "{", "&#123;")
	Str = Replace(Str, "}", "&#125;")
	Str = Replace(Str, "|", "&#124;")
	Str = Replace(Str, "script", "&#115;cript")
	Str = Replace(Str, "SCRIPT", "&#083;CRIPT")
	Str = Replace(Str, "Script", "&#083;cript")
	Str = Replace(Str, "script", "&#083;cript")
	Str = Replace(Str, "object", "&#111;bject")
	Str = Replace(Str, "OBJECT", "&#079;BJECT")
	Str = Replace(Str, "Object", "&#079;bject")
	Str = Replace(Str, "object", "&#079;bject")
	Str = Replace(Str, "applet", "&#097;pplet")
	Str = Replace(Str, "APPLET", "&#065;PPLET")
	Str = Replace(Str, "Applet", "&#065;pplet")
	Str = Replace(Str, "applet", "&#065;pplet")
	Str = Replace(Str, "embed", "&#101;mbed")
	Str = Replace(Str, "EMBED", "&#069;MBED")
	Str = Replace(Str, "Embed", "&#069;mbed")
	Str = Replace(Str, "embed", "&#069;mbed")
	Str = Replace(Str, "document", "&#100;ocument")
	Str = Replace(Str, "DOCUMENT", "&#068;OCUMENT")
	Str = Replace(Str, "Document", "&#068;ocument")
	Str = Replace(Str, "document", "&#068;ocument")
	Str = Replace(Str, "cookie", "&#099;ookie")
	Str = Replace(Str, "COOKIE", "&#067;OOKIE")
	Str = Replace(Str, "Cookie", "&#067;ookie")
	Str = Replace(Str, "cookie", "&#067;ookie")
	Str = Replace(Str, "event", "&#101;vent")
	Str = Replace(Str, "EVENT", "&#069;VENT")
	Str = Replace(Str, "Event", "&#069;vent")
	Str = Replace(Str, "event", "&#069;vent")
	CheckLinkStr = Str
End Function

Function CheckStr(byVal ChkStr) 
	Dim Str:Str=ChkStr
	Str=Trim(Str)
	If IsNull(Str) Then
		CheckStr = ""
		Exit Function 
	End If
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="(\r\n){3,}"
	Str=re.Replace(Str,"$1$1$1")
	Set re=Nothing
	Str = Replace(Str,"'","''")
	Str = Replace(Str, "select", "sel&#101;ct")
	Str = Replace(Str, "join", "jo&#105;n")
	Str = Replace(Str, "union", "un&#105;on")
	Str = Replace(Str, "where", "wh&#101;re")
	Str = Replace(Str, "insert", "ins&#101;rt")
	Str = Replace(Str, "delete", "del&#101;te")
	Str = Replace(Str, "update", "up&#100;ate")
	Str = Replace(Str, "like", "lik&#101;")
	Str = Replace(Str, "drop", "dro&#112;")
	Str = Replace(Str, "create", "cr&#101;ate")
	Str = Replace(Str, "modify", "mod&#105;fy")
	Str = Replace(Str, "rename", "ren&#097;me")
	Str = Replace(Str, "alter", "alt&#101;r")
	Str = Replace(Str, "cast", "ca&#115;t")
	Str = Replace(Str, "パ", "&pa;")
	Str = Replace(Str, "ポ", "&po;")
        Str = Replace(Str, "ゾ", "&zo;")
        Str = Replace(Str, "ギ", "&gi;")
        Str = Replace(Str, "ビ", "&bi;")
        Str = Replace(Str, "ヴ", "&wu;")
        Str = Replace(Str, "ダ", "&da;")
        Str = Replace(Str, "グ", "&ku;")
        Str = Replace(Str, "ピ", "&pi;")
        Str = Replace(Str, "ヂ", "&ji;")
        Str = Replace(Str, "ゲ", "&ke;")
        Str = Replace(Str, "ブ", "&bu;")
        Str = Replace(Str, "ヅ", "&zu;")
        Str = Replace(Str, "ゴ", "&ko;")
        Str = Replace(Str, "プ", "&pu;")
        Str = Replace(Str, "デ", "&de;")
        Str = Replace(Str, "ザ", "&za;")
        Str = Replace(Str, "ベ", "&be;")
        Str = Replace(Str, "ド", "&do;")
        Str = Replace(Str, "ジ", "&zi;")
        Str = Replace(Str, "ペ", "&pe;")
        Str = Replace(Str, "バ", "&ba;")
        Str = Replace(Str, "ズ", "&zi;")
        Str = Replace(Str, "ボ", "&bo;")
	CheckStr=Str
End Function

Function UnCheckStr(Str)
		Str = Replace(Str, "sel&#101;ct", "select")
		Str = Replace(Str, "jo&#105;n", "join")
		Str = Replace(Str, "un&#105;on", "union")
		Str = Replace(Str, "wh&#101;re", "where")
		Str = Replace(Str, "ins&#101;rt", "insert")
		Str = Replace(Str, "del&#101;te", "delete")
		Str = Replace(Str, "up&#100;ate", "update")
		Str = Replace(Str, "lik&#101;", "like")
		Str = Replace(Str, "dro&#112;", "drop")
		Str = Replace(Str, "cr&#101;ate", "create")
		Str = Replace(Str, "mod&#105;fy", "modify")
		Str = Replace(Str, "ren&#097;me", "rename")
		Str = Replace(Str, "alt&#101;r", "alter")
		Str = Replace(Str, "ca&#115;t", "cast")
		Str = Replace(Str, "&pa;", "パ")
		Str = Replace(Str, "&po;", "ポ")
		Str = Replace(Str, "&zo;", "ゾ")
		Str = Replace(Str, "&gi;", "ギ")
		Str = Replace(Str, "&bi;", "ビ")
		Str = Replace(Str, "&wu;", "ヴ")
		Str = Replace(Str, "&da;", "ダ")
		Str = Replace(Str, "&ku;", "グ")
		Str = Replace(Str, "&pi;", "ピ")
		Str = Replace(Str, "&ji;", "ヂ")
		Str = Replace(Str, "&ke;", "ゲ")
		Str = Replace(Str, "&bu;", "ブ")
		Str = Replace(Str, "&zu;", "ヅ")
		Str = Replace(Str, "&ko;", "ゴ")
		Str = Replace(Str, "&pu;", "プ")
		Str = Replace(Str, "&de;", "デ")
		Str = Replace(Str, "&za;", "ザ")
		Str = Replace(Str, "&be;", "ベ")
		Str = Replace(Str, "&do;", "ド")
		Str = Replace(Str, "&zi;", "ジ")
		Str = Replace(Str, "&pe;", "ペ")
		Str = Replace(Str, "&ba;", "バ")
		Str = Replace(Str, "&zi;", "ズ")
		Str = Replace(Str, "&bo;", "ボ")
		UnCheckStr=Str
End Function

Function HTMLEncode(reString) 
	Dim Str:Str=reString
	If Not IsNull(Str) Then
		Str = UnCheckStr(Str)
		Str = Replace(Str, "&", "&amp;")
		Str = Replace(Str, ">", "&gt;")
		Str = Replace(Str, "<", "&lt;")
		Str = Replace(Str, CHR(32), "&nbsp;")
	        Str = Replace(Str, CHR(9), "&nbsp;&nbsp;&nbsp;&nbsp;")
		Str = Replace(Str, CHR(9), "&#160;&#160;&#160;&#160;")
		Str = Replace(Str, CHR(34),"&quot;")
		Str = Replace(Str, CHR(39),"&#39;")
		Str = Replace(Str, CHR(13), "")
		Str = Replace(Str, CHR(10), "<br>")
		HTMLEncode = Str
	End If
End Function

Function EditDeHTML(byVal Content)
	EditDeHTML=Content
	IF Not IsNull(EditDeHTML) Then
		EditDeHTML=UnCheckStr(EditDeHTML)
		EditDeHTML=Replace(EditDeHTML,"&","&amp;")
		EditDeHTML=Replace(EditDeHTML,"<","&lt;")
		EditDeHTML=Replace(EditDeHTML,">","&gt;")
		EditDeHTML=Replace(EditDeHTML,CHR(34),"&quot;")
		EditDeHTML=Replace(EditDeHTML,CHR(39),"&#39;")
	End IF
End Function

Function DateToStr(DateTime,ShowType)  
	Dim DateMonth,DateDay,DateHour,DateMinute
	DateMonth=Month(DateTime)
	DateDay=Day(DateTime)
	DateHour=Hour(DateTime)
	DateMinute=Minute(DateTime)
	If Len(DateMonth)<2 Then DateMonth="0"&DateMonth
	If Len(DateDay)<2 Then DateDay="0"&DateDay
	Select Case ShowType
	Case "Y-m-d"  
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay
	Case "Y-m-d H:I A"
		Dim DateAMPM
		If DateHour>12 Then 
			DateHour=DateHour-12
			DateAMPM="PM"
		Else
			DateHour=DateHour
			DateAMPM="AM"
		End If
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&" "&DateAMPM
	Case "Y-m-d H:I:S"
		Dim DateSecond
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute&":"&DateSecond
	Case "YmdHIS"
		DateSecond=Second(DateTime)
		If Len(DateHour)<2 Then DateHour="0"&DateHour	
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
		DateToStr=Year(DateTime)&DateMonth&DateDay&DateHour&DateMinute&DateSecond	
	Case "ym"
		'DateToStr=Right(Year(DateTime),2)&DateMonth
                DateToStr=Year(DateTime)&DateMonth
	Case "d"
		DateToStr=DateDay
	Case Else
		If Len(DateHour)<2 Then DateHour="0"&DateHour
		If Len(DateMinute)<2 Then DateMinute="0"&DateMinute
		DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
	End Select
End Function

Function MultiPage(Numbers,Perpage,Curpage,Url_Add)
	CurPage=Int(Curpage)
	Dim URL
	URL=Request.ServerVariables("Script_Name")&Url_Add
	MultiPage=""
	Dim Page,Offset,PageI
	If Int(Numbers)>Int(PerPage) Then
		Page=10
		Offset=2
		Dim Pages,FromPage,ToPage
		If Numbers Mod Cint(Perpage)=0 Then
			Pages=Int(Numbers/Perpage)
		Else
			Pages=Int(Numbers/Perpage)+1
		End If
		FromPage=Curpage-Offset
		ToPage=Curpage+Page-Offset-1
		If Page>Pages Then
			FromPage=1
			ToPage=Pages
		Else
			If FromPage<1 Then
				Topage=Curpage+1-FromPage
				FromPage=1
				If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then ToPage=Page
			ElseIF Topage>Pages Then
				FromPage =Curpage-Pages +ToPage
				ToPage=Pages
				If (ToPage-FromPage)<Page And (ToPage-FromPage)<Pages Then FromPage=Pages-Page+1
			End If
		End If
		MultiPage="<a href="""&Url&"page=1""><img src=""img/blog/icon_ar.gif"" border=""0"" align=""absmiddle""></a> "
		For PageI=FromPage TO ToPage
			If PageI<>CurPage Then
				MultiPage=MultiPage&"<a href="""&Url&"page="&PageI&""">["&PageI&"]</a>&nbsp;"
			Else
				MultiPage=MultiPage&"<b>["&PageI&"]</b>&nbsp;"
			End If
		Next
		If Int(Pages)>Int(Page) Then
			MultiPage=MultiPage&" ... <a href="""&Url&"page="&Pages&"""> ["&pages&"] <img src=""images/icon_al.gif"" border=""0"" align=""absmiddle""></a>&nbsp;<input type=""text"" name=""custompage"" size=""1"" class=""custompage"" onKeyDown=""javascript: if(window.event.keyCode == 13) window.location='"&Url&"page='+this.value;"">"
		Else
			MultiPage=MultiPage&"<a href="""&Url&"page="&Pages&"""><img src=""img/blog/icon_al.gif"" border=""0"" align=""absmiddle""></a>"
		End If
	End If
End Function

Function SplitLines(byVal Content,byVal ContentNums)
	Dim ts,i,l
	If IsNull(Content) Then Exit Function
	i=1
	ts = 0
	For i=1 to Len(Content)
      	l=Mid(Content,i,4)
      	If l="<br>" Then
         	ts=ts+1
      	End If
      	If ts>ContentNums Then Exit For 
	Next
	If ts>ContentNums Then
    	Content=Left(Content,i-1)
	End If
	SplitLines=Content
End Function

Function Generator(Length) 
	Dim i, tempS
	tempS = "abcdefghijklmnopqrstuvwxyz1234567890" 
	Generator = ""
	If isNumeric(Length) = False Then 
		Exit Function 
	End If 
	For i = 1 to Length 
		Randomize 
		Generator = Generator & Mid(tempS,Int((Len(tempS) * Rnd) + 1),1)
	Next 
End Function 

Function CutStr(byVal Str,byVal StrLen) 
	Dim l,t,c,i
	l=Len(str)
	t=0
	For i=1 To l
		c=AscW(Mid(str,i,1))
		If c<0 Or c>255 Then t=t+2 Else t=t+1
		IF t>=StrLen Then
			CutStr=left(Str,i)&".."
			Exit For
		Else
			CutStr=Str
		End If
	Next
End Function

Function Trackback(trackback_url, url, title, excerpt, blog_name) 
	Dim query_string, objXMLHTTP, objDOM
	title = cutStr(Server.URLEncode(title),100)
	excerpt = cutStr(Server.URLEncode(excerpt), 252)
	url = Server.URLEncode(url)
	blog_name = Server.URLEncode(blog_name)
	query_string = "title="&title&"&url="&url&"&blog_name="&blog_name&"&excerpt="&excerpt

	Set objXMLHTTP = Server.CreateObject("MSXML2.ServerXMLHTTP")
	Set objDom = Server.CreateObject("Microsoft.XMLDOM")

	objXMLHTTP.Open "POST", trackback_url, false
	objXMLHTTP.setRequestHeader "Content-Type","application/x-www-Form-urlencoded"

	'HAndling timeout
	On Error Resume Next
	
	objXMLHTTP.SEnd query_string

	If objXMLHTTP.readyState <> 4 Then
		objXMLHTTP.waitForResponse 15
	End If

	If Err.Number <> 0 Then
		Trackback	= "0$$TrackBack 错误：无法连接服务器"
	Else
		If (objXMLHTTP.readyState <> 4) Or (objXMLHTTP.Status <> 200) Then
			objXMLHTTP.Abort
			Trackback	= "0$$Trackback 超时"
		Else
			objDom.async=false
			objDom.loadXML(objXMLHTTP.responseText) 
			If objDom.parseError.errorCode <> 0 Then
				Trackback	= "0$$TrackBack 响应解析错误"
			Else
				If objDom.getElementsByTagName("error")(0).Text="0" Then
					Trackback	= "1$$Trackback 成功"
				Else
					Trackback	= "0$$Trackback 错误："&objDom.getElementsByTagName("message")(0).Text
				End If
			End If
		End If
	End If
	Set objXMLHTTP = Nothing
	Set objDom = Nothing
End Function

Function DelQuote(strContent)
	If IsNull(strContent) Then Exit Function
	Dim re
	Set re=new RegExp
	re.IgnoreCase =True
	re.Global=True
	re.Pattern="(\[quote\])(.*?)(\[\/quote\])"
	strContent= re.Replace(strContent,"")
	Set re=Nothing
	DelQuote=strContent
End Function

Function FixName(UpFileExt) '*****
	If IsEmpty(UpFileExt) Then Exit Function
 	FixName = Ucase(UpFileExt) 
 	FixName = Replace(FixName,Chr(0),"") 
 	FixName = Replace(FixName,".","") 
	FixName = Replace(FixName,"ASP","") 
 	FixName = Replace(FixName,"ASA","") 
 	FixName = Replace(FixName,"ASPX","") 
 	FixName = Replace(FixName,"CER","") 
 	FixName = Replace(FixName,"CDX","") 
 	FixName = Replace(FixName,"HTR","")
        FixName = Replace(FixName,"PHP","") 
End Function

Function IsvalidFile(File_Type)   
	IsvalidFile = False
	Dim GName
	For Each GName in UP_FileType
		If File_Type = GName Then
			IsvalidFile = True
			Exit For
		End If
	Next
End Function

Function CutURL(URLStr)
	Dim URLLen
	URLLen=Len(URLStr)
	If URLLen>65 Then
		CutURL=Left(URLStr,URLLen*0.5)&" ... "&Right(URLStr,URLLen*0.3)
	Else
		CutURL=URLStr
	End If
End Function
%>
