推荐：ASP开发中有用的函数(function)集合(3)ASP开发中有用的函数（function）集合，挺有用的，请大家保留！ '************************************* '切割内容 - 按行分割 '************************************* Function SplitLines(byVal Content,byVal ContentNums) Dim ts,i,l ContentNums=int(
ASP开发中有用的函数（function）集合，挺有用的，请大家保留！
'*************************************
'过滤超链接
'*************************************
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-&DateDayT&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=&Urlpage=1 title=第一页 style=text-decoration:none><</a> |
if not FirstShortCut then ShortCut= accesskey=, else ShortCut=
if Curpage<>1 then MultiPage=MultiPage<a href=&Urlpage=&CurPage-1 title=上一页 style=text-decoration:none;&ShortCut></a>
For PageI=FromPage TO ToPage
If PageI<>CurPage Then
MultiPage=MultiPage<a href=&Urlpage=&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=&Urlpage=&CurPage+1 title=下一页 style=text-decoration:none&ShortCut></a>
if Curpage<>pages then MultiPage=MultiPage<a href=&Urlpage=&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
分享：ASP判断数据库值是否为空的通用函数由于各种字段属性不同，判断字段是否为空的方法也各异． 下面是一个通用函数，免去了还要看字段类型之苦． 'Check a variable isn't empty Function IsBlank(ByRef TempVar) 'by default, assume it's not blank IsBlank = False 'now check by variable t