This file contains an annotated Essbase Visual Basic API program. This fundamental sample program can be used in a Visual Basic programming environment as a starting point for more functional programs.
This file is to be used with the Oracle Essbase API Reference to illustrate basic points in API programming. A complete set of actual VB code files is also included in the samples directory of this documentation.
This code is attached to the form itself. It calls functions in Code.bas (which follows). This arrangement allows you to include Code.bas in other projects.
Private Sub Form_Load() Call SetBeforeStart End Sub Private Sub SetBeforeStart() cmdStart.Enabled = True cmdStop.Enabled = False cmdClearMsg.Enabled = False lstMessages.Enabled = False cmdListApps.Enabled = False cmdListDbs.Enabled = False cmdGetActive.Enabled = False cmdSetActive.Enabled = False cmdGetDbInfo.Enabled = False End Sub Private Sub SetAfterLogin() cmdStart.Enabled = False cmdStop.Enabled = True cmdClearMsg.Enabled = True lstMessages.Enabled = True cmdListApps.Enabled = True cmdListDbs.Enabled = True cmdGetActive.Enabled = True cmdSetActive.Enabled = True cmdGetDbInfo.Enabled = True End Sub Private Sub cmdClearMsg_Click() lstMessages.Clear End Sub
This code is in code.bas.
Option Explicit
'*******************
'RETURN ERROR STATUS
'*******************
Dim lngStatus As Long
'***********
'INIT GLOBAL
'***********
Dim structInit As ESB_INIT_T
Dim lngInstHndl As Long
'*********************
'ESB_GetMESSAGE GLOBAL
'*********************
Dim intMsgLev As Integer
Dim lngMsgNmbr As Long
'****************
'ESB_LOGIN GLOBAL
'****************
Dim lngCtxHndl As Long
'******************************************
'ESB_SetACTIVE and ESB_ClearDATABASE GLOBAL
'******************************************
Dim strActiveApp As String
Dim strActiveDb As String
'*********************************************
'Init and turn error handle turned off
'*********************************************
Sub ESB_Init()
ESB_TRUE = 1 ' ESB_TRUE
ESB_FALSE = 0 ' and ESB_FALSE are variables, not constants
'**********************
' Define init structure
'**********************
structInit.Version = ESB_API_VERSION
structInit.MaxHandles = 10
structInit.LocalPath = "C:\Hyperion\products\Essbase\EssbaseClient"
structInit.MessageFile = ""
structInit.ClientError = ESB_TRUE
structInit.ErrorStack = 100
'******************
'Initialize the API
'******************
lngStatus = EsbInit(structInit, lngInstHndl)
If lngStatus = 0 Then
MsgBox "The API is initialized: " & (lngInstHndl)
Else
MsgBox "The API failed to initialize: " & (lngStatus)
End If
End Sub
'*******************************************************
'Login in user Admin. All login parameters are hardcoded
'*******************************************************
Sub ESB_Login()
Dim strServer As String * ESB_SVRNAMELEN
Dim strUser As String * ESB_USERNAMELEN
Dim strPassword As String * ESB_PASSWORDLEN
Dim intNumAppDb As Integer
strServer = "Localhost"
strUser = "Admin"
strPassword = "password"
lngStatus = EsbLogin(lngInstHndl, _
strServer, strUser, strPassword, _
intNumAppDb, _
lngCtxHndl)
'**************
'Error Checking
'**************
If lngStatus = 0 Then
MsgBox "Admin is logged in, with login ID (context handle) " & (lngCtxHndl)
Call ESB_ListErrorStackMsgs ' Even successful logins return useful messages
Else
MsgBox "Login failed: " & (lngStatus)
End If
End Sub
'*******
' Logout
'*******
Sub ESB_Logout()
lngStatus = EsbLogout(lngCtxHndl)
'**********************************************
'Display whether the logout succeeded or failed
'**********************************************
If lngStatus = 0 Then
MsgBox "Admin, with login ID (context handle) " & (lngCtxHndl) _
& ", is logged out"
Else
MsgBox "EsbLogout() failed: " & (lngStatus)
End If
End Sub
'*****************************
' Terminate the VB API
'*****************************
Sub ESB_Term()
EsbTerm (lngInstHndl)
'**********************************
'Display whether the API terminated
'**********************************
If lngStatus = 0 Then
MsgBox "The API is terminated"
Else
MsgBox "EsbTerm() failed: " & (lngStatus)
End If
End Sub
'************************************************************
'This is an error checking subroutine that uses EsbGetMessage
'************************************************************
Sub ESB_ListErrorStackMsgs()
Const intMsgLen = 256
Dim strMsg As String * intMsgLen
lngStatus = EsbGetMessage(lngInstHndl, intMsgLev, lngMsgNmbr, _
strMsg, intMsgLen)
Dim intStackNmbr As Integer
intStackNmbr = 1
'********************************************************************
'Do while the error stack has messages and drop messages in a ListBox
'********************************************************************
Do While Mid$(strMsg, 1, 1) <> Chr$(0)
lstMessages "MESSAGE ON ERROR STACK:"
lstMessages "Stack #" & (intStackNmbr)
lstMessages "Level #" & (intMsgLev)
lstMessages "Message #" & (lngMsgNmbr)
lstMessages (strMsg)
intStackNmbr = intStackNmbr + 1
lngStatus = EsbGetMessage(lngInstHndl, intMsgLev, lngMsgNmbr, strMsg, intMsgLen)
Loop
End Sub
'**********************************************************************
'Gets the names of the caller's current active application and database
'**********************************************************************
Sub ESB_GetActive()
Const intAppNameSize = ESB_APPNAMELEN
Const intDbNameSize = ESB_DBNAMELEN
Dim strAppName As String * intAppNameSize
Dim strDbName As String * intDbNameSize
Dim intUserAccess As Integer
lngStatus = EsbGetActive(lngCtxHndl, strAppName, intAppNameSize, _
strDbName, intDbNameSize, intUserAccess)
'**********************************
'Error Checking and Message display
'**********************************
If lngStatus = 0 Then
MsgBox "EsbGetActive() succeeded"
If Mid$(strAppName, 1, 1) = Chr$(0) Then
lstMessages "No active application/database is set"
Else
lstMessages (strAppName)
lstMessages "/ " & (strDbName)
End If
Else
MsgBox "EsbGetActive() failed: " & (lngStatus)
End If
End Sub
'**********************************************************************
'Gets a database's information structure, which contains non
'user-configurable parameters for the database. Sample Basic Hardcoded.
'**********************************************************************
Sub Esb_GetDbInfo()
Dim strAppName As String
Dim strDbName As String
Dim structDbInfo As ESB_DBINFO_T
Dim structDbReqInfo As ESB_DBREQINFO_T
Dim intI As Integer
'Number of database info structures;
'Applies where database is an empty string
Dim intNumDbInfo As Integer
strAppName = "Sample"
strDbName = "Basic"
lngStatus = EsbGetDatabaseInfo(lngCtxHndl, strAppName, strDbName, _
structDbInfo, intNumDbInfo)
'**********************************
'Error Checking and Message display
'**********************************
If lngStatus = 0 Then
MsgBox "You have retrieved a list of database info structures" & Chr(10) _
& "EsbGetNextItem() will now generate a list"
Else
MsgBox "EsbGetDatabaseInfo() failed: " & (lngStatus)
MsgBox "Note: Sample / Basic are Hardcoded for this Example"
End If
'************************************************
'Get database information and display in list box
'************************************************
For intI = 1 To intNumDbInfo
lngStatus = EsbGetNextItem(lngCtxHndl, ESB_DBREQINFO_TYPE, structDbReqInfo)
If lngStatus = 0 Then
MsgBox "EsbGetNextItem() succeeded"
'Return values for the structDbReqInfo.DbReqType:
' 0 = Data load
' 1 = Calculation
' 2 = Outline update
lstMessages "Type of request is: " & (structDbReqInfo.DbReqType)
lstMessages "User is: " & (structDbReqInfo.User)
' User does not display - none is loading, calculating, or updating outline
' BUT, cannot display structDbInfo fields, which is reason for call
Else
MsgBox "EsbGetNextItem() failed: " & (lngStatus)
End If
Next
End Sub
'*********************************************************
'Lists all applications which are accessible to the caller
'*********************************************************
Sub Esb_ListApps()
Dim intNumApps As Integer
Dim strAppName As String * ESB_APPNAMELEN
Dim intI As Integer ' Index for loop
lngStatus = EsbListApplications(lngCtxHndl, intNumApps)
'**********************************
'Error Checking and Message display
'**********************************
If lngStatus = 0 Then
MsgBox "You have retrieved the application names" & Chr(10) _
& "EsbGetNextItem() will now generate a list"
Else
MsgBox "EsbListApplications() failed: " & (lngStatus)
End If
'************************************************
'Get list of applications and display in list box
'************************************************
For intI = 1 To intNumApps
lngStatus = EsbGetNextItem(lngCtxHndl, ESB_APPNAME_TYPE, ByVal strAppName)
If lngStatus = 0 Then
MsgBox "EsbGetNextItem() succeeded"
lstMessages (strAppName)
Else
MsgBox "EsbGetNextItem() failed: " & (lngStatus)
End If
Next
End Sub
'*************************************************************
'Lists all databases which are accessible to the caller,
'either within a specific application, or on an entire server.
'*************************************************************
Sub Esb_ListDbs()
Dim strAppName As String
Dim intNumDbs As Integer
Dim structAppDb As ESB_APPDB_T
Dim intI As Integer ' Index for loop
lngStatus = EsbListDatabases(lngCtxHndl, strAppName, intNumDbs)
'**********************************
'Error Checking and Message display
'**********************************
If lngStatus = 0 Then
MsgBox "You have retrieved a list of application/database structures" & Chr(10) _
& "EsbGetNextItem() will now generate a list"
Else
MsgBox "EsbListDatabases() failed: " & (lngStatus)
End If
'**********************************************************
'Get list of applications/databases and display in list box
'**********************************************************
For intI = 1 To intNumDbs
lngStatus = EsbGetNextItem(lngCtxHndl, ESB_APPDB_TYPE, structAppDb)
If lngStatus = 0 Then
MsgBox "EsbGetNextItem() succeeded"
lstMessages (structAppDb.AppName)
lstMessages "/ " & (structAppDb.DbName)
Else
MsgBox "EsbGetNextItem() failed: " & (lngStatus)
End If
Next
End Sub
'*************************************************
'Sets the caller's active application and database
'*************************************************
Sub Esb_SetActive()
Dim strAppAnswer As String
Dim strDbAnswer As String
Dim intUserAccess As Integer
'*******************************************
'Input boxes allow users to select an app/db
'*******************************************
strAppAnswer = InputBox("Type the Application Name to Set Active. (May be case sensitive)")
'
strDbAnswer = InputBox("Type the Database Name to Set Active. (May be case sensitive)")
lngStatus = EsbSetActive(lngCtxHndl, strAppAnswer, strDbAnswer, intUserAccess)
'**********************************
'Error Checking and Message display
'**********************************
If lngStatus = 0 Then
MsgBox strAppAnswer & "/" & strDbAnswer & " is now active"
Else
MsgBox "EsbSetActive() failed: " & (lngStatus)
End If
End Sub
Sub lstMessages(strItem As String)
frmAppDb.lstMessages.AddItem (strItem)
End Sub
Sub lstMessagesClear()
frmAppDb.lstMessages.Clear
End Sub