?? function.asp
字號:
?<%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 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, "[", "[")
Str = Replace(Str, "]", "]")
Str = Replace(Str, "<", "<")
Str = Replace(Str, ">", ">")
Str = Replace(Str, "{", "{")
Str = Replace(Str, "}", "}")
Str = Replace(Str, "|", "|")
Str = Replace(Str, "script", "script")
Str = Replace(Str, "SCRIPT", "SCRIPT")
Str = Replace(Str, "Script", "Script")
Str = Replace(Str, "script", "Script")
Str = Replace(Str, "object", "object")
Str = Replace(Str, "OBJECT", "OBJECT")
Str = Replace(Str, "Object", "Object")
Str = Replace(Str, "object", "Object")
Str = Replace(Str, "applet", "applet")
Str = Replace(Str, "APPLET", "APPLET")
Str = Replace(Str, "Applet", "Applet")
Str = Replace(Str, "applet", "Applet")
Str = Replace(Str, "embed", "embed")
Str = Replace(Str, "EMBED", "EMBED")
Str = Replace(Str, "Embed", "Embed")
Str = Replace(Str, "embed", "Embed")
Str = Replace(Str, "document", "document")
Str = Replace(Str, "DOCUMENT", "DOCUMENT")
Str = Replace(Str, "Document", "Document")
Str = Replace(Str, "document", "Document")
Str = Replace(Str, "cookie", "cookie")
Str = Replace(Str, "COOKIE", "COOKIE")
Str = Replace(Str, "Cookie", "Cookie")
Str = Replace(Str, "cookie", "Cookie")
Str = Replace(Str, "event", "event")
Str = Replace(Str, "EVENT", "EVENT")
Str = Replace(Str, "Event", "Event")
Str = Replace(Str, "event", "Event")
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", "select")
Str = Replace(Str, "join", "join")
Str = Replace(Str, "union", "union")
Str = Replace(Str, "where", "where")
Str = Replace(Str, "insert", "insert")
Str = Replace(Str, "delete", "delete")
Str = Replace(Str, "update", "update")
Str = Replace(Str, "like", "like")
Str = Replace(Str, "drop", "drop")
Str = Replace(Str, "create", "create")
Str = Replace(Str, "modify", "modify")
Str = Replace(Str, "rename", "rename")
Str = Replace(Str, "alter", "alter")
Str = Replace(Str, "cast", "cast")
CheckStr=Str
End Function
Function UnCheckStr(Str)
Str = Replace(Str, "select", "select")
Str = Replace(Str, "join", "join")
Str = Replace(Str, "union", "union")
Str = Replace(Str, "where", "where")
Str = Replace(Str, "insert", "insert")
Str = Replace(Str, "delete", "delete")
Str = Replace(Str, "update", "update")
Str = Replace(Str, "like", "like")
Str = Replace(Str, "drop", "drop")
Str = Replace(Str, "create", "create")
Str = Replace(Str, "modify", "modify")
Str = Replace(Str, "rename", "rename")
Str = Replace(Str, "alter", "alter")
Str = Replace(Str, "cast", "cast")
UnCheckStr=Str
End Function
Function HTMLEncode(reString) '轉換HTML代碼
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = UnCheckStr(Str)
Str = Replace(Str, "&", "&")
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
Str = Replace(Str, CHR(32), " ")
Str = Replace(Str, CHR(9), " ")
Str = Replace(Str, CHR(9), "    ")
Str = Replace(Str, CHR(34),""")
Str = Replace(Str, CHR(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,"&","&")
EditDeHTML=Replace(EditDeHTML,"<","<")
EditDeHTML=Replace(EditDeHTML,">",">")
EditDeHTML=Replace(EditDeHTML,CHR(34),""")
EditDeHTML=Replace(EditDeHTML,CHR(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
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 IsValidUserName(byVal UserName)
Dim i,c
IsValidUserName = True
For i = 1 To Len(UserName)
c = Lcase(Mid(UserName, i, 1))
IF InStr("$!<>?#^%@~`&*(){};:+='"" ", c) > 0 Then
IsValidUserName = False
Exit Function
End IF
Next
End Function
Function IsValidEmail(Email) '檢測是否有效的E-mail地址
Dim names, name, i, c
IsValidEmail = True
Names = Split(email, "@")
If UBound(names) <> 1 Then
IsValidEmail = False
Exit Function
End If
For Each name IN names
If Len(name) <= 0 Then
IsValidEmail = False
Exit Function
End If
For i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
IsValidEmail = false
Exit Function
End If
Next
If Left(name, 1) = "." or Right(name, 1) = "." Then
IsValidEmail = false
Exit Function
End If
Next
If InStr(names(1), ".") <= 0 Then
IsValidEmail = False
Exit Function
End If
i = Len(names(1)) - InStrRev(names(1), ".")
If i <> 2 And i <> 3 Then
IsValidEmail = False
Exit Function
End If
If InStr(email, "..") > 0 Then
IsValidEmail = False
End If
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=""images/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> "
Else
MultiPage=MultiPage&"<b>["&PageI&"]</b> "
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> <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=""images/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%>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -