ordersxml.vb

wrox出版社的另一套经典的VB2005数据库编程学习书籍,收集了书中源码,郑重推荐,电子书,电子书下载

				chkOrderXML2Index.Checked = False
				If blnSalesOrders Then
					txtOrderSQL.Text = DropXmlSchemaCollection("SalesOrders", "OrderXML1")
					txtOrderSQL.Text += DropXmlSchemaCollection("SalesOrders", "OrderXML2")
				Else
					txtOrderSQL.Text = DropXmlSchemaCollection("Orders", "OrderXML1")
					txtOrderSQL.Text += DropXmlSchemaCollection("Orders", "OrderXML2")
				End If
				strSQL += "DROP COLUMN OrderXML1, OrderXML2; "
			End If
			txtOrderSQL.Text += strSQL
			cmNwind.CommandText = strSQL
			cnNwind.Open()
			Dim intRetVal As Integer = cmNwind.ExecuteNonQuery
			If intRetVal = -1 Then
				txtOrderData.Text = ""
				If blnCreate Then
					OrdersControlState(True)
					btnOrderCols.Text = "Drop xml Columns"
					intXML1Start = GetMinXMLOrderID(False)
				Else
					OrdersControlState(False)
					btnOrderCols.Enabled = True
					btnOrderCols.Text = "Add xml Columns"
				End If
			Else
				'Error
			End If
			cnNwind.Close()
			blnBypassHandler = False
		Catch exc As Exception
			If exc.Message.Contains("failed") Then
				btnOrderCols.Text = "Add xml Columns"
				txtOrdersXQResult.Text = "Click Add xml Columns to correct the problem"
			Else
				txtOrdersXQResult.Text = exc.Message
			End If
		Finally
			cnNwind.Close()
		End Try
	End Sub

	Private Sub OrdersControlState(ByVal blnEnabled As Boolean)
		'Disable controls curing fill
		btnOrderCols.Enabled = blnEnabled
		chkUseSalesOrders.Enabled = blnEnabled
		chkUseXmlWriter.Enabled = blnEnabled
		btnFillOrderXML1.Enabled = blnEnabled
		btnFillOrderXML2.Enabled = blnEnabled
		chkOrderXML1Schema.Enabled = blnEnabled
		chkOrderXML2Schema.Enabled = blnEnabled
		chkOrderXML1Index.Enabled = blnEnabled
		chkOrderXML1IndexPath.Enabled = blnEnabled
		chkOrderXML1IndexValue.Enabled = blnEnabled
		chkOrderXML1IndexProp.Enabled = blnEnabled
		chkOrderXML2Index.Enabled = blnEnabled
		chkOrderXML2IndexPath.Enabled = blnEnabled
		chkOrderXML2IndexValue.Enabled = blnEnabled
		chkOrderXML2IndexProp.Enabled = blnEnabled
	End Sub

	Private Sub btnFillOrderXML1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnFillOrderXML1.Click
		'False to get document generation baseline time

		Me.Cursor = Cursors.WaitCursor
		OrdersControlState(False)
		txtOrderSQL.Text = ""
		txtOrderData.Text = ""
		If blnSalesOrders Then
			txtOrderData.Text = "Starting at OrderID " + intXML1Start.ToString
		End If
		intRows = 0
		intSizeErrors = 0
		pbFillColumn.Value = 0
		If blnSalesOrders Then
			pbFillColumn.Maximum = intSORows
		Else
			pbFillColumn.Maximum = alOrderIDs.Count
		End If
		ClearTimingData()
        Application.DoEvents()
		lngBytes = 0
		Dim strSQL As String = Nothing
		objTimer = New Stopwatch
		If chkUseXmlWriter.Checked Then
			blnIsOrderXML1 = True
			Dim intOrderID As Integer
			Dim intRow As Integer
			cmNwind.Parameters.Add("@OrderID", SqlDbType.Int)
			cmNwind.Parameters(0).Direction = ParameterDirection.Input
			cnNwind.Open()
			objTimer.Start()
			Dim intMaxRows As Integer
			If blnSalesOrders Then
				intMaxRows = intSORows
			Else
				intMaxRows = alOrderIDs.Count
			End If
			For intRow = 0 To intMaxRows - 1
				If blnSalesOrders Then
					intOrderID = intXML1Start + intRow
				Else
					intOrderID = CInt(alOrderIDs(intRow))
				End If
				Try
					If blnUpdateCols Then
						strSQL = "UPDATE Orders SET OrderXML1 = N'" + CreateOrderXML1Doc(intOrderID) + _
						 "' WHERE OrderID = @OrderID; "
						If blnSalesOrders Then
							strSQL = Replace(strSQL, "Orders", "SalesOrders")
						End If
						cmNwind.CommandText = strSQL
						intRows += cmNwind.ExecuteNonQuery
					Else
						strSQL = "-- Baseline time without UPDATE operations" + _
						vbCrLf + CreateOrderXML1Doc(intOrderID)
						intRows += 1
					End If
					pbFillColumn.Value = intRows
					If intRow = 0 Then
						txtOrderSQL.Text = strSQL
                        Application.DoEvents()
					End If
					If intRows Mod 10 = 0 Then
						txtRows.Text = intRow.ToString
                        Application.DoEvents()
					End If
				Catch exc As Exception
					If exc.Message.Contains("Cannot create") Then
						intSizeErrors += 1
						txtOrderData.Text += "OrderID: " + intOrderID.ToString
					End If
					txtOrderData.Text = exc.Message + vbCrLf
                    Application.DoEvents()
				End Try
			Next
			cmNwind.Parameters.Clear()
			dblTime = objTimer.ElapsedTime
			objTimer.Done()
			txtTime.Text = dblTime.ToString("0.000")
			cnNwind.Close()
			If blnUpdateCols Then
				If blnSalesOrders Then
					intXML1Start = intOrderID + 1
					txtOrderData.Text = SaveAndDisplayData("SalesOrders", "OrderXML1", intOrderID)
					If txtOrderData.Text.Contains("Can't find OrderID") Then
						intXML1Start -= intMaxRows
					End If
				Else
					txtOrderData.Text = SaveAndDisplayData("Orders", "OrderXML1", 0)
				End If
			End If
			If chkBytes.Checked Then
				lblRowsPerSec.Text = "KB/Sec:"
				Dim dblKB As Double = lngBytes / 1000
				txtRows.Text = dblKB.ToString("#,##0.0")
				txtRowsPerSec.Text = (dblKB / dblTime).ToString("#0.0")
			Else
				txtRows.Text = intRows.ToString
				txtRowsPerSec.Text = (intRows / dblTime).ToString("#0.0")
			End If
		Else
            blnIsOrderXML1 = False

            'Original T-SQL without timezone
            strSQL = "DECLARE @OrderXML xml " + _
             "SET @OrderXML = (SELECT OrderID, CustomerID, EmployeeID, OrderDate, RequiredDate, ShippedDate, ShipVia, " + _
             "Freight, ShipName, ShipAddress, ShipCity, ShipRegion, ShipPostalCode, ShipCountry " + _
             "FROM Orders AS [Order] WHERE OrderID = @OrderID FOR XML AUTO, ELEMENTS, TYPE) " + vbCrLf

            'New T-SQL with timezone (required for XML dateTime with schema)
            strSQL = "DECLARE @OrderXML xml; " + _
             "SET @OrderXML = (SELECT OrderID, CustomerID, EmployeeID, "
            Dim blnPstOffset As Boolean = True
            Dim blnPstCorrection As Boolean = False
            If blnPstOffset Then
                'Add timezone with PST offset
                strSQL += "CONVERT(nvarchar(30), OrderDate, 126) + N'-08:00' AS OrderDate, " + _
                 "CONVERT(nvarchar(30), RequiredDate, 126) + N'-08:00' AS RequiredDate, " + _
                 "CONVERT(nvarchar(30), ShippedDate, 126) + N'-08:00' AS ShippedDate, "
            ElseIf blnPstCorrection Then
                'Add timezone with PST correction to Zulu
                strSQL += "CONVERT(nvarchar(30), DATEADD(hour, 8, OrderDate), 126) + N'Z' AS OrderDate, " + _
                 "CONVERT(nvarchar(30), DATEADD(hour, 8, RequiredDate), 126) + N'Z' AS RequiredDate, " + _
                 "CONVERT(nvarchar(30), DATEADD(hour, 8, ShippedDate), 126) + N'Z' AS ShippedDate, "
            Else
                'Add timezone without PST correction to Zulu
                strSQL += "CONVERT(nvarchar(30), OrderDate, 126) + N'Z' AS OrderDate, " + _
                 "CONVERT(nvarchar(30), RequiredDate, 126) + N'Z' AS RequiredDate, " + _
                 "CONVERT(nvarchar(30), ShippedDate, 126) + N'Z' AS ShippedDate, "
            End If
            strSQL += "ShipVia, Freight, ShipName, ShipAddress, ShipCity, ShipRegion, ShipPostalCode, ShipCountry " + _
            "FROM Orders AS [Order] WHERE OrderID = @OrderID FOR XML AUTO, ELEMENTS, TYPE); " + vbCrLf

			If blnUpdateCols Then
				strSQL += "UPDATE Orders SET OrderXML1 = @OrderXML WHERE OrderID = @OrderID; "
			End If
			If blnSalesOrders Then
				strSQL = Replace(strSQL, "Orders", "SalesOrders")
			End If
			If blnUpdateCols Then
				txtOrderSQL.Text = strSQL
			Else
				txtOrderSQL.Text = "-- Baseline time without UPDATE operations" + _
				vbCrLf + strSQL
			End If
            Application.DoEvents()
			intRows = UpdateOrdersXML1(strSQL, "OrderXML1")
		End If
		Me.Cursor = Cursors.Default
		OrdersControlState(True)
		chkOrderXML1Index.Enabled = True
		btnFillOrderXML1.Focus()
	End Sub

	Public Function UpdateOrdersXML1(ByVal strSQL As String, ByVal strColName As String) As Integer
		'Populate the specified Orders column
		intRows = 0
		blnIsOrderXML1 = True
		blnIsOrderXML2 = False
		Dim intOrderID As Integer
		objTimer = New Stopwatch
		With cmNwind
			.Parameters.Clear()
			.Parameters.AddWithValue("@OrderID", alOrderIDs(0))
			.CommandText = strSQL
			cnNwind.Open()
			objTimer.Start()
			Dim intRow As Integer
			Dim intMaxRows As Integer
			If blnSalesOrders Then
				intMaxRows = intSORows
			Else
				intMaxRows = alOrderIDs.Count
			End If
			For intRow = 0 To intMaxRows - 1
				If blnSalesOrders Then
					intOrderID = intXML1Start + intRow
				Else
					intOrderID = CInt(alOrderIDs(intRow))
				End If
				.Parameters(0).Value = intOrderID
				Try
					If blnUpdateCols Then
						intRows += cmNwind.ExecuteNonQuery
					Else
                        'Read but don't process the data (for timing)
                        'Dim srData As SqlRecord = cmNwind.ExecuteRow
						intRows += 1
					End If
					pbFillColumn.Value = intRows
					If intRows Mod 10 = 0 Then
						txtRows.Text = intRows.ToString
                        Application.DoEvents()
					End If
				Catch exc As Exception
					txtOrderData.Text += exc.Message + vbCrLf
					'Temporary: Issue with size errors
					If exc.Message.Contains("Cannot create") Then
						intSizeErrors += 1
						txtOrderData.Text += "OrderID: " + intOrderID.ToString
					End If
				End Try
			Next
			dblTime = objTimer.ElapsedTime
			objTimer.Done()
			txtTime.Text = dblTime.ToString("0.000")
			.Parameters.Clear()
			cnNwind.Close()
			If intSizeErrors > 0 Then
				Dim strMsg As String = intSizeErrors.ToString + " " + strSizeError
				MsgBox(strMsg, MsgBoxStyle.Critical, "Row Size Errors During Fill")
			End If
			If blnUpdateCols Then
				If blnSalesOrders Then
					intXML1Start = intOrderID + 1
					txtOrderData.Text = SaveAndDisplayData("SalesOrders", strColName, intOrderID)
					If txtOrderData.Text.Contains("Can't find OrderID") Then
						intXML1Start -= intMaxRows
					End If
				Else
					intXML1Start = CInt(alOrderIDs(alOrderIDs.Count - 1)) + 1
					txtOrderData.Text = SaveAndDisplayData("Orders", strColName, 0)
				End If
			End If
			lngBytes = txtOrderData.Text.Length * intRows
			If chkBytes.Checked Then
				lblRowsPerSec.Text = "~KB/Sec:"
				Dim dblKB As Double = lngBytes / 1000
				txtRows.Text = dblKB.ToString("#,##0.0")
				txtRowsPerSec.Text = (dblKB / dblTime).ToString("#0.0")
			Else
				txtRows.Text = intRows.ToString
				txtRowsPerSec.Text = (intRows / dblTime).ToString("#0.0")
			End If
			Return intRows
		End With
	End Function

	Private Function CreateOrderXML1Doc(ByVal intOrderID As Integer) As String
		Dim strSQL As String = "SELECT OrderID, CustomerID, EmployeeID, OrderDate, RequiredDate, " + _
		 "ShippedDate, ShipVia, Freight, ShipName, ShipAddress, ShipCity, " + _
		 "ShipRegion, ShipPostalCode, ShipCountry " + vbCrLf + _
		 "FROM Orders WHERE OrderID = @OrderID; "
		If blnSalesOrders Then
			strSQL = Replace(strSQL, "Orders", "SalesOrders")
		End If
        Dim sdrOrder As SqlDataReader
		Try
			With cmNwind
				.Parameters(0).Value = intOrderID
				.CommandText = strSQL
                sdrOrder = .ExecuteReader
			End With
		Catch exc As Exception
			Return "Error executing query"
		End Try
        If sdrOrder.HasRows() Then
            sdrOrder.Read()
        Else
            Return "Order is missing"
        End If
        Dim msOrder As New MemoryStream()
		Dim xwSettings As New XmlWriterSettings
		Dim sbXML As New StringBuilder()
		With xwSettings
			.Encoding = Encoding.Unicode