<%
'Option Explicit
'ON ERROR RESUME NEXT
%>
<%
'叛断此用户是否已经打开COOKIES
if Not IsCookiesOpen then
response.redirect "nocookie.htm"
end if
%>
<%
dim rs_user,rs_today,rs_lar,rs_newboy,rs_newgirl,rs_board,rs_links,rs_boy,rs_girl,rs_online,rs_hs,rs,rsQuestion,rsAnswer,star_girl,star_boy,rs_article
dim sql,records,today_records,today_pics,rs_pic,rs_photoboy,rs_photogirl,rs_bb,rs_birthday,rs_count,online_count,articlecount,rs_vote,vote_count
dim i,j,k,pics,birnum
dim conn,connpic,articleconn,DBPath
if isempty(session("u_id")) or session("u_id")="" then
session("u_id")=1
end if
Set conn = Server.CreateObject("ADODB.Connection")
DBPath = Server.MapPath("isi/xlist.asp")
conn.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DBPath
Set connpic = Server.CreateObject("ADODB.Connection")
DBPath = Server.MapPath("isi/ximg.asp")
connpic.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DBPath
Dim us_id
us_id=session("u_id")
%>
龙川在线-龙川交友网
<% end if %>
<%if isempty(us_id) or us_id=1 then
'没注册的用户
%>
会员登陆
<% end if %>
便捷搜索网友
最热门的投票
<% Dim str
sql = "Select Top 1 id,Topic,count From t_Vote Where ParentID=0 Order By count DESC"
Set rsQuestion = Server.CreateObject("ADODB.RecordSet")
Set rsAnswer= Server.CreateObject("ADODB.RecordSet")
rsQuestion.Open sql,conn,1,1
If Not rsQuestion.EOF Then
str="
"
Else
str="
目前还没有任何投票"
End If
Response.write str
' rsAnswer.close
rsQuestion.close
set rsAnswer=nothing
set rsQuestion=nothing
%>
星座与运程
<%
connstrz="DBQ="+server.mappath("book/story.asp")+";DefaultDir=;DRIVER={Microsoft Access Driver (*.mdb)};"
set conn3=server.createobject("ADODB.CONNECTION")
conn3.open connstrz
sql="select top 8 articleid,title from learning where typeid=10 order by articleid desc"
Set rsz= Server.CreateObject("ADODB.Recordset")
rsz.open sql,conn3,1,1
if rsz.eof then
response.write "
<%
sql="select top 8 articleid,title from learning where typeid=9 order by articleid desc"
Set rsz= Server.CreateObject("ADODB.Recordset")
rsz.open sql,conn3,1,1
if rsz.eof then
response.write "
<%
Set rs_links = Server.CreateObject("ADODB.Recordset")
sql="select top 8 sitename,siteurl from links order by id asc"
rs_links.open sql,conn,1,1
if rs_links.eof and rs_links.bof then%>
暂时没有链接
<%else%>
<%
'取得人气最高的女主角
Set rs_girl = Server.CreateObject("ADODB.Recordset")
sql="select top 1 user_id,netname,age,home from larchives where sex like '" & "女" & "' and photo > 0 order by renqi desc"
rs_girl.open sql,conn,1,1
if rs_girl.eof and rs_girl.bof then%>
没有，暂时空缺！
<%else
Set rs_pic = Server.CreateObject("ADODB.Recordset")
sql="select id from pic where user_id=" & rs_girl("user_id") & " and index = true"
rs_pic.open sql,connpic,1,1
if rs_pic.eof and rs_pic.bof then
pics=1
else
pics=rs_pic("id")
end if
%>
<%
'取得人气最高的男主角
Set rs_boy = Server.CreateObject("ADODB.Recordset")
sql="select top 1 user_id,netname,age,home from larchives where sex like '" & "男" & "' and photo > 0 order by renqi desc"
rs_boy.open sql,conn,1,1
if rs_boy.eof and rs_boy.bof then%>
没有，暂时空缺！
<%else
Set rs_pic = Server.CreateObject("ADODB.Recordset")
sql="select id from pic where user_id=" & rs_boy("user_id") & " and index = true"
rs_pic.open sql,connpic,1,1
if rs_pic.eof and rs_pic.bof then
pics=1
else
pics=rs_pic("id")
end if
%>
<%
'取得人气最高的索女
Set star_girl = Server.CreateObject("ADODB.Recordset")
sql="select top 1 user_id,netname,age,home from larchives where shenqing=true and sex='女' and photo>0 Order by piaoshu desc"
star_girl.open sql,conn,1,1
if star_girl.eof and star_girl.bof then%>
没有，暂时空缺！
<%else
Set rs_pic = Server.CreateObject("ADODB.Recordset")
sql="select id from pic where user_id=" & star_girl("user_id") & " and index = true"
rs_pic.open sql,connpic,1,1
if rs_pic.eof and rs_pic.bof then
pics=1
else
pics=rs_pic("id")
end if
%>
<%
'取得人气最高的型男
Set star_boy = Server.CreateObject("ADODB.Recordset")
sql="select top 1 user_id,netname,age,home from larchives where shenqing=true and sex='男' and photo>0 Order by piaoshu desc"
star_boy.open sql,conn,1,1
if star_boy.eof and star_boy.bof then%>
没有，暂时空缺！
<%else
Set rs_pic = Server.CreateObject("ADODB.Recordset")
sql="select id from pic where user_id=" & star_boy("user_id") & " and index = true"
rs_pic.open sql,connpic,1,1
if rs_pic.eof and rs_pic.bof then
pics=1
else
pics=rs_pic("id")
end if
%>
<%
'取得人气最高的网友（12位）
Set rs_lar = Server.CreateObject("ADODB.Recordset")
rs_lar.open "select top 12 * from larchives order by renqi desc",conn,1,1
%>
<%i=0%>
<%do while not(rs_lar.eof)
if i mod 2 =0 then
%>
<%
dim conn2,rs2
set conn2=server.createobject("adodb.connection")
DBPath = Server.MapPath("article/txt97.asp")
conn2.Open "driver={Microsoft Access Driver (*.mdb)};dbq=" & DBPath
sql="SELECT top 7 articleid,title,name,user_id,dateandtime FROM learning ORDER BY hits DESC"
set rs2=server.createobject("adodb.recordset")
rs2.open sql,conn2,1,1
if rs2.eof and rs2.bof then
response.write "
<%
sql="SELECT top 7 articleid,title,name,user_id,dateandtime FROM learning ORDER BY articleid DESC"
set rs2=server.createobject("adodb.recordset")
rs2.open sql,conn2,1,1
if rs2.eof and rs2.bof then
response.write "
<%
sql="SELECT top 7 articleid,title,dateandtime FROM learning where typeid=1 ORDER BY hits DESC"
set rsz=server.createobject("adodb.recordset")
rsz.open sql,conn3,1,1
if rsz.eof and rsz.bof then
response.write "
<%
sql="SELECT top 7 articleid,title,dateandtime FROM learning where typeid=12 ORDER BY articleid DESC"
set rsz=server.createobject("adodb.recordset")
rsz.open sql,conn3,1,1
if rsz.eof and rsz.bof then
response.write "
<%
Set Rs = Server.CreateObject("ADODB.Recordset")
sql = "Select TOP 8 * From meeting Order By id Desc"
Rs.Open sql,conn,1,1
i=0
DO While Not Rs.EOF
i=i+1
%>
<% if i mod 2 =0 then %>
<%
function strlen(str)
dim p_len,xx
p_len=0
strlen=0
if trim(str)<>"" then
p_len=len(trim(str))
for xx=1 to p_len
if asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
else
strlen=int(strlen) + 1
end if
next
end if
end function
function strvalue(str,lennum)
dim p_num
dim i,x
if strlen(str)<=lennum then
strvalue=str
else
p_num=0
x=0
do while not p_num > lennum-2
x=x+1
if asc(mid(str,x,1))<0 then
p_num=int(p_num) + 2
else
p_num=int(p_num) + 1
end if
strvalue=left(trim(str),x)&"..."
loop
end if
end function
function RmHtml(fString)
fString = Replace(fString, CHR(13), " ")
fString = Replace(fString, CHR(10) & CHR(10), " ")
fString = Replace(fString, CHR(10), " ")
fString = Replace(fString, " ", " ")
fString = Replace(fString, " ", " ")
fString = Replace(fString, " ", " ")
fString = Replace(fString, " ", " ")
fString = Replace(fString, "
", " ")
fString = Replace(fString, "
", " ")
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
RmHtml=fString
End Function
%>
