网页教学网
 当前位置: 网页教学网 >> 网络编程 >> ASP编程技术 >> ASP开发中有用的函数(function)集合(2)
[ HTML ] [ FW ] [ DW ] [ FP ] [ JS ] [ XML ] [ CSS ] [ 图象 ] [ FLASH ] [ .NET ] [ ASP ] [ JSP ] [ PHP ] [ 数据 ] [ 系统 ] [ 安全 ] [ 素材 ] [ 建站 ] [ 主机 ] [ 入门 ] [ 技巧 ]

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

http://www.webjx.com  更新日期:2007-09-29 08:28  出处:网页教学网  作者:站长整理

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

关键词:ASP,函数
推荐给好友】【关闭】【收藏本文
最新五条评论
查看全部评论
评论总数 0
您的评论
用户名: 新注册) 密 码: 匿名:
·用户发表意见仅代表其个人意见,并且承担一切因发表内容引起的纠纷和责任
·本站管理人员有权在不通知用户的情况下删除不符合规定的评论信息或留做证据
·请客观的评价您所看到的资讯,提倡就事论事,杜绝漫骂和人身攻击等不文明行为
站内搜索
相关文章
推荐文章