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

  
'*************************************   
'检测系统组件是否安装   
'*************************************   
Function CheckObjInstalled(strClassString)   
    On Error Resume Next  
    Dim Temp   
    Err = 0   
    Dim TmpObj   
    Set TmpObj = Server.CreateObject(strClassString)   
    Temp = Err   
    IF Temp = 0 OR Temp = -2147221477 Then  
        CheckObjInstalled=true   
    ElseIF Temp = 1 OR Temp = -2147221005 Then  
        CheckObjInstalled=false   
    End IF   
    Err.Clear    字串7
    Set TmpObj = Nothing  
    Err = 0   
End Function  
  
'*************************************   
'判断服务器Microsoft.XMLDOM   
'*************************************   
Function getXMLDOM   
    On Error Resume Next  
    Dim Temp   
    getXMLDOM="Microsoft.XMLDOM"  
    Err = 0   
    Dim TmpObj   
    Set TmpObj = Server.CreateObject(getXMLDOM)   
    Temp = Err   
    IF Temp = 1 OR Temp = -2147221005 Then  
        getXMLDOM="Msxml2.DOMDocument.5.0"  
    End IF    月落网
    Err.Clear   
    Set TmpObj = Nothing  
    Err = 0   
end function   
  
'*************************************   
'判断服务器MSXML2.ServerXMLHTTP   
'*************************************   
Function getXMLHTTP   
    On Error Resume Next  
    Dim Temp   
    getXMLHTTP="MSXML2.ServerXMLHTTP"  
    Err = 0   
    Dim TmpObj   
    Set TmpObj = Server.CreateObject(getXMLHTTP)   
    Temp = Err   
    IF Temp = 1 OR Temp = -2147221005 Then  
        getXMLHTTP="Msxml2.ServerXMLHTTP.5.0"  

月落

    End IF   
    Err.Clear   
    Set TmpObj = Nothing  
    Err = 0   
end function   
  
'*************************************   
'垃圾关键字过滤   
'*************************************   
function filterSpam(str,path)   
  on error resume next   
     filterSpam = false   
     dim spamXml,spamItem   
     Set spamXml = Server.CreateObject(getXMLDOM)   
       If Err Then     
           Err.clear   
           exit function   
       end if   
     spamXml.async = false     
     spamXml.load(Server.MapPath(path))   
     if spamXml.parseerror.errorcode=0 then   
       For Each spamItem in spamXml.selectNodes("//key")   
            if InStr(Lcase(str),Lcase(spamItem.text))<>0 then   
               filterSpam = true   
               exit function   
            end if   
       next   
     end if   
     set spamXml=nothing   
end function   
  
'*********************************************************   
' 目的：    检查正则式   
' 输入：    id   
' 返回：    成功为True   
'*********************************************************   
Function CheckRegExp(source,para)   
  
    If para="[username]" Then  
        para="^[.A-Za-z0-9\u4e00-\u9fa5]+$"  
    End If  
    If para="[password]" Then  
        para="^[a-z0-9]+$"  
    End If  
    If para="[email]" Then   www.yueluo.net
        para="^([0-9a-zA-Z]([-.\w]*[0-9a-zA-Z])*@([0-9a-zA-Z][-\w]*\.)+[a-zA-Z]*)$"  
    End If  
    If para="[homepage]" Then  
        para="^[a-zA-Z]+://[a-zA-z0-9\-\./]+?/*$"  
    End If  
    If para="[nojapan]" Then  
        para="[\u3040-\u30ff]+"  
    End If  
    If para="[guid]" Then  
        para="^\w{8}\-\w{4}\-\w{4}\-\w{4}\-\w{12}$"  
    End If  
  
    Dim re   
    Set re = New RegExp   
    re.Global = True  

月落

    re.Pattern = para   
    re.IgnoreCase = False  
    CheckRegExp = re.Test(source)   
  
End Function  
  
'**********************************************   
'获取在线人数   
'**********************************************   
function getOnline   
    getOnline=1   
    if len(Application(space_CookieName"_onlineCount"))>0 then   
        if DateDiff("s",Application(space_CookieName"_userOnlineCountTime"),now())>60 then   
                Application.Lock()   
                Application(space_CookieName"_online")=Application(space_CookieName"_onlineCount")   
                Application(space_CookieName"_onlineCount")=1   
                Application(space_CookieName"_onlineCountKey")=randStr(2)   
                Application(space_CookieName"_userOnlineCountTime")=now()   
                Application.Unlock()   
        else   
                if Session(space_CookieName"userOnlineKey")<>Application(space_CookieName"_onlineCountKey") then   
                    Application.Lock()    字串7
                    Application(space_CookieName"_onlineCount")=Application(space_CookieName"_onlineCount")+1   
                    Application.Unlock()   
                    Session(space_CookieName"userOnlineKey")=Application(space_CookieName"_onlineCountKey")   
                end if   
        end if   
    else   
        Application.Lock   
        Application(space_CookieName"_online")=1   
        Application(space_CookieName"_onlineCount")=1   
        Application(space_CookieName"_onlineCountKey")=randStr(2)   
        Application(space_CookieName"_userOnlineCountTime")=now()   
        Application.Unlock   
    end if   
    getOnline=Application(space_CookieName"_online")   
end Function  
  
%> yueluo.net