Adding Entries (old VB Blog)

   1:  Imports System.IO

   2:  Imports System.Net

   3:  Imports System.Xml

   4:  Imports System.Configuration.ConfigurationManager

   5:  Imports System.Data.SqlClient

   6:   

   7:  Partial Class addentry

   8:      Inherits System.Web.UI.Page

   9:      Shared last As Integer = 1

  10:      Protected Sub page_init(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.PreInit

  11:          ' First, check if this is ad administrator.  If not, send to the error page.

  12:          If Not Roles.IsUserInRole("administrator") Then

  13:              Session("AccessDenied") = True

  14:              FormsAuthentication.SignOut()

  15:        Response.StatusCode = 403

  16:              Response.Redirect("/errorpages/401.aspx?page=AddEntry.aspx")

  17:          End If

  18:      End Sub

  19:      Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

  20:          ' Do some formatting when not posted back.

  21:          If Not IsPostBack Then

  22:              strMessage.Text = "Help : <span class=""code""><span class=""BlueCode"">

                   <</span><span class=""MaroonCode"">photo</span> <span class=""RedCode"">src

                   </span><span class=""BlueCode"">=""Path-To-Image""</span> 

                   <span class=""RedCode"">alt</span><span class=""BlueCode"">=""Some Text""

                   </span> <span class=""RedCode"">href</span><span class=""BlueCode"">

                   =""Path-To-Link""</span> <span class=""RedCode"">id</span>

                   <span class=""BlueCode"">=""Number""/></span></span>"

  23:              strMessage.Text &= " <a href=""/template.html"" target=""_blank"">Moillo Template</a><br/>"

  24:              objTitle.Text = "Title"

  25:              objTitle.Visible = True

  26:              objEntry.Text = "Entry"

  27:              objEntry.Visible = True

  28:              If Request.QueryString("a") = "2" Then

  29:                  strMessage.Text = ""

  30:                  ClickPings()

  31:              End If

  32:          End If

  33:      End Sub

  34:      Protected Sub PostBlog(ByVal sender As Object, ByVal e As System.EventArgs) Handles SubmitButton.Click

  35:          ' This is the action when the save button is clicked.  

  36:          ' PostEntry() handles the database.  GenerateTheXMLFeed does what it says on the cover.

  37:          ' After saving, activate a half second timer that pings the aggregators on each tick.

  38:          Trace.Warn("Button clicked")

  39:          If PostEntry() = True Then

  40:              ' Entry is posted ok, parse display stuff.

  41:              objTitle.Visible = False

  42:              objEntry.Visible = False

  43:              strTitle.Visible = False

  44:              strBlog.Visible = False

  45:              Response.Flush()

  46:              SubmitButton.Visible = False

  47:              SubmitButton.Enabled = False

  48:              Trace.Warn("Entry Posted")

  49:              strMessage.Text &= "<br/>" & LPC.Functions.GenerateTheXMLFeed()

  50:              Response.Flush()

  51:              Timer1.Enabled = True

  52:          End If

  53:      End Sub

  54:      Protected Function PostEntry() As Boolean

  55:          Dim Title, Blog As String

  56:          Dim sqlConn As ConnectionStringSettings

  57:          sqlConn = ConnectionStrings("SQLServer")

  58:          Dim objConn As New SqlConnection(sqlConn.ConnectionString)

  59:          objConn.Open()

  60:          Dim objCmd As New SqlCommand("AddBlogEntry")

  61:          objCmd.CommandType = Data.CommandType.StoredProcedure

  62:          objCmd.Connection = objConn

  63:          Title = LPC.Functions.TextToDB(strTitle.Text)

  64:          Blog = LPC.Functions.TextToDB(strBlog.Text)

  65:          objCmd.Parameters.Add("@Title", Data.SqlDbType.VarChar)

  66:          objCmd.Parameters("@Title").Value = Title

  67:          objCmd.Parameters.Add("@Text", Data.SqlDbType.NText)

  68:          objCmd.Parameters("@Text").Value = Blog

  69:          objCmd.Parameters.Add("@Guid", Data.SqlDbType.UniqueIdentifier)

  70:          objCmd.Parameters("@Guid").Value = System.Guid.NewGuid

  71:          objCmd.Parameters.Add("@PostType", Data.SqlDbType.Int)

  72:          objCmd.Parameters("@PostType").Value = 1

  73:          objCmd.Parameters.Add("@PostTime", Data.SqlDbType.SmallDateTime)

  74:          objCmd.Parameters("@PostTime").Value = Now.ToUniversalTime

  75:          Try

  76:              objCmd.ExecuteNonQuery()

  77:              strMessage.Text &= "Entry Added"

  78:              Return True

  79:          Catch ex As Exception

  80:              strMessage.Text = "Error posting data : " & ex.Message

  81:              Return False

  82:          Finally

  83:              objConn.Close()

  84:          End Try

  85:      End Function

  86:      Protected Sub Timer1_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles Timer1.Tick

  87:          Select Case last

  88:              Case 1

  89:                  PingSite("Weblogs.com", "http://rpc.weblogs.com/RPC2")

  90:              Case 2

  91:                  PingSite("Technorati", "http://rpc.technorati.com/rpc/ping")

  92:              Case 3

  93:                  PingSite("Feedster", "http://api.feedster.com/ping")

  94:              Case 4

  95:                  PingSite("FeedBurner", "http://ping.feedburner.com")

  96:              Case 5

  97:                  PingSite("Goo.Ne.Jp", "http://blog.goo.ne.jp/XMLRPC")

  98:              Case 6

  99:                  PingSite("Yahoo!", "http://ping.feeds.yahoo.com/RPC2/")

 100:              Case 7

 101:                  PingSite("Bloggers.jp", "http://ping.bloggers.jp/rpc/")

 102:              Case 8

 103:                  PingSite("Syndic8", "http://ping.syndic8.com/xmlrpc.php")

 104:              Case 9

 105:                  PingSite("BlogRolling", "http://rpc.blogrolling.com/pinger/")

 106:              Case 10

 107:                  PingSite("WeblogAlot", "http://ping.weblogalot.com/rpc.php")

 108:              Case 11

 109:                  PingSite("Moreover", "http://api.moreover.com/RPC2")

 110:              Case 12

 111:                  PingSite("BlogFlux", "http://pinger.blogflux.com/rpc")

 112:              Case 13

 113:                  PingSite("Twingly", "http://rpc.twingly.com/")

 114:              Case Else

 115:                  strMessage.Text &= "Completed.<br/>"

 116:                  Timer1.Enabled = False

 117:          End Select

 118:      End Sub

 119:      Sub PingSite(ByVal SiteName As String, ByVal SiteURL As String)

 120:          Dim blogURL As String = "http://davewhite.net"

 121:          Dim blogName As String = "Long Pink Cake"

 122:          Dim pingResult As String = ""

 123:          Try

 124:              Dim oldMessage As String

 125:              strMessage.Text &= "Pinging " & SiteName & " : "

 126:              oldMessage = strMessage.Text

 127:              Dim technoratiPing As HttpWebRequest = CType(WebRequest.Create(SiteURL), HttpWebRequest)

 128:              technoratiPing.Method = "POST"

 129:              technoratiPing.ContentType = "text/xml"

 130:              Dim streamPingRequest As Stream = CType(technoratiPing.GetRequestStream, Stream)

 131:              Dim xmlPing As XmlTextWriter = New XmlTextWriter(streamPingRequest, System.Text.Encoding.UTF8)

 132:              xmlPing.WriteStartDocument()

 133:              xmlPing.WriteStartElement("methodCall")

 134:              xmlPing.WriteElementString("methodName", "weblogUpdates.ping")

 135:              xmlPing.WriteStartElement("params")

 136:              xmlPing.WriteStartElement("param")

 137:              xmlPing.WriteElementString("value", blogName)

 138:              xmlPing.WriteEndElement()

 139:              xmlPing.WriteStartElement("param")

 140:              xmlPing.WriteElementString("value", blogURL)

 141:              xmlPing.WriteEndElement()

 142:              xmlPing.WriteEndElement()

 143:              xmlPing.WriteEndElement()

 144:              xmlPing.Close()

 145:              Dim technoratiPingResponse As HttpWebResponse = CType(technoratiPing.GetResponse, HttpWebResponse)

 146:              Dim streamPingResponse As StreamReader = New StreamReader(technoratiPingResponse.GetResponseStream)

 147:              Dim strResult As String = streamPingResponse.ReadToEnd

 148:              streamPingResponse.Close()

 149:              technoratiPingResponse.Close()

 150:              strMessage.Text = oldMessage & "Done.<br/>"

 151:          Catch ex As Exception

 152:              strMessage.Text &= "Error : " & ex.Message & "<br/>"

 153:          Finally

 154:              last = last + 1

 155:          End Try

 156:      End Sub

 157:      Protected Sub PingButton_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles PingButton.Click

 158:          ClickPings()

 159:      End Sub

 160:      Protected Sub ClickPings()

 161:          objTitle.Visible = False

 162:          objEntry.Visible = False

 163:          strTitle.Visible = False

 164:          strBlog.Visible = False

 165:          Response.Flush()

 166:          SubmitButton.Visible = False

 167:          SubmitButton.Enabled = False

 168:          strMessage.Text &= "<br/>" & LPC.Functions.GenerateTheXMLFeed()

 169:          Response.Flush()

 170:          Timer1.Enabled = True

 171:      End Sub

 172:  End Class