char.asp

一个用asp实现简单的小型OA系统

<%
Rem 过滤字符

Function ChkBadWords(fString)
    Dim bwords, ii
    If Not(IsNull(BadWords) Or IsNull(fString)) Then
        bwords = Split(BadWords, "|")
        For ii = 0 To UBound(bwords)
            fString = Replace(fString, bwords(ii), String(Len(bwords(ii)), "*"))
        Next
        ChkBadWords = fString
    End If
End Function

Rem 过滤HTML代码

Function HTMLEncode(fString)
    If Not IsNull(fString) Then
        fString = Replace(fString, ">", "&gt;")
        fString = Replace(fString, "<", "&lt;")
        fString = Replace(fString, Chr(0), "", 1, -1, 1)
        fString = Replace(fString, """", "&quot;", 1, -1, 1)
        fString = Replace(fString, "’", "’’", 1, -1, 1)
        fString = Replace(fString, Chr(32), "&nbsp;")
        fString = Replace(fString, Chr(9), "&nbsp;")
        fString = Replace(fString, Chr(34), "&quot;")
        fString = Replace(fString, Chr(39), "&#39;")
        fString = Replace(fString, Chr(13), "")
        fString = Replace(fString, Chr(10) & Chr(10), "</P><P> ")
        fString = Replace(fString, Chr(10), "<BR> ")
        fString = Replace(fString, "'", "’")
        fString = ChkBadWords(fString)
        HTMLEncode = fString
    End If
End Function

Rem 过滤表单字符

Function HTMLcode(fString)
    If Not IsNull(fString) Then
        fString = Replace(fString, Chr(13), "")
        fString = Replace(fString, Chr(10) & Chr(10), "</P><P>")
        fString = Replace(fString, Chr(10), "<BR>")
        HTMLcode = fString
    End If
End Function

Rem 判断发言是否来自外部

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

Rem 过滤SQL非法字符

Function checkStr(Str)
    If IsNull(Str) Then
        checkStr = ""
        Exit Function
    End If
    checkStr = Replace(Str, "'", "’")
    checkStr = Replace(Str, Chr(39), "’")
    checkStr = Replace(Str, "--", "－－")
    CheckStr = Replace(Str, "’", "’’", 1, -1, 1)
End Function

Rem 判断数字是否整形

Function isInteger(para)
    On Error Resume Next
    Dim Str
    Dim l, i
    If IsNull(para) Then
        isInteger = False
        Exit Function
    End If
    Str = CStr(para)
    If Trim(Str) = "" Then
        isInteger = False
        Exit Function
    End If
    l = Len(Str)
    For i = 1 To l
        If Mid(Str, i, 1)>"9" Or Mid(Str, i, 1)<"0" Then
            isInteger = False
            Exit Function
        End If
    Next
    isInteger = True
    If Err.Number<>0 Then Err.Clear
End Function

Rem 是否是有效email

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

Rem 检测字符串长度

Function strLength(Str)
    On Error Resume Next
    Dim WINNT_CHINESE
    WINNT_CHINESE = (Len("论坛") = 2)
    If WINNT_CHINESE Then
        Dim l, t, c
        Dim i
        l = Len(Str)
        t = l
        For i = 1 To l
            c = Asc(Mid(Str, i, 1))
            If c<0 Then c = c + 65536
            If c>255 Then
                t = t + 1
            End If
        Next
        strLength = t
    Else
        strLength = Len(Str)
    End If
    If Err.Number<>0 Then Err.Clear
End Function

Rem 截取定长字符串

Function cutStr(Str, strlen)
    Dim l, t, c
    l = Len(Str)
    t = 0
    For i = 1 To l
        c = Abs(Asc(Mid(Str, i, 1)))
        If c>255 Then
            t = t + 2
        Else
            t = t + 1
        End If
        If t>= strlen Then
            cutStr = Left(Str, i)&"..."
            Exit For
        Else
            cutStr = Str
        End If
    Next
    cutStr = Replace(cutStr, Chr(10), "")
End Function
%>