<% Set CmsDjMessage = New CmsDj_Com_Message Set CmsDjUser = New CmsDj_Com_User Set CmsDjPic = New CmsDj_Com_Pic Set CmsDjArt = New CmsDj_Com_Art Set CmsDjPublic = New CmsDj_Com_Public Set CmsDjShare = New CmsDj_Com_Share Set CmsDjFeed = New CmsDj_Com_Feed Set CmsDjMusic = New CmsDj_Com_Dj Set CmsDjClass = New CmsDj_Com_DjClass Set CmsDjPay = New CmsDj_Com_Pay Set CmsDjWeb = New CmsDj_Com_Web Set CmsDjWebMold = New CmsDj_Com_WebMold Set CmsDjShop = New CmsDj_Com_Shop Set CmsDjAdData = New CmsDj_Com_AdData Set CmsDjSupply = New CmsDj_Com_Supply Sub Index_Menu%>
  • 动态
  • 消息发送
  • 音乐上传
  • 相册上传
  • 日志发表
  • 好友找人
  • 分享
  • 空间
  • 充值升级VIP
  • 供求发布
  • <%if CD_AdData="yes" then%>
  • 宣传
  • <%end if%>
  • 随便看看
  • <% End Sub Sub Index_Top%>

    会员中心

    <%if UserLogined<>True then%> <%else%> <%end if%>
    <% End Sub Sub Index_Bottom%> <% End Sub '================================================= '过程名:Call Index_Feed '作 用:动态 '作 者: 花心萝卜 http://www.7xiwl.com '================================================= Sub Index_Feed Response.write "

    动态

    " Response.write "
    " Response.write "" Response.write "
    " Response.write "
    "& VbCrLf Response.write "
    "& VbCrLf Response.write "
    "& VbCrLf Response.write "
    "& VbCrLf Response.write ""& VbCrLf rs.movenext loop Else Response.write "暂无动态! ^_^" End If rs.Close Set rs=nothing Response.write ""& VbCrLf Response.write "
    "& VbCrLf Response.write "
    "&List_Page(m,z,page,"space.asp?do=feed&view="&view,5,3)&"
    " Response.write "" End Sub '================================================= '过程名:Call Index_Share '作 用:分享 '作 者: 花心萝卜 http://www.7xiwl.com '================================================= Sub Index_Share %>

    分享

    <%if view="share" then%>
    ">« 返回上一页
    <%end if%>
    <%if view<>"share" then%>
    按分享类型查看: >全部| >网址| >音乐| >Flash| >视频|
    <% end if if view="share" then Set Rs = CmsDjShare.GetRs("",0,"ShareID="&ID) If rs.EOF And rs.BOF Then Response.write"" Response.End End If Conn.DB "update CmsDj_Share set ShareH=ShareH+1 where ShareID="&id,"exe" %>

    " target="web"><%=rs("UserName")%> (<%=GetUserName(rs("UserID"),1)%>) 分享了一个<%=rs("ShareB")%>

    <%=CmsDj_Com_Time(rs("ShareTime"))%>
    " target="_blank"><%=rs("ShareD")%>
    "> <%if rs("ShareA")="2" then%> <%elseif rs("ShareA")="3" then%> <%elseif rs("ShareA")="4" then%> <%end if%>
    <%=rs("ShareC")%>

    <% rs.close set rs=nothing else %>
    <%=List_Page(m,z,page,"space.asp?do=share&view="&view,11,5)%>
    <%end if%> <% End Sub '================================================= '过程名:Call Index_Daily '作 用:日志 '作 者: 花心萝卜 http://www.7xiwl.com '================================================= Sub Index_Daily Response.write "
    " Response.write "
    " Response.write "" Response.write "" Response.write " " Response.write "" Response.write "
    " Response.write "
    " Response.write "

    日志

    " Response.write "
    " Response.write "" gourl=request.serverVariables("HTTP_REFERER") if view="blog" then Response.write "
    " Response.write "« 返回上一页 " Response.write "
    " end if Response.write "
    " if view="blog" then Set Rs = CmsDjArt.GetRs("",0,"ID="&ID) If rs.EOF And rs.BOF Then Response.write"" Response.End End If Conn.DB "update CmsDj_Art set Hits=Hits+1 where id="&id,"exe" ptitle=rs("title") Hits=rs("Hits") UserID=rs("UserID") UserName=rs("UserName") UpdateTime=rs("UpdateTime") Content=rs("Content") rs.close set rs=nothing %>
    » 关闭侧边栏 查看日志|返回日志列表

    <%=ptitle%>

    <%=CmsDj_Com_Time(UpdateTime)%>
    <%=Content%>
    分享 <%if UserName=""&CmsDj_Com_UserName&"" then%> <%end if%>

    作者:<%=UserName%>   人气:<%=Hits%>

    评论


    <% elseif view="edit" then Set Rs = CmsDjArt.GetRs("",0,"UserID="&CmsDj_Com_UserID&" and ID="&ID) If rs.EOF And rs.BOF Then Response.write"" Response.End End If Content = rs("Content") Content = Replace(Content, "<", "<") Content = Replace(Content, ">", ">") Content = Replace(Content, """", """) %>
    日志标题 " size="60" />
    隐私设置
     
    <% elseif view="add" then %>
    日志标题
    隐私设置
     
    <% else Response.write "
    "& VbCrLf Response.write "
    "& VbCrLf Response.write ""& VbCrLf Response.write "
    "& VbCrLf Response.write "
    "&List_Page(m,z,page,"space.asp?do=daily&view="&view,11,5)&"
    " Response.write "
    " end if if view="" or view="me" or view="all" then Response.write "
    " Response.write "
    " Response.write "

    快捷菜单

    " Response.write "" Response.write "
    " Response.write "
    " end if End Sub '================================================= '过程名:Call Index_Pic '作 用:相册 '作 者: 花心萝卜 http://www.7xiwl.com '================================================= Sub Index_Pic %>
    <% Response.write "
    " Response.write "
    " Response.write "" Response.write "" Response.write " " Response.write "" Response.write "
    " Response.write "
    " Response.write "

    相册

    " Response.write "
    " Response.write "" Response.write "
    " If view="album" Then Set Rs = CmsDjPic.GetRs("",0,"ID="&ID) If rs.EOF And rs.BOF Then Response.write"" Response.End End If Conn.DB "update CmsDj_Pic set Hits=Hits+1 where id="&id,"exe" ptitle=rs("title") Hits=rs("Hits") UserID=rs("UserID") UserName=rs("UserName") StyleType=rs("StyleType") UpdateTime=rs("UpdateTime") PicUrl=LCase(rs("PicUrl")) if left(PicUrl,6)="upload" then PicUrl=InstallDir&PicUrl PicUrlB="http://"&CD_weburl&PicUrl else PicUrl=PicUrl PicUrlB=PicUrl end if rs.close set rs=nothing set UpPic = Conn.DB ("select top 1 id,Title from [CmsDj_Pic] where UserID="&UserID&" order by id asc","exe") upurl=UpPic(0) uptitle=UpPic(1) set DownPic = Conn.DB ("select top 1 id,Title from [CmsDj_Pic] where UserID="&UserID&" order by id desc","exe") downurl=DownPic(0) downtitle=DownPic(1) set RelationArt = Conn.DB ("select top 1 id,Title from [CmsDj_Pic] where UserID="&UserID&" and id<"&id&" order by id desc","exe") IF RelationArt.eof and relationArt.bof Then contextuala= "上一张" else contextuala= "上一张" end if set RelationArt = Conn.DB ("select top 1 id,Title from [CmsDj_Pic] where UserID="&UserID&" and id>"&id&" order by id","exe") IF RelationArt.eof and relationArt.bof Then downpic=upurl contextualb=contextualb& "下一张" else downpic=relationArt(0) contextualb=contextualb& "下一张" end if Response.write "
    " Response.write "
    " Response.write ""&contextuala&"|" Response.write ""&contextualb&"|" Response.write "幻灯播放" Response.write "" Response.write "
    " Response.write "人气:"&Hits&" " Response.write "
    " Response.write "
    " Response.write "" Response.write "

    " Response.write "分享" Response.write "

    上传人 "&UserName&"

    " Response.write "

    上传于 "&UpdateTime&"

    " Response.write "
    " %>

    <% Response.write "
    " Response.write "
    " Response.write "" Response.write "
    " Response.write "
    " Response.write "
    " ElseIf view="edit" Then Set Rs = CmsDjPic.GetRs("",0,"UserID="&CmsDj_Com_UserID&" and ID="&ID) If rs.EOF And rs.BOF Then Response.write"" Response.End End If Response.write "
    " Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
    " Response.write "

    选择图片

    " Response.write "

    提示:点击选择图片,然后点浏览从电脑中选择你要上传的图片,选择完成后点击开始上传。

    " Response.write "
    图片标题
    链接地址 " if CD_UploadType="0" then Response.write "" else Response.write "" end if Response.write "
    隐私设置" Response.write "" Response.write "
    图片特效" Response.write "" Response.write "
     
    " rs.close set rs=nothing ElseIf view="add" Then Response.write "
    " Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "" Response.write "
    " Response.write "

    选择图片

    " Response.write "

    提示:点击选择图片,然后点浏览从电脑中选择你要上传的图片,选择完成后点击开始上传。

    " Response.write "
    图片标题
    链接地址 " if CD_UploadType="0" then Response.write "" else Response.write "" end if Response.write "
    隐私设置" Response.write "" Response.write "
    图片特效" Response.write "" Response.write "
     
    " Else Response.write "
    "& VbCrLf Response.write ""& VbCrLf Response.write ""& VbCrLf i=0 if view="all" then if key<>"" then SqlA = "Title like '%"&key&"%' or UserName like '%"&key&"%' and Hidden=0 order by UpdateTime desc" else SqlA = "Hidden=0 order by UpdateTime desc" end if else SqlA = "UserID="&CmsDj_Com_UserID&" order by UpdateTime desc" end if Set Rs=CmsDjPic.GetRs("",0,SqlA) If Not(rs.bof And rs.EOF) Then rs.pagesize=10 '每页数据 rs.AbsolutePage=page m=rs.recordcount '总记录 n=rs.PageCount '总页数 z=rs.pagesize '每页数量 do while not rs.eof and i"& VbCrLf Response.write "
    "& VbCrLf Response.write ""& VbCrLf Response.write ""& VbCrLf Response.write ""& VbCrLf Response.write "
    "& VbCrLf Response.write "
    "&replace(rs("title"),key,""&key&"")&"
    "& VbCrLf if view="all" then Response.write "

    "&replace(rs("UserName"),key,""&key&"")&"

    " Response.write "

    "& VbCrLf else Response.write "

    "& VbCrLf if rs("Hidden")=1 then Response.write "状态: 仅自己可见
    " else Response.write "状态: 全站用户可见
    " end if end if Response.write "人气: "&rs("Hits")&"
    更新: "&CmsDj_Com_Time(rs("UpdateTime"))&"

    "& VbCrLf if rs("UserName")=""&CmsDj_Com_UserName&"" then Response.write "

    管理|删除

    "& VbCrLf end if Response.write "
    "& VbCrLf Response.write ""& VbCrLf If i mod 2=0 Then Response.write ""& VbCrLf End If rs.movenext loop Else Response.write "暂无相册, 赶快上传吧! ^_^" End If rs.Close Set rs=nothing Response.write "" Response.write "" Response.write "
    " End If if view="all" then Dim HiddenSum:HiddenSum = Conn.DB ("select count(*) from CmsDj_Pic where Hidden=1","exe")(0) Response.write "
    本页有 "&HiddenSum&" 个相册因作者的隐私设置而隐藏
    " end if Response.write "
    "&List_Page(m,z,page,"space.asp?do=pic&view="&view,11,5)&"
    " End Sub '================================================= '过程名:Call Index_Inbox '作 用:消息 '作 者: 花心萝卜 http://www.7xiwl.com '================================================= Sub Index_Inbox If view="pm" Then messages_id=CLng(request("id")) IF Not IsNum(messages_id) Then Response.Write "出错了,参数传输错误!" :Response.End Set Rs=CmsDjMessage.GetRs("",0,"(incept='"&CmsDj_Com_UserName&"' or sender='"&CmsDj_Com_UserName&"') and id="&messages_id) if rs.eof and rs.bof then response.write "" Response.End else Conn.DB "update CmsDj_Message set flag=1 where incept='"&CmsDj_Com_UserName&"' and ID="&messages_id,"exe" %> <% Response.write "

    消息

    " Response.write "
    " Response.write "" Response.write "
    " Response.write "
    "& VbCrLf Response.write "
    "& VbCrLf Response.write ""& VbCrLf Response.write ""& VbCrLf Response.write "
      "& VbCrLf Response.write "
    • "& VbCrLf If rs("sender")="系统消息" Then Response.write "
      "& VbCrLf Response.write ""& VbCrLf Response.write "
      "& VbCrLf Response.write "
      "& VbCrLf Response.write "

      "&rs("sender")&" "&CmsDj_Com_Time(rs("sendtime"))&"

      "& VbCrLf Else Response.write "
      "& VbCrLf Response.write ""& VbCrLf Response.write "
      "& VbCrLf Response.write "
      "& VbCrLf Response.write "

      "&rs("sender")&" "&CmsDj_Com_Time(rs("sendtime"))&"

      "& VbCrLf End If Response.write "
      "&rs("title")&"
      "& VbCrLf Response.write ""&rs("content")&"
      "& VbCrLf Response.write "
      "& VbCrLf Response.write "
    • "& VbCrLf Response.write "
    "& VbCrLf If rs("sender")<>"系统消息" Then Response.write "
      "& VbCrLf Response.write "
    • "& VbCrLf Response.write "
      "& VbCrLf Response.write ""& VbCrLf Response.write "
      "& VbCrLf Response.write "
      "& VbCrLf Response.write "

      "&rs("incept")&"

      "& VbCrLf Response.write "
      "& VbCrLf Response.write "
      "& VbCrLf Response.write "

      "& VbCrLf Response.write ""& VbCrLf Response.write "可以使用 Ctrl+Enter 发布

      "& VbCrLf Response.write "
      "& VbCrLf Response.write "
      "& VbCrLf Response.write "
    • "& VbCrLf Response.write "
    "& VbCrLf End If Response.write "
    " Response.write "" end if rs.Close set rs=nothing ElseIf view="sendmsg" Then Response.write "

    消息

    " Response.write "
    " Response.write "" Response.write "
    " Response.write "
    "& VbCrLf %>
    " style="width: 398px;" class="t_input" tabindex="1" onclick="auc.handleEvent(this.value ,event);" onkeyup="auc.handleEvent(this.value ,event);" onkeydown="closeOpt(username,event);inputKeyDown(event);" autocomplete="off" /> <% Set Rs=CmsDjPublic.GetRs("",0,"CD_AA=0 and CD_CC="&Cmsdj_Com_UserID&" order by CD_ID desc") If Not(Rs.bof And Rs.EOF) Then ShowFriends=True do while not Rs.eof ShowFriend=ShowFriend&""&GetUserName(Rs("CD_BB"),0)&"," Rs.movenext loop Else ShowFriend=ShowFriend&"" ShowFriends=False End If Rs.Close Set Rs=nothing If ShowFriends=True Then %> <%End If%>
      <% dim inboxsum:inboxsum = Conn.DB ("select count(*) from CmsDj_Message where incept='"&CmsDj_Com_UserName&"'","exe")(0) if inboxsum>=CmsDj_Com_MessageNum then response.write "您的收信箱可以储存 "&CmsDj_Com_MessageNum&" 条短信已满,请先删除无用信息后发送。谢谢!" else%> 可以使用 Ctrl+Enter 发布 <%end if%>
    <%Else%> <% Response.write "

    消息

    " Response.write "
    " Response.write "" Response.write "
    " Response.write "
    " Response.write "
    " CmsDj_Com_MsgNum = Conn.DB ("select count(*) from CmsDj_Message where incept='"&CmsDj_Com_UserName&"'","exe")(0) Response.write "您的收信箱总共可以储存 "&CmsDj_Com_MessageNum&" 条短信,目前已有 "&CmsDj_Com_MsgNum&" 条短信,还可以储存 "&CmsDj_Com_MessageNum-CmsDj_Com_MsgNum&" 条短消息。" Response.write "
    为了节省空间,请及时删除无用信息,谢谢。" Response.write "
    " Response.write "
    "& VbCrLf Response.write "
      "& VbCrLf page=int(request.QueryString ("page")) if page<=0 or page="" then page=1'初始化分页参数 i=0 if view="privatepm" then SqlA = "incept='"&CmsDj_Com_UserName&"' and sender<>'系统消息' order by sendtime desc" elseif view="systempm" then SqlA = "incept='"&CmsDj_Com_UserName&"' and sender='系统消息' order by sendtime desc" else SqlA = "incept='"&CmsDj_Com_UserName&"' and flag=0 order by sendtime desc" end if Set Rs=CmsDjMessage.GetRs("",0,SqlA) If Not(rs.bof And rs.EOF) Then rs.pagesize=10 '每页数据 rs.AbsolutePage=page m=rs.recordcount '总记录 n=rs.PageCount '总页数 z=rs.pagesize '每页数量 do while not rs.eof and i"& VbCrLf Response.write "
    • "& VbCrLf If rs("sender")="系统消息" Then Response.write "
      "& VbCrLf Response.write ""& VbCrLf Response.write "
      "& VbCrLf Else Response.write "
      "& VbCrLf Response.write ""& VbCrLf Response.write "
      "& VbCrLf End If Response.write "
      "& VbCrLf Response.write "

      "& VbCrLf If rs("sender")="系统消息" Then Response.write ""&rs("sender")&" "& VbCrLf Else Response.write ""&rs("sender")&" "& VbCrLf End If Response.write ""&CmsDj_Com_Time(rs("sendtime"))&"

      "& VbCrLf Response.write "
      "& VbCrLf Response.write ""&rs("title")&"

      "& VbCrLf Response.write "查看详情"& VbCrLf Response.write "

      "& VbCrLf Response.write "
      "& VbCrLf Response.write "删除"& VbCrLf Response.write "
      "& VbCrLf Response.write "
    • "& VbCrLf Response.write ""& VbCrLf rs.movenext loop Else Response.write "
      当前没有相应的短消息。
      " End If rs.Close Set rs=nothing Response.write "
    "& VbCrLf Response.write "
    "& VbCrLf Response.write "
    "&List_Page(m,z,page,"space.asp?do=inbox&view="&view&"",5,3)&"
    " Response.write "
    " %> <% End IF End Sub '================================================= '过程名:GetUrl '作 用:获取当前Url参数的函数 '作 者: 花心萝卜 http://www.7xiwl.com '================================================= Function GetUrl Dim ScriptAddress,Servername,qs ScriptAddress = CStr(Request.ServerVariables("SCRIPT_NAME")) Servername = CStr(Request.ServerVariables("Server_Name")) qs=Request.QueryString if qs<>"" then GetUrl =ScriptAddress &"?"&qs 'GetUrl ="http://"& Servername & ScriptAddress &"?"&qs else GetUrl =ScriptAddress 'GetUrl ="http://"& Servername & ScriptAddress end if GetUrl =Replace(Replace(Replace(Replace(GetUrl,"&","%26"),"/","%2F"),"?","%3F"),"=","%3D") End Function Function List_Page(Numbers,Perpage,Curpage,Url_Add,PageA,OffsetA) 'Numbers ------- 数据总数 'Perpage ------- 每页数量 'CurPage ------- 当前页数 'Url_Add ------- 文件地址 ListUrl=Url_Add&"&page=" List_Page="" Dim Page,Offset,PageI If Int(Numbers)>Int(PerPage) Then Page=PageA Offset=OffsetA Dim Pages,FromPage,ToPage If Numbers Mod Cint(Perpage)=0 Then Pages=Int(Numbers/Perpage) Else Pages=Int(Numbers/Perpage)+1 End If FromPage=Curpage-Offset ToPage=Curpage+Page-Offset-1 If Page>Pages Then FromPage=1 ToPage=Pages Else If FromPage<1 Then Topage=Curpage+1-FromPage FromPage=1 If (ToPage-FromPage)Pages Then FromPage =Curpage-Pages +ToPage ToPage=Pages If (ToPage-FromPage) "&Numbers&" " If Curpage>1 Then List_Page=List_Page&"1 ..." List_Page=List_Page&"‹‹" End If For PageI=FromPage TO ToPage If PageI<>CurPage Then List_Page=List_Page&""&PageI&"" Else List_Page=List_Page&""&PageI&"" End If Next If Curpage››" List_Page=List_Page&"... "&Pages&"" End If End If End Function Function Ylmv_Com_BlogList(num,Fontnum,l) m=0 if l="1" then set rs=Conn.DB ("SELECT * FROM CmsDj_Art where UserID="&CmsDj_Com_UserID&" order by UpdateTime desc","exe") elseif l="2" then set rs=Conn.DB ("SELECT * FROM CmsDj_Art order by Hits desc","exe") else set rs=Conn.DB ("SELECT * FROM CmsDj_Art order by UpdateTime desc","exe") end if if not Rs.eof then do while not rs.eof m=m+1 Ylmv_Com_BlogList=Ylmv_Com_BlogList&"
  • "&left(rs("Title"),Fontnum)&"
  • " if m>=num then exit do rs.movenext loop else Ylmv_Com_BlogList=Ylmv_Com_BlogList&"
  • 没有数据
  • " end if rs.close set rs=nothing End Function %>