Visual Basic Interface

EMPNO          NUMBER            NOT NULL         P1
ENAME          VARCHAR(16)
JOB            VARCHAR(16)
MGR            NUMBER
HIREDATE       DATE
SAL            NUMBER(7,2)
COMM           NUMBER(7,2)
DEPTNO         NUMBER

#For tmax demo employee program
EMPNO             7500                   long         -                        -
ENAME             7501                   string       -                        -
JOB               7502                   string       -                        -
MGR               7503                   long         -                        -
DATE              7504                   string       -                        -
SAL               7505                   float        -                        -
COMM              7506                   float        -                        -
DEPTNO            7507                   long         -                        -
E_TYPE            9009                   long         -                        -
E_CODE            9010                   long         -                        -
E_MSG             9011                   string       -                        -
E_TMP             9012                   long         -                        -

*DOMAIN
dom1       SHMKEY = 70000, MAXUSER = 200, MINCLH = 1, MAXCLH = 5,
           TPORTNO = 8888, BLOCKTIME = 200, TXTIME = 200

*NODE
tmax1      TMAXDIR = "/home/tmax",
           APPDIR = "/home/tmax/appbin",
           PATHDIR = "/home/tmax/path",
           TLOGDIR = "/home/tmax/log/tlog",
           SLOGDIR = "/home/tmax/log/slog"
           ULOGDIR = "/home/tmax/log/ulog"

*SVRGROUP
svg1        NODENAME = tmax1,
            DBNAME = ORACLE,
            OPENINFO = "ORACLE_XA+Acc=P/scott/tiger+SesTm=60",
            TMSNAME = svg1_tms

*SERVER
emp_c       SVGNAME = svg1, MIN = 1

*SERVICE
FDLSELECT   VRNAME = emp_c
FDLUPDATE   SVRNAME = emp_c
FDLDELETE   SVRNAME = emp_c
FDLINSERT   SVRNAME = emp_c

EmployeeMgr.frm Source
Option Explicit

Private Sub BtnDel_Click()

    Dim Isendbuf As Long
    Dim Irecvbuf As Long
    Dim Irbuflen As Long
    Dim Iret As Long
    Dim text As String
    Dim value As Long
    Dim dvalue As Double
    Dim svalue As Single
    Dim tx_b As Integer
    Dim txbool As Integer 'If a transaction begins, 1 is returned. Otherwise 0 is returned.'

    ' tpstart '
    tmaxStart

    'Initializes the option to begin a transaction'
    txbool = 0

    If EditEmpNo.text = "" Then
        MsgBox "Enter the emloyee number."
        tmaxEnd
        Exit Sub
    End If

    value = Trim(EditEmpNo.text)


    ' Allocate a buffer to send data '
    Isendbuf = fballoc(100, 1024)
    If Isendbuf = Null Then
        TmaxError ("fballoc")
        Call fbfree(Isendbuf)
        tmaxEnd
        Exit Sub
    End If

    ' Allocate a buffer to receive data '
    Irecvbuf = fballoc(100, 1024)
    If Irecvbuf = Null Then
        TmaxError ("fballoc")
        Call fbfree(Irecvbuf)
        tmaxEnd
        Exit Sub
    End If

    Iret = PUTLONG(ByVal Isendbuf, "EMPNO", 0, value)
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Initiate a transaction '
    Iret = tx_begin
    txbool = 1
    If Iret < 0 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Request for an inquiry service '
    Iret = tpcall(ByVal "FDLDELETE", ByVal Isendbuf, ByVal 0, Irecvbuf,
                  Irbuflen, ByVal 0)

    LabelErr.Caption = "sbuf = " & Isendbuf & ", rbuf = " & Irecvbuf

    If Iret = -1 Then
        TmaxError ("tpcall(SVC1)")
        ViewErr (Irecvbuf)
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Save a transaction '
    Iret = tx_commit
    If Iret < 0 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    Else
        txbool = 1
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

End Sub

Private Sub BtnExit_Click()
    End
End Sub

Private Sub BtnIns_Click()

    Dim Isendbuf As Long
    Dim Irecvbuf As Long
    Dim Irbuflen As Long
    Dim Iret As Long
    Dim text As String
    Dim value As Long
    Dim dvalue As Double
    Dim svalue As Single
    Dim lenL As Long
    Dim txbool As Integer ' If a transaction begins, 1 is returned. Otherwise 0 is returned '

    ' tpstart '
    tmaxStart

    ' Initializes the option to begin a transaction '
    txbool = 0

    If EditEmpNo.text = "" Then
        MsgBox "Enter the employee number."
        tmaxEnd
        Exit Sub
    End If

    ' Allocate a buffer to send data. '
    Isendbuf = fballoc(100, 1024)
    If Isendbuf = Null Then
        TmaxError ("fballoc")
        Call fbfree(Isendbuf)
        tmaxEnd
        Exit Sub
    End If

    ' Allocate a buffer to receive data. '
    Irecvbuf = fballoc(100, 1024)
    If Irecvbuf = Null Then
        TmaxError ("fballoc")
        Call fbfree(Irecvbuf)
        tmaxEnd
        Exit Sub
    End If

    Iret = PUTLONG(ByVal Isendbuf, "EMPNO", 0, Trim(EditEmpNo.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    Iret = PUTVAR(ByVal Isendbuf, "ENAME", 0, Trim(EditName.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    Iret = PUTVAR(ByVal Isendbuf, "JOB", 0, Trim(EditJob.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    Iret = PUTLONG(ByVal Isendbuf, "MGR", 0, Trim(EditMgr.text))
    If Iret = -1 Then    ' Initiate a transaction '
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    Iret = PUTVAR(ByVal Isendbuf, "DATE", 0, Trim(EditDate.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    svalue = Trim(EditSal.text)
    ' The definition of fbput and fbget_fldkey functions are specified in the comm.bas file. '
    ' The fbget_fldkey function converts a field name to a key value. '
    Iret = fbput(ByVal Isendbuf, ByVal fbget_fldkey("SAL"), svalue, ByVal lenL)
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' The below comment can function the same as its subsequent statement. '
    'svalue = Trim(EditComm.text)
    'Iret = fbput(ByVal Isendbuf, ByVal fbget_fldkey("COMM"), svalue, ByVal lenL)
    'If Iret = -1 Then
    '    FdlErrorMsg ("fbput")
    '    Exit Sub
    'End If

    ' Functions the same as the above comment. '
    Iret = PUTFLOAT(ByVal Isendbuf, "COMM", 0, Trim(EditComm.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If


    Iret = PUTLONG(ByVal Isendbuf, "DEPTNO", 0, Trim(EditDept.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Initiate a transaction '
    Iret = tx_begin
    txbool = 1
    If Iret < 0 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Request for the updated service '
    Iret = tpcall(ByVal "FDLINSERT", ByVal Isendbuf, ByVal 0, Irecvbuf,
                  Irbuflen, ByVal 0)

    LabelErr.Caption = "sbuf = " & Isendbuf & ", rbuf = " & Irecvbuf

    If Iret = -1 Then
        TmaxError ("tpcall(SVC1)")
        ViewErr (Irecvbuf)
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Save a transaction '
    Iret = tx_commit
    If Iret < 0 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    Else
        txbool = 1
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

End Sub
' Function that displays an error related to Oracle. '
' Event handler that appears when the search button is clicked. '
Private Sub BtnSel_Click()

    Hide
    ' Shows the search result window. '
    EmployeeGrid.Show

End Sub
' Event handler that appears when the Update button is clicked. '
Private Sub BtnUdt_Click()

    Dim Isendbuf As Long
    Dim Irecvbuf As Long
    Dim Irbuflen As Long
    Dim Iret As Long
    Dim text As String
    Dim value As Long
    Dim dvalue As Double
    Dim svalue As Single
    Dim lenL As Long
    Dim txbool As Integer ' If a transaction begins, 1 is returned. Otherwise 0 is returned. '

    ' tpstart '
    tmaxStart

    ' Option to begin a transaction '
    txbool = 0

    If EditEmpNo.text = "" Then
        MsgBox "Enter the password number."
        tmaxEnd
        Exit Sub
    End If

    ' Allocate a buffer to send data. '
    Isendbuf = fballoc(100, 1024)
    If Isendbuf = Null Then
        TmaxError ("fballoc")
        Call fbfree(Isendbuf)
        tmaxEnd
        Exit Sub
    End If

    ' Allocate a buffer to receive data. '
    Irecvbuf = fballoc(100, 1024)
    If Irecvbuf = Null Then
        TmaxError ("fballoc")
        Call fbfree(Irecvbuf)
        tmaxEnd
        Exit Sub
    End If

    Iret = PUTLONG(ByVal Isendbuf, "EMPNO", 0, Trim(EditEmpNo.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    Iret = PUTVAR(ByVal Isendbuf, "ENAME", 0, Trim(EditName.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    Iret = PUTVAR(ByVal Isendbuf, "JOB", 0, Trim(EditJob.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    Iret = PUTLONG(ByVal Isendbuf, "MGR", 0, Trim(EditMgr.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    Iret = PUTVAR(ByVal Isendbuf, "DATE", 0, Trim(EditDate.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If


    svalue = Trim(EditSal.text)
    ' Declare Function fbput Lib "TMAX4GL.DLL"
        (ByVal pFBUF As Long, ByVal fieldid As Long, pbuffer As Any,
         ByVal Fieldlen As Long) As Long
    Iret = fbput(ByVal Isendbuf, ByVal fbget_fldkey("SAL"), svalue, ByVal lenL)
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    svalue = Trim(EditComm.text)
    Iret = fbput(ByVal Isendbuf, ByVal fbget_fldkey("COMM"), svalue, ByVal lenL)
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    Iret = PUTLONG(ByVal Isendbuf, "DEPTNO", 0, Trim(EditDept.text))
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Begin a transaction '
    Iret = tx_begin
    txbool = 1
    If Iret < 0 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Requst for the updated service '
    Iret = tpcall(ByVal "FDLUPDATE", ByVal Isendbuf, ByVal 0, Irecvbuf, Irbuflen,
                  ByVal 0)

    LabelErr.Caption = "sbuf = " & Isendbuf & ", rbuf = " & Irecvbuf

    If Iret = -1 Then
        TmaxError ("tpcall(SVC1)")
        ViewErr (Irecvbuf)
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Save a transaction '
    Iret = tx_commit
    If Iret < 0 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    Else
        txbool = 1
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If


End Sub
Private Sub ExitSub(txbool As Integer, Isendbuf As Long, Irecvbuf As Long)
    If txbool = 1 Then
        tx_rollback
    End If

    ' Release an allocated buffer '
    Call fbfree(ByVal Isendbuf&)
    Call fbfree(ByVal Irecvbuf&)

    ' Function to execute tpend '
    tmaxEnd

    Exit Sub

End Sub
' tpstart '
Private Sub tmaxStart()
    Dim ret As Integer

    ' Retrieve the environment configuration file. '
    ' It is defined in the atmi.bas file. '
    ' Declare Function tmaxreadenv Lib "TMAX4GL.DLL" (ByVal envfile As String,
                                                      ByVal label As String)
                                                      As Long '
    ' For the detailed information, refer to "Tmax Reference Guide".'
    ret = tmaxreadenv("C:\tmax.env", "aix5l389")
    If ret < 0 Then
        TmaxError ("tmaxreadenv")
        Exit Sub
    End If

    ret = tpstart(ByVal 0&)
    If ret = -1 Then
        LabelErr.Caption = "tpstart error = " & gettperrno()
        TmaxError ("tpstart")
        Exit Sub
    Else
        LabelErr.Caption = "tpstart return value = " & ret & " tpstart success"
    End If

End Sub
' tpend '
Private Sub tmaxEnd()
    Dim ret As Integer
    ret = tpend()
    If ret = -1 Then
        LabelErr.Caption = "tpend error = " & gettperrno()
        TmaxError ("tpend")
        Exit Sub
    Else
        LabelErr.Caption = "tpreturn return value = " & ret
    End If

End Sub

' Funtion that displays Oracle error messages '
Private Sub ViewErr(ByVal a As Long)

    'E_TYPE          9009    long    -   -
    'E_CODE          9010    long    -   -
    'E_MSG           9011    string  -   -
    'E_TMP           9012    long    -   -

    Dim typeL, codeL, tmpL As Long
    Dim msgS As String
    Dim Iret As Integer

    ' Refer to Tmax FDL Reference Guide. '
    ' The funtions are defined in comm.bas. '
    Iret = fbget_tu(ByVal a, ByVal fbget_fldkey("E_TYPE"), 0, typeL, 0)
    If Iret = -1 Then
        FdlErrorMsg ("fbget_tu")
        Exit Sub
    End If

    Iret = fbget_tu(ByVal a, ByVal fbget_fldkey("E_CODE"), 0, codeL, 0)
    If Iret = -1 Then
        FdlErrorMsg ("fbget_tu")
        Exit Sub
    End If

    Iret = GETVAR(ByVal a, "E_MSG", 0, msgS)
    If Iret = -1 Then
        TmaxError ("ViewErr, GETVAR, E_MSG")
        Exit Sub
    End If

    Iret = fbget_tu(ByVal a, ByVal fbget_fldkey("E_TMP"), 0, tmpL, 0)
    If Iret = -1 Then
        FdlErrorMsg ("fbget_tu")
        Exit Sub
    End If
    ' Show error messages in a messge box. '
    MsgBox ("Error Type : " & typeL & " ,Code : " & codeL & " ,Message :
            " & msgS & " ,Tmp : " & tmpL)

End Sub

EmployeeGrid.frm Source LabelErr

Option Explicit
' Close the inquiry window. '
Private Sub BtnReturn_Click()
    Hide
    EmployeeMgr.Show

End Sub
' Function that shows the inquiry results when the Inquire button is clicked. '
Private Sub Form_Activate()

Dim Isendbuf As Long
    Dim Irecvbuf As Long
    Dim Irbuflen As Long
    Dim Iret As Integer
    Dim text As String
    Dim value As Long
    Dim dvalue As Double
    Dim svalue As Single
    Dim lenL As Long
    Dim initS, outputS As String
    Dim empnoS, enameS, jobS, mgrS, dateS, salS, commS, deptnoS As String
    Dim cntL As Long
    Dim eNo As Long
    Dim txbool As Integer ' If a transaction begins, 1 is returned. Otherwise 0 is returned. '

    ' tpstart '
    tmaxStart

    ' Initialize an option to begin a transaction '
    txbool = 0

    initS = vbCrLf & vbTab & vbTab & vbTab & "***** Query Results *****"
           & vbCrLf & vbTab & "==================================================="
           & vbCrLf & vbTab & "Employee Number Name Position Manager Data Hired Salary COMM Dept."
           & vbCrLf & vbTab & "==================================================="
           & vbCrLf & vbCrLf

    If EmployeeMgr.EditEmpNo.text = "" Then
        MsgBox "Enter the employee number."
        Hide
        EmployeeMgr.Show
        Exit Sub
    End If

    ' Allocate a buffer to send data '
    Isendbuf = fballoc(100, 1024)
    If Isendbuf = Null Then
        TmaxError ("fballoc")
        Call fbfree(Isendbuf)
        tmaxEnd
        Exit Sub
    End If

    ' Allocate a buffer to receive data '
    Irecvbuf = fballoc(100, 1024)
    If Irecvbuf = Null Then
        TmaxError ("fballoc")
        Call fbfree(Irecvbuf)
        tmaxEnd
        Exit Sub
    End If

    ' Retreive an employee number from the employee management page. '
    eNo = Trim(EmployeeMgr.EditEmpNo.text)
    Iret = fbput(ByVal Isendbuf, ByVal fbget_fldkey("EMPNO"), eNo, ByVal lenL)
    If Iret = -1 Then
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    ' Request for inquiry service '
    Iret = tpcall(ByVal "FDLSELECT", ByVal Isendbuf, ByVal 0, Irecvbuf, Irbuflen,
                  ByVal 0)
    If Iret = -1 Then
        ViewErr (Irecvbuf)
        Call ExitSub(txbool, Isendbuf, Irecvbuf)
    End If

    cntL = fbkeyoccur(ByVal Irecvbuf, ByVal fbget_fldkey("EMPNO"))

    Dim i As Long

    For i = 0 To cntL - 1
        Iret = GETLONG(ByVal Irecvbuf, "EMPNO", i, value)
        If Iret = -1 Then
            TmaxError ("GETLONG(EMPNO)")
            Call ExitSub(txbool, Isendbuf, Irecvbuf)
        End If
        empnoS = value

        Iret = GETVAR(ByVal Irecvbuf, "ENAME", i, text)
        If Iret = -1 Then
            TmaxError ("GETVAR(ENAME)")
            Call ExitSub(txbool, Isendbuf, Irecvbuf)
        End If
        enameS = text

        Iret = GETVAR(ByVal Irecvbuf, "JOB", i, text)
        If Iret = -1 Then
            TmaxError ("GETVAR(JOB)")
            Call ExitSub(txbool, Isendbuf, Irecvbuf)
        End If
        jobS = text

        Iret = GETLONG(ByVal Irecvbuf, "MGR", i, value)
        If Iret = -1 Then
            TmaxError ("GETLONG(MGR)")
            Call ExitSub(txbool, Isendbuf, Irecvbuf)
        End If
        mgrS = value

        Iret = GETVAR(ByVal Irecvbuf, "DATE", i, text)
        If Iret = -1 Then
            TmaxError ("GETVAR(DATE)")
            Call ExitSub(txbool, Isendbuf, Irecvbuf)
        End If
        dateS = text

        ' Retreive float data from SAL data field. '
        ' The function is defined in comm.bas. '
        Iret = fbget_tu(ByVal Irecvbuf, ByVal fbget_fldkey("SAL"), i, svalue, 0)
        If Iret = -1 Then
            FdlErrorMsg ("fbget_tu")
            Call ExitSub(txbool, Isendbuf, Irecvbuf)
        End If
        salS = svalue

        Iret = GETFLOAT(ByVal Irecvbuf, "COMM", i, svalue)
        If Iret = -1 Then
            TmaxError ("GETFLOAT(COMM)")
            Call ExitSub(txbool, Isendbuf, Irecvbuf)
        End If
        commS = svalue

        Iret = GETLONG(ByVal Irecvbuf, "DEPTNO", i, value)
        If Iret = -1 Then
            TmaxError ("GETLONG(DEPTNO)")
            Call ExitSub(txbool, Isendbuf, Irecvbuf)
        End If
        deptnoS = value & vbCrLf

        outputS = outputS & "       " & empnoS & vbTab & enameS & vbTab & jobS
                                      & vbTab & mgrS & vbTab & dateS & vbTab
                                      & salS & vbTab & commS & vbTab & deptnoS

    Next i

    InfoText.text = initS & outputS
    ' Displays returned data in the text box '
    LabelErr.Caption = "SAL = " & dvalue

    Call ExitSub(txbool, Isendbuf, Irecvbuf)

End Sub

Private Sub ExitSub(txbool As Integer, Isendbuf As Long, Irecvbuf As Long)
    If txbool = 1 Then
        tx_rollback
    End If

    ' Release the allocated buffer '
    Call fbfree(ByVal Isendbuf&)
    Call fbfree(ByVal Irecvbuf&)

    ' Function that executes tpend '
    tmaxEnd

    Exit Sub

End Sub

' tpstart '
Private Sub tmaxStart()
    Dim ret As Integer

    ' Retreive the environment configuration file. '
    ' It is defined in the atmi.bas file. '
    ' Declare Function tmaxreadenv Lib "TMAX4GL.DLL"(ByVal envfile As String,
                                                    ByVal label As String) As Long '
    ' For the detailed information, refer to "Tmax Reference Guide". '
    ret = tmaxreadenv("C:\tmax.env", "aix5l389")
    If ret < 0 Then
        TmaxError ("tmaxreadenv")
        Exit Sub
    End If

    ret = tpstart(ByVal 0&)
    If ret = -1 Then
        LabelErr.Caption = "tpstart error = " & gettperrno()
        TmaxError ("tpstart")
        Exit Sub
    Else
        LabelErr.Caption = "tpstart return value = " & ret & " tpstart success"
    End If

End Sub
' tpend '
Private Sub tmaxEnd()
    Dim ret As Integer
    ret = tpend()
    If ret = -1 Then
        LabelErr.Caption = "tpend error = " & gettperrno()
        TmaxError ("tpend")
        Exit Sub
    Else
        LabelErr.Caption = "tpreturn return value = " & ret
    End If
End Sub
' Function that displays Oracle errors '
Private Sub ViewErr(ByVal a As Long)

'E_TYPE          9009    long    -   -
'E_CODE          9010    long    -   -
'E_MSG           9011    string  -   -
'E_TMP           9012    long    -   -

    Dim typeL As Long
    Dim codeL As Long
    Dim msgS As String
    Dim tmpL As Long
    Dim Iret As Integer

    Iret = fbget_tu(ByVal a, ByVal fbget_fldkey("E_TYPE"), 0, typeL, 0)

    If Iret = -1 Then
        FdlErrorMsg ("fbget_tu")
        Exit Sub
    End If
    Iret = fbget_tu(ByVal a, ByVal fbget_fldkey("E_CODE"), 0, codeL, 0)
    If Iret = -1 Then
        FdlErrorMsg ("fbget_tu")
        Exit Sub
    End If

    Iret = GETVAR(ByVal a, "E_MSG", 0, msgS)
    Iret = fbget_tu(ByVal a, ByVal fbget_fldkey("E_TMP"), 0, tmpL, 0)
    If Iret = -1 Then
        FdlErrorMsg ("fbget_tu")
        Exit Sub
    End If
    MsgBox ("Error Type : " & typeL & " ,Code : " & codeL & " ,Message : "&msgS&",
            Tmp : " & tmpL)
End Sub

#include <stdio.h>
#include <ctype.h>
#include <tuxinc/macro.h>
#include "../../fdl/demo_fdl.h"

EXEC SQL include sqlca.h;
EXEC SQL INCLUDE ORACA;
EXEC ORACLE  OPTION (ORACA=YES);
EXEC ORACLE  OPTION (RELEASE_CURSOR=YES);

#define INP   1
#define ORA   2
#define TMX   3
#define APP   4

EXEC SQL begin declare section;
int   h_empno;
char  h_ename[11];
char  h_job[10];
int   h_mgr;
char  h_date[11];
float h_sal;
float h_comm;
int   h_deptno;
EXEC SQL end declare section;

void svc_error(long type, long err_code, char *msg, long tmp);

FDLINSERT( TPSVCINFO *msg )
{
    FBUF *rcvbuf;
    int i, occurrence;
    rcvbuf = (FBUF *)msg->data;
    h_empno = h_mgr = h_sal = h_comm = h_deptno = 0;

    memset(h_ename, 0x00, sizeof(h_ename));
    memset(h_job, 0x00, sizeof(h_job));
    memset(h_date, 0x00, sizeof(h_date));

    occurrence = fbkeyoccur(rcvbuf, EMPNO);

    for (i=0; i< occurrence; i++){
         fbget_tu(rcvbuf, EMPNO, i, (char *)&h_empno, 0);
         fbget_tu(rcvbuf, MGR,   i, (char *)&h_mgr, 0);
         fbget_tu(rcvbuf, SAL,   i, (char *)&h_sal, 0);
         fbget_tu(rcvbuf, COMM,  i, (char *)&h_comm, 0);
         fbget_tu(rcvbuf, DEPTNO,i, (char *)&h_deptno, 0);
         fbget_tu(rcvbuf, ENAME, i, (char *)h_ename, 0);
         fbget_tu(rcvbuf, JOB  , i, (char *)h_job, 0);
         fbget_tu(rcvbuf, DATE , i, (char *)h_date, 0);

         EXEC SQL INSERT
         INTO emp(empno, ename, job, mgr, hiredate, sal,comm, deptno)
         VALUES (:h_empno, :h_ename, :h_job, :h_mgr,
                 to_date(:h_date,'yyyymmdd'), :h_sal, :h_comm, :h_deptno );
     }

     if(sqlca.sqlcode != 0)
        goto LB_DBERROR;

     EXEC SQL WHENEVER SQLERROR
        goto LB_DBERROR;

     tpreturn(TPSUCCESS, 0L, (char *)rcvbuf, 0L, 0L);

     LB_DBERROR :
         EXEC SQL WHENEVER SQLERROR CONTINUE;
         svc_error(ORA, sqlca.sqlcode, sqlca.sqlerrm.sqlerrmc, 0);
}


FDLDELETE( TPSVCINFO *msg )
{
     FBUF *rcvbuf;
     int i, occurrence;

     rcvbuf = ( FBUF *)msg->data;
     occurrence = fbkeyoccur(rcvbuf, EMPNO);

     for (i=0; i< occurrence; i++){
          fbget_tu (rcvbuf, EMPNO, i, (char *)&h_empno , 0);

          EXEC SQL DELETE
          FROM emp
          WHERE empno = :h_empno;
     }
     if(sqlca.sqlcode != 0)
        goto LB_DBERROR;

     EXEC SQL WHENEVER SQLERROR
        goto LB_DBERROR ;

     EXEC SQL WHENEVER NOT FOUND
        goto LB_DBERROR ;

     tpreturn(TPSUCCESS, 0L, (char *)rcvbuf, 0L, 0L);

     LB_DBERROR :
        EXEC SQL WHENEVER SQLERROR CONTINUE;
        svc_error(ORA, sqlca.sqlcode, sqlca.sqlerrm.sqlerrmc, 0);
}

FDLSELECT( TPSVCINFO *msg )
{
      FBUF *rcvbuf;
      FLDLEN fldlen;
      int i=0, ROWMEM=200, CHKROW=500;
      rcvbuf = (FBUF *)msg->data;

      if((rcvbuf=(FBUF *)tprealloc((char *)rcvbuf,ROWMEM*CHKROW))==NULL) {
          rcvbuf=(FBUF *)msg->data;
          goto LB_TMAXERROR ;
       }

       h_empno = h_mgr = h_sal = h_comm = h_deptno = 0;

       memset( h_ename, 0x00, sizeof( h_ename ) );
       memset( h_job, 0x00, sizeof( h_job ) );
       memset( h_date, 0x00, sizeof( h_date ) );

       fbget_tu( rcvbuf, EMPNO, 0, (char *)&h_empno, &fldlen);

       EXEC SQL DECLARE DB_CUR CURSOR FOR
       SELECT  nvl(empno,0), nvl(ename,' '), nvl(job,' '),
               nvl(to_char(hiredate,'yyyymmdd'),' '),  nvl(mgr,0),
               nvl(sal,0), nvl(comm,0), nvl(deptno,0)
       FROM  emp
       WHERE empno >= :h_empno-50 AND empno <= :h_empno+50;
       EXEC SQL OPEN DB_CUR;

       if(sqlca.sqlcode != 0)
          goto LB_DBERROR;

       EXEC SQL WHENEVER SQLERROR
          goto LB_DBERROR ;
       EXEC SQL WHENEVER NOT FOUND
          Do break ;

       while(1) {
          EXEC SQL FETCH DB_CUR
          INTO    :h_empno,
                  :h_ename,
                  :h_job,
                  :h_date,
                  :h_mgr,
                  :h_sal,
                  :h_comm,
                  :h_deptno;
          fbchg_tu(rcvbuf, EMPNO,  i,(char *)&h_empno, 0);
          fbchg_tu(rcvbuf, MGR,    i,(char *)&h_mgr, 0);
          fbchg_tu(rcvbuf, SAL,    i,(char *)&h_sal, 0);
          fbchg_tu(rcvbuf, DEPTNO, i,(char *)&h_deptno, 0);
          fbchg_tu(rcvbuf, COMM,   i,(char *)&h_comm, 0);
          fbchg_tu(rcvbuf, ENAME,  i,(char *)h_ename, 0);
          fbchg_tu(rcvbuf, JOB,    i,(char *)h_job, 0);
          fbchg_tu(rcvbuf, DATE,   i,(char *)h_date, 0);

          i++;
       }
       if (i < 1) goto LB_DBERROR;

       EXEC SQL CLOSE DB_CUR;
       tpreturn(TPSUCCESS, 0L, (char *)rcvbuf, 0L, 0L);

       LB_DBERROR :
            EXEC SQL WHENEVER SQLERROR CONTINUE;
            EXEC SQL CLOSE DB_CUR ;
            svc_error(ORA, sqlca.sqlcode, sqlca.sqlerrm.sqlerrmc, 0L) ;

       LB_TMAXERROR :
            EXEC SQL WHENEVER SQLERROR CONTINUE;
            EXEC SQL CLOSE DB_CUR;
            svc_error(TMX, tperrno, "", 0L);
}

FDLUPDATE( TPSVCINFO *msg )
{
       FBUF *rcvbuf ;
       int i, occurrence;
       rcvbuf = (FBUF *)msg->data;
       h_empno = h_mgr = h_sal = h_comm = h_deptno = 0;

       memset( h_ename, 0x00, sizeof( h_ename ) );
       memset( h_job, 0x00, sizeof( h_job ) );
       memset( h_date, 0x00, sizeof( h_date ) );

       occurrence = fbkeyoccur(rcvbuf, EMPNO);

       for (i=0; i< occurrence; i++){
            fbget_tu ( rcvbuf, EMPNO, i, (char *)&h_empno, 0);
            fbget_tu ( rcvbuf, ENAME, i, (char *)h_ename, 0);
            fbget_tu ( rcvbuf, JOB, i, (char *)h_job, 0);
            fbget_tu ( rcvbuf, MGR, i, (char *)&h_mgr, 0);
            fbget_tu ( rcvbuf, SAL, i, (char *)&h_sal, 0);
            fbget_tu ( rcvbuf, COMM, i, (char *)&h_comm,0);
            fbget_tu ( rcvbuf, DEPTNO, i, (char *)&h_deptno,0);
            fbget_tu ( rcvbuf, DATE, i, (char *)h_date, 0);

            EXEC SQL UPDATE emp
            SET ename = nvl(:h_ename, ename),
                job   = nvl(:h_job, job),
                mgr   = :h_mgr,
                hiredate  = nvl(to_date(:h_date,
                                'yyyymmdd'),hiredate),
                sal   = :h_sal,
                comm  = :h_comm,
                deptno = :h_deptno
            WHERE empno = :h_empno;

            if(sqlca.sqlcode != 0)
               goto LB_DBERROR;

            EXEC SQL WHENEVER SQLERROR
               goto LB_DBERROR;

            EXEC SQL WHENEVER NOT FOUND
               goto LB_DBERROR;
       }
       tpreturn(TPSUCCESS, 0L, (char *)rcvbuf, 0L, 0L);

       LB_DBERROR :
            EXEC SQL WHENEVER SQLERROR CONTINUE;
            svc_error(ORA, sqlca.sqlcode, sqlca.sqlerrm.sqlerrmc, 0L) ;
}

/*********************************************************************
 * Error Processing: If an error occurs in a service routine, the error is entered to the buffer and sent to the client.
 ********************************************************************/
void svc_error(long type, long err_code, char *msg, long tmp) {
        FBUF *transf;
        char *svcname;
        char err_msg[100];
        char temp[100];
        int i = 0;

        printf("type     ==>[%ld]\n", type);
        printf("err_code ==>[%ld]\n", err_code);
        printf("msg      ==>[%s]\n",  msg);
        strcpy(err_msg, msg);

        if ((transf = (FBFR *)tpalloc("FML", NULL, 0)) == NULL) {
             printf("tpalloc failed! errno = %d\n", tperrno);
        }

        switch(type) {
             case INP:
                  switch(err_code) {
                         case -1000:
                               strcpy(err_msg,"The user is not authorized.");
                               break;
                         default:
                               strcpy(err_msg,
                                      "Input error message is not registered.");
                  }
                  break;
             case ORA:
                  if (strlen(err_msg)== 0)
                      strcpy(err_msg, sqlca.sqlerrm.sqlerrmc);
                      break;
             case TMX:
                  if (strlen(err_msg)== 0)
                      strcpy(err_msg, tpstrerror(tperrno));
                      break;
             case APP:
                  if (strlen(err_msg)== 0) {
                      /* Sets an error message if * err_mssg="" is specified. ******/
                      switch(err_code) {
                            case -500:            /* SYSTEM Error */
                                  strcpy(err_msg,"File creation error.");
                                  break;
                            case -502:
                                  strcpy(err_msg,"Failed to call an internal service.");
                                  break;
                            case -504:
                                  strcpy(err_msg, "Socket communication error.");
                                  break;
                            case -505: /* Displays 'processing error if the application is updated by another transaction.*/
                                    /* "[%s] has been updated by another application after an inquiry is performed.
                                    \n\nQuery again and process it.": Processed in a client*/
                                strcpy(err_msg, "does not exist.");
                                    break;
                            case -5002:
                                    strcpy(err_msg, "Contact to the computer center.");
                                    break;
                            default:
                                    strcpy(err_msg,
                                 "Application Error Message is not registered.");
                        }
                   }
                   break;
            }

            /* ROLLBACK */
            EXEC SQL WHENEVER SQLERROR CONTINUE;
            EXEC SQL ROLLBACK;

            fbchg_tu ( transf, E_TYPE, i, (char *)&type,0);
            fbchg_tu ( transf, E_CODE, i, (char *)&err_code,0);
            fbchg_tu ( transf, E_MSG, i, (char *)err_msg,0);
            fbchg_tu ( transf, E_TMP, i, (char *)&tmp,0);

            tpreturn(TPFAIL, 0, (char *)transf, 0L, 0L);
}

include $(ORACLE_HOME)/precomp/lib/env32.mk
ORALIBDIR = $(LIBHOME)
ORALIB = -L/home/oracle/OraHome/lib32/ -lclntsh  -lld -lm `cat
          /home/oracle/OraHome/lib32/sysliblist`  -lm  -lc_r -lpthreads
TARGET = emp_c
APOBJS = emp_c.o
NSDLOBJ = $(TMAXDIR)/lib/sdl.o
#CC
CC=cc

#Oracle
LIBS = -lsvr -loras

OBJS = $(APOBJS) $(SVCTOBJ)
SVCTOBJ = $(TARGET)_svctab.o

CFLAGS  = -q32 -O -I$(TMAXDIR)
LDFLAGS = -brtl
APPDIR  = $(TMAXDIR)/appbin
SVCTDIR = $(TMAXDIR)/svct
TMAXLIBDIR  = $(TMAXDIR)/lib
 #
.SUFFIXES : .c

.c.o:
     $(CC) $(CFLAGS) $(LDFLAGS) -c $<

all: $(TARGET)

$(TARGET): $(OBJS)
     $(CC) $(CFLAGS) $(LDFLAGS) -L$(TMAXLIBDIR) -o $(TARGET)
     -L$(ORALIBDIR) $(ORALIB) $(OBJS) $(LIBS) $(NSDLOBJ)
     mv $(TARGET) $(TMAXDIR)/appbin

$(APOBJS): $(TARGET).pc
     proc iname=emp_c include=$(TMAXDIR)
     define=__LINUX_ORACLE_PROC__
     $(CC) $(CFLAGS) $(LDFLAGS) -c $(TARGET).c

$(SVCTOBJ):
     touch $(SVCTDIR)/$(TARGET)_svctab.c
     $(CC) $(CFLAGS) $(LDFLAGS) -c $(SVCTDIR)/$(TARGET)_svctab.c
#
clean:
     -rm -f *.o core $(TARGET) $(TARGET).lis