当前位置: 首页 > 图文教程 > 网络编程 > ASP > ASP开发中有用的函数（function）集合(2)

ASP
ASP基础讲座（下）
解决IIS5 HTTP500内部错误
ASP 3.0高级编程（四十六）
ASP 3.0高级编程（四十五）
ASP 3.0高级编程（四十四）
ASP 3.0高级编程（四十三）
ASP 3.0高级编程（四十二）
ASP 3.0高级编程（四十一）
ASP 3.0高级编程（三十九）
ASP 3.0高级编程（三十八）
ASP 3.0高级编程（三十七）
ASP 3.0高级编程（三十六）
ASP 3.0高级编程（三十五）
ASP 3.0高级编程（三十四）
ASP 3.0高级编程（三十三）
ASP 3.0高级编程（三十二）
ASP 3.0高级编程（三十一）
ASP错误代码说明
jscript错误代码及相应解释大全
ASP错误处理

No. « 12 13 14 15 »

技术文章搜索

关键字

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

出处:互联网   整理: 软晨网（RuanChen.com）   发布: 2009-08-14   浏览: 71 ::
收藏到网摘: n/a

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