class_usercommand.asp

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

		Else
			If (G_P_This-1) * G_P_PerMax < G_P_AllRecords Then
				rst.move  (G_P_This-1) * G_P_PerMax
				'Dim bookmark
				'bookmark=rst.bookmark
				Select Case strMode
					Case "0"
						strReturn = ShowOnePage(rst)
						strReturn=strReturn & oblog.showpage(false,true,strUnit)
					Case "1"
						strReturn = ShowMessages(rst)
						strReturn="<h1>留言板首页(<a href='"&blogdir&mUserPath&"/message."&f_ext&"#cmt'>签写留言</a>)</h1>" & vbCrLf & strReturn & oblog.showpage(false,true,strUnit)
					Case "2"
						strReturn = strReturn&getPhotolist(rst)
						strReturn=strReturn & oblog.showpage(false,true,strUnit)
				End Select	
			Else
				G_P_This=1
				Select Case strMode
					Case "0"
						strReturn = ShowOnePage(rst)
						strReturn=strReturn & oblog.showpage(false,true,strUnit)
					Case "1"
						strReturn = ShowMessages(rst)
						strReturn="<h1>留言板首页(<a href='"&blogdir&mUserPath&"/message."&f_ext&"#cmt'>签写留言</a>)</h1>" & vbCrLf & strReturn & oblog.showpage(G_P_FileName,G_P_AllRecords,G_P_PerMax,false,true,strUnit)
					Case "2"
						strReturn = strReturn&getPhotolist(rst)
						strReturn=strReturn & oblog.showpage(false,true,strUnit)
				End Select	           	
			End If
		End If
		rst.Close
		Set rst=Nothing
		ShowList=strReturn
	End Function

	Private Function ShowOnePage(rst)
		Dim strBody,strContent,strTmp,rssubject,i,substr
		Dim strTopic,strLoginfo,strLogtext,strMore,strEmot,strAuthor,strAddtime,strTopictxt
		Set rssubject = oblog.execute("select subjectid,subjectname from oblog_subject where userid="&mUserid)
		While Not rssubject.EOF
			substr = substr & rssubject(0) & "!!??((" & rssubject(1) & "##))=="
			rssubject.movenext
		Wend
		substr = substr & "0!!??((全部日志##))=="
		Do While Not rst.EOF
			if (mUsersublist=1 and id>0) or mUserIndexlist=1 then '列表显示
				strBody="<li><a href="&mUserLogpath&rst("logfile")&" >"&oblog.filt_html(rst("topic"))&"</a>　"&oblog.filt_html(rst("author"))&" <span>"&rst("addtime")&"</span></li>"&vbcrlf				
			else
				'If rst("face") = "0" Then
	'					strEmot = ""
	'				Else
	'					strEmot = "<img src="&blogurl&"images/face/" & rst("face") & ".gif />"
	'				End If
				If mUserNickName = "" Or IsNull(mUserNickName) Then
					strAuthor = mUserName
				Else
					strAuthor = mUserNickName
				End If

				If rst("authorid") <> mUserId Then strAuthor = rst("author")
				strAddtime = rst("addtime")
				strTopic = strEmot
				If rst("subjectid") > 0 Then
					strTopic = strTopic & "<a href=""" & mUserCmdpath & "cmd."&f_ext&"?uid="&mUserid&"&do=blogs&id=" & rst("subjectid") & """>[" & oblog.filt_html(getsubname(substr,rst("subjectid"))) & "]</a>"
				End If
				strTopictxt = "<a href=""" & mUserLogpath&rst("logfile") & """>" & oblog.filt_html(rst("topic")) & "</a>"
				If rst("isbest") = 1 Then strTopictxt = strTopictxt & "　<img src=" & blogurl & "images/jhinfo.gif >"
				strTopic = strTopic & strTopictxt
				If rst("istop") = 1 Then strTopictxt = "[置顶]" & strTopictxt
				strLoginfo = strAuthor & " 发表于 " & strAddtime
				strMore = "<a href=""" & mUserLogpath&rst("logfile") & """>阅读全文("&rst("iis")&")</a>"
				strMore = strMore & " | <a href=""" & mUserLogpath & rst("logfile") & "#cmt"">回复("&rst("commentnum")&")</a>"
				strMore = strMore & " | <a href=""" & blogurl & "showtb.asp?id=" & rst("logid") & """ target=""_blank"">引用通告("&rst("trackbacknum")&")</a>"
				'取得文章摘要内容
				If IsNull(rst("Abstract")) Or Trim(rst("Abstract")) = "" or rst("ishide") = 1 or rst("ispassword") <> "" or rst("passcheck") = 0 Then
					'兼容以前数据
					If rst("ishide") = 1 Then strTmp = "此日志为隐藏日志，仅好友可见，<a href='" & blogurl & "more.asp?id=" & rst("logid") & "'>点击进入验证页面</a>。"
					If rst("ispassword") <> "" Then strTmp = "<form method='post' action='" & blogurl & "more.asp?id=" & rst("logid") & "' target='_blank'>请输入日志访问密码：<input type=""password"" size=""15"" name=""password"" />  <input type=""submit"" value=""提交""></form>"
					If rst("passcheck") = 0 Then strTmp = "此日志需要管理员审核后才可见。"
					If strTmp <> "" Then
						strLogtext = strTmp
					Else
						strLogtext = rst("logtext")
						strLogtext = trimlog(strLogtext, rst("showword"))
						'If Left(strLogtext, 7) = "#isubb#" Then
							'strLogtext = UBBCode(strLogtext, 1)
							'strLogtext = Replace(strLogtext, Chr(10), "<br /> ")
							
						'End If
						strLogtext = Replace(strLogtext, "#isubb#", "")
						strLogtext = filtimg(strLogtext)
						If oblog.cacheConfig(45)=1 Then strLogtext = profilthtm(strLogtext)
					End If
				 Else
					strLogtext = rst("Abstract")
				 End If
				 strLogtext=oblog.filt_badword(UBBCode(strLogtext,1))
				 '当使用相对路径时，替换为绝对路径
				 'if is_relativepath=1 then
					'	strLogtext=filtskinpath(strLogtext)
				 'end if
				 strlogn = strlogn & "$" & rst("logid")
				 strBody = Replace(mUserSkinLog, "$show_topic$", strTopic)
				 strBody = Replace(strBody, "$show_loginfo$", strLoginfo)
				 strBody = Replace(strBody, "$show_logtext$", strLogtext)
				 strBody = Replace(strBody, "$show_more$", strMore)
				 strBody = Replace(strBody, "$show_emot$", strEmot)
				 strBody = Replace(strBody, "$show_author$", strAuthor)
				 strBody = Replace(strBody, "$show_addtime$", strAddtime)
				 strBody = Replace(strBody, "$show_topictxt$", strTopictxt)	
				 strBody = Replace(strBody, "$show_blogzhai$", "")	
				 strBody = Replace(strBody, "$show_blogtag$", "")	
				 'show_logmore = show_logmore & strBody
			 end if
			 strContent = strContent & VBCRLF & strBody	
			 rst.movenext
			 i=i+1
			 if i>=G_P_PerMax then exit do
		  Loop
		  set rssubject=nothing
		  ShowOnePage=strContent
		  if (mUsersublist=1 and id>0) or mUserIndexlist=1then
			ShowOnePage="<div id=""subject_index""><ul>"&oblog.filt_html(getsubname(substr,id))&ShowOnePage&"</ul></div>"
		  end if
	End Function	

	Public Function ShowMessages(rst)
		Dim strtopic, stremot, straddtime, strlogtext, strauthor, strloginfo, strmore, strMessage, strtopictxt, strContent
		Dim homepage_str, user_filepath,i
		If Not rst.EOF Then
			Do While Not rst.EOF
				If IsNull(rst("homepage")) Then
					homepage_str = "个人主页"
				Else
					If Trim(Replace(rst("homepage"), "http://", "")) = "" Then
						homepage_str = "个人主页"
					Else
						homepage_str = "<a href=""" & oblog.filt_html(rst("homepage")) & """ target=""_blank"">个人主页</a>"
					End If
				End If
				strtopic = oblog.filt_html(rst("messagetopic")) & "<a name='" & rst("messageid") & "'></a>"
				If rst("isguest") = 1 Then
					strauthor = oblog.filt_html(rst("message_user")) & "(游客)"
				Else
					strauthor = oblog.filt_html(rst("message_user"))
				End If
				straddtime = rst("addtime")
				strtopictxt = strtopic
				strloginfo = strauthor & "发表留言于" & straddtime
				strlogtext = oblog.Ubb_Comment(rst("message"))
				strmore = homepage_str & " | <a href='"&blogurl&"user_messages.asp?action=modify&re=true&id=" & rst("messageid") & "'>回复</a>"
				strmore = strmore & " | <a href=""" & blogurl & "user_messages.asp?action=del&id=" & rst("messageid") & """  target=""_blank"">删除</a>"
				if rst("ishide")=1 then 
					strtopictxt="悄悄话"
					strtopic="悄悄话"
					strlogtext="此留言为悄悄话。"
					strmore=replace(strmore,"回复","查看")
				end if
				strMessage = Replace(mUserSkinLog, "$show_topic$", strtopic)
				strMessage = Replace(strMessage, "$show_loginfo$", strloginfo)
				strMessage = Replace(strMessage, "$show_logtext$", strlogtext)
				strMessage = Replace(strMessage, "$show_more$", strmore)
				strMessage = Replace(strMessage, "$show_emot$", "")
				strMessage = Replace(strMessage, "$show_author$", strauthor)
				strMessage = Replace(strMessage, "$show_addtime$", straddtime)
				strMessage = Replace(strMessage, "$show_topictxt$", strtopictxt)
				strMessage = Replace(strMessage, "$show_blogtag$", "")
				strMessage = Replace(strMessage, "$show_blogzhai$", "")
				strContent = strContent & strMessage
				rst.movenext
				i=i+1
				If i>=G_P_PerMax Then Exit Do
			Loop
		Else
			strContent = "暂无留言"
		End If
		ShowMessages=strContent

	End Function

	'获取用户信息
	Private Function GetUserInfo()
		Dim rst,rst1,ustr
		Set rst=oBlog.Execute("Select * From oBlog_User Where UserId=" & mUserId)
		If rst.Eof Then
			Set rst = Nothing
			Response.Write "错误的用户编号"
			Response.End
		Else
			'判断是否整站加密
			if rst("blog_password")<>""  and Request.Cookies(cookies_name)("blogpw")<>rst("blog_password") then
				set rst=nothing
				response.Write "window.location='"&blogurl&"chkblogpassword.asp?userid="&mUserId&"';"
				response.End()
			end if		
			mUserFolder=rst("user_folder")
			mUserPath=rst("user_dir")&"/"&rst("user_folder")
			mBlogName=rst("blogname")
			mUserName=rst("username")		
			mUserNickName=rst("nickname")
			G_P_PerMax=rst("user_showlog_num")
			mUserPhotoRow=rst("user_photorow_num")
			ustr=rst("user_info")
			mUserIndexlist=rst("indexlist")
			if ustr="" or isnull(ustr) then
				mUsersublist=0
			else
				ustr=split(ustr,"$")
				if ustr(0)<>"" then mUsersublist=cint(ustr(0)) else mUsersublist=0
			end if
			if mUsersublist=1 and id>0 then G_P_PerMax=40 '列表模式调用50条
			if mUserPhotoRow<=0 or isnull(mUserPhotoRow) then mUserPhotoRow=1
			If IsNull(rst("user_skin_showlog")) OR rst("user_skin_showlog")="" Then
				Set rst1 = oBlog.Execute("select skinshowlog from oBlog_userskin where isdefault=1")
				If Not rst1.EOF Then
					mUserSkinLog = rst1("skinshowlog")
					Set rst1 = Nothing
				Else
					Set rst1 = Nothing
					Set rs = Nothing
					Response.Write ("模板错误")
					Response.End
				End If
			Else
				mUserSkinLog=rst("user_skin_showlog")
			End If
			if true_domain=1 then
				mUserCmdpath="/"
				mUserLogpath=""
			else
				mUserCmdpath=blogdir&mUserPath&"/"
				mUserLogpath=blogdir
			end if
			'mUserSkinLog=filtskinpath(mUserSkinLog)
		End If		
		Set rst=Nothing
	End Function

	Function getPhotolist(rsPhoto)
		Dim i,bstr,n,fso,sReturn
		Dim title,imgsrc
		Set fso = server.CreateObject("Scripting.FileSystemObject")	
		sReturn="<table width='100%'  align='center' cellpadding='0' cellspacing='1'><tbody>"& vbcrlf
		Do While not rsPhoto.eof
			sReturn=sReturn&"<tr>"& vbcrlf
			For n=1 to mUserPhotoRow
				if rsPhoto.eof then
					sReturn=sReturn&"<td width='25%'></td>"& vbcrlf
				Else
					title="<BR/><a href=" & blogurl & "more.asp?id=" & rsPhoto(1) &" target=_blank >阅读相片介绍</a><BR/><BR/>"
					imgsrc=blogurl & rsPhoto(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=blogurl&rsPhoto(0)
					'End if
					sReturn=sReturn&"<td align='center'> <a href='"& blogurl & rsPhoto(0)&"' target='_blank' title='点击查看原图'><img src='"&imgsrc&"' height='100' width='130' border='0' /></a><br />"&title&"</td>"& vbcrlf
					i=i+1
					if not rsPhoto.eof then rsPhoto.movenext
				End if
			Next
			sReturn=sReturn&"</tr>"& vbcrlf
			if i>=G_P_PerMax then exit do	
		loop		
		sReturn=sReturn&"</tbody></table>"	& VBCRLF
		Set fso=nothing
		getPhotolist=sReturn
	End Function

	'获取用户分类
	Function GetUserClasses(typestr)
		Dim rst,sReturn,strPlayerUrl
		strPlayerUrl= blogurl & "PhotoPlayer.asp?userid="&muserid
		Set rst=conn.Execute("Select * From oblog_subject Where subjecttype=1 and userid="&mUserid&" order by ordernum")
		If rst.Eof Then
			sReturn=""
		Else
			Do While Not rst.Eof
				sReturn=sReturn&"<option value="&rst("subjectid")&">" & rst("subjectname") & "</option>" & VBCRLF
				rst.Movenext
			Loop
			sReturn = "<option value="""">请选择相片分类</option><option value='0'>所有分类</option>" & VBCRLF & sReturn
			sReturn="<select name=classid onchange=""javascript:window.location='"&mUserCmdpath&"cmd."&f_ext&"?uid="&muserid&"&do="&typestr&"&id='+this.options[this.selectedIndex].value;"">" & VBCRLF & sReturn & "</select>"
		End If
		rst.Close
		Set rst=Nothing
		sReturn=sReturn&"　<a href=""#"" onclick=""window.open('"&strPlayerUrl&"','_photo','height=500, width=480, top=100, left=400, toolbar=no, menubar=no, scrollbars=no, resizable=yes,status=no')"">启用自动播放</a>" & VBCRLF
		if typestr="album" then
			sReturn=sReturn&"  <a href='"&mUserCmdpath&"cmd."&f_ext&"?uid="&mUserid&"&do=photos'>日志方式浏览</a>"
		else
			sReturn=sReturn&"  <a href='"&mUserCmdpath&"cmd."&f_ext&"?uid="&mUserid&"&do=album'>相册方式浏览</a>"
		end if
		GetUserClasses = sReturn	
	End Function


	function showinfo()
		dim rs,str,c0,c1,c2
		select case trim(request("infotype"))
		case "1"
			str=str&"<ul class=""ob_user_friend"">"
			set rs=oblog.execute("select a.username,a.nickname,a.user_icon1,a.userid from oblog_user a,oblog_friend  b where a.userid=b.friendid and b.userid ="&Muserid&" and b.isblack=0 order by b.id desc")
			while not rs.eof 
				str=str&"<li><a href=" &blogurl & "go.asp?userid="&rs(3)&" target=_blank><img src=""" & ProIco(rs(2),1) & """ class=""ob_face_info"" /><br />"&OB_IIF(rs(1),rs(0))&"</a></li>"&vbcrlf
				rs.movenext
			wend
			str=str&"</ul>"& vbcrlf
			c1=" class='nowselect' "
		case "2"
			str=str&"<ul class=""ob_user_group"">"
			set rs=oblog.execute("select a.t_name,a.teamid,a.t_ico from oblog_team a,oblog_teamusers  b where a.teamid=b.teamid and a.istate=3 and (b.state=3 or b.state=5 ) and userid ="&Muserid)
			while not rs.eof 
				str=str&"<li><a href=" &blogurl & "group.asp?gid="&rs(1)&" target=""_blank""><img src=""" & ProIco(rs(2),2) & """ class=""group_logo_info"" /><br />"&oblog.filt_html(left(rs(0),18))&"</a></li>"&vbcrlf
				rs.movenext
			wend
			str=str&"</ul>"& vbcrlf
			c2=" class='nowselect' "
		case else
			set rs=oblog.execute("select * from oblog_user where userid="&Muserid)
			if not rs.eof then
				str=str&"<ul class=""ob_user_info""><img src=""" & ProIco(rs("user_icon1"),1) & """ class=""ob_face_info"" /><li>用户名："&rs("username")&"</li><li>昵　称："&rs("nickname")&"</li><li>性　别："&ob_IIF2(rs("sex")=1,"男","女")&"</li><li>真　名："&rs("truename")&"</li><li>所在地："&rs("province")&rs("city")&"</li><li>生　日："&rs("birthday")&"</li><li>职　业："&rs("job")&"</li><li>ＭＳＮ："&rs("msn")&"</li><li>Ｑ　Ｑ："&rs("qq")&"</li><li>地　址："&rs("address")&"</li><li>简　介："&oblog.filt_html(rs("siteinfo"))&"</li></ul>"& vbcrlf
			end if
			c0=" class='nowselect' "
		end select
		showinfo="<div id=""ob_userinfo""><ul class=""top""><li"&c0&"><a href='"&mUserCmdpath&"cmd."&f_ext&"?uid="&mUserid&"&do=info'>详细资料</a></li><li"&c1&"><a href='"&mUserCmdpath&"cmd."&f_ext&"?uid="&mUserid&"&do=info&infotype=1'>好友</a></li><li"&c2&"><a href='"&mUserCmdpath&"cmd."&f_ext&"?uid="&mUserid&"&do=info&infotype=2'>" &P_QQ_NAME& "</a></li></ul>"&str&"</div>"
		set rs=nothing
	end function	
End Class	
%>