⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 syscode.asp

📁 电子备课系统
💻 ASP
📖 第 1 页 / 共 4 页
字号:
		sRet=sRet & "</ul>" & Vbcrlf
		sRet = sRet & oblog.GetNickNameById (arrayList,i,teamid&postnum&l&u&t)
	End if
	GetPosts=sRet
End Function

'最受欢迎的用户,计算方法
'user_siterefu_num+comment_count*1.5+message_count*1.5+sub_num*3
'访问数+回复数*1.5+留言数*1.5+被订阅数*3
't 是否显示用户头像
Function GetHotUsers(n,t)
	Dim rs, userurl,userico,i
	set rs=oblog.execute("select top "&n&" username,nickname,blogname,userid,user_dir,user_domain,user_domainroot,user_folder,user_icon1 from [oblog_user] where lockuser=0 and isdel=0 order by (user_siterefu_num+comment_count*1.5+message_count*1.5+sub_num*3) desc,userid DESC")
	GetHotUsers = Vbcrlf & "<ul>" & Vbcrlf
	While Not rs.EOF
		If oblog.cacheConfig(5) = 1 Then
			userurl = "http://" & Trim(rs("user_domain")) & "." & Trim(rs("user_domainroot"))
		Else
			userurl = rs("user_dir") & "/" & rs("user_folder") & "/index." & f_ext
		End If
		If t=1 Then userico="<img src=""" & OB_IIF(rs(8),"images/ico_default.gif") & """ width=""48"" height=""48"" border=""0"" /><br />"
		GetHotUsers=GetHotUsers&"<li><a href="&userurl&" target=""_blank"" title=""" & rs(2)& """>"&userico& rs(2)&"</a></li>" & vbcrlf
		rs.MoveNext
	Wend
	GetHotUsers=GetHotUsers&"</ul>" & Vbcrlf
	Set rs = Nothing
End Function

'随机调用博客链接,这里只调头像,博客名会默认显示在提示那里.
'show_rnduser(调用条数,图片高度,图片宽度,是否只调用推荐/活跃,多少天内登录过的活跃用户,是否只调用有自定义头像的用户)
'是否只调用推荐/活跃    1 只是推荐    10 只是推荐男生博客  11 只是推荐女生博客 2 按最后登录时间过滤 20按登录时间过滤男生  21按登录时间过滤女生
'是否只调用有自定义头像的用户 0 否 1 是
'$show_rnduser(40,48,48,2,30,1)$

Function GetRndUser(num,width,height,types,dht,ishaveface)
	Dim rs,sql,Utype,UFdate,RndOrderBy,userurl
	UFdate = int(dht)
	If Err Then Err.clear:UFdate = 30
		If Is_Sqldata = 1 Then
			RndOrderBy = " Order By Newid()"
		Else
			Randomize
			RndOrderBy = " Order By Rnd(-(UserID+"&Rnd()&"))"
		End If 
		If ishaveface = "1" Then RndOrderBy=" and not(user_icon1 is null or user_icon1='') " & RndOrderBy
	Select Case types
		Case "1"
			Utype= " and user_isbest=1"
		Case "10"
			Utype= " and user_isbest=1 and sex=1"
		Case "11"
			Utype= " and user_isbest=1 and sex=0"
		Case "2"
			Utype= " and datediff("&G_Sql_d&",lastlogin,"&G_Sql_Now&") <= "&UFdate
		Case "20"
			Utype= " and sex=1 and datediff("&G_Sql_d&",lastlogin,"&G_Sql_Now&") <= "&UFdate
		Case "21"
			Utype= " and sex=0 and datediff("&G_Sql_d&",lastlogin,"&G_Sql_Now&") <= "&UFdate
	End Select 
		Set rs=oblog.execute("select top "&num&" username,nickname,blogname,userid,user_dir,user_domain,user_domainroot,user_folder,user_icon1 from [oblog_user] where lockuser=0 and isdel=0 and (blog_password is null or blog_password='')  "&Utype&" "&RndOrderBy)
		GetRndUser = Vbcrlf & "<ul id=""showrnduser"">" & Vbcrlf
	While Not rs.EOF
		If oblog.cacheConfig(5) = 1 Then
			userurl = "http://" & Trim(rs("user_domain")) & "." & Trim(rs("user_domainroot"))
		Else
			userurl = rs("user_dir") & "/" & rs("user_folder") & "/index." & f_ext
		End If
			GetRndUser=GetRndUser&"<li><a href="""&userurl&""" target=""_blank"" title=""" & rs(2)& """><img src=""" & OB_IIF(rs(8),"images/ico_default.gif") & """ width="""&width&""" height=""" & height & """ border=""0"" title="""&rs(2)&"""/></a></li>" & vbcrlf
		rs.MoveNext
	Wend
	GetRndUser=GetRndUser&"</ul>" & Vbcrlf
	Set rs = Nothing


End Function 

function TreeClass(n)
	dim Table_Name,wsql,toptitle,fname
	select case n
		case "user"
			Table_Name="oblog_userclass"
			wsql=""
			toptitle="用户类别"
			fname="listblogger.asp?usertype="
		case "log"
			Table_Name="oblog_logclass"
			wsql=" where idType=0 "
			toptitle="日志类别"
			fname="list.asp?classid="
		case "photo"
			Table_Name="oblog_logclass"
			wsql=" where idType=1 "
			toptitle="相片类别"
			fname="photo.asp?classid="
		case "group"
			Table_Name="oblog_logclass"
			toptitle=oblog.CacheConfig(69)& "类别"
			wsql=" where idType=2 "
			fname="groups.asp?classid="
	end select
	dim sqlClass,rsClass,D_String
	sqlClass="select id,parentid,classname From "&Table_Name&wsql&"  order by RootID,OrderID"
	set rsClass=oblog.execute(sqlClass)
	'把查询到的内容存放到字符串里,在JS中调用该字符串
	do	while not rsClass.eof
		D_String=D_String&"|"&rsClass("id")&","&rsClass("parentid")&",<a href='"&fname & rsClass("id") & "'>"&rsClass("classname")&"</a>,0"
		rsClass.movenext
	loop
	TreeClass="<script src='inc/tree.js'></script><script language='javascript' type='text/javascript'>var J_String,J_First,J_Second;var i,j;d = new dTree('d');d.add(0,-1,'<strong>"&toptitle&"</strong>');J_String="""&D_String&""";J_First=J_String.split('|');for(i=0;i<J_First.length;i++){J_Second=J_First[i].split(',');d.add(J_Second[0],J_Second[1],J_Second[2],'',J_Second[3]);}document.write(d);</script>"
	set rsClass=nothing
end function

'获得辩论列表
'n:显示条数;
'l:字符数目;
's:显示类型,1最新/2参与人数最多
Function GetArgueList(n,l,s)
	Dim sRet,Sql,rs,sState
	If s="1" Then
		'最新
		Sql="select top " & n & " argueid,topic,a_ico,actions,actions1,actions2,actions3 From oblog_argue Where istate=2 Order By argueid Desc"
	Else
		'最热的
		Sql="select top " & n & " argueid,topic,a_ico,actions,actions1,actions2,actions3  From oblog_argue Where istate=2 Order By actions Desc"
	End If
	'Response.Write Sql
	Set rs=oblog.Execute(Sql)
	Do While Not rs.Eof
		sRet=sRet & "<li><a href=""bl.asp?cmd=show&blid=" & rs("argueid") & """ target=""_blank"">" & Left(rs("topic"),l) & "</a><br/><font color=""red"">正</font>&nbsp;" & rs("actions1") & "&nbsp;&nbsp;<font color=""blue"">反</font>&nbsp;" & rs("actions2") & "&nbsp;&nbsp;<font color=""green"">参与</font>&nbsp;" &  rs("actions") & "</li>"
		rs.Movenext
	Loop
	Set rs=Nothing
	GetArgueList=sRet
	sRet=""
End Function

Function GetTemplate(n)
	Dim sRet,Sql,rs
	sql="SELECT TOP "&n&" * FROM oblog_userskin WHERE ispass=1 ORDER BY Id DESC"
	Set rs=Server.CreateObject("Adodb.Recordset")
	rs.open sql ,CONN,1,1
	If Not RS.Eof Then
		While Not rs.EOF
			sRet = sRet &"<!-- 最新模板 -->"&vbcrlf
			sRet = sRet &"<div id=""NewSkin"">"&vbcrlf
			sRet = sRet &"	<div class=""SkinImg""><a href=""showskin.asp?id="&rs("id")&""" target =""_blank""><img src="""&rs("skinpic")&""" alt="""&rs("userskinname")&""" /></a></div>"&vbcrlf
			sRet = sRet &"	<div class=""Skinname""><a href=""showskin.asp?id="&rs("id")&""" target =""_blank"">"&rs("userskinname")&"</a></div>"&vbcrlf
			sRet = sRet &"</div>"&vbcrlf
			sRet = sRet &"<!-- 最新模板 END -->"&vbcrlf
			rs.MoveNext
		Wend
	End If
	GetTemplate = sRet
	sRet = ""
End Function

Function GetAlbum(n,l)
	Dim sRet,Sql,rs
	Dim Imgsrc,Preimgsrc,fso
	Set fso = Server.CreateObject(oblog.CacheCompont(1))
	Sql = "SELECT TOP "&N&" c.photo_path,c.subjectid,c.subjectlognum,userid,subjectname FROM "
	Sql = Sql &" oblog_subject AS c "
	Sql = Sql &" WHERE c.subjecttype = 1 AND (c.ishide = 0 OR c.ishide IS NULL)"
	If L = 0 Then
		Sql = Sql &" ORDER BY c.subjectid DESC"
	Else
		Sql = Sql &" ORDER BY c.views DESC,c.subjectid DESC"
	End If
'	OB_DEBUG SQL,1
	Set rs=Server.CreateObject("Adodb.Recordset")
	rs.open sql ,CONN,1,1
	If Not RS.Eof Then
		sRet = "<!-- 相册标签 -->"&vbcrlf
		sRet = sRet &"<div id=""NewPhotoAlbum"">"&vbcrlf
		While Not rs.EOF
			Imgsrc=RS(0)
			If Not IsNull(Imgsrc) Then
				Preimgsrc=Replace(Imgsrc,Right(Imgsrc,3),"Jpg")
				Preimgsrc=Replace(Preimgsrc,Right(Preimgsrc,Len(Preimgsrc)-instrrev(Preimgsrc,"/")),"Pre"&Right(Preimgsrc,Len(Preimgsrc)-instrrev(Preimgsrc,"/")))
				If Not Fso.Fileexists(Server.Mappath(Preimgsrc)) Then
					Preimgsrc=Imgsrc
				End If
			End if
			sRet = sRet &"	<div class=""NewPhotoAlbum"">"&vbcrlf
			sRet = sRet &"		<div class=""NewPhotoAlbumImg""><a href=""go.asp?albumid="&rs(3)&""" target = ""_blank""><img src="""&Proico(Preimgsrc,4)&""" /></a></div>"&vbcrlf
			sRet = sRet &"		<div class=""NewPhotoAlbumName""><a href=""go.asp?albumid="&rs(3)&""" target = ""_blank"">"&rs("subjectname")&"</a></div>"&vbcrlf
			sRet = sRet &"	</div>"&vbcrlf
			RS.MoveNext
		Wend
		sRet = sRet &"</div>"&vbcrlf
		sRet = sRet &"<!-- 相册标签 END -->"&vbcrlf
	End If
	GetAlbum = sRet
	sRet = ""
End Function

Function GetPic(n,l)
	Dim sRet,Sql,rs
	Dim Imgsrc,Preimgsrc,fso
	Set fso = Server.CreateObject(oblog.CacheCompont(1))
	Sql = "SELECT TOP "&N&" photo_path,photo_title,fileid FROM oblog_album "
	Sql = Sql &" WHERE (ishide = 0 OR ishide IS NULL)"
	If L = 0 Then
		Sql = Sql &" ORDER BY photoID DESC"
	ElseIf l = 1 Then
		Sql = Sql &" ORDER BY views DESC,photoID DESC"
	Else
		Sql = Sql &" ORDER BY commentnum DESC,photoID DESC"
	End If
'	OB_DEBUG SQL,1
	Set rs=Server.CreateObject("Adodb.Recordset")
	rs.open sql ,CONN,1,1
	If Not RS.Eof Then
		sRet = "<!-- 相片标签 -->"&vbcrlf
		sRet = sRet &"<div id=""NewPhoto"">"&vbcrlf
		While Not rs.EOF
			Imgsrc=RS(0)

			Preimgsrc=Replace(Imgsrc,Right(Imgsrc,3),"Jpg")
			Preimgsrc=Replace(Preimgsrc,Right(Preimgsrc,Len(Preimgsrc)-instrrev(Preimgsrc,"/")),"Pre"&Right(Preimgsrc,Len(Preimgsrc)-instrrev(Preimgsrc,"/")))
			If Not Fso.Fileexists(Server.Mappath(Preimgsrc)) Then
				Preimgsrc=Imgsrc
			End If
			sRet = sRet &"	<div class=""NewPhoto"">"&vbcrlf
			sRet = sRet &"		<div class=""NewPhotoImg""><a href=""go.asp?fileid="&rs(2)&""" target = ""_blank""><img src="""&Proico(Preimgsrc,4)&""" /></a></div>"&vbcrlf
			sRet = sRet &"		<div class=""NewPhotoName""><a href=""go.asp?fileid="&rs(2)&""" target = ""_blank"">"&OB_IIF(rs(1),"无标题")&"</a></div>"&vbcrlf
			sRet = sRet &"	</div>"&vbcrlf
			RS.MoveNext
		Wend
		sRet = sRet &"</div>"&vbcrlf
		sRet = sRet &"<!-- 相片标签 END -->"&vbcrlf
	End If
	GetPic = sRet
	sRet = ""
End Function

Function GetDiggs(n,l)
	Dim sRet,Sql,rs,ClassName
	Dim arrayList,i
	ReDim arrayList(n-1)
	Sql = "SELECT TOP "&N&" diggnum,diggurl,diggtitle,addtime,author,authorid FROM oblog_userdigg "
	Sql = Sql &" WHERE istate = 1 "
	If L = 0 Then
		Sql = Sql &" ORDER BY DiggID DESC"
		ClassName = "NewDIGG"
	ElseIf l = 1 Then
		Sql = Sql &" ORDER BY diggnum DESC,DiggID DESC"
		ClassName = "DIGGTop"
	Else
		Sql = Sql &" ORDER BY lastdiggtime DESC"
	End If
'	OB_DEBUG SQL,1
	Set rs=Server.CreateObject("Adodb.Recordset")
	rs.open sql ,CONN,1,1
	If Not RS.Eof Then
		i = 0
		sRet = "<!-- DIGG标签 -->"&vbcrlf
		sRet = sRet &"<div id="""&ClassName&""">"&vbcrlf
		While Not rs.EOF
			arrayList(i) = rs("authorid")
			sRet = sRet &"	<div class="""&ClassName&""">"&vbcrlf
			sRet = sRet &"		<span class=""DIGGNumber"">"&rs(0)&"</span>"&vbcrlf
			sRet = sRet &"		<span class=""DIGGTitle""><a href="""&rs(1)&""" title="""&rs(2)&""">"&rs(2)&"</a></span>"&vbcrlf
			If l = 0 Then
				sRet = sRet &"		<span class=""DIGGTime"">"&rs(3)&"</span>"&vbcrlf
				sRet = sRet &"		<span class=""DIGGUser""><a href=""go.asp?userid="&rs(5)&"""><span name=""nickname_"&rs("authorid")&""" id=""nickname_"&rs("authorid")&""">"&rs("authorid")&"</span></a></span>"&vbcrlf
			End If
			sRet = sRet &"	</div>"&vbcrlf
			i = i + 1
			RS.MoveNext
		Wend
		sRet = sRet &"</div>"&vbcrlf
		sRet = sRet &"<!-- DIGG标签 END -->"&vbcrlf
		sRet = sRet & oblog.GetNickNameById (arrayList,i,n&l)
	End If
	GetDiggs = sRet
	sRet = ""
End Function

Function GetUserDiggs(n,l)
	Dim sRet,Sql,rs
	Sql = "SELECT TOP "&N&" userid,User_Icon1,username,nickname,diggs FROM "
	Sql = Sql &" oblog_user "
	Sql = Sql &" WHERE lockuser=0 AND isdel=0  "
	If L = 0 Then
		Sql = Sql &" ORDER BY diggs DESC,userid DESC"
	Else
		Sql = Sql &" ORDER BY userid DESC"
	End If
'	OB_DEBUG SQL,1
	Set rs=Server.CreateObject("Adodb.Recordset")
	rs.open sql ,CONN,1,1
	If Not RS.Eof Then
		sRet = "<!-- DIGG标签 -->" & vbcrlf
		sRet = sRet &"<div id=""DIGGMostUser"">" & vbcrlf
		While Not rs.EOF
			sRet = sRet &"	<div class=""DIGGMostUser"">" & vbcrlf
			sRet = sRet &"		<div class=""DIGGMostUserIco""><a href=""go.asp?userid="&rs(0)&""" target = ""_blank""><img src="""&Proico(rs(1),1)&""" alt="""&OB_IIF(rs(3),rs(2))&""" /></a></div>" & vbcrlf
			sRet = sRet &"		<div class=""DIGGMostUserName""><a href=""go.asp?userid="&rs(0)&""" title=""alt="""&OB_IIF(rs(3),rs(2))&""""" target = ""_blank"">"&OB_IIF(rs(3),rs(2))&"</a>被推荐<span title="""&OB_IIF(rs(4),0)&""">"&OB_IIF(rs(4),0)&"</span>次</div>" & vbcrlf
			sRet = sRet &"	</div>" & vbcrlf
			RS.MoveNext
		Wend
		sRet = sRet &"</div>" & vbcrlf
		sRet = sRet &"<!-- DIGG标签 END -->" & vbcrlf
	End If
	GetUserDiggs = sRet
	sRet = ""
End Function
%>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -