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

  Dim lngCtxHndl  As Long



'*********************

'ESB_GetMESSAGE GLOBAL

'*********************

  Dim intMsgLev  As Integer

  Dim lngMsgNmbr 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 = "$ARBORPATH"

  structInit.MessageFile = ""

  structInit.ClientError = ESB_TRUE

  structInit.ErrorStack = 100

                                                

  '******************

  'Initialize the API

  '******************

  lngStatus = EsbInit(structInit, lngInstHndl)

  

  '**************

  'Error Checking

  '**************

  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) _

         & Chr$(10) & "WAIT! DO NOTHING!" _

         & Chr$(10) & "Retrieving login status; setting Sample/Basic as active"

    

    

    '*************************************************

    'Call the SetActive routine to select Sample Basic

    '*************************************************

    Call ESB_ListErrorStackMsgs  ' Even successful logins return useful messages

    Call ESB_SetActive

  Else

    MsgBox "Login failed: " & (lngStatus)

  End If



End Sub



'**************************************************

'Sets the caller's active application and database.

'**************************************************

Sub ESB_SetActive()

  

  Dim intUserAccess As Integer

  

  strActiveApp = "Sample"

  strActiveDb = "Basic"





  lngStatus = EsbSetActive(lngCtxHndl, strActiveApp, strActiveDb, intUserAccess)

  

'**************

'Error Checking

'**************

    

  If lngStatus = 0 Then

    MsgBox (strActiveApp) & "/" & (strActiveDb) & " is now active"

    

  Else

    MsgBox "EsbSetActive() 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





'***********************************************

'Gets a string of data from the active database.

'***********************************************

Sub ESB_GetString()



  Const intDStringLen = 256

  

  Dim strDataString As String * intDStringLen

  Dim intNumGSCalls As Integer

  

  intNumGSCalls = 1



  lngStatus = EsbGetString(lngCtxHndl, strDataString, intDStringLen)

    

'***************************************************************

'Call EsbGetString() until an empty string (no data) is returned

'***************************************************************

  Do While Mid$(strDataString, 1, 1) <> Chr$(0)

    

    If lngStatus = 0 Then

      MsgBox "EsbGetString() call #" & (intNumGSCalls) & " just read the string" _

      & Chr$(10) & (strDataString)       ' The server's translation of the query string

      lstMessages (strDataString)        ' Display each returned string on a line

      intNumGSCalls = intNumGSCalls + 1  ' Increment now often EsbGetString() is called

    Else

      MsgBox "EsbGetString() failed: " & (lngStatus)

    End If

    

    lngStatus = EsbGetString(lngCtxHndl, strDataString, intDStringLen)

  Loop



End Sub





'********************************************************************

'EsbSendString() sends a string of data to the active database.

'This function should be called after EsbBeginReport(),EsbBeginUpdate(),

'or EsbBeginCalc()

'**********************************************************************

Sub ESB_SendString()

  

  Dim strQueryString          As String

  Dim arrQueryStrings(1 To 8) As String

  Dim intCounter              As Integer



  arrQueryStrings(1) = "<PAGE (Market, Measures) "

  arrQueryStrings(2) = "<COLUMN (Year, Scenario) "

  arrQueryStrings(3) = "<ROW (Product) "

  arrQueryStrings(4) = "<ICHILD Market "

  arrQueryStrings(5) = "Qtr1 Qtr2 "

  arrQueryStrings(6) = "Actual Budget Variance "

  arrQueryStrings(7) = "<ICHILD Product "

  arrQueryStrings(8) = "!"

  

'*****************************************************

'Send a series of query strings to the active database

'*****************************************************

                                                     

  For intCounter = 1 To 8

     strQueryString = arrQueryStrings(intCounter)

     lngStatus = EsbSendString(lngCtxHndl, strQueryString)



'**************

'Error Checking

'**************

    If lngStatus = 0 Then

      MsgBox "EsbSendString() sent query string # " & (intCounter) _

           & " to the active database"

      lstMessages (strQueryString)

    Else

      MsgBox "EsbSendString() failed: " & (lngStatus)

    Exit Sub

    End If

  Next



End Sub



'****************************************************************

'Sends a report specification to the active database from a file

'****************************************************************

Sub ESB_QryFile()



  Dim lngDbCtxHndl     As Long

  Dim lngRFCtxHndl     As Long

  Dim strAppName       As String

  Dim strDbName        As String

  Dim strReportFile    As String

  Dim intWhetherOutput As Integer

  Dim intWhetherLock   As Integer

  

  lngDbCtxHndl = lngCtxHndl

  lngRFCtxHndl = lngCtxHndl

  strAppName = "Sample"

  strDbName = "Basic"

  strReportFile = "MyRpt01"

  

  

  intWhetherOutput = ESB_TRUE     ' If TRUE, data is output from server

  intWhetherLock = ESB_FALSE      ' If TRUE, blocks are locked for update

                                  ' If both are FALSE, report spec checked for syntax

  lngStatus = EsbCreateLocalContext(lngInstHndl, "", "", lngRFCtxHndl)

                                  ' set the local context so EsbReportFile

                                  ' can find the report file on the client

  MsgBox ("Client context completed:" & lngStatus)

   

  lngStatus = EsbReportFile(lngDbCtxHndl, lngRFCtxHndl, strAppName, strDbName, _

                            strReportFile, intWhetherOutput, intWhetherLock)

  

'**************

'Error Checking

'**************

  If lngStatus = 0 Then

    MsgBox "The report file" & Chr$(10) & (strReportFile) & Chr$(10) _

         & "was sent to " & (strAppName) & (strDbName) & Chr$(10) _

         & "EsbGetString() will read the data"

    

  '******************************************************************************

  'Calls EsbGetString to read the returned data until an empty string is returned

  '******************************************************************************

  Call ESB_GetString

                        

  Else

    MsgBox "EsbReportFile() failed: " & (lngStatus)

  End If





End Sub





'**********************************************************************

'Sends a report specification to the active database as a single string

'**********************************************************************

Sub ESB_QryStr()

  

  Dim intWhetherOutput As Integer

  Dim intWhetherLock   As Integer

  Dim strQueryString   As String



  strQueryString = "<DESC Year !"  ' One query string

  intWhetherOutput = ESB_TRUE      ' If TRUE, data is output from server

  intWhetherLock = ESB_FALSE       ' If TRUE, blocks are locked for update

                                   ' If both are FALSE, report spec checked for syntax

  



  lngStatus = EsbReport(lngCtxHndl, intWhetherOutput, intWhetherLock, strQueryString)



'**************

'Error Checking

'**************

  If lngStatus = 0 Then

    MsgBox "The report specification" & Chr$(10) & (strQueryString) & Chr$(10) _

         & "was sent to the active database" & Chr$(10) _

         & "EsbGetString() will read the data"

    

    '*********************************************************

    ' Server outputs data if intWhetherOutput = ESB_TRUE;

    ' ESB_GetString calls EsbGetString() to read the returned

    ' data until an empty string is returned

    '*********************************************************

    Call ESB_GetString

  Else

    MsgBox "EsbReport() failed: " & (lngStatus)

  End If



End Sub



'****************************************************************

'Sends an update specification to the active database from a file

'****************************************************************

Sub ESB_UpdFile()



  Dim lngDbCtxHndl     As Long

  Dim lngUFCtxHndl     As Long

  Dim strAppName       As String

  Dim strDbName        As String

  Dim strUpdateFile    As String

  Dim intWhetherStore  As Integer

  Dim intWhetherUnlock As Integer



  lngDbCtxHndl = lngCtxHndl

  lngUFCtxHndl = lngCtxHndl

  strAppName = "Sample"

  strDbName = "Basic"

  strUpdateFile = "CDupdtDb"

  

  

  intWhetherStore = ESB_TRUE    ' Database is updated & data is stored (on server)

  intWhetherUnlock = ESB_TRUE   ' Locked blocks are unlocked after data is updated

   

'*******************************************

'Lock database blocks before you update them

'*******************************************

  Call ESB_LockDatabase





'******************************************

'Send update file to the specified database

'******************************************

  lngStatus = EsbUpdateFile(lngDbCtxHndl, lngUFCtxHndl, strAppName, strDbName, _

                            strUpdateFile, intWhetherStore, intWhetherUnlock)

  

'**************

'Error Checking

'**************

  If lngStatus = 0 Then

    MsgBox "The update file" & Chr$(10) & (strUpdateFile) & Chr$(10) _

         & "was sent to " & (strAppName) & (strDbName)

  Else

    MsgBox "EsbUpdateFile() failed: " & (lngStatus)

  End If

  

  '********************************

  'Calls error checking sub routine

  '********************************

  Call ESB_ListErrorStackMsgs

  

End Sub





'************************************************************

'Starts sending a report specification to the active database

'************************************************************

Sub ESB_BeginReport()



  Dim intWhetherOutput As Integer

  Dim intWhetherLock   As Integer

  Dim strQueryString   As String



  intWhetherOutput = ESB_TRUE  ' If TRUE, data is output from server

  intWhetherLock = ESB_FALSE   ' If TRUE, blocks are locked for update

                               ' If both are FALSE, report spec checked for syntax





  lngStatus = EsbBeginReport(lngCtxHndl, intWhetherOutput, intWhetherLock)

    

'**************

'Error Checking

'**************

  If lngStatus = 0 Then

    MsgBox "EsbBeginReport() succeeded"

  Else

    MsgBox "EsbBeginReport() failed: " & (lngStatus)

  End If

  

End Sub



'***********************************************************************

'EsbEndReport marks the end of the report specification sent to the

'active database.

'***********************************************************************



Sub ESB_EndReport()

    

  lngStatus = EsbEndReport(lngCtxHndl)

  

'**************

'Error Checking

'**************

  If lngStatus = 0 Then

    MsgBox "EsbEndReport() succeeded"

    

  Else

    MsgBox "EsbEndReport() failed: " & (lngStatus)

    

    '********************************

    'Calls error checking sub routine

    '********************************

    Call ESB_ListErrorStackMsgs

    

    Exit Sub

    

  End If



End Sub





'**************************************************************

'Executes a calc script against the active database from a file

'**************************************************************



Sub ESB_CalcFile()



  Dim lngDbCtxHndl      As Long

  Dim lngCSCtxHndl      As Long

  Dim strAppName        As String

  Dim strDbName         As String

  Dim strCalcScriptFile As String

  Dim intWhetherCalc    As Integer  ' If TRUE, the calc script is executed

  

  lngDbCtxHndl = lngCtxHndl

  lngCSCtxHndl = lngCtxHndl

  strAppName = "Sample"

  strDbName = "Basic"

  strCalcScriptFile = "Calc5Dim"

  intWhetherCalc = ESB_TRUE





  lngStatus = EsbCalcFile(lngDbCtxHndl, lngCSCtxHndl, strAppName, strDbName, _

                          strCalcScriptFile, intWhetherCalc)

  

'**************

'Error Checking

'**************

  If lngStatus = 0 Then

    MsgBox (strAppName) & (strDbName) & " is being calculated" & Chr$(10) _

         & "using the calc script in " & (strCalcScriptFile)

   

    '*********************************************************

    'Call Esb_GetProcessState to get the current state of calc

    '*********************************************************

    Call ESB_GetProcessState

                                

  Else

    MsgBox "EsbCalcFile() failed: " & (lngStatus)

      

      '********************************

      'Calls error checking sub routine

      '********************************

      Call ESB_ListErrorStackMsgs

  End If



End Sub



'***********************************

'Clear data from the active database

'***********************************

Sub ESB_ClrData()



  lngStatus = EsbClearDatabase(lngCtxHndl)

  

'********************

'Begin error checking

'********************

  If lngStatus = 0 Then

    MsgBox "WAIT!! Data is being cleared from " & (strActiveApp) & (strActiveDb)

       

  

    '************************************************************

    'Call Esb_GetProcessState to get the current state of process

    '************************************************************

    Call ESB_GetProcessState

                             

  Else

    MsgBox "EsbClearDatabase() failed: " & (lngStatus)

    

    '********************************

    'Calls error checking sub routine

    '********************************

    Call ESB_ListErrorStackMsgs

  End If



End Sub



'*************************************************

'Import data from different sources to the Essbase

'*************************************************

Sub ESB_LdData()



  Dim structRulesFile        As ESB_OBJDEF_T

  Dim structDataFile         As ESB_OBJDEF_T

  Dim structSQLSource        As ESB_MBRUSER_T

                                               

  Dim strErrorsOnLoadFile    As String

  Dim intWhetherAbortOnError As Integer



  structDataFile.hCtx = lngCtxHndl

  structDataFile.Type = ESB_OBJTYPE_TEXT

  structDataFile.AppName = "Sample"

  structDataFile.DbName = "Basic"

  structDataFile.FileName = "CalcDat"

  

  strErrorsOnLoadFile = "ErrsOnLd.txt"

  intWhetherAbortOnError = ESB_TRUE

  

'********************************************

'Import data from CalcDat.txt to Sample/Basic

'********************************************

  lngStatus = EsbImport(lngCtxHndl, structRulesFile, structDataFile, structSQLSource, _

                        strErrorsOnLoadFile, intWhetherAbortOnError)

                        

'**************

'Error Checking

'**************

  If lngStatus = 0 Then

    MsgBox "WAIT!! Data from " & (structDataFile.FileName) & Chr$(10) _

         & "is being imported to " & (structDataFile.AppName) & (structDataFile.DbName)

    

    '***********************************************************

    'Call Esb_GetProcessState to get the current state of import

    '***********************************************************

    Call ESB_GetProcessState

                              

  Else

    MsgBox "EsbImport() failed: " & (lngStatus)

    

    '********************************

    'Calls error checking sub routine

    '********************************

    Call ESB_ListErrorStackMsgs

  End If



End Sub





'*******************************************************************

' ESB_LockDatabase() calls EsbReportFile() to lock blocks for update

'*******************************************************************

Sub ESB_LockDatabase()





  Dim lngDbCtxHndl     As Long

  Dim lngRFCtxHndl     As Long

  Dim strAppName       As String

  Dim strDbName        As String

  Dim strReportFile    As String

  Dim intWhetherOutput As Integer  ' If TRUE, data is output from server

  Dim intWhetherLock   As Integer  ' If TRUE, blocks are locked for update

  

  lngDbCtxHndl = lngCtxHndl

  lngRFCtxHndl = lngCtxHndl

  strAppName = "Sample"

  strDbName = "Basic"

  strReportFile = "CDlockDb"

  

        

  intWhetherOutput = ESB_FALSE     ' FALSE: no data is output from server

  intWhetherLock = ESB_TRUE        ' TRUE: blocks are locked for update

   



  lngStatus = EsbReportFile(lngDbCtxHndl, lngRFCtxHndl, strAppName, strDbName, _

                            strReportFile, intWhetherOutput, intWhetherLock)

  

'**************

'Error Checking

'**************

  If lngStatus = 0 Then

    MsgBox "The report file" & Chr$(10) & (strReportFile) & Chr$(10) _

         & "was sent to " & (strAppName) & (strDbName) & Chr$(10) _

         & "Blocks are locked for update" & Chr$(10) _

         & "EsbUpdateFile() will update the CalcData database"

  Else

    MsgBox "EsbReportFile() failed: " & (lngStatus)

    

    '********************************

    'Calls error checking sub routine

    '********************************

    Call ESB_ListErrorStackMsgs

    

  End If



End Sub





'******************************************************************

'Get the current state of an asynchronous process until it finishes

'******************************************************************

Sub ESB_GetProcessState()



  Dim structProcessState As ESB_PROCSTATE_T



  lngStatus = EsbGetProcessState(lngCtxHndl, structProcessState)

  Do Until structProcessState.State = ESB_STATE_DONE

    lngStatus = EsbGetProcessState(lngCtxHndl, structProcessState)

  Loop

  

  MsgBox "Asynchronous Process Completed"

   

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





Sub lstMessages(strItem As String)

    frmRprts.lstMessages.AddItem (strItem)

End Sub





Sub lstMessagesClear()

    frmRprts.lstMessages.Clear

End Sub

