home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Begin VB.Form Form1 Caption = "Form1" ClientHeight = 8208 ClientLeft = 48 ClientTop = 276 ClientWidth = 6900 LinkTopic = "Form1" ScaleHeight = 8208 ScaleWidth = 6900 StartUpPosition = 3 'Windows Default Begin VB.CommandButton Close Caption = "Command1" Height = 612 Left = 5400 TabIndex = 24 Top = 840 Width = 972 End Begin VB.TextBox txtUpdatedQueryResults BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 492 Left = 3720 TabIndex = 18 Text = "0.00" Top = 7440 Width = 1692 End Begin VB.CommandButton btn6_RunQueryAgain Caption = "Run Query Again" Height = 492 Left = 840 TabIndex = 17 Top = 7440 Width = 2652 End Begin VB.CommandButton btn5_WriteNewCell Caption = "Write New Cell" Height = 492 Left = 840 TabIndex = 5 Top = 6120 Width = 2652 End Begin VB.TextBox txtnewValue BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 492 Left = 3720 TabIndex = 4 Text = "0.00" Top = 5040 Width = 1692 End Begin VB.TextBox txtQueryResults BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 492 Left = 3720 TabIndex = 3 Text = "0.00" Top = 4320 Width = 1692 End Begin VB.CommandButton btn3_RunQuery Caption = "Run Query" Height = 492 Left = 840 TabIndex = 2 Top = 4320 Width = 2652 End Begin VB.TextBox txtMdxString Height = 1332 Left = 840 MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 1 Top = 2280 Width = 5532 End Begin VB.CommandButton btn1_Connect Caption = "Connect to Server and Database" Height = 492 Left = 840 TabIndex = 0 Top = 960 Width = 2652 End Begin VB.Label lblLabel2 Caption = " for" Height = 492 Left = 3720 TabIndex = 23 Top = 6840 Width = 1692 End Begin VB.Label lblLabel Caption = " for" Height = 372 Left = 3720 TabIndex = 22 Top = 3840 Width = 1692 End Begin VB.Label Label4 Caption = "Cube Cell Write Back Example" BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 372 Left = 960 TabIndex = 21 Top = 0 Width = 4452 End Begin VB.Label Label3 Caption = "Step" Height = 252 Left = 120 TabIndex = 20 Top = 480 Width = 372 End Begin VB.Line Line1 Index = 5 X1 = 0 X2 = 6360 Y1 = 8040 Y2 = 8040 End Begin VB.Line Line1 Index = 4 X1 = 120 X2 = 6360 Y1 = 6720 Y2 = 6720 End Begin VB.Line Line1 Index = 3 X1 = 120 X2 = 6360 Y1 = 5640 Y2 = 5640 End Begin VB.Line Line1 Index = 2 X1 = 120 X2 = 6360 Y1 = 4920 Y2 = 4920 End Begin VB.Line Line1 Index = 1 X1 = 120 X2 = 6360 Y1 = 3720 Y2 = 3720 End Begin VB.Line Line1 Index = 0 X1 = 120 X2 = 6360 Y1 = 1560 Y2 = 1560 End Begin VB.Label Label2 Caption = "Step 6) Press to rexecute the query." Height = 372 Index = 5 Left = 840 TabIndex = 19 Top = 6840 Width = 2652 End Begin VB.Label Label2 Caption = "Step 5) Write the new value of the cell to the cubes delta table" Height = 372 Index = 4 Left = 840 TabIndex = 16 Top = 5760 Width = 2652 End Begin VB.Label Label2 Caption = "Step 4) Enter a new Value for this Query below:" Height = 372 Index = 3 Left = 840 TabIndex = 15 Top = 5040 Width = 2652 End Begin VB.Label Label2 Caption = "Step 3) Press to open the cellset containing the querys results." Height = 372 Index = 2 Left = 840 TabIndex = 14 Top = 3840 Width = 2652 End Begin VB.Label Label2 Caption = "Step2) Compose a query returning a SINGLE lowest level cell." Height = 372 Index = 1 Left = 840 TabIndex = 13 Top = 1800 Width = 2652 End Begin VB.Label Label2 Caption = "Step 1) Press to connect to the server and Database." Height = 372 Index = 0 Left = 840 TabIndex = 12 Top = 480 Width = 2652 End Begin VB.Label label1 Caption = "6" BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 492 Index = 5 Left = 120 TabIndex = 11 Top = 7560 Width = 252 End Begin VB.Label label1 Caption = "5" BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 492 Index = 4 Left = 240 TabIndex = 10 Top = 6240 Width = 252 End Begin VB.Label label1 Caption = "4" BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 492 Index = 3 Left = 240 TabIndex = 9 Top = 5040 Width = 252 End Begin VB.Label label1 Caption = "3" BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 492 Index = 2 Left = 240 TabIndex = 8 Top = 3960 Width = 252 End Begin VB.Label label1 Caption = "2" BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 492 Index = 1 Left = 240 TabIndex = 7 Top = 2280 Width = 252 End Begin VB.Label label1 Caption = "1" BeginProperty Font Name = "MS Sans Serif" Size = 13.8 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 492 Index = 0 Left = 240 TabIndex = 6 Top = 960 Width = 252 End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False '------------------------------------------------------------------------------ '| SimpleWriteBack Example in ADO. '| This example shows the user how to write back a value into a cellset in a cube. '| The basic algorith for doing this is: '| 1)Connect to a Server, Provider and Database '| 2)Issue a query against a cube in the database '| 3)Examine the contents of one of the cells returned by the query '| 4)Change the value of that Cell '| 5)Issue the transaction against the connection '| 6)Close the connection. '| It demonstrates the use of the following objects and their methods: '| Connection Object CellSet Object '| Methods: Methods: '| Open Open '| BeginTrans Close '| CommitTrans Properties: '| RollbackTrans Positions '| Close Value '| Properties: '| Mode '| DefaultDatabase '| IsolationLevel '------------------------------------------------------------------------------- 'Global Declarations Dim oc_Connection As New ADODB.Connection 'Declare and allocate a connection object Dim ocs_CellSet As ADOMD.Cellset 'Declare a cellset object Dim s_ServerName As String 'server name Dim s_Provider As String 'provider name Dim s_CatalogName As String 'Catalog(i.e. Database) name Dim s_MdxString As String 'Mdx Query String Dim iAxis As Integer 'current axis Dim iRow As Integer 'current row Dim ICol As Integer 'current column '------------------------------------------------------------------------------- '| btn1_Connect_Click() '| Connection to the database using the connection object by: '| 1) Using the connection object to set its mode to read and write, '| 2) Assigning it a Server and Provider, '| 3) Assigning it a Database to work from '| 4) And finally setting the transaction level. '------------------------------------------------------------------------------- Private Sub btn1_Connect_Click() On Error Resume Next 'Set the mouse pointer to hourglass because this routine may take some time. Screen.MousePointer = vbHourglass With oc_Connection .Mode = adModeReadWrite .Open "Data Source =" & s_ServerName & "; Provider=" & s_Provider & ";" .DefaultDatabase = s_CatalogName .IsolationLevel = adXactReadCommitted End With 'Display the MDX String which is set in Form_Load() txtMdxString.Text = s_MdxString txtMdxString.SetFocus 'Set the Screen pointer back to normal. Screen.MousePointer = vbDefault End Sub '-------------------------------------------------------------------------------- '| btn3_RunQuery_Click() '| Runs a query by opening the cellset with an mdx query string and a connection object '| 1) Allocates a CellSet object. '| 2) Assigns the Cellset object the results from a query against the connection object. '| 3) Displays the results to the user and gives a helpful label. '-------------------------------------------------------------------------------- Private Sub btn3_RunQuery_Click() Screen.MousePointer = vbHourglass Set ocs_CellSet = New ADOMD.Cellset ocs_CellSet.Open txtMdxString.Text, oc_Connection txtQueryResults.Text = Str(ocs_CellSet(0, 0).Value) lblLabel.Caption = ocs_CellSet(iRow, ICol).Positions(0).Members(0).Caption & " for " & _ ocs_CellSet(iRow, ICol).Positions(1).Members(0).Caption Screen.MousePointer = vbDefault txtnewValue.SetFocus End Sub '-------------------------------------------------------------------------------- '| btn5_WriteNewCell_Click() '| Begins a transaction, executes it, and then confirms it or rolls it back. '| 1) Inform the connection object that a transaction is about to occur '| 2) Find out what the depth of the cell that will be written is.. '| 3) If the cell is at the lowest depth, then set its value to something new OR '| Tell the user that writing to the cell is not allowed because it is not '| At the lowest level. '| 4) Ask the user if they want to commit this transaction. If they do, then call '| the CommitTrans method, otherwise roll the transaction back by calling the '| RollBackTrans method. '| 5) Close the Connection and Cellset objects. '-------------------------------------------------------------------------------- Private Sub btn5_WriteNewCell_Click() Dim nRowDepth As Integer 'the depth of our Row Dim nColDepth As Integer 'the depth of our Column Screen.MousePointer = vbHourglass 'Inform the connection object that a transaction is about to occur oc_Connection.BeginTrans 'Find out what the depth of the cell that will be written is.. nRowDepth = ocs_CellSet.Axes(0).Positions(iRow).Members(0).LevelDepth nColDepth = ocs_CellSet.Axes(1).Positions(ICol).Members(0).LevelDepth 'If the cell is at the lowest depth, then set its value to something new OR 'Tell the user that writing to the cell is not allowed because it is not 'At the lowest level. On Error Resume Next ocs_CellSet(0, 0).Value = Val(txtnewValue.Text) ' Some new Value. If Err.Number Then MsgBox Err.Number & " -" & Err.Description End If Screen.MousePointer = vbDefault 'Ask the user if they want to commit this transaction. If they do, then call 'the CommitTrans method, otherwise roll the transaction back by calling the 'RollBackTrans method. If MsgBox("Commit this transaction?", vbYesNo) = vbYes Then Screen.MousePointer = vbHourglass oc_Connection.CommitTrans Else Screen.MousePointer = vbHourglass oc_Connection.RollbackTrans End If 'Close the Connection and Cellset objects. On Error Resume Next ocs_CellSet.Close oc_Connection.Close 'Deallocate the Connection and Cellset objects. freeing them up completely. Set ocs_CellSet = Nothing Set ocs_Connection = Nothing Screen.MousePointer = Default End Sub '------------------------------------------------------------------------------- '| btn6_RunQueryAgain_Click() '| Rerun the query again to show the results of the transaction '|------------------------------------------------------------------------------ Private Sub btn6_RunQueryAgain_Click() Screen.MousePointer = vbHourglass 'Open the connection with read privs only. With oc_Connection .Mode = adModeRead .Open "Data Source =" & s_ServerName & "; Provider=" & s_Provider & ";" .DefaultDatabase = s_CatalogName .IsolationLevel = adXactReadCommitted End With 'Allocate a new cellset and assign it the results returned by the query. 'Then give the user an informative label and display the selected Sel. Set ocs_CellSet = New ADOMD.Cellset ocs_CellSet.Open s_MdxString, oc_Connection lblLabel2.Caption = ocs_CellSet(iRow, ICol).Positions(0).Members(0).Caption & " for " & _ ocs_CellSet(iRow, ICol).Positions(1).Members(0).Caption txtUpdatedQueryResults.Text = ocs_CellSet(iRow, ICol).Value 'Close the Cellset and the Connection. On Error Resume Next ocs_CellSet.Close oc_Connection.Close 'Deallocate the objects to free them up completely Set ocs_CellSet = Nothing Set ocs_Connection = Nothing Screen.MousePointer = vbDefault End Sub Private Sub Close_Click() On Error Resume Next ocs_CellSet.Close oc_Connection.Close 'Deallocate the objects to free them up completely Set ocs_CellSet = Nothing Set ocs_Connection = Nothing End Sub '------------------------------------------------------------------------------- '| Initialize the variables and set them to appropriate values. '------------------------------------------------------------------------------- Private Sub Form_Load() 'Initialize the strings s_ServerName = "LocalHost" 'This evaluates to the local machine s_Provider = "msolap" 'This is the olap providers name s_CatalogName = "FoodMart" 'This is the name of the Catalog s_MdxString = "select {[Measures].Members} on columns, NON EMPTY{[Customer].[Customer Name].Members} on rows From Small Where ([Product].[Akron City Map])" 'in this example Choose the (0,0) cell in each cell set by... iRow = 0 'Refering the the first element in the row ICol = 0 'and to the first element in the column. End Sub 
(.txt)