前言
本人使用最近在学习tuxedo,前台使用Delphi开发,在网上翻阅了无数的资料,过程曲折,遇到了很多的问题。况且在网上有关Delphi调用Tuxedo的资料也不多,很多问题都要靠自己解决。为了总结自己的学习过程,同时也将相关经验和大家共享,遂有了写这篇文章的冲动。由于本人知识有限,在本文中难免会有错误,还请及时指正。
一:Tuxedo安装及配置(Windows)
1.1 环境
Tuxedo:Tuxedo8.0
系统:WindowsXP
C编译器:Microsoft Visual C++ 6.0
1.2 安装文件
Tuxedo: tuxedo80_win.exe(安装文件),R406_TUX80_I-WNT40-2000-XP.exe(补订),Lience(下载地址为:
http://www.oracle.com/us/support/licensecodes/bea/index.html,Tuxedo Lience 文件分为SDK和RTK两种,其中SDK为开发Lience,RTK为运行时Lience
最要使用SDK Lience,如果为RTK Lience则在不能编译程序)。
VC++: Microsoft Visual C++ 6.0 简体中文企业版
1.3 Tuxcedo 安装
1.3.1 安装Tuxedo(全部安装)
由于Tuxedo采用的是图形安装界面,用户根据向导就能很容易完成安装,所以下面仅指出一些关键步骤。
1.3.2 选择安装类型
Full Install
1.3.3 输入监听密码
tuxedo
1.3.4 SSL安装选择
no
1.3.5 License安装选择
yes
1.3.6 安装Tuxedo补丁
1.4 Tuxedo 配置
以上Tuxedo的安装路径为C:\tuxedo,Tuxedo服务端程序路径为d:\tuxedoserver,需要配置环境变量,需要设置的环境变量如下。
1.4.1 修改系统环境变量path的值,增加“C:\tuxedo\tuxedo8.0\bin;”
1.4.2 在系统变量中增加“APPDIR”项,其值为服务端程序所在路径“d:\tuxedoserver”。
1.4.3 在系统变量中增加“LIB”项,其值为“C:\tuxedo\tuxedo8.0\lib”,该环境变量在编译tuxedo程序时会用到。
1.4.4 在系统变量中增加“INCLUDE”项,其值为“C:\tuxedo\tuxedo8.0\include”,该环境变量在编译tuxedo程序时会用到。
1.4.5 在系统变量中增加“TUXDIR”项,其值为“C:\tuxedo\tuxedo8.0”。
1.4.6 在系统变量中增加“TUXCONFIG”项,其值为“D:\tuxedoserver\tuxconfig”。该环境变量用来描述服务端程序资源文件名(含路径信息),该文件是二进制文件
有ubbconfig文件通过tmloadcf命令编译而来,在tuxedo启动的时候会加载该文件。
1.4.7 在系统变量中增加“WSNADDR”项,该选项为客户端程序使用,用来描述服务端地址和监听端口号,其值可以为“//192.168.0.102:6565”。服务端的监听端口
和IP地址也在ubbconfig文件中配置“WSL SRVGRP=GROUP1 SRVID=5 CLOPT="-A -t -- -n //192.168.0.102:6565 -m 2 -M 5 -x 10"。服务启动时候会启动监听。
1.5 Microsoft Visual C++安装
Tuxedo编译服务端程序(使用buildserver命令编译)和客户端程(使用buildclient命令编译),在编译时需要使用C编译器,安装VC++的目的是使用其编译器。安装 的时候要选择设置环境变量。安装完成之后增加环境变量“MSDevDir”项,其值为“C:\Program Files\Microsoft Visual Studio\Common\MSDev98”。
1.6 以上设置完成之后重启系统,重启之后系统变量才会生效。
二:tuxedo测试
1: 将tuxedo自带的程序simpapp(在C:\tuxedo\tuxedo8.0\samples\atmi\simpapp路径下),拷贝到d:\tuxedoserver目录下(拷贝simpapp目录下的所有文件)。
2: 文件ubbsimple即为tuxedo服务端程序的配置文件(ubbconfig),该文件中记录着服务端程序的所有资源信息,即服务信息,修改如下。
#ident "@(#) apps/simpapp/ubbsimple $Revision: 1.3 $"
#Skeleton UBBCONFIG file for the TUXEDO Simple Application.
#Replace the <bracketed> items with the appropriate values.
*RESOURCES
IPCKEY 123456
#Example:
#IPCKEY 123456
DOMAINID simpapp
MASTER simple
MAXACCESSERS 100
MAXSERVERS 50
MAXSERVICES 100
MODEL SHM
LDBAL N
*MACHINES
DEFAULT:
APPDIR="d:\tuxedoserver"
TUXCONFIG="d:\tuxedoserver\tuxconfig"
TUXDIR="c:\tuxedo\tuxedo8.0"
MAXWSCLIENTS=50
MAXACCESSERS=400
#Example:
# APPDIR="/home/me/simpapp"
# TUXCONFIG="/home/me/simpapp/tuxconfig"
# TUXDIR="/usr/tuxedo"
KONGDL LMID=simple #KONGDL 为计算机名称,要大写,根据自己的计算机名称修改即可
#Example:
#beatux LMID=simple
*GROUPS
GROUP1
LMID=simple GRPNO=1 OPENINFO=NONE
*SERVERS
DEFAULT:
CLOPT="-A"
simpserv SRVGRP=GROUP1 SRVID=1
WSL SRVGRP=GROUP1 SRVID=5 CLOPT="-A -t -- -n //192.168.0.102:6565 -m 2 -M 5 -x 10"
*SERVICES
TOUPPER
3: 编译ubbsimple文件
进入dos控制台,选择d:\tuxedoserver路径为当前目录,运行“tmloadcf -y ubbsimple”命令编译ubbsimple文件,成功之后会在d:\tuxedoserver目录下生成二进制的
TUXCONFIG文件。
4: 编译服务端程序
在dos控制台中运行“buildserver -o simpserv -f simpserv.c -s TOUPPER -v”,命令编译服务端程序,源代码为simpserv.c文件,编译成功之后会在d:\tuxedoserver
目录下生成simpserv.exe文件。
5: 编译客户端程序
在dos控制台中运行“buildclient -o simpcl -f simpcl.c -v -w”,命令编译服务端程序,源代码为simpserv.c文件,编译成功之后会在d:\tuxedoserver
目录下生成simpcl.exe文件。
6: 运行客户端程序simpcl.exe测试
在dos控制台中输入simpcl.exe hello 则返回HELLO,表示成功,如下图所示。
三:tuxedo编程
3.1 服务端程序
SERVER端编程主要用C(或COBAL)语言编写一个个的SERVICE,如果需要进行数据库调用,则用数据库提供的嵌入S QL 语言的编程接口,如ORACLE 的PROC , INFORMIX的ESQL 等编写。一个SERVICE其实就时一个C 函数,但它的参数只能是一个TPSVCINFO结构体指针。该结构体在atmi.h中的定义:
struct tpsvcinfo {
char name[XATMI_SERVICE_NAME_LENGTH];/* service name invoked */
long flags; /* describes service attributes */
char *data; /* pointer to data */
long len; /* request data length */
int cd; /* reserved for future use */
long appkey; /* application authentication client key */
CLIENTID cltid; /* client identi fier for originating client */
};
typedef struct tpsvcinfo TPSVCINFO;
TPSVRCINFO说明:
char name[XATMI_SERVICE_NAME_LENGTH]; 该SERVICE的名字
long flags; CLIENT端在TPCALL ,TPACALL等的FLAGS中设置的值
char *data; 指向CLIENT发送过来的缓冲区的首地址
long len; data缓冲区的的长度
int cd; 当采用CONVERSATION 通讯方式时,对应的CD值
long appkey; 当采用安全认证时,该CLIENT 所对应的KEY
CLIENTID cltid; 用于识别该CLIENT 的ID
在SERVER端的程序中可以调用TUXEDO 提供的ATMI 编程接口。这些函数主要在atmi.h中定义。一个SERVICE的处理结果可以用tpreturn返回到CLIENT 端或用t
pforward()转发给另一个SERVICE。
Tpreturn()函数:
Void tpreturn(int rval, int rcode, char *data,long len, long flags)
参数:
rval:定义该SERVICE的返回值,可以是:
TPSUCCESS: CLIENT端的tpgetrply() 或 tpcall() 会返回一个非0 值。如果是用会话方式进行通讯,则会产生TPEV_SVCSUCC 事件。
TPFAIL: CLIENT 端的tpgetrply() 或 tpcall() 会返回-1 。如果是用CONVERSATION 进行通讯,则会产生TPEV_SVCFAIL 事件。
TPEXIT: 和TPFAIL 一样,并且该SERVICE 所在的SERVER进程会自动退出。
Rcode:可以给它赋值,CLIENT 端可以用tpurcode() 取到该值。
Data: 返回给CLIENT端的缓冲区
Len: Data 缓冲区的长度,只有该缓冲区类型为CARRAY时,才需要指定。
Flags:现在没用,设为0
Tpsvrinit ()函数
Int tpsvrinit(int argc, char **argv)
描述:在SERVER 启动时,它将自动调用函数:tpsvrinit(int argc, char *argv[])
如果该SERVER 所在的GROUP配置了连接数据库的接口,那么在默认情况下,该SERVICE将自动
调用TPOPEN(),建立与数据库的连接。
参数:int argc, char **argv 参数的含义与main() 函数的参数含义一样。
返回值:执行成功返回0,失败返回-1
tpsvrdone() 函数
void tpsvrdone()
描述:tpdone()做一些清除工作,如断开与数据库的连接,从系统的BULLITON BOARD 中清除
与该SERVER对应的登记项。
参数:无
返回值:无
SERVER端程序的编译:
用buildserver编译SERVER 端程序,buildserver将调用C 编译器对SERVER端程序进行编译。
其格式如下:
buildserver [- o executable]...
[ -v] \
[ -s service2, service3:func] \
[ -f source/object]...\
[ -l object] ... \
[ -r resource manager]
说明:
- v – 输出详细的编译信息
- o executable – SERVER 的名字
- l executable – 在连接TUXEDO的库之后,还要连接的库文件
- s service – 指定将要发布的SERVICE的名称
- f source/object – 一个 .c 或 * .o 文件,它可以包含在该SERVER中的SERVICE调用到的函数
- r resource manager –RM的名称
simpserv.c程序如下。
#include <stdio.h>
#include <ctype.h>
#include <atmi.h> /* tuxedo atmi接口头文件*/
#include <userlog.h> /* tuxedo 写日志信息,日至文件写入到服务端程序目录下,如ULOG.011813*/#if defined(__STDC__) || defined(__cplusplus)
tpsvrinit(int argc, char *argv[]) //初始化,服务启动时有tuxedo 调用,可以打开数据库连接等
#else
tpsvrinit(argc, argv)
int argc;
char **argv;
#endif
{
/* Some compilers warn if argc and argv aren't used. */
argc = argc;
argv = argv;/* userlog writes to the central TUXEDO message log */
userlog("Welcome to the simple server"); //记录日志信息return(0);
}#ifdef __cplusplus
extern "C"
#endif
void
#if defined(__STDC__) || defined(__cplusplus)
TOUPPER(TPSVCINFO *rqst) //tuxedo 交易服务
#else
TOUPPER(rqst)
TPSVCINFO *rqst;
#endif
{int i;
for(i = 0; i < rqst->len-1; i++)
rqst->data[i] = toupper(rqst->data[i]);/* Return the transformed buffer to the requestor. */
tpreturn(TPSUCCESS, 0, rqst->data, 0L, 0);
}
3.2 客户端程序
创建BEA Tuxedo的客户程序与在C和C++编程语言中创建其它应用程序一样,BEA Tuxedo提供了一个其于C语言的编程接口,即应用程序事务监控接口ATMI,这套接 口很容易使用,以便用于开发客户程序和服务程序。除了C语言接口外,BEA Tuxedo还提供了COBOL接口。为了更好的了解客户端的所有任务以编写客户端应用,有必要 重新认识客户端在C/S模式中扮演的角色。 首先,客户端是用户界面。意思是当用户在系统上用程序进行一次操作的整个过程就是一个客户端过程。前端过程是对客户端的 另一个描述。客户端的首要任务就是获得执行操作应该得到的数据。一旦客户端得到了应有的信息,应该将数据按服务能够识别并适合传输的格式打包。 然后,向服务端 发送请求并等待回应。收到回应数据后,将其按一定格式返回给终端用户。
客户端开发过程
客户端程序的设计和实现可以被分成2部分考虑:用户处理过程和TUXEDO功能部分。下文的客户端程序只描述了TUXEDO功能部分。利用TUXEDO的ATMI API调用可以做到:
——基本的TUXEDO调试技巧(tperrno,tpstrerror,userlog)
——TUXEDO进程管理(tpinit,tpterm)
——基本数据缓冲管理(tpalloc,tprealloc,tpfree)
——基本通讯(tpcall,tpacall,tpgetrply)
客户程序一般执行如下任务:
1. 用tpchkauth()决定加入一个应用程序所需的安全级别。可能出现的响应包括:没有安全级别,应用程序口令,应用程序授权,访问控制列表,连接级加密,公钥加
密,审计。这些可以根据你的需求进行选择;在实际的应用中很多的软件开发商通常对这一步都不做处理。
2,调用tpinit()来连接到一个BEA Tuxedo应用程序,所需的安全信息作为tpinit()的参数传给了应用程序;
3.执行服务请求,调用tpcall
4.调用tpterm()来断开和BEA Tuxedo应用程序的连接
调试和错误处理
当调用ATMI出错时,返回值为-1,全程变量tperrno被设值,该变量提供系统定义的出错原因。函数tpstrerror()以此变量为参数,返回错误的字符说明信息。 完整的
错误号和文本错误信息存在于文件$TUXDIR/include/atmi.h。函数userlog()重定向输出文件为ULOG.mmddyy。使用方法同printf()。该函数每次输出都写硬盘,这样在系
统失败时也能保留调试信息。
进程管理
tuxedo 接到一个tpinit的请求后,就启动一个服务进程,接收到tpterm()后,就会中止该服务进程.在实际应用中,tpinit()和tpterm()必须成对出现,而且要相互对应.
如果只在程序中调用了tpinit()而没有调用tpterm(),则tuxedo系统会认为该进程一直处于活动状态,这样的话可能会因为服务进程达到系统允许的上限而导致系统的崩
溃.int tpinit(TPINIT *tpinfo)客户端通过调用tpinit()与应用连接,进行交互,有以下事件发生:调用安全接口检查客户端是否需要认证连接BB,使进一步的ATMI函数得到
信息使BBL了解BB中已经存在请求建立客户端消息队列使服务可以发回返回信息,系统可以送出广播通知等.错误时返回-1,可能由以下原因引起:
² TPEINVAL 参数错误
² TPENOENT BB无空间
² TPEPERM 无连接权限
² TPEPROTO 协议错误 –被服务调用
int tpterm()
客户端调用tpterm()切断与应用的连接,结束了客户端的TUXEDO进程,该过程发生以下事件:BB入口删除,使BBL知道客户端已经离开客户端离开BB,客户端的信
号量被移除客户端消息队列被移除错误时返回-1,可能由以下原因引起:TPEPROTO协议错误 –被服务调用TPESYSTEM /T系统下错误TPEOS 操作系统错
数据缓冲管理
在Bea Tuxedo系统中的所有通信过程都是通过类型缓冲区来完成的,Bea Tuxedo系统提供了大量的类型缓冲区来供开发者使用。所有类型缓冲区都必须通过Bea
Tuxedo的tpalloc(), tprealloc(), tpfree()这些ATMI来分配回收,它们都有特定的头部。
以下是TUXEDO基本的数据缓冲类型:
² STRING 以空值结尾的单域字符数据。
² CARRAY 有长度定义的单域二进制数据,不进行编、解码。
² VIEW 类C结构或COBOL记录的多域组织。
² FML 无固定结构的自定义缓冲。
四:delphi 客户端程序
4.1: 准备
1: 从c:\tuxedo\tuxedo8.1\bin 目录下拷贝libbuft.dll,libengine.dll,libfml.dll,libfml32.dll,libgpnet.dll,libtux.dll,libwsc.dll,wtuxws32.dll文件到要编写的delphi程序的
运行目录下。
2: 编写tuxedo动态链接库声明文件tuxedo32.pas,该文件如下。
unit Tuxedo32;
interface
{$DEFINE WS}
const
{add by ming}
TPMULTICONTEXTS = 32;
{Flags for service routines}
TPNOBLOCK = $00000001;
TPSIGRSTRT = $00000002;
TPNOREPLY = $00000004;
TPNOTRAN = $00000008;
TPTRAN = $00000010;
TPNOTIME = $00000020;
TPABSOLUTE = $00000040;
TPGETANY = $00000080;
TPNOCHANGE = $00000100;
TPCONV = $00000400;
TPSENDONLY = $00000800;
TPRECVONLY = $00001000;
TPACK = $00002000;{Flags for tpreturn()}
TPFAIL = $00000001;
TPSUCCESS = $00000002;
TPEXIT = $08000000;{Flags for tpscmt()}
TP_CMT_LOGGED = $01;
TP_CMT_COMPLETE = $02;{Flags to tpinit()}
TPU_MASK = $00000007;
TPU_SIG = $00000001;
TPU_DIP = $00000002;
TPU_IGN = $00000004;
TPSA_FASTPATH = $00000008;
TPSA_PROTECTED = $00000010;{Flags to tpconvert()}
TPTOSTRING = $40000000;
TPCONVCLTID = $00000001;
TPCONVTRANID = $00000002;
TPCONVXID = $00000004;
TPCONVMAXSTR = 256;{Return values of tpchkauth()}
TPNOAUTH = 0;
TPSYSAUTH = 1;
TPAPPAUTH = 2;{Misc}
MAXTIDENT = 30;{Errors}
TPEABORT = 1;
TPEBADDESC = 2;
TPEBLOCK = 3;
TPEINVAL = 4;
TPELIMIT = 5;
TPENOENT = 6;
TPEOS = 7;
TPEPERM = 8;
TPEPROTO = 9;
TPESVCERR = 10;
TPESVCFAIL = 11;
TPESYSTEM = 12;
TPETIME = 13;
TPETRAN = 14;
TPGOTSIG = 15;
TPERMERR = 16;
TPEITYPE = 17;
TPEOTYPE = 18;
TPERELEASE = 19;
TPEHAZARD = 20;
TPEHEURISTIC = 21;
TPEEVENT = 22;
TPEMATCH = 23;
TPEDIAGNOSTIC = 24;
TPEMIB = 25;{ conversations - events }
TPEV_DISCONIMM = $0001;
TPEV_SVCERR = $0002;
TPEV_SVCFAIL = $0004;
TPEV_SVCSUCC = $0008;
TPEV_SENDONLY = $0020;type
PPChar = ^Pchar;
PShortInt = ^ShortInt;
PLongInt = ^LongInt;
PInteger = ^Integer;
PSingle = ^Single;
PExtended = ^Extended;
TClientid = record
Clientdata: array[1..4] of LongInt;
end;PTClientid = ^TClientid;
{add by kongdl for add fml declare}
{add by kongdl}{XATMI}
type
TTpsvcinfo = record
Name: array[0..31] of Char;
Flags: LongInt;
Data: PChar;
Len: LongInt;
Cd: Integer;
Appkey: LongInt;
Cltid: TClientid;
end;
PTTpsvcinfo = ^TTpsvcinfo;function tpacall ( Svc, Data: PChar; Len, Flags: LongInt ): Integer; stdcall;
function tpadvertise ( Svcname: PChar; Tpsvcinfo: Pointer ): Integer; stdcall;
function tpalloc ( Maintype, Subtype: PChar; Size: LongInt ): Pointer; stdcall;
//function tpcall ( Svc, Idata: PChar; Ilen: LongInt; Odata: PPChar; Olen: PLongInt; Flags:LongInt ): Integer; stdcall;
Function tpcall ( SVCNAME: pChar; IDATA: pChar; ILEN: LongInt;
var ODATA: pChar; var OLEN :LongInt; flags :LongInt ): Integer;
stdcall;external 'wtuxws32.dll'
function tpcancel ( Cd: Integer ): Integer; stdcall;
function tpconnect ( Svc, Data: PChar; Len, Flags: LongInt ): Integer; stdcall;
function tpdiscon ( Cd: Integer ): Integer; stdcall;
procedure tpfree ( Ptr: PChar ); stdcall;
function tpgetrply ( Cd: PInteger; Data: PPChar; Len: PLongInt; Flags: LongInt ): Integer; stdcall;
function tprealloc ( Ptr: PChar; Size: LongInt ): PChar; stdcall;
function tprecv ( Cd: Integer; Data: PPChar; Len: PLongInt; Flags: LongInt; Revent: PLongInt ): Integer; stdcall;
procedure tpreturn ( Rval: Integer; Rcode: LongInt; Data: PChar; Len, Flags: LongInt ); stdcall;
function tpsend ( Cd: Integer; Data: PChar; Len, Flags: LongInt; Revent: PLongInt ): Integer; stdcall;
procedure tpservice ( Svcinfo: PTTpsvcinfo ); stdcall;
function tptypes ( Ptr, Maintype, Subtype: PChar ): LongInt; stdcall;
function tpunadvertise ( Svcname: PChar ): Integer; stdcall;
//hz add
function tpgetctxt(context:PLongInt;flags:LongInt): Integer; stdcall;
function tpsetctxt(context:LongInt;flags:LongInt): Integer; stdcall;
{ATMI}type
TTpinit = record
Usrname: array[0..31] of Char;
Cltname: array[0..31] of Char;
Passwd: array[0..31] of Char;
Grpname: array[0..31] of Char;
Flags: LongInt;
Datalen: LongInt;
Data: longInt;
end;TTpqctl = record
Flags: LongInt;
Deq_time: LongInt;
Priority: LongInt;
Diagnostic: LongInt;
Msgid: array[0..31] of Char;
Corrid: array[0..31] of Char;
Replyqueue: array[0..16] of Char;
Failurequeue: array[0..16] of Char;
Cltid: TClientid;
Urcode: LongInt;
Appkey: LongInt;
end;TTpevctl = record
Flags: LongInt;
Name1: array[0..31] of Char;
Name2: array[0..31] of Char;
Qctl: TTpqctl;
end;TTptranid = record
Info: array[0..5] of LongInt;
end;PTTpinit = ^TTpinit;
PTTpqctl = ^TTpqctl;
PTTpevctl = ^TTpevctl;
PTTptranid = ^TTptranid;
Unsolhandler = procedure ( Data: PChar; Len, Flags: LongInt ); stdcall;function tpabort ( Flags: LongInt ): Integer; stdcall;
function tpbegin ( Timeout, Flags: LongInt ): Integer; stdcall;
function tpbroadcast ( Lmid, Usrname, Cltname, Data: PChar; Len, Flags: LongInt ): Integer; stdcall;
function tpchkauth : Integer; stdcall;
function tpchkunsol : Integer; stdcall;
function tpcommit ( Flags: LongInt ): Integer; stdcall;
function tpdequeue ( Qspace, Qname: PChar; Ctl: PTTpqctl; Data: PPChar; Len: PLongInt; Flags: LongInt ): Integer; stdcall;
function tpenqueue ( Qspace, Qname: PChar; Ctl: PTTpqctl; Data: PChar; Len, Flags: LongInt ): Integer; stdcall;
procedure tpforward ( Svc, Data: PChar; Len, Flags: LongInt ); stdcall;
function tpgetlev : Integer; stdcall;
function tpgprio : Integer; stdcall;
function tpinit ( Tpinfo: PTTpinit ): Integer; stdcall;
function tpnotify ( Clientid: PTClientid; Data: PChar; Len, Flags: LongInt ): Integer; stdcall;
function tppost ( Eventname, Data: PChar; Len, Flags: LongInt ): Integer; stdcall;
function tpresume ( Tranid: PTTptranid; Flags: LongInt ): Integer; stdcall;
function tpsetunsol ( Disp: Unsolhandler ): Unsolhandler; stdcall;
function tpsprio ( Prio: Integer; Flags: LongInt ): Integer; stdcall;
function tpstrerror ( Err: Integer ): PChar; stdcall;
function tpsubscribe ( Eventexpr, Filter: PChar; Ctl: PTTpevctl; Flags: LongInt ): Integer; stdcall;
function tpsuspend ( Tranid: PTTptranid; Flags: LongInt ): Integer; stdcall;
procedure tpsvrdone ; stdcall;
function tpsvrinit ( Argc: Integer; Argv: PPChar ): Integer; stdcall;
function tpterm : Integer; stdcall;
function tpunsubscribe ( Subscription, Flags: LongInt ): Integer; stdcall;
{TX}type
Txid = record
FormatID: LongInt;
Gtrid_Length: LongInt;
Bqual_length: LongInt;
Data: array[0..127] of Char;
end;
TTxinfo = record
XID: TXID;
When_Return: LongInt;
Tran_Control: LongInt;
Tran_Timeout: LongInt;
Tran_State: LongInt;
end;
COMMIT_RETURN = LongInt;
TRANSACTION_CONTROL = LongInt;
TRANSACTION_TIMEOUT = LongInt;function tx_begin : Integer; stdcall;
function tx_close : Integer; stdcall;
function tx_commit : Integer; stdcall;
function tx_info ( Info: Pointer ): Integer; stdcall;
function tx_open : Integer; stdcall;
function tx_rollback : Integer; stdcall;
function tx_set_commit_return ( When_return: COMMIT_RETURN ): Integer; stdcall;
function tx_set_transaction_control ( Control: TRANSACTION_CONTROL ): Integer; stdcall;
function tx_set_transaction_timeout ( Timeout: TRANSACTION_TIMEOUT ): Integer; stdcall;{FML}
type
FLDIDD = Word;
FLDLEN = Word;
FLDOCC = Integer;
TFbfr = record
Magic: Integer;
Len: FLDLEN;
Maxlen: FLDLEN;
Nie: FLDLEN;
Indxintvl: FLDLEN;
Val: array[0..7] of Byte;
end;
TFldidArray = array[0..99] of FLDIDD;
PFLDIDD = ^FLDIDD;
PFLDLEN = ^FLDLEN;
PFLDOCC = ^FLDOCC;
PTFbfr = ^TFbfr;
PFldidArray = ^TFldidArray;
function Fadd ( Fbfr: PTFbfr; Fieldid: FLDIDD; Value: Pointer; Len: FLDLEN ): Integer; stdcall;
function Falloc ( F: FLDOCC; V:FLDLEN ): PTFbfr; stdcall;
function Fchg ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC; Value: Pointer; Len: FLDLEN ): Integer; stdcall;
function Fcmp ( Fbfr1, Fbfr2: PTFbfr ): Integer; stdcall;
function Fcpy ( Dest, Src: PTFbfr ): Integer; stdcall;
function Fdel ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC ): Integer; stdcall;
function Fdel32 ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC ): Integer; stdcall;
function Fdelall ( Fbfr: PTFbfr; Fieldid: FLDIDD ): Integer; stdcall;
function Fdelete ( Fbfr: PTFbfr; PFieldid: PFldidArray ): Integer; stdcall;
function Ffind ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC; Len: PFLDLEN ): Pointer; stdcall;
function Ffindlast ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: PFLDOCC; Len: PFLDLEN ): integer; stdcall;
function Ffindocc ( Fbfr: PTFbfr; Fieldid: FLDIDD; Value: Pointer; Len: FLDLEN ): FLDOCC; stdcall;
function Fget ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC; Value: Pointer; Maxlen: PFLDLEN ): Integer; stdcall;
function Fgetalloc ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC; Extralen: PFLDLEN ): Pointer; stdcall;
function Fgetlast ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: PFLDOCC; Value: Pointer; Maxlen: PFLDLEN ): Integer; stdcall;
function Finit ( Fbfr: PTFbfr; Buflen: FLDLEN ): Integer; stdcall;
function Fldid ( Name: PChar ): FLDIDD; stdcall;
function Fldno ( Fieldid: FLDIDD ): Integer; stdcall;
function Fldtype ( Fieldid: FLDIDD ): Integer; stdcall;
function Fmkfldid ( Itype: Integer; Num: FLDIDD ): FLDIDD; stdcall;
function Fmove ( Dest: PChar; Src: PTFbfr ): Integer; stdcall;
function Fname ( Fieldid: FLDIDD ): PChar; stdcall;
function Fneeded ( F: FLDOCC; V: FLDLEN ): LongInt; stdcall;
function Ffree ( Fbfr: PTFbfr ): Integer; stdcall;
function Fnext ( Fbfr: PTFbfr; Fieldid: PFLDIDD; Oc: PFLDOCC; Value: Pointer; Len: PFLDLEN ): Integer; stdcall;
function Fnum ( Fbfr: PTFbfr ): FLDOCC; stdcall;
function Foccur ( Fbfr: PTFbfr; Fieldid: FLDIDD ): FLDOCC; stdcall;
function Fpres ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC ): Integer; stdcall;
function Frealloc ( Fbfr: PTFbfr; Nf: FLDOCC; Nv: FLDLEN ): PTFbfr; stdcall;
function Fsizeof ( Fbfr: PTFbfr ): LongInt; stdcall;
function Ftype ( Fieldid: FLDIDD ): PChar; stdcall;
function Funused ( Fbfr: PTFbfr ): LongInt; stdcall;
function Fused ( Fbfr: PTFbfr ): LongInt; stdcall;
function Fvall ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC ): LongInt; stdcall;
function Fvals ( Fbfr: PTFbfr; FIeldid: FLDIDD; Oc: FLDOCC ): PChar; stdcall;
function Fconcat ( Dest, Src: PTFbfr ): Integer; stdcall;
function Fjoin ( Dest, Src: PTFbfr ): Integer; stdcall;
function Fojoin ( Dest, Src: PTFbfr ): Integer; stdcall;
function Fproj ( Fbfr: PTFbfr; Fieldid: PFldidArray ): Integer; stdcall;
function Fprojcpy ( Dest, Src: PTFbfr; Fieldid: PFldidArray ): Integer; stdcall;
function Fupdate ( Dest, Src: PTFbfr ): Integer; stdcall;
function CFadd ( Fbfr: PTFbfr; Fieldid: FLDIDD; Value: PChar; Len: FLDLEN; Itype: Integer ): Integer; stdcall;
function CFchg ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC; Value: PChar; Len: FLDLEN; Itype: Integer ): Integer; stdcall;
function CFget ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC; Buf: PChar; Len: PFLDLEN; Itype: Integer ): Integer; stdcall;
function CFgetalloc ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC; Itype: Integer; Extralen: PFLDLEN ): PChar; stdcall;
function CFfind ( Fbfr: PTFbfr; Fieldid: FLDIDD; Oc: FLDOCC; Len: PFLDLEN; Itype: Integer ): PChar; stdcall;
function CFfindocc ( Fbfr: PTFbfr; Fieldid: FLDIDD; Value: PChar; Len: FLDLEN; Itype: Integer ): Integer; stdcall;
function Ftypcvt ( Tolen: PFLDLEN; Totype: Integer; Fromval: PChar; Fromtype: Integer; Fromlen: FLDLEN ): PChar; stdcall;
function Fidxused ( Fbfr: PTFbfr ): Integer; stdcall;
function Findex ( Fbfr: PTFbfr; Intvl: FLDOCC ): Integer; stdcall;
function Frstrindex ( Fbfr: PTFbfr; Numidx: FLDOCC ): Integer; stdcall;
function Funindex ( Fbfr: PTFbfr ): Integer; stdcall;
function Fboolco ( Expression: PChar ): PChar; stdcall;
function Fboolev ( Fbfr: PTFbfr; Tree: PChar ): Integer; stdcall;
function Ffloatev ( Fbfr: PTFbfr; Tree: PChar ): Double; stdcall;
procedure Fidnm_unload; stdcall;
procedure Fnmid_unload; stdcall;
function Fchksum ( Fbfr: PTFbfr ): LongInt; stdcall;
function Fielded ( Fbfr: PTFbfr ): Integer; stdcall;
function Fstrerror ( Err: Integer ): PChar; stdcall;{Miscellaneous}
type
TNl_catd = record
Catd_set: PChar;
Catd_msgs: PChar;
Catd_data: PChar;
Catd_set_nr: Integer;
Catd_type: Char;
end;
Nl_item = Integer;
PTNl_catd = ^TNl_catd;function catgets ( Catd: PTNl_catd; Set_num, Msg_num: Integer; S: PChar ): PChar; stdcall;
function catopen ( Name: PChar; Oflag: Integer ): PTNl_catd; stdcall;
function catclose ( Catd: PTNl_catd ): Integer; stdcall;
function gettperrno : Integer; stdcall;
//add by kongdl
function gettpurcode: integer; stdcall
//add by kongdl
function nl_langinfo ( Item: Nl_item ): PChar; stdcall;
function tuxgetenv ( Name: PChar ): PChar; stdcall;
function tuxputenv ( Envstring: PChar ): Integer; stdcall;
function tuxreadenv ( Envfile, Envlabel: PChar ): Integer; stdcall;
function userlog ( Format: PChar ): Integer; stdcall;
{$IFDEF WS}
function bq ( Cmd: PChar ): Integer; stdcall;
function setlocale ( Category: Integer; Locale: PChar ): PChar; stdcall;
{$ENDIF}{Others}
type
TTm = record
Tm_sec: Integer;
Tm_min: Integer;
Tm_hour: Integer;
Tm_mday: Integer;
Tm_mon: Integer;
Tm_year: Integer;
Tm_wday: Integer;
Tm_yday: Integer;
Tm_isdst: Integer;
end;
PTTm = ^TTm;function gp_mktime ( Time: PTTm ): LongInt; stdcall;
implementation{XATMI}
function tpacall ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpacall';
function tpadvertise ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpadvertise';
function tpalloc ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpalloc';
//function tpcall ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpcall';
function tpcancel ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpcancel';
function tpconnect ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpconnect';
function tpdiscon ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpdiscon';
procedure tpfree ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpfree';
function tpgetrply ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpgetrply';
function tprealloc ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tprealloc';
function tprecv ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tprecv';
procedure tpreturn ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpreturn';
function tpsend ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpsend';
procedure tpservice ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpservice';
function tptypes ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tptypes';
function tpunadvertise ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpunadvertise';function tpgetctxt ; stdcall ; external {$IFDEF WS} 'libtux.dll' {$ELSE} 'wtuxws32.dll' {$ENDIF} name 'tpgetctxt';
function tpsetctxt ; stdcall ; external {$IFDEF WS} 'libtux.dll' {$ELSE} 'wtuxws32.dll' {$ENDIF} name 'tpsetctxt';{ATMI}
function tpabort ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpabort';
function tpbegin ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpbegin';
function tpbroadcast ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpbroadcast';
function tpchkauth ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpchkauth';
function tpchkunsol ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpchkunsol';
function tpcommit ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpcommit';
function tpdequeue ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpdequeue';
function tpenqueue ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpenqueue';
procedure tpforward ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpforward';
function tpgetlev ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpgetlev';
function tpgprio ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpgprio';
function tpinit ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpinit';
function tpnotify ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpnotify';
function tppost ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tppost';
function tpresume ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpresume';
function tpsetunsol ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpsetunsol';
function tpsprio ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpsprio';
function tpstrerror ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpstrerror';
function tpsubscribe ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpsubscribe';
function tpsuspend ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpsuspend';
procedure tpsvrdone ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpsvrdone';
function tpsvrinit ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpsvrinit';
function tpterm ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpterm';
function tpunsubscribe ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tpunsubscribe';{TX}
function tx_begin ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tx_begin';
function tx_close ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tx_close';
function tx_commit ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tx_commit';
function tx_info ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tx_info';
function tx_open ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tx_open';
function tx_rollback ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tx_rollback';
function tx_set_commit_return ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tx_set_commit_return';
function tx_set_transaction_control ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tx_set_transaction_control';
function tx_set_transaction_timeout ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'tx_set_transaction_timeout';{FML}
function Fadd ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fadd';
function Falloc ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Falloc';
function Fchg ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fchg';
function Fcmp ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fcmp';
function Fcpy ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fcpy';
function Fdel32 ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fdel32';
//function Fdel ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fdel';
function Fdel; stdcall; external 'libfml.dll' name 'Fdel';
function Fdelall ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fdelall';
function Fdelete ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fdelete';
function Ffind ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Ffind';
function Ffindlast ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Ffindlast';
function Ffindocc ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Ffindocc';
function Ffree ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Ffree';
function Fget ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fget';
function Fgetalloc ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fgetalloc';
function Fgetlast ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fgetlast';
function Finit ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Finit';
function Fldid ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fldid';
function Fldno ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fldno';
function Fldtype ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fldtype';
function Fmkfldid ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fmkfldid';
function Fmove ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fmove';
function Fname ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fname';
function Fneeded ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fneeded';
function Fnext ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fnext';
function Fnum ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fnum';
function Foccur ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Foccur';
function Fpres ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fpres';
function Frealloc ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Frealloc';
function Fsizeof ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fsizeof';
function Ftype ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Ftype';
function Funused ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Funused';
function Fused ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fused';
function Fvall ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fvall';
function Fvals ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fvals';
function Fconcat ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fconcat';
function Fjoin ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fjoin';
function Fojoin ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fojoin';
function Fproj ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fproj';
function Fprojcpy ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fprojcpy';
function Fupdate ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fupdate';
function CFadd ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'CFadd';
function CFchg ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'CFchg';
function CFget ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'CFget';
function CFgetalloc ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'CFgetalloc';
function CFfind ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'CFfind';
function CFfindocc ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'CFfindocc';
function Ftypcvt ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Ftypcvt';
function Fidxused ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fidxused';
function Findex ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Findex';
function Frstrindex ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Frstrindex';
function Funindex ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Funindex';
function Fboolco ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fboolco';
function Fboolev ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fboolev';
function Ffloatev ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Ffloatev';
procedure Fidnm_unload ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fidnm_unload';
procedure Fnmid_unload ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fnmid_unload';
function Fchksum ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fchksum';
function Fielded ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fielded';
function Fstrerror ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libfml.dll' {$ENDIF} name 'Fstrerror';{Miscellaneous}
function catgets ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libgp.dll' {$ENDIF} name 'catgets';
function catopen ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libgp.dll' {$ENDIF} name 'catopen';
function catclose ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libgp.dll' {$ENDIF} name 'catclose';
function gettperrno ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'gettperrno';
//add by kongdl
function gettpurcode; stdcall; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'gettpurcode';
//add by kongdl
function nl_langinfo ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libgp.dll' {$ENDIF} name 'nl_langinfo';
function tuxgetenv ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libgp.dll' {$ENDIF} name 'tuxgetenv';
function tuxputenv ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libgp.dll' {$ENDIF} name 'tuxputenv';
function tuxreadenv ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libgp.dll' {$ENDIF} name 'tuxreadenv';
function userlog ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libtux.dll' {$ENDIF} name 'userlog';
{$IFDEF WS}
function bq ; stdcall ; external 'wtuxws32.dll' name 'bq';
function setlocale ; stdcall ; external 'wtuxws32.dll' name 'setlocale';
{$ENDIF}{Others}
function gp_mktime ; stdcall ; external {$IFDEF WS} 'wtuxws32.dll' {$ELSE} 'libgp.dll' {$ENDIF} name 'gp_mktime';
end.
4.2 调用tuxedo服务代码(该代码包含调用调用TOUPPER服务,调用数据库访问服务(TEST),调用VIEW缓冲区服务VIEWTEST, FML缓冲区操作)
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Tuxedo32, StdCtrls, ComCtrls;type
TForm1 = class(TForm)
PageControl1: TPageControl;
TabSheet1: TTabSheet;
Edit1: TEdit;
Button1: TButton;
Label1: TLabel;
Label2: TLabel;
Edit2: TEdit;
TabSheet2: TTabSheet;
Label3: TLabel;
edtEmpNO: TEdit;
Label4: TLabel;
edtName: TEdit;
Button2: TButton;
TabSheet3: TTabSheet;
Label5: TLabel;
edtBID: TEdit;
Label6: TLabel;
edtBalance: TEdit;
Label7: TLabel;
edtERMSG: TEdit;
Label8: TLabel;
edtResult: TEdit;
Button3: TButton;
TabSheet4: TTabSheet;
Label9: TLabel;
edtFMLEmpNO: TEdit;
Label10: TLabel;
edtFMLEmpName: TEdit;
Label11: TLabel;
edtFMLEmpSale: TEdit;
Button4: TButton;
Button5: TButton;
Button7: TButton;
lvFMLEmp: TListView;
Button6: TButton;
procedure Button1Click(Sender: TObject);
procedure edtEmpNOKeyPress(Sender: TObject; var Key: Char);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure edtBalanceKeyPress(Sender: TObject; var Key: Char);
procedure Button4Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure lvFMLEmpSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
private
{ Private declarations }
FBufFML: Pointer; //FML缓冲区
procedure GetEmpFromBuffer;
public
{ Public declarations }
end;var
Form1: TForm1;implementation
type
TAUD = packed record
b_id: dword;
balance: single;
ermsg: array[0..79] of char;
end;PAUD = ^TAUD;
TEmp = class
private
Serial: integer;
EMPNO: integer;
EMPName: string;
EMPSale: double;
end;const
EMPNO = FLDIDD(9193);
ENAME = FLDIDD(41962);
SAL = FLDIDD(33771);
{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var bConn: boolean;
iRes, iRcvLen: longint;
sSrc: string;
TPTTpinit: PTTpinit;
bufSend, bufRcv: PChar;
begin
try
Screen.Cursor := crSQLWait;
bConn := false;
TPTTpinit := nil;
bufSend := nil;
bufRcv := nil;
TPTTpinit := PTTpinit(tpalloc('TPINIT', nil, sizeOf(PTTpinit)));
//tuxputenv('WSNADDR=//192.168.90.150:6565');
iRes := TPInit(nil);
if (iRes = -1) then
begin
Application.MessageBox(PChar(Format('初始化失败: %d!', [gettperrno])), '系统提示');
Exit;
end
else
bConn := true;sSrc := edit1.Text;
bufSend := PChar(PTTpinit(tpalloc('STRING', nil, Length(sSrc) + 1)));
bufRcv := PChar(PTTpinit(tpalloc('STRING', nil, Length(sSrc) + 1)));StrCopy(bufSend, PChar(sSrc));
iRes := tpcall(PChar('TOUPPER'), bufSend, longint(Length(sSrc) + 1), bufSend, iRcvLen, TPNOBLOCK);
if (iRes = -1) then
begin
Application.MessageBox('调用TOUPPER失败!', '系统提示');
Exit;
end
else
begin
Edit2.Text := bufSend;
end;
finally
if Assigned(TPTTpinit) then
tpfree(pchar(TPTTpinit));
if Assigned(bufSend) then
tpfree(bufSend);
if Assigned(bufRcv) then
tpfree(bufRcv);
if bConn then
tpterm();
Screen.Cursor := crDefault;
end;
end;procedure TForm1.edtEmpNOKeyPress(Sender: TObject; var Key: Char);
begin
if ((Ord(Key) > Ord('9')) or (Ord(Key) < Ord('0'))) and (Ord(Key) <> 8) then
Key := #0;
end;procedure TForm1.Button2Click(Sender: TObject);
var bConn: boolean;
sNO: string;
iRes, iRcvLen, iSendLen, iCode: LongInt;
bufSend, bufRcv: PChar;
begin
try
Screen.Cursor := crSQLWait;
bConn := false;
bufSend := nil;
bufRcv := nil;//连接服务器
try
iRes := tpinit(nil);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('连接tuxedo服务器失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end
else
bConn := true;sNO := IntToStr(StrToIntDef(edtEmpNO.Text, -1));
iSendLen := Length(sNO);bufSend := PChar(tpalloc('STRING', nil, iSendLen));
if bufSend = nil then
begin
Application.MessageBox(PChar(Format('初始化缓冲区失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;bufRcv := PChar(tpalloc('STRING', nil, iSendLen));
if bufRcv = nil then
begin
Application.MessageBox(PChar(Format('初始化缓冲区失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;StrCopy(bufSend, PChar(sNO));
//调用TEST服务
iRes := tpcall('TEST', bufSend, 0, bufRcv, iRcvLen, 0);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('调用TEST服务失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end
else
begin
iCode := tuxedo32.gettpurcode;
if iCode = 0 then
edtName.Text := bufRcv
else
begin
edtName.Text := '';
if iCode = 1 then
Application.MessageBox('未查找到数据!', '系统提示')
else
Application.MessageBox(PChar(Format('调用失败:%s', [trim(bufRcv)])), '系统提示');
end;
end;
except
on e: Exception do
begin
Application.MessageBox(PChar(Format('调用TEST服务出错:%s', [e.Message])), '系统提示');
end;
end;
finally
if Assigned(bufSend) then
tpfree(bufSend);
if Assigned(bufRcv) then
tpfree(bufRcv);
if bConn then
tpterm();Screen.Cursor := crDefault;
end;
end;procedure TForm1.Button3Click(Sender: TObject);
var bConn: boolean;
iRes, iRcvLen, iCode: LongInt;
bufAud: PAUD;
bufRcv: PChar;
begin
try
Screen.Cursor := crSQLWait;
bufAud := nil;
bufRcv := nil;
bConn := false;try
iRes := tpinit(nil);if iRes = -1 then
begin
Application.MessageBox(PChar(Format('连接tuxedo服务器失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end
else
bConn := true;bufAud := PAUD(tpalloc('VIEW', 'aud', SizeOf(TAUD)));
if bufAud = nil then
begin
Application.MessageBox(PChar(Format('初始化缓冲区失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;bufRcv := tpalloc('STRING', nil, 1000);
if bufRcv = nil then
begin
Application.MessageBox(PChar(Format('初始化缓冲区失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;FillChar(bufAud^, SizeOf(TAUD), 0);
bufAud^.b_id := StrToIntDef(edtBID.Text, 1);
bufAud^.balance := StrToFloatDef(edtBALANCE.Text, 0);
StrCopy(bufAud^.ermsg, PChar(edtERMSG.Text));iRes := tpcall('VIEWTEST', PChar(bufAUD), 0, bufRcv, iRcvLen, 0);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('调用VIEWTEST服务失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end
else
begin
iCode := tuxedo32.gettpurcode;
if iCode = 0 then
edtResult.Text := bufRcv
else
begin
edtName.Text := '';
if iCode = 1 then
Application.MessageBox('调用失败:分配缓冲区失败', '系统提示')
else
Application.MessageBox(PChar(Format('调用失败:%s', [trim(bufRcv)])), '系统提示');
end;
end;
except
on e: Exception do
begin
Application.MessageBox(PChar(Format('调用VIEWTEST服务出错:%s', [e.Message])), '系统提示');
end;
end;
finally
if Assigned(bufAud) then
tpfree(PChar(bufAud));
if Assigned(bufRcv) then
tpfree(bufRcv);
if bConn then
tpterm();Screen.Cursor := crDefault;
end;
end;procedure TForm1.edtBalanceKeyPress(Sender: TObject; var Key: Char);
begin
if ((Ord(Key) > Ord('9')) or (Ord(Key) < Ord('0'))) and (Ord(Key) <> 8) and (Ord(Key) <> Ord('.')) then
Key := #0
else
begin
if (Ord(Key) = Ord('.')) and (Pos('.', TEdit(Sender).Text) > 0) then
Key := #0;
end;
end;procedure TForm1.Button4Click(Sender: TObject);
var iEmpNO, iRes: integer;
dEmpSale: double;
sEmpName: string;
begin
try
Screen.Cursor := crSQLWait;if not Assigned(FBufFML) then
begin
try
FBufFML := tpalloc('FML', nil, 1024);if FBufFML = nil then
begin
Application.MessageBox(PChar(Format('分配FML缓冲区出错: %d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;
except
on e: Exception do
begin
Application.MessageBox(PChar(Format('分配FML缓冲区出错: %s', [e.Message])), '系统提示');
end;
end;
end;if trim(edtFMLEmpNO.Text) = '' then
begin
Application.MessageBox('请输入员工编号!', '系统提示');
edtFMLEmpNO.SetFocus;
Exit;
end
else
iEmpNO := StrToInt(edtFMLEmpNO.Text);if trim(edtFMLEmpName.Text) = '' then
begin
Application.MessageBox('请输入员工姓名!', '系统提示');
edtFMLEmpName.SetFocus;
Exit;
end
else
sEmpName := trim(edtFMLEmpName.Text);if trim(edtFMLEmpSale.Text) = '' then
begin
Application.MessageBox('请输入薪水!', '系统提示');
edtFMLEmpSale.SetFocus;
Exit;
end
else
dEmpSale := StrToFloat(edtFMLEmpSale.Text);try
iRes := Fadd(FBufFML, EMPNO, @iEmpNO, 0);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('调用Fadd失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;iRes := Fadd(FBufFML, ENAME, PChar(sEmpName), 0);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('调用Fadd失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;iRes := Fadd(FBufFML, SAL, @dEmpSale, 0);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('调用Fadd失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;GetEmpFromBuffer;
Application.MessageBox('添加员工信息成功!', '系统提示');
except
on e: Exception do
begin
Application.MessageBox(PChar(Format('添加员工信息出错: %s', [e.Message])), '系统提示');
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(FBufFML) then
tpfree(FBufFML);
end;procedure TForm1.GetEmpFromBuffer;
var iSerial, iMaxRow, iRes: integer;
oEmp: TEmp;
oItem: TListItem;
sBuf: array[0..1024] of char;
begin
try
Screen.Cursor := crSQLWait;
if not Assigned(FBufFML) then
begin
try
FBufFML := tpalloc('FML', nil, 1024);if FBufFML = nil then
begin
Application.MessageBox(PChar(Format('分配FML缓冲区出错: %d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;
except
on e: Exception do
begin
Application.MessageBox(PChar(Format('分配FML缓冲区出错: %s', [e.Message])), '系统提示');
end;
end;
end;try
iRes := Ffindlast(FBufFML, EMPNO, @iMaxRow, nil);
if Fnum(FBufFML) = 0 then
Exit;
lvFMLEmp.Items.Clear;for iSerial := 0 to iMaxRow do
begin
oEmp := TEmp.Create;
oEmp.Serial := iSerial;iRes := FGet(FBufFML, EMPNO, iSerial, @oEmp.EMPNO, nil);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('获取FML EMPNO出错:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;FillChar(sBuf, Length(sBuf), 0);
iRes := FGet(FBufFML, ENAME, iSerial, @sBuf[0], nil);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('获取FML EMPName出错:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end
else
oEmp.EMPName := sBuf;iRes := FGet(FBufFML, SAL, iSerial, @oEmp.EMPSale, nil);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('获取FML EMPSale出错:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;oItem := lvFMLEmp.Items.Add;
oItem.Data := oEmp;
oItem.Caption := IntToStr(oEmp.Serial);
oItem.SubItems.Add(IntToStr(oEmp.EMPNO));
oItem.SubItems.Add(oEmp.EMPName);
oItem.SubItems.Add(Format('%.2f', [oEmp.EMPSale]));
end;
except
on e: Exception do
begin
Application.MessageBox(PChar(Format('获取FML缓冲区数据出错:%s', [e.Message])), '系统提示');
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;procedure TForm1.lvFMLEmpSelectItem(Sender: TObject; Item: TListItem;
Selected: Boolean);
begin
edtFMLEmpNO.Text := IntToStr(TEmp(Item.Data).EMPNO);
edtFMLEmpName.Text := TEmp(Item.Data).EMPName;
edtFMLEmpSale.Text := FloatToStr(TEmp(Item.Data).EMPSale);
end;procedure TForm1.Button5Click(Sender: TObject);
var iRes, iEmpNO: integer;
dEmpSale: double;
sEmpName: string;
oEmp: TEmp;
begin
try
Screen.Cursor := crSQLWait;
if lvFMLEmp.Selected <> nil then
begin
oEmp := TEmp(lvFMLEmp.Selected.Data);
if trim(edtFMLEmpNO.Text) = '' then
begin
Application.MessageBox('请输入员工编号!', '系统提示');
edtFMLEmpNO.SetFocus;
Exit;
end
else
iEmpNO := StrToInt(edtFMLEmpNO.Text);if trim(edtFMLEmpName.Text) = '' then
begin
Application.MessageBox('请输入员工姓名!', '系统提示');
edtFMLEmpName.SetFocus;
Exit;
end
else
sEmpName := trim(edtFMLEmpName.Text);if trim(edtFMLEmpSale.Text) = '' then
begin
Application.MessageBox('请输入薪水!', '系统提示');
edtFMLEmpSale.SetFocus;
Exit;
end
else
dEmpSale := StrToFloat(edtFMLEmpSale.Text);try
iRes := Fchg(FBufFML, EMPNO, oEmp.Serial, @iEmpNO, 0);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('调用Fchg失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
lvFMLEmpSelectItem(lvFMLEmp, lvFMLEmp.Selected, true);
Exit;
end;iRes := Fchg(FBufFML, ENAME, oEmp.Serial, PChar(sEmpName), 0);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('调用Fchg失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
lvFMLEmpSelectItem(lvFMLEmp, lvFMLEmp.Selected, true);
Exit;
end;iRes := Fchg(FBufFML, SAL, oEmp.Serial, @dEmpSale, 0);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('调用Fchg失败:%d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
lvFMLEmpSelectItem(lvFMLEmp, lvFMLEmp.Selected, true);
Exit;
end;GetEmpFromBuffer;
Application.MessageBox('修改数据成功!', '系统提示');
except
on e: Exception do
begin
Application.MessageBox(PChar(Format('修改数据失败:%s', [e.Message])), '系统提示');
end;
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;procedure TForm1.Button6Click(Sender: TObject);
var iRes: integer;
oEmp: TEmp;
begin
try
if lvFMLEmp.Selected <> nil then
begin
oEmp := TEmp(lvFMLEmp.Selected.Data);iRes := Fdel(FBufFML, EMPNO, oEmp.Serial);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('删除FML缓冲区EMPNO失败: %d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;iRes := Fdel(FBufFML, ENAME, oEmp.Serial);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('删除FML缓冲区ENAME失败: %d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;iRes := Fdel(FBufFML, SAL, oEmp.Serial);
if iRes = -1 then
begin
Application.MessageBox(PChar(Format('删除FML缓冲区EMPSale失败: %d-%s', [gettperrno, tpstrerror(gettperrno)])), '系统提示');
Exit;
end;GetEmpFromBuffer;
Application.MessageBox('删除数据成功!', '系统提示');
end;
except
on e: Exception do
begin
Application.MessageBox(PChar(Format('删除数据出错:%s', [e.Message])), '系统提示');
end;
end;
end;procedure TForm1.Button7Click(Sender: TObject);
begin
GetEmpFromBuffer;
end;end.
4.3 源代码下载
源代码下载路径为:http://download.csdn.net/detail/kongguoqing791025/5015183