www.gusucode.com > 全球营销软件站整站源码4月最新数据 4.0源码程序 > 801wyxqf\adminadmin\asked\admin_online.asp

    <!--#include file="const.asp"-->
<%
Admin_header
'=====================================================================
' 软件名称：801w软件代理系统
' 当前版本：801wAsp 801w cn 801w com
' 文件名称：admin_main.asp
' 更新日期：2010-2-16
' 官方网站：801w代理系统(www.801w.cn www.801w.com) QQ：274667447
'=====================================================================
' Copyright 2003-2010 801w.cn - All Rights Reserved.
' 801wasp is a trademark of 801w.cn
'=====================================================================
%>
<table class="table1" cellspacing="1" cellpadding="3" align="center" border="0">
	<tr>
		<td class="tableline linetitle" width="200" align="left">在线列表管理</td>
		<td class="tableline" width="*" align="right"><a href="admin_setting.asp">问吧设置</a>
			 - <a href="admin_online.asp">管理首页</a>
			 - <a href="admin_online.asp?action=zone&ChannelID=<%=ChannelID%>">详细地址</a>
			 - <a href="admin_online.asp?action=refer&ChannelID=<%=ChannelID%>">访问来源</a>
			 - <a href="admin_online.asp?action=delall" onclick="{if(confirm('您确定要删除所有在线人数吗?')){return true;}return false;}"><font color="blue">删除所有在线人数</font></a>
		</td>
	</tr>
</table>
<%
Dim maxperpage,totalrec,Pcount,pagelinks,showmode,pagenow,count
Dim Action,OnlineArry

maxperpage = 30 '###每页显示数
count=NewAsp.ChkNumeric(Request("count"))
pagenow=NewAsp.ChkNumeric(Request("page"))
If pagenow=0 Then pagenow=1
Action = LCase(Request("action"))
If Not ChkAdmin("Online") Then
	Call Transfer_error()
End If
Select Case Trim(Action)
Case "refer"
	Call OnlineReferer()
Case "zone"
	Call OnlineZone()
Case "del"
	Call DelOnline()
Case "delall"
	Call DelAllOnline()
Case "remove"
	Call DelCount()
Case "removeall"
	Call DelAllCount()
Case Else
	Call showmain()
End Select
If FoundErr = True Then
	ReturnError(ErrMsg)
End If
Admin_footer
SaveLogInfo(AdminName)
NewAsp.PageEnd
Ask_CloseConn

Sub showmain()
	Dim i,iCount,lCount
	iCount=2:lCount=2
%>
<table id="tablehovered" border="0" align="center" cellpadding="3" cellspacing="1" class="tableborder">
<tr>
	<th width='5%' nowrap>选择</th>
	<th nowrap>用 户 名</th>
	<th nowrap>访 问 时 间</th>
	<th nowrap>活 动 时 间</th>
	<th nowrap>用 户 IP 地 址</th>
	<th nowrap>操 作 系 统</th>
	<th nowrap>浏 览 器</th>
</tr>
<tr>
	<td class="tablerow1" colspan="7" align="left" id="showNextPage">&nbsp;</td>
</tr>
<form name="selform" method="post" action="?action=del">
<%
	Call showMainOnline()
	If IsArray(OnlineArry) Then
		For i=0 To Ubound(OnlineArry,2)
			If Not Response.IsClientConnected Then Response.End
			If (i mod 2) = 0 Then
				iCount=2:lCount=1
			Else
				iCount=1:lCount=2
			End If
%>
<tr align="center">
	<td class="tablerow<%=iCount%> hovered"><input type="checkbox" name="OnlineID" value="<%=OnlineArry(0,i)%>"></td>
	<td class="tablerow<%=iCount%> hovered"><%=OnlineArry(1,i)%></td>
	<td class="tablerow<%=iCount%> hovered"><%=OnlineArry(2,i)%></td>
	<td class="tablerow<%=iCount%> hovered"><%=OnlineArry(3,i)%></td>
	<td class="tablerow<%=iCount%> hovered"><%=OnlineArry(4,i)%></td>
	<td class="tablerow<%=iCount%> hovered"><%=usersysinfo(OnlineArry(5,i), 0)%></td>
	<td class="tablerow<%=iCount%> hovered"><%=usersysinfo(OnlineArry(5,i), 1)%></td>
</tr>
<%
		Next
	End If
%>
<tr>
	<td class="tablerow<%=lCount%>" colspan="7">
	<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="submit_button2" value="删除" onclick="{if(confirm('您确定要删除此在线人员吗?')){return true;}return false;}">
	<input class="button" type="button" name="submit_button3" value="清空所有在线人数" onclick="{if(confirm('您确定要清空所有在线人数吗?')){location.href='admin_online.asp?action=delall';return true;}return false;}"></td>
</tr>
</form>
<tr>
	<td class="tablerow<%=iCount%>" colspan="7" id="NextPageText"><var class="morePage"><%=showlistpage(pagenow,Pcount,maxperpage,totalrec,pagelinks)%></var></td>
</tr>
</table>
<script type="text/javascript">
document.getElementById("showNextPage").innerHTML = document.getElementById("NextPageText").innerHTML;
</script>
<%
	OnlineArry=Null
End Sub

Sub showMainOnline()
	Dim Rs,SQL
	If count=0 Then
		totalrec=NewAsp.Ask_Execute("SELECT COUNT(*) FROM [NC_Ask_Online]")(0)
	Else
		totalrec=count
	End If
	Pcount = CLng(totalrec / maxperpage)
	If Pcount < totalrec / maxperpage Then Pcount = Pcount + 1
	If pagenow>Pcount Then pagenow=1
	pagelinks="?ChannelID="&ChannelID&"&count="&totalrec&"&"
	Set Rs=NewAsp.CreateAXObject("ADODB.Recordset")
	SQL = "SELECT id,username,accesstime,activetime,ip,browser FROM [NC_Ask_Online] ORDER BY accesstime DESC"
	Rs.Open SQL,Ask_Conn,1,1
	If pagenow >1 Then
		Rs.Move (pagenow-1) * maxperpage
	End If
	If Not (Rs.BOF And Rs.EOF) Then
		OnlineArry=Rs.GetRows(maxperpage)
	Else
		OnlineArry=Null
	End If
	Rs.close()
	Set Rs=Nothing
End Sub

Sub OnlineReferer()
	Dim i,iCount,lCount
	iCount=2:lCount=2
%>
<table id="tablehovered" border="0" align="center" cellpadding="3" cellspacing="1" class="tableborder">
<tr>
	<th width='5%' nowrap>选择</th>
	<th width='15%' nowrap>来访时间/IP</th>
	<th>访 问 来 源</th>
	<th>当 前 位 置</th>
</tr>
<tr>
	<td class="tablerow1" colspan="4" align="left" id="showNextPage">&nbsp;</td>
</tr>
<form name="selform" method="post" action="?action=del">
<%
	Call showRefererList()
	If IsArray(OnlineArry) Then
		For i=0 To Ubound(OnlineArry,2)
			If Not Response.IsClientConnected Then Response.End
			If (i mod 2) = 0 Then
				iCount=2:lCount=1
			Else
				iCount=1:lCount=2
			End If
%>
<tr>
	<td align="center" class="tablerow<%=iCount%> hovered"><input type="checkbox" name="OnlineID" value="<%=OnlineArry(0,i)%>"></td>
	<td align="center" class="tablerow<%=iCount%> hovered" nowrap><%=OnlineArry(2,i)%><br/><%=OnlineArry(3,i)%></td>
	<td class="tablerow<%=iCount%> hovered"><a href="javascript:" onclick="window.open('<%=Replace(OnlineArry(4,i), "'", "&#39;")%>')"><%=Server.HTMLEncode(URLDecode(OnlineArry(4,i)))%></a></td>
	<td class="tablerow<%=iCount%> hovered"><a href="<%=OnlineArry(7,i)%>" target="_blank"><%=Server.HTMLEncode(OnlineArry(6,i))%></a></td>
</tr>
<%
		Next
	End If
%>
<tr>
	<td class="tablerow<%=lCount%>" colspan="4">
	<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="submit_button2" value="删除" onclick="{if(confirm('您确定要删除此在线人员吗?')){return true;}return false;}">
	<input class="button" type="button" name="submit_button3" value="清空所有在线人数" onclick="{if(confirm('您确定要清空所有在线人数吗?')){location.href='admin_online.asp?action=delall';return true;}return false;}"></td>
</tr>
</form>
<tr>
	<td class="tablerow<%=iCount%>" colspan="4" id="NextPageText"><var class="morePage"><%=showlistpage(pagenow,Pcount,maxperpage,totalrec,pagelinks)%></var></td>
</tr>
</table>
<script type="text/javascript">
document.getElementById("showNextPage").innerHTML = document.getElementById("NextPageText").innerHTML;
</script>
<%
	OnlineArry=Null
End Sub

Sub showRefererList()
	Dim Rs,SQL
	If count=0 Then
		totalrec=NewAsp.Ask_Execute("SELECT COUNT(*) FROM [NC_Ask_Online]")(0)
	Else
		totalrec=count
	End If
	Pcount = CLng(totalrec / maxperpage)
	If Pcount < totalrec / maxperpage Then Pcount = Pcount + 1
	If pagenow>Pcount Then pagenow=1
	pagelinks="?action=refer&ChannelID="&ChannelID&"&count="&totalrec&"&"
	Set Rs=NewAsp.CreateAXObject("ADODB.Recordset")
	SQL = "SELECT id,username,accesstime,ip,fromsite,browser,stats,url FROM [NC_Ask_Online] ORDER BY accesstime DESC"
	Rs.Open SQL,Ask_Conn,1,1
	If pagenow >1 Then
		Rs.Move (pagenow-1) * maxperpage
	End If
	If Not (Rs.BOF And Rs.EOF) Then
		OnlineArry=Rs.GetRows(maxperpage)
	Else
		OnlineArry=Null
	End If
	Rs.close()
	Set Rs=Nothing
End Sub

Sub OnlineZone()
	Dim i,iCount,lCount
	iCount=2:lCount=2
%>
<table id="tablehovered" border="0" align="center" cellpadding="3" cellspacing="1" class="tableborder">
<tr>
	<th width='5%' nowrap>选择</th>
	<th nowrap>用 户 名</th>
	<th nowrap>用 户 等 级</th>
	<th nowrap>IP 地 址</th>
	<th nowrap>详 细 地 址</th>
	<th nowrap>操 作 系 统</th>
	<th nowrap>浏 览 器</th>
</tr>
<tr>
	<td class="tablerow1" colspan="7" align="left" id="showNextPage">&nbsp;</td>
</tr>
<form name="selform" method="post" action="?action=del">
<%
	Call showZoneList()
	If IsArray(OnlineArry) Then
		For i=0 To Ubound(OnlineArry,2)
			If Not Response.IsClientConnected Then Response.End
			If (i mod 2) = 0 Then
				iCount=2:lCount=1
			Else
				iCount=1:lCount=2
			End If
%>
<tr align="center">
	<td class="tablerow<%=iCount%> hovered"><input type="checkbox" name="OnlineID" value="<%=OnlineArry(0,i)%>"></td>
	<td class="tablerow<%=iCount%> hovered" nowrap><%=OnlineArry(1,i)%></td>
	<td class="tablerow<%=iCount%> hovered"><%=OnlineArry(2,i)%></td>
	<td class="tablerow<%=iCount%> hovered"><%=Server.HTMLEncode(OnlineArry(4,i))%></td>
	<td class="tablerow<%=iCount%> hovered"><%=GetAddress(OnlineArry(4,i))%></td>
	<td class="tablerow<%=iCount%> hovered"><%=usersysinfo(OnlineArry(5,i), 0)%></td>
	<td class="tablerow<%=iCount%> hovered"><%=usersysinfo(OnlineArry(5,i), 1)%></td>
</tr>
<%
		Next
	End If
%>
<tr>
	<td class="tablerow<%=lCount%>" colspan="7">
	<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="submit_button2" value="删除" onclick="{if(confirm('您确定要删除此在线人员吗?')){return true;}return false;}">
	<input class="button" type="button" name="submit_button3" value="清空所有在线人数" onclick="{if(confirm('您确定要清空所有在线人数吗?')){location.href='admin_online.asp?action=delall';return true;}return false;}"></td>
</tr>
</form>
<tr>
	<td class="tablerow<%=iCount%>" colspan="7" id="NextPageText"><var class="morePage"><%=showlistpage(pagenow,Pcount,maxperpage,totalrec,pagelinks)%></var></td>
</tr>
</table>
<script type="text/javascript">
document.getElementById("showNextPage").innerHTML = document.getElementById("NextPageText").innerHTML;
</script>
<%
	OnlineArry=Null
End Sub

Sub showZoneList()
	Dim Rs,SQL
	If count=0 Then
		totalrec=NewAsp.Ask_Execute("SELECT COUNT(*) FROM [NC_Ask_Online]")(0)
	Else
		totalrec=count
	End If
	Pcount = CLng(totalrec / maxperpage)
	If Pcount < totalrec / maxperpage Then Pcount = Pcount + 1
	If pagenow>Pcount Then pagenow=1
	pagelinks="?action=zone&ChannelID="&ChannelID&"&count="&totalrec&"&"
	Set Rs=NewAsp.CreateAXObject("ADODB.Recordset")
	SQL = "SELECT id,username,usertitle,accesstime,ip,browser FROM [NC_Ask_Online] ORDER BY accesstime DESC"
	Rs.Open SQL,Ask_Conn,1,1
	If pagenow >1 Then
		Rs.Move (pagenow-1) * maxperpage
	End If
	If Not (Rs.BOF And Rs.EOF) Then
		OnlineArry=Rs.GetRows(maxperpage)
	Else
		OnlineArry=Null
	End If
	Rs.close()
	Set Rs=Nothing
End Sub

Sub DelAllOnline()
	NewAsp.Ask_Execute("DELETE FROM NC_Ask_Online")
	Call OutputScript ("在线人数全部清除完成！","admin_online.asp")
End Sub

Sub DelOnline()
	Dim OnlineID
	If Request("OnlineID") <> "" Then
		OnlineID = NewAsp.CheckIDlist(Request("OnlineID"))
		NewAsp.Ask_Execute("DELETE FROM NC_Ask_Online WHERE ID in (" & OnlineID & ")")
		Response.Redirect (Request.ServerVariables("HTTP_REFERER"))
	Else
		OutAlertScript("请选择正确的系统参数！")
	End If
End Sub

Function usersysinfo(info, getinfo)
	Dim usersys
	usersys = Split(info, "|")
	usersysinfo = usersys(getinfo)
End Function

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

%>