?? function.asp
字號:
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&" <a href="""&URL&"page="&PageI&""">"&PageI&"</a>"
Next
If Int(Pages)>Int(Page) Then
ThreadPage=ThreadPage&" ... <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> "
Else
MultiPage_tag=MultiPage_tag&"<b>["&PageI&"]</b> "
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> <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> <span class=""date"">"&DateToStr(tagxg("log_PostTime"),"Y-m-d A")&" "&tagxg("cate_Name")&"</span>"
Else
tagxg_blog = tagxg_blog & "<a href=""BlogView.asp?logID="&tagxg("log_ID")&""">" & tagxg("log_Title") & "</a> <span class=""date"">"&DateToStr(tagxg("log_PostTime"),"Y-m-d A")&" "&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
%>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -