ASP开发中有用的函数(function)集合(2)_ASP教程

'*************************************
'过滤超链接
'*************************************
Function checkURL(ByVal ChkStr)
Dim str:str=ChkStr
str=Trim(str)
If IsNull(str) Then
checkURL = ""
Exit Function
End If
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="(d)(ocument\.cookie)"
Str = re.replace(Str,"1ocument cookie")
re.Pattern="(d)(ocument\.write)"
Str = re.replace(Str,"1ocument write")
re.Pattern="(s)(cript:)"
Str = re.replace(Str,"1cript ")
re.Pattern="(s)(cript)"
Str = re.replace(Str,"1cript")
re.Pattern="(o)(bject)"
Str = re.replace(Str,"1bject")
re.Pattern="(a)(pplet)"
Str = re.replace(Str,"1pplet")
re.Pattern="(e)(mbed)"
Str = re.replace(Str,"1mbed")
Set re=Nothing
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
checkURL=Str
end function

'*************************************
'过滤文件名字
'*************************************
Function FixName(UpFileExt)
If IsEmpty(UpFileExt) Then Exit Function
FixName = Ucase(UpFileExt)
FixName = Replace(FixName,Chr(0),"")
FixName = Replace(FixName,".","")
FixName = Replace(FixName,"ASP","")
FixName = Replace(FixName,"ASA","")
FixName = Replace(FixName,"ASPX","")
FixName = Replace(FixName,"CER","")
FixName = Replace(FixName,"CDX","")
FixName = Replace(FixName,"HTR","")
End Function

'*************************************
'过滤特殊字符
'*************************************
Function CheckStr(byVal ChkStr)
Dim Str:Str=ChkStr
If IsNull(Str) Then
CheckStr = ""
Exit Function
End If
Str = Replace(Str, "&", "&")
Str = Replace(Str,"'","'")
Str = Replace(Str,"""",""")
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="(w)(here)"
Str = re.replace(Str,"1here")
re.Pattern="(s)(elect)"
Str = re.replace(Str,"1elect")
re.Pattern="(i)(nsert)"
Str = re.replace(Str,"1nsert")
re.Pattern="(c)(reate)"
Str = re.replace(Str,"1reate")
re.Pattern="(d)(rop)"
Str = re.replace(Str,"1rop")
re.Pattern="(a)(lter)"
Str = re.replace(Str,"1lter")
re.Pattern="(d)(elete)"
Str = re.replace(Str,"1elete")
re.Pattern="(u)(pdate)"
Str = re.replace(Str,"1pdate")
re.Pattern="(\s)(or)"
Str = re.replace(Str,"1or")
Set re=Nothing
CheckStr=Str
End Function

'*************************************
'恢复特殊字符
'*************************************
Function UnCheckStr(ByVal Str)
If IsNull(Str) Then
UnCheckStr = ""
Exit Function
End If
Str = Replace(Str,"'","'")
Str = Replace(Str,""","""")
Dim re
Set re=new RegExp
re.IgnoreCase =True
re.Global=True
re.Pattern="(w)(here)"
str = re.replace(str,"1here")
re.Pattern="(s)(elect)"
str = re.replace(str,"1elect")
re.Pattern="(i)(nsert)"
str = re.replace(str,"1nsert")
re.Pattern="(c)(reate)"
str = re.replace(str,"1reate")
re.Pattern="(d)(rop)"
str = re.replace(str,"1rop")
re.Pattern="(a)(lter)"
str = re.replace(str,"1lter")
re.Pattern="(d)(elete)"
str = re.replace(str,"1elete")
re.Pattern="(u)(pdate)"
str = re.replace(str,"1pdate")
re.Pattern="(\s)(or)"
Str = re.replace(Str,"1or")
Set re=Nothing
Str = Replace(Str, "&", "&")
UnCheckStr=Str
End Function

'*************************************
'转换HTML代码
'*************************************
Function HTMLEncode(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
Str = Replace(Str, CHR(9), " ")
Str = Replace(Str, CHR(32), " ")
Str = Replace(Str, CHR(39), "'")
Str = Replace(Str, CHR(34), """)
Str = Replace(Str, CHR(13), "")
Str = Replace(Str, CHR(10), "<br/>")
HTMLEncode = Str
End If
End Function

'*************************************
'反转换HTML代码
'*************************************
Function HTMLDecode(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
Str = Replace(Str, " ", CHR(9))
Str = Replace(Str, " ", CHR(32))
Str = Replace(Str, "'", CHR(39))
Str = Replace(Str, """, CHR(34))
Str = Replace(Str, "", CHR(13))
Str = Replace(Str, "<br/>", CHR(10))
HTMLDecode = Str
End If
End Function

'*************************************
'恢复&字符
'*************************************
function ClearHTML(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, "&", "&")
ClearHTML = Str
End If
End Function

'*************************************
'过滤textarea
'*************************************
Function UBBFilter(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, "</textarea>", "</textarea>")
UBBFilter = Str
End If
End Function

'*************************************
'过滤HTML代码
'*************************************
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,DateWeek,DateSecond
Dim FullWeekday,shortWeekday,Fullmonth,Shortmonth,TimeZone1,TimeZone2
TimeZone1="+0800"
TimeZone2="+08:00"
FullWeekday=Array("Sunday","Monday","Tuesday","Wednesday","Thursday","Friday","Saturday")
shortWeekday=Array("Sun","Mon","Tue","Wed","Thu","Fri","Sat")
Fullmonth=Array("January","February","March","April","May","June","July","August","September","October","November","December")
Shortmonth=Array("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec")

DateMonth=Month(DateTime)
DateDay=Day(DateTime)
DateHour=Hour(DateTime)
DateMinute=Minute(DateTime)
DateWeek=weekday(DateTime)
DateSecond=Second(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"
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 "ymd"
DateToStr=Right(Year(DateTime),4)&DateMonth&DateDay
Case "mdy"
Dim DayEnd
select Case DateDay
Case 1
DayEnd="st"
Case 2
DayEnd="nd"
Case 3
DayEnd="rd"
Case Else
DayEnd="th"
End Select
DateToStr=Fullmonth(DateMonth-1)" "&DateDay&DayEnd" "&Right(Year(DateTime),4)
Case "w,d m y H:I:S"
DateSecond=Second(DateTime)
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=shortWeekday(DateWeek-1)","&DateDay" "& Left(Fullmonth(DateMonth-1),3) " "&Right(Year(DateTime),4)" "&DateHour":"&DateMinute":"&DateSecond" "&TimeZone1
Case "y-m-dTH:I:S"
If Len(DateHour)<2 Then DateHour="0"&DateHour
If Len(DateSecond)<2 Then DateSecond="0"&DateSecond
DateToStr=Year(DateTime)"-"&DateMonth"-"&DateDay"T"&DateHour":"&DateMinute":"&DateSecond&TimeZone2
Case Else
If Len(DateHour)<2 Then DateHour="0"&DateHour
DateToStr=Year(DateTime)"-"&DateMonth"-"&DateDay" "&DateHour":"&DateMinute
End Select
End Function

'*************************************
'分页函数
'*************************************
dim FirstShortCut,ShortCut
FirstShortCut=false
Function MultiPage(Numbers,Perpage,Curpage,Url_Add,aname,Style)
CurPage=Int(Curpage)
Numbers=Int(Numbers)
Dim URL
URL=Request.ServerVariables("Script_Name")&Url_Add
MultiPage=""
Dim Page,Offset,PageI
' If Int(Numbers)>Int(PerPage) Then
Page=9
Offset=4
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="<div class=""page"" style="""&Style"""><ul>"
'if Curpage<>1 then MultiPage=MultiPage&"<li class=""PageL""><a href="""&Url&"page=1"" class=""PageLbutton"" title=""第一页""></a></li>"
MultiPage=MultiPage"<li class=""pageNumber"">"
if Curpage<>1 then MultiPage=MultiPage"<a href="""&Url"page=1"" title=""第一页"" style=""text-decoration:none""><</a> | "
if not FirstShortCut then ShortCut=" accesskey="",""" else ShortCut=""
if Curpage<>1 then MultiPage=MultiPage"<a href="""&Url"page="&CurPage-1""" title=""上一页"" style=""text-decoration:none;"""&ShortCut"></a>"
For PageI=FromPage TO ToPage
If PageI<>CurPage Then
MultiPage=MultiPage"<a href="""&Url"page="&PageI&aname""">"&PageI"</a> | "
Else
MultiPage=MultiPage"<strong>"&PageI"</strong>"
if PageI<>Pages then MultiPage=MultiPage" | "
End If
Next
if not FirstShortCut then ShortCut=" accesskey="".""" else ShortCut=""
if Curpage<>pages then MultiPage=MultiPage"<a href="""&Url"page="&CurPage+1""" title=""下一页"" style=""text-decoration:none"""&ShortCut"></a>"
if Curpage<>pages then MultiPage=MultiPage"<a href="""&Url"page="&Pages&aname""" title=""最后一页"" style=""text-decoration:none"">></a>"
MultiPage=MultiPage"</li>"
'If Int(Pages)>Int(Page) Then
' MultiPage=MultiPage&"<li>...</li><li><a href="""&Url&"page="&Pages&aname&""">"&pages&"</a></li>"
'End If
'if Curpage<>pages then MultiPage=MultiPage&"<li class=""PageR""><a href="""&Url&"page="&Pages&aname&""" class=""PageRbutton"" title=""最后一页""></a></li>"
MultiPage=MultiPage"</ul></div>"
' End If
FirstShortCut=true
End Function