VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "c_DBSessionImpl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
'Generated by IDL2VB v092. Copyright (c) 1999 Martin.Both
'Source File Name: ../demos/db_query/database.idl

Option Explicit

Implements cOrbSkeleton
Implements c_DBSession

'interface ::DB::Session
Const sTypeId As String = "IDL:DB/Session:1.0"
Private oObjRef As cOrbObjRef
Private oDelegate As c_DBSession

'Each tie contains a delegate object, to which all operations are forwarded.
'You can remove this if you use this class as an example for your servant.
Public Sub setDelegate(ByVal Delegate As c_DBSession)
    Set oDelegate = Delegate
End Sub

Public Function getDelegate() As c_DBSession
    Set getDelegate = oDelegate
End Function

Friend Property Get ObjRef() As cOrbObjRef
    Set ObjRef = oObjRef
End Property

Friend Property Get This() As c_DBSession
    Dim oObj As cOrbObject
    Set oObj = New c_DBSession
    If oObj.setObjRef(oObjRef, False) Then
        Set This = Nothing
    Else
        Set This = oObj
    End If
End Property

Private Property Get cOrbSkeleton_TypeId(ByVal Item As Integer) As String
    Select Case Item
    Case 0: cOrbSkeleton_TypeId = sTypeId
    Case 1: cOrbSkeleton_TypeId = "IDL:omg.org/CORBA/Object:1.0"
    End Select
End Property

Private Property Get cOrbSkeleton_ObjRef() As cOrbObjRef
    Set cOrbSkeleton_ObjRef = oObjRef
End Property

Private Property Set cOrbSkeleton_ObjRef(ByVal newObjRef As cOrbObjRef)
    Set oObjRef = newObjRef
End Property

'Helper
Private Function cOrbSkeleton_execute(ByVal sOperation As String, _
    ByVal oIn As cOrbStream, ByVal oOut As cOrbStream) As Long
    On Error GoTo ErrHandler
    Dim oImpl_ As c_DBSession
    Set oImpl_ = IIf(oDelegate Is Nothing, Me, oDelegate)
    Select Case sOperation
    Case "open"
        Dim a1_warns As c_DBMessageSeq
        Call oImpl_.openSub(a1_warns)
        Call a1_warns.writeMe(oOut, 0)
    Case "executeStatement"
        Dim a2_stmstr As String
        a2_stmstr = oIn.readString()
        Dim a2_warns As c_DBMessageSeq
        Dim executeStatement As Long
        executeStatement = oImpl_.executeStatement(a2_stmstr, a2_warns)
        Call oOut.writeLong(executeStatement)
        Call a2_warns.writeMe(oOut, 0)
    Case "prepareStatement"
        Dim a3_stmstr As String
        a3_stmstr = oIn.readString()
        Dim a3_warns As c_DBMessageSeq
        Dim prepareStatement As c_DBStatement
        Set prepareStatement = oImpl_.prepareStatement(a3_stmstr, a3_warns)
        Call oOut.writeObject(prepareStatement)
        Call a3_warns.writeMe(oOut, 0)
    Case "commit"
        Dim a4_warns As c_DBMessageSeq
        Call oImpl_.commit(a4_warns)
        Call a4_warns.writeMe(oOut, 0)
    Case "rollback"
        Dim a5_warns As c_DBMessageSeq
        Call oImpl_.rollback(a5_warns)
        Call a5_warns.writeMe(oOut, 0)
    Case "close"
        Dim a6_warns As c_DBMessageSeq
        Call oImpl_.closeSub(a6_warns)
        Call a6_warns.writeMe(oOut, 0)
    Case "destroy"
        Dim a7_warns As c_DBMessageSeq
        Call oImpl_.destroy(a7_warns)
        Call a7_warns.writeMe(oOut, 0)
    Case Else
        Call VBOrb.raiseBADOPERATION(1, VBOrb.CompletedNO, sOperation)
    End Select
    cOrbSkeleton_execute = 0 'NO_EXCEPTION
    Exit Function
UserExWriter:
    Call VBOrb.getException().writeMe(oOut)
    cOrbSkeleton_execute = 1 'USER_EXCEPTION
    Exit Function
ErrHandler:
    If VBOrb.ErrIsUserEx() Then Resume UserExWriter
    Call VBOrb.ErrReraise(Err, "Session.execute(" & sOperation & ")")
End Function

'Implements c_DBSession

'open() raises(c_DBErrMsgsEx)
Private Sub c_DBSession_openSub(ByRef warns As c_DBMessageSeq)
    On Error GoTo ErrHandler
    'Please write your own code here if using as servant example
    If oDelegate Is Nothing Then
        Call VBOrb.raiseNOIMPLEMENT(0, VBOrb.CompletedNO)
    Else
        Call oDelegate.openSub(warns)
    End If
    Exit Sub
ErrHandler:
    Call VBOrb.ErrReraise(Err, "openSub")
End Sub

'executeStatement() raises(c_DBErrMsgsEx)
Private Function c_DBSession_executeStatement(ByVal stmstr As String, _
    ByRef warns As c_DBMessageSeq) As Long
    On Error GoTo ErrHandler
    Select Case stmstr
    Case "INSERT INTO tabelle" & vbCrLf _
        & "VALUES(729, ""Joeline"", ""Sydney"")"
        Call insertRow(729, "Joeline", "Sydney")
        c_DBSession_executeStatement = 1
        Set warns = New c_DBMessageSeq
    Case "UPDATE tabelle" & vbCrLf _
        & "SET ort = ""Minden""" & vbCrLf _
        & "WHERE name = ""Joeline"""
        c_DBSession_executeStatement = updateOrtByName("Minden", "Joeline")
        Set warns = New c_DBMessageSeq
    Case "DELETE FROM tabelle" & vbCrLf _
        & "WHERE name = ""Joeline"""
        c_DBSession_executeStatement = deleteName("Joeline")
        Set warns = New c_DBMessageSeq
    Case Else
        Dim oDBEx As c_DBErrMsgsEx
        Set oDBEx = New c_DBErrMsgsEx
        Set oDBEx.errs = New c_DBMessageSeq
        oDBEx.errs.Length = 1
        Dim oErrMsg As c_DBMessage
        Set oErrMsg = New c_DBMessage: Set oDBEx.errs.Item(0) = oErrMsg
        oErrMsg.sqlcode = -900
        oErrMsg.sqlstate = "EE900"
        oErrMsg.sqlmessage = "Der Demo-Server erlaubt nur bekannte SQL-Statements"
        Call VBOrb.raiseUserEx(oDBEx)
    End Select
    Exit Function
ErrHandler:
    Call VBOrb.ErrReraise(Err, "executeStatement")
End Function

'prepareStatement() raises(c_DBErrMsgsEx)
Private Function c_DBSession_prepareStatement(ByVal stmstr As String, _
    ByRef warns As c_DBMessageSeq) As c_DBStatement
    On Error GoTo ErrHandler
    If stmstr <> "SELECT * FROM tabelle" Then
        Dim oDBEx As c_DBErrMsgsEx
        Set oDBEx = New c_DBErrMsgsEx
        Set oDBEx.errs = New c_DBMessageSeq
        oDBEx.errs.Length = 1
        Dim oErrMsg As c_DBMessage
        Set oErrMsg = New c_DBMessage: Set oDBEx.errs.Item(0) = oErrMsg
        oErrMsg.sqlcode = -900
        oErrMsg.sqlstate = "EE900"
        oErrMsg.sqlmessage = "Der Demo-Server erlaubt nur bekannte SQL-Statements"
        Call VBOrb.raiseUserEx(oDBEx)
    End If
    'Create a statement
    Dim oDBStmImpl As c_DBStatementImpl
    Set oDBStmImpl = New c_DBStatementImpl
    Call oObjRef.Orb.Connect(oDBStmImpl)
    'Returning warnings if any
    Set warns = New c_DBMessageSeq
    'Returning a reference of the statement object
    Set c_DBSession_prepareStatement = oDBStmImpl.This
    Exit Function
ErrHandler:
    Call VBOrb.ErrReraise(Err, "prepareStatement")
End Function

'commit() raises(c_DBErrMsgsEx)
Private Sub c_DBSession_commit(ByRef warns As c_DBMessageSeq)
    On Error GoTo ErrHandler
    'do something
    Dim oDBEx As c_DBErrMsgsEx
    Set oDBEx = New c_DBErrMsgsEx
    Set oDBEx.errs = New c_DBMessageSeq
    oDBEx.errs.Length = 1
    Dim oErrMsg As c_DBMessage
    Set oErrMsg = New c_DBMessage: Set oDBEx.errs.Item(0) = oErrMsg
    oErrMsg.sqlcode = -999
    oErrMsg.sqlstate = "EE999"
    oErrMsg.sqlmessage = "Connection.commit is not implemented"
    Call VBOrb.raiseUserEx(oDBEx)
    Exit Sub
ErrHandler:
    Call VBOrb.ErrReraise(Err, "commit")
End Sub

'rollback() raises(c_DBErrMsgsEx)
Private Sub c_DBSession_rollback(ByRef warns As c_DBMessageSeq)
    On Error GoTo ErrHandler
    'do something
    Dim oDBEx As c_DBErrMsgsEx
    Set oDBEx = New c_DBErrMsgsEx
    Set oDBEx.errs = New c_DBMessageSeq
    oDBEx.errs.Length = 1
    Dim oErrMsg As c_DBMessage
    Set oErrMsg = New c_DBMessage: Set oDBEx.errs.Item(0) = oErrMsg
    oErrMsg.sqlcode = -999
    oErrMsg.sqlstate = "EE999"
    oErrMsg.sqlmessage = "Connection.rollback is not implemented"
    Call VBOrb.raiseUserEx(oDBEx)
    Exit Sub
ErrHandler:
    Call VBOrb.ErrReraise(Err, "rollback")
End Sub

'close() raises(c_DBErrMsgsEx)
Private Sub c_DBSession_closeSub(ByRef warns As c_DBMessageSeq)
    On Error GoTo ErrHandler
    Set warns = New c_DBMessageSeq
    Call oObjRef.Orb.disconnect(Me)
    Exit Sub
ErrHandler:
    Call VBOrb.ErrReraise(Err, "closeSub")
End Sub

'destroy() raises(c_DBErrMsgsEx)
Private Sub c_DBSession_destroy(ByRef warns As c_DBMessageSeq)
    On Error GoTo ErrHandler
    'Please write your own code here if using as servant example
    If oDelegate Is Nothing Then
        Call VBOrb.raiseNOIMPLEMENT(0, VBOrb.CompletedNO)
    Else
        Call oDelegate.destroy(warns)
    End If
    Exit Sub
ErrHandler:
    Call VBOrb.ErrReraise(Err, "destroy")
End Sub

