'---------------------------------------------------------------------
'Function: Scan the element mItem whether it is in the element list strItemList
'Parameters: stritemList (the scanned element list, each element is separated by a comma), mItem (to match the element)
'Return: True(found)/False
'Example: 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
'Troubleshooting the conversion problem of logical expressions
Public Function translate(sourceStr, fieldStr)
Dim sourceList
Dim resultStr
Dim i, j
If InStr(sourceStr, " ") > 0 Then
Dim isOperator
isOperator = True
sourceList = Split(sourceStr)
'--------------------------------------------------------
' "num:" & cstr(ubound(sourceList)) & "<br>"
For i = 0 To UBound(sourceList)
' i
Select Case UCase(sourceList(i))
Case "AND", "&", "and", "and"
resultStr = resultStr & " and "
isOperator = True
Case "OR", "|","or"
resultStr = resultStr & " or "
isOperator = True
Case "NOT","!","No","!"!"!"!"!"!"
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
' resultStr+"<br>"
Next
translate = resultStr
Else 'Single condition
If InStr(sourceStr, "%") > 0 Then
translate = " " & fieldStr & " like '" & Replace(sourceStr, "'", "''") & "' "
Else
translate = " " & fieldStr & " like '%" & Replace(sourceStr, "'", "''") & "%' "
End If
'Add a space before and after each to avoid forgetting to add it when interchanging SQL and making an error.
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
= True
= 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
= "^[\d]{8}$"
If Not (sStr) Then Exit Function
If sStr <> sDate Then Exit Function
Case 15
= "^[\d]{15}$"
If Not (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
= "^(?:[\d]{18}|[\d]{17}X)$"
If Not (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
'Record query error event
Public Function SaveSQLLOG(sCommand, message)
Dim Log_ConnStr, Log_Conn, ldb, sql, Rs
ldb = "data/SQL_LOG.mdb"
Log_ConnStr = "Provider = .4.0;Data Source = " & (ldb)
Set Log_Conn = ("")
Log_Conn.open Log_ConnStr
Set Rs = ("")
sql = "select * from Mesky_sql_log"
sql, Log_Conn, 1, 3
Rs("ScriptName") = ScriptName
Rs("S_Info") = Left(sCommand, 255)
Rs("ip") = UserTrueIP
Set Rs = Nothing
Log_Conn.Execute (sql)
Log_Conn.Close
Set Log_Conn = Nothing
SaveSQLLOG = message
End Function
'IP/Source
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/"
aConnStr = "Provider = .4.0;Data Source = " & (adb)
Set aConn = ("")
aConnStr
sql = "select top 1 country,city from Mesky_address where ip1 <=" & num & " and ip2 >=" & num & ""
Set irs = (sql)
If And Then
country = "Asia"
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 = "Unknown"
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 = ("HTTP_USER_AGENT")
'Agent="Opera/7.23 (X11; Linux i686; U) [en]"
If Left(Agent, 7) = "Mozilla" Then 'There is this identification as a browser
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 'There is this identification as a browser
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
'Identify search engines
Dim botlist, i
botlist = "Google,Isaac,Webdup,SurveyBot,Baiduspider,ia_archiver,,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) & "Searcher"
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 'Official site blocks this sentence Customers' Remove blocking
'Record unknown Agent
If Browser = "unknown" Or Version = "unknown" Or platform = "unknown" Then
Agent = (("HTTP_USER_AGENT"))
Dim Log_ConnStr, Log_Conn, Log_db, Rs
Log_db = "data/SQL_LOG.mdb"
Log_ConnStr = "Provider = .4.0;Data Source = " & (Log_db)
Set Log_Conn = ("")
Log_Conn.open Log_ConnStr
Set Rs = Log_Conn.Execute("select * from [Agent] where UserAgent='" & Agent & "'")
If 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 %>