**我的聊天程序那儿出错了?**有关Tserversocket和Tclientsocket的问题。(200分)

  • 主题发起人 主题发起人 failer
  • 开始时间 开始时间
F

failer

Unregistered / Unconfirmed
GUEST, unregistred user!
我写了一个聊天程序,用的是Tserversocket和Tclientsocket。
但是无法接收到信息,现经调试发现Tserversocket的onclientread事件没有被触发,而且Tclientsocket在执行了open方法后,active仍为false
源代码如下:

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
Edit1: TEdit;
cs: TClientSocket;
ss: TServerSocket;
Label1: TLabel;
Edit2: TEdit;
Label2: TLabel;
Edit3: TEdit;
Label3: TLabel;
Edit4: TEdit;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
// if ss.Active then ss.Close;
// ss.Port :=strtoint(edit2.Text);
// ss.Open;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
if ss.Active then ss.Close;
ss.Port :=strtoint(edit2.Text);
ss.Open;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if cs.Active then cs.Close;
cs.Host :=edit3.text;
cs.Port :=strtoint(edit4.Text);
cs.Open;
cs.Socket.SendText(edit1.Text);
cs.Close;
end;

procedure TForm1.ssClientRead(Sender: TObject; Socket: TCustomWinSocket);
var rec : string;
begin
rec:= Socket.ReceiveText;
memo1.Lines.Add(rec);
end;

end.


窗体(dfm)文件:
object Form1: TForm1
Left = 192
Top = 140
Width = 523
Height = 255
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 384
Top = 8
Width = 52
Height = 13
Caption = 'local port :'
end
object Label2: TLabel
Left = 384
Top = 64
Width = 57
Height = 13
Caption = 'remote IP : '
end
object Label3: TLabel
Left = 384
Top = 120
Width = 59
Height = 13
Caption = 'remote port :'
end
object Memo1: TMemo
Left = 8
Top = 8
Width = 361
Height = 177
Lines.Strings = (
'Memo1')
TabOrder = 0
end
object Button1: TButton
Left = 296
Top = 192
Width = 75
Height = 25
Caption = 'send'
TabOrder = 1
OnClick = Button1Click
end
object Edit1: TEdit
Left = 8
Top = 192
Width = 281
Height = 21
TabOrder = 2
Text = 'Edit1'
end
object Edit2: TEdit
Left = 384
Top = 32
Width = 121
Height = 21
TabOrder = 3
Text = '5001'
end
object Edit3: TEdit
Left = 384
Top = 88
Width = 121
Height = 21
TabOrder = 4
Text = 'localhost'
end
object Edit4: TEdit
Left = 384
Top = 144
Width = 121
Height = 21
TabOrder = 5
Text = '5001'
end
object Button2: TButton
Left = 408
Top = 184
Width = 75
Height = 25
Caption = 'listen'
TabOrder = 6
OnClick = Button2Click
end
object cs: TClientSocket
Active = False
ClientType = ctNonBlocking
Host = 'localhost'
Port = 5001
Left = 96
Top = 72
end
object ss: TServerSocket
Active = False
Port = 5001
ServerType = stNonBlocking
OnClientRead = ssClientRead
Left = 136
Top = 72
end
end

我用的是winxp + d7

 
我给你一个 tcp/ip 的例子 用indy
不是聊天的,不过可以参考一下。
TT8 利用 Delphi7 Indy 开发的 文件上传例子,希望对大家有帮助 :)

ftp://fox:fox@61.133.63.168/tt8/transfile/transfile.rar

 
这个例子对付你的问题应该够了,
不过你可以参考 indy tcp 的例子,其实我也是看了标准参考以后自己写的。
 
感谢tt8的例子。
但希望大侠耐心看一下我的代码,帮我找一下错误,万分感谢。
 
这是因为你的程序在客户端和服务器端还没有成功连接你就发送数据造成的。
你可以加一个全局变量来判断是否双方建立了连接,在判断成功后再发送数据。
var
Send_Flag:Boolean

你的代码添加以下内容
procedure TForm1.Button1Click(Sender: TObject);
begin
if cs.Active then cs.Close;
Send_Flag:=False;
cs.Host :=edit3.text;
cs.Port :=strtoint(edit4.Text);
cs.Open;
//以下这一句就是判断是否建立连接(在实际应用时你要考虑超时处理)
while Not Send_Flag do Application.ProcessMessages;
cs.Socket.SendText(edit1.Text);
cs.Close;
end;

//给ClientSocket组件 cs 添加一个OnConnected事件
procedure TForm1.csConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
ConF:=True;
end;
 
不好意思,写错一个变量。 :)
//给ClientSocket组件 cs 添加一个OnConnected事件
procedure TForm1.csConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
// ConF:=True;
Send_Flag:=True;
end;
 
这个问题以前讨论过许多。
看你的代码,需要把第一次发送到服务器的代码写在csconnect中就可以了。
 
我先试试。
提前表示感谢。
 
按照dos_fan的方法改写后,程序陷入死循环,这是为何?
 
问题解决,谢谢各位。
 
后退
顶部