sql_msg_function.asp

. 缓存处理技术

<%


Public Page_QueryStr
  

 Dim Per_Page:Per_Page=CheckStr(Trim(Rst("CnPerBBrPage")))

 if isNum(Per_Page) then Session("CnPerBBrPage")=Per_Page
 if isNum(Session("CnPerBBrPage")) then	JsPerPage=Clng(Session("CnPerBBrPage"))
 

 Dim BBR_MsgTitle
 BBR_MsgTitle=Trim(Rst("BBR_MsgTitle"))
 BBR_MsgTitle=Replace(Replace(Replace(Replace(Replace(BBR_MsgTitle,",","|||"),"，","|||")," ","|||"),";","|||"),";","|||")
 BBR_MsgTitle=InterceptString(CheckStr(BBR_MsgTitle),45)


 Dim BBR_MsgOwner
 BBR_MsgOwner=CheckStr(Trim(Rst("BBR_MsgOwner")))
 if Not isNum(BBR_MsgOwner) then
    if BBR_MsgOwner="" then
       BBR_MsgOwner=0
    else
	Dim RsU1
       	Sql="select RegId,RegUserName from users where RegUserName='"&BBR_MsgOwner&"'"
        Set RsU1=Server.CreateObject("Adodb.RecordSet")
	RsU1.Open Sql,conn,1,1
	if RsU1.Eof or RsU1.Bof then
	   BBR_MsgOwner=0
	else
	   BBR_MsgOwner=RsU1("RegId")
	end if
	RsU1.Close
	Set RsU1=nothing
    end if
 else
    BBR_MsgOwner=Clng(BBR_MsgOwner)
 end if


 Dim BBR_MsgStatus
 BBR_MsgStatus=CheckStr(Trim(Rst("BBR_MsgStatus")))
 if not isNum(BBR_MsgStatus) then BBR_MsgStatus=0.1


 Dim BBR_MsgWriteDate
 BBR_MsgWriteDate=CheckStr(Trim(Rst("BBR_MsgWriteDate")))
 if Not isNum(BBR_MsgWriteDate) then
    BBR_MsgWriteDate=0
 else
    BBR_MsgWriteDate=Clng(BBR_MsgWriteDate)
 end if


 Dim BBR_AucOrder
 BBR_AucOrder=CheckStr(Trim(Rst("CnAucBBrOrder")))
 if Not isNum(BBR_AucOrder) then
    BBR_AucOrder=0
 else
    Session("CnAucBBrOrder")=Clng(BBR_AucOrder)
 end if
 if isNum(Session("CnAucBBrOrder")) then BBR_AucOrder=Session("CnAucBBrOrder")




 Dim Sql_SearchStr
 Sql_SearchStr="Select MsgID,AucID,MsgTitle,Content,WriteDate,Reply,WriterId,OwnerID,MsgStatus,Sender_DelMsg,Receiver_DelMsg From Msg Where MsgID>=0"

 Dim TempTs
 if instr(BBR_MsgTitle,"|||")>1 then
    Dim TempT,TempT2,Tii
    TempT=BBR_MsgTitle
    TempT=Split(TempT,"|||")
    For Tii=0 to Ubound(TempT)
      TempT2=TempT2 &" and MsgTitle like '%"& TempT(Tii) &"%'"
    Next
    TempTs=TempT2
 else
    TempTs=" and MsgTitle like '%"& BBR_MsgTitle &"%'"
 end if
 Sql_SearchStr=Sql_SearchStr & TempTs


 if BBR_MsgOwner<>0 then Sql_SearchStr=Sql_SearchStr &" and OwnerID="& BBR_MsgOwner
 if BBR_MsgStatus<>0.1 then Sql_SearchStr=Sql_SearchStr & " and MsgStatus="& BBR_MsgStatus
 if IsSqlDataBase=1 then
    if BBR_MsgWriteDate<>0 then Sql_SearchStr=Sql_SearchStr & " and DateDiff('d',WriteDate,"&SqlNowString&")<"&BBR_MsgWriteDate
 else
    if BBR_MsgWriteDate<>0 then Sql_SearchStr=Sql_SearchStr & " and DateDiff(""d"",WriteDate,"&SqlNowString&")<"&BBR_MsgWriteDate
 end if
 

 Select Case BBR_AucOrder
   Case 1: Sql_SearchStr=Sql_SearchStr &" order by MsgID Desc"
   Case 2: Sql_SearchStr=Sql_SearchStr &" order by WriteDate Desc"
   Case else:
 End Select




 Page_QueryStr="BBR_MsgTitle="& BBR_MsgTitle
 Page_QueryStr=Page_QueryStr &"&BBR_MsgOwner="& BBR_MsgOwner
 Page_QueryStr=Page_QueryStr &"&BBR_MsgStatus="& BBR_MsgStatus
 Page_QueryStr=Page_QueryStr &"&BBR_MsgWriteDate="& BBR_MsgWriteDate
 Page_QueryStr=Page_QueryStr &"&CnAucBBrOrder="& BBR_AucOrder
 Page_QueryStr=Page_QueryStr &"&"





 Dim Page:Page=rst("page")
 if Page="" then Page=1
 if Not IsNum(Page) then Page=1
 Dim Page_Url
 Page_Url=Cnbbr_CurrentPath
 dim strAnd
 if instr(Page_Url,"?")=0 then
    strAnd = "?"
 else
    strAnd = "&"
 end if

 Page_QueryStr=Replace(Page_QueryStr,",","|")
 Page_QueryStr=Page_Url & StrAnd & Page_QueryStr


























Function Disp_MsgSearch()

With Response

	.Write"<table width=98% border=0 align=center cellpadding=0 cellspacing=0>"& vbcrlf
	.Write"  <tr height=28 class=td>"& vbcrlf
	.Write"   <td width=380 align=left>"& Disp_MsgAdminMenu &"</td>"& vbcrlf
	.Write"   <td align=right>"& vbcrlf

	.Write "<TABLE cellSpacing=0 cellPadding=0 width=98% align=right border=0>" & Vbcrlf
	.Write "<TR>" & Vbcrlf
	.Write "<td colspan=3 width=100% height=1 align=center class=menutdbg_1></td>" & Vbcrlf
	.Write "</TR>" & Vbcrlf
	.Write "<TR>" & Vbcrlf
	.Write "<td colspan=3 width=100% height=26 align=Left background=""../skins/"& SKINS_FOLDER &"/GrayBg.Gif"" border=""0"">"& Vbcrlf


	.Write DispAndOrder

	.Write "</td>" & Vbcrlf
	.Write "</TR>" & Vbcrlf
	.Write "<TR height=1>" & Vbcrlf
	.Write "<td width=1% align=center class=td></td><td width=98% align=center class=menutdbg_2> </td><td width=1% align=center class=td></td>" & Vbcrlf
	.Write "</TR>" & Vbcrlf
	.Write "</Table>" & Vbcrlf

	.Write"   </td>"& vbcrlf
	.Write"  </tr>"& vbcrlf
	.Write"</table>"& vbcrlf

End With










 Call Disp_PageAuc(Sql_SearchStr)

End Function




Function Disp_PageAuc(sql)



Set Rs=Server.CreateObject("Adodb.RecordSet")
Rs.Open sql,conn,1,1
if Rs.eof or Rs.Bof then
   HelpTitle="出错了！"
   HelpInfo="对不起，系统没有找到你搜索的信息！"
   HelpList="<Ul>" & Vbcrlf
   HelpList=HelpList & "<LI><a href=""Search_Msg.asp"">查看所有站内信息</a></LI>" & Vbcrlf
   HelpList=HelpList & "<LI><a href=""javascript: history.back(-1);"">返回上页</a></LI>" & Vbcrlf
   HelpList=HelpList & "</Ul>" & Vbcrlf
   Cnbbr_Helper HelpTitle,HelpInfo,HelpList,368
else

   Dim TotalCs : Totalcs=Rs.recordcount
   Response.Write"<form name=""searchform"" method=""post"" action="""">"& Vbcrlf
   Response.Write"<table width=98% border=0 cellspacing=0 cellpadding=0 align=center>" & vbcrlf
   Response.Write" <tr height=32 class=TDBg_2>" & vbcrlf
   Response.Write"   <td width=12 align=center><input type=""checkbox"" name=""chkAll"" value=""on"" onClick=""CheckAll(this.form)""></td>" & vbcrlf
   Response.Write"   <td width=398 align=center>信息标题 / 写信人</td>" & vbcrlf
   Response.Write"   <td width=158 align=center>接收人</td>" & vbcrlf
   Response.Write"   <td width=80 align=center>撰写时间</td>" & vbcrlf
   Response.Write"   <td width=80 align=center>回复状态</td>" & vbcrlf
   Response.Write"</tr>" & vbcrlf
   Response.Write"<TR><TD colspan=5 height=2 background=""../skins/"& Skins_Folder &"/Dot.gif""></TD></TR>" & vbcrlf
   Response.Write"</table>"& Vbcrlf
   rs.pagesize=jsperpage
   Dim CurrentPage
   if trim(Page)<>"" then
      if Not IsNum(Page) then Page=1
      CurrentPage=clng(Page)
      if CurrentPage<1 then CurrentPage=1
      if CurrentPage>rs.pagecount then
	 CurrentPage=rs.pagecount
      end if
   else
      CurrentPage=1
   end if 



   if currentpage<>1 then
      if (currentpage-1)*jsperpage<totalcs then
	 rs.move(currentpage-1)*jsperpage
	 dim bookmark
	 bookmark=rs.bookmark
      end if
   end if

   Dim TotalPages
   if (totalcs mod jsperpage)=0 then
      totalpages=totalcs\jsperpage
   else
      totalpages=totalcs\jsperpage+1
   end if
   i=0
   do while not Rs.eof
      Response.Write"<table width=98% border=0 cellspacing=0 cellpadding=0 align=center>" & vbcrlf
      response.write"<tr bgcolor=""#FFFFFF"" onMouseOver=""this.bgColor='#FAFAFA';"" onMouseOut=""this.bgColor='#FFFFFF'"">" & vbcrlf
      Response.Write"<td width=12 align=center><input name=id type=checkbox value="& rs("Msgid") &"></td>" & vbcrlf

      response.write"<td width=398 align=left style=""Line-height:23px;""> -> <a href=""###"" title="""& Rs("Content") &""">"


      Dim AucTitle
      auctitle=InterceptString(rs("Msgtitle"),88)
      response.write "<Span Style=""color: #0044CC; Font-weight: bold"">"& auctitle &"</Span>"
      response.write"</a><BR>"
      Dim TempU1ID,TempU2ID
      TempU1ID=Rs("WriterID")
      TempU2ID=Rs("OwnerID")
      Dim Rs_Seller
      Sql="select RegId,RegUserName,UserQQ,BBR_UserQQSkins,BBR_UserQQMsg from Users where RegID in ("& TempU1ID &","& TempU2ID &")"
      Set Rs_Seller=conn.execute(sql)
      if isNum(TempU1ID) then 
	 if Clng(TempU1ID)=0 then
	    Response.Write"【系统消息】" & Vbcrlf
	 else
	    Response.Write"写信人： <a href=""Search_Msg.asp?BBR_MsgOwner="& Rs_Seller("RegId") &""" title=""点击搜索此用户的所有站内短信息"" class=link_on_td>"& Rs_Seller("RegUserName") &"</a>" & Vbcrlf
	    Rs_Seller.MoveNext
	 end if
      end if   
      response.write"</td>" & vbcrlf
      response.write"<td width=158 align=center>"      


      if isNum(TempU2ID) then 
	 if Clng(TempU2ID)=0 then
	    Response.Write"【系统】" & Vbcrlf
	 else
	    Response.Write"<a href=""Search_Msg.asp?BBR_MsgOwner="& Rs_Seller("RegId") &""" title=""点击搜索此用户的所有站内短信息"" class=link_on_td>"& Rs_Seller("RegUserName") &"</a>" & Vbcrlf
	 end if
      end if  
      Rs_Seller.Close
      Set Rs_Seller=nothing

      response.write"</td>" & vbcrlf
      response.write"<td width=80 align=center>"


      response.write rs("WriteDate")

      Response.write"</td>" & vbcrlf
      response.write"<td width=80 align=center>"


      Dim TempMsgStatus
      TempMsgStatus=Rs("msgStatus")
      if TempMsgStatus=0 then
	 Response.Write "未读"
      elseif TempMsgStatus=1 then
	 Response.Write "已读"
      elseif TempMsgStatus=2 then
	 Response.Write "已回复"
      else
	 Response.Write "异常"
      end if

      Response.write"</td></tr>" & vbcrlf
      Response.Write"<TR><TD colspan=5 height=2 background=""../skins/"& Skins_Folder &"/Dot.gif""></TD></TR>" & vbcrlf
      Response.Write"</table>"& Vbcrlf
      i=i+1
      if i>JsPerPage then Exit Do
    rs.movenext
    loop

    Response.Write"<input name=act type=hidden value=msg>"& Vbcrlf
    Response.Write"</form>"


Response.Write"<table width=98% border=0 cellspacing=0 cellpadding=0 align=center>" & vbcrlf
response.write"<tr>" & vbcrlf
response.write"<td align=""right"">" & vbcrlf
response.write"<table cellspacing=0 cellpadding=0 width=100% align=center border=0>" & vbcrlf
Response.Write"<form name=cnbbrpagefrom action="&Cnbbr_CurrentPath&" method=post onsubmit=""cnbbrpagefrom.B4.disabled=true;"">"
response.write"<tbody>" & vbcrlf
response.write"<tr class=td>" & vbcrlf
response.write"<td width=45% height=25>" & vbcrlf
response.write"&nbsp;<img height=14 src=""../skins/"& Skins_Folder &"/go.gif"" width=14 align=center>" & vbcrlf
response.write" 共[<font class=fblack>"& totalcs &"</font>]条信息　分[<font class=fblack>"& totalpages &"</font>]页&nbsp;&nbsp;当前第[<font class=fblack>"& currentpage &"</font>]页</td>"
response.write"<td width=30% ><img height=11 src=""../skins/"& Skins_Folder &"/lt.gif"" width=11 align=center>"

if currentpage<2 then
   response.write "首页 上一页 "
else
   Response.Write "<font class=fblack>"
   response.write "<a href="&Page_QueryStr &"page=1>首页</a> "
   response.write "<a href="&Page_QueryStr &"page="& (currentpage-1) &">上一页</a> "
   Response.Write "</font>"
end if
if totalpages-currentpage<1 then
   response.write "下一页 尾页"
else
   Response.Write "<font class=fblack>"
   response.write "<a href="&Page_QueryStr &"page="&(currentpage+1)&">下一页</a> "
   response.write "<a href="&Page_QueryStr &"page="& totalpages &">尾页</a>"
   Response.Write "</font>"
end if

response.write"<img height=11 src=""../skins/"& Skins_Folder &"/gt.gif"" width=11 align=center></td>" & vbcrlf
response.write"<td width=25% >" & vbcrlf
response.write"<select name=page>" & vbcrlf

i=1
for i=1 to totalpages
if i=currentpage then
response.write"<option value="&i&" selected>第"&i&"页</option>"
else
response.write"<option value="&i&">第"&i&"页</option>"
end if
next
response.write"</select>&nbsp;"& Vbcrlf

Response.Write"<Input Name=BBR_MsgTitle type=hidden value="&BBR_MsgTitle&">"& Vbcrlf
Response.Write"<Input Name=BBR_MsgOwner type=hidden value="&BBR_MsgOwner&">"& Vbcrlf
Response.Write"<Input Name=BBR_MsgStatus type=hidden value="&BBR_MsgStatus&">"& Vbcrlf
Response.Write"<Input Name=BBR_MsgWriteDate type=hidden value="&BBR_MsgWriteDate&">"& Vbcrlf

Response.Write"<input type=""submit"" name=""B4"" value=""转向"" class=""button"">"& Vbcrlf
Response.Write"</td>"
response.write"</tr>" & vbcrlf
response.write"</form>" & vbcrlf
response.write"</tbody>" & vbcrlf
response.write"</table>" & vbcrlf
response.write"</td></tr></table>" & vbcrlf

End if
End Function

 Function GetPage_Url()
  Dim Re_Url
  Re_Url=Request.ServerVariables("URL")
  if Request.QueryString<>"" then
     Re_Url = Re_Url & "?" & Request.QueryString 
  end if

  Dim Re
  set re = new RegExp
  re.Pattern = "[&|?]page=\d+"
  re.IgnoreCase = true
  re.multiLine = true
  re.global = true
  Dim Matches,TmpMatch,Match
  Set Matches = re.Execute(Re_Url) 
  For Each Match in Matches  
     tmpMatch = Match.Value
     GetPage_Url = replace(Re_Url,tmpMatch,"")
  next
  GetPage_Url=GetPage_Url
 End function
%>