notifications.vb

来自「wrox出版社的另一套经典的VB2005数据库编程学习书籍,收集了书中源码,郑重」· VB 代码 · 共 939 行 · 第 1/4 页

            cnNwind.Open()
            'Following throws an exception if DbMail isn't installed
            Dim intMailCount As Integer = CType(cmdTestMail.ExecuteScalar(), Integer)
            cnNwind.Close()
            strMsg += "Send automated reorders by DbMail?"
            If MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, _
             "Products with Units in Stock below Reorder Level") = MsgBoxResult.Yes Then
                Dim intReorder As Integer
                Dim intSent As Integer
                Dim bytStatus As Byte
                Dim datSent As DateTime
                Dim strDupSubject As String = Nothing
                Dim strDupBody As String = Nothing
                cnNwind.Open()
                For intReorder = 0 To alReorders.Count - 1
                    Dim blnUseParams As Boolean = True
                    If blnUseParams Then
                        'Create the parameterized command
                        strToEmail = alMessages(intReorder).ToEmail
                        strSubject = alMessages(intReorder).Subject
                        strBody = alMessages(intReorder).Body
                        cmdReorder = New SqlCommand("dbo.sp_send_dbmail", cnNwind)
                        With cmdReorder
                            .CommandType = CommandType.StoredProcedure
                            .Parameters.AddWithValue("@profile_name", "NorthwindSuppliers")
                            .Parameters.AddWithValue("@recipients", strToEmail)
                            .Parameters.AddWithValue("@subject", strSubject)
                            .Parameters.AddWithValue("@body", strBody)
                            .Parameters.AddWithValue("@body_format", "TEXT")
                            .Parameters.AddWithValue("@importance", "HIGH")
                            Dim prmRetVal As New SqlParameter("RETURN_VALUE", SqlDbType.Int)
                            prmRetVal.Direction = ParameterDirection.ReturnValue
                            .Parameters.Add(prmRetVal)
                        End With
                    Else
                        'Create the EXECUTE command
                        cmdReorder = New SqlCommand(alReorders(intReorder).ToString, cnNwind)
                    End If

                    Dim blnDateIsNull As Boolean
                    'Test for duplicate messages (dependent on same purchase order number)
                    Dim strTestSQL As String = "SELECT sent_status, sent_date, " + _
                    "subject, body FROM dbo.sysmail_mailitems " + _
                    "WHERE body = '" + alMessages(intReorder).Body + "'"
                    Dim cmdTest As New SqlCommand(strTestSQL, cnNwind)
                    Dim blnHasRows As Boolean
                    rdrTest = cmdTest.ExecuteReader
                    With rdrTest
                        If .HasRows Then
                            blnHasRows = True
                            'Get the last duplicate
                            While .Read
                                bytStatus = .GetByte(0)
                                If .Item(1) Is DBNull.Value Then
                                    blnDateIsNull = True
                                Else
                                    datSent = .GetDateTime(1)
                                End If
                                strDupSubject = .GetString(2)
                                strDupBody = .GetString(3)
                            End While
                        End If
                        .Close()
                    End With
                    If blnHasRows Then
                        Dim strStatus As String = "A duplicate of this message "
                        If bytStatus = 0 Then
                            strStatus += "was pending"
                        ElseIf bytStatus = 1 Then
                            strStatus += "was sent to the e-mail server"
                        Else
                            strStatus += "failed delivery to the e-mail server"
                        End If
                        If Not blnDateIsNull Then
                            strStatus += " on " + datSent.ToShortDateString
                            strStatus += " at " + datSent.ToShortTimeString
                        End If
                        strStatus += "." + vbCrLf + vbCrLf
                        strStatus += "Subject: " + strDupSubject + vbCrLf + vbCrLf
                        strStatus += strDupBody + vbCrLf + vbCrLf
                        strStatus += "Do you want to resend this reorder?"
                        If MsgBox(strStatus, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, "Duplicate Reorder Message Found") = MsgBoxResult.Yes Then
                            intSent += cmdReorder.ExecuteNonQuery
                        End If
                    Else
                        intSent += cmdReorder.ExecuteNonQuery
                    End If
                    If blnUseParams Then
                        'Returns 1 if an error
                        Dim intRetVal As Integer = cmdReorder.Parameters("RETURN_VALUE").Value
                    End If
                Next
                cnNwind.Close()
                If intSent < 0 Then
                    strSubject = alMessages(alMessages.Count - 1).Subject
                    strBody = alMessages(alMessages.Count - 1).Body
                    strMsg = (-intSent).ToString + " messages sent by DbMail. Last message:" + vbCrLf + vbCrLf
                    strMsg += "Subject: " + strSubject + vbCrLf + vbCrLf + strBody
                Else
                    strMsg = "No messages were sent by DbMail"
                End If
                MsgBox(strMsg, MsgBoxStyle.Information, "Automated Reorder Message Report - DbMail")
            Else
                strSubject = alMessages(alMessages.Count - 1).Subject
                strBody = alMessages(alMessages.Count - 1).Body
                strMsg = "No messages were sent by DbMail. Last message would have been:" + vbCrLf + vbCrLf
                strMsg += "Subject: " + strSubject + vbCrLf + vbCrLf + strBody
                MsgBox(strMsg, MsgBoxStyle.Information, "Automated Reorder Messages Canceled")
            End If
        Catch excMail As Exception
            If excMail.Message.Contains("Invalid object name") Then
                'DbMail isn't installed
                cnNwind.Close()
                strMsg += "(Can't mail reorder messages because DbMail isn't installed.)"
                strMsg += vbCrLf + vbCrLf + "Display last message details?"
                If MsgBox(strMsg, MsgBoxStyle.Exclamation Or MsgBoxStyle.YesNo, _
                "Products with Units in Stock below Reorder Level") = MsgBoxResult.Yes Then
                    strSubject = alMessages(alMessages.Count - 1).Subject
                    strBody = alMessages(alMessages.Count - 1).Body
                    strMsg = "No messages sent by DbMail. Last message would be:" + vbCrLf + vbCrLf
                    strMsg += "Subject: " + strSubject + vbCrLf + vbCrLf + strBody
                    MsgBox(strMsg, MsgBoxStyle.Information, "Emulated Automated Reorder Message Report")
                End If
            Else
                MsgBox(excMail.Message, MsgBoxStyle.Exclamation, "DbMail Error")
            End If
        Finally
            If rdrTest IsNot Nothing Then
                rdrTest.Close()
            End If
            If cmdReorder IsNot Nothing Then
                cmdReorder.Dispose()
            End If
            cnNwind.Close()
        End Try
    End Sub

    Private Sub SendReordersBySMTP(ByVal alMessages As ArrayList, ByVal strMsg As String)
        'Emulate DbMail with the SmtpClient object

        'Replace these values with those for your e-mail provider
        'Dim strHost As String = "smtp.mail.somewhere.com"
        Dim strHost As String = "smtp.sbcglobal.yahoo.com"
        'Dim strFromEmail As String = "[e-mail]"
        Dim strFromEmail As String = "[e-mail]"
        'Dim strPassword As String = "somewhere"
        Dim strPassword As String = "safegate"

        Dim strToEmail As String = Nothing
        Dim strSubject As String = Nothing
        Dim strBody As String = Nothing

        strMsg += "Send automated reorders to SMTP host with SmtpClient?"
        If MsgBox(strMsg, MsgBoxStyle.Question Or MsgBoxStyle.YesNo, _
         "Products with Units in Stock below Reorder Level") = MsgBoxResult.Yes Then
            Try
                'Create an SmtpClient
                Dim cliReorder As New SmtpClient("smtp.sbcglobal.yahoo.com")
                'If host uses Windows authentication, uncomment below
                'cliReorder.UseDefaultCredentials = True
                'Otherwise add mail provider authentication credentials
                Dim crdHost As New NetworkCredential(strFromEmail, strPassword)
                cliReorder.Credentials = crdHost

                Dim intCtr As Integer
                For intCtr = 0 To alMessages.Count - 1
                    'Create the MailMessage
                    strToEmail = alMessages(intCtr).ToEmail
                    strSubject = alMessages(intCtr).Subject
                    strBody = alMessages(intCtr).Body
                    Dim msgReorder As New MailMessage(strFromEmail, strToEmail, strSubject, strBody)
                    'Send the message
                    cliReorder.Send(msgReorder)
                Next
                If intCtr > 0 Then
                    strMsg = intCtr.ToString + " messages sent to SMTP host. Last message:" + vbCrLf + vbCrLf
                    strMsg += "Subject: " + strSubject + vbCrLf + vbCrLf + strBody
                Else
                    strMsg = "No messages were sent to SMTP host."
                End If
                MsgBox(strMsg, MsgBoxStyle.Information, "Automated Reorder Message Report - SMTP")
            Catch excMail As Exception
                MsgBox(excMail.Message, MsgBoxStyle.Exclamation, "SmtpClient Error")
            End Try
        Else
            strSubject = alMessages(alMessages.Count - 1).Subject
            strBody = alMessages(alMessages.Count - 1).Body
            strMsg = "No messages sent to SMTP host. Last message would have been:" + vbCrLf + vbCrLf
            strMsg += "Subject: " + strSubject + vbCrLf + vbCrLf + strBody
            MsgBox(strMsg, MsgBoxStyle.Information, "Emulated Automated Reorder Message Report - SMTP")
        End If
    End Sub

    Private Sub OriginalSendReordersBySMTP(ByVal strToEmail As String, ByVal strSubject As String, ByVal strBody As String)
        'Emulate DbMail with the SmtpClient object
        Try
            Dim strFromEmail As String = "[e-mail]"
            Dim strPassword As String = "your_password"
            Dim strHost As String = "smtp.your_provider.com"
            'Create a MailMessage
            Dim msgReorder As New MailMessage(strFromEmail, strToEmail, strSubject, strBody)
            'Create an SmtpClient
            Dim cliReorder As New SmtpClient(strHost)
            'Add mail provider authentication credentials
            Dim crdHost As New NetworkCredential(strFromEmail, strPassword)
            cliReorder.Credentials = crdHost
            'Send the message
            cliReorder.Send(msgReorder)
        Catch exc As Exception
            MsgBox(exc.Message)
        End Try
    End Sub

    Private Class clsReorder
        'For SMTP mail
        Public ToEmail As String
        Public Subject As String
        Public Body As String
    End Class

    Private Sub frmNotifications_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        'Save the current data before closing
        NorthwindDataSet.WriteXml(strProductsFile, XmlWriteMode.DiffGram)
    End Sub

    Private Sub chkSendMessages_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles chkSendMessages.CheckedChanged
        If chkSendMessages.Checked Then
            chkSendDbMail.Enabled = True
        Else
            chkSendDbMail.Enabled = False
        End If
    End Sub
End Class