write.aspx.vb

毕业设计时做的,一个管理关于污染管理的, 源代码,呵呵 想想当时还真厉害,可以实现污染检测

Imports System
Imports System.IO
Imports System.ComponentModel
Imports System.Data
Imports System.Data.OleDb
Imports System.Web
Imports System.Web.SessionState
Imports System.Web.UI
Imports System.Web.UI.WebControls
Imports System.Configuration
Imports Microsoft.VisualBasic

Public Class write
    Inherits System.Web.UI.Page
    Protected WithEvents name As System.Web.UI.WebControls.TextBox
    Protected WithEvents email As System.Web.UI.WebControls.TextBox
    Protected WithEvents qq As System.Web.UI.WebControls.TextBox
    Protected WithEvents homepage As System.Web.UI.WebControls.TextBox
    Protected WithEvents title As System.Web.UI.WebControls.TextBox
    Protected WithEvents thetext As System.Web.UI.WebControls.TextBox
    Protected WithEvents gg As System.Web.UI.WebControls.RadioButton
    Protected WithEvents mm As System.Web.UI.WebControls.RadioButton
    Protected WithEvents face As System.Web.UI.WebControls.DropDownList
    Protected WithEvents Button1 As System.Web.UI.WebControls.Button

#Region " Web 窗体设计器生成的代码 "

    '该调用是 Web 窗体设计器所必需的。
    <System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()

    End Sub

    Private Sub Page_Init(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Init
        'CODEGEN: 此方法调用是 Web 窗体设计器所必需的
        '不要使用代码编辑器修改它。
        InitializeComponent()
    End Sub

#End Region

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        Dim PostTime As String, cie As HttpCookie
        cie = Request.Cookies("rwfj")
        If Not (cie Is Nothing) Then
            PostTime = cie.Values("PostTime")
            If PostTime <> "" Then
                If DateDiff(DateInterval.Second, CType(PostTime, Date), Date.Now) < Int(ConfigurationSettings.AppSettings("发帖间隔")) Then Response.Redirect("info.aspx?ID=6,")
            End If
        End If
        Dim FoundErr As Boolean = False, ID As String, iface As String
        Dim iname As String, iemail As String, iqq As String, ihp As String, ititle As String, itext As String, sex As String
        iname = Server.HtmlEncode(Trim(name.Text))
        iemail = Server.HtmlEncode(Trim(email.Text))
        iqq = Trim(qq.Text)
        ihp = Server.HtmlEncode(Trim(homepage.Text))
        ititle = Server.HtmlEncode(Trim(title.Text))
        itext = Trim(thetext.Text)
        iface = Server.HtmlEncode(Trim(face.SelectedItem.Value))
        If iname.Length < 1 Then
            FoundErr = True
            ID += "1,"
        ElseIf Session("name") <> ConfigurationSettings.AppSettings("站长") And iname = ConfigurationSettings.AppSettings("站长") Then
            FoundErr = True
            ID += "3,"
        End If
        If itext.Length < 1 Then
            FoundErr = True
            ID += "2,"
        End If
        If iemail.Length > 0 And (InStr(iemail, "@") = 0 Or InStr(iemail, ".") = 0 Or iemail.Length < 7) Then
            FoundErr = True
            ID += "4,"
        End If
        If iqq.Length > 0 And (iqq.Length < 5 Or IsNumeric(iqq) = False) Then
            FoundErr = True
            ID += "5,"
        End If
        If FoundErr = True Then Response.Redirect("info.aspx?ID=" + ID)
        If UCase(ConfigurationSettings.AppSettings("允许HTML")) = "NO" Then
            itext = Server.HtmlEncode(itext)
        End If
        If mm.Checked = True Then
            sex = "美女"
        Else
            sex = "帅哥"
        End If
        If iname.Length > 20 Then iname = Left(iname, 20)
        If iemail.Length < 1 Then iemail = "(保密)"
        If iemail.Length > 50 Then iemail = Left(iemail, 50)
        If iqq.Length < 1 Then iqq = "(保密)"
        If iqq.Length > 15 Then iqq = Left(iqq, 15)
        If ihp.Length < 1 Then ihp = "(保密)"
        If ihp.Length > 100 Then ihp = Left(ihp, 100)
        If ititle.Length < 1 Then ititle = "(无标题)"
        If ititle.Length > 40 Then ititle = Left(ititle, 40)
        If iface.Length > 50 Then iface = Left(iface, 50)
        itext = Trim(itext)
        itext = "&nbsp;&nbsp;" + itext + "&nbsp;&nbsp;"
        itext = Replace(itext, vbCrLf, "<br>&nbsp;&nbsp;")
        If itext.Length > Int(ConfigurationSettings.AppSettings("留言长度限制")) Then itext = Left(itext, Int(ConfigurationSettings.AppSettings("留言长度限制")))
        Dim conn As OleDbConnection, comd As OleDbCommand
        conn = New OleDbConnection("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(ConfigurationSettings.AppSettings("数据库")))
        comd = New OleDbCommand("Insert into 留言(标题,作者,内容,性别,主页,信箱,QQ,IP,头像) Values(@p1,@p2,@p3,@p4,@p5,@p6,@p7,@p8,@p9)", conn)
        With comd.Parameters
            .Add(New OleDbParameter("@p1", OleDbType.Char))
            .Add(New OleDbParameter("@p2", OleDbType.Char))
            .Add(New OleDbParameter("@p3", OleDbType.Char))
            .Add(New OleDbParameter("@p4", OleDbType.Char))
            .Add(New OleDbParameter("@p5", OleDbType.Char))
            .Add(New OleDbParameter("@p6", OleDbType.Char))
            .Add(New OleDbParameter("@p7", OleDbType.Char))
            .Add(New OleDbParameter("@p8", OleDbType.Char))
            .Add(New OleDbParameter("@p9", OleDbType.Char))
        End With
        comd.Parameters("@p1").Value = ititle
        comd.Parameters("@p2").Value = iname
        comd.Parameters("@p3").Value = itext
        comd.Parameters("@p4").Value = sex
        comd.Parameters("@p5").Value = ihp
        comd.Parameters("@p6").Value = iemail
        comd.Parameters("@p7").Value = iqq
        comd.Parameters("@p8").Value = Request.ServerVariables("REMOTE_ADDR")
        comd.Parameters("@p9").Value = iface
        comd.Connection.Open()
        comd.ExecuteNonQuery()
        comd.Connection.Close()
        comd.Dispose()
        conn.Close()
        conn.Dispose()
        Dim ds As DataSet, TheTime As Date
        ds = New DataSet()
        ds.ReadXml(Server.MapPath("data/count.xml"))
        TheTime = CType(ds.Tables(0).Rows(0)(4), Date)
        If DateValue(TheTime) = DateValue(Date.Now) Then
            ds.Tables(0).Rows(0)(0) = Int(ds.Tables(0).Rows(0)(0)) + 1
        Else
            ds.Tables(0).Rows(0)(0) = 1
        End If
        ds.Tables(0).Rows(0)(2) = Int(ds.Tables(0).Rows(0)(2)) + 1
        ds.Tables(0).Rows(0)(4) = Date.Now
        ds.AcceptChanges()
        ds.WriteXml(Server.MapPath("data/count.xml"))
        ds.Dispose()
        cie = New HttpCookie("rwfj")
        cie.Values.Add("PostTime", Date.Now.ToString)
        cie.Values.Add("name", "guest")
        Response.AppendCookie(cie)
        Response.Redirect("default.aspx")
    End Sub

    Private Sub Page_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        If Not IsPostBack Then
            Dim dir As Directory, fs As String(), i As Integer
            fs = dir.GetFiles(Server.MapPath("face\"))
            For i = 0 To UBound(fs)
                fs(i) = Replace(fs(i), Server.MapPath("face\"), "")
            Next
            face.DataSource = fs
            face.DataBind()
        End If
    End Sub

End Class