您的位置：程序门 -> delphi -> windows sdk/api

delphi异步方法如何实现

[收藏此页] [打印本页]选择字色：背景色：字体：[大][中][小]

delphi异步方法如何实现[无满意答案结贴,结贴人:qiuzigame]

发表于：2007-11-07 17:02:43 楼主

tutssessionrecievecmd = procedure（asender: tobject; shreceivetype: smallint; shsid: smallint;
const bstrreceived: widestring) of object;

tutssession = class（tolecontrol)
private
fonrecievecmd: tutssessionrecievecmd;
fintf: iutssession;
function getcontrolinterface: iutssession;
protected
procedure createcontrol;
procedure initcontroldata; override;
public
property nxmittype[nsid: sysint]: sysint read get_nxmittype write set_nxmittype;
published
property anchors;
property onrecievecmd: tutssessionrecievecmd read fonrecievecmd write fonrecievecmd;
end;

以上是我com接口中的定义
utssessionrecievecmd是个异步消息传递函数
现在我想实现它,改如何办,谢谢

发表于：2007-11-07 22:12:491楼得分:0

问题讲得不清楚，是要实现事件响应还是在com中实现接口

如果只是需要异步机制，可从vcl的继承一个异步对象

算帮你顶一下

发表于：2007-11-08 03:05:072楼得分:0

实现事件响应
com已经注册并安装了,我在form上拖放了一个控件,里面有这么一个异步事件响应函数 utssessionrecievecmd,
我这样写的.
unit app;

interface

uses
windows, messages, sysutils, variants, classes, graphics, controls, forms,
dialogs, olectrls, utsdvpcmlib_tlb, stdctrls;

type
tform1 = class（tform)
utssession1: tutssession;
memo1: tmemo;
button1: tbutton;
button2: tbutton;
button3: tbutton;
procedure utssession1inforeceived（asender: tobject; shrid: smallint;
const bstrsiddid: widestring; shnum: smallint);
procedure button2click（sender: tobject);
procedure utssession1recievecmd（asender: tobject; shreceivetype,
shsid: smallint; const bstrreceived: widestring);
procedure button1click（sender: tobject);
procedure utssession1errorreturn（asender: tobject; sherrorcode,
shsuberrorcode: smallint; const bstrdetail: widestring);
private
{ private declarations }
public
{ public declarations }
end;

var
form1: tform1;
sid:integer;
s:string;

implementation

{$r *.dfm}

procedure tform1.utssession1inforeceived（asender: tobject; shrid: smallint;
const bstrsiddid: widestring; shnum: smallint);
var
sid:string;
rid,sidn,connected:integer;

begin
sid := bstrsiddid;
rid := shrid;
sidn := shnum;
showmessage（'sid'+sid+'rid'+inttostr（rid)+'sidn'+inttostr（sidn));
utssession1.isconnectedcom（connected);
utssession1.keepalivecom;
showmessage（inttostr（connected));
end;
procedure tform1.button2click（sender: tobject);
var
cmd:string;
begin
cmd:='da';
utssession1.sendstr（cmd,81);
end;

procedure tform1.utssession1recievecmd（asender: tobject; shreceivetype,
shsid: smallint; const bstrreceived: widestring);
begin
showmessage（bstrreceived);
end;

procedure tform1.button1click（sender: tobject);
var
m:integer;
user,pass,server:string;
begin
m:=0;
user :='username';
pass :='password';
server :='xxx.xxx.xxx.xxx';
utssession1.connectserver（m,user,pass,server);
end;

procedure tform1.utssession1errorreturn（asender: tobject; sherrorcode,
shsuberrorcode: smallint; const bstrdetail: widestring);
var
errs:string;
begin
errs:= inttostr（sherrorcode)+bstrdetail;
showmessage（errs);
end;

end.
utssessionrecievecmd没有什么信息showmessage出来.我改如何解决.

发表于：2007-11-08 03:12:463楼得分:0

以下是 utsdvpcmlib_tlb文件内容
unit utsdvpcmlib_tlb;

// ************************************************************************ //
// warning
// -------
// the types declared in this file were generated from data read from a
// type library. if this type library is explicitly or indirectly （via
// another type library referring to this type library) re-imported, or the
// 'refresh' command of the type library editor activated while editing the
// type library, the contents of this file will be regenerated and all
// manual modifications will be lost.
// ************************************************************************ //

// pastlwtr : 1.2
// file generated on 2007-9-24 23:58:00 from type library described below.

// ************************************************************************ //
// type lib: f:\2007training\eterm3测试\etermcom.dll （1)
// libid: {32199613-7063-4d2e-abae-08db631abf55}
// lcid: 0
// helpfile:
// helpstring: utsdvpcm 1.0 type library
// depndlst:
// （1) v2.0 stdole, （c:\windows\system32\stdole2.tlb)
// errors:
// error creating palette bitmap of （tutssession) : error reading control bitmap
// ************************************************************************ //
{$typedaddress off} // unit must be compiled without type-checked pointers.
{$warn symbol_platform off}
{$writeableconst on}
{$varpropsetter on}
interface

uses windows, activex, classes, graphics, olectrls, oleserver, stdvcl, variants;

// *********************************************************************//
// guids declared in the typelibrary. following prefixes are used:
// type libraries : libid_xxxx
// coclasses : class_xxxx
// dispinterfaces : diid_xxxx
// non-disp interfaces: iid_xxxx
// *********************************************************************//
const
// typelibrary major and minor versions
utsdvpcmlibmajorversion = 1;
utsdvpcmlibminorversion = 0;

libid_utsdvpcmlib: tguid = '{32199613-7063-4d2e-abae-08db631abf55}';

diid__iutssessionevents: tguid = '{b1021d70-7054-4dc1-b80e-e74d1e5cf6ac}';
iid_iutssession: tguid = '{6767d0ee-0d6a-4da8-ae01-9c5c9efc116e}';
class_utssession: tguid = '{76191606-6e81-4259-8621-5a4cefb9aa16}';
type

// *********************************************************************//
// forward declaration of types defined in typelibrary
// *********************************************************************//
_iutssessionevents = dispinterface;
iutssession = interface;
iutssessiondisp = dispinterface;

// *********************************************************************//
// declaration of coclasses defined in type library
// （note: here we map each coclass to its default interface)
// *********************************************************************//
utssession = iutssession;

// *********************************************************************//
// dispintf: _iutssessionevents
// flags: （4096) dispatchable
// guid: {b1021d70-7054-4dc1-b80e-e74d1e5cf6ac}
// *********************************************************************//
_iutssessionevents = dispinterface
['{b1021d70-7054-4dc1-b80e-e74d1e5cf6ac}']
procedure inforeceived（shrid: smallint; const bstrsiddid: widestring; shnum: smallint); dispid 1;
procedure recievecmd（shreceivetype: smallint; shsid: smallint; const bstrreceived: widestring); dispid 2;
procedure errorreturn（sherrorcode: smallint; shsuberrorcode: smallint;
const bstrdetail: widestring); dispid 3;
end;

// *********************************************************************//
// interface: iutssession
// flags: （4416) dual oleautomation dispatchable
// guid: {6767d0ee-0d6a-4da8-ae01-9c5c9efc116e}
// *********************************************************************//
iutssession = interface（idispatch)
['{6767d0ee-0d6a-4da8-ae01-9c5c9efc116e}']
procedure sendstr（const bstrcmd: widestring; shsid: smallint); safecall;
procedure connectserver（ntype: smallint; const bstrusername: widestring;
const bstrpassword: widestring; const bstrip: widestring); safecall;
procedure isconnectedcom（out bconnected: integer); safecall;
procedure keepalivecom; safecall;
procedure disconnectcom; safecall;
procedure sendcmd（shkey: smallint; shsid: smallint); safecall;
function get_nrow: sysint; safecall;
procedure set_nrow（pval: sysint); safecall;
function get_ncol: sysint; safecall;
procedure set_ncol（pval: sysint); safecall;
function get_nxmittype（nsid: sysint): sysint; safecall;
procedure set_nxmittype（nsid: sysint; pval: sysint); safecall;
property nrow: sysint read get_nrow write set_nrow;
property ncol: sysint read get_ncol write set_ncol;
property nxmittype[nsid: sysint]: sysint read get_nxmittype write set_nxmittype;
end;

// *********************************************************************//
// dispintf: iutssessiondisp
// flags: （4416) dual oleautomation dispatchable
// guid: {6767d0ee-0d6a-4da8-ae01-9c5c9efc116e}
// *********************************************************************//

发表于：2007-11-08 03:13:204楼得分:0

iutssessiondisp = dispinterface
['{6767d0ee-0d6a-4da8-ae01-9c5c9efc116e}']
procedure sendstr（const bstrcmd: widestring; shsid: smallint); dispid 1;
procedure connectserver（ntype: smallint; const bstrusername: widestring;
const bstrpassword: widestring; const bstrip: widestring); dispid 2;
procedure isconnectedcom（out bconnected: integer); dispid 3;
procedure keepalivecom; dispid 4;
procedure disconnectcom; dispid 5;
procedure sendcmd（shkey: smallint; shsid: smallint); dispid 6;
property nrow: sysint dispid 7;
property ncol: sysint dispid 8;
property nxmittype[nsid: sysint]: sysint dispid 9;
end;

// *********************************************************************//
// ole control proxy class declaration
// control name : tutssession
// help string : utssession class
// default interface: iutssession
// def. intf. disp? : no
// event interface: _iutssessionevents
// typeflags : （2) cancreate
// *********************************************************************//
tutssessioninforeceived = procedure（asender: tobject; shrid: smallint;
const bstrsiddid: widestring;
shnum: smallint) of object;
tutssessionrecievecmd = procedure（asender: tobject; shreceivetype: smallint; shsid: smallint;
const bstrreceived: widestring) of object;
tutssessionerrorreturn = procedure（asender: tobject; sherrorcode: smallint;
shsuberrorcode: smallint;
const bstrdetail: widestring) of object;

tutssession = class（tolecontrol)
private
foninforeceived: tutssessioninforeceived;
fonrecievecmd: tutssessionrecievecmd;
fonerrorreturn: tutssessionerrorreturn;
fintf: iutssession;
function getcontrolinterface: iutssession;
protected
procedure createcontrol;
procedure initcontroldata; override;
function get_nxmittype（nsid: sysint): sysint;
procedure set_nxmittype（nsid: sysint; pval: sysint);
public
procedure sendstr（const bstrcmd: widestring; shsid: smallint);
procedure connectserver（ntype: smallint; const bstrusername: widestring;
const bstrpassword: widestring; const bstrip: widestring);
procedure isconnectedcom（out bconnected: integer);
procedure keepalivecom;
procedure disconnectcom;
procedure sendcmd（shkey: smallint; shsid: smallint);
property controlinterface: iutssession read getcontrolinterface;
property defaultinterface: iutssession read getcontrolinterface;
property nxmittype[nsid: sysint]: sysint read get_nxmittype write set_nxmittype;
published
property anchors;
property nrow: integer index 7 read getintegerprop write setintegerprop stored false;
property ncol: integer index 8 read getintegerprop write setintegerprop stored false;
property oninforeceived: tutssessioninforeceived read foninforeceived write foninforeceived;
property onrecievecmd: tutssessionrecievecmd read fonrecievecmd write fonrecievecmd;
property onerrorreturn: tutssessionerrorreturn read fonerrorreturn write fonerrorreturn;
end;

procedure register;

resourcestring
dtlserverpage = 'activex';

dtlocxpage = 'activex';

implementation

uses comobj;

procedure tutssession.initcontroldata;
const
ceventdispids: array [0..2] of dword = （
$00000001, $00000002, $00000003);
ccontroldata: tcontroldata2 = （
classid: '{76191606-6e81-4259-8621-5a4cefb9aa16}';
eventiid: '{b1021d70-7054-4dc1-b80e-e74d1e5cf6ac}';
eventcount: 3;
eventdispids: @ceventdispids;
licensekey: nil （*hr:$80004002*);
flags: $00000000;
version: 401);
begin
controldata := @ccontroldata;
tcontroldata2（ccontroldata).firsteventofs := cardinal（@@foninforeceived) - cardinal（self);
end;

procedure tutssession.createcontrol;

procedure docreate;
begin
fintf := iunknown（oleobject) as iutssession;
end;

begin
if fintf = nil then docreate;
end;

function tutssession.getcontrolinterface: iutssession;
begin
createcontrol;
result := fintf;
end;

function tutssession.get_nxmittype（nsid: sysint): sysint;
begin
result := defaultinterface.nxmittype[nsid];
end;

procedure tutssession.set_nxmittype（nsid: sysint; pval: sysint);
begin
defaultinterface.nxmittype[nsid] := pval;
end;

procedure tutssession.sendstr（const bstrcmd: widestring; shsid: smallint);
begin
defaultinterface.sendstr（bstrcmd, shsid);
end;

procedure tutssession.connectserver（ntype: smallint; const bstrusername: widestring;
const bstrpassword: widestring; const bstrip: widestring);
begin
defaultinterface.connectserver（ntype, bstrusername, bstrpassword, bstrip);
end;

procedure tutssession.isconnectedcom（out bconnected: integer);
begin
defaultinterface.isconnectedcom（bconnected);
end;

procedure tutssession.keepalivecom;
begin
defaultinterface.keepalivecom;
end;

procedure tutssession.disconnectcom;
begin
defaultinterface.disconnectcom;
end;

procedure tutssession.sendcmd（shkey: smallint; shsid: smallint);
begin
defaultinterface.sendcmd（shkey, shsid);
end;

procedure register;
begin
registercomponents（dtlocxpage, [tutssession]);
end;

end.

发表于：2007-11-08 09:33:225楼得分:0

procedure utssession1inforeceived（asender: tobject; shrid: smallint;
const bstrsiddid: widestring; shnum: smallint);
procedure utssession1recievecmd（asender: tobject; shreceivetype,
shsid: smallint; const bstrreceived: widestring);
procedure utssession1errorreturn（asender: tobject; sherrorcode,
shsuberrorcode: smallint; const bstrdetail: widestring);
其中utssession1inforeceived,utssession1errorreturn都可以正常运行,
而utssession1recievecmd没有返回结果

发表于：2007-11-09 10:22:536楼得分:0

在线等~~~~~~~~~~先顶起

发表于：2007-11-09 23:11:387楼得分:0

你必须调试接口实现嘛，问题明显是出在接口实现com。

你贴出的这些代码于分析问题毫无助益

发表于：2007-11-12 08:49:298楼得分:0

哪如何正确处理呢？请给予帮助。谢谢

其他资讯