<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%> <%option explicit%> <% '**************************************************** '**************************************************** ' Copyright (C) Phels.Inc All Rights Reserved. ' Email: web@phels.com . QQ:109095604 Tel:0512-86886356 ' Web: http://www.phels.com '**************************************************** '**************************************************** Dim KSCls Set KSCls = New User_Favorite KSCls.Kesion() Set KSCls = Nothing Class User_Favorite Private KS,KSUser,action Private currpage,totalPut Private RS,MaxPerPage Private ChannelID,i,Param Private TempStr,SqlStr Private InfoIDArr,InfoID Private Sub Class_Initialize() MaxPerPage =10 Set KS=New PublicCls Set KSUser = New UserCls End Sub Private Sub Class_Terminate() Set KS=Nothing Set KSUser=Nothing End Sub %> <% Public Sub loadMain() Call KSUser.Head() Call KSUser.InnerLocation("我的收藏夹") KSUser.CheckPowerAndDie("s16") action=KS.S("action") If KS.S("page") <> "" Then currpage = CInt(KS.S("page")) Else currpage = 1 End If Param=" Where UserName='"& KSUser.UserName &"'" %>
<% Select Case action Case "Add" Dim RSAdd InfoID=KS.ChkClng(KS.S("InfoID")) ChannelID=KS.ChkClng(KS.S("ChannelID")) If InfoID=0 Or Channelid=0 Then Response.Write "" Response.End() End If Set RSAdd=Server.CreateObject("Adodb.Recordset") RSADD.Open "Select top 1 * From KS_Favorite Where ChannelID=" & ChannelID & " And InfoID=" & InfoID & " And UserName='" & KSUser.UserName & "'",Conn,1,3 IF RSADD.Eof And RSADD.Bof Then RSADD.AddNew RSAdd(1)=KSUser.UserName RSAdd(2)=ChannelID RSAdd(3)=InfoID RSAdd(4)=Now RSAdd.Update End IF RSADD.Close:SET RSADD=Nothing myFav Case "Cancel" call CanCel() case "bbscancel" Call FavCancel() : KS.Die "" case "applyMedal" applyMedal case "medal" Medal case "bbs","cy" bbsinfo case "fav" Fav case else myFav End Select End Sub Sub CanCel() InfoID=KS.S("InfoID") InfoID=Replace(InfoID," ","") InfoID=KS.FilterIDs(InfoID) If InfoID="" Then Response.Write "" Response.End End If Conn.Execute("Delete From KS_Favorite Where ID In(" & InfoID & ") And UserName='" & KSUser.UserName & "'") KS.Die "" End Sub Sub MyFav() If ChannelID="" or not isnumeric(ChannelID) Then ChannelID=0 IF ChannelID<>0 Then Param= Param & " and ChannelID=" & ChannelID %> <% Set RS=Server.CreateObject("AdodB.Recordset") SqlStr="Select ID,ChannelID,InfoID,AddDate From KS_Favorite "& Param &" and Channelid<>6 order by id desc" RS.open SqlStr,conn,1,1 If RS.EOF And RS.BOF Then Response.Write "" Else totalPut = RS.RecordCount If currpage < 1 Then currpage = 1 If currpage >1 and (currpage - 1) * MaxPerPage < totalPut Then RS.Move (currpage - 1) * MaxPerPage End If Dim I,SQL,K Response.Write "" SQL=RS.GetRows(MaxPerPage) For K=0 To Ubound(SQL,2) %> <% Next %> <% End If %>
您的收藏夹没有内容!
<% Select Case KS.C_S(SQL(1,K),6) Case 1 SqlStr="Select top 1 ID,Title,Tid,ReadPoint,InfoPurview,Fname,Changes,AddDate,hits From " & KS.C_S(SQL(1,K),2) &" Where ID=" & SQL(2,K) Case 2 SqlStr="Select top 1 ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,AddDate,hits From " & KS.C_S(SQL(1,K),2) &" Where ID=" & SQL(2,K) Case 3 SqlStr="Select top 1 ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,AddDate,hits From " & KS.C_S(SQL(1,K),2) &" Where ID=" & SQL(2,K) Case 4 SqlStr="Select top 1 ID,Title,Tid,ReadPoint,InfoPurview,Fname,0,AddDate,hits From " & KS.C_S(SQL(1,K),2) &" Where ID=" & SQL(2,K) Case 5 SqlStr="Select top 1 ID,Title,Tid,0,0,Fname,0,AddDate,hits From KS_Product Where ID=" & SQL(2,K) Case 7 SqlStr="Select top 1 ID,Title,Tid,0,0,Fname,0,AddDate,hits From KS_Movie Where ID=" & SQL(2,K) Case 8 SqlStr="Select top 1 ID,Title,Tid,0,0,Fname,0,AddDate,hits From KS_GQ Where ID=" & SQL(2,K) Case 9 SqlStr="Select top 1 ID,Title,0,0,0,0,0,date,hits From KS_SJ Where ID=" & SQL(2,K) Case else SqlStr="Select top 1 ID From KS_Article Where 1=0" End Select Dim Url,RSF:Set RSF=Conn.Execute(SqlStr) If Not RSF.Eof Then If SQL(1,K)=9 then url="../html/sj/" & RSF(0) & ".htm" else url=KS.GetItemUrl(SQL(1,K),RSF(2),RSF(0),RSF(5)) end if Response.Write "
" & RSF(1) & "
" Response.Write "
" Response.Write "类型:" & KS.C_S(SQL(1,K),3) & " 收藏时间:" & KS.GetTimeFormat(SQL(3,K)) & " 信息最后更新:" & KS.GetTimeFormat(RSF(7)) & " 人气:" & RSF(8) End If %>
取消收藏
 选中本页显示的所有收藏
<%Call KS.ShowPage(totalput, MaxPerPage, "", currpage,false,true)%>
<% End Sub sub bbsinfo() Call KSUser.InnerLocation("我发表的主题") %>
"/> 主题搜索: 关键字 "" then response.write ks.s("keyword") else response.write "关键字"%>" size=20> 
<% dim sql dim param:param=" where username='" & ksuser.username &"'" if not ks.isnul(ks.s("keyword")) then param=param & " and subject like '%" & ks.s("keyword") & "%'" '取帖子存放数据表 if request("action")="cy" then Dim Nodes,Doc,TableName set Doc = KS.InitialObject("msxml2.FreeThreadedDOMDocument"& MsxmlVersion) Doc.async = false Doc.setProperty "ServerHTTPRequest", true Doc.load(Server.MapPath(KS.Setting(3)&"Config/clubtable.xml")) Set Nodes=Doc.DocumentElement.SelectSingleNode("item[@isdefault='1']") TableName=nodes.selectsinglenode("tablename").text Set Doc=Nothing sql="select * from KS_Guestbook where id in(select top 200 topicid from " & TableName & param &") order by LastReplayTime desc" else sql="select * from KS_Guestbook " & param & " order by id desc" end if set rs=server.createobject("adodb.recordset") rs.open sql,Conn,1,1 if rs.eof and rs.bof then %> <%else totalPut = RS.RecordCount If CurrPage > 1 and (CurrPage - 1) * MaxPerPage < totalPut Then RS.Move (CurrPage - 1) * MaxPerPage End If i=0 do while not rs.eof if i mod 2=0 then %> <% else %> <% end if Dim PhotoUrl:PhotoUrl=RS("face") If KS.IsNul(PhotoUrl) Then PhotoUrl=KSUser.GetUserInfo("UserFace") %> <% rs.movenext I = I + 1 If I >= MaxPerPage Then Exit Do loop end if rs.close set rs=Nothing %>
主题 版块 回复 最后发表
您没有发表过任何主题!
 发表时间:[<%=KS.GetTimeFormat1(rs("addtime"),false)%>] 状态:[<%if rs("verific")="1" then response.write "已审核" else response.write "未审核"%>]
<% Dim Node KS.LoadClubBoard Set Node=Application(KS.SiteSN&"_ClubBoard").DocumentElement.SelectSingleNode("row[@id=" & rs("boardid") &"]") if not node is nothing then KS.Echo "" & Node.SelectSingleNode("@boardname").text & "" else KS.Echo "---" end if Set Node=Nothing %> <%=RS("TotalReplay")%> <%=RS("LastReplayUser")%>
<%=KS.GetTimeFormat1(RS("LastReplayTime"),True)%>
<% Call KS.ShowPage(totalput, MaxPerPage, "", CurrPage,false,true) %> <% if request("action")="cy" then ks.echo "
说明:我参与的主题最多列出当前数据表的200条记录。
" end if end sub Sub Fav() %> <% set rs=server.createobject("adodb.recordset") dim sql:sql="select a.*,f.favorid from KS_Guestbook a inner join KS_AskFavorite f on a.id=f.topicid where f.Username='"&KSUser.UserName&"' order by LastReplayTime desc" rs.open sql,Conn,1,1 if rs.eof and rs.bof then %> <%else totalPut = RS.RecordCount If CurrPage > 1 and (CurrPage - 1) * MaxPerPage < totalPut Then RS.Move (CurrPage - 1) * MaxPerPage i=0 do while not rs.eof if i mod 2=0 then %> <% else %> <% end if %> <% rs.movenext I = I + 1 If I >= MaxPerPage Then Exit Do loop end if rs.close set rs=Nothing %>
主题 版块 回复 最后发表
您没有收藏问题!
 发表时间:[<%=KS.GetTimeFormat1(rs("addtime"),false)%>] 状态:[<%if rs("verific")="1" then response.write "已审核" else response.write "未审核"%>]
<% Dim Node KS.LoadClubBoard Set Node=Application(KS.SiteSN&"_ClubBoard").DocumentElement.SelectSingleNode("row[@id=" & rs("boardid") &"]") if not node is nothing then KS.Echo "" & Node.SelectSingleNode("@boardname").text & "" else KS.Echo "---" end if Set Node=Nothing %> <%=RS("TotalReplay")%> <%=RS("LastReplayUser")%>
<%=KS.GetTimeFormat1(RS("LastReplayTime"),True)%>
<% End Sub Sub FavCancel() Dim FavorID:Favorid=KS.FilterIDS(KS.S("favorid")) if FavorID="" Then KS.AlertHintScript "对不起,您没有选择记录!" Conn.Execute("Delete From KS_AskFavorite Where Favorid in(" & Favorid & ") and username='" & KSUser.UserName & "'") KS.AlertHintScript "恭喜,取消帖子收藏成功!" End Sub Sub applyMedal() dim i,mstr,medalArr,MedalID,Expression medalID=KS.ChkClng(KS.G("MedalID")) If MedalID=0 Then KS.AlertHintScript "出错啦!" Dim RS:Set RS=Server.CreateObject("ADODB.RECORDSET") RS.Open "Select top 1 * From KS_GuestMedal Where MedalID=" & MedalID,conn,1,1 If RS.Eof And RS.Bof Then RS.Close : Set RS=Nothing KS.AlertHIntScript "对不起,传递参数有误!" End If Dim LQFs,GradeID,medalname Lqfs=rs("Lqfs") GradeID=rs("GradeID") medalname=rs("medalname") Expression=split(rs("Expression")&",0,0,0,0,0,0,0,0,0,",",") mstr=rs("medalid") &"|" & rs("medalname") & "|" & rs("ico") RS.Close :Set RS=Nothing If Lqfs="1" Then If Not KS.IsNul(GradeID) Then If KS.FoundInArr(gradeid,KSUser.GetUserInfo("gradeid"),",")=false Then KS.AlertHintScript "对不起,您所以的论坛级别不够,申请失败!" end if End If If KS.ChkClng(Expression(0))>0 And KS.ChkClng(KSUser.GetUserInfo("PostNum"))0 And KS.ChkClng(KSUser.GetUserInfo("BestTopicNum"))0 And KS.ChkClng(conn.execute("select count(1) from ks_guestbook where username='" & ksuser.username &"'")(0))0 And KS.ChkClng(KSUser.GetUserInfo("score"))0 And KS.ChkClng(KSUser.GetUserInfo("Prestige"))0 And KS.ChkClng(KSUser.GetUserInfo("money"))0 And KS.ChkClng(KSUser.GetUserInfo("score"))0 Then If KS.ChkClng(KSUser.GetUserInfo("score"))medalid then if newMedalStr="" then newMedalStr=medalArr(i) else newmedalStr=newmedalStr & "@@@" & medalArr(i) end if end if next End If if newmedalStr="" then newmedalStr=mstr else newmedalStr=newmedalStr & "@@@" & mstr end if If IsObject(Session(KS.SiteSN&"UserInfo")) Then Session(KS.SiteSN&"UserInfo").DocumentElement.SelectSingleNode("row").SelectSingleNode("@medal").Text=newmedalStr Conn.Execute("Update KS_User Set Medal='" & newmedalStr & "' where username='" & KSUser.UserName &"'") If Lqfs="1" Then KS.AlertHintScript "恭喜,勋章申请成功!!!" Else KS.AlertHintScript "恭喜,勋章购买成功!!!" End If End Sub Sub Medal() Call KSUser.InnerLocation("勋章中心") Dim i,medalArr,MyMedal,MedalIds MyMedal=KSUser.GetUserInfo("medal") %>
 我 的 勋 章 <%if KS.IsNul(myMedal) Then response.write "您拥有有 0 枚勋章!" else medalArr=split(mymedal,"@@@") response.write "您拥有有 " & ubound(medalArr)+1 & " 枚勋章!" end if %>
    <%if isArray(medalArr) Then for i=0 to ubound(medalArr) MedalIds=MedalIds & split(medalArr(i),"|")(0) & "," response.write "

  • " & split(medalArr(i),"|")(1) & "
  • " next else response.write "
  • 您没有勋章!
  • " end if %>
 全 部 勋 章 以下列出本站的全部勋章,带申请的勋章您可以申请拥有。
    <% dim rs:set rs=conn.execute("select medalid,medalname,ico,descript,LQFS,Expression From KS_GuestMedal Where status=1 order by medalid") Do While Not RS.Eof response.write "

  • " & rs("medalname") & "" if KS.FoundInArr(MedalIds,rs("medalid"),",") Then response.write "
    " Else if rs("lqfs")="1" then response.write "
    " elseif rs("lqfs")="2" then response.write "
    " else response.write "
    " end if End If response.write "
  • " rs.movenext Loop RS.Close Set RS=Nothing %>
<% End Sub End Class %>