在线用户列表

<% '根据IP查地理位置 Function cacuIp(ip) On Error Resume Next Dim srIp, aIp srIp=0 aIp = Split(ip,".") If UBound(aIP)<>3 Then cacuIP=0 Exit Function End If For i=0 To 3 srIp=srIp+(CInt(aIP(i))*(256^(3-i))) Next cacuIp=srIp-1 If Err Then cacuIp=0 End Function Function GetPlace(ip) Set CONN=Server.CreateObject("ADODB.Connection") CONN.Open "DRIVER={Microsoft Access Driver (*.mdb)};DBQ="&Server.Mappath("ipaddress.mdb") iIp=cacuIp(IP) SQL = "SELECT country,city FROM address WHERE ip1<=" & iIp & " AND ip2>=" & iIp Set tempRs = CONN.Execute ( SQL ) If tempRs.Eof Then sPlace="Sorry！查无记录" Else sPlace=tempRs(0)&" "&tempRs(1) End If tempRs.close Set tempRs=Nothing GetPlace=sPlace End Function 'Response.Write "查询的IP为："&ip&"
所在的位置为："&sPlace&"
官方数据为：查询该IP官方数据" %> <% Const MaxPerPage=20 dim totalPut,CurrentPage,TotalPages,j,sql if Not isempty(SafeRequest("page",1)) then currentPage=Cint(SafeRequest("page",1)) else currentPage=1 end if dim namekey,checkbox,action,vipuser action=FormatSQL(SafeRequest("action",0)) checkbox=request.form("checkbox") namekey=request.form("namekey") if namekey="" then namekey=FormatSQL(SafeRequest("namekey",0)) if checkbox="" then checkbox=FormatSQL(SafeRequest("checkbox",0)) set rs=server.CreateObject("adodb.recordset") rs.open "delete from onlineuser where datediff('s',staytime,now())>30",conn,1,3 '删除超过60秒没发送状态的用户 if namekey="" then rs.open "select * from onlineuser order by logontime desc",conn,1,1 else if checkbox=1 then rs.open "select * from onlineuser where name like '%"&namekey&"%' order by logontime desc",conn,1,1 else rs.open "select * from onlineuser where name= '%"&namekey&"%'order by logontime desc",conn,1,1 end if end if if err.number<>0 then response.write "数据库中暂时无数据" end if if rs.eof And rs.bof then Response.Write "

对不起，此用户不在线！

" else totalPut=rs.recordcount if currentpage<1 then currentpage=1 end if if (currentpage-1)*MaxPerPage>totalput then if (totalPut mod MaxPerPage)=0 then currentpage= totalPut \ MaxPerPage else currentpage= totalPut \ MaxPerPage + 1 end if end if if currentPage=1 then showContent showpage totalput,MaxPerPage,"onlineuser.asp" else if (currentPage-1)*MaxPerPage

当前在线

<%'set rs=server.CreateObject("adodb.recordset") 'rs.open "select coupon.* from coupon order by id desc",conn,1,1 'rs.open "select coupon.id,coupon.code,coupon.owner,coupon.content,coupon.gettime,coupon.getfrom,coupon.state,coupon.orderid,coupon.usedtime,acoupon.deadline from coupon,acoupon where coupon.id=acoupon.id and coupon.owner='"&request.cookies("timesshop")("username")&"' order by id desc",conn,1,1 intTotalNum = rs.RecordCount dim useronline,guestonline useronline=0 '在线用户 guestonline=0 '在线访客 do while not rs.eof if (i mod 2)=0 then response.write "" else response.write "" end if %> <%i=i+1 if i>=MaxPerPage then Exit Do rs.movenext loop rs.close set rs=nothing %>

Session_ID	来访IP	地点	所属组	用户名	上线时间	在线时长	活动时间	闲置时间	当前浏览页面
<%=rs("id")%>	<% =rs("ip")%>	<% =GetPlace(rs("ip"))%>	<% if rs("isuser")=0 then response.write "访客" guestonline=guestonline+1 else response.write "注册用户" useronline=useronline+1 end if %>	<% if rs("isuser")=0 then trim(rs("name")) else response.write "" & trim(rs("name"))&" " end if %>	<%=trim(rs("logontime"))%>	<%=datediff("n",rs("logontime"),now())%>	<% =rs("staytime")%>	<%=datediff("s",rs("staytime"),now())%>	target="_blank"><% =rs("curpage")%>

<%=now()%> 时的状态！（每5分钟自动刷新！）共有 <%=intTotalNum%> 人在线，其中会员 <%=useronline%> 人，访客 <%=guestonline%> 人

<% End Sub Function showpage(totalnumber,maxperpage,filename) Dim n If totalnumber Mod maxperpage=0 Then n= totalnumber \ maxperpage Else n= totalnumber \ maxperpage+1 End If Response.Write "