📄 admin_online.asp
字号:
strClass = "class=TableRow1"
Else
strClass = "class=TableRow2"
End If
%>
<tr align=center>
<td <%=strClass%>><input type=checkbox name=id value='<%=Rs("id")%>'></td>
<td <%=strClass%> nowrap><%=FormatDateTime(Rs("CountDate"),1)%></td>
<td <%=strClass%>><%=Rs("UniqueIP")%></td>
<td <%=strClass%>><%=Rs("Pageview")%></td>
<td <%=strClass%>><%=Rs("google")%></td>
<td <%=strClass%>><%=Rs("baidu")%></td>
<td <%=strClass%>><%=Rs("yahoo")%></td>
<td <%=strClass%>><%=Rs("C3721")%></td>
<td <%=strClass%>><%=Rs("zhongsou")%></td>
<td <%=strClass%>><%=Rs("sogou")%></td>
<td <%=strClass%>><%=Rs("other")%></td>
<td <%=strClass%>><%=Rs("DirectInput")%></td>
<td <%=strClass%>><%=Rs("AlexaToolbar")%></td>
</tr>
<%
Rs.movenext
i = i + 1
If i >= maxperpage Then Exit Do
Loop
End If
Rs.Close:Set Rs = Nothing
%>
<tr>
<td class=tablerow1 colspan=13>
<input class=Button type="button" name="chkall" value="全选" onClick="CheckAll(this.form)"><input class=Button type="button" name="chksel" value="反选" onClick="ContraSel(this.form)">
<input class=Button type="submit" name="Submit2" value="删除" onclick="{if(confirm('您确定要删除此统计吗?')){this.document.selform.submit();return true;}return false;}">
<input class=Button type="button" name="Submit3" value="清空所有浏览统计" onclick="{if(confirm('您确定要清空所有浏览统计吗?')){location.href='admin_online.asp?action=removeall';return true;}return false;}"></td>
</tr>
</form>
<tr>
<td class=tablerow2 colspan=13><%Call showpage()%></td>
</tr>
</table>
<%
End Sub
Private Sub DelAllOnline()
Newasp.Execute("DELETE FROM NC_Online")
Call OutputScript ("在线人数全部清除完成！","admin_online.asp")
End Sub
Private Sub DelAllCount()
Newasp.Execute("DELETE FROM NC_SiteCount")
Call OutputScript ("流量统计全部清除完成！","admin_online.asp")
End Sub
Private Sub DelCount()
Dim cid
If Request("id") <> "" Then
cid = Request("id")
Newasp.Execute("DELETE FROM NC_SiteCount WHERE id in (" & cid & ")")
OutHintScript ("流量统计删除成功！")
Else
OutAlertScript("请选择正确的系统参数！")
End If
End Sub
Private Sub DelOnline()
Dim OnlineID
If Request("OnlineID") <> "" Then
OnlineID = Request("OnlineID")
Newasp.Execute("DELETE FROM NC_Online WHERE ID in (" & OnlineID & ")")
OutHintScript ("在线人数删除成功！")
Else
OutAlertScript("请选择正确的系统参数！")
End If
End Sub
Private Sub showpage()
Dim n
If totalnumber Mod maxperpage = 0 Then
n = totalnumber \ maxperpage
Else
n = totalnumber \ maxperpage + 1
End If
Response.Write "<table cellspacing=1 width='100%' border=0><form method=Post action='" & sFileName & "'><tr><td align=center> " & vbCrLf
If CurrentPage < 2 Then
Response.Write "总记录数 <font COLOR=#FF0000><strong>" & totalnumber & "</strong></font> 条 首 页 上一页 | "
Else
Response.Write "总记录数 <font COLOR=#FF0000><strong>" & totalnumber & "</strong></font> 条 <a href=" & sFileName & "page=1>首 页</a> "
Response.Write "<a href=" & sFileName & "page=" & CurrentPage - 1 & ">上一页</a> | "
End If
If n - CurrentPage < 1 Then
Response.Write "下一页 尾 页" & vbCrLf
Else
Response.Write "<a href=" & sFileName & "page=" & (CurrentPage + 1) & ">下一页</a>"
Response.Write " <a href=" & sFileName & "page=" & n & ">尾 页</a>" & vbCrLf
End If
Response.Write " 页次：<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>页 "
Response.Write " 转到："
Response.Write "<input name=page size=3 value='" & CurrentPage & "'> <input class=Button type=submit name=Submit value='转到'>"
Response.Write "</td></tr></FORM></table>" & vbCrLf
End Sub
Private Function usersysinfo(info, getinfo)
Dim usersys
usersys = Split(info, "|")
usersysinfo = usersys(getinfo)
End Function
Public Function GetAddress(sip)
If Len(sip) < 5 Then
GetAddress = "未知"
Exit Function
End If
On Error Resume Next
Dim Wry,IPType
Set Wry = New TQQWry
If Not Wry.IsIp(sip) Then
GetAddress = " 未知"
Exit Function
End If
IPType = Wry.QQWry(sip)
GetAddress = Wry.Country & " " & Wry.LocalStr
End Function
Class TQQWry
' ============================================
' 变量声名
' ============================================
Dim Country, LocalStr, Buf, OffSet
Private StartIP, EndIP, CountryFlag
Public QQWryFile
Public FirstStartIP, LastStartIP, RecordCount
Private Stream, EndIPOff
' ============================================
' 类模块初始化
' ============================================
Private Sub Class_Initialize
On Error Resume Next
Country = ""
LocalStr = ""
StartIP = 0
EndIP = 0
CountryFlag = 0
FirstStartIP = 0
LastStartIP = 0
EndIPOff = 0
QQWryFile = Server.MapPath("../DataBase/IPAddress.dat") 'QQ IP库路径，要转换成物理路径
End Sub
' ============================================
' IP地址转换成整数
' ============================================
Function IPToInt(IP)
Dim IPArray, i
IPArray = Split(IP, ".", -1)
FOr i = 0 to 3
If Not IsNumeric(IPArray(i)) Then IPArray(i) = 0
If CInt(IPArray(i)) < 0 Then IPArray(i) = Abs(CInt(IPArray(i)))
If CInt(IPArray(i)) > 255 Then IPArray(i) = 255
Next
IPToInt = (CInt(IPArray(0))*256*256*256) + (CInt(IPArray(1))*256*256) + (CInt(IPArray(2))*256) + CInt(IPArray(3))
End Function
' ============================================
' 整数逆转IP地址
' ============================================
Function IntToIP(IntValue)
p4 = IntValue - Fix(IntValue/256)*256
IntValue = (IntValue-p4)/256
p3 = IntValue - Fix(IntValue/256)*256
IntValue = (IntValue-p3)/256
p2 = IntValue - Fix(IntValue/256)*256
IntValue = (IntValue - p2)/256
p1 = IntValue
IntToIP = Cstr(p1) & "." & Cstr(p2) & "." & Cstr(p3) & "." & Cstr(p4)
End Function
' ============================================
' 获取开始IP位置
' ============================================
Private Function GetStartIP(RecNo)
OffSet = FirstStartIP + RecNo * 7
Stream.Position = OffSet
Buf = Stream.Read(7)
EndIPOff = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256)
StartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + (AscB(MidB(Buf, 4, 1))*256*256*256)
GetStartIP = StartIP
End Function
' ============================================
' 获取结束IP位置
' ============================================
Private Function GetEndIP()
Stream.Position = EndIPOff
Buf = Stream.Read(5)
EndIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + (AscB(MidB(Buf, 4, 1))*256*256*256)
CountryFlag = AscB(MidB(Buf, 5, 1))
GetEndIP = EndIP
End Function
' ============================================
' 获取地域信息，包含国家和和省市
' ============================================
Private Sub GetCountry(IP)
If (CountryFlag = 1 Or CountryFlag = 2) Then
Country = GetFlagStr(EndIPOff + 4)
If CountryFlag = 1 Then
LocalStr = GetFlagStr(Stream.Position)
' 以下用来获取数据库版本信息
If IP >= IPToInt("255.255.255.0") And IP <= IPToInt("255.255.255.255") Then
LocalStr = GetFlagStr(EndIPOff + 21)
Country = GetFlagStr(EndIPOff + 12)
End If
Else
LocalStr = GetFlagStr(EndIPOff + 8)
End If
Else
Country = GetFlagStr(EndIPOff + 4)
LocalStr = GetFlagStr(Stream.Position)
End If
' 过滤数据库中的无用信息
Country = Trim(Country)
LocalStr = Trim(LocalStr)
If InStr(Country, "CZ88.NET") Then Country = "GZ110.CN"
If InStr(LocalStr, "CZ88.NET") Then LocalStr = "GZ110.CN"
End Sub
' ============================================
' 获取IP地址标识符
' ============================================
Private Function GetFlagStr(OffSet)
Dim Flag
Flag = 0
Do While (True)
Stream.Position = OffSet
Flag = AscB(Stream.Read(1))
If(Flag = 1 Or Flag = 2 ) Then
Buf = Stream.Read(3)
If (Flag = 2 ) Then
CountryFlag = 2
EndIPOff = OffSet - 4
End If
OffSet = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256)
Else
Exit Do
End If
Loop
If (OffSet < 12 ) Then
GetFlagStr = ""
Else
Stream.Position = OffSet
GetFlagStr = GetStr()
End If
End Function
' ============================================
' 获取字串信息
' ============================================
Private Function GetStr()
Dim c
GetStr = ""
Do While (True)
c = AscB(Stream.Read(1))
If (c = 0) Then Exit Do
'如果是双字节，就进行高字节在结合低字节合成一个字符
If c > 127 Then
If Stream.EOS Then Exit Do
GetStr = GetStr & Chr(AscW(ChrB(AscB(Stream.Read(1))) & ChrB(C)))
Else
GetStr = GetStr & Chr(c)
End If
Loop
End Function
' ============================================
' 核心函数，执行IP搜索
' ============================================
Public Function QQWry(DotIP)
Dim IP, nRet
Dim RangB, RangE, RecNo
IP = IPToInt (DotIP)
Set Stream = CreateObject("ADodb.Stream")
Stream.Mode = 3
Stream.Type = 1
Stream.Open
Stream.LoadFromFile QQWryFile
Stream.Position = 0
Buf = Stream.Read(8)
FirstStartIP = AscB(MidB(Buf, 1, 1)) + (AscB(MidB(Buf, 2, 1))*256) + (AscB(MidB(Buf, 3, 1))*256*256) + (AscB(MidB(Buf, 4, 1))*256*256*256)
LastStartIP = AscB(MidB(Buf, 5, 1)) + (AscB(MidB(Buf, 6, 1))*256) + (AscB(MidB(Buf, 7, 1))*256*256) + (AscB(MidB(Buf, 8, 1))*256*256*256)
RecordCount = Int((LastStartIP - FirstStartIP)/7)
' 在数据库中找不到任何IP地址
If (RecordCount <= 1) Then
Country = "未知"
QQWry = 2
Exit Function
End If
RangB = 0
RangE = RecordCount
Do While (RangB < (RangE - 1))
RecNo = Int((RangB + RangE)/2)
Call GetStartIP (RecNo)
If (IP = StartIP) Then
RangB = RecNo
Exit Do
End If
If (IP > StartIP) Then
RangB = RecNo
Else
RangE = RecNo
End If
Loop
Call GetStartIP(RangB)
Call GetEndIP()
If (StartIP <= IP) And ( EndIP >= IP) Then
' 没有找到
nRet = 0
Else
' 正常
nRet = 3
End If
Call GetCountry(IP)
QQWry = nRet
End Function
' ============================================
' 检查IP地址合法性
' ============================================
Public Function IsIp(IP)
IsIp = True
If IP = "" Then IsIp = False : Exit Function
Dim Re
Set Re = New RegExp
Re.Pattern = "^(0|[1-9]\d?|[0-1]\d{2}|2[0-4]\d|25[0-5])\.(0|[1-9]\d?|[0-1]\d{2}|2[0-4]\d|25[0-5])\.(0|[1-9]\d?|[0-1]\d{2}|2[0-4]\d|25[0-5])\.(0|[1-9]\d?|[0-1]\d{2}|2[0-4]\d|25[0-5])$"
Re.IgnoreCase = True
Re.Global = True
IsIp = Re.Test(IP)
Set Re = Nothing
End Function
' ============================================
' 类终结
' ============================================
Private Sub Class_Terminate
On ErrOr Resume Next
Stream.Close
If Err Then Err.Clear
Set Stream = Nothing
End Sub
End Class
Public Function URLDecodes(ByVal str)
If Len(str) < 1 Then Exit Function
On Error Resume Next
Dim Mynewasp
Set Mynewasp = Server.CreateObject("Gatherer.VBProcess")
If Err Then
Err.Clear
Set MyNewCloud = Nothing
URLDecodes = str
Exit Function
End If
URLDecodes = Mynewasp.URLDecode(str)
Set MyNewCloud = Nothing
End Function
%>⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -