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

ajax

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