online.asp

三鸟个人网站源码。

<%
dbfilename="data.mdb" '此为数据库文件名
checkonline
sub checkonline
	set cont=server.createobject("adodb.connection")
	on error resume next
	cont.connectionstring="provider=microsoft.jet.oledb.4.0;data source="&server.mappath("data/"&dbfilename)
	cont.open
	dim sqlstr
	dim timeout
	timeout=cdate(dateadd("s",-600,now()))
	sqlstr="select * from online"
	dim ros
	set ros=server.createobject("adodb.recordset")
	ros.open sqlstr,cont,1,3
	do while not ros.eof
		if ros("actiontime")<timeout then
			ros.delete
		end if
		ros.movenext
	loop
	ros.update
	if cont.errors.count > 0 then
		response.write "function checkonline<br>"
		for i=0 to cont.errors.count-1
			response.write cont.errors(i).description&"<br>"
		next
		response.write "--------------------------<br><br>"
	end if
	cont.close
	set cont=nothing
end sub
%>
<%
function addonline(uid,action)
	set cont=server.createobject("adodb.connection")
	cont.connectionstring="provider=microsoft.jet.oledb.4.0;data source="&server.mappath("data/"&dbfilename)
	cont.open
	dim sqlstr
	dim ors
	'on error resume next
	sqlstr="select * from userinfo where uid='"&uid&"'"
	set ors=cont.execute(sqlstr)
	if ors.eof then
		addonlineguest action
	else
		addonlineuser uid,action
	end if
	if cont.errors.count > 0 then
		response.write "function addonline<br>"
		for i=0 to cont.errors.count-1
			response.write cont.errors(i).description&"<br>"
		next
		response.write "--------------------------<br><br>"
	end if
	cont.close
	set cont=nothing
end function
%>



<%
function getonlinelist
	set cont=server.createobject("adodb.connection")
	cont.connectionstring="provider=microsoft.jet.oledb.4.0;data source="&server.mappath("data/"&dbfilename)
	cont.open
	dim ros
	dim sqlstr
	dim liststr
	sqlstr="select * from online order by id desc"
	set ros=cont.execute(sqlstr)
	if ros.eof then
		liststr="none."
		'getonlinelist=liststr
	else
		liststr=ros("uid")&"="&ros("action")
		do while not ros.eof
			ros.movenext
			if ros.eof then exit do
			liststr=liststr+"/"&ros("uid")&"="&ros("action")
		loop
	end if
	ros.close
	set ros=nothing
	cont.close
	set cont=nothing
	getonlinelist=liststr
end function
%>




<%
function addonlineuser(uid,action)
	dim sqlstr
	dim ros
	dim ip
	dim cont
	
	set cont=server.createobject("adodb.connection")
	cont.connectionstring="provider=microsoft.jet.oledb.4.0;data source="&server.mappath("data/"&dbfilename)
	cont.open
	ip=request.servervariables("remote_addr")
	'on error resume next
	sqlstr="select * from online where ip='"&ip&"' or uid='"&uid&"'"
	set ros=server.createobject("adodb.recordset")
	ros.open sqlstr,cont,1,3
	if ros.eof then
		'sqlstr="insert into online (uid,actiontime,action,ip) values ('"&uid&"','"&now()&"','"&action&"','"&ip&"')"
		ros.addnew
		ros("uid")=uid
		ros("actiontime")=now()
		ros("action")=action
		ros("ip")=ip
		ros.update
	else
		'sqlstr="update online set actiontime='"&now()&"', action='"&action&"',ip='"&ip&"' where uid='"&uid&"'"
		ros("uid")=uid
		ros("actiontime")=now()
		ros("action")=action
		ros("ip")=ip
		ros.update
	end if
	ros.close
	set ros=nothing
	if cont.errors.count > 0 then
		response.write "function addonlineuser<br>"
		for i=0 to cont.errors.count-1
			response.write cont.errors(i).description&"<br>"
		next
		response.write "--------------------------<br><br>"
	end if
	cont.close
	set cont=nothing
end function
%>
<%
sub addonlineguest(action)
	dim sqlstr
	dim ip
	dim cont
	'on error resume next
	set cont=server.createobject("adodb.connection")
	cont.connectionstring="provider=microsoft.jet.oledb.4.0;data source="&server.mappath("data/"&dbfilename)
	cont.open
	ip=request.servervariables("remote_addr")
	sqlstr="insert into online (uid,actiontime,action,ip) values ('guest','"&now()&"','"&action&"','"&ip&"')"
	sqlstr="select * from online where ip='"&ip&"'"
	dim ros
	set ros=server.createobject("adodb.recordset")
	ros.open sqlstr,cont,1,3
	if ros.eof then
		ros.addnew
		ros("uid")="guest"
		ros("action")=action
		ros("actiontime")=now()
		ros("ip")=ip
		ros.update
	else
		ros("action")=action
		ros("actiontime")=now()
		ros("ip")=ip
		ros.update
	end if
	if cont.errors.count > 0 then
		response.write "function addonlineguest<br>"
		for i=0 to cont.errors.count-1
			response.write cont.errors(i).description&"<br>"
		next
		response.write "--------------------------<br><br>"
	end if	
	ros.close
	set ros=nothing
	cont.close
	set cont=nothing
end sub
%>
<%
function getonlinenum
	set cont=server.createobject("adodb.connection")
	cont.connectionstring="provider=microsoft.jet.oledb.4.0;data source="&server.mappath("data/"&dbfilename)
	cont.open
	dim ros
	dim sqlstr
	dim liststr
	dim num
	num=0
	sqlstr="select * from online order by id desc"
	set ros=cont.execute(sqlstr)
	do while not ros.eof
		num=num+1
		ros.movenext
	loop
	ros.close
	set ros=nothing
	cont.close
	set cont=nothing
	getonlinenum=num
end function
%><%
function deleteonline(uid)
	set cont=server.createobject("adodb.connection")
	on error resume next
	cont.connectionstring="provider=microsoft.jet.oledb.4.0;data source="&server.mappath("data/"&dbfilename)
	cont.open
	dim sqlstr
	sqlstr="delete from online where uid='"&uid&"'"
	cont.execute(sqlstr)
	if cont.errors.count > 0 then
		response.write "function checkonline<br>"
		for i=0 to cont.errors.count-1
			response.write cont.errors(i).description&"<br>"
		next
		response.write "--------------------------<br><br>"
	end if
	cont.close
	set cont=nothing
end function
%>