首页 > > 网络编程 > Asp编程 >

ASP开发中有用的函数（function）集合(2)

2009-05-12 15:14:59来源：未知阅读 ()

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"-"&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

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有