syscode.asp

来自「是个不错的文件代码,希望大家好好用,」· ASP 代码 · 共 887 行 · 第 1/3 页

End Function

Function show_search(i)
	If i = 0 Then i = "" Else i = "<br />"
	show_search = "<form name='search' method='post' action='list.asp'>"
	show_search=show_search&"<select name='selecttype' id='selecttype'>"
	show_search=show_search&"<option value='topic' selected>日志标题</option>"
	show_search=show_search&"<option value='logtext'>日志内容</option>"
	show_search=show_search&"<option value='id'>博客名称</option></select>"&i
	show_search=show_search&"<input name='keyword' type='text' id='keyword' size='16' maxlength='40'>"
	show_search=show_search&" <input type='submit' name='Submit' value='搜索'></form>"
End Function

Function show_cityblogger(i)
	show_cityblogger = "<form name=""oblogform"" action=""listblogger.asp"">" & oblog.type_city("", "") & " <input type='submit' value='搜索'></form>"
	If i = 1 Then show_cityblogger = Replace(show_cityblogger, "<select name='city'", "<br /><select name='city'")
End Function

Function show_newphoto(n, i, w, h)
	Dim rs, sReadMe,surl,imgsrc,fso,wstr,hstr
	Set fso = server.CreateObject("Scripting.FileSystemObject")
	If i = 1 Then i = "<br />" Else i = ""
	if w<>0 or w<>"" then wstr="width="""&w&""""
	if h<>0 or h<>"" then hstr="height="""&h&"""" 
	Set rs = oblog.execute("select top " & CLng(n) & " file_path,file_readme,oblog_upfile.userid,user_dir,username,nickname,logid from [oblog_user],oblog_upfile where oblog_user.userid=oblog_upfile.userid and isphoto=1 and ispower=0  and oblog_user.isdel=0 order by fileid desc")
	While Not rs.EOF
		If IsNull(rs(1)) Then
			sReadMe = ""
		Else
			sReadMe = oblog.filt_html(rs(1))
		End If
		if rs("logid")=0 or isnull(rs("logid")) then 
			surl="<a href='"&rs("file_path")&"' target='_blank'>"
		else
			surl="<a href='go.asp?albumid="&rs("userid")&"' target='_blank'>"
		end if
		imgsrc=rs(0)
		imgsrc=replace(imgsrc,right(imgsrc,3),"jpg")
		imgsrc=replace(imgsrc,right(imgsrc,len(imgsrc)-InstrRev(imgsrc,"/")),"pre"&right(imgsrc,len(imgsrc)-InstrRev(imgsrc,"/")))
		if  not fso.FileExists(Server.MapPath(imgsrc)) then
			imgsrc=rs(0)
		end if
		show_newphoto=show_newphoto&"<a href='go.asp?albumid="&rs("userid")&"' target='_blank'><img src="""&imgsrc&""" "&wstr&" "&hstr&" hspace=""6"" border=""0"" vspace=""6"" alt='"& sReadMe &"' /></a>"&i
		rs.MoveNext
	Wend
	Set rs = Nothing
End Function

Function show_blogstar()
	Dim rs
	Set rs = oblog.execute("select top 1 * from oblog_blogstar where ispass=1 order by id desc")
	If Not rs.EOF Then
		show_blogstar = "<div><a href='" & rs("userurl") & "' target='_blank'><img src=""" & rs("picurl") & """  hspace=""3"" border=""0"" vspace=""3"" alt='" & oblog.filt_html(rs("blogname")) & "' /></a></div>"
		show_blogstar=show_blogstar&"<div>博客："&"<a href='"&rs("userurl")&"' target='_blank'>"&oblog.filt_html(rs("blogname"))&"</a></div>"
		show_blogstar=show_blogstar&"<div>简介："&oblog.filt_html(rs("info"))&"</div>"
	Else
		show_blogstar = " "
	End If
	Set rs = Nothing
End Function

Public Function show_blogstar2(iNumber, iPerline, iWidth, iHeight)
	Dim rs, iCount, sLine
	If Not IsNumeric(iNumber) Then
		iNumber = 1
	Else
		iNumber = CLng(iNumber)
	End If
	'iWidth=160
	'iHeight=160
	If iNumber = 0 Then iNumber = 1
	Set rs = oblog.execute("select top " & iNumber & " * from oblog_blogstar where ispass=1 order by id desc")
	If Not rs.EOF Then
		show_blogstar2 = "<table style=""table-layout: fixed"" width=" & (iWidth + 2) * iPerline & " border=0><tr>"
		If iNumber = 1 Then
			sLine = "<td nowrap  valign=top style=""width:" & (iWidth + 2) & "px;white-space:nowrap;text-overflow : clip; overflow : hidden;""><a href='" & rs("userurl") & "' target='_blank'><img src=""" & rs("picurl") & """  hspace=""3"" border=""0"" vspace=""3"" alt='" & oblog.filt_html(rs("blogname")) & "' onload=""javascript:if(this.width>" & iWidth & ") this.style.width=" & iWidth & ";"" /></a><BR/>"
			sLine = sLine & "博客：" & "<a href='" & rs("userurl") & "' target='_blank'>" & oblog.filt_html(rs("blogname")) & "</a><BR/>"
			sLine = sLine & "简介：" & oblog.filt_html(rs("info")) & "</td>"
			show_blogstar2 = show_blogstar2 & sLine & "</tr>" & vbCrLf
		'多图片时强制大小统一
		Else
			iCount = 1
			Do While Not rs.EOF
				sLine = "<td nowrap  valign=top style=""width:" & (iWidth + 2) & "px;white-space:nowrap""><a href='" & rs("userurl") & "' target='_blank'><img src=""" & rs("picurl") & """  hspace=""3"" border=""0"" vspace=""3"" alt='" & oblog.filt_html(rs("blogname")) & "' width=" & iWidth & " height=" & iHeight & " /></a><BR/>"
				sLine = sLine & "博客：" & "<a href='" & rs("userurl") & "' target='_blank'>" & oblog.filt_html(rs("blogname")) & "</a><BR/>"
				sLine = sLine & "简介：" & oblog.filt_html(rs("info")) & "</td>" & vbCrLf
				show_blogstar2 = show_blogstar2 & sLine
				If iCount Mod iPerline = 0 Then show_blogstar2 = show_blogstar2 & "</tr>"
				iCount = iCount + 1
				rs.MoveNext
			Loop
			If Right(show_blogstar2, 5) <> "</tr>" Then show_blogstar2 = show_blogstar2 & "</tr>"
		End If
		show_blogstar2 = show_blogstar2 & "</table>"
	Else
		show_blogstar2 = " "
	End If
	rs.Close
	Set rs = Nothing
End Function

'获取标签
's 表现形式 1-列表形式,2-云图形式
'n 标签数目
'x 排序方式 0 自然序/1频度最高
'y 每行显示数目
Function GetHotTags(s,n,x,y)
	Dim sContent,sSql,rst,iFont,iFontSize,i,iFontFamily
	Dim sSplit
	sSplit="&nbsp;&nbsp;"
	sSql="Select top "& n & " * From oblog_Tags Where iNum>0 "
	If s=1 Then sSql= sSql & " Order By iNum Desc"
	Set rst=conn.Execute(sSql)
	If rst.Eof Then
		sContent=""
	Else
		Do While Not rst.Eof
			If s=1 Then
				sContent= sContent & "<span><a href=""tags.asp?tagid=" & rst("tagID") &""">" & rst("Name")& "<span>(" & rst("iNum") &  ")</span></a></span>" & sSPlit
			Else
				iFont=rst("iNum") Mod 100
				If iFont=0 Then iFontSize=10
				If iFont>-1 And iFont<20 Then iFontSize=10 + iFont
				if iFontSize>18 and iFontSize<23 then iFontSize=20
				if iFontSize>23 and iFontSize<28 then iFontSize=25
				if iFontSize>28 then iFontSize=30
				if iFontSize >18 then iFontFamily="黑体,"
				sContent= sContent & "<a href=""tags.asp?tagid=" & rst("tagID") & """ title="""& rst("Name") &"""><span style=""font-size:"& iFontSize &"px;line-height:26px;font-family:"&iFontFamily&"Arial, Helvetica"">" & Left(rst("Name"),10)& "</span></a>" & sSPlit
			End If
			i=i+1
			If i Mod y = 0 Then
				sContent = sContent &  "<br />"
			End If			
			rst.Movenext
		Loop
	End If
	rst.Close
	Set rst=Nothing
	GetHotTags= sContent
	sContent=""
End Function

'x:1- 最新创建/2-最活跃群组(贴数最多)/3-规模大(人数最多) / 4-推荐群组
'n: 数目
'l: 题目显示长度
'y: 是否显示图标
'w:	图标宽度，不写则默认50
'h: 图标高度，不写则默认50
Function GetTeams(x,n,l,y,w,h)
	Dim rs,Sql,sRet,sIco
	Sql="Select top " & n & " teamid,t_name,t_ico,icount0,(icount1+icount2) From oblog_team Where istate=3 and isdel=0  " 
	Select Case x
		Case 1
			Sql= Sql & " Order By teamid Desc"
		Case 2
			Sql= Sql & " Order By (icount1+icount2) Desc"
		Case 3
			Sql= Sql & " Order By icount0 Desc"
		Case 4
			Sql= Sql & " and isbest=1"
	End Select
	Set rs=oblog.Execute(Sql)
	sRet="<div><ul>"
	Do While Not rs.Eof 
		sRet=sRet & "<li>" 
		If y=1 Then
			If w="" Then w=50:h=50
			sIco=LCase(Ob_IIF(rs(2),"images/ico_default.gif"))			
			If Left(sico,7)<>"http://" Then sico=blogdir & sico
			sRet=sRet & "<img src=""" & sico & """ width=""" & w &""" height=""" & h &"""/><br />"
		End if	
		sRet=sRet & "<a href=""group.asp?gid=" & rs(0) & """ target=""_blank"">" & Left(oblog.filt_html((rs(1))),l) & "</a>(" & rs(3) & "/" & rs(4) & ")"
		sRet=sRet & "</li>" & Vbcrlf
		rs.movenext
	Loop
	Set rs=Nothing
	sRet=sRet & "</ul></div>"
	GetTeams=sRet
End Function

'获取群组文章
'teamid: 0 所有群组;如果是选择多个群组,则把群组ID用|分隔开,如1|2|8
'postnum: 帖子数目
'l:帖子主题显示字数
'u:是否显示用户名 0/1
't:是否显示发帖时间 0/1
Function GetPosts(teamid,postnum,l,u,t)
	Dim rs,sql,sRet,sAddon
	Sql="Select Top " & postnum & " teamid,postid,topic,addtime,author,userid From oblog_teampost Where idepth=0 and isdel=0 "
	If teamid<>"" And teamid<>"0" Then
		teamid=Replace(teamid,"|",",")
		Sql=Sql & " And teamid In (" & teamid & ") "
	End If
	Sql=Sql & " Order by postid Desc"
	Set rs=oblog.Execute(Sql)
	sRet="<ul>"
	Do While Not rs.Eof
		sAddon=""
		sRet=sRet & "<li><a href=""group.asp?gid=" & rs(0) & "&pid=" & rs(1) & """ target=""_blank"">" & oblog.Filt_html(Left(rs(2),l)) & "</a>"
		If u=1 Then sAddon=rs(4)
		if t=1 Then
			If sAddon<>"" Then sAddon=sAddon & ","
			sAddon=sAddon & rs(3)
		End If
		If sAddon<>"" Then sAddon="(" & sAddon & ")"
		sRet=sRet & sAddon & "</li>"
		rs.Movenext
	Loop
	Set rs = Nothing
	sRet=sRet & "</ul>"
	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")
	GetHotUsers="<ul>"
	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"">"&userico& rs(2)&"</a></li>" & vbcrlf      
		rs.MoveNext
	Wend
	GetHotUsers=GetHotUsers&"</ul>"
	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=P_QQ_NAME& "类别"
			wsql=" where idType=2 "		
			fname="groups.asp?classid="
	end select
	dim sqlClass,rsClass,D_String
	sqlClass="select * 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>,"&rsClass("readme")
		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
%>