io Programmo 32/IOPROG_32.ISO/SOFT/SqlEval7/MSOLAP/samples/Samples.exe/VbDSOWriteEnableCube/frmMain.frm

Visual Basic Form | 1998-10-30 | 15.0 KB | 374 lines

VERSION 5.00
Begin VB.Form frmMain
   Caption         =   "Write Enable"
   ClientHeight    =   2700
   ClientLeft      =   48
   ClientTop       =   276
   ClientWidth     =   1884
   LinkTopic       =   "Form1"
   ScaleHeight     =   2700
   ScaleWidth      =   1884
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton cmdWriteEnable
      Caption         =   "Write Enable Cube"
      Height          =   492
      Left            =   0
      TabIndex        =   3
      Top             =   2040
      Width           =   1812
   End
   Begin VB.ComboBox cboCubeName
      Height          =   288
      Left            =   0
      TabIndex        =   2
      Top             =   1680
      Width           =   1812
   End
   Begin VB.ComboBox cboDatabaseName
      Height          =   288
      Left            =   0
      TabIndex        =   1
      Top             =   960
      Width           =   1812
   End
   Begin VB.TextBox txtServerName
      Height          =   288
      Left            =   0
      TabIndex        =   0
      Text            =   "LocalHost"
      Top             =   240
      Width           =   1812
   End
   Begin VB.Label Label2
      Caption         =   "Select a cube to write enable"
      Height          =   372
      Left            =   0
      TabIndex        =   6
      Top             =   1320
      Width           =   1812
   End
   Begin VB.Label Label1
      Caption         =   "Select a Database"
      Height          =   252
      Left            =   0
      TabIndex        =   5
      Top             =   720
      Width           =   1812
   End
   Begin VB.Label Enter
      Caption         =   "Enter Server Name"
      Height          =   252
      Left            =   0
      TabIndex        =   4
      Top             =   0
      Width           =   1812
   End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' frmMain.frm - Write enables a selected cube. This sample is intended to be
' used in conjunction with the VbDSOCreateSmallCube example and the
' VbDSOWriteBack example.
' (C)Copyright 1998, Microsoft Corporation. All rights reserved.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit
'Declare the module level variables.
Public m_dsoServer   As DSO.Server
Public m_dsoDatabase As DSO.MDStore
Public m_dsoCube     As DSO.MDStore
'   Initialize - initialize the sample application
Public Sub Initialize()
    ' If the DSO server object has already been in use
    '   then call CloseServer method
    ' NOTE: CloseServer method releases all of the resources
    '       acquired by DSO.  It is important to call this
    '       method when the DSO server object is not needed
    '       any longer
    If Not m_dsoServer Is Nothing Then
        m_dsoServer.CloseServer
    End If
End Sub
'   ConnectToServer - create and connect to the DSO server
Public Sub ConnectToServer()
    ' create an instance of the server object
    Dim dsoServer As DSO.Server
    Set dsoServer = New DSO.Server
    ' connect to the server
    On Error GoTo err_connect
    dsoServer.Connect frmMain.txtServerName

    ' store the reference to the server object
    ' so that other methods can use it
    Set m_dsoServer = dsoServer
Exit Sub
err_connect:
    ' Failed to connect to the server.
    ' Possible reasons:
    '   - the Microsoft SQL Server OLAP Server is not running
    '   - the machine on which the OLAP Server is running cannot be reached
    '   - the machine on which DSO application is running is not connected
    '       to the network
    '   - you are not a member of the OLAP Administrators user group on the
    '       server machine
    MsgBox Err.Description
End Sub
'   WriteEnableCube - enables the Sales cube for write back
'   Enabling a cube for writeback entails creation of a writeback partition.  Writeback
'   partition is a ROLAP partition without any aggregations.  The source table of the
'   writeback partition is called writeback table.  The writeback information is stored
'   in this table.
'   We will create the writeback table in the Foodmart sample database
Public Sub WriteEnableCube()
    ' get the cube's datasource
    Dim dsoDatasource As DSO.DataSource
    Set dsoDatasource = m_dsoCube.DataSources(1)
    ' make sure that we are still connected
    If dsoDatasource.IsConnected = False Then
        MsgBox "Cannot create write enable cube. Connection to the datasource cannot be established."
        Exit Sub
    End If
    ' what will be the writeback table name
    Dim sWriteBackTableName As String
    sWriteBackTableName = "Sample_Writeback_" & m_dsoCube.Name
    ' get the connection to the datasource
    Dim adoConnection As ADODB.Connection
    Set adoConnection = dsoDatasource.Connection
    ' create the writeback partition
    Dim dsoWBPartition As DSO.MDStore
    Set dsoWBPartition = m_dsoCube.MDStores.AddNew("Writeback")
    ' set the writeback flag
    dsoWBPartition.IsReadWrite = True
    ' set the partition's source table
    dsoWBPartition.SourceTable = dsoDatasource.OpenQuoteChar & sWriteBackTableName & dsoDatasource.CloseQuoteChar
    ' set the partition's storage mode
    ' NOTE: the writeback partition should not have any aggregations
    dsoWBPartition.OlapMode = olapmodeRolap
    ' begin transaction on the datasource connection
    adoConnection.BeginTrans
    ' create the writeback table
    ' and map the partition levels and measures to this table
    On Error GoTo Err_CreateWriteBackTable
    CreateWriteBackTable dsoWBPartition, dsoDatasource, adoConnection, sWriteBackTableName
    ' commit the transaction on the datasource
    ' NOTE: the OLAP server uses a different connection to the
    '       relational database, so we need to commit the
    '       changes here
    adoConnection.CommitTrans
    ' save the writeback partition
    dsoWBPartition.Update
    ' process the write back partition
    On Error GoTo Err_Process
    dsoWBPartition.Process processFull
Exit Sub
Err_CreateWriteBackTable:
    ' rollback transaction on the datasource
    adoConnection.RollbackTrans
    ' remove the writeback partition from the cube
    m_dsoCube.MDStores.Remove dsoWBPartition.Name
    MsgBox "Cannot create writeback table. " & Err.Description
    Exit Sub
Err_Process:
    ' remove the writeback table
    adoConnection.Execute "DROP TABLE " & sWriteBackTableName
    ' remove the writeback partition from the cube
    m_dsoCube.MDStores.Remove dsoWBPartition.Name
    MsgBox "Cannot process the writeback partition. " & Err.Description
    Exit Sub
End Sub
'   CreateWriteBackTable - create the writeback table
'   The writeback table must have one column for each measure
'   and level in the cube.  It also has two columns used by
'   the OLAP server for storing auditing information
'   This function creates the table and maps the writeback
'   partition levels and measures to this table
Private Sub CreateWriteBackTable(dsoWBPartition As DSO.MDStore, _
                                 dsoDatasource As DSO.DataSource, _
                                 adoConnection As ADODB.Connection, _
                                 TableName As String)


    Dim Progress
    Dim nParitions As Integer

    ' drop the table if it already exists
    On Error Resume Next
    adoConnection.Execute "DROP TABLE " & TableName
    Err.Clear
    On Error GoTo 0
    ' construct the create table statement
    Dim sCreateTable As String
    sCreateTable = "CREATE TABLE " & TableName & " "
    sCreateTable = sCreateTable & " ( "
    ' create two columns required by the OLAP server
    ' for storing auditing information
    sCreateTable = sCreateTable & _
                    "MS_AUDIT_USER varchar(32), " & _
                    "MS_AUDIT_TIME  DateTime"
    ' create a column for each level
    ' since the column names have to be unique
    '   add the level OrdinalPosition to the level name
    Dim dsoPartDimension As DSO.Dimension
    Dim dsoPartLevel As DSO.Level
    Dim sColumnName As String
    For Each dsoPartDimension In dsoWBPartition.Dimensions
        For Each dsoPartLevel In dsoPartDimension.Levels
            If Not dsoPartLevel.LevelType = levAll And _
               Not dsoPartLevel.IsDisabled And _
               Not dsoPartLevel.SubClassType = sbclsVirtual Then
                ' get the column name
                sColumnName = GetColumnName(dsoPartLevel.Name & "_L" & CStr(dsoPartLevel.OrdinalPosition))
                ' update the create table statement
                sCreateTable = sCreateTable & ", " & _
                               sColumnName & " " & GetColumnTypeDefinition(dsoPartLevel.ColumnType, dsoPartLevel.ColumnSize)

                ' map the partition level to this column
                dsoPartLevel.MemberKeyColumn = dsoWBPartition.SourceTable & _
                                               "." & _
                                               dsoDatasource.OpenQuoteChar & sColumnName & dsoDatasource.CloseQuoteChar
            End If
        Next
    Next
    ' create a column for each measure
    ' and map the partition measure to this column
    Dim dsoPartitionMeasure As DSO.Measure
    For Each dsoPartitionMeasure In dsoWBPartition.Measures
        ' get the column name
        sColumnName = GetColumnName(dsoPartitionMeasure.Name)
        ' update the create table statement
        sCreateTable = sCreateTable & ", " & _
                       sColumnName & " " & GetColumnTypeDefinition(dsoPartitionMeasure.SourceColumnType)
        ' map the partition measure to this column
        dsoPartitionMeasure.SourceColumn = dsoWBPartition.SourceTable & _
                                           "." & _
                                           dsoDatasource.OpenQuoteChar & sColumnName & dsoDatasource.CloseQuoteChar
    Next
    ' complete the create table statement
    sCreateTable = sCreateTable & ")"
    ' execute the create table statement
    adoConnection.Execute sCreateTable
End Sub
'   GetColumnTypeDefinition - return a string describing the data type
'                             that can be used in create table statement
'   NOTE: this function works with Jet provider, other providers have different data type names
Private Function GetColumnTypeDefinition(ColumnType As ADODB.DataTypeEnum, Optional ColumnSize As Integer = 50) As String
    Select Case ColumnType
        Case adChar, adVarChar, adWChar
            GetColumnTypeDefinition = " VARCHAR (" & CStr(ColumnSize) & ") "
        Case adCurrency
            GetColumnTypeDefinition = " CURRENCY "
        Case adInteger
            GetColumnTypeDefinition = " INTEGER "
        Case adSmallInt
            GetColumnTypeDefinition = " SMALLINT "
        Case adSingle
            GetColumnTypeDefinition = " REAL "
        Case adDouble
            GetColumnTypeDefinition = " DOUBLE "
        Case adDBTimeStamp, adDate
            GetColumnTypeDefinition = " DATETIME "
        Case Else
            Debug.Assert False ' there is a new data type
                               ' we need to update this function
    End Select
End Function
'   GetColumnName   - create a column name based on the given string
'                     get rid of spaces
Private Function GetColumnName(ObjectName As String) As String
    Dim s As String
    Dim c As String
    Dim i As Integer
    For i = Len(ObjectName) To 1 Step -1
        c = Mid(ObjectName, i, 1)
        If c <> " " Then
            ' legal char, use it
            s = c + s
        End If
    Next
    GetColumnName = s
End Function
'   txtServerName_KeyDown - Connects to a server and loads its databases into
'   a combination box if the enter key is pressed on the Server Name boc.
Private Sub txtServerName_KeyDown(KeyCode As Integer, Shift As Integer)
    ' Was the enter key pressed?
    If KeyCode = vbKeyReturn Then
        ' Set the hourglass and clear the contents of the Database combo box
        Screen.MousePointer = vbHourglass
        cboDatabaseName.Clear

        On Error GoTo err_connect
        ' Connect to this server.
        ConnectToServer
        ' Load up the Databases combo box with new values.
        LoadDatabases

err_connect:
        ' Enable the combo so the user can use it.
        cboDatabaseName.Enabled = True
        'Restore the mouse pointer.
        Screen.MousePointer = vbDefault
    End If

End Sub
'   LoadDatabases() - Loads all of the database names on a server
' into a combo box so the user can select one.
Private Sub LoadDatabases()
Dim tmpDB As DSO.MDStore
    For Each tmpDB In m_dsoServer.MDStores
        cboDatabaseName.AddItem tmpDB.Name
    Next
    cboDatabaseName.Text = cboDatabaseName.List(0)
End Sub
'   LoadCubeNames() - Loads all of the cube names within the database
'   into a combo box.
Private Sub LoadCubeNames()
Dim tmpCube As DSO.MDStore
    For Each tmpCube In m_dsoDatabase.MDStores
        cboCubeName.AddItem tmpCube.Name
    Next
    cboCubeName.Text = cboCubeName.List(0)
End Sub
' cboCubeName_Click - Checks to see if the selected cube can be
' write-enabled
Private Sub cboCubeName_Click()
    'Get the cube
    Set m_dsoCube = m_dsoDatabase.MDStores(cboCubeName.ListIndex + 1)
    ' Is the cube write enabled?
    If m_dsoCube.IsReadWrite = False Then
        ' Is the cubes class Regular? (vice virtual)
        If m_dsoCube.SubClassType = sbclsRegular Then
            cmdWriteEnable.Enabled = True
        Else
            cmdWriteEnable.Enabled = False
        End If
    Else
        cmdWriteEnable.Enabled = False
    End If
End Sub
' cboDatabaseName_Click() - Loads the cube names into their combo box.
Private Sub cboDatabaseName_Click()
    cboCubeName.Clear
    Set m_dsoDatabase = m_dsoServer.MDStores(cboDatabaseName.ListIndex + 1)
    LoadCubeNames
    cboCubeName.Enabled = True
End Sub
' cmdWriteEnable_Click - Call the write enable function.
Private Sub cmdWriteEnable_Click()
    Screen.MousePointer = vbHourglass
        WriteEnableCube
    Screen.MousePointer = vbDefault
    MsgBox "Cube Write Enabled!"
    cmdWriteEnable.Enabled = False
End Sub
' Form_Load - Initializes the server and disables all of the controls
' except ther servers name.
Private Sub Form_Load()
    Initialize
    txtServerName.Enabled = True
    cboDatabaseName.Enabled = False
    cboCubeName.Enabled = False
    cmdWriteEnable.Enabled = False
End Sub