cls_main.asp

    '---------------------------------------------------------------------
    '函数：扫描元素mItem是否在元素列表strItemList中
    '参数：stritemList(被扫描元素列表，各元素以逗号隔开),mItem(欲匹配元素)
    '返回：True(找到)/False
    '例：ItemInList("1","1,2,3") = True
    '----------------------------------------------------------------------
    Public Function ItemInList(strItemList, mItem)
        ItemInList = False
        If IsNull(strItemList) Or IsNull(mItem = "") Then Exit Function
        strItemList = Replace(strItemList, " ", "")
        If InStr("," & strItemList & ",", "," & mItem & ",") >= 1 Then
            ItemInList = True
        End If
    End Function
    '处理逻辑表达式的转化问题
    Public Function translate(sourceStr, fieldStr)
        Dim sourceList
        Dim resultStr
        Dim i, j
        If InStr(sourceStr, " ") > 0 Then
            Dim isOperator
            isOperator = True
            sourceList = Split(sourceStr)
            '--------------------------------------------------------
            ' Response.Write "num:" & cstr(ubound(sourceList)) & "<br>"
            For i = 0 To UBound(sourceList)
                ' Response.Write i
                Select Case UCase(sourceList(i))
                Case "AND", "&", "和", "与"
                    resultStr = resultStr & " and "
                    isOperator = True
                Case "OR", "|", "或"
                    resultStr = resultStr & " or "
                    isOperator = True
                Case "NOT", "!", "非", "！", "！"
                    resultStr = resultStr & " not "
                    isOperator = True
                Case "(", "（", "（"
                    resultStr = resultStr & " ( "
                    isOperator = True
                Case ")", "）", "）"
                    resultStr = resultStr & " ) "
                    isOperator = True
                Case Else
                    If sourceList(i) <> "" Then
                        If Not isOperator Then resultStr = resultStr & " and "
                        If InStr(sourceList(i), "%") > 0 Then
                            resultStr = resultStr & " " & fieldStr & " like '" & Replace(sourceList(i), "'", "''") & "' "
                        Else
                            resultStr = resultStr & " " & fieldStr & " like '%" & Replace(sourceList(i), "'", "''") & "%' "
                        End If
                        isOperator = False
                    End If
                End Select
                ' Response.write resultStr+"<br>"
            Next
            translate = resultStr
        Else '单条件
            If InStr(sourceStr, "%") > 0 Then
                translate = " " & fieldStr & " like '" & Replace(sourceStr, "'", "''") & "' "
            Else
                translate = " " & fieldStr & " like '%" & Replace(sourceStr, "'", "''") & "%' "
            End If
            ' 前后各加一个空格，免得连sql时忘了加，而出错。
        End If
    End Function

    Public Function CheckIDCard(sStr, ByVal dDate, ByVal nSex)
        CheckIDCard = False
        If IsNull(sStr) Or sStr = "" Then Exit Function
        If Not IsDate(dDate) Or dDate = "" Then Exit Function
        If Not IsNumeric(nSex) Or nSex = "" Then Exit Function

        Dim oRE, sDate

        Set oRE = New RegExp
        oRE.IgnoreCase = True
        oRE.Global = True
        nSex = CInt(nSex Mod 2)
        sDate = Year(dDate) & DblNum(Month(dDate)) & DblNum(Day(dDate))

        Select Case Len(sStr)
        Case 8
            If DateDiff("yyyy", dDate, Date) < 19 Then Exit Function
            oRE.Pattern = "^[\d]{8}$"
            If Not oRE.test(sStr) Then Exit Function
            If sStr <> sDate Then Exit Function
        Case 15
            oRE.Pattern = "^[\d]{15}$"
            If Not oRE.test(sStr) Then Exit Function
            If Mid(sStr, 7, 6) <> Right(sDate, 6) Then Exit Function
            If CInt(Mid(sStr, 14, 1)) Mod 2 <> nSex Then Exit Function
        Case 18
            oRE.Pattern = "^(?:[\d]{18}|[\d]{17}X)$"
            If Not oRE.test(sStr) Then Exit Function
            If Mid(sStr, 7, 8) <> sDate Then Exit Function
            If CInt(Mid(sStr, 17, 1)) Mod 2 <> nSex Then Exit Function
            Dim nN, aW, ac, nL
            nN = 0
            aW = Array(7, 9, 10, 5, 8, 4, 2, 1, 6, 3, 7, 9, 10, 5, 8, 4, 2)
            ac = Array("1", "0", "X", "9", "8", "7", "6", "5", "4", "3", "2")
            For nL = 1 To 17
                nN = nN + CInt(Mid(sStr, nL, 1)) * aW(nL - 1)
            Next
            If UCase(Right(sStr, 1)) <> ac(nN Mod 11) Then Exit Function
        Case Else
            Exit Function
        End Select

        Set oRE = Nothing

        CheckIDCard = True
    End Function
    Private Function DblNum(nNum)
        DblNum = nNum
        If DblNum < 10 Then DblNum = "0" & DblNum
    End Function
    '记录查询错误事件
    Public Function SaveSQLLOG(sCommand, message)
        Dim Log_ConnStr, Log_Conn, ldb, sql, Rs
        ldb = "data/SQL_LOG.mdb"
        Log_ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(ldb)
        Set Log_Conn = Server.CreateObject("ADODB.Connection")
        Log_Conn.open Log_ConnStr
        Set Rs = Server.CreateObject("adodb.recordset")
        sql = "select * from Mesky_sql_log"
        Rs.open sql, Log_Conn, 1, 3
        Rs.AddNew
        Rs("ScriptName") = ScriptName
        Rs("S_Info") = Left(sCommand, 255)
        Rs("ip") = UserTrueIP
        Rs.Update
        Rs.Close
        Set Rs = Nothing
        Log_Conn.Execute (sql)
        Log_Conn.Close
        Set Log_Conn = Nothing
        SaveSQLLOG = message
    End Function

    'IP/来源
    Public Function address(sip)
        Dim aConnStr, aConn, adb
        Dim str1, str2, str3, str4
        Dim num
        Dim country, city
        Dim irs, sql
        If IsNumeric(Left(sip, 2)) Then
            If sip = "127.0.0.1" Then sip = "192.168.0.1"
            str1 = Left(sip, InStr(sip, ".") - 1)
            sip = Mid(sip, InStr(sip, ".") + 1)
            str2 = Left(sip, InStr(sip, ".") - 1)
            sip = Mid(sip, InStr(sip, ".") + 1)
            str3 = Left(sip, InStr(sip, ".") - 1)
            str4 = Mid(sip, InStr(sip, ".") + 1)
            If IsNumeric(str1) = 0 Or IsNumeric(str2) = 0 Or IsNumeric(str3) = 0 Or IsNumeric(str4) = 0 Then
            Else
                num = CLng(str1) * 16777216 + CLng(str2) * 65536 + CLng(str3) * 256 + CLng(str4) - 1
                adb = "data/ipaddress.mdb"
                aConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(adb)
                Set aConn = Server.CreateObject("ADODB.Connection")
                aConn.open aConnStr

                sql = "select top 1 country,city from Mesky_address where ip1 <=" & num & " and ip2 >=" & num & ""
                Set irs = aConn.Execute(sql)
                If irs.EOF And irs.BOF Then
                    country = "亚洲"
                    city = ""
                Else
                    country = irs(0)
                    city = irs(1)
                End If
                Set irs = Nothing
                Set aConn = Nothing
                SqlQueryNum = SqlQueryNum + 1
            End If
            address = country & city
        Else
            address = "未知"
        End If
    End Function
end class

Class Cls_Browser
    Public Browser, Version, platform, IsSearch
    Private Sub Class_Initialize()
        Dim Agent, Tmpstr
        IsSearch = False
        If Not IsEmpty(Session("Cls_Browser")) Then
            Tmpstr = Split(Session("Cls_Browser"), "|||")
            Browser = Tmpstr(0)
            Version = Tmpstr(1)
            platform = Tmpstr(2)
            If Tmpstr(3) = "1" Then
                IsSearch = True
            End If
            Exit Sub
        End If
        Browser = "unknown"
        Version = "unknown"
        platform = "unknown"
        Agent = Request.ServerVariables("HTTP_USER_AGENT")
        'Agent="Opera/7.23 (X11; Linux i686; U)  [en]"
        If Left(Agent, 7) = "Mozilla" Then '有此标识为浏览器
            Agent = Split(Agent, ";")
            If InStr(Agent(1), "MSIE") > 0 Then
                Browser = "Microsoft Internet Explorer "
                Version = Trim(Left(Replace(Agent(1), "MSIE", ""), 6))
            ElseIf InStr(Agent(4), "Netscape") > 0 Then
                Browser = "Netscape "
                Tmpstr = Split(Agent(4), "/")
                Version = Tmpstr(UBound(Tmpstr))
            ElseIf InStr(Agent(4), "rv:") > 0 Then
                Browser = "Mozilla "
                Tmpstr = Split(Agent(4), ":")
                Version = Tmpstr(UBound(Tmpstr))
                If InStr(Version, ")") > 0 Then
                    Tmpstr = Split(Version, ")")
                    Version = Tmpstr(0)
                End If
            End If
            If InStr(Agent(2), "NT 5.2") > 0 Then
                platform = "Windows Server 2003"
            ElseIf InStr(Agent(2), "Windows CE") > 0 Then
                platform = "Windows CE"
            ElseIf InStr(Agent(2), "NT 5.1") > 0 Then
                platform = "Windows XP"
            ElseIf InStr(Agent(2), "NT 4.0") > 0 Then
                platform = "Windows NT"
            ElseIf InStr(Agent(2), "NT 5.0") > 0 Then
                platform = "Windows 2000"
            ElseIf InStr(Agent(2), "NT") > 0 Then
                platform = "Windows NT"
            ElseIf InStr(Agent(2), "9x") > 0 Then
                platform = "Windows ME"
            ElseIf InStr(Agent(2), "98") > 0 Then
                platform = "Windows 98"
            ElseIf InStr(Agent(2), "95") > 0 Then
                platform = "Windows 95"
            ElseIf InStr(Agent(2), "Win32") > 0 Then
                platform = "Win32"
            ElseIf InStr(Agent(2), "Linux") > 0 Then
                platform = "Linux"
            ElseIf InStr(Agent(2), "SunOS") > 0 Then
                platform = "SunOS"
            ElseIf InStr(Agent(2), "Mac") > 0 Then
                platform = "Mac"
            ElseIf UBound(Agent) > 2 Then
                If InStr(Agent(3), "NT 5.1") > 0 Then
                    platform = "Windows XP"
                End If
                If InStr(Agent(3), "Linux") > 0 Then
                    platform = "Linux"
                End If
            End If
            If InStr(Agent(2), "Windows") > 0 And platform = "unknown" Then
                platform = "Windows"
            End If
        ElseIf Left(Agent, 5) = "Opera" Then '有此标识为浏览器
            Agent = Split(Agent, "/")
            Browser = "Mozilla "
            Tmpstr = Split(Agent(1), " ")
            Version = Tmpstr(0)
            If InStr(Agent(1), "NT 5.2") > 0 Then
                platform = "Windows 2003"
            ElseIf InStr(Agent(1), "Windows CE") > 0 Then
                platform = "Windows CE"
            ElseIf InStr(Agent(1), "NT 5.1") > 0 Then
                platform = "Windows XP"
            ElseIf InStr(Agent(1), "NT 4.0") > 0 Then
                platform = "Windows NT"
            ElseIf InStr(Agent(1), "NT 5.0") > 0 Then
                platform = "Windows 2000"
            ElseIf InStr(Agent(1), "NT") > 0 Then
                platform = "Windows NT"
            ElseIf InStr(Agent(1), "9x") > 0 Then
                platform = "Windows ME"
            ElseIf InStr(Agent(1), "98") > 0 Then

                platform = "Windows 98"
            ElseIf InStr(Agent(1), "95") > 0 Then
                platform = "Windows 95"
            ElseIf InStr(Agent(1), "Win32") > 0 Then
                platform = "Win32"
            ElseIf InStr(Agent(1), "Linux") > 0 Then
                platform = "Linux"
            ElseIf InStr(Agent(1), "SunOS") > 0 Then
                platform = "SunOS"
            ElseIf InStr(Agent(1), "Mac") > 0 Then
                platform = "Mac"
            ElseIf UBound(Agent) > 2 Then
                If InStr(Agent(3), "NT 5.1") > 0 Then
                    platform = "Windows XP"
                End If
                If InStr(Agent(3), "Linux") > 0 Then
                    platform = "Linux"
                End If
            End If
        Else
            '识别搜索引擎
            Dim botlist, i
            botlist = "Google,Isaac,Webdup,SurveyBot,Baiduspider,ia_archiver,P.Arthur,FAST-WebCrawler,Java,Microsoft-ATL-Native,TurnitinBot,WebGather,Sleipnir"
            botlist = Split(botlist, ",")
            For i = 0 To UBound(botlist)
                If InStr(Agent, botlist(i)) > 0 Then
                    platform = botlist(i) & "搜索器"
                    IsSearch = True
                    Exit For
                End If
            Next
        End If
        If Version <> "unknown" Then
            Dim Tmpstr1
            Tmpstr1 = Trim(Replace(Version, ".", ""))
            If Not IsNumeric(Tmpstr1) Then
                 Version = "unknown"
            End If
        End If
        If IsSearch Then
            Browser = ""
            Version = ""
            Session("Cls_Browser") = Browser & "|||" & Version & "|||" & platform & "|||1"
        Else
            Session("Cls_Browser") = Browser & "|||" & Version & "|||" & platform & "|||0"
        End If

        Exit Sub '官方站屏蔽此句 客户的去掉屏蔽
        '记录未知Agent
        If Browser = "unknown" Or Version = "unknown" Or platform = "unknown" Then
            Agent = Dvbbs.checkStr(Request.ServerVariables("HTTP_USER_AGENT"))
            Dim Log_ConnStr, Log_Conn, Log_db, Rs
            Log_db = "data/SQL_LOG.mdb"
            Log_ConnStr = "Provider = Microsoft.Jet.OLEDB.4.0;Data Source = " & Server.MapPath(Log_db)
            Set Log_Conn = Server.CreateObject("ADODB.Connection")
            Log_Conn.open Log_ConnStr
            Set Rs = Log_Conn.Execute("select * from [Agent] where UserAgent='" & Agent & "'")
            If Rs.EOF Then
                Set Rs = Nothing
                Log_Conn.Execute ("insert into [Agent](UserAgent)Values('" & Agent & "')")
            End If
            Log_Conn.Close
            Set Log_Conn = Nothing
        End If
    End Sub
End Class %>

最新评论