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

ASP
ASP调用ORACLE存储过程并返回结果集
用ASP实现网页BBS
关于Global.asa文件的深入研究与session变量失效提示的具体方法
简易ASP+注册系统
防护手册：如何防止ASP木马在服务器上运行
用Visual Basic实现多画面播放功能之二
如何增强ASP程序性能(1)
如何增强ASP程序性能(2)
如何增强ASP程序性能(3)
ASP备份数据库
二十八条改善 ASP 性能和外观的技巧
在Form域中Post大于100K的数据
如何使用ASP制作模似动态生长的表单?
Microsoft IIS 真的如此「不安全」吗？(1)
Microsoft IIS 真的如此「不安全」吗？(2)
Microsoft IIS 真的如此「不安全」吗？(3)
Microsoft IIS 真的如此「不安全」吗？(4)
Microsoft IIS 真的如此「不安全」吗？(5)
关于页面和代码分离
ServerVariables 对路径的操作

No. « 135 136 137 138 »

技术文章搜索

关键字

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

出处:互联网   整理: 软晨网（RuanChen.com）   发布: 2009-08-14   浏览: 203 ::
收藏到网摘: 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