function_blog.asp

后台登陆admin.asp

<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