notifications.vb

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

          "ProductsQnService", Int32.MaxValue)
        'Attach the notification to the command
        cmdRequest.Notification = snrProds
        Try
            'Register 
            cnNwind.Open()
            Dim rdrProds As SqlDataReader = cmdRequest.ExecuteReader
            rdrProds.Close()
            cnNwind.Close()
        Catch exc As Exception
            MsgBox(exc.Message, MsgBoxStyle.Exclamation, "Error Creating SqlNotificationRequest")
        Finally
            cnNwind.Close()
        End Try
    End Sub

    Private Sub btnPollNotifications_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnPollNotifications.Click
        PollNotifications(False)
    End Sub

    Private Function PollNotifications(ByVal blnSilent As Boolean) As Integer
        'Poll the ProductsQnQueue for changes
        Dim intRetValue As Integer
        Dim strPollSQL As String = "RECEIVE CAST(message_body AS XML) AS " + _
         "ProductsQnMessage FROM ProductsQnQueue; "
        Dim strProdsMessage As String = Nothing
        Dim strMsg As String = Nothing
        If cnNwind Is Nothing Then
            cnNwind = New SqlConnection(My.Settings.NorthwindConnection)
        End If
        Dim cmdPoll As New SqlCommand(strPollSQL, cnNwind)
        Try
            cnNwind.Open()
            Dim rdrPoll As SqlDataReader = cmdPoll.ExecuteReader
            If rdrPoll.HasRows Then
                'Queue has message(s)
                While rdrPoll.Read()
                    strProdsMessage += "Message: " + rdrPoll(0).ToString + vbCrLf + vbCrLf
                End While
                strMsg = "ProductsQnQueue has changes. " + _
                 "Click Refresh Data to update the Products lookup table." + _
                 vbCrLf + vbCrLf + Replace(strProdsMessage, "><", ">" + vbCrLf + "<")
                cnNwind.Close()
                If Not ListSubscriptions(True) Then
                    'Don't add duplicate notification requests
                    AddSqlNotificationRequest()
                End If
                intRetValue = 1
                MsgBox(strMsg, MsgBoxStyle.Information, "Polling ProductsQnQueue")
            Else
                intRetValue = 0
                strMsg = "ProductsQnQueue is empty, or notification has expired or was deleted."
                If Not blnSilent Then
                    MsgBox(strMsg, MsgBoxStyle.Information, "Polling ProductsQnQueue")
                End If
            End If
            cnNwind.Close()
            Return intRetValue
        Catch exc As Exception
            If Not blnSilent Then
                strMsg = exc.Message
                If exc.Message.Contains("Invalid object") Then
                    strMsg += vbCrLf + vbCrLf + "Click Add SqlNotification Objects to create the queue and service."
                End If
                MsgBox(strMsg, MsgBoxStyle.Exclamation, "Error Polling ProductsQnQueue")
            End If
            'btnCreateQueues.Text = "&Add SqlNotification Objects"
            Return -1 'Error
        Finally
            cnNwind.Close()
            cmdPoll.Dispose()
        End Try
    End Function

    '************************
    'Refresh and save DataSet
    '************************

    Private Sub btnRefresh_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnRefresh.Click
        RefreshProducts(True, True)
    End Sub

    Private Sub RefreshProducts(ByVal blnTest As Boolean, ByVal blnSendDbMail As Boolean)
        'Refill the TableAdapter and save current data
        'If blnTest = True, check for low inventory and mark DataGridView cells
        'Change the following to a valid email address to receive messages
        'Dim strToEmail As String = "[e-mail]"
        Dim strToEmail As String = "[e-mail]"
        Dim alReorders As New ArrayList
        Dim alMsgBodies As New ArrayList
        Dim alMessages As New ArrayList
        Me.Cursor = Cursors.WaitCursor
        Try
            ProductsTableAdapter.Fill(NorthwindDataSet.Products)
            NorthwindDataSet.WriteXml(strProductsFile, XmlWriteMode.DiffGram)
            btnSaveChanges.Enabled = False
            If blnTest Then
                'Test for low inventory items
                Dim strMsg As String = Nothing
                Dim strBody As String = Nothing
                Dim strSubject As String = Nothing
                With ProductsBindingSource
                    .MoveFirst()
                    Dim intRow As Integer
                    Dim intFirstRow As Integer = Int32.MaxValue
                    Dim drvItem As DataRowView
                    Dim drSupplier As DataRow()
                    ProductsDataGridView.SuspendLayout()
                    alReorders.Clear()
                    alMsgBodies.Clear()
                    alMessages.Clear()
                    For intRow = 0 To .Count - 1
                        drvItem = CType(.Item(intRow), DataRowView)
                        With drvItem
                            If .Item(6) + .Item(7) - .Item(8) <= 0 Then
                                strMsg += "ProductID " + .Item(0).ToString + " '" + .Item(1).ToString + _
                                 "' requires reorder of " + .Item(8).ToString + " units "

                                Dim strQuan As String = Nothing
                                If .Item(8).ToString = "0" Then
                                    'Default reorder quantity
                                    strQuan = "10"
                                Else
                                    strQuan = .Item(8).ToString
                                End If

                                'Simulate an OrderID
                                Dim strOrderID As String = Now.Year.ToString + Now.Month.ToString + _
                                 Now.Day.ToString + intRow.ToString

                                'Create the DbMail body text
                                strBody = "Please enter our order number " + _
                                strOrderID + " for " + strQuan + " each " + _
                                Replace(.Item(1).ToString, "'", "") + " (" + .Item(4).ToString + _
                                ") and ship immediately by Speedy Express. Northwind standard terms apply." + _
                                 vbCrLf + vbCrLf + "Please acknowledge this order immediately. " + _
                                "Confirmation will follow by postal mail."

                                'Get the supplier data
                                drSupplier = NorthwindDataSet.Suppliers.Select("SupplierID = " + _
                                 drvItem.Item(2).ToString)
                                If drSupplier.Length = 1 Then
                                    With drSupplier(0)
                                        strMsg += "from SupplierID " + .Item(0).ToString + _
                                         " '" + .Item(1).ToString + "'." + vbCrLf + vbCrLf

                                        'Add to the body text
                                        strBody = "To:  " + Replace(.Item(1).ToString, "'", "") + vbCrLf + _
                                         "Att: " + Replace(.Item(2).ToString, "'", "") + ", " + _
                                         .Item(3).ToString + vbCrLf + vbCrLf + strBody + _
                                         vbCrLf + vbCrLf + "Jose Santiago, Purchasing Agent" + _
                                         vbCrLf + "[e-mail]"

                                        'Create the reorder DbMail command text
                                        'An EXECUTE command is used here for clarity (and brevity)
                                        'The SendReordersByDbMail procedure adds parameters to the command
                                        strSubject = "Northwind Traders Purchase Order for " + _
                                           Replace(drvItem.Item(1).ToString, "'", "")
                                        Dim strReorder As String = "EXECUTE dbo.sp_send_dbmail " + _
                                         "@profile_name = 'NorthwindSuppliers', " + _
                                         "@recipients = '" + strToEmail + "', " + _
                                         "@subject = '" + strSubject + "', " + _
                                         "@body = '" + strBody + "', " + _
                                         "@body_format = 'TEXT', " + _
                                         "@importance = 'HIGH'"

                                        'Add the command text to the ArrayList
                                        alReorders.Add(strReorder)
                                        alMsgBodies.Add(strBody)

                                        'Add the message details to the ArrayList
                                        Dim objReorder As New clsReorder
                                        With objReorder
                                            .ToEmail = strToEmail
                                            .Subject = strSubject
                                            .Body = strBody
                                        End With
                                        alMessages.Add(objReorder)
                                    End With
                                End If
                                With ProductsDataGridView
                                    'Change to yellow background
                                    .Rows(intRow).Cells(1).Style.BackColor = Color.Yellow
                                    .Rows(intRow).Cells(6).Style.BackColor = Color.Yellow
                                End With
                                If intFirstRow = Int32.MaxValue Then
                                    intFirstRow = intRow
                                End If
                            Else
                                With ProductsDataGridView
                                    'White background
                                    .Rows(intRow).Cells(1).Style.BackColor = Color.White
                                    .Rows(intRow).Cells(6).Style.BackColor = Color.White
                                End With
                            End If
                        End With
                        .MoveNext()
                    Next
                    If intFirstRow = Int32.MaxValue Then
                        .MoveFirst()
                    Else
                        .Position = intFirstRow
                    End If
                    ProductsDataGridView.ResumeLayout()

                    If alReorders.Count > 0 And chkSendMessages.Checked Then
                        If chkSendDbMail.Checked Then
                            'Process automated reorders with DbMail
                            SendReordersByDbMail(alReorders, alMessages, strMsg)
                        Else
                            'Process automated reorders with SmptClient
                            SendReordersBySMTP(alMessages, strMsg)
                        End If
                    End If
                End With
            End If
        Catch exc As Exception
            Me.Cursor = Cursors.Default
            MsgBox(exc.Message, MsgBoxStyle.Exclamation, "DataSet Refresh Operation Failed")
        Finally
            Me.Cursor = Cursors.Default
            cnNwind.Close()
        End Try
    End Sub

    Private Sub SendReordersByDbMail(ByVal alReorders As ArrayList, ByVal alMessages As ArrayList, ByVal strMsg As String)
        'If set up, use DbMail to send messages with test for duplicates
        Dim rdrTest As SqlDataReader = Nothing
        Dim cmdReorder As SqlCommand = Nothing
        Dim strToEmail As String = Nothing
        Dim strSubject As String = Nothing
        Dim strBody As String = Nothing
        Try
            Dim strMailSQL As String = "SELECT COUNT(*) FROM dbo.sysmail_mailitems"
            Dim cmdTestMail As New SqlCommand(strMailSQL, cnNwind)