C
caigou
Unregistered / Unconfirmed
GUEST, unregistred user!
我用delphi创建了一个COM Automation对象支持事件，内部建立了一个Listening thread,
监听TIdTCPClient的输入，并通过事件通知客户获取了消息。代码如下.
TCetTCPClientListeningThread = class(TIdThread)
protected
FContext: TIdContext;
FClient: TCetTCPClient;
FRecvData: string;
FCmd: string;
FCmdLen: integer;
//
procedure Run; override;
private
FOnAcceptMsg: TCetTCPClientAcceptMsgEvent;
procedure HandleCommand;
public
constructor Create(AClient: TCetTCPClient); reintroduce;
destructor Destroy; override;
//
property Client: TCetTCPClient read FClient;
property RecvData: String read FRecvData write FRecvData;
property OnAcceptMsg: TCetTCPClientAcceptMsgEvent read FOnAcceptMsg write
FOnAcceptMsg;
end;
{ Listening Thread }
constructor TCetTCPClientListeningThread.Create(AClient: TCetTCPClient);
begin
inherited Create(False);
//
FContext := TIdContext.Create(AClient, nil, nil);
FClient := AClient;
FreeOnTerminate := True;
end;
destructor TCetTCPClientListeningThread.Destroy;
begin
inherited Destroy;
FreeAndNil(FContext);
end;
procedure TCetTCPClientListeningThread.HandleCommand;
begin
if FCmdLen = 3 then begin
FCmd := FRecvData;
FRecvData := '';
end
else begin
FCmd := Copy(FRecvData, 1, 3);
FRecvData := Copy(FRecvData, 5, FCmdLen - 4);
end;
if not IsNumeric(FCmd) then begin
//MesssgeBox(
if Assigned(FOnAcceptMsg) then
FOnAcceptMsg(FCmd, FRecvData, FContext);
end;
end;
procedure TCetTCPClientListeningThread.Run;
begin
FRecvData := FClient.IOHandler.ReadLn;
FCmdLen := Length(FRecvData);
if FCmdLen >= 3 then
Synchronize(HandleCommand);
FClient.IOHandler.CheckForDisconnect;
end;
然后在客户创建连接的时候创建线程。
此控件生成注册后，用VBScript调用，代码如下：
<SCRIPT FOR="myBusiness" EVENT="OnMsgAccept(sCmd, sMsg)" LANGUAGE="VBScript">
MsgBox sMsg
</SCRIPT>
</head>
<script language="vbscript">
<!--
sub Page_OnLoad()
myBusiness.GetOrCreateConnect "192.168.18.241",5001
end sub
sub SendMsg()
myBusiness.SendMsg("MSG:a test Hahaha...."
end sub
-->
</script>
<body OnLoad="Page_OnLoad()">
。。。
<OBJECT ID="myBusiness" CLASSID="CLSID:E023469C-B299-4A75-83C1-AC2F28B10B2B"></OBJECT>
</body>
我已经测试过，如果不用线程，直接读取，没问题。请高手救命啊！
监听TIdTCPClient的输入，并通过事件通知客户获取了消息。代码如下.
TCetTCPClientListeningThread = class(TIdThread)
protected
FContext: TIdContext;
FClient: TCetTCPClient;
FRecvData: string;
FCmd: string;
FCmdLen: integer;
//
procedure Run; override;
private
FOnAcceptMsg: TCetTCPClientAcceptMsgEvent;
procedure HandleCommand;
public
constructor Create(AClient: TCetTCPClient); reintroduce;
destructor Destroy; override;
//
property Client: TCetTCPClient read FClient;
property RecvData: String read FRecvData write FRecvData;
property OnAcceptMsg: TCetTCPClientAcceptMsgEvent read FOnAcceptMsg write
FOnAcceptMsg;
end;
{ Listening Thread }
constructor TCetTCPClientListeningThread.Create(AClient: TCetTCPClient);
begin
inherited Create(False);
//
FContext := TIdContext.Create(AClient, nil, nil);
FClient := AClient;
FreeOnTerminate := True;
end;
destructor TCetTCPClientListeningThread.Destroy;
begin
inherited Destroy;
FreeAndNil(FContext);
end;
procedure TCetTCPClientListeningThread.HandleCommand;
begin
if FCmdLen = 3 then begin
FCmd := FRecvData;
FRecvData := '';
end
else begin
FCmd := Copy(FRecvData, 1, 3);
FRecvData := Copy(FRecvData, 5, FCmdLen - 4);
end;
if not IsNumeric(FCmd) then begin
//MesssgeBox(
if Assigned(FOnAcceptMsg) then
FOnAcceptMsg(FCmd, FRecvData, FContext);
end;
end;
procedure TCetTCPClientListeningThread.Run;
begin
FRecvData := FClient.IOHandler.ReadLn;
FCmdLen := Length(FRecvData);
if FCmdLen >= 3 then
Synchronize(HandleCommand);
FClient.IOHandler.CheckForDisconnect;
end;
然后在客户创建连接的时候创建线程。
此控件生成注册后，用VBScript调用，代码如下：
<SCRIPT FOR="myBusiness" EVENT="OnMsgAccept(sCmd, sMsg)" LANGUAGE="VBScript">
MsgBox sMsg
</SCRIPT>
</head>
<script language="vbscript">
<!--
sub Page_OnLoad()
myBusiness.GetOrCreateConnect "192.168.18.241",5001
end sub
sub SendMsg()
myBusiness.SendMsg("MSG:a test Hahaha...."
end sub
-->
</script>
<body OnLoad="Page_OnLoad()">
。。。
<OBJECT ID="myBusiness" CLASSID="CLSID:E023469C-B299-4A75-83C1-AC2F28B10B2B"></OBJECT>
</body>
我已经测试过，如果不用线程，直接读取，没问题。请高手救命啊！