index.asp

WAP网上购物系统源程序,,有兴趣的朋友,一起研究一下..交流经眼

	rs.close
	set rs=conn.execute ("select count(*) from Announce")
	Response.Write "·论坛总帖:<b><font color=red>&nbsp;"&rs(0)&"&nbsp;</font></b>条<br>"
	rs.close
	set rs=conn.execute ("select count(*) from Announce where datediff('d',ndatetime,now())=0")
	Response.Write "·论坛新帖:<b><font color=red>&nbsp;"&rs(0)&"&nbsp;</font></b>条<br>"
	rs.close
	set rs=conn.execute ("select count(*) from photo")
	Response.Write "·照片数:<b><font color=red>&nbsp;"&rs(0)&"&nbsp;</font></b>张<br>"
	rs.close
	set rs=conn.execute ("select count(*) from forum where  datediff('d',pubtime,now())=1")
	Response.Write "·昨日留言:<b><font color=red>&nbsp;"&rs(0)&"&nbsp;</font></b>条<br>"
	rs.close
	set rs=conn.execute ("select count(*) from forum where  datediff('d',pubtime,now())=0")
	Response.Write "·今日留言:<b><font color=red>&nbsp;"&rs(0)&"&nbsp;</font></b>条<br>"
	rs.close
	set rs=conn.execute ("select count(*) from ec where  datediff('d',lastedtime,now())=0")
	Response.Write "·今日登录:<b><font color=red>&nbsp;"&rs(0)&"&nbsp;</font></b>人<br>"
	rs.close
	set rs=conn.execute ("select count(*) from photo where  datediff('m',pubtime,now())=0")
	Response.Write "·本月照片:<b><font color=red>&nbsp;"&rs(0)&"&nbsp;</font></b>张"
	rs.close
    set rs=nothing
	Response.Flush
end sub
Sub showrcentInterview
	Dim rs
	Set rs=conn.execute ("select top 2 sname,lastedtime from ec order by lastedtime desc")
	While not rs.eof
		Response.Write "· <font style='cursor:hand' title='最近访问时间:"&rs("lastedtime")&"'>"&rs("sname")&"</font> <span style='font-size:10px;color:#666666;font-family:verdana;'>("&datevalue(rs("lastedtime"))&")</span><br>"
		Rs.movenext
	Wend
	Rs.close
	Set Rs=Nothing
	Response.Flush
End Sub
Sub indexforumshow
	Dim rs,title2,content,maxtitlelen
	maxtitlelen=20
	Response.Write "<table width=""399"" border=""0"" cellspacing=""0"" cellpadding=""0"">"&Vbcrlf
	Response.Write "	<tr>"&Vbcrlf
	Response.Write "		<td height=""23"" background=""images/ye_bk.jpg"" style=""background-repeat: no-repeat;padding-left:8px;padding-top:4px;"">最新留言</td>"&Vbcrlf
	Response.Write "       <td>&nbsp;</td><td style=""text-align:right;padding-right:5px;""><a href='message_show.asp' title='影音留言'>更多留言&gt;&gt;</a></td>"&Vbcrlf
	Response.Write "	</tr>"&Vbcrlf
	Response.Write "	<tr>"&Vbcrlf
	Response.Write "		<td colspan=""3"" style=""padding:8px;line-height:1.8;font-family:verdana;"">" &Vbcrlf
	Response.Flush
	Set rs=Server.CreateObject("Adodb.Recordset")
	rs.open "select top 5 forum.*,ec.sname,ec.studentid from forum,ec where ec.studentid=forum.studentid order by pubtime desc",conn,1
	If Not rs.Eof Then
		While Not Rs.Eof
			title2=BadWords_Deal(Replace(rs("content"),"<br>",""))
			Response.Write "·<a href='message_show.asp'  title='"&walkgotTopic(title2,60)&"'>"&walkgotTopic(title2,30)&"</a> ("&month(rs("pubtime"))&"-"&day(rs("pubtime"))&" "&hour(rs("pubtime"))&":"&minute(rs("pubtime"))&","&rs("sname")&")<br>"&Vbcrlf
			Rs.movenext
		Wend
	Else
		Response.Write "·暂时没有留言!"&Vbcrlf
	End If
	Response.Write "</td>"&Vbcrlf
	Response.Write "</tr>"&Vbcrlf
	Rs.close
	set Rs=Nothing
	Response.Write "</table>"&Vbcrlf
	Response.Flush()
End Sub
Sub showuserinfomation
	Dim rs,faceimgurl
	set rs=conn.execute("select studentid,sname,logintimes,pic,forumtimes,picwidth,picheight,picurl from ec where studentid='"&Session("username")&"'")
	If Rs.Eof Then
		Response.Write("<font color=red>●发生异常,请注销用户身份!<br>")
		Response.Write("●3秒之后系统将自动注销!</font>")
		Response.Write("<script>setTimeout('location.href=""logout.asp"";',3000);</script>")
		Exit Sub
	End If
%>
<table width="100%" border="1" cellspacing="0" cellpadding="1" bordercolor="#cccccc" class="user">
  <tr> 
    <td width="50％" align="center"><%=showuserpicindex(rs("pic"),rs("picwidth"),rs("picheight"))%></td>
    <td align="center"><%=rs("sname")%></td>
  </tr>
  <tr> 
    <td align="center">登录次数</td>
    <td align="center"><%=rs("logintimes")%></td>
  </tr>
  <tr> 
    <td align="center">留言次数</td>
    <td align="center"><%=rs("forumtimes")%></td>
  </tr>
  <tr>
    <td align="center">用户类型</td>
    <td align="center"><font color="#0000FF"><%Response.Write index_usertype%></font></td>
  </tr>
  <tr> 
    <td align="center">上次登录</td>
    <td align="center"><span style="font-size:10px;"><%=month(Session("lastedtime"))&"-"&day(Session("lastedtime"))&" "&hour(Session("lastedtime"))&":"&minute(Session("lastedtime"))%></span></td>
  </tr>
</table>
<%
rs.close
set rs=nothing
Response.Flush
end sub
Function index_usertype
	Select Case session("usertype")
		Case 1	index_usertype="影音好友"
		Case 2	index_usertype="准影音用户"
		Case 3	index_usertype="影音成员"
		Case 4	index_usertype="Wap影音嘉宾"
		Case	Else index_usertype="游客"
	End Select
End Function

Function showuserpicindex(picurl,picwidth,picheight)
	dim width_xx,height_xx
	If 	picwidth>70 Then 
		width_xx="width=70"
	Elseif picwidth>0 then
		width_xx="width="&picwidth
	ElseIf picwidth=0 Then
		width_xx=""
	End If

	If picheight>Int(Split(const_Faceheight,"|")(1)) Then
		height_xx="height="&Split(const_FaceWidth,"|")(1)
	ElseIf picheight>0  Then
		height_xx="height="&picheight
	ElseIf picheight=0 Then
		height_xx=""
	End If
	IF lcase(Left(picurl,5))="http:" then
		Response.Write "<img src='" + picurl + "'"  & width_xx & " " & height_xx  & " onload=""javascript:if(this.width>70)   this.width=70"">"
	ElseIf picurl<>"" and (not isnull(picurl)) Then
		Response.Write("<img src='" + const_txl_HomeUrl &picurl + "' " & width_xx & " " & height_xx & " onload=""javascript:if(this.width>70)   this.width=70"">")
	End If
End Function
%>
<%Sub shownewbbs
	Dim rs,title,maxtitlelen
	Set rs=Server.CreateObject("Adodb.Recordset")
	rs.open "select top 5 Announce.*,ec.sname from Announce,ec where ec.studentid=Announce.username and parentid=0 order by id desc",conn,1
%>
<table width="399" border="0" cellspacing="0" cellpadding="0">
      <tr>
        <td height="23" background="images/ye_bk.jpg" style="background-repeat: no-repeat;padding-left:8px;padding-top:4px;">论坛新贴</td>
        <td>　</td>
        <td style="text-align:right;padding-right:5px;"><a href="forum.asp">进入论坛&gt;&gt;</a></td>
      </tr>
	  <tr> 
		<td colspan="3" style="padding:8px;line-height:1.8;font-family:Verdana, Arial, Helvetica, sans-serif;">
  <%If not rs.eof then
  	maxtitlelen=20
  	while not rs.eof
		title=rs("title")
		If Len(title)>maxtitlelen then Title=left(Title,maxtitlelen-2)&"……"
		%>
	·<a href='Announce.asp?boardid=<%=rs("boardid")%>&announceid=<%=rs("id")%>'><%=title%></a> 
      (<%=month(rs("ndatetime"))&"-"&day(rs("ndatetime"))&" "&hour(rs("ndatetime"))&":"&minute(rs("ndatetime"))%>,<a href='User_showuserinfo.asp?username=<%=rs("username")%>'><%=rs("sname")%></a>)<br>
  <%
  	rs.movenext
  wend
  Else
  %>
   ·暂时没有信息！
  <%End If%>
	</td>
  </tr>
</table>
<%
	rs.close
	set rs=nothing
	Response.Flush
End SUb
%>
<%SUB Shownewphoto
	Dim rs,title,maxtitlelen
	Set rs=Server.CreateObject("Adodb.Recordset")
	rs.open "select top 3 photo.*,ec.sname from photo,ec where ec.studentid=photo.username and Isok=1 order by picid desc",conn,1
if rs.eof then
	
end if
%>
<table width="399" border="0" cellspacing="0" cellpadding="0">
  <tr>
	<td height="23" background="images/ye_bk.jpg" style="background-repeat: no-repeat;padding-left:8px;padding-top:4px;">最新照片</td>
	<td>　</td>
	<td style="text-align:right;padding-right:5px;"><a href="photo_show.asp">更多照片&gt;&gt;</a></td>
  </tr>
  <tr align="center">
<%
	dim trflag,trflag2,clos,k,ss,i,subject
	clos=4	'每行4列
	k=0
	ss=rs.recordcount
	if ss>0 then
		Response.write "<tr align='center' >"
		while k<ss and  not rs.eof
			subject=rs("subject")
			if len(subject)>8 then subject=left(subject,6)&"……"
			i=i+1
			trflag=false
			trflag2=false
			if k mod 3=0 then trflag=true
			Response.Write("<td width='33%' valign='top' style='padding:5px;'>")
			%>
      <%If Lcase(rs("PhotoFormat"))=".swf" Then
				Response.Write "<embed width='106' src='"&const_txl_HomeUrl&const_photoup_path&rs("pic")&"' align='center' height='130'>"
			Else%>
            <a href="photo_view.asp?picid=<%=rs("picid")%>"><img src="<%=const_txl_HomeUrl&const_photoup_path&rs("pic")%>" width="106" border="0" alt="<%=rs("LastUpdateInfo")%>" height="130" style="border:#CCCCCC 1px solid;"></a>
            <%End IF%><br><br>
	  <a href="photo_view.asp?picid=<%=rs("picid")%>" title="<%=rs("LastUpdateInfo")%>"><%=subject%></a>
	  <%
			Response.Write("</td>")
			rs.movenext
			k=k+1
			if k mod clos=0 then trflag2=true
			if trflag2 then Response.Write("</tr>")
		wend
		if ss mod 3<>0  then
			for k=1 to (3-ss mod 3)
				Response.Write("<td width='33%'>&nbsp;</td>")
			next
			Response.Write("</tr>")
		end if
	end if%>
</table>
<%
	rs.close
	set rs=nothing
	Response.Flush
End Sub
%>

<%
Sub thismonthbirth
	Dim rs
	set rs=conn.execute ("select  studentid,sname,birthday from ec where month(birthday)=month(now())")
	Response.write "<table width='100%' border='0' cellspacing='0' cellpadding='0'>"&Vbcrlf
	if rs.eof then
		Response.write "<tr>"&vbcrlf
		Response.write "	<td colspan=2>本月没有会员过生日！</td>"&vbcrlf
		Response.write "</tr>"&vbcrlf
	else
		while not rs.eof
			Response.write "<tr>"&vbcrlf
			Response.write "	<td>"&rs("sname")&"</td>"&vbcrlf
			Response.write "	<td width=66 align=right>"&rs("birthday")&"</td>"&vbcrlf
			Response.write "</tr>"&vbcrlf
			rs.movenext
		wend
	end if
	Response.write "</table>"&vbcrlf
	rs.close
	set rs=nothing
	Response.Flush
End Sub
Sub index_newuserlogin
	Dim rs,i,regtime
	set rs=conn.execute ("select  top 10 studentid,sname,regtime from ec order by regtime desc")
	Response.write "<table width='100%' border='0' cellspacing='0' cellpadding='0'>"&Vbcrlf
	Response.write "<tr><td colspan=2  style='font-family:verdana;line-height:1.5;'>"&vbcrlf
	if rs.eof then
		Response.write "·没有信息！"&vbcrlf
	else
		i=0
		while not rs.eof and i<10
			i=i+1
			'if isdate(rs("regtime")) then
				'regtime=datevalue(rs("regtime"))
			'else
				'regtime="&nbsp;"
			'end if
			Response.write "·"&rs("sname")&" <span style='font-size:10px;color:#666666;'>("& datevalue(rs("regtime")) &")</span><br>"&vbcrlf
			rs.movenext
		wend
	end if
	Response.write "</td></tr>"&vbcrlf
	Response.write "</table>"&vbcrlf
	rs.close
	set rs=nothing
	Response.Flush
End Sub
Sub todaybirth
	dim rs,tmpstr,outstr,idd
	set rs=conn.execute ("select ec.sname,ec.studentid from ec where datepart('m',birthday)=datepart('m',now) and datepart('d',birthday)=datepart('d',now)")
	tmpstr=""
	while not rs.eof
		tmpstr=tmpstr&rs(0)&"&nbsp;"
                  idd=rs(1)
		rs.movenext
	wend
	rs.close
	set rs=nothing
	if tmpstr="" then
		outstr="今天没有会员过生日!"
	else
		outstr="<a href='User_showuserinfo.asp?username="&idd&"'><B>"&tmpstr&"</B></a>,今天是你的生日，祝你生日快乐哦!!<bgsound src='sound/happybirth.mid'loop=2>"
         end if
	Response.write outstr
	Response.Flush
    
End SUb

Sub	indexordershow
	dim rs,sql,tmpstr
	'sql="delete from ordersong"
	'conn.execute(sql)
	sql="select ordersong.*,ec.sname from ordersong,ec where ec.studentid=ordersong.username and Isok=1 order by ordersong.id desc "

	Set rs=conn.execute (sql)
	tmpstr=""
	if rs.Eof Then tmpstr="目前没有文件信息！<br>操作：【<a href='music_ordersong.asp' target='_blank'><font color=black>我来添加</font></a>】【<a href='music_showordersong.asp' target='_blank'><font color=black>查看全部文件</font></a>】"
	While not rs.eof
		tmpstr=tmpstr&"查看：</font>【<a href=javacript:; onclick=""javascript:winsteps_open_window('music_displaysong.asp?musicurl="&rs("musicurl")&"&musicname="&rs("musicname")&"',520,300);return false"" title='点击查看'><font color=red>"&Trim(rs("musicname"))&"</font></a>】<br>"&vbcrlf
		tmpstr=tmpstr&"简介：【<font color=green>"&rs("content")&"</font>】<br>"&vbcrlf
		tmpstr=tmpstr&" 操作：【<a href='music_ordersong.asp' target='_blank'><font color=black>我来添加</font></a>】【<a href='music_showordersong.asp' target='_blank'><font color=black>查看全部文件</font></a>】<br><br>"&vbcrlf
		rs.movenext
	Wend
	rs.close
	set rs=nothing
	Response.Write tmpstr
	Response.Flush
End Sub

Function dealtimestr(str)
	If Int(str) < 10 Then
		dealtimestr = "0" & Cstr(str)
	Else
		dealtimestr = Cstr(str)
	End If
End Function
%>