このファイルには注釈付きのEssbase Visual Basic APIプログラムが含まれています。この基本的なサンプル・プログラムは、Visual Basicプログラミング環境でより多機能なプログラムを作成するための開始点として使用できます。
このファイルは『Oracle Essbase APIリファレンス』と併用して、APIプログラミングの基本的な点を示します。実際のVBコード・ファイル一式は、このドキュメントのsamplesディレクトリにもあります。
このコードはフォーム自体に付属しています。Code.bas(後続)の関数を呼び出します。Code.basは他のプロジェクトに含めることもできます。
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
このコードは、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