Attribute VB_Name = "Code"

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 Essbase 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 = "e:\essbase\client"

  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 Essbase 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



