function.asp

来自「一套非常实用的博客源代码,功能全,界面简单易用.」· ASP 代码 · 共 752 行 · 第 1/2 页

ASP
752 行
字号
12
	End If
End Sub

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 CheckWordFilter(byVal Str)
	Dim log_WordFilterListNumS,log_WordFilterListNumI
	log_WordFilterListNumS=Ubound(Arr_WordFilter,2)
	For log_WordFilterListNumI=0 To log_WordFilterListNumS
		Str=Replace(Str,Arr_WordFilter(1,log_WordFilterListNumI),Arr_WordFilter(2,log_WordFilterListNumI))
	Next
	CheckWordFilter=Str
End Function

Function UnCheckWordFilter(byVal Str)
	Dim log_WordFilterListNumS,log_WordFilterListNumI
	log_WordFilterListNumS=Ubound(Arr_WordFilter,2)
	For log_WordFilterListNumI=0 To log_WordFilterListNumS
		Str=Replace(Str,Arr_WordFilter(2,log_WordFilterListNumI),Arr_WordFilter(1,log_WordFilterListNumI))
	Next
	UnCheckWordFilter=Str
End Function

'去除非法链接
Function Strurls(str,notes)
    Strurls=ubound(split(LCase(str),notes))
End Function

Function CheckWordFilter(byVal Str)
	Dim log_WordFilterListNumS,log_WordFilterListNumI
	log_WordFilterListNumS=Ubound(Arr_WordFilter,2)
	For log_WordFilterListNumI=0 To log_WordFilterListNumS
		Str=Replace(Str,Arr_WordFilter(1,log_WordFilterListNumI),Arr_WordFilter(2,log_WordFilterListNumI))
	Next
	CheckWordFilter=Str
End Function

Function ThreadPage(Numbers,Perpage,Url_Add)
	Dim URL,CurPage
	CurPage=1
	URL="threadview.asp"&Url_Add
	ThreadPage=""
	Dim Page,Offset,PageI
	If Int(Numbers)>Int(PerPage) Then
		Page=8
		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
		For PageI=FromPage TO ToPage
			ThreadPage=ThreadPage&"&nbsp;<a href="""&URL&"page="&PageI&""">"&PageI&"</a>"
		Next
		If Int(Pages)>Int(Page) Then
			ThreadPage=ThreadPage&"&nbsp;...&nbsp;<a href="""&URL&"page="&Pages&""">"&Pages&"</a>"
		End If
	End If
End Function

Function MultiPage_tag(Numbers,Perpage,Curpage,Url_Add) 'TAG列表分页函数
	CurPage=Int(Curpage)
	Dim URL
	URL=Request.ServerVariables("Script_Name")&Url_Add
	MultiPage_tag=""
	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_tag="<a href="""&Url&"sortBy="&sortBy&"&tags="&tag&"&page=1""><img src=""images/icon_ar.gif"" border=""0"" align=""absmiddle""></a> "
		For PageI=FromPage TO ToPage
			If PageI<>CurPage Then
				MultiPage_tag=MultiPage_tag&"<a href="""&Url&"sortBy="&sortBy&"&tags="&tag&"&page="&PageI&""">["&PageI&"]</a>&nbsp;"
			Else
				MultiPage_tag=MultiPage_tag&"<b>["&PageI&"]</b>&nbsp;"
			End If
		Next
		If Int(Pages)>Int(Page) Then
			MultiPage_tag=MultiPage_tag&" ... <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_tag=MultiPage_tag&" <a href="""&Url&"sortBy="&sortBy&"&tags="&tag&"&page="&Pages&"""><img src=""images/icon_al.gif"" border=""0"" align=""absmiddle""></a>"
		End If
	End If
End Function

'显示TAG 2005-7-26
Function ShowTag(blogID,TagMode)
  SQL="SELECT TagsName,Blog_ID From blog_Tag WHERE blog_ID="&blogID&""
  DIM STAG,STARR,STNUM,STI,taglist,tagxg,tagxg_blog,tagxg_num,Noid
  Noid=" log_ID<>" & blogID & " "
  tagxg_blog = ""
  Set STAG=SERVER.CREATEOBJECT("ADODB.RECORDSET")
  STAG.OPEN sql,znwl,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
        ElseIf TagMode="Meta" 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
        
        '显示相关日志与TAG有关 2005-10-30
        '判断非首页
        IF Request.Querystring("logID")<>Empty Then
        Select Case STNUM
               Case 0
                 tagxg_num= 6
               Case 1
                 tagxg_num= 3
               Case 2
                 tagxg_num= 2 
               Case 3
                 tagxg_num= 2
               Case Else
                 tagxg_num= 1
        End Select
        IF STARR(0,STI)=Empty or STARR(0,STI)="" Then
        Else
        SQL="SELECT Top 5 C.cate_Name,A.* FROM blog_Content AS L,blog_Category AS C,blog_tag AS A Where C.cate_ID=L.log_CateID AND L.log_ID=A.blog_ID and tagsName = '" & STARR(0,STI) & "' And " & Noid & " ORDER BY log_IsTop ASC,log_ID DESC"
    Set tagxg=Server.CreateObject("adodb.recordset")
        tagxg.Open sql,znwl,1,1
        IF tagxg.eof And tagxg.bof Then
           
        Else
           Do while NOT tagxg.eof
              IF STI>STNUM Then
                  tagxg_blog = tagxg_blog & "<a href=""BlogView.asp?logID="&tagxg("log_ID")&""">" & tagxg("log_Title") & "</a>&nbsp;&nbsp;&nbsp;&nbsp;<span class=""date"">"&DateToStr(tagxg("log_PostTime"),"Y-m-d A")&"&nbsp;&nbsp;"&tagxg("cate_Name")&"</span>"
                 Else
                  tagxg_blog = tagxg_blog & "<a href=""BlogView.asp?logID="&tagxg("log_ID")&""">" & tagxg("log_Title") & "</a>&nbsp;&nbsp;&nbsp;&nbsp;<span class=""date"">"&DateToStr(tagxg("log_PostTime"),"Y-m-d A")&"&nbsp;&nbsp;&nbsp;"&tagxg("cate_Name")&"</span><br />"
              End IF
              Noid = Noid & " And log_ID<>" & tagxg("log_ID") & " " 
              tagxg.movenext
           Loop
           
        End IF
        tagxg.Close
        Set tagxg=NoThing
        End IF
        End IF
        '显示相关日志与TAG有关 结束
        
        IF STI=STNUM Then
           ShowTag = ShowTag & "<a href=""BloglistTag.asp?tags="&Server.URLEncode(STARR(0,STI))&""">" & taglist & "</a>"
          Else
           ShowTag = ShowTag & "<a href=""BloglistTag.asp?tags="&Server.URLEncode(STARR(0,STI))&""">" & taglist & "</a>" & " | "
        End IF
        
       End IF
     Next
     IF TagMode="Edit" then
     ElseIF TagMode="Meta" then
        ShowTag = "Tags,"&ShowTag&""
     ElseIF tagxg_blog=Empty or tagxg_blog="" Then
        IF ShowTag<>"" AND ShowTag<>Empty Then
           ShowTag = "Tags：" & ShowTag & ""
        End IF
     Else
        tagxg_blog="<BR>相关日志：<BR>"&tagxg_blog&""
        ShowTag = "Tags：" & ShowTag & "" & tagxg_blog
     End IF
  END IF
  STAG.CLOSE
  SET STAG=NOTHING
End Function


Function Realremark(byVal Str)
	Realremark=Replace(Str,"<a","<a rel=""nofollow""")
End Function

Sub EditTags(log_ID)
                SQL="Select * from blog_tag where blog_id="&log_ID&""
				Set deltag=Server.CreateObject("Adodb.Recordset")
				deltag.OPEN SQL,znwl,1,1
				DO While NOT deltag.Eof
				   znwl.execute ("update blog_tags set TagBlogCount=TagBlogCount-1 where TagName='"&deltag("TagsName")&"'")
				   deltag.MoveNext
				LOOP
				deltag.Close
				set deltag=nothing
				znwl.execute ("Delete * from blog_tag where blog_ID="&log_ID&"")
				znwl.execute ("Delete * from blog_tags where TagBlogCount=0")
End Sub

Sub DelTags(blog_ED)
                SQL="Select * from blog_tag where blog_id="&blog_ED&""
				Set deltag=Server.CreateObject("Adodb.Recordset")
				deltag.OPEN SQL,znwl,1,1
				DO While NOT deltag.Eof
				   znwl.execute ("update blog_tags set TagBlogCount=TagBlogCount-1 where TagName='"&deltag("TagsName")&"'")
				   deltag.MoveNext
				LOOP
				deltag.Close
				set deltag=nothing
				znwl.execute ("Delete * from blog_tag where blog_ID="&blog_ED&"")
				znwl.execute ("Delete * from blog_tags where TagBlogCount=0")
End Sub

'显示TAGS分类
Sub TagsList(tMode)
Dim TagRS,MAXTag
IF tMode="Hot" Then
   Sql="Select TOP 20 * from blog_tags order by TagBlogCount desc, CreateDate asc"
Else
   Sql="Select * from blog_tags order by CreateDate desc"
End IF
Set TagRS = Server.CreateObject("Adodb.RecordSet")
TagRS.Open Sql,znwl,1,1
IF TagRS.Eof AND TagRS.Bof Then
   Response.Write ("目前没有 Tags 分类。")
Else
   '得到当前最多日志分类数
			MAXTag=znwl.Execute("select top 1 TagBlogCount From Blog_Tags Order By TagBlogCount Desc")(0)
   Do While Not TagRS.Eof
	  IF TagRS("TagBlogCount")>=cint(MAXTag*0.2) AND TagRS("TagBlogCount")<=cint(MAXTag*0.6) Then
	     Response.Write ("<a href=""BloglistTag.asp?tags="&Server.URLEncode(TagRS("TagName"))&"""><span class=""Tag_size2"" title=""此Tag共有"&TagRS("TagBlogCount")&"篇日志"">" & TagRS("TagName") & "</span></a>")
	  ElseIF TagRS("TagBlogCount")>cint(MAXTag*0.6) AND TagRS("TagBlogCount")<=cint(MAXTag*0.9) Then
	     Response.Write ("<a href=""BloglistTag.asp?tags="&Server.URLEncode(TagRS("TagName"))&"""><span class=""Tag_size3"" title=""此Tag共有"&TagRS("TagBlogCount")&"篇日志"">" & TagRS("TagName") & "</span></a>")
	  ElseIF TagRS("TagBlogCount")>cint(MAXTag*0.9) Then
	     Response.Write ("<a href=""BloglistTag.asp?tags="&Server.URLEncode(TagRS("TagName"))&"""><span class=""Tag_size4"" title=""此Tag共有"&TagRS("TagBlogCount")&"篇日志"">" & TagRS("TagName") & "</span></a>")
	  Else
	     Response.Write ("<a href=""BloglistTag.asp?tags="&Server.URLEncode(TagRS("TagName"))&"""><span class=""Tag_size1"" title=""此Tag共有"&TagRS("TagBlogCount")&"篇日志"">" & TagRS("TagName") & "</span></a>")
	  End IF
	  Response.Write (" | ")
	  TagRS.MoveNext
			Loop
End IF
TagRS.Close
Set TagRS=NoThing
End Sub

%>
12

function.asp - 源码说明

本页面展示了「一套非常实用的博客源代码,功能全,界面简单易用.」中的 function.asp 源码文件，采用 ASP 编程语言编写，共 752 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与博客系统相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?