webserver.vb

CSDN V3.0 使用VB。Net开发 可以使用该助手访问CSDN

Imports System.Net
Imports System.Threading
Imports System.Text.RegularExpressions
Imports System.Xml
''' <summary>
''' Http Server类
''' </summary>
''' <remarks></remarks>
Public Class WebServer
    ''' <summary>
    ''' 监视类
    ''' </summary>
    ''' <remarks></remarks>
    Public HttpServer As New Net.HttpListener

    Sub Main()
        Try
            HttpServer.Start()
            HttpServer.Prefixes.Add("http://+:" & My.Settings.ServerPort & "/")
            HttpServer.IgnoreWriteExceptions = True
            While True
                Dim i As IAsyncResult = HttpServer.BeginGetContext(New AsyncCallback(AddressOf ListenerCallback), HttpServer)
                i.AsyncWaitHandle.WaitOne()
            End While
        Catch ex As Exception

        End Try

    End Sub

    Sub ListenerCallback(ByVal result As IAsyncResult)
        Dim HttpServer As Net.HttpListener = Nothing
        Dim Context As HttpListenerContext = Nothing
        Dim Response As HttpListenerResponse = Nothing
        Dim Request As HttpListenerRequest = Nothing
        Dim sw As IO.StreamWriter = Nothing
        Try
            HttpServer = result.AsyncState
            Context = HttpServer.EndGetContext(result)
            Response = Context.Response

            Request = Context.Request
            sw = New IO.StreamWriter(Response.OutputStream, System.Text.Encoding.GetEncoding("gb2312"))
            For i As Integer = 0 To 20
                sw.WriteLine("<!--***************************************-->")
            Next
            sw.WriteLine("<div id=""SD""><br><br>")
            sw.WriteLine("<center>数据加载中，请稍候...<br><br>")
            sw.WriteLine("<marquee direction=right scrollamount=8 scrolldelay=50 style=""border:1px solid #666666;height:15px;width:300px;font-size:1px;""><span style=""height:15px;width:90px;background-color:#366BD4;filter:alpha(opacity=0,finishopacity=30,style=1)""></span><span style=""height:15px;width:90px;background-color:#366BD4;filter:alpha(opacity=0,finishopacity=30,style=1) fliph();""></span></marquee></center>")
            sw.WriteLine("</div>")
            ' sw.WriteLine("<style type=""text/css"">FONT,TD,TR,TABLE,DIV,FORM,BODY { FONT-SIZE: 12px;  LINE-HEIGHT: 19px; FONT-FAMILY: ""宋体""; TEXT-DECORATION: none }</style>")
            sw.Flush()
            '''''''''''''''''''''''''''''''''''
            Dim pq As String = Request.Url.LocalPath.ToLower
            ' Console.WriteLine(pq)

            Dim Res As String = ""
            If "/expert/forumslist.asp|/expert/forumlist.asp|/expert/member/myforum.asp".IndexOf(pq) > -1 Then
                Res = ProcBbsList(Request.Url.PathAndQuery)
            End If
            If "/expert/topicview1.aspx".IndexOf(pq) > -1 Then
                Res = ProcBbsTip(Request.Url.PathAndQuery)
            End If
            If "/listmessage.aspx".IndexOf(pq) > -1 Then
                Res = ProcMsg(Request.Url.PathAndQuery)
            End If
            If "/replay.aspx" = pq Then
 
                If Request.HttpMethod = "GET" Then
                    Res = My.Resources.replay.Replace("<tiptitle>", comm.Comm.decode(Request.QueryString("title")))
                    Res = Res.Replace("<tipid>", Request.QueryString("id"))
                Else
                    Dim sr As IO.StreamReader = Nothing
                    Dim post As String = ""
                    Try
                        sr = New IO.StreamReader(Request.InputStream, Request.ContentEncoding)
                        post = sr.ReadToEnd

                    Catch ex As Exception
                    Finally
                        If Not sr Is Nothing Then
                            sr.Close()
                        End If
                    End Try
                    Res = ProcReplay(post, Request.UrlReferrer.ToString())
                End If

            End If

            If Len(Res) = 0 Then
                Res = "<title>本功能还没有实现</title>本功能还没有实现！"
            End If
            sw.WriteLine(Res)

            sw.WriteLine("<script>SD.style.display=""none"";SD.style.visibility=""hidden"";</script>")

        Finally

            If Not sw Is Nothing Then
                sw.Close()
            End If
            If Not Context Is Nothing Then
                Context = Nothing
            End If
            If Not Request Is Nothing Then
                Request = Nothing
            End If
            If Not Response Is Nothing Then
                Response.Close()
                Response = Nothing
            End If
        End Try

        ''''''''''''''''''''''''''''''

    End Sub

#Region "回复帖子"
    Private Function ProcReplay(ByVal post As String, ByVal strRef As String) As String
        Dim StrHtml As String = ""
        Dim http As New comm.HttpProc(comm.Comm.CSDN_COMINITY_URL & "/Expert/reply.asp", post)
        http.cookiePost = comm.Comm.CL
        StrHtml = http.Proc
        http = Nothing
        If StrHtml.IndexOf("CSDN 用户登录") > 0 Then
            Return "<title>使用该功能前请登录</title><tr><td colspan=""5""><center><font color=red>你还没有登录！！</font></center></td></tr>"
        End If

        If (StrHtml.IndexOf("正在生成静态页面") > 0) Then
            StrHtml = "<script>alert('回复成功！');window.parent.location.href='" & strRef & "';</script>" 'window.parent.location.href =window.parent.location.href;window.parent.location.reload()
        Else
            If (StrHtml.IndexOf("连续的回复不能超过3次") > 0) Then
                StrHtml = "连续的回复不能超过3次"
            Else
                If (StrHtml.IndexOf("你回复太快了") > 0) Then
                    StrHtml = "你回复太快了"
                Else
                    StrHtml = "发表失败，请抓图发送到[e-mail]：" + StrHtml
                End If
            End If
        End If

        Return StrHtml
    End Function
#End Region

#Region "处理帖子"

    ''' <summary>
    ''' 处理帖子
    ''' </summary>
    ''' <param name="url"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ProcBbsTip(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
        Dim xmldoc As New XmlDocument
        Dim XML As New CSDN_XML_TIPS

        Dim sb As New System.Text.StringBuilder

        Try
            xmldoc.LoadXml(StrHtml)
            XML.CreateXmlTips(xmldoc)
        Catch ex As Exception
            sb.Append(ex.ToString)
        End Try

        sb.Append("<html><head><meta http-equiv=""content-type"" content=""text/html; charset=gb2312""><head><body>")
        Dim temp As String = ""
        temp = My.Resources.Issue
        temp = temp.Replace("<%#comm.config.LbFontName%>", "宋体")
        temp = temp.Replace("<%#comm.config.LbFontSize%>", "12")
        temp = temp.Replace("<%#XML.Issue.TopicName%>", comm.Comm.html(XML.Issue.TopicName))
        temp = temp.Replace("<%#XML.Issue.TopicName2%>", comm.Comm.encode(XML.Issue.TopicName))
        temp = temp.Replace("<%#XML.Issue.TopicId%>", XML.Issue.TopicId)
        temp = temp.Replace("<%#XML.Issue.PostUserName%>", XML.Issue.PostUserName)
        temp = temp.Replace("<%#XML.Issue.PostUserNickName%>", comm.Comm.html(XML.Issue.PostUserNickName))
        temp = temp.Replace("<%#XML.Issue.ranknum%>", XML.Issue.ranknum)
        temp = temp.Replace("<%#XML.Issue.credit%>", XML.Issue.credit)
        temp = temp.Replace("<%#XML.Issue.RoomName%>", XML.Issue.RoomName)
        temp = temp.Replace("<%#XML.Issue.Point%>", XML.Issue.Point.ToString)
        temp = temp.Replace("<%#XML.Issue.ReplyNum%>", XML.Issue.ReplyNum.ToString)
        temp = temp.Replace("<%#XML.Issue.PostDateTime%>", XML.Issue.PostDateTime.ToString)
        temp = temp.Replace("<%#XML.Issue.Content%>", comm.Comm.html(XML.Issue.Content))
        sb.Append(temp)
 
        If (XML.Replys.Count > 0) Then
            Dim c_csdn1 As C_CSDN
            For Each c_csdn1 In XML.Replys
                temp = My.Resources.Replys
                temp = temp.Replace("<%#PostUserName%>", c_csdn1.PostUserName)
                temp = temp.Replace("<%#PostUserNickName%>", comm.Comm.html(c_csdn1.PostUserNickName))
                temp = temp.Replace("<%#rank%>", c_csdn1.rank)
                temp = temp.Replace("<%#ranknum%>", c_csdn1.ranknum)
                temp = temp.Replace("<%#credit%>", c_csdn1.credit)
                temp = temp.Replace("<%#PostDateTime%>", c_csdn1.PostDateTime.ToString)
                temp = temp.Replace("<%#Point%>", c_csdn1.Point.ToString)
                temp = temp.Replace("<%#Content%>", comm.Comm.html(c_csdn1.Content))
                temp = temp.Replace("<%#comm.config.LbFontName%>", "宋体")
                temp = temp.Replace("<%#comm.config.LbFontSize%>", "12")
                sb.Append(temp)
            Next
        Else
            sb.Append(My.Resources.noReplays)
        End If
        sb.Append("<a name=""R""></a>")
        If comm.Comm.CL Is Nothing Then
            sb.Append("<table><tr><td colspan=""5""><center><font color=red>你还没有登录！！</font></center></td></tr></table>")
        Else
            'sb.Append("<iframe style=""width: 620px; height: 420px"" frameborder=""0"" src=""/replay.aspx?id=" & XML.Issue.TopicId & "&title=" & comm.Comm.encode(XML.Issue.TopicName) & """ scrolling=""no""></iframe>")
            '<%#checked%>
            temp = My.Resources.replay
            temp = temp.Replace("<%#tipid%>", XML.Issue.TopicId)
            temp = temp.Replace("<%#tiptitle%>", XML.Issue.TopicName)
            temp = temp.Replace("<%#SIGNING%>", My.Settings.Signing)
            If My.Settings.UseSigning Then
                temp = temp.Replace("<%#checked%>", "block")
                temp = temp.Replace("<%#checked1%>", "checked")
            Else
                temp = temp.Replace("<%#checked%>", "none")
                temp = temp.Replace("<%#checked1%>", "")

            End If
            sb.Append(temp)
        End If

        sb.Append("</body></html>")
        Return sb.ToString
    End Function

#End Region

    Private Sub Msg2Html(ByRef sb As System.Text.StringBuilder, ByVal a As ArrayList)
        If a.Count > 0 Then
            For Each m As Msg In a
                sb.Append("<table border=""1"" cellpadding=""0"" cellspacing=""0"" style=""border-collapse: collapse;table-layout:fixed;word-break:break-all;word-wrap:break-word;"" bordercolor=""#111111"" width=""630"">")
                sb.Append("  <tr>")
                sb.Append("    <td width=""33%"">发送方：" & m.发送方 & "</td>")
                sb.Append("   <td width=""33%"">接收方：" & m.接受方 & "</td>")
                sb.Append("   <td width=""34%"">时间：" & m.发送时间 & "</td>")
                sb.Append("  </tr>")
                sb.Append("  <tr>")
                sb.Append("    <td width=""100%"" colspan=""3"">" & m.内容 & "</td>")
                sb.Append("  </tr>")
                sb.Append("</table>")
                sb.Append("<br>")
            Next
        Else
            sb.Append("没有任何信息。")
        End If
    End Sub

#Region "处理短消息"
    Private Function ProcMsg(ByVal url As String) As String
        Dim msg As New CsdnMsg
        Dim sb As New System.Text.StringBuilder
        sb.Append("<title>短消息</title>")
        sb.Append("<style type=""text/css"">FONT,TD,TR,TABLE,DIV,FORM,BODY { FONT-SIZE: 12px;  LINE-HEIGHT: 19px; FONT-FAMILY: ""宋体""; TEXT-DECORATION: none }</style>")
        Dim a As ArrayList
        '新消息 

        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=""newMessage""><font color=""#FFFFFF""><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.newMessage)
        Msg2Html(sb, a)
        sb.Append("<br>")
        sb.Append("<br>")
        sb.Append("<br>")

        '这里将这些数据标记成已读装状态
        Dim strurl As String = "http://message.csdn.net/ReadMessageFinish.aspx?id="
        For Each m As Msg In a
            strurl += m.编号 & ","
        Next
        If strurl.EndsWith(",") Then
            strurl = strurl.Substring(0, strurl.Length - 1)
        End If
        Dim http As New comm.HttpProc(strurl, comm.Comm.CL)
        http.Proc()

        '非系统消息
        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=""noSystemMessage""><font color=""#FFFFFF""><a href=""#noSystemMessage""><font color=""#FFFFFF"">非系统消息<font></a> <a href=""#MyRecentlyPostMessage""><font color=""#FFFFFF"">我最近的消息<font></a> <a href=""#newMessage""><font color=""#FFFFFF"">新消息<font></a><font></td></tr></table>")
        a = msg.GetNewMsg(msgType.noSystemMessage)
        Msg2Html(sb, a)
        sb.Append("<br>")
        sb.Append("<br>")
        sb.Append("<br>")