showuser.asp

来自「1.支持文章」· ASP 代码 · 共 286 行

ASP
286 行
字号 
<%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%option explicit%>
<!--#include file="Conn.asp"-->
<!--#include file="SysCls/KS_CommonCls.asp"-->
<!--#include file="SysCls/KS_RefreshCls.asp"-->
<%
'===================================================================================================================
'软件名称：科汛网站管理系统
'当前版本：科汛网站管理系统 V2.2 0628 Free
'Copyright (C) 2005-2006 Kesion.Com  All rights reserved.
'产品咨询QQ：9537636,41904294
'技术支持QQ：111394,54004407 
'程序版权：科汛网络
'程序开发：科汛网络开发组（总策划：林文仲）
'E-Mail  :kesioncms@hotmail.com webmaster@kesion.com
'官方网站：http://www.kesion.com  
'演示站点：http://test.kesion.com 
'郑重声明:
'    ①、免费版本请在程序首页保留版权信息，并做上本站LOGO友情连接,商业版本无此要求;
'    ②、任何个人或组织不得在授权允许的情况下删除、修改、拷贝本软件及其他副本上一切关于版权的信息；
'    ③、科汛网络保留此软件的法律追究权利
'===================================================================================================================
Dim KSCls
Set KSCls = New ShowUser
KSCls.Execute()
Set KSCls = Nothing

Class ShowUser
        Private KSCMS
		Private Sub Class_Initialize()
		  Set KSCMS=New CommonCls
		End Sub
        Private Sub Class_Terminate()
		 Set KSCMS=Nothing
		End Sub
		Public Sub Execute()
		 Dim UserID:UserID=KSCMS.CHKClng(KSCMS.G("UserID"))
		 If UserID="" Then Exit Sub
		 Dim RSObj:Set RSObj=Server.CreateObject("ADODB.RecordSet")
		 RSObj.Open "Select * From KS_User Where UserID=" & UserID,Conn,1,1
		 If RSObj.Eof And RSObj.Bof Then
		  Call KSCMS.Alert("参数不正确!","")
		  RsObj.Close:Set RSObj=Nothing
		  Conn.Close:Set Conn=Nothing
		  Exit Sub
		 End If
		 Dim FileContent
		 Application(Cstr(KSCMS.SiteSN & "RefreshType")) = "ShowUser"   '设置当前位置为会员列表
	 	Dim KMRFObj:Set KMRFObj = New Refresh
		   '读出公告内容页对应的模板
		    FileContent = KMRFObj.LoadTemplate(9991)
		   If Trim(FileContent) = "" Then FileContent = "模板不存在!"
			FileContent = KMRFObj.ReplaceGeneralLabelContent(FileContent) '替换通用标签
			FileContent = KMRFObj.ReplaceLableFlag(KMRFObj.ReplaceAllLabel(FileContent))
			FileContent = ReplaceUserInfoContent(FileContent,RSObj)
			FileContent = Replace(FileContent,"{$GetUserItem}",GetUserItem(RSObj))
		   Set KMRFObj = Nothing
		   
		   Response.Write FileContent 
		   RSObj.Close:Set RSOBj=nothing
		   Conn.Close:Set Conn=Nothing  
	End Sub
  
  Function ReplaceUserInfoContent(ByVal Content,ByVal RS)
       
        Dim Privacy:Privacy=RS("Privacy")
        Content=Replace(Content,"{$GetUserName}",RS("UserName"))
		If Trim(rs("userface"))="" or isnull(rs("userface")) Then
		  Content=Replace(Content,"{$GetUserFace}","<img src=""" & KSCMS.GetDomain & "Skin/default/nopic.gif"" width=""" & rs("facewidth")*2 & """ height=""" & rs("faceheight")*2 & """>")
		Else
		 Content=Replace(Content,"{$GetUserFace}","<img src=""" & rs("userface") & """ width=""" & rs("facewidth")*2 & """ height=""" & rs("faceheight")*2 &""">")
		End If

		'联系方式
    	If Privacy=2 Then
		 Content=Replace(Content,"{$GetEmail}","保密")
		Else
		 Dim Email:Email=RS("Email")
		 If IsNull(Email) Or Email="" Then Email="暂无"
		 Content=Replace(Content,"{$GetEmail}",Email)
		End If
    	If Privacy=2 Then
		 Content=Replace(Content,"{$GetQQ}","保密")
		Else
		 Dim QQ:QQ=RS("QQ")
		 If IsNull(QQ) Or QQ="" Then QQ="暂无"
		 Content=Replace(Content,"{$GetQQ}",QQ)
		End If
    	If Privacy=2 Then
		 Content=Replace(Content,"{$GetUC}","保密")
		Else
		 Dim UC:UC=RS("UC")
		 If IsNull(UC) Or UC="" Then UC="暂无"
		 Content=Replace(Content,"{$GetUC}",UC)
		End If
		If Privacy=2 Then
		 Content=Replace(Content,"{$GetMSN}","保密")
		Else
		 Dim MSN:MSN=RS("MSN")
		 If IsNull(MSN) Or MSN="" Then MSN="暂无"
		 Content=Replace(Content,"{$GetMSN}",MSN)
		End If
    	If Privacy=2 Then
		 Content=Replace(Content,"{$GetHomePage}","保密")
		Else
		 Dim HomePage:HomePage=RS("MSN")
		 If Not IsNull(HomePage) Then
		 Content=Replace(Content,"{$GetHomePage}","<a href=""" & RS("HomePage") & """ target=""_blank"">" & RS("HomePage") & "</a>")
		 Else
		   Content=Replace(Content,"{$GetHomePage}","")
		 End iF
		End If


		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetRealName}","保密")
		Else
		 Dim RealName:RealName=RS("RealName")
		 If IsNull(RealName) Or RealName="" Then RealName="暂无"
		 Content=Replace(Content,"{$GetRealName}",RealName)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetSex}","保密")
		Else
		 Dim Sex:Sex=RS("Sex")
		 If IsNull(Sex) Or Sex="" Then Sex="暂无"
		 Content=Replace(Content,"{$GetSex}",Sex)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetBirthday}","保密")
		Else
		  Dim BirthDay:BirthDay=RS("BirthDay")
		 If IsNull(BirthDay) Or BirthDay="" Then BirthDay="暂无"
		 Content=Replace(Content,"{$GetBirthday}",BirthDay)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetIDCard}","保密")
		Else
		 Dim IDCard:IDCard=RS("IDCard")
		 If IsNull(IDCard) Or IDCard="" Then IDCard="暂无"
		 Content=Replace(Content,"{$GetIDCard}",IDCard)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetOfficeTel}","保密")
		Else
		 Dim OfficeTel:OfficeTel=RS("OfficeTel")
		 If IsNull(OfficeTel) Or OfficeTel="" Then OfficeTel="暂无"
		 Content=Replace(Content,"{$GetOfficeTel}",OfficeTel)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetHomeTel}","保密")
		Else
		 Dim HomeTel:HomeTel=RS("HomeTel")
		 If IsNull(HomeTel) Or HomeTel="" Then HomeTel="暂无"
		 Content=Replace(Content,"{$GetHomeTel}",HomeTel)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetMobile}","保密")
		Else
		 Dim Mobile:Mobile=RS("Mobile")
		 If IsNull(Mobile) Or Mobile="" Then Mobile="暂无"
		 Content=Replace(Content,"{$GetMobile}",Mobile)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetFax}","保密")
		Else
		 Dim Fax:Fax=RS("Fax")
		 If IsNull(Fax) Or Fax="" Then Fax="暂无"
		 Content=Replace(Content,"{$GetFax}",Fax)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetUserArea}","保密")
		Else
		 Dim Province:Province=RS("Province")
		 If IsNull(Province) Or Province="" Then Province=""
		 Dim City:City=RS("City")
		 If IsNull(City) Or Fax="" Then City="未知"
		 Content=Replace(Content,"{$GetUserArea}",Province & City)
		End If

		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetAddress}","保密")
		Else
		 Dim AddRess:AddRess=RS("AddRess")
		 If IsNull(AddRess) Or AddRess="" Then AddRess="暂无"
		 Content=Replace(Content,"{$GetAddress}",AddRess)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetZip}","保密")
		Else
		 Dim Zip:Zip=RS("Zip")
		 If IsNull(Zip) Or Zip="" Then Zip="暂无"
		 Content=Replace(Content,"{$GetZip}",ZIP)
		End If
		If Privacy=2 or Privacy=1 Then
		 Content=Replace(Content,"{$GetSign}","保密")
		Else
		 Dim Sign:Sign=RS("Sign")
		 If IsNull(Sign) Or Sign="" Then Sign="暂无"
		 Content=Replace(Content,"{$GetSign}",Sign)
		End If
        ReplaceUserInfoContent=Content
  End Function
  Function GetUserItem(RS)
          GetUserItem =" <table class=table_border height=""100%"" cellSpacing=0 cellPadding=0 width=""100%"" align=center border=0>" & vbcrlf
         GetUserItem  = GetUserItem & "       <tr>" & vbcrlf
         GetUserItem  =GetUserItem & "         <td class=link_table_title height=25><a href=""?UserID=" & RS("UserID") & "&ChannelID=1"">查看文章集</a> | <a href=""?UserID=" & RS("UserID") & "&ChannelID=2"">查看图片集</a> | <a href=""?UserID=" & RS("UserID") & "&ChannelID=3"">查看软件集</a> | <a href=""?UserID=" & RS("UserID") & "&ChannelID=4"">查看动漫集</a></td>" & vbcrlf
        GetUserItem  =GetUserItem & "        </tr>" & vbcrlf
        GetUserItem  =GetUserItem & "        <tr>" & vbcrlf
        GetUserItem  =GetUserItem & "          <td valign=""top"">" & vbcrlf
		GetUserItem  =GetUserItem & "           <table border=""0"" align=""center"" width=""99%"">" & vbcrlf
		GetUserItem  =GetUserItem & "            <tr><td style=""Border-top:#efefef 1px dotted;Border-Left:#efefef 1px dotted;BORDER-RIGHT: #efefef 1px dotted; BORDER-BOTTOM: #efefef 1px dotted; text-align:center;color:blue"">作品名称</td><td align=""center"" width=""80"" style=""Border-top:#efefef 1px dotted;Border-Left:#efefef 1px dotted;BORDER-RIGHT: #efefef 1px dotted; BORDER-BOTTOM: #efefef 1px dotted; text-align:center;color:blue"">作者</td><td align=""center"" width=""90"" style=""Border-top:#efefef 1px dotted;Border-Left:#efefef 1px dotted;BORDER-RIGHT: #efefef 1px dotted; BORDER-BOTTOM: #efefef 1px dotted; text-align:center;color:blue"">被签收时间</td></tr>" & vbcrlf
		 Dim ChannelID:ChannelID=KSCMS.ChkClng(KSCMS.G("ChannelID")):If ChannelID=0 Then ChannelID=1
		 Dim SqlStr,RSObj,CurrentPage,totalPut,MaxPerPage
		 MaxPerPage =20
		If KSCMS.G("page") <> "" Then
					CurrentPage = KSCMS.ChkClng(KSCMS.G("page"))
		 Else
					CurrentPage = 1
		 End If
		 Select Case ChannelID
		  Case 1 
		   SqlStr="Select ID,Tid,Title,ArticleInput,AddDate,Fname,ReadPoint,InfoPurview From KS_Article Where ArticleInput='" & RS("UserName") & "'"
		  Case 2
		   SqlStr="Select ID,Tid,Title,PictureInput,AddDate,Fname,ReadPoint,InfoPurview From KS_Photo Where PictureInput='" & RS("UserName") & "'"
		  Case 3
		   SqlStr="Select ID,Tid,Title,DownInput,AddDate,Fname,ReadPoint,InfoPurview From KS_DownLoad Where DownInput='" & RS("UserName") & "'"
		  Case 4
		  SqlStr="Select ID,Tid,Title,FlashInput,AddDate,Fname,ReadPoint,InfoPurview From KS_Flash Where FlashInput='" & RS("UserName") & "'"
		End Select
		 Set RSObj=Server.CreateObject("ADODB.RECORDSET")
		 RSObj.Open SqlStr,Conn,1,1
		                 If RSObj.EOF and RSObj.Bof  Then
						  GetUserItem  =GetUserItem & "<tr><td style=""BORDER-left: #efefef 1px dotted;BORDER-RIGHT: #efefef 1px dotted; BORDER-BOTTOM: #efefef 1px dotted;text-align:center"" colspan=3>没有找到该会员的相关作品集！</td></tr>"
						 Else
							totalPut = RSObj.RecordCount
                           If CurrentPage < 1 Then
								CurrentPage = 1
							End If
			
								If (CurrentPage - 1) * MaxPerPage > totalPut Then
									If (totalPut Mod MaxPerPage) = 0 Then
										CurrentPage = totalPut \ MaxPerPage
									Else
										CurrentPage = totalPut \ MaxPerPage + 1
									End If
								End If
			
								If CurrentPage = 1 Then
									GetUserItem  =GetUserItem & showContent(RSObj,totalPut, MaxPerPage, CurrentPage,ChannelID,RS("UserID"))
								Else
									If (CurrentPage - 1) * MaxPerPage < totalPut Then
										RSObj.Move (CurrentPage - 1) * MaxPerPage
										GetUserItem  =GetUserItem &showContent(RSObj,totalPut, MaxPerPage, CurrentPage,ChannelID,RS("UserID"))
									Else
										CurrentPage = 1
										GetUserItem  =GetUserItem &showContent(RSObj,totalPut, MaxPerPage, CurrentPage,ChannelID,RS("UserID"))
									End If
								End If
				           End If
		 
		GetUserItem  =GetUserItem & "            </table>" & vbcrlf
		GetUserItem  =GetUserItem & "          </td>" & vbcrlf
        GetUserItem  =GetUserItem & "        </tr>" & vbcrlf
        GetUserItem  =GetUserItem & "      </table>" & vbcrlf
       End Function
		Function ShowContent(RS,totalPut, MaxPerPage, CurrentPage,ChannelID,UserID)
		    Dim I
			  Do While Not RS.Eof 
              ShowContent = ShowContent & "<tr height=""20""> " &vbNewLine
              ShowContent = ShowContent & "  <td style=""BORDER-RIGHT: #efefef 1px dotted; BORDER-LEFT: #efefef 1px dotted; BORDER-BOTTOM: #efefef 1px dotted"">·<a href=""" & KSCMS.GetInfoUrl(ChannelID,RS) & """ target=""_blank"">" & RS(2) & "</a></td>" & vbnewline
              ShowContent = ShowContent & "  <td style=""BORDER-RIGHT: #efefef 1px dotted; BORDER-BOTTOM: #efefef 1px dotted; text-align:center"">"& RS(3) & "</td>" & vbnewline
            ShowContent = ShowContent & "    <td style=""BORDER-RIGHT: #efefef 1px dotted; BORDER-BOTTOM: #efefef 1px dotted;text-align:center"">" & vbcrlf
			ShowContent = ShowContent &  RS(4) & "</td>" & vbcrlf
           ShowContent = ShowContent & "   </tr> " & vbcrlf
             RS.MoveNext
			    I = I + 1
				If I >= MaxPerPage Then Exit Do
			 Loop
			 
			 ShowContent = ShowContent & "<tr><td colspan=3 align=""right"">" & vbcrlf
			 ShowContent = ShowContent & KSCMS.ShowPagePara(totalPut, MaxPerPage, "", True, "条", CurrentPage, "UserID=" & UserID & "&ChannelID=" & ChannelID)
			 ShowContent = ShowContent & "</td></tr>" & vbcrlf
			End Function	
End Class
%>

showuser.asp - 源码说明

本页面展示了「1.支持文章」中的 showuser.asp 源码文件，采用 ASP 编程语言编写，共 286 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

⌨️ 快捷键说明

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