ordersxquery.vb

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

            Case 3
                strNS = strNwso + "; " + strNwst
        End Select
        strNS += "; "
        If intMethod = 1 Then
            strXQuery = Replace(strXQuery, ".query('", ".query('" + strNS)
        ElseIf intMethod = 2 Then
            strXQuery = Replace(strXQuery, ".exist('", ".exist('" + strNS)
        ElseIf intMethod = 3 Then
            strXQuery = Replace(strXQuery, ".modify('", ".modify('" + strNS)
        ElseIf intMethod = 4 Then
            strXQuery = Replace(strXQuery, ".value('", ".value('" + strNS)
        ElseIf intMethod = 5 Then
            strXQuery = Replace(strXQuery, ".nodes('", ".value('" + strNS)
        Else
            'Invalid
        End If
    End Sub

	Private Sub btnExecuteOrders_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnExecuteOrders.Click
		Dim intScanRows As Integer
		Me.Cursor = Cursors.WaitCursor
		btnExecuteOrders.Enabled = False
		txtOrdersXQResult.Text = ""
		dgvShowPlan.Visible = False
        Application.DoEvents()
		'Test maximum rows value
		Try
			Dim intMaxRows As Integer = Integer.Parse(txtMaxRows.Text)
			Dim intRowsMax As Integer
			If blnSalesOrders Then
				If rbOrderXML1.Checked Then
					intRowsMax = intXML1Start - intSOrderIDMin
				Else
					intRowsMax = intXML2Start - intSOrderIDMin
				End If
			Else
				intRowsMax = alOrderIDs.Count
			End If

			If intMaxRows = 0 Then
				txtOrdersXQResult.Text = "Maximum rows is zero. Please enter a valid integer"
				Return
			ElseIf intMaxRows > intRowsMax And Not rbRandomIDs.Checked Then
				'Don't test for random IDs; can be any number
				txtOrdersXQResult.Text = "Maximum rows value of " + intMaxRows.ToString + _
				" is greater than " + intRowsMax.ToString + " table rows with xml content."
				Return
			End If
            Application.DoEvents()
			If rbRandomIDs.Checked Then
				'Special case for random ID scans
				ClearTimingData()
				intEmptyRows = 0
				'Refresh the starting XQuery expression for Max. Rows change
				blnResetMaxRows = False
				rbRandomIDs.Checked = False
				rbRandomIDs.Checked = True
				blnResetMaxRows = True
                Application.DoEvents()
				Dim intIdMax As Integer
				Dim strPreviousID As String
				If blnSalesOrders Then
					If rbOrderXML1.Checked Then
						intIdMax = intXML1Start - 1
					Else
						intIdMax = intXML2Start - 1
					End If
					strPreviousID = intIdMax.ToString
				Else
					intIdMax = CInt(alOrderIDs(alOrderIDs.Count - 1))
					strPreviousID = intIdMax.ToString
				End If
				Dim intCtr As Integer
				Dim strNewID As String = Nothing
				If cnNwind.State <> Data.ConnectionState.Open Then
					cnNwind.Open()
				End If
				pbFillColumn.Maximum = intMaxRows
				objTimer = New Stopwatch
				objTimer.Start()
				Dim strXQRand As String = strXQuery
				For intCtr = 0 To intMaxRows - 1
					If blnSalesOrders Then
						'Get a random SalesOrderID
						Dim intRnd As Integer = CInt(Rnd() * (intIdMax - intSOrderIDMin - 1)) + intSOrderIDMin
						strNewID = intRnd.ToString
					Else
						strNewID = alOrderIDs(CInt(Rnd() * (alOrderIDs.Count - 1))).ToString
					End If

					'Replace the OrderIDs
					Dim strMinID As String = (CInt(strPreviousID) - CInt(txtMaxRows.Text)).ToString
					Dim strMinNewID As String = (CInt(strNewID) - CInt(txtMaxRows.Text)).ToString
					strXQRand = Replace(strXQRand, strPreviousID, strNewID)
					strXQRand = Replace(strXQRand, strMinID, strMinNewID)

					If intCtr < 11 Then
						'Display first 10 random values and results
						blnShowLast = True
						txtOrdersXQResult.Text += "Previous ID: " + strPreviousID + _
						  " Current ID: " + strNewID + vbCrLf + strXQRand + vbCrLf + vbCrLf
					Else
						blnShowLast = False
					End If

					'Execute the expression
					If blnSalesOrders Or rbOrderXML2.Checked Then
						intScanRows += CInt(GetXQueryResult(strXQRand, "SalesOrders", intMaxRows, chkUseOrdersSqlXml.Checked, False, True))
					Else
						intScanRows += CInt(GetXQueryResult(strXQRand, "Orders", intMaxRows, chkUseOrdersSqlXml.Checked, False, True))
					End If
					strPreviousID = strNewID
					pbFillColumn.Value = intCtr
                    Application.DoEvents()
				Next intCtr
				Dim dblTime As Double = objTimer.ElapsedTime
				objTimer.Done()
				cnNwind.Close()
				pbFillColumn.Value = pbFillColumn.Maximum
				txtRows.Text = intScanRows.ToString
				txtTime.Text = dblTime.ToString("0.000")
				txtRowsPerSec.Text = (intScanRows / dblTime).ToString("#,##0.000")
				txtOrdersXQResult.Text += vbCrLf + sbXML.Replace("><", ">" + vbCrLf + "<").ToString
				If Not blnUseFLWOR Then
					txtOrdersXQResult.Text = "Total rows returned by SqlDataReader: " + _
					 (intEmptyRows + intScanRows).ToString("#,##0") + vbCrLf + vbCrLf + txtOrdersXQResult.Text
				End If
			Else
				If rbUpdateOrders.Checked Then
					objTimer = New Stopwatch
					objTimer.Start()
				End If
				Dim strResult As String = Nothing
				If blnCheckCache And Not (rbFindByOrderCountryF.Checked And rbOrderXML2.Checked) Then
					'Don't include the comments, which would change if cache reuse worked correctly
					'Special case for Find By Country after Update
					If blnSalesOrders Or rbOrderXML2.Checked Then
						strResult = GetXQueryResult(strXQuery, "SalesOrders", intMaxRows, chkUseOrdersSqlXml.Checked, True, False)
					Else
						strResult = GetXQueryResult(strXQuery, "Orders", intMaxRows, chkUseOrdersSqlXml.Checked, True, False)
					End If
				Else
					If blnSalesOrders Or rbOrderXML2.Checked Then
						strResult = GetXQueryResult(txtOrdersXQuery.Text, "SalesOrders", intMaxRows, chkUseOrdersSqlXml.Checked, True, False)
					Else
						strResult = GetXQueryResult(txtOrdersXQuery.Text, "Orders", intMaxRows, chkUseOrdersSqlXml.Checked, True, False)
					End If
				End If
				If strResult.Contains("XQuery:") Then
					'XQuery error message received
					txtOrdersXQResult.Text = strResult
					Return
				End If
				If rbUpdateOrders.Checked Then
					dblTime = objTimer.ElapsedTime
					objTimer.Done()
					txtTime.Text = dblTime.ToString("#0.000")
					txtOrdersXQuery.Text = Replace(txtOrdersXQuery.Text, strClick, "")
					Dim strSQL As String = "SELECT COUNT(OrderID) FROM Orders WHERE ShipCountry = 'USA' AND OrderXML1 IS NOT NULL; "
					If rbOrderXML2.Checked Then
						strSQL = Replace(strSQL, "XML1", "XML2")
					End If
					If blnSalesOrders Then
						strSQL = Replace(strSQL, "Orders", "SalesOrders")
					End If
					cmNwind.CommandText = strSQL
					cnNwind.Open()
					intMaxRows = CInt(cmNwind.ExecuteScalar)
					'Report the time for all rows
					If intMaxRows > 0 Then
						txtRows.Text = intMaxRows.ToString
						txtRowsPerSec.Text = (intMaxRows / dblTime).ToString("#,##0.00")
						If blnInsertShowplans Then
							InsertShowPlan(strLastShowplan)
						End If
						blnFromUpdate = True
						rbFindByOrderCountryF.Checked = True
						'Return the entire order, not just BillTo elements
						txtOrdersXQuery.Text = Replace(txtOrdersXQuery.Text, "/nwbt:BillTo return", " return")
						txtOrdersXQResult.Text += "Click Execute Query to verify the updates."
					End If
					cnNwind.Close()
				Else
					txtOrdersXQResult.Text = strResult
				End If

				'Test for cached execution plan reuse and optionally clear cache
				If blnCheckCache Or blnClearCache Then
					Dim strCache As String = Nothing
					Dim strTest As String = Replace(strXQuery, "'", "''")
					If strTest.Length > 3800 Then
						strTest = strTest.Substring(1, 3800)
					End If
					'Note: usecounts doesn't increment
					Dim strSQL As String = "SELECT cacheobjtype, refcounts, usecounts, pagesused " + _
					  "FROM sys.syscacheobjects WHERE CHARINDEX('"
					strSQL += strTest + "', sql) > 0;"
					Dim strMsg As String
					Try
						cnNwind.Open()
						If blnClearCache Then
							cmNwind.CommandText = "DBCC FREEPROCCACHE;"
							cmNwind.ExecuteNonQuery()
						End If
						If blnCheckCache Then
							cmNwind.CommandText = strSQL
                            Dim srCache As SqlDataReader
                            srCache = cmNwind.ExecuteReader
                            If srCache.HasRows Then
                                With srCache
                                    strCache = "-- Query cached as " + .GetString(0)
                                    strCache += "; refcounts = " + .GetInt32(1).ToString
                                    strCache += "; usecounts = " + .GetInt32(2).ToString
                                    strCache += "; pagesused = " + .GetInt32(3).ToString + vbCrLf + vbCrLf
                                End With
                            Else
                                strCache = "-- Query not cached (DBCC FREEPROCCACHE executed)" + vbCrLf + vbCrLf
                            End If
                            srCache.Close()
							If strCacheMsg.Length > 0 Then
								txtOrdersXQuery.Text = Replace(txtOrdersXQuery.Text, strCacheMsg, "")
								strCacheMsg = ""
							End If
							txtOrdersXQuery.Text = strCache + txtOrdersXQuery.Text + vbCrLf + vbCrLf + _
							 "-- Query is not editable with CheckCacheState or ClearQueryCache settings"
							txtOrdersXQuery.Text = Replace(txtOrdersXQuery.Text, strClick, "")
							strCacheMsg = strCache
						Else
							strCacheMsg = ""
						End If
					Catch ex As Exception
						strMsg = ex.Message
					Finally
						cnNwind.Close()
					End Try
				End If
			End If
			If blnShowPlanXML AndAlso strOrdersXQuery.Length > 0 AndAlso txtOrdersXQuery.Text <> strOrdersXQuery Then
				pbFillColumn.Width = 175
				btnShowplan.Visible = True
			Else
				pbFillColumn.Width = 291
				btnShowplan.Visible = False
			End If
			If blnInsertShowplans And Not blnFromUpdate Then
				chkBytes.Checked = False
				InsertShowPlan(strLastShowplan)
			End If
		Catch exc As Exception
			If exc.Message.Contains("correct format") Then
				txtOrdersXQResult.Text = "Please correct the maximum rows value."
			Else
				txtOrdersXQResult.Text = exc.Message
			End If
		Finally
			blnFromUpdate = False
			Me.Cursor = Cursors.Default
			If Not rbRandomIDs.Checked Then
				chkBytes.Enabled = True
			End If
			btnExecuteOrders.Enabled = True
			cnNwind.Close()
		End Try
	End Sub

	Private Sub rbOrderXML1_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles rbOrderXML1.CheckedChanged
		'Refresh the XQuery text box contents
		Dim intCtr As Integer
		Dim rbSel As RadioButton
		With gbOrdersXQuery
			Dim blnShowplans As Boolean = blnInsertShowplans
			'blnInsertShowplans = False
			For intCtr = 0 To .Controls.Count - 1
				Dim objSel As Object = .Controls(intCtr)
				If TypeOf .Controls(intCtr) Is RadioButton Then
					rbSel = CType(.Controls(intCtr), RadioButton)
					If rbSel.Checked Then
						If Not rbSel.Name.Contains("rbOrderXML") Then
							rbSel.Checked = False
							rbSel.Checked = True
						End If
						Exit For
					End If
				End If
			Next
			blnInsertShowplans = blnShowplans
		End With
		If rbAggregationsF.Checked Then
			txtOrdersXQResult.Text = "Aggregate queries require OrderXML2"
		End If
	End Sub
End Class