class_usercommand.asp

本息统基于中国网站技术人员最熟悉WindowsNT环境和Asp语言

	  	If rst.Eof  Then
			strReturn=strReturn & "<ul>无记录</ul>"
			ShowList = strReturn
			rst.Close
			Set rst=Nothing
			Exit Function
		End If
		Total=rst.RecordCount
		'strReturn=strReturn & "共调用" & Total & strUnit & "<br>"
		If CurrentPage<1 Then
	     	CurrentPage=1
	    End If
	    If (CurrentPage-1)*MaxPerPage>Total Then
			If (Total mod MaxPerPage)=0 Then
		     	CurrentPage= Total \ MaxPerPage
			Else
			    CurrentPage= Total \ MaxPerPage + 1
		   	End If
	    End If
		If CurrentPage=1 Then
			Select Case strMode
					Case "0"
						strReturn = strReturn&ShowOnePage(rst)
						strReturn=strReturn & oblog.showpage(mFileName,Total,MaxPerPage,false,true,strUnit)
					Case "1"
						strReturn = ShowMessages(rst)
						strReturn="<h1>留言板首页(<a href='"&blogdir&mUserPath&"/message."&f_ext&"#cmt'>签写留言</a>)</h1>" & vbCrLf & strReturn & oblog.showpage(mFileName,Total,MaxPerPage,false,true,strUnit)
					Case "2"
						strReturn = strReturn&getPhotolist(rst)
						strReturn=strReturn & oblog.showpage(mFileName,Total,MaxPerPage,false,true,strUnit)
			End Select	
	   	Else
	   		If (CurrentPage-1) * MaxPerPage < Total Then
	        	rst.move  (CurrentPage-1) * MaxPerPage
	         	'Dim bookmark
	           	'bookmark=rst.bookmark
	            Select Case strMode
					Case "0"
						strReturn = ShowOnePage(rst)
						strReturn=strReturn & oblog.showpage(mFileName,Total,MaxPerPage,false,true,strUnit)
					Case "1"
						strReturn = ShowMessages(rst)
						strReturn="<h1>留言板首页(<a href='"&blogdir&mUserPath&"/message."&f_ext&"#cmt'>签写留言</a>)</h1>" & vbCrLf & strReturn & oblog.showpage(mFileName,Total,MaxPerPage,false,true,strUnit)
					Case "2"
						strReturn = strReturn&getPhotolist(rst)
						strReturn=strReturn & oblog.showpage(mFileName,Total,MaxPerPage,false,true,strUnit) 
				End Select	
	        Else
		        CurrentPage=1
	           	Select Case strMode
					Case "0"
						strReturn = ShowOnePage(rst)
						strReturn=strReturn & oblog.showpage(mFileName,Total,MaxPerPage,false,true,strUnit)
					Case "1"
						strReturn = ShowMessages(rst)
						strReturn="<h1>留言板首页(<a href='"&blogdir&mUserPath&"/message."&f_ext&"#cmt'>签写留言</a>)</h1>" & vbCrLf & strReturn & oblog.showpage(mFileName,Total,MaxPerPage,false,true,strUnit)
					Case "2"
						strReturn = strReturn&getPhotolist(rst)
						strReturn=strReturn & oblog.showpage(mFileName,Total,MaxPerPage,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
		Do While Not rst.EOF
	    	If rst("face") = "0" Then 
	        	strEmot = "" 
	        Else 
	            strEmot = "<img src="&blogdir&"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=""" & blogdir & mUserPath & "/cmd."&f_ext&"?uid="&mUserid&"&do=blogs&id=" & rst("subjectid") & """>[" & oblog.filt_html(getsubname(substr,rst("subjectid"))) & "]</a>"
	        End If
	        strTopictxt = "<a href=""" & blogdir&rst("logfile") & """>" & oblog.filt_html(rst("topic")) & "</a>"
	        If rst("isbest") = 1 Then strTopictxt = strTopictxt & "　<img src=" & blogdir & "images/jhinfo.gif >"
	        strTopic = strTopic & strTopictxt
	        If rst("istop") = 1 Then strTopictxt = "[置顶]" & strTopictxt
	        strLoginfo = strAuthor & " 发表于 " & strAddtime
	        strMore = "<a href=""" & blogdir&rst("logfile") & """>阅读全文("&rst("iis")&")</a>"
	        strMore = strMore & " | <a href=""" & blogdir & rst("logfile") & "#cmt"">回复("&rst("commentnum")&")</a>"
	        strMore = strMore & " | <a href=""" & blogdir & "showtb.asp?id=" & rst("logid") & """ target=""_blank"">引用通告("&rst("trackbacknum")&")</a>"
	        '取得文章摘要内容
	        If IsNull(rst("Abstract")) Or Trim(rst("Abstract")) = "" Then
	        	'兼容以前数据
	            If rst("ishide") = 1 Then strTmp = "此日志为隐藏日志，仅好友可见，<a href='" & blogdir & "more.asp?id=" & rst("logid") & "'>点击进入验证页面</a>。"
	            If rst("ispassword") <> "" Then strTmp = "<form method='post' action='" & blogdir & "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.setup(29, 0) = 1 Then strLogtext = profilthtm(strLogtext)
	            End If
	         Else
	         	strLogtext = rst("Abstract")
	         End If
			 '当使用相对路径时，替换为绝对路径
			 '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
	         strContent = strContent & VBCRLF & strBody	         
	         rst.movenext
	         i=i+1
			 if i>=MaxPerPage then exit do
	      Loop
		  set rssubject=nothing
	      ShowOnePage=strContent
	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.FilterUbbFlash(filtscript(rst("message")))
                strmore = homepage_str & " | <a href='"&blogdir&"user_messages.asp?action=modify&re=true&id=" & rst("messageid") & "'>回复</a>"
                strmore = strmore & " | <a href=""" & blogdir & "user_messages.asp?action=del&id=" & rst("messageid") & """  target=""_blank"">删除</a>"
                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>=MaxPerPage Then Exit Do
            Loop
        Else
            strContent = "暂无留言"
        End If
        ShowMessages=strContent  
  
    End Function
	
	'获取用户信息
	Private Function GetUserInfo()
		Dim rst,rst1
		Set rst=oBlog.Execute("Select user_folder,user_dir,BlogName,username," &_
			"nickname,user_skin_showlog,user_showlog_num,blog_password,user_photorow_num From oBlog_User Where UserId=" & mUserId)
		If rst.Eof Then
			Set rst = Nothing
			Response.Write "错误的用户编号"
			Response.End
		Else
			'判断是否整站加密
			if (rst("blog_password")<>"" or isnull(rst("blog_password"))=false) and Request.Cookies(cookies_name)("blogpw")<>rst("blog_password") then
				set rst=nothing
				response.Write "window.location='"&blogdir&"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")
			MaxPerPage=rst("user_showlog_num")
			mUserPhotoRow=rst("user_photorow_num")
			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
			'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=" & blogdir & "more.asp?id=" & rsPhoto(1) &" target=_blank >阅读相片介绍</a><BR/><BR/>"
				imgsrc=blogdir & 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=blogdir&rsPhoto(0)
				End if
				sReturn=sReturn&"<td align='center'> <a href='"& blogdir & 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>=MaxPerPage then exit do	
	loop		
	sReturn=sReturn&"</tbody></table>"	& VBCRLF
	Set fso=nothing
	getPhotolist=sReturn
End Function
	
'获取用户分类
Function GetUserClasses(typestr)
	Dim rst,sReturn,strPlayerUrl
	strPlayerUrl= blogdir & "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='"&blogdir&muserpath&"/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='"&blogdir&mUserpath&"/cmd."&f_ext&"?uid="&mUserid&"&do=photos'>日志方式浏览</a>"
	else
		sReturn=sReturn&"  <a href='"&blogdir&mUserpath&"/cmd."&f_ext&"?uid="&mUserid&"&do=album'>相册方式浏览</a>"
	end if 
	GetUserClasses = sReturn	
End Function
	
End Class	
%>