[转帖]delphi 中调用 tuxedo 的简单 demo_MQ, Tuxedo及OLTP讨论区_Weblogic技术|Tuxedo技术|中间件技术|Oracle论坛|JAVA论坛|Linux/Unix技术|hadoop论坛_联动北方技术论坛  
网站首页 | 关于我们 | 服务中心 | 经验交流 | 公司荣誉 | 成功案例 | 合作伙伴 | 联系我们 |
联动北方-国内领先的云技术服务提供商
»  游客             当前位置:  论坛首页 »  自由讨论区 »  MQ, Tuxedo及OLTP讨论区 »
总帖数
1
每页帖数
101/1页1
返回列表
0
发起投票  发起投票 发新帖子
查看: 4176 | 回复: 0   主题: [转帖]delphi 中调用 tuxedo 的简单 demo        下一篇 
songjian
注册用户
等级:上尉
经验:711
发帖:60
精华:0
注册:2012-11-8
状态:离线
发送短消息息给songjian 加好友    发送短消息息给songjian 发消息
发表于: IP:您无权察看 2012-11-13 9:37:34 | [全部帖] [楼主帖] 楼主

procedure TForm1.Button1Click(Sender: TObject);

LongInt ): Pointer; stdcall;

var

SndBuf : PTFbfr;

RcvBuf :PTFbfr;

ret :integer;

lBillCount :longint;

fRecNum :single;

fDeposit:single;

lNumLong:longint;

BILLCOUNT,RECNUM,DEPOSIT,NUMLONG :FLDIDD32;

SvcName:array[1..20] of char;

Ilen: LongInt;

Olen: PLongInt;

lFlag :longint;

Tpinfo: PTTpinit;

begin

tuxputenv('WSNADDR=//wsy:6060');

Tpinfo :=nil;

ret := tpinit(Tpinfo);

if (ret < 0) then

begin

application.MessageBox(pchar(inttostr(ret)),'tpinit error',MB_OK);

application.MessageBox(pchar (inttostr(gettperrno)),'tpinit error',MB_ OK);

end;

SndBuf := tpalloc('FML32',nil,1024);

if (SndBuf = nil) then

begin

application.MessageBox('','error in tpalloc SndBuf',MB_OK);

tpterm();

exit;

end;

Rcv Buf := tpalloc('FML32',nil,1024);

if (RcvBuf = nil) then

begin

application.MessageBox('','error in tpalloc RcvBuf',MB_OK);

tpfree(pchar(Sndbuf));

tpterm();

exit;

end;

BILLCOUNT :=33556580;

lBillCount := 1680;

Value: Pointer; Len: FLDLEN32 ): Integer; stdcall;

ret :=Fchg32(SndBuf,BILLCOUNT,0,@lBillCount,0);

if (ret < 0) then

begin

application.MessageBox('Fchg32 lo ng error','Fchg32 long error',MB_OK);

tpfree(pchar(SndBuf));

tpfree(pchar(RcvBuf));

tpterm();

exit;

end;

RECNUM := 100665536;

fRecNum := 60.96;

ret :=Fchg32(Sn dBuf,RECNUM,0,@fRecNum,0);

if (ret < 0) then

begin

application.MessageBox('Fchg32 long error','Fchg32 double RECNUM

error',MB_OK);

tpfree(pchar(Sndbuf));

tpfree(pchar(RcvBuf));

tpterm();

exit;

end;

Ilen := 0;

Olen := 0;

lFlag :=0;

{

    strcopy(@SvcName,pchar( 'FMLTMP'));

    ret := tpcall (@SvcName,pchar(SndBuf),Ilen,@SndBuf,Olen,TPNOTRAN);

}

ret := tpcall ('FMLTMP',pchar(SndBuf),0,@SndBuf,0,0);

if (ret < 0) then

begin

application.MessageBox(pchar(inttostr(ret)),'tpcall error',MB_OK);

application.MessageBox(pchar (inttostr(gettperrno)),'tpcall error',MB_OK);

application.MessageBox(tpstrerror(gettperrno),'tpcall error',MB_OK);

tpfree(pchar(SndBuf));

tpfree(pchar(RcvBuf));

tpterm();

exit;

end;

DEPOSIT := 100665348;

ret:= Fget32(SndBuf,DEPOSIT,0,@fDeposit,0);

if (ret < 0) then

begin

application.MessageBox(pchar(inttostr(ret)),'Fget32 float DEPOSIT

error',MB_OK);

application.MessageBox(pchar (inttostr(gettperrno)),'Fget32 float

DEPOSIT error',MB_OK);

application.MessageBox(tpstrerror(gettperrno),'Fget32 float DEPOSIT

error',MB_OK);

tpfree(pchar(SndBuf));

tpfree(pchar(RcvBuf));

tpterm();

exit;

end;

application.MessageBox(pchar(floattostr(fDeposit)),'Fget32 float DEPOSIT

value ',MB_OK);

NUMLONG := 33556847;

ret := Fget32(SndBuf,NUMLONG,0,@lNumLong,0);

if (ret < 0) then

begin

applicatio n.MessageBox(pchar(inttostr(ret)),'Fget32 long NUMLONG

error',MB_OK);

application.MessageBox(pchar (inttostr(gettperrno)),'Fget32 long

NUMLONG error',MB_OK);

application.MessageBox(tpstrerror(gettperrno),'Fget32 long NUMLONG

error',MB_OK);

tpfree(pchar(SndBuf));

tpfree




赞(0)    操作        顶端 
总帖数
1
每页帖数
101/1页1
返回列表
发新帖子
请输入验证码: 点击刷新验证码
您需要登录后才可以回帖 登录 | 注册
技术讨论