Visual Basic .NET Interface (Unicode)
This chapter describes functions used by the Visual Basic .NET interface that supports Unicode, with examples.
|
Since int data can be assigned to an IntPtr object that is used to support Unicode in Visual Basic, Visual Basic .NET’s Unicode interface and Visual Basic .NET’s general interface are compatible. For more information about Visual Basic .NET’s general interface, refer to Visual Basic .NET Interface (General). |
1. Overview
A Visual Basic .NET interface has interface modules that define functions' prototypes to call a client library.
If the following interface modules are installed, functions provided by a Tmax client library can be called and used.
| Module | Description |
|---|---|
atmi.vb |
Module that defines ATMI functions' prototypes. |
fdl.vb |
Module that defines field key functions' prototypes. |
TmaxMacros.vb |
Class that defines macros for user convenience. |
WinApi.vb |
Module that defines prototypes of functions provided by Windows. |
The Visual Basic .NET interface provides the following functions.
| Function | Description |
|---|---|
Displays data in the "STATLIN" field key and an error message of tpurcode. |
|
Displays an error message and an error code of an FDL function. |
|
Makes up a tpstart_t structure, which is a buffer used to connect to a Tmax system. |
|
Gets string data from a buffer allocated in memory through tpalloc(). |
|
Gets binary data from a buffer allocated in memory through tpalloc(). |
|
Returns data in a field with a specified name and location as a byte array value by using fbget_tu(), the Tmax FDL function. |
|
Returns data in a field with a specified name and location as a CARRAY value by using fbget_tu(), the Tmax FDL function. |
|
Returns data in a field with a specified name and location as a Double value by using fbget_tu(), the Tmax FDL function. |
|
Returns data in a field with a specified name and location as a Single value by using fbget_tu(), the Tmax FDL function. |
|
Returns data in a field with a specified name and location as an Integer value by using fbget_tu(), the Tmax FDL function. |
|
Returns data in a field with a specified name and location as a Long value by using fbget_tu(), the Tmax FDL function. |
|
Returns data in a field with a specified name and location as a Short value by using fbget_tu(), the Tmax FDL function. |
|
Returns data in a field with a specified name and location as a String value by using fbget_tu(), the Tmax FDL function. |
|
Stores CARRAY data in a buffer allocated in memory through tpalloc(). |
|
Stores binary data in a buffer allocated in memory through tpalloc(). |
|
Saves data to a field with a specified name and location as a byte array value by using fbchg_tu(), the Tmax FDL function. |
|
Saves data to a field with a specified name and location as a Char value by using fbchg_tu(), the Tmax FDL function. |
|
Saves data to a field with a specified name and location as a Double value by using fbchg_tu(), the Tmax FDL function. |
|
Saves data to a field with a specified name and location as a Single value by using fbchg_tu(), the Tmax FDL function. |
|
Saves data to a field with a specified name and location as an Integer value by using fbchg_tu(), the Tmax FDL function. |
|
Saves data to a field with a specified name and location as a Long value by using fbchg_tu(), the Tmax FDL function. |
|
Saves data to a field with a specified name and location as a Short value by using fbchg_tu(), the Tmax FDL function. |
|
Saves data to a field with a specified name and location as a String value by using fbchg_tu(), the Tmax FDL function. |
|
For information about prototypes and descriptions of ATMI and field key functions, refer to Tmax Reference Guide and Tmax Application Development Guide. |
2. Functions
2.1. ErrorMsg
Displays data in the "STATLIN" field key and an error message of tpurcode. ErrorMsg() is defined in the TmaxMacros.vb file.
The data and error message is displayed in MsgBox. If the error message is sent from a server, both the error message and a user-desired message are displayed in MsgBox.
-
Prototype
Public Shared Function ErrorMsg (ByVal pBuffer As IntPtr, ByVal msg As String) As Integer
-
Parameter
Parameter Description pBuffer
Pointer of a buffer.
msg
Data to be displayed.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf, lrcvbuf As IntPtr Dim rlen, lret As Integer lret = tpcall("FDLTOUPPER", lsndbuf, 0, lrcvbuf, rlen, TPNOFLAGS) If lret < 0 Then ErrorMsg(lrcvbuf, "FDLTOUPPER") End If -
Related functions
FdlErrorMsg()
2.2. FdlErrorMsg
Displays an error message and an error code of an FDL function in MsgBox.
-
Prototype
Public Shared Function FdlErrorMsg(ByVal msg As String) As Integer
-
Parameter
Parameter Description msg
Data to be displayed.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As Integer Dim lret As Integer lret = fbput(lsndbuf, fbget_fldkey("INPUT"), txtSmallF.Text, txtSmallF.TextLength) If lret < 0 Then FdlErrorMsg("fbput") End If -
Related functions
ErrorMsg()
2.3. FilltpstartBuf
Makes up a tpstart_t structure, which is a buffer used to connect to a Tmax system.
-
Prototype
Public Shared Function FilltpstartBuf(ByVal pBuffer As IntPtr, _ ByVal startInfop As tpstart_t) As Integer -
Parameter
Parameter Description pBuffer
Buffer allocated in memory through tpalloc().
startInfo
tpstart_t variable.
-
Return value
Return value Description 0 (primary host)
1 (backup host)
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim cinfo As tpstart_t lsndbuf = tpalloc("TPSTART", "", 0) If lsndbuf = 0 Then error processing End If cinfo.cltname = "tmax" + Chr(0) cinfo.usrname = "tmax" + Chr(0) cinfo.dompwd = "xamt" + Chr(0) cinfo.usrpwd = "batman" + Chr(0) cinfo.flags = TPUNSOL_HND lret = FilltpstartBuf(lsndbuf, cinfo) If ret < 0 Then error processing End If ret = tpstart(lsndbuf) If ret < 0 Then error processing End
2.4. GETCAR
Gets string data from a buffer allocated in memory through tpalloc().
-
Prototype
Public Shared Function GETCAR(ByVal pBuffer As IntPtr, _ByRef value As String, _ByVal len As Integer) As Integer -
Parameter
Parameter Description pBuffer
Buffer allocated in memory through tpalloc().
value
Data to be read.
len
Length of data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempS As String lsndbuf = tpalloc("STRING", "", 0) lret = GETCAR(lrcvbuf, tempS, 10) If lret < 0 Then error processing End If -
Related functions
PUTCAR()
2.5. GETCAR2
Gets binary data from a buffer allocated in memory through tpalloc().
-
Prototype
Public Shared Function GETCAR2(ByVal pBuffer As IntPtr, _ByRef value() As Byte, _ByVal len As Integer) As Integer -
Parameter
Parameter Description pBuffer
Buffer allocated in memory through tpalloc().
value
Data to be read.
len
Length of data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempB() As Byte lsndbuf = tpalloc("STRING", "", 0) lret = GETCAR2(lrcvbuf, tempB, 1024) If lret < 0 Then error processing End If -
Related functions
PUTCAR2()
2.6. GETCAR3
Returns data in a field with a specified name and location by using fbget_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data is returned through value (the 4th parameter), which is a byte array.
-
Prototype
Public Shared Function GETCAR3(ByVal pFBUF As IntPtr, _ByRef fldName As String, _ByVal nth As Integer, _ByRef value() As Byte, _ByRef len As Integer) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be read from a field buffer (pFBUF).
nth
Sequence number of a field to be read.
value
Field data to be read.
len
Length of field data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempB() As Byte Dim len As Integer lsndbuf = fballoc(10, 100) lret = GETCAR3(lsndbuf, "TP_BITMAP", 0, tempB, len) If lret < 0 Then error processing End If
-
Related functions
GETINT(), GETLONG(), GETDOUBLE(), GETFLOAT(), GETSHORT(), GETVAR(), GETCHR()
2.7. GETCHR
Returns data in a field with a specified name and location by using fbget_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data is returned through value (the 4th parameter), which is CARRAY.
While GETVAR() returns String data, GETCHR() returns CARRAY data. Since a specific data length is necessary for CARRAY, the length is specified through a parameter. A specific data length is not necessary for String because String data has NULL at the end.
-
Prototype
Public Shared Function GETCHR(ByVal pFBUF As IntPtr, _ByRef fldName As String, _ByVal nth As Integer, _ByRef value As Char, _ByRef len As Integer) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be read from a field buffer (pFBUF).
nth
Sequence number of a field to be read.
value
Field data to be read.
len
Length of field data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempC As Char Dim len As Integer lsndbuf = fballoc(10, 100) lret = GETCHR(lsndbuf, "CHR", 0, tempC, len) If lret < 0 Then error processing End If
-
Related functions
GETINT(), GETLONG(), GETDOUBLE(), GETFLOAT(), GETSHORT(), GETCAR3(), GETVAR()
2.8. GETDOUBLE
Returns data in a field with a specified name and location by using fbget_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data is returned through value (the 4th parameter), which is Double.
-
Prototype
Public Shared Function GETDOUBLE(ByVal pFBUF As IntPtr, _ByRef fldName As String, _ByVal nth As Integer, _ByRef value As Double) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be read from a field buffer (pFBUF).
nth
Sequence number of a field to be read.
value
Field data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempID As Double lsndbuf = fballoc(10, 100) lret = GETDOUBLE(lsndbuf, "DOUBLEDATA", 0, tempD) If lret < 0 Then error processing End If
-
Related functions
GETINT(), GETLONG(), GETFLOAT(), GETSHORT(), GETCAR3(), GETVAR(), GETCHR()
2.9. GETFLOAT
Returns data in a field with a specified name and location by using fbget_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data is returned through value (the 4th parameter), which is Single.
-
Prototype
Public Shared Function GETFLOAT(ByVal pFBUF As IntPtr,_ByRef fldName As String, _ByVal nth As Integer, _ByRef value As Single) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be read from a field buffer (pFBUF).
nth
Sequence number of a field to be read.
value
Field data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempS As Single lsndbuf = fballoc(10, 100) lret = GETFLOAT(lsndbuf, "TAPE_SENT", 0, tempS) If lret < 0 Then error processing End If
-
Related functions
GETINT(), GETLONG(), GETDOUBLE(), GETSHORT() GETCAR3(), GETVAR(), GETCHR()
2.10. GETINT
Returns data in a field with a specified name and location by using fbget_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data is returned through value (the 4th parameter), which is Integer.
-
Prototype
Public Shared Function GETINT(ByVal pFBUF As IntPtr, _ByRef fldName As String, _ByVal nth As Integer, _ByRef value As Integer) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be read from a field buffer (pFBUF).
nth
Sequence number of a field to be read.
value
Field data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempI As Integer lsndbuf = fballoc(10, 100) lret = GETINT(lsndbuf, "INTDATA", 0, tempI) If lret < 0 Then error processing End If
-
Related functions
GETLONG(), GETDOUBLE(), GETFLOAT(), GETSHORT(), GETCAR3(), GETVAR(), GETCHR()
2.11. GETLONG
Returns data in a field with a specified name and location by using fbget_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data is returned through value (the 4th parameter), which is Long.
-
Prototype
Public Shared Function GETLONG(ByVal pFBUF As IntPtr, _ByRef fldName As String, _ByVal nth As Integer, _ByRef value As Long) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be read from a field buffer (pFBUF).
nth
Sequence number of a field to be read.
value
Field data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempL As Long lsndbuf = fballoc(10, 100) lret = GETINT(lsndbuf, "LONGDATA", 0, tempL) If lret < 0 Then error processing End If
-
Related functions
GETINT(), GETDOUBLE(), GETFLOAT(), GETSHORT(), GETCAR3(), GETVAR(), GETCHR()
2.12. GETSHORT
Returns data in a field with a specified name and location by using fbget_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data is returned through value (the 4th parameter), which is Short.
-
Prototype
Public Shared Function GETSHORT(ByVal pFBUF As IntPtr, _ByRef fldName As String, _ByVal nth As Integer, _ByRef value As Short) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be read from a field buffer (pFBUF).
nth
Sequence number of a field to be read.
value
Field data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempS As Short lsndbuf = fballoc(10, 100) lret = GETSHORT(lsndbuf, "SUPER_NUM", 0, tempS) If lret < 0 Then error processing End If
-
Related functions
GETINT(), GETLONG(), GETDOUBLE(), GETFLOAT(), GETCAR3(), GETVAR(), GETCHR()
2.13. GETVAR
Returns data in a field with a specified name and location by using fbget_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data is returned through value (the 4th parameter), which is String.
-
Prototype
Public Shared Function GETVAR(ByVal pFBUF As IntPtr, _ByRef fldName As String, _ByVal nth As Integer, _ByRef value As String) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be read from a field buffer (pFBUF).
nth
Sequence number of a field to be read.
value
Field data to be read.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempS As String lsndbuf = fballoc(10, 100) lret = GETVAR(lsndbuf, "FILENAM", 0, tempS) If lret < 0 Then error processing End If
-
Related functions
GETINT(), GETLONG(), GETDOUBLE(), GETFLOAT(), GETSHORT(), GETCAR3(), GETCHR()
2.14. PUTCAR
Stores CARRAY data in a buffer allocated in memory through tpalloc().
-
Prototype
Public Shared Function PUTCAR(ByVal pBuffer As IntPtr, _ByVal value As String, _ByVal len As Integer) As Integer -
Parameter
Parameter Description pBuffer
Buffer allocated in memory through tpalloc().
value
CARRAY data to be stored.
len
Length of CARRAY data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim rlet As Integer Dim tempS As String lsndbuf = tpalloc("CARRAY", "", 0) tempS = txtString.Text lret = PUTCAR(lsndbuf, tempS, tempS.Length) If lret < 0 Then MsgBox("PUTCAR fail…[" & tpstrerror(gettperrno()) & "]") End If -
Related functions
GETCAR()
2.15. PUTCAR2
Stores binary data in a buffer allocated in memory through tpalloc().
-
Prototype
Public Shared Function PUTCAR2(ByVal pBuffer As IntPtr, _ByRef value() As Byte, _ByVal len As Integer) As Integer -
Parameter
Parameter Description pBuffer
Buffer allocated in memory through tpalloc().
value
Binary data to be stored.
len
Length of binary data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempB() As Short Dim fs As FileStream Dim br As BinaryReader Dim FilePath As String lsndbuf = tpalloc("CARRAY", "", 0) fs = New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.None) br = New BinaryReader(fs) ReDim tempB(CInt(fs.Length)) br.Read(tempBr, 0, CInt(fs.Length)) br.Close() fs.Close() lret = PUTCAR2(lsendbuf, tempB, Cint(fs.Length)) If lret < 0 Then MsgBox("PUTCAR2 fail…[" & tpstrerror(gettperrno()) & "]") End If -
Related functions
GETCAR2()
2.16. PUTCAR3
Saves data to a field with a specified name and location by using fbchg_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data to be saved is value (the 4th parameter), which is a byte array. This PUTCAR3 function is used to handle binary data.
If a specified filed already has data, the existing data will be replaced with a given data. If a specified filed already has no data, a given data will be saved.
-
Prototype
Public Shared Function PUTCAR3(ByVal pFBUF As IntPtr, _ByVal fldName As String, _ByVal nth As Integer, _ByRef value() As Byte, _ByVal len As Integer) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be stored in a field buffer (pFBUF).
nth
Sequence number of a field to be stored.
value
Binary data to be stored.
len
Length of binary data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempB() As Short Dim fs As FileStream Dim br As BinaryReader Dim FilePath As String lsndbuf = fballoc(10, 100) fs = New FileStream(FilePath, FileMode.Open, FileAccess.Read, FileShare.None) br = New BinaryReader(fs) ReDim tempB(CInt(fs.Length)) br.Read(tempBr, 0, CInt(fs.Length)) br.Close() fs.Close() lret = PUTCAR3(lsendbuf, "TP_BITMAP", 0, tempB, Cint(fs.Length)) If lret < 0 Then error processing End If -
Related functions
PUTINT(), PUTLONG(), PUTSHORT(), PUTDOUBLE(), PUTFLOAT(), PUTVAR(), PUTCHR()
2.17. PUTCHR
Saves data to a field with a specified name and location by using fbchg_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data to be saved is value (the 4th parameter), which is Char.
If a specified filed already has data, the existing data will be replaced with a given data. If a specified filed already has no data, a given data will be saved.
-
Prototype
Public Shared Function PUTCHR(ByVal pFBUF As IntPtr, _ByVal fldName As String, _ByVal nth As Integer, _ByRef value As Char, _ByVal len As Integer) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be stored in a field buffer (pFBUF).
nth
Sequence number of a field to be stored.
value
Char data to be stored.
len
Length of Char data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempC As Char lsndbuf = fballoc(10, 100) tempC = New String("a").ToCharArray() lret = PUTCHR(lsndbuf, "CHR", 0, tempC(0), 1) If lret < 0 Then error processing End If -
Related functions
PUTINT(), PUTLONG(), PUTSHORT(), PUTDOUBLE(), PUTFLOAT(), PUTCAR3(), PUTVAR()
2.18. PUTDOUBLE
Saves data to a field with a specified name and location by using fbchg_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data to be saved is value (the 4th parameter), which is Double.
If a specified filed already has data, the existing data will be replaced with a given data. If a specified filed already has no data, a given data will be saved.
-
Prototype
Public Shared Function PUTDOUBLE(ByVal pFBUF As IntPtr, _ByVal fldName As String, _ByVal nth As Integer, _ByRef value As Double) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be stored in a field buffer (pFBUF).
nth
Sequence number of a field to be stored.
value
Double data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempD As Double lsndbuf = fballoc(10, 100) tempD = CDbl(txtDouble.Text) lret = PUTDOUBLE(lsndbuf, "DOUBLEDATA", 2, tempD) If lret < 0 Then error processing End If
-
Related functions
PUTINT(), PUTLONG(), PUTFLOAT(), PUTSHORT(), PUTCAR3(), PUTVAR(), PUTCHR()
2.19. PUTFLOAT
Saves data to a field with a specified name and location by using fbchg_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data to be saved is value (the 4th parameter), which is Single.
If a specified filed already has data, the existing data will be replaced with a given data. If a specified filed already has no data, a given data will be saved.
-
Prototype
Public Shared Function PUTFLOAT(ByVal pFBUF As IntPtr, _ByVal fldName As String, _ByVal nth As Integer, _ByRef value As Single) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be stored in a field buffer (pFBUF).
nth
Sequence number of a field to be stored.
value
String data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempS As Single lsndbuf = fballoc(10, 100) tempS = CSng(txtSingle.Text) lret = PUTFLOAT(lsndbuf, "TAPE_SENT", 2, tempS) If lret < 0 Then error processing End If
-
Related functions
PUTINT(), PUTLONG(), PUTSHORT(), PUTDOUBLE(), PUTCAR3(), PUTVAR(), PUTCHR()
2.20. PUTINT
Saves data to a field with a specified name and location by using fbchg_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data to be saved is value (the 4th parameter), which is Integer.
If a specified filed already has data, the existing data will be replaced with a given data. If a specified filed already has no data, a given data will be saved.
-
Prototype
Public Shared Function PUTINT(ByVal pFBUF As IntPtr, _ByVal fldName As String, _ByVal nth As Integer, _ByRef value As Integer) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be stored in a field buffer (pFBUF).
nth
Sequence number of a field to be stored.
value
Integer data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempI As Integer lsndbuf = fballoc(10, 100) tempI = CInt(txtInt.Text) lret = PUTINT(lsndbuf, "INTDATA", 2, tempI) If lret < 0 Then error processing End If
-
Related functions
PUTLONG(), PUTDOUBLE(), PUTFLOAT(), PUTSHORT(), PUTCAR3(), PUTVAR(), PUTCHR()
2.21. PUTLONG
Saves data to a field with a specified name and location by using fbchg_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data to be saved is value (the 4th parameter), which is Long.
If a specified filed already has data, the existing data will be replaced with a given data. If a specified filed already has no data, a given data will be saved.
-
Prototype
Public Shared Function PUTLONG(ByVal pFBUF As IntPtr, _ByVal fldName As String, _ByVal nth As Integer, _ByRef value As Long) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be stored in a field buffer (pFBUF).
nth
Sequence number of a field to be stored.
value
Long data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempL As Long lsndbuf = fballoc(10, 100) tempL = CLong(txtLong.Text) lret = PUTLONG(lsndbuf, "LONGDATA", 2, tempL) If lret < 0 Then error processing End If
-
Related functions
PUTINT(), PUTDOUBLE(), PUTFLOAT(), PUTSHORT(), PUTCAR3(), PUTVAR(), PUTCHR()
2.22. PUTSHORT
Saves data to a field with a specified name and location by using fbchg_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data to be saved is value (the 4th parameter), which is Short.
If a specified filed already has data, the existing data will be replaced with a given data. If a specified filed already has no data, a given data will be saved.
-
Prototype
Public Shared Function PUTSHORT(ByVal pFBUF As IntPtr, _ByVal fldName As String, _ByVal nth As Integer, _ByRef value As Short) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be stored in a field buffer (pFBUF).
nth
Sequence number of a field to be stored.
value
Short data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempS As Short lsndbuf = fballoc(10, 100) tempS = CShort(txtShort.Text) lret = PUTSHORT(lsndbuf, "SUPER_NUM", 2, tempS) If lret < 0 Then error processing End If
-
Related functions
PUTINT(), PUTLONG(), PUTFLOAT(), PUTDOUBLE(), PUTCAR3(), PUTVAR(), PUTCHR()
2.23. PUTVAR
Saves data to a field with a specified name and location by using fbchg_tu(), the Tmax FDL function. The field name is specified in fldName (the 2nd parameter) and the field location is specified in nth (the 3rd parameter). The data to be saved is value (the 4th parameter), which is String.
If a specified filed already has data, the existing data will be replaced with a given data. If a specified filed already has no data, a given data will be saved.
-
Prototype
Public Shared Function PUTVAR(ByVal pFBUF As IntPtr, _ByVal fldName As String, _ByVal nth As Integer, _ByVal value As String) As Integer -
Parameter
Parameter Description pFBUF
Buffer allocated in memory through tpalloc() or fballoc().
fldName
Name of a field to be stored in a field buffer (pFBUF).
nth
Sequence number of a field to be stored.
value
String data to be stored.
-
Return value
Return value Description 1
Function call succeeded.
-1
Function call failed.
-
Example
Dim lsndbuf As IntPtr Dim lret As Integer Dim tempS As String lsndbuf = fballoc(10, 100) tempS = txtString.Text lret = PUTVAR(lsndbuf, " FILENAME ", 2, tempS) If lret < 0 Then error processing End If
-
Related functions
PUTINT(), PUTLONG(), PUTSHORT(), PUTDOUBLE(), PUTFLOAT(), PUTCAR3(), PUTCHR()
3. Example Program
The following describes an example program that queries, modifies, deletes, and adds names, positions, managers in charge, joining dates, salaries, contracted periods, and departments with a key of an account ID. Filed key buffers are used in the program.
3.1. Program Organization
Each program consists of the following files. Add atmi.vb, fdl.vb, TmaxMacros.vb, and WinAPI.vb as modules for this project.
-
Common program
File Description demo.f
Defines field key buffers.
tmconfig.m
Tmax configuration file.
-
Client program
File Description AssemblyInfo.vb
File that sets the default values used during assembly.
CodeFile1.vb
Automatically created file in a Visual Basic .NET interface.
EmployeeGrid.resx
Automatically created file in a Visual Basic .NET interface.
EmployeeGrid.vb
Program that shows a search result.
EmployeeMgr.resx
Automatically created file in a Visual Basic .NET interface.
EmployeeMgr.sln
Automatically created file in a Visual Basic .NET interface.
EmployeeMgr.suo
Automatically created file in a Visual Basic .NET interface.
EmployeeMgr.vb
Main program that processes search, modification, deletion, and addition.
EmployeeMgr.vbproj
Automatically created file in a Visual Basic .NET interface.
EmployeeMgr.vbproj.user
Automatically created file in a Visual Basic .NET interface.
TmaxMacros.vb
Class that defines macros for user convenience.
WinAPI.vb
Module that defines prototypes of functions provided by Windows.
atmi.vb
Module that defines ATMI functions' prototypes.
fdl.vb
Modlule that defines field key functions' prototypes.
-
Server program
File Description emp_c.mk
Makefile.
emp_c.pc
Server program that provides services. AIX and Oracle 9i are used.
3.2. Program Description
The following describes each program.
-
Client program
Item Description Tmax connection
Connection is established with tpstart_t.
Buffer
'fdl' files need to be created by compiling FIELD KEY buffers and field structure files with the fdlc utility.
Communication
Synchronous communication is made by using tpcall(). A send buffer and a receive buffer are specified separately.
Transaction
TMS assigns auto transactions.
-
Server program
Item Description Service
FDLSELECT and FDLINSERT are written.
Database
Oracle database is used. Database information is specified in SVRGROUP of a system
3.3. Common Program
DataBase EMP Table
The following is an example table to be created in a database.
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
Field Key Buffer Definition
The following is an example file that defines a field key buffer.
<demo.f>
#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 - -
Tmax Configuration
The following is an example Tmax configuration file.
<tmconfig.m>
*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 SVRNAME = emp_c
FDLUPDATE SVRNAME = emp_c
FDLDELETE SVRNAME = emp_c
FDLINSERT SVRNAME = emp_c
3.4. Client Program
Main Screen
The following is a Form design for the main screen.
The following describes each component in the Form design.
| Control Name | Control Type | Remarks |
|---|---|---|
EmployeeMgrForm |
Form |
Caption="Employee Management Program" |
LabelErr |
Label |
Caption="Error" |
BtnExit |
Command button |
Caption="Exit" |
BtnIns |
Command button |
Caption="Add" |
BtnDel |
Command button |
Caption="Delete" |
BtnUdt |
Command button |
Caption="Modify" |
BtnSel |
Command button |
Caption="Search" |
EditName |
Text box |
|
EditEmpNo |
Text box |
|
EditDept |
Text box |
|
EditComm |
Text box |
|
EditSal |
Text box |
|
EditDate |
Text box |
|
EditMgr |
Text box |
|
EditJob |
Text box |
|
MList |
Text box |
|
BtnReturn |
Text box |
The following is an example main design program for employee management.
Option Explicit
' Closing a search window '
Private Sub BtnReturn_Click()
Hide
EmployeeMgr.Show
End Sub
' Function that shows a search result when the search button is clicked '
Private Sub Form_Activate()
' tpstart execution function '
tmaxStart
Dim Isendbuf As IntPtr
Dim Irecvbuf As IntPtr
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 ' 1 if a transation started and 0 if not '
' tpstart '
tmaxStart
' Initializing the value of whether a transaction starts '
txbool = 0
initS = vbCrLf & vbTab & vbTab & vbTab & "***** Search Result *****"
& vbCrLf & vbTab & "================================================="
& vbCrLf & vbTab & "EmpNo Name Position Mgr JoinDate Salary COMM Dept"
& vbCrLf & vbTab & "================================================="
& vbCrLf & vbCrLf
If EmployeeMgr.EditEmpNo.text = "" Then
MsgBox "Enter an employee number."
Hide
EmployeeMgr.Show
Exit Sub
End If
' Allocating a buffer to send data '
Isendbuf = fballoc(100, 1024)
If Isendbuf = Null Then
TmaxError ("fballoc")
Call fbfree(Isendbuf)
tmaxEnd
Exit Sub
End If
' Allocating a buffer to receive data '
Irecvbuf = fballoc(100, 1024)
If Irecvbuf = Null Then
TmaxError ("fballoc")
Call fbfree(Irecvbuf)
tmaxEnd
Exit Sub
End If
' Getting an employee number from Employee management Form.
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
' Requesting a search servcie '
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
' Getting float data from a 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
' Displaying 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 IntPtr, Irecvbuf As IntPtr)
If txbool = 1 Then
tx_rollback
End If
' Freeing allocated buffers '
Call fbfree(ByVal Isendbuf&)
Call fbfree(ByVal Irecvbuf&)
' tpend execution function '
tmaxEnd
Exit Sub
End Sub
' tpstart '
Private Sub tmaxStart()
Dim ret As Integer
' Loading a configuration file. '
' Defined in the atmi.bas file. '
' Declare Function tmaxreadenv Lib "TMAX4GL.DLL"(ByVal envfile As String,
ByVal label As String) As Long'
' For more 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 IntPtr)
'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
The following is an example program that manages employees.
<EmployeeMgr.vb>
Option Strict Off
Option Explicit On
Imports WindowsApplication1.TmaxUtils.TmaxMacros
Public Class EmployeeMgr
Inherits System.Windows.Forms.Form
Public Shared EmpNo As Integer
#Region " Code created in Windows Form Designer "
#End Region
Private Sub BtnExit_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles BtnExit.Click
End
End Sub
Function getEmpNo()
Return EmpNo
End Function
Protected Overrides Sub Finalize()
MyBase.Finalize()
End Sub
Private Sub BtnSel_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles BtnSel.Click
Dim EmpGrid As EmployeeGrid
EmpGrid = New EmployeeGrid()
Hide()
EmpGrid.EmpNo = EditEmpNo.Text()
EmpGrid.ShowDialog()
Show()
End Sub
Private Sub BtnUdt_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles BtnUdt.Click
Dim Isendbuf As IntPtr
Dim Irecvbuf As IntPtr
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 txbool As Integer ' 1 if a transation started and 0 if not '
' tpstart '
tmaxStart()
' Initializing the value of whether a transaction starts '
txbool = 0
If EditEmpNo.Text = "" Then
MsgBox("Enter an employee number.")
tmaxEnd()
Exit Sub
End If
' Allocating a buffer to send data '
Isendbuf = fballoc(100, 1024)
If Isendbuf = 0 Then
Call fbfree(Isendbuf)
tmaxEnd()
Exit Sub
End If
' Allocating a buffer to receive data '
Irecvbuf = fballoc(100, 1024)
If Irecvbuf = 0 Then
Call fbfree(Irecvbuf)
tmaxEnd()
Exit Sub
End If
Iret = PUTLONG(Isendbuf, "EMPNO", 0, Trim(EditEmpNo.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTVAR(Isendbuf, "ENAME", 0, Trim(EditName.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTVAR(Isendbuf, "JOB", 0, Trim(EditJob.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTLONG(Isendbuf, "MGR", 0, Trim(EditMgr.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTVAR(Isendbuf, "DATE", 0, Trim(EditDate.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTFLOAT(Isendbuf, "SAL", 0, Trim(EditSal.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTFLOAT(Isendbuf, "COMM", 0, Trim(EditComm.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTLONG(Isendbuf, "DEPTNO", 0, Trim(EditDept.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
' Starting a transaction '
Iret = tx_begin()
If Iret = -1 Then
txbool = 1
Call ExitSub(txbool, Isendbuf, Irecvbuf)
Else
txbool = 1
End If
' Requesting a modification service '
Iret = tpcall("FDLUPDATE", Isendbuf, 0, Irecvbuf, Irbuflen, 0)
LabelErr.Text = "sbuf = " & Isendbuf & ", rbuf = " & Irecvbuf
If Iret < 0 Then
ViewErr(Irecvbuf)
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
' Freeing allocated buffers
' Saving the transaction '
Iret = tx_commit()
If Iret < 0 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
Else
txbool = 0
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
End Sub
Private Sub BtnDel_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles BtnDel.Click
Dim Isendbuf As IntPtr
Dim Irecvbuf As IntPtr
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 txbool As Integer ' 1 if a transation started and 0 if not '
' tpstart '
tmaxStart()
' Initializing the value of whether a transaction starts '
txbool = 0
If EditEmpNo.Text = "" Then
MsgBox("Enter an employee number.")
tmaxEnd()
Exit Sub
End If
value = Trim(EditEmpNo.Text)
' Allocating a buffer to send data '
Isendbuf = fballoc(100, 1024)
If Isendbuf = 0 Then
Call fbfree(Isendbuf)
tmaxEnd()
Exit Sub
End If
' Allocating a buffer to receive data '
Irecvbuf = fballoc(100, 1024)
If Irecvbuf = 0 Then
Call fbfree(Irecvbuf)
tmaxEnd()
Exit Sub
End If
Iret = PUTLONG(Isendbuf, "EMPNO", 0, value)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
' Starting a transaction '
Iret = tx_begin()
If Iret = -1 Then
txbool = 1
Call ExitSub(txbool, Isendbuf, Irecvbuf)
Else
txbool = 1
End If
' Requesting a search servcie '
Iret = tpcall("FDLDELETE", Isendbuf, 0, Irecvbuf, Irbuflen, 0)
If Iret = -1 Then
ViewErr(Irecvbuf)
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
' Saving the transaction '
Iret = tx_commit()
If Iret < 0 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
Else
txbool = 0
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
End Sub
Private Sub BtnIns_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles BtnIns.Click
Dim Isendbuf As IntPtr
Dim Irecvbuf As IntPtr
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 txbool As Integer ' 1 if a transation started and 0 if not '
' tpstart '
tmaxStart()
' Initializing the value of whether a transaction starts '
txbool = 0
If EditEmpNo.Text = "" Then
MsgBox("Enter an employee number.")
tmaxEnd()
Exit Sub
End If
' Allocating a buffer to send data '
Isendbuf = fballoc(100, 1024)
If Isendbuf = 0 Then
Call fbfree(Isendbuf)
tmaxEnd()
Exit Sub
End If
' Allocating a buffer to receive data '
Irecvbuf = fballoc(100, 1024)
If Irecvbuf = 0 Then
Call fbfree(Irecvbuf)
tmaxEnd()
Exit Sub
End If
Iret = PUTLONG(Isendbuf, "EMPNO", 0, Trim(EditEmpNo.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTVAR(Isendbuf, "ENAME", 0, Trim(EditName.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTVAR(Isendbuf, "JOB", 0, Trim(EditJob.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTLONG(Isendbuf, "MGR", 0, Trim(EditMgr.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTVAR(Isendbuf, "DATE", 0, Trim(EditDate.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTFLOAT(Isendbuf, "SAL", 0, Trim(EditSal.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTFLOAT(Isendbuf, "COMM", 0, Trim(EditComm.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = PUTLONG(Isendbuf, "DEPTNO", 0, Trim(EditDept.Text))
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
' Starting a transaction '
Iret = tx_begin()
If Iret = -1 Then
txbool = 1
Call ExitSub(txbool, Isendbuf, Irecvbuf)
Else
txbool = 1
End If
' Requesting a modification service '
Iret = tpcall("FDLINSERT", Isendbuf, 0, Irecvbuf, Irbuflen, 0)
If Iret = -1 Then
ViewErr(Irecvbuf)
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
' Saving the transaction '
Iret = tx_commit()
If Iret < 0 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
Else
txbool = 0
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
End Sub
Private Sub ExitSub(ByVal txbool As Integer, ByVal Isendbuf As IntPtr,
ByVal Irecvbuf As IntPtr)
If txbool = 1 Then
tx_rollback()
End If
' Freeing allocated buffers '
Call fbfree(Isendbuf)
Call fbfree(Irecvbuf)
' tpend '
tmaxEnd()
Exit Sub
End Sub
Private Sub tmaxStart()
Dim ret As Integer
Dim envFile As String
' Loading a configuration file. '
' Defined in the atmi.bas file. '
' Declare Function tmaxreadenv Lib "TMAX4GL.DLL" (ByVal envfile As String,
ByVal label As String)
As Long '
' For more information, refer to "Tmax Reference Guide". '
envFile = "C:\tmax.env"
ret = tmaxreadenv(envFile, "aix5l389")
If ret < 0 Then
MsgBox("Tmaxreadenv Error" & envFile)
Exit Sub
End If
ret = tpstart(0&)
If ret = -1 Then
LabelErr.Text = "tpstart error = " & gettperrno()
Else
LabelErr.Text = "tpstart return value = " & ret & " tpstart success"
End If
End Sub
Private Sub tmaxEnd()
Dim ret As Integer
ret = tpend()
If ret = -1 Then
LabelErr.Text = "tpend error = " & gettperrno()
Else
LabelErr.Text = "tpreturn return value = " & ret
End If
End Sub
Oracle Error Message Box
The following is a message box that shows an Oracle error.
The following is an example configuration that is necessary to display Oracle errors.
' Function that displays Oracle errors
Private Sub ViewErr(ByVal a As IntPtr)
'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
GETLONG(a, "E_TYPE", 0, typeL)
GETLONG(a, "E_CODE", 0, codeL)
GETVAR(a, "E_MSG", 0, msgS)
GETLONG(a, "E_TMP", 0, tmpL)
MsgBox("Error Type : " & typeL & " ,Code : " & codeL & " ,Message :
" & msgS & " ,Tmp : " & tmpL)
End Sub
End Class
Search Screen
The following is a Form design for the search screen.
The following describes each component in the From design.
| Control Name | Control Type | Property that must Be Modified |
|---|---|---|
EmployeeGrid |
Form |
Caption="Employee Information List" |
ListTextBox |
Text box |
MultiLine=True |
BtnReturn |
Command button |
Caption="Back" |
The following is an example search screen design program for employee management.
<EmployeeGrid.frm>
Option Strict Off
Option Explicit On
Imports WindowsApplication1.TmaxUtils.TmaxMacros
Imports System.IO
Public Class EmployeeGrid
Inherits System.Windows.Forms.Form
Public Shared EmpNo As Integer
#Region " Code created in Windows Form Designer "
#End Region
Private Sub BtnReturn_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles BtnReturn.Click
Hide()
End Sub
Protected Overrides Sub OnLoad(ByVal e As System.EventArgs)
Dim Isendbuf, Irecvbuf As IntPtr
Dim Isendlen, Irecvlen As Integer
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 Integer
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 i As Integer
Dim txbool As Integer ' 1 if a transation started and 0 if not '
' tpstart '
tmaxStart()
' Initializing the value of whether a transaction starts '
txbool = 0
' Allocating a buffer to send data '
Isendbuf = fballoc(100, 1024)
If Isendbuf = 0 Then
Call fbfree(Isendbuf)
tmaxEnd()
Exit Sub
End If
' Allocating a buffer to receive data '
Irecvbuf = fballoc(100, 1024)
If Irecvbuf = 0 Then
Call fbfree(Irecvbuf)
tmaxEnd()
Exit Sub
End If
Iret = fbput(Isendbuf, fbget_fldkey("EMPNO"), EmpNo, lenL)
If Iret = -1 Then
FdlErrorMsg("fbput")
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
' Requesting a search servcie '
Iret = tpcall("FDLSELECT", Isendbuf, 0, Irecvbuf, Irbuflen, 0)
If Iret = -1 Then
ViewErr(Irecvbuf)
initS = vbCrLf & vbTab & vbTab & vbTab & "***** Search Result *****"
& vbCrLf & vbTab & "=========================================="
& vbCrLf & vbTab & "EmpNo Name Position Mgr JoinDate Salary COMM Dept"
& vbCrLf & vbTab & "=========================================="
& vbCrLf & vbCrLf
ListTextBox.Text = initS & " "
LabelErr.Text = "SAL = " & dvalue
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = fbkeyoccur(Irecvbuf, fbget_fldkey("EMPNO"))
For i = 0 To Iret - 1
' Displaying a returned data in a text box '
Iret = GETLONG(Irecvbuf, "EMPNO", i, value)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
empnoS = value
Iret = GETVAR(Irecvbuf, "ENAME", i, text)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
enameS = text
Iret = GETVAR(Irecvbuf, "JOB", i, text)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
jobS = text
Iret = GETLONG(Irecvbuf, "MGR", i, value)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
mgrS = value
Iret = GETVAR(Irecvbuf, "DATE", i, text)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
dateS = text
Iret = fbget_tu(Irecvbuf, fbget_fldkey("SAL"), i, svalue, 0)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
salS = svalue
Iret = fbget_tu(Irecvbuf, fbget_fldkey("COMM"), i, svalue, 0)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
commS = svalue
Iret = GETLONG(Irecvbuf, "DEPTNO", i, value)
If Iret = -1 Then
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
initS = vbCrLf & vbTab & vbTab & vbTab & "***** Search Result *****"
& vbCrLf & vbTab & "=========================================="
& vbCrLf & vbTab & "EmpNo Name Position Mgr JoinDate Salary COMM Dept"
& vbCrLf & vbTab & "=========================================="
& vbCrLf & vbCrLf
ListTextBox.Text = initS & outputS
LabelErr.Text = "SAL = " & dvalue
' Freeing allocated buffers '
Call fbfree(Isendbuf)
Call fbfree(Irecvbuf)
' tpend execution function '
tmaxEnd()
End Sub
Private Sub ExitSub(ByVal txbool As Integer, ByVal Isendbuf As IntPtr,
ByVal Irecvbuf As IntPtr)
If txbool = 1 Then
tx_rollback()
End If
' Freeing allocated buffers '
Call fbfree(Isendbuf)
Call fbfree(Irecvbuf)
' tpend '
tmaxEnd()
End
End Sub
Public Sub tmaxStart()
Dim ret As Integer
Dim envFile As String
' Loading a configuration file. '
' Defined in the atmi.bas file. '
' Declare Function tmaxreadenv Lib "TMAX4GL.DLL" (ByVal envfile As String,
ByVal label As String) As Long '
' For more information, refer to "Tmax Reference Guide". '
envFile = "C:\tmax.env"
ret = tmaxreadenv(envFile, "aix5l389")
If ret < 0 Then
MsgBox("Tmaxreadenv Error : " & envFile)
End
End If
ret = tpstart(0&)
If ret = -1 Then
MsgBox("Tpstart Error")
End
Else
LabelErr.Text = "tpstart return value = " & ret & " tpstart success"
End If
End Sub
Public Sub tmaxEnd()
Dim ret As Integer
ret = tpend()
If ret = -1 Then
MsgBox("Tpend Error")
End
Else
LabelErr.Text = "tpreturn return value = " & ret
End If
End Sub
Private Sub ViewErr(ByVal a As IntPtr)
'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
GETLONG(a, "E_TYPE", 0, typeL)
GETLONG(a, "E_CODE", 0, codeL)
GETVAR(a, "E_MSG", 0, msgS)
GETLONG(a, "E_TMP", 0, tmpL)
MsgBox("Error Type : " & typeL & " ,Code : " & codeL & " ,Message :
" & msgS & " ,Tmp : " & tmpL)
End Sub
End ClassOption Strict Off
Option Explicit On
Imports WindowsApplication1.TmaxUtils.TmaxMacros
Imports System.IO
Public Class EmployeeGrid
Inherits System.Windows.Forms.Form
Public Shared EmpNo As Integer
#Region " Code created in Windows Form Designer "
Public Sub New()
MyBase.New()
'This call is necessary in Windows Form Designer.
InitializeComponent()
'Add an initialization process after calling InitializeComponent().
End Sub
'Form cleans up components by redefining Dispose.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'The following is necessary for Windows Form Designer.
Private components As System.ComponentModel.IContainer
'Note: The following procedure is necessary for Windows Form Designer.
'Modify the procedure by using Windows Form Designer.
'Do not modify the procedure by using a code editor.
Friend WithEvents BtnReturn As System.Windows.Forms.Button
Friend WithEvents LabelErr As System.Windows.Forms.Label
Protected WithEvents ListTextBox As System.Windows.Forms.TextBox
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Me.ListTextBox = New System.Windows.Forms.TextBox()
Me.BtnReturn = New System.Windows.Forms.Button()
Me.LabelErr = New System.Windows.Forms.Label()
Me.SuspendLayout()
'
'ListTextBox
'
Me.ListTextBox.Location = New System.Drawing.Point(10, 12)
Me.ListTextBox.Multiline = True
Me.ListTextBox.Name = "ListTextBox"
Me.ListTextBox.Size = New System.Drawing.Size(472, 272)
Me.ListTextBox.TabIndex = 0
Me.ListTextBox.TabStop = False
Me.ListTextBox.Text = "TextBox" & Microsoft.VisualBasic.ChrW(13)
& Microsoft.VisualBasic.ChrW(10) & "Hello"
'
'BtnReturn
'
Me.BtnReturn.Location = New System.Drawing.Point(392, 288)
Me.BtnReturn.Name = "BtnReturn"
Me.BtnReturn.Size = New System.Drawing.Size(88, 32)
Me.BtnReturn.TabIndex = 1
Me.BtnReturn.Text = "Back"
'
'LabelErr
'
Me.LabelErr.Location = New System.Drawing.Point(20, 294)
Me.LabelErr.Name = "LabelErr"
Me.LabelErr.Size = New System.Drawing.Size(350, 23)
Me.LabelErr.TabIndex = 2
Me.LabelErr.Text = "Label1"
'
'EmployeeGrid
'
Me.AutoScaleBaseSize = New System.Drawing.Size(6, 14)
Me.ClientSize = New System.Drawing.Size(492, 323)
Me.Controls.AddRange(New System.Windows.Forms.Control()
{Me.LabelErr, Me.BtnReturn, Me.ListTextBox})
Me.Name = "EmployeeGrid"
Me.Text = "Employee Information List"
Me.ResumeLayout(False)
End Sub
#End Region
Private Sub BtnReturn_Click(ByVal sender As System.Object,
ByVal e As System.EventArgs) Handles BtnReturn.Click
Hide()
End Sub
Protected Overrides Sub OnLoad(ByVal e As System.EventArgs)
Dim Isendbuf, Irecvbuf As IntPtr
Dim Isendlen, Irecvlen As Integer
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 Integer
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 i As Integer
Dim txbool As Integer ' 1 if a transation started and 0 if not '
' tpstart '
tmaxStart()
' Initializing the value of whether a transaction starts '
txbool = 0
' Allocating a buffer to send data '
Isendbuf = fballoc(100, 1024)
If Isendbuf = 0 Then
Call fbfree(Isendbuf)
tmaxEnd()
Exit Sub
End If
' Allocating a buffer to receive data '
Irecvbuf = fballoc(100, 1024)
If Irecvbuf = 0 Then
Call fbfree(Irecvbuf)
tmaxEnd()
Exit Sub
End If
Iret = fbput(Isendbuf, fbget_fldkey("EMPNO"), EmpNo, lenL)
If Iret = -1 Then
FdlErrorMsg("fbput")
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
' Requesting a search servcie '
Iret = tpcall("FDLSELECT", Isendbuf, 0, Irecvbuf, Irbuflen, 0)
If Iret = -1 Then
ViewErr(Irecvbuf)
initS = vbCrLf & vbTab & vbTab & vbTab & "***** Search Result *****"
& vbCrLf & vbTab & "=========================================="
& vbCrLf & vbTab & "EmpNo Name Position Mgr JoinDate Salary COMM Dept"
& vbCrLf & vbTab & "=========================================="
& vbCrLf & vbCrLf
ListTextBox.Text = initS & " "
LabelErr.Text = "SAL = " & dvalue
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
Iret = fbkeyoccur(Irecvbuf, fbget_fldkey("EMPNO"))
For i = 0 To Iret - 1
' Displaying returned data in the text box '
Iret = GETLONG(Irecvbuf, "EMPNO", i, value)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
empnoS = value
Iret = GETVAR(Irecvbuf, "ENAME", i, text)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
enameS = text
Iret = GETVAR(Irecvbuf, "JOB", i, text)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
jobS = text
Iret = GETLONG(Irecvbuf, "MGR", i, value)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
mgrS = value
Iret = GETVAR(Irecvbuf, "DATE", i, text)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
dateS = text
Iret = fbget_tu(Irecvbuf, fbget_fldkey("SAL"), i, svalue, 0)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
salS = svalue
Iret = fbget_tu(Irecvbuf, fbget_fldkey("COMM"), i, svalue, 0)
If Iret = -1 Then
Call ExitSub(txbool, Isendbuf, Irecvbuf)
End If
commS = svalue
Iret = GETLONG(Irecvbuf, "DEPTNO", i, value)
If Iret = -1 Then
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
initS = vbCrLf & vbTab & vbTab & vbTab & "***** Search Result *****"
& vbCrLf & vbTab & "=========================================="
& vbCrLf & vbTab & "EmpNo Name Position Mgr JoinDate Salary COMM Dept"
& vbCrLf & vbTab & "=========================================="
& vbCrLf & vbCrLf
ListTextBox.Text = initS & outputS
LabelErr.Text = "SAL = " & dvalue
' Freeing allocated buffers '
Call fbfree(Isendbuf)
Call fbfree(Irecvbuf)
' tpend execution function '
tmaxEnd()
End Sub
Private Sub ExitSub(ByVal txbool As Integer, ByVal Isendbuf As IntPtr,
ByVal Irecvbuf As IntPtr)
If txbool = 1 Then
tx_rollback()
End If
' Freeing allocated buffers '
Call fbfree(Isendbuf)
Call fbfree(Irecvbuf)
' tpend '
tmaxEnd()
End
End Sub
Public Sub tmaxStart()
Dim ret As Integer
Dim envFile As String
' Loading a configuration file. '
' Defined in the atmi.bas file.'
' Declare Function tmaxreadenv Lib "TMAX4GL.DLL" (ByVal envfile As String,
ByVal label As String) As Long '
' For more information, refer to "Tmax Reference Guide". '
envFile = "C:\tmax.env"
ret = tmaxreadenv(envFile, "aix5l389")
If ret < 0 Then
MsgBox("Tmaxreadenv Error : " & envFile)
End
End If
ret = tpstart(0&)
If ret = -1 Then
MsgBox("Tpstart Error")
End
Else
LabelErr.Text = "tpstart return value = " & ret & " tpstart success"
End If
End Sub
Public Sub tmaxEnd()
Dim ret As Integer
ret = tpend()
If ret = -1 Then
MsgBox("Tpend Error")
End
Else
LabelErr.Text = "tpreturn return value = " & ret
End If
End Sub
Private Sub ViewErr(ByVal a As IntPtr)
'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
GETLONG(a, "E_TYPE", 0, typeL)
GETLONG(a, "E_CODE", 0, codeL)
GETVAR(a, "E_MSG", 0, msgS)
GETLONG(a, "E_TMP", 0, tmpL)
MsgBox("Error Type : " & typeL & " ,Code : " & codeL & " ,Message :
" & msgS & " ,Tmp : " & tmpL)
End Sub
End Class
3.5. Server Program
Service Program
The following is an example service program.
<emp_c.pc>
#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 Handling: If a service error occurs, the error will be entered in a buffer and then sent to a 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 has no privilege.");
break;
default:
strcpy(err_msg,
"An input error message has not been 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) {
/* An error message is set. ******/
switch(err_code) {
case -500: /* SYSTEM error */
strcpy(err_msg, "Failed to create a file.");
break;
case -502:
strcpy(err_msg,"Could not call an internal service.");
break;
case -504:
strcpy(err_msg, "This is a socket communication error.");
break;
case -505: /* When a change was made in another transaction */
/* "[%s] was changed in another transaction after it was queried.
\n\nHandle it after querying it again.": Handling in CLIENT */
strcpy(err_msg, "does not exist.");
break;
case -5002:
strcpy(err_msg, "Contact with a technical team.");
break;
default:
strcpy(err_msg,
"An application error message has not been 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);
}
Makefile
The following is an example Makefile that builds emp_c.pc into a Tmax application
<emp_c.mk>
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