pjblog2的参数第1/2页 - 站长资源库


答案：<%  
'=============================================================== 
'  Function For PJblog2 
'    更新时间: 2006-6-2 
'=============================================================== 
'************************************* 
'防止外部提交 
'************************************* 
function ChkPost()  
  dim server_v1,server_v2 
  chkpost=false 
  server_v1=Cstr(Request.ServerVariables("HTTP_REFERER")) 
  server_v2=Cstr(Request.ServerVariables("SERVER_NAME")) 
  If Mid(server_v1,8,Len(server_v2))<>server_v2 then 
    chkpost=False 
  else 
   chkpost=True 
  end If 
 end function 

'************************************* 
'IP过滤 
'*************************************  
function MatchIP(IP) 
 on error resume next 
 MatchIP=false 
 Dim SIp,SplitIP 
 for each SIp in FilterIP 
    SIp=replace(SIp,"*","\d*") 
    SplitIP=split(SIp,".") 
    Dim re, strMatchs,strIP 
     Set re=new RegExp 
      re.IgnoreCase =True 
      re.Global=True 
      re.Pattern="("&SplitIP(0)&"|)."&"("&SplitIP(1)&"|)."&"("&SplitIP(2)&"|)."&"("&SplitIP(3)&"|)" 
     Set strMatchs=re.Execute(IP) 
      strIP=strMatchs(0).SubMatches(0) & "." & strMatchs(0).SubMatches(1)& "." & strMatchs(0).SubMatches(2)& "." & strMatchs(0).SubMatches(3) 
     if strIP=IP then MatchIP=true:exit function 
     Set strMatchs=Nothing 
     Set re=Nothing 
 next  
end function 
'************************************* 
'获得注册码 
'*************************************   
Function getcode()  
    getcode= "<img src=""common/getcode.asp"" alt="""" style=""margin-right:40px;""/>"         
End Function 
'************************************* 
'限制上传文件类型 
'*************************************   
Function IsvalidFile(File_Type) 
    IsvalidFile = False 
    Dim GName 
    For Each GName in UP_FileType 
        If File_Type = GName Then 
            IsvalidFile = True 
            Exit For 
        End If 
    Next 
End Function 

'************************************* 
'限制插件名称 
'*************************************   
Function IsvalidPlugins(Plugins_Name)  
 dim NoAllowNames,NoAllowName 
 NoAllowNames="user,bloginfo,calendar,comment,search,links,archive,category,contentlist" 
 NoAllowName=split(NoAllowNames,",") 
    IsvalidPlugins = true 
    Dim GName 
    Plugins_Name=trim(lcase(Plugins_Name)) 
    For Each GName in NoAllowName 
        If Plugins_Name = GName Then 
             IsvalidPlugins = false 
            Exit For 
        End If 
    Next 
End Function 

'************************************* 
'检测是否只包含英文和数字 
'*************************************  
Function IsValidChars(str) 
    Dim re,chkstr 
    Set re=new RegExp 
    re.IgnoreCase =true 
    re.Global=True 
    re.Pattern="[^_\.a-zA-Z\d]" 
    IsValidChars=True 
    chkstr=re.Replace(str,"") 
    if chkstr<>str then IsValidChars=False 
    set re=nothing 
End Function 
'************************************* 
'检测是否只包含英文和数字 
'*************************************  
Function IsvalidValue(ArrayN,Str) 
    IsvalidValue = false 
    Dim GName 
    For Each GName in ArrayN 
        If Str = GName Then 
             IsvalidValue = true 
            Exit For 
        End If 
    Next 
End Function  
'************************************* 
'检测是否有效的数字 
'************************************* 
Function IsInteger(Para)  
    IsInteger=False 
    If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then 
        IsInteger=True 
    End If 
End Function 
'************************************* 
'用户名检测 
'************************************* 
Function IsValidUserName(byVal UserName) 
    on error resume next 
    Dim i,c 
    Dim VUserName 
    IsValidUserName = True 
    For i = 1 To Len(UserName) 
        c = Lcase(Mid(UserName, i, 1)) 
        If InStr("$!<>?#^%@~`&*();:+='""     ", c) > 0 Then 
                IsValidUserName = False 
                Exit Function 
        End IF 
    Next 
    For Each VUserName in Register_UserName 
        If UserName = VUserName Then 
            IsValidUserName = False 
            Exit For 
        End If 
    Next 
End Function 
'************************************* 
'检测是否有效的E-mail地址 
'************************************* 
Function IsValidEmail(Email)  
    Dim names, name, i, c 
    IsValidEmail = True 
    Names = Split(email, "@") 
    If UBound(names) <> 1 Then 
           IsValidEmail = False 
           Exit Function 
    End If 
    For Each name IN names 
        If Len(name) <= 0 Then 
             IsValidEmail = False 
             Exit Function 
           End If 
           For i = 1 to Len(name) 
             c = Lcase(Mid(name, i, 1)) 
             If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then 
                   IsValidEmail = false 
                   Exit Function 
             End If 
           Next 
           If Left(name, 1) = "." or Right(name, 1) = "." Then 
              IsValidEmail = false 
              Exit Function 
           End If 
    Next 
    If InStr(names(1), ".") <= 0 Then 
           IsValidEmail = False 
           Exit Function 
    End If 
    i = Len(names(1)) - InStrRev(names(1), ".") 
    If i <> 2 And i <> 3 Then 
           IsValidEmail = False 
           Exit Function 
    End If 
    If InStr(email, "..") > 0 Then 
           IsValidEmail = False 
    End If 
End Function 
'************************************* 
'加亮关键字 
'************************************* 
Function highlight(byVal strContent,byRef arrayWords) 
    Dim intCounter,strTemp,intPos,intTagLength,intKeyWordLength,bUpdate 
    if len(arrayWords)<1 then highlight=strContent:exit function 
    For intPos = 1 to Len(strContent) 
        bUpdate = False 
        If Mid(strContent, intPos, 1) = "<" Then 
            On Error Resume Next 
            intTagLength = (InStr(intPos, strContent, ">", 1) - intPos) 
            if err then 
              highlight=strContent 
              err.clear 
            end if 
            strTemp = strTemp & Mid(strContent, intPos, intTagLength) 
            intPos = intPos + intTagLength 
        End If 
            If arrayWords <> "" Then 
                intKeyWordLength = Len(arrayWords) 
                If LCase(Mid(strContent, intPos, intKeyWordLength)) = LCase(arrayWords) Then 
                    strTemp = strTemp & "<span class=""high1"">" & Mid(strContent, intPos, intKeyWordLength) & "</span>" 
                    intPos = intPos + intKeyWordLength - 1 
                    bUpdate = True 
                End If 
            End If 
        If bUpdate = False Then 
            strTemp = strTemp & Mid(strContent, intPos, 1) 
        End If 
    Next 
    highlight = strTemp 
End 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.Patter
上一个：简单分页函数一常用
下一个：CHR(10)表示换行，CHR(13)表示回车，CHR(32)表示空格
更多图片编程知识: