📄 webserver.vb
字号:
'最近的消息
sb.Append("<table border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse"" bordercolor=""#808080"" width=""630"" id=""AutoNumber2"" bgcolor=""#008080""><tr><td width=""100%""><font color=""#FFFFFF""><b>我最近发出：</b></font><a name=""MyRecentlyPostMessage""><a href=""#noSystemMessage""><font color=""#FFFFFF"">非系统消息<font></a> <a href=""#MyRecentlyPostMessage""><font color=""#FFFFFF"">我最近的消息<font></a> <a href=""#newMessage""><font color=""#FFFFFF"">新消息<font></a></td></tr></table>")
a = msg.GetNewMsg(msgType.MyRecentlyPostMessage)
Msg2Html(sb, a)
sb.Append("<br>")
sb.Append("<br>")
sb.Append("<br>")
Return sb.ToString
End Function
#End Region
#Region "处理列表"
''' <summary>
''' 列表处理类
''' </summary>
''' <param name="url"></param>
''' <returns></returns>
''' <remarks>主要处理大、小版列表，我的问题、参与的问题、回复的问题</remarks>
Private Function ProcBbsList(ByVal url As String) As String
url = comm.Comm.CSDN_COMINITY_URL & url
url = url.ToLower
Dim uu As New Uri(url)
Dim StrHtml As String = ""
Dim http As New comm.HttpProc(url)
http.cookiePost = comm.Comm.CL
StrHtml = http.Proc
http = Nothing
If Len(StrHtml) = 0 Then
' MsgBox("HTTP错误！")
Return ""
End If
If StrHtml.IndexOf("CSDN 用户登录") > 0 Then
Return "<title>使用该功能前请登录</title><tr><td colspan=""5""><center><font color=red>你还没有登录！！</font></center></td></tr>"
End If
'提取ID和TITLE的正则
Dim r As String = ""
Dim m As Match
Dim mc As MatchCollection
Dim sb As New System.Text.StringBuilder
'大版快
If url.IndexOf("forumslist.asp") > 0 Then
r = "<tr bgcolor=""#ffffff"" ><td colspan=""2""> <font color=""red"" size=""3"">(?<TITLE>.*?)</font></td></tr>"
End If
'小版块
If url.IndexOf("forumlist.asp") > 0 Then
r = "<tr bgcolor=""#ffffff""><td colspan=""2""> <font size=3 color=red><b>(?<TITLE>.*?)</b></font> \((?<TYPE>.*?)\)</td></tr>"
End If
'我的问题，参与问题，得分问题
If url.IndexOf("myforum.asp") > 0 Then
r = "<tr bgcolor=""#ffffff"" ><td> <b>(?<TITLE>.*?)</b>.*?</td></tr>"
End If
If Len(r) > 0 Then
'标题
sb.AppendLine("<title>" & comm.RegMatch.Match(r, StrHtml, "TITLE") & "</title>")
sb.AppendLine("<table style=""font-family: 宋体; font-size: 9pt;"" width=""100%"" cellspacing=""0"" cellpadding=""0""")
sb.AppendLine(" style=""border-collapse: collapse"" bordercolor=""#111111"">")
sb.AppendLine(" <tr><td colspan=""5""> 当前：<font size=""+2"" color=""red""><b><i>〓")
'这里设置当前版面的名字
sb.AppendLine(comm.RegMatch.Match(r, StrHtml, "TITLE"))
sb.AppendLine("</i></b></font> ")
'这里显示斑竹
If url.IndexOf("ForumList") > 0 Then
r = "<a href=""/Message_Board/Send.asp\?sendto=(?<BBSADMIN>.*?)"">\1</a>"
Else
r = "<a href=""http://message.csdn.net/SendMessage\.aspx\?To=(?<BBSADMIN>.*?)"">\1</a>"
End If
mc = comm.RegMatch.Matches(r, StrHtml)
If mc.Count > 0 Then
sb.AppendLine("斑竹：")
For Each m In comm.RegMatch.Matches(r, StrHtml)
sb.AppendLine(m.Result("${BBSADMIN}") & "、")
Next
Else
If url.IndexOf("myforum.asp") = 0 Then
sb.AppendLine("该版本暂无斑竹！")
End If
End If
sb.AppendLine("</td></tr>")
sb.AppendLine(" <tr><td colspan=""5"">")
'开始处理分页
r = "<font color=red>(?<ID>\d+)</font>"
'当前页
Dim intPage As Integer = comm.RegMatch.Match(r, StrHtml, "ID")
Dim intCount As Integer = 0
'分页列表
'r = "<a href='(?<URL>.*?)(?<PAGE>\d+)'>\2</a>"
'If url.IndexOf("myforum.asp") > 0 Then
' r = "<a href='(?<URL>.*?)'>(?<PAGE>\d+)</a>"
'End If
r = "<a href='(?<URL>.*?)'>(?<PAGE>\d+)</a>"
mc = comm.RegMatch.Matches(r, StrHtml)
Dim i As Integer = 0
If mc.Count > 0 Then
intCount = mc.Count / 2
sb.AppendLine("分页导航：")
While i <= intCount
If i + 1 = intPage Then
'当前页是红色
sb.AppendLine("<font color=""red"">" & intPage & "</font>")
End If
If i <> intCount Then
sb.AppendLine(mc(i).Value)
End If
i += 1
End While
'首页
If intPage > 1 Then
sb.Append("[<a href=""" & mc(0).Result("${URL}") & """>首页</a> ")
Else
sb.Append("[首页 ")
End If
'上一页
If intPage > 1 Then
sb.Append("<a href=""" & mc(intPage - 2).Result("${URL}") & """>上一页</a> ")
Else
sb.Append("上一页 ")
End If
'下一页
If intPage < intCount + 1 Then
sb.Append("<a href=""" & mc(intPage - 1).Result("${URL}") & """>下一页</a> ")
Else
sb.Append("下一页 ")
End If
If intPage < intCount + 1 Then
sb.Append("<a href=""" & mc(intCount - 1).Result("${URL}") & """>末页</a>]")
Else
sb.Append("末页]")
End If
Else
If intPage > 0 Then
sb.AppendLine("获取分页错误")
Else
sb.AppendLine("")
End If
End If
sb.Append(" [<a href=""" & uu.PathAndQuery & """>刷新</a>]")
sb.Append(" [<a href=""http://exit.aspx/"">关闭</a>]")
sb.AppendLine("</td><tr>")
sb.AppendLine(" <tr>")
sb.AppendLine(" <td>")
sb.AppendLine(" <font color=""#0099CC""><b>问题</b></font>")
If url.IndexOf("myforum.asp") > 0 Then
Dim t As String = uu.PathAndQuery.ToLower
sb.Append("<font color=""#0099CC""><b>【</b></font>")
If url.IndexOf("typenum=1") > 0 Then
sb.Append("参于的问题 ")
Else
sb.Append("<a href='" + t.Replace("typenum=2", "typenum=1").Replace("typenum=3", "typenum=1") + "'>参于的问题</a> ")
End If
If url.IndexOf("typenum=2") > 0 Then
sb.Append("我的问题 ")
Else
sb.Append("<a href='" + t.Replace("typenum=1", "typenum=2").Replace("typenum=3", "typenum=2") + "'>我的问题</a> ")
End If
If url.IndexOf("typenum=3") > 0 Then
sb.Append("得分的问题")
Else
sb.Append("<a href='" + t.Replace("typenum=1", "typenum=3").Replace("typenum=2", "typenum=3") + "'>得分的问题</a>")
End If
sb.Append("<font color=""#0099CC""><b>】</b> </font>")
Else
If url.IndexOf("forumslist.asp") > 0 Then
Dim t As String = uu.PathAndQuery.ToLower
sb.AppendLine(" <font color=""#0099CC""><b>【</b></font>")
sb.Append("<a href='/Expert/member/MyForum.asp?typenum=1'>我的问题</a> ")
sb.Append("<a href='/Expert/member/MyForum.asp?typenum=2'>参于的问题</a> ")
sb.Append("<a href='/Expert/member/MyForum.asp?typenum=3'>得分的问题</a>")
sb.Append("<font color=""#0099CC""><b>】</b> </font>")
End If
End If
If url.IndexOf("forumlist.asp") > 0 Then
mc = comm.RegMatch.Matches("smallclassid=(?<ID>\d+)", StrHtml)
If mc.Count >= 3 Then
sb.Append("<font color=""#0099CC""><b>【</b></font>")
sb.Append("<a href='/Expert/member/myforum.asp?TypeNum=1&smallclassid=" + mc(0).Result("${ID}") + "'>我的问题</a> ")
sb.Append("<a href='/Expert/member/myforum.asp?TypeNum=2&smallclassid=" + mc(0).Result("${ID}") + "'>参于的问题</a> ")
sb.Append("<a href='/Expert/member/myforum.asp?TypeNum=3&smallclassid=" + mc(0).Result("${ID}") + "'>得分的问题</a> ")
sb.Append("<font color=""#0099CC""><b>】</b></font>")
End If
End If
mc = comm.RegMatch.Matches("/Expert/ForumList.asp\?typenum=(?<TYPE>\d+)&Roomid=(?<ID>\d+)", StrHtml)
If mc.Count >= 2 Then
sb.Append("<font color=""#0099CC""><b>【</b></font>")
If comm.RegMatch.Match("typenum=2&Roomid=", StrHtml) Then
sb.Append("<a href='/Expert/ForumList.asp?typenum=2&Roomid=" + mc(0).Result("${ID}") + "'>已解决</a> ")
Else
sb.Append("已解决 ")
End If
If comm.RegMatch.Match("typenum=1&Roomid=", StrHtml) Then
sb.Append("<a href='/Expert/ForumList.asp?typenum=1&Roomid=" + mc(0).Result("${ID}") + "'>未解决</a> ")
Else
sb.Append("未解决 ")
End If
If comm.RegMatch.Match("typenum=3&Roomid=", StrHtml) Then
sb.Append("<a href='/Expert/ForumList.asp?typenum=3&Roomid=" + mc(0).Result("${ID}") + "'>精华</a>")
Else
sb.Append("精华")
End If
sb.Append("<font color=""#0099CC""><b>】</b></font>")
End If
sb.AppendLine(" </td>")
sb.AppendLine(" <td align=""right"">")
sb.AppendLine(" <font color=""#0099CC""><b>作者</b></font></td>")
sb.AppendLine(" <td align=""right"" width=""30"">")
sb.AppendLine(" <font color=""#0099CC""><b>分数</b></font></td>")
sb.AppendLine(" <td align=""right"" width=""30"">")
sb.AppendLine(" <font color=""#0099CC""><b>回复</b></font></td>")
sb.AppendLine(" <td align=""right"" width=""80"">")
sb.AppendLine(" <font color=""#0099CC""><b>时间</b></font></td>")
sb.AppendLine(" </tr>")
sb.AppendLine(" <tr>")
sb.AppendLine(" <td colspan=""5"" height=""2"" bgcolor=""#0099CC"">")
sb.AppendLine(" </td>")
sb.AppendLine(" </tr>")
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'现在来处理列表
r = "<td class=""WithBreaks"">\r\n(?<S>.*?)\r\n<a href=[""|']/Expert/TopicView[\d*].asp\?id=(?<ID>\d+)[""|'] target=[""|']_blank[""|']>(?<TITLE>.*?)</a>\r\n</td>\r\n<td align=""right"">(?<AUTHOR>.*?)</td>\r\n<td width=""30"" align=""right"">(?<MARK>\d+)</td>\r\n<td width=""30"" align=""right"">(?<REVIEWCOUNT>\d+)</td>\r\n<td width=""80"" align=""right"">(?<TIME>[\d+\-\d+ \r\n \d+:\r\n \d+]+)</td>"
If url.IndexOf("myforum.asp") > 0 Then
r = "<td class='WithBreaks'>(?<S>.*?)<a href='/Expert/TopicView.asp\?id=(?<ID>\d+)' target='_blank'>(?<TITLE>.*?)</a>（(?<AUTHOR>.*?)）</td><td width='30' align='right'>(?<MARK>\d+)</td><td width='30' align='right'>(?<REVIEWCOUNT>\d+)</td><td width='80' align='right'>(?<TIME>.*?)</td>"
End If
mc = comm.RegMatch.Matches(r, StrHtml)
If mc.Count > 0 Then
For i = 0 To mc.Count - 1
sb.AppendLine(" <tr height=""22""")
If i Mod 2 = 0 Then
sb.AppendLine(" bgcolor=""#dddddd"" ")
End If
sb.AppendLine(">")
sb.AppendLine(" <td>")
sb.AppendLine(" <a href=""/Expert/TopicView1.asp?id=" & mc(i).Result("${ID}") & """>" & mc(i).Result("${S}") & mc(i).Result("${TITLE}") & "</a>")
sb.AppendLine(" </td>")
sb.AppendLine(" <td align=""right"">")
sb.AppendLine(" " & mc(i).Result("${AUTHOR}") & "")
sb.AppendLine(" </td>")
sb.AppendLine(" <td align=""right"" width=""30"">")
sb.AppendLine(" " & mc(i).Result("${MARK}") & "")
sb.AppendLine(" </td>")
sb.AppendLine(" <td align=""right"" width=""30"">")
sb.AppendLine(" " & mc(i).Result("${REVIEWCOUNT}") & "")
sb.AppendLine(" </td>")
sb.AppendLine(" <td align=""right"" width=""80"">")
sb.AppendLine(" " & mc(i).Result("${TIME}") & "")
sb.AppendLine(" </td>")
sb.AppendLine(" </tr>")
Next
sb.AppendLine("")
Else
sb.AppendLine("<tr><td colspan=""5""><center><font color=red>没有满足条件的记录！！</font></center></td></tr>")
End If
End If
StrHtml = sb.ToString
sb = Nothing
Return StrHtml
End Function
#End Region
End Class
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -