Recommended: Useful collection of functions in ASP development (3) A collection of useful functions in ASP development is quite useful, please keep it! '*************************************** 'Slice content-Split by line'****************************** Function SplitLines(byVal Content,byVal ContentNums) Dim ts,i,l ContentNums=int(
A collection of useful functions in ASP development is quite useful, please keep it!
'******************************************
'Filter hyperlinks
'******************************************
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)(script:)
Str = re.replace(Str,1script)
re.Pattern=(s)(script)
Str = re.replace(Str,1script)
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
'******************************************
'Filter file name
'******************************************
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
'******************************************
'Filter special characters
'******************************************
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
'******************************************
'Restore special characters
'******************************************
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
'******************************************
'Convert HTML code
'******************************************
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
'******************************************
'Inverse conversion HTML code
'******************************************
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
'******************************************
'Recover&character
'******************************************
function ClearHTML(ByVal reString)
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, &, &)
ClearHTML = Str
End If
End Function
'******************************************
'Filter 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
'******************************************
'Filter HTML code
'******************************************
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
'******************************************
'Date conversion 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, 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 Ymd
DateToStr=Year(DateTime)-&DateMonth-&DateDay
Case Ymd H:IA
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 Ymd 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,dmy 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 ym-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
'******************************************
'Pagination 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=First Page></a></li>
MultiPage=MultiPage<li class=pageNumber>
if Curpage<>1 then MultiPage=MultiPage<a href=&Urlpage=1 title=First page 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=Previous pagestyle=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=Next page style=text-decoration:none&ShortCut></a>
if Curpage<>pages then MultiPage=MultiPage<a href=&Urlpage=&Pages&aname title=last page 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=last page></a></li>
MultiPage=MultiPage</ul></div>
' End If
FirstShortCut=true
End Function
Share: ASP's general function to determine whether the database value is empty Due to different properties of various fields, the methods to determine whether a field is empty are also different. The following is a general function, which avoids the pain of field type. 'Check a variable isn't empty Function IsBlank(ByRef TempVar) 'by default, assume it's not blank IsBlank = False 'now check by variable t