function.asp
来自「我的小网站个人利用业余时间设计的」· ASP 代码 · 共 300 行
ASP
300 行
<%
Function getUrlEncodel(byVal Url)
Dim i,code
getUrlEncodel=""
IF trim(Url)="" Then Exit Function
For i=1 To len(Url)
code=Asc(mid(Url,i,1))
IF code<0 Then code = code + 65536
IF code>255 Then
getUrlEncodel=getUrlEncodel&"%"&Left(Hex(Code),2)&"%"&Right(Hex(Code),2)
Else
getUrlEncodel=getUrlEncodel&mid(Url,i,1)
End IF
Next
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 IsInteger(Para) '检测是否有效的数字
IsInteger=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
IsInteger=True
End If
End Function
Function CheckStr(Chkstr) '检查无效字符
Dim Str:Str=Chkstr
IF isnull(Str) Then
CheckStr = ""
Exit Function
End IF
Str=replace(Str,"'","''")
CheckStr=Trim(Str)
End Function
Function HTMLEncode(reString) '转换HTML代码
Dim Str:Str=reString
IF Not isnull(Str) Then
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 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
IF Len(DateMinute)<2 Then DateMinute="0"&DateMinute
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
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(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(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
DateToStr=Year(DateTime)&"-"&DateMonth&"-"&DateDay&" "&DateHour&":"&DateMinute
End Select
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(ByRef Numbers,Perpage,Curpage,Url_Add) '分页函数
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=Int(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'><<</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&"] >></a>"
Else
MultiPage=MultiPage&"<a href='"&Url&"page="&Pages&"'>>></a>"
End IF
End IF
End Function
Function SplitLines(Content,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, v
Dim c(39)
tempS = ""
c(1) = "a": c(2) = "b": c(3) = "c": c(4) = "d": c(5) = "e": c(6) = "f": c(7) = "g"
c(8) = "h": c(9) = "i": c(10) = "j": c(11) = "k": c(12) = "l": c(13) = "m": c(14) = "n"
c(15) = "o": c(16) = "p": c(17) = "q": c(18) = "r": c(19) = "s": c(20) = "t": c(21) = "u"
c(22) = "v": c(23) = "w": c(24) = "x": c(25) = "y": c(26) = "z": c(27) = "1": c(28) = "2"
c(29) = "3": c(30) = "4": c(31) = "5": c(32) = "6": c(33) = "7": c(34) = "8": c(35) = "9"
c(36) = "-": c(37) = "_": c(38) = "@": c(39) = "!"
If isNumeric(Length) = False Then
Response.Write "随机字符串的长度必须是数字！"
Exit Function
End If
For i = 1 to Length
Randomize
v = Int((39 * Rnd) + 1)
tempS = tempS & c(v)
Next
Generator = tempS
End Function
Function cutStr(str,strlen) '截取字符串
dim l,t,c,i
l=len(str)
t=0
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=strlen then
cutStr=left(str,i)&"..."
exit for
else
cutStr=str
end if
next
cutStr=replace(cutStr,chr(10),"")
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
%>⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?