Delphi Interface

This chapter describes functions used by Delphi interface with examples.fName used to receive a message

1. Overview

A Delphi interface is a strong alternative to Visual Basic. It includes interface modules used to call the functions provided by client library. All functions are available by installing an interface module. Unlike Power Builder or Visual Basic, Delphi supports the concept of a pointer and passes a value in the same way as C language. In addition, Delphi uses the Pascal syntax so that those who are familiar with existing languages can easily use Delphi. Therefore, additional macro or component is not needed to use Delphi.

The followings are the components of Delphi interface.

Module Description

atmi.pas

File that defines a prototype for atmi functions.

fdl.pas

File that defines a prototype for field key functions

For detailed information about the prototypes and functions of atmi and field key functions, refer to Tmax Reference Guide and Tmax Application Development Guide. The usage of Delphi interface will be explained in the example programs.

2. Example Program

The programs retrieve the name and department of an employee from Oracle database when the employee number is entered.

2.1. Program Configuration

Add Atmi.pas, fdl.pas, TuxSvc.pas as a module in project.

  • Common programs

    Program file Description

    demo.f

    File that defines a field key buffer.

    tmax

    Library file.

  • Client programs

    Program file Description

    Atmi.dcu

    Object file created by compiling an atmi source file.

    Atmi.pas

    File that defines a prototype for atmi functions.

    EmployeeMgr.bpg

    Project group file.

    EmployeeMgr.cfg

    Project environment configuration file.

    EmployeeMgr.dof

    Delphi option file.

    EmployeeMgr.dpr

    Project file that has multiple pas files and dfm files.

    EmployeeMgr.exe

    Executable object file.

    EmployeeMgr.res

    Compiled binary resource file.

    Fdl.dcu

    Object file created by compiling an Fdl source file.

    Fdl.pas

    File that defines a prototype for field key functions.

    TuxSvc.pas

    Tuxedo convertible source file.

    main.dcu

    Object file created by compiling a main source file.

    main.dfm

    Main form file.

    main.pas

    Client program.

  • Server programs

    Program file Description

    emp_c.mk

    Makefile.

    emp_c.pc

    Server program. AIX and Oracle 9i are used.

    employee.m

    Tmax environment configuration file.

2.2. Program Features

  • Client programs

    Function Description

    Tmax connection

    A Tmax user account, and a user name for application definition are used as an argument.

    Buffer type

    An 'fdl' file needs to be created by compiling a field key buffer and a field key file using the fdlc utility.

    Communication mode

    Synchrnomous communication using tpcall(). A send buffer and a receive buffer are the same.

    Transaction option

    TMS allocates AutoTransaction.

  • Server programs

    Function Description

    Service

    FDLSELECT, FDLDELETE, FDLUPDATE, and FDLINSERT need to be created.

    Database

    Oracle database. Database information is specified in SVRGROUP of a system configuration file.

2.3. Common Programs

DataBase EMP Table

The following is an example of a basic table used for operating a DB.

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 example 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 Environment Configuration

The following shows an example of Tmax environment 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

2.4. Client Programs

Main Screen Format Design

The following shows a main screen format.

image

The following table shows the components of a main screen format.

Control name Control type Note

EmployeeMgrForm

Form

Caption="Employee management program"

LabelErr

TLabel

Caption="Error"

BtnExit

TButton

Caption="Close"

BtnIns

TButton

Caption="Insert"

BtnDel

TButton

Caption="Delete"

BtnUdt

TButton

Caption="Update"

BtnSel

TButton

Caption="Query"

EditName

TEdit

EditEmpNo

TEdit

EditDept

TEdit

EditComm

TEdit

EditSal

TEdit

EditDate

TEdit

EditMgr

TEdit

EditJob

TEdit

MList

TEdit

BtnReturn

TEdit

The following example executes a designed main screen format.

<main.pas>

unit main;

interface

uses
    Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
    StdCtrls;

type
    TEmployeeMgrForm = class(TForm)
       LabelEmpNo: TLabel;
       LabelName: TLabel;
       EditEmpNo: TEdit;
       EditName: TEdit;
       GroupBoxInfo: TGroupBox;
       LabelJob: TLabel;
       LabelMgr: TLabel;
       LabelDate: TLabel;
       LabelSal: TLabel;
       EditJob: TEdit;
       EditMgr: TEdit;
       EditDate: TEdit;
       EditSal: TEdit;
       EditComm: TEdit;
       EditDept: TEdit;
       LabelComm: TLabel;
       LabelDept: TLabel;
       BtnSel: TButton;
       BtnUdt: TButton;
       BtnDel: TButton;
       BtnIns: TButton;
       BtnExit: TButton;
       LabelErr: TLabel;
       MList: TMemo;
       BtnReturn: TButton;
       procedure BtnExitClick(Sender: TObject);
       procedure BtnSelClick(Sender: TObject);
       procedure BtnUdtClick(Sender: TObject);
       procedure BtnDelClick(Sender: TObject);
       procedure BtnInsClick(Sender: TObject);
       procedure tmaxStart();
       procedure BtnReturnClick(Sender: TObject);
       procedure ViewErr(a:Pointer);

       { Private declarations }
  public
       { Public declarations }
  end;

var
    EmployeeMgrForm: TEmployeeMgrForm;

implementation

// Use Atmi and Fdl
uses Atmi, Fdl;
const BufferSize = 1024;

{$R *.DFM}

// The length of a string is omitted.{$H+}
{$H+}

procedure TEmployeeMgrForm.tmaxStart();

var
    tpinfo: pTPSTART;
    ret: integer;

begin
    // Defined in the atmi.pas file.
    // Function tmaxreadenv(a:PChar; b:PChar):Integer; cdecl; external TmaxDLL;
    // For the detailed information, refer to Tmax Reference Guide.
    ret := tmaxreadenv('C:\tmax.env', 'aix5l389');
    if ret < 0 then begin
        ShowMessage('tmaxreadenv Error');
        Exit;
    end;
    // Allocate a buffer to send user information for tpstart.
    tpinfo := tpalloc('TPSTART', NIL, 0);

    if tpinfo = Nil then begin
        ShowMessage('tpinfo tpalloc failed,' + StrPas(tpstrerror(gettperrno)));
        tpfree(tpinfo);
        Exit;
    end;
    //
    // The following options can be specified.
    //
    // User account for authentication
    // tpinfo.usrname := 'tmax';
    // Name used to receive a message voluntarily
    // tpinfo.cltname := 'tmax';
    // Allow to accept a message voluntarily
    // tpinfo.flags := TPUNSOL_POLL;

    // Tmax connection
    ret := tpstart(tpinfo);
    if ret < 0 then begin
        ShowMessage('tpstart failed' + StrPas(tpstrerror(gettperrno)));
        tpfree(tpinfo);
        tpend();
        Exit;
    end;
    // Free the buffer used to send user information
    tpfree(tpinfo);
end;

// When the Close button is clicked.
procedure TEmployeeMgrForm.BtnExitClick(Sender: TObject);
begin
    tpend();
    close;
end;


procedure TEmployeeMgrForm.BtnUdtClick(Sender: TObject);

var sndbuf, revbuf: Pointer;
    ret, empno_l, mgr_l, deptno_l: longint;
    sal_f, comm_f: single;
    job_s, ename_s: pointer;
    rlen: integer;
    date_s: string[100];

begin

    tmaxStart();

    // Allocate a buffer to send
    sndbuf := fballoc(1000, 10000);
    if sndbuf = Nil then begin
        ShowMessage('sndbuf tpalloc failed, ' + StrPas(tpstrerror(gettperrno)));
        fbfree(sndbuf);
        tpend();
        Exit;
    end;

    // Allocate a buffer to receive
    revbuf := fballoc(1000, 10000);
    if revbuf = Nil then begin
        ShowMessage('revbuf tpalloc failed, ' + StrPas(tpstrerror(gettperrno)));
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    empno_l := StrToInt(EditEmpNo.text);
    fbput(sndbuf, fbget_fldkey('EMPNO'), @empno_l, 0);

    ename_s := PChar(EditName.text);
    fbput(sndbuf, fbget_fldkey('ENAME'), ename_s, 0);

    job_s := PChar(EditJob.text);
    fbput(sndbuf, fbget_fldkey('JOB'), job_s, 0);

    mgr_l := StrToInt(EditMgr.text);
    fbput(sndbuf, fbget_fldkey('MGR'), @mgr_l, 0);

    // date_s := PChar(EditDate.text);
    // fbput(sndbuf, fbget_fldkey('DATE'), @date_s, 0);
    date_s := EditDate.text;
    rlen := length(EditDate.text);
    ret := fbchg_tu(sndbuf, fbget_fldkey('DATE'),0 ,@date_s[1], 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'DATE error!!!';
        Exit;
    end;

    sal_f := StrToFloat(EditSal.text);
    fbput(sndbuf, fbget_fldkey('SAL'), @sal_f, 0);

    comm_f := StrToFloat(EditComm.text);
    fbput(sndbuf, fbget_fldkey('COMM'), @comm_f, 0);

    deptno_l := StrToInt(EditDept.text);
    fbput(sndbuf, fbget_fldkey('DEPTNO'), @deptno_l, 0);

    // Begin a transaction
    ret := tx_begin();
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'tx_begin error';
        Exit;
    end;


    // Initiate a service
    ret := tpcall('FDLUPDATE', sndbuf, 0, @revbuf, @rlen, 0);
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    ret := tx_commit();
    if ret < 0 then begin
        ShowMessage('tx_commit failed! ' + StrPas(tpstrerror(gettperrno)));
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    // Free the allocated buffer
    fbfree(sndbuf);
    fbfree(revbuf);
    tpend();
end;

procedure TEmployeeMgrForm.BtnDelClick(Sender: TObject);
var sndbuf, revbuf: Pointer;
    empno_l, ret: longint;
    rlen: integer;

begin

    tmaxStart();

    // Allocate a buffer to send data to the server
    sndbuf := fballoc(1000, 10000);
    if sndbuf = Nil then begin
        ShowMessage('sndbuf tpalloc failed, ' + StrPas(tpstrerror(gettperrno)));
        tpend();
        Exit;
    end;

    // Allocate a buffer to receive data from the server
    revbuf := fballoc(1000, 10000);
    if sndbuf = Nil then begin
        ShowMessage('sndbuf tpalloc failed, ' + StrPas(tpstrerror(gettperrno)));
        tpend();
        Exit;
    end;

    empno_l := StrToInt(EditEmpNo.text);
    fbput(sndbuf, fbget_fldkey('EMPNO'), @empno_l, 0);

    // Begin a transaction
    ret := tx_begin();
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'tx_begin error';
        Exit;
    end;

    // Send a service request to the server
    ret := tpcall('FDLDELETE', sndbuf, 0, @revbuf, @rlen, 0);
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    ret := tx_commit();
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    // Free the allocated buffer
    fbfree(sndbuf);
    fbfree(revbuf);

    tpend();
end;

procedure TEmployeeMgrForm.BtnInsClick(Sender: TObject);
var sndbuf, revbuf: Pointer;
    empno_l, mgr_l, deptno_l: longint;
    sal_f, comm_f: single;
    job_s, ename_s, date_s: string[100];
    ret, rlen: integer;

begin

    // Function to call tpstart
    tmaxStart();

    // Allocate a buffer to send
    LabelErr.Caption := '';
    sndbuf := fballoc(1000,10000);
    if sndbuf = Nil then begin
        LabelErr.Caption := 'sndbuf tpalloc failed, '
                            + StrPas(tpstrerror(gettperrno));
        fbfree(sndbuf);
        tpend();
        Exit;
    end;
    revbuf := fballoc(100,1000);
    if revbuf = Nil then begin
        LabelErr.Caption := 'revbuf tpalloc failed, '
                            + StrPas(tpstrerror(gettperrno));
        fbfree(revbuf);
        tpend();
        Exit;
    end;


    empno_l := StrToInt(EditEmpNo.text);
    ret := fbput(sndbuf, fbget_fldkey('EMPNO'), @empno_l, 0);
    if ret = -1 then begin
        LabelErr.Caption := 'EMPNO error!!!';
        Exit;
    end;

    ename_s := EditName.text;
    rlen := length(EditName.text);
    ret := fbchg_tu(sndbuf, fbget_fldkey('ENAME'),0 ,@ename_s[1], 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'ENAME error!!!';
        Exit;
    end;

    job_s := EditJob.text;
    rlen := length(EditJob.text);
    ret := fbchg_tu(sndbuf, fbget_fldkey('JOB'),0 ,@job_s[1], 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'JOB error!!!';
        Exit;
    end;

    mgr_l := StrToInt(EditMgr.text);
    ret := fbput(sndbuf, fbget_fldkey('MGR'), @mgr_l, 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'MGR error!!!';
        Exit;
    end;

    date_s := EditDate.text;
    rlen := length(EditDate.text);
    ret := fbchg_tu(sndbuf, fbget_fldkey('DATE'),0 ,@date_s[1], 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'DATE error!!!';
        Exit;
    end;

    sal_f := StrToFloat(EditSal.text);
    ret := fbput(sndbuf, fbget_fldkey('SAL'), @sal_f, 0);
    if ret = -1 then begin
       LabelErr.Caption := LabelErr.Caption + 'SAL error!!!';
       Exit;
    end;

    comm_f := StrToFloat(EditComm.text);
    ret := fbput(sndbuf, fbget_fldkey('COMM'), @comm_f, 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'COMM error!!!';
        Exit;
    end;

    deptno_l := StrToInt(EditDept.text);
    ret := fbput(sndbuf, fbget_fldkey('DEPTNO'), @deptno_l, 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'DEPTNO error!!!';
        Exit;
    end;

    // Begin a transaction
    ret := tx_begin();
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'tx_begin error';
        Exit;
    end;

    // Initiate a service
    ret := tpcall('FDLINSERT', sndbuf, 0, @revbuf, @rlen, 0);
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    ret := tx_commit();
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    // Free a buffer to send data
    fbfree(revbuf);
    fbfree(sndbuf);
    tpend();
end;

procedure TEmployeeMgrForm.BtnReturnClick(Sender: TObject);
begin
    BtnReturn.Visible := false;
    MList.Visible := false;
end;

procedure TEmployeeMgrForm.ViewErr( a:Pointer );
var   typeS: PChar;
      codeS: PChar;
      msgS: PChar;
      tmpS: PChar;
     // Iret: Integer;
begin
    // E_TYPE     9009    long    -   -
    // E_CODE     9010    long    -   -
    // E_MSG      9011    string  -   -
    // E_TMP      9012    long    -   -

    typeS := fbgetvals(a, fbget_fldkey('E_TYPE'), 0);
    codeS := fbgetvals(a, fbget_fldkey('E_CODE'), 0);
    msgS := fbgetvals(a, fbget_fldkey('E_MSG'), 0);
    tmpS := fbgetvals(a, fbget_fldkey('E_TMP'), 0);
    ShowMessage('Error Type : ' + typeS + ' ,Code : ' + codeS +  ' ,Message :
                ' + msgS + ' ,Tmp : ' + tmpS);
end;
Inquiry Screen

The following figure shows an inquiry screen format.

image

The following example executes a designed inquiry screen format.

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TEmployeeMgrForm = class(TForm)
     LabelEmpNo: TLabel;
     LabelName: TLabel;
     EditEmpNo: TEdit;
     EditName: TEdit;
     GroupBoxInfo: TGroupBox;
     LabelJob: TLabel;
     LabelMgr: TLabel;
     LabelDate: TLabel;
     LabelSal: TLabel;
     EditJob: TEdit;
     EditMgr: TEdit;
     EditDate: TEdit;
     EditSal: TEdit;
     EditComm: TEdit;
     EditDept: TEdit;
     LabelComm: TLabel;
     LabelDept: TLabel;
     BtnSel: TButton;
     BtnUdt: TButton;
     BtnDel: TButton;
     BtnIns: TButton;
     BtnExit: TButton;
     LabelErr: TLabel;
     MList: TMemo;
     BtnReturn: TButton;
     procedure BtnExitClick(Sender: TObject);
     procedure BtnSelClick(Sender: TObject);
     procedure BtnUdtClick(Sender: TObject);
     procedure BtnDelClick(Sender: TObject);
     procedure BtnInsClick(Sender: TObject);
     procedure tmaxStart();
     procedure BtnReturnClick(Sender: TObject);
     procedure ViewErr( a:Pointer );

     { Private declarations }
  public
     { Public declarations }
  end;

var
     EmployeeMgrForm: TEmployeeMgrForm;

implementation

// Use Atmi and Fdl.
uses Atmi, Fdl;
const BufferSize = 1024;

{$R *.DFM}

// The value of a string is omitted.
{$H+}

procedure TEmployeeMgrForm.tmaxStart();

var
    tpinfo: pTPSTART;
    ret: integer;

begin
    // Defined in the atmi.pas file.
    // Function tmaxreadenv(a:PChar; b:PChar):Integer; cdecl; external TmaxDLL;
    // For the detailed information, refer to Tmax Reference Guide.
    ret := tmaxreadenv('C:\tmax.env', 'aix5l389');
    if ret < 0 then begin
        ShowMessage('tmaxreadenv Error');
        Exit;
    end;
    // Send a buffer used to send user information for tpstart.
    tpinfo := tpalloc('TPSTART', NIL, 0);

    if tpinfo = Nil then begin
        ShowMessage('tpinfo tpalloc failed,' + StrPas(tpstrerror(gettperrno)));
        tpfree(tpinfo);
        Exit;
    end;
    //
    // The following options can be specified.
    //
    // User account for authentication
    // tpinfo.usrname := 'tmax';
    // Name used to receive a message voluntarily
    // tpinfo.cltname := 'tmax';
    // Allow to accept a message voluntarily
    // tpinfo.flags := TPUNSOL_POLL;

    // Tmax connection
    ret := tpstart(tpinfo);
    if ret < 0 then begin
        ShowMessage('tpstart failed' + StrPas(tpstrerror(gettperrno)));
        tpfree(tpinfo);
        tpend();
        Exit;
    end;
    // Free the buffer used to send user information
    tpfree(tpinfo);
end;

// When the Close button is clicked.
procedure TEmployeeMgrForm.BtnExitClick(Sender: TObject);
begin
    tpend();
    close;
end;


procedure TEmployeeMgrForm.BtnUdtClick(Sender: TObject);

var sndbuf, revbuf: Pointer;
    ret, empno_l, mgr_l, deptno_l: longint;
    sal_f, comm_f: single;
    job_s, ename_s: pointer;
    rlen: integer;
    date_s: string[100];

begin

    tmaxStart();

    // Allocate a buffer to send
    sndbuf := fballoc(1000, 10000);
    if sndbuf = Nil then begin
        ShowMessage('sndbuf tpalloc failed, ' + StrPas(tpstrerror(gettperrno)));
        fbfree(sndbuf);
        tpend();
        Exit;
    end;

    // Allocate a buffer to receive
    revbuf := fballoc(1000, 10000);
    if revbuf = Nil then begin
        ShowMessage('revbuf tpalloc failed, ' + StrPas(tpstrerror(gettperrno)));
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    empno_l := StrToInt(EditEmpNo.text);
    fbput(sndbuf, fbget_fldkey('EMPNO'), @empno_l, 0);

    ename_s := PChar(EditName.text);
    fbput(sndbuf, fbget_fldkey('ENAME'), ename_s, 0);

    job_s := PChar(EditJob.text);
    fbput(sndbuf, fbget_fldkey('JOB'), job_s, 0);

    mgr_l := StrToInt(EditMgr.text);
    fbput(sndbuf, fbget_fldkey('MGR'), @mgr_l, 0);

    // date_s := PChar(EditDate.text);
    // fbput(sndbuf, fbget_fldkey('DATE'), @date_s, 0);
    date_s := EditDate.text;
    rlen := length(EditDate.text);
    ret := fbchg_tu(sndbuf, fbget_fldkey('DATE'),0 ,@date_s[1], 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'DATE error!!!';
        Exit;
    end;

    sal_f := StrToFloat(EditSal.text);
    fbput(sndbuf, fbget_fldkey('SAL'), @sal_f, 0);

    comm_f := StrToFloat(EditComm.text);
    fbput(sndbuf, fbget_fldkey('COMM'), @comm_f, 0);

    deptno_l := StrToInt(EditDept.text);
    fbput(sndbuf, fbget_fldkey('DEPTNO'), @deptno_l, 0);

    // Begin a transaction
    ret := tx_begin();
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'tx_begin error';
        Exit;
    end;


    // Initiate a service
    ret := tpcall('FDLUPDATE', sndbuf, 0, @revbuf, @rlen, 0);
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    ret := tx_commit();
    if ret < 0 then begin
        ShowMessage('tx_commit failed! ' + StrPas(tpstrerror(gettperrno)));
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    // Free the allocated buffer
    fbfree(sndbuf);
    fbfree(revbuf);
    tpend();
end;

procedure TEmployeeMgrForm.BtnDelClick(Sender: TObject);
var sndbuf, revbuf: Pointer;
    empno_l, ret: longint;
    rlen: integer;

begin

    tmaxStart();

    // Allocate a buffer to send data to the server
    sndbuf := fballoc(1000, 10000);
    if sndbuf = Nil then begin
        ShowMessage('sndbuf tpalloc failed, ' + StrPas(tpstrerror(gettperrno)));
        tpend();
        Exit;
    end;

    // Allocate a buffer to receive data from the server
    revbuf := fballoc(1000, 10000);
    if sndbuf = Nil then begin
        ShowMessage('sndbuf tpalloc failed, ' + StrPas(tpstrerror(gettperrno)));
        tpend();
        Exit;
    end;

    empno_l := StrToInt(EditEmpNo.text);
    fbput(sndbuf, fbget_fldkey('EMPNO'), @empno_l, 0);

    // Begin a transaction
    ret := tx_begin();
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'tx_begin error';
        Exit;
    end;

    // Send a service request to the server
    ret := tpcall('FDLDELETE', sndbuf, 0, @revbuf, @rlen, 0);
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    ret := tx_commit();
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    // Free the allocated buffer
    fbfree(sndbuf);
    fbfree(revbuf);

    tpend();
end;

procedure TEmployeeMgrForm.BtnInsClick(Sender: TObject);
var sndbuf, revbuf: Pointer;
    empno_l, mgr_l, deptno_l: longint;
    sal_f, comm_f: single;
    job_s, ename_s, date_s: string[100];
    ret, rlen: integer;

begin

    // Function to call tpstart
    tmaxStart();

    // Allocate a buffer to send
    LabelErr.Caption := '';
    sndbuf := fballoc(1000,10000);
    if sndbuf = Nil then begin
        LabelErr.Caption := 'sndbuf tpalloc failed, '
                             + StrPas(tpstrerror(gettperrno));
        fbfree(sndbuf);
        tpend();
        Exit;
    end;
    revbuf := fballoc(100,1000);
    if revbuf = Nil then begin
        LabelErr.Caption := 'revbuf tpalloc failed, '
                             + StrPas(tpstrerror(gettperrno));
        fbfree(revbuf);
        tpend();
        Exit;
    end;


    empno_l := StrToInt(EditEmpNo.text);
    ret := fbput(sndbuf, fbget_fldkey('EMPNO'), @empno_l, 0);
    if ret = -1 then begin
        LabelErr.Caption := 'EMPNO error!!!';
        Exit;
    end;

    ename_s := EditName.text;
    rlen := length(EditName.text);
    ret := fbchg_tu(sndbuf, fbget_fldkey('ENAME'),0 ,@ename_s[1], 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'ENAME error!!!';
        Exit;
    end;

    job_s := EditJob.text;
    rlen := length(EditJob.text);
    ret := fbchg_tu(sndbuf, fbget_fldkey('JOB'),0 ,@job_s[1], 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'JOB error!!!';
        Exit;
    end;

    mgr_l := StrToInt(EditMgr.text);
    ret := fbput(sndbuf, fbget_fldkey('MGR'), @mgr_l, 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'MGR error!!!';
        Exit;
    end;

    date_s := EditDate.text;
    rlen := length(EditDate.text);
    ret := fbchg_tu(sndbuf, fbget_fldkey('DATE'),0 ,@date_s[1], 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'DATE error!!!';
        Exit;
    end;

    sal_f := StrToFloat(EditSal.text);
    ret := fbput(sndbuf, fbget_fldkey('SAL'), @sal_f, 0);
    if ret = -1 then begin
       LabelErr.Caption := LabelErr.Caption + 'SAL error!!!';
       Exit;
    end;

    comm_f := StrToFloat(EditComm.text);
    ret := fbput(sndbuf, fbget_fldkey('COMM'), @comm_f, 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'COMM error!!!';
        Exit;
    end;

    deptno_l := StrToInt(EditDept.text);
    ret := fbput(sndbuf, fbget_fldkey('DEPTNO'), @deptno_l, 0);
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'DEPTNO error!!!';
        Exit;
    end;

    // Begin a transaction
    ret := tx_begin();
    if ret = -1 then begin
        LabelErr.Caption := LabelErr.Caption + 'tx_begin error';
        Exit;
    end;

    // Initiate a service
    ret := tpcall('FDLINSERT', sndbuf, 0, @revbuf, @rlen, 0);
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    ret := tx_commit();
    if ret < 0 then begin
        ViewErr(revbuf);
        tx_rollback();
        fbfree(sndbuf);
        fbfree(revbuf);
        tpend();
        Exit;
    end;

    // Free the allocated buffer
    fbfree(revbuf);
    fbfree(sndbuf);
    tpend();
end;

procedure TEmployeeMgrForm.BtnReturnClick(Sender: TObject);
begin
    BtnReturn.Visible := false;
    MList.Visible := false;
end;

procedure TEmployeeMgrForm.ViewErr( a:Pointer );
var  typeS: PChar;
     codeS: PChar;
     msgS: PChar;
     tmpS: PChar;
     // Iret: Integer;
begin
    // E_TYPE          9009    long    -   -
    // E_CODE          9010    long    -   -
    // E_MSG           9011    string  -   -
    // E_TMP           9012    long    -   -

    typeS := fbgetvals(a, fbget_fldkey('E_TYPE'), 0);
    codeS := fbgetvals(a, fbget_fldkey('E_CODE'), 0);
    msgS := fbgetvals(a, fbget_fldkey('E_MSG'), 0);
    tmpS := fbgetvals(a, fbget_fldkey('E_TMP'), 0);
    ShowMessage('Error Type : ' + typeS + ' ,Code : ' + codeS +  ' ,Message : '
                 + msgS + ' ,Tmp : ' + tmpS);
end;
Oracle Error Display

The following figure is an Oracle error message display screen.

image

The following example executes an Oracle error display screen.

procedure TEmployeeMgrForm.ViewErr( a:Pointer );
var     typeS: PChar;
        codeS: PChar;
        msgS: PChar;
        tmpS: PChar;
        // Iret: Integer;
begin
    // E_TYPE      9009    long    -   -
    // E_CODE      9010    long    -   -
    // E_MSG       9011    string  -   -
    // E_TMP       9012    long    -   -

    typeS := fbgetvals(a, fbget_fldkey('E_TYPE'), 0);
    codeS := fbgetvals(a, fbget_fldkey('E_CODE'), 0);
    msgS := fbgetvals(a, fbget_fldkey('E_MSG'), 0);
    tmpS := fbgetvals(a, fbget_fldkey('E_TMP'), 0);
    ShowMessage('Error Type : ' + typeS + ' ,Code : ' + codeS +  ' ,Message :
                ' + msgS + ' ,Tmp : ' + tmpS);
end;

2.5. Server Programs

Service Programs

The following is an example of service program.

<em4p_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 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 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) {
                    /* 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);
}
Makefile

The following example creates an emp_c.pc source as 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