我学着做的一个多线程聊天程序，怎么没有激活线程执行呢？ ( 积分: 100 )

  • 主题发起人 主题发起人 xkdcc
  • 开始时间 开始时间
X

xkdcc

Unregistered / Unconfirmed
GUEST, unregistred user!
服务器是把监听到的客户端的发言（发给服务器的）再发给每个客户端，应该每个客户端的连接是一个线程，服务器会显示所有的线程信息，如线程ID和线程总数。
我这是Delphi6分布式应用系统开发（中国铁道出版社）上的例程，没有光盘，看不到原程序，所以自己按照书上写的做的：
我的服务器代码如下：U_main.pas和U_myServerThread.pas
//--------服务器U_main.pas----------------------
unit U_main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, ScktComp;
type
Tfrmmain = class(TForm)
listenBtn: TBitBtn;
GroupBox1: TGroupBox;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
GroupBox2: TGroupBox;
Label3: TLabel;
Edit2: TEdit;
Label5: TLabel;
Edit3: TEdit;
Label4: TLabel;
Edit4: TEdit;
GroupBox3: TGroupBox;
Label6: TLabel;
Memo2: TMemo;
StatusBar1: TStatusBar;
BitBtn2: TBitBtn;
ServerSocket: TServerSocket;
ListBox1: TListBox;
ListBox2: TListBox;
procedure ServerSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
procedure ServerSocketThreadStart(Sender: TObject;
Thread: TServerClientThread);
procedure ServerSocketThreadEnd(Sender: TObject;
Thread: TServerClientThread);
procedure ServerSocketListen(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure BitBtn2Click(Sender: TObject);
procedure listenBtnClick(Sender: TObject);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{ Private declarations }
public
{ Public declarations }
ListenPort:String;
IsServer:Boolean;
end;

var
frmmain: Tfrmmain;
implementation


uses U_myServerThread;
{$R *.dfm}
{ TForm1 }
procedure Tfrmmain.ServerSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread:=MyServerThread.Create(Memo2,ListBox1,False,ClientSocket);
end;

procedure Tfrmmain.ServerSocketThreadStart(Sender: TObject;
Thread: TServerClientThread);
begin
ListBox2.Items.Add('Thread<' + InttoStr(Thread.ThreadID) + '>');
Edit2.Text := InttoStr(Thread.ServerSocket.ActiveThreads);
Edit3.Text := InttoStr(Thread.ServerSocket.IdleThreads);
Edit4.Text := InttoStr(Thread.ServerSocket.ThreadCacheSize);
end;

procedure Tfrmmain.ServerSocketThreadEnd(Sender: TObject;
Thread: TServerClientThread);
begin
ListBox2.Items.Delete(ListBox2.Items.IndexOf('Thread<' + InttoStr(Thread.ThreadID) + '>'));
Edit2.Text := InttoStr(Thread.ServerSocket.ActiveThreads);
Edit3.Text := InttoStr(Thread.ServerSocket.IdleThreads);
Edit4.Text := InttoStr(Thread.ServerSocket.ThreadCacheSize);
end;

procedure Tfrmmain.ServerSocketListen(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Listening ' + ListenPort + '...';
end;

procedure Tfrmmain.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
IsServer :=True;
ListBox1.Items.Add('Client<' + Socket.RemoteHost + ':' + InttoStr(Socket.RemotePort)
+ '>Server<' + Socket.LocalHost + ':' + InttoStr(Socket.LocalPort)
+ '>SocketHandle<' + InttoStr(Socket.SocketHandle)
+ {'>Thread<' + InttoStr(ThreadID) +} '>');
Edit1.Text := InttoStr(ServerSocket.Socket.ActiveConnections);
StatusBar1.SimpleText := 'Accept connection from :' + Socket.RemoteHost;
end;

procedure Tfrmmain.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Client connected.';
end;

procedure Tfrmmain.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
con:Integer;
ActiveAfterDisconnect:Integer;
begin
ActiveAfterDisconnect := ServerSocket.Socket.ActiveConnections;
for con:=0 to ServerSocket.Socket.ActiveConnections - 1do
if Socket=ServerSocket.Socket.Connections[con] then
begin
ListBox1.Items.Delete(con);
ActiveAfterDisconnect := ActiveAfterDisconnect -1;
end;
Edit1.Text := InttoStr(ActiveAfterDisconnect);
StatusBar1.SimpleText := 'Client disconnect.';
end;

procedure Tfrmmain.BitBtn2Click(Sender: TObject);
begin
Close;
end;

procedure Tfrmmain.listenBtnClick(Sender: TObject);
begin
if ServerSocket.Active then
begin
ServerSocket.Active := False;
StatusBar1.SimpleText := '';
end;
if InputQuery('Port to listen','Port:',ListenPort) then
ServerSocket.Port := StrtoInt(ListenPort);
ServerSocket.Active := True;
StatusBar1.SimpleText := 'Listening @' + ListenPort + '...';
end;

procedure Tfrmmain.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure Tfrmmain.ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ShowMessage('ErrorCode is ' + InttoStr(ErrorCode) + '.');
end;

end.
//--------------------U_myServerThread.pas-----------
unit U_myServerThread;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, ScktComp;
type
MyServerThread = class(TServerClientThread)
private
FMemo:TMemo;
FListBuffer:TListBox;
Buffer:array[0..80] of Char;
procedure Execute;
protected
procedure ClientExecute;override;
proceduredo
DisplayCreate;
proceduredo
DisplayBuffer;
public
constructor Create(Memo:TMemo;ListBox:TListBox;CreateSuspended:Boolean;
ASocket:TServerClientWinSocket);
end;

implementation
uses U_main;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure MyServerThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
}
{ MyServerThread }
procedure MyServerThread.ClientExecute;
var
Stream:TWinSocketStream;
begin
inherited;
//----------debug-------------
showMessage('ClientExecute!');
//----------------------------
while (not Terminated) and ClientSocket.Connecteddo
begin
try
Stream:=TWinSocketStream.Create(ClientSocket,60000);
try
FillChar(Buffer,80,0);
if Stream.WaitForData(60000) then
begin
if Stream.Read(Buffer,80)=0 then
ClientSocket.Close;
//Ö´ÐÐDoDisplayBufferº¯Êý
Synchronize(DoDisplayBuffer);
end;
finally
Stream.Free;
end;
except
HandleException;
end;
end;

end;

constructor MyServerThread.Create(Memo: TMemo;
ListBox: TListBox;
CreateSuspended: Boolean;
ASocket: TServerClientWinSocket);
begin
FMemo:=Memo;
FListBox:=ListBox;
end;

procedure MyServerThread.DoDisplayBuffer;
var
con:Integer;
begin
//ÔÚMemoÖÐÏÔʾÊÕµ½µÄÐÅÏ¢
FMemo.Lines.Add('Thread<' + InttoStr(threadId) + '>
Client<' + ClientSocket.RemoteHost + ':' + InttoStr( ClientSocket.RemotePort) + '>:' + Buffer);
//½«ÊÕµ½µÄÐÅÏ¢·¢¸øÿ¸öÕýÁ¬½ÓÔڸķþÎñÆ÷ÉϵĿͻ§¶Ë
for con:=0 to ClientSocket.ServerWinSocket.ActiveConnections - 1do
ClientSocket.ServerWinSocket.Connections[con].SendText(Buffer);
end;

procedure MyServerThread.DoDisplayCreate;
begin

end;

procedure MyServerThread.Execute;
begin
ClientExecute;
end;

end.
我的客户端代码：U_main.pas
//----------------客户端U_main-----------------
unit U_main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ScktComp, ComCtrls;
type
TForm1 = class(TForm)
ClientSocket: TClientSocket;
ServerSocket: TServerSocket;
Label1: TLabel;
Label2: TLabel;
GroupBox1: TGroupBox;
ListenButton: TButton;
ConnectButton: TButton;
DisconnectButton: TButton;
Memo1: TMemo;
Memo2: TMemo;
StatusBar1: TStatusBar;
procedure ListenButtonClick(Sender: TObject);
procedure ConnectButtonClick(Sender: TObject);
procedure DisconnectButtonClick(Sender: TObject);
procedure ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure Memo1KeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
ListenPort :String;
Server :String;
ConnectPort :String;//服务器端口
IsServer :Boolean;
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ListenButtonClick(Sender: TObject);
begin
if ServerSocket.Active then
begin
ServerSocket.Active := False;
StatusBar1.Panels[0].Text := '';
end;
if InputQuery('Port to listen','Port:',ListenPort) then
ServerSocket.Port:=StrtoInt(ListenPort);
ClientSocket.Active := False;
ServerSocket.Active := True;
StatusBar1.SimpleText := 'Listening @'+ListenPort+' ...';
end;

procedure TForm1.ConnectButtonClick(Sender: TObject);
begin
if ClientSocket.Active then
begin
ClientSocket.Active := False;
StatusBar1.SimpleText := '';
end;

if InputQuery('Computer to connect to','Address Name:',Server) then
if InputQuery('Port to connect to','Port:',ConnectPort) then
if Length(Server)>0 then
with ClientSocketdo
begin
Host := Server;
Port := StrtoInt(ConnectPort);
Active := True;
end;
end;

procedure TForm1.DisconnectButtonClick(Sender: TObject);
begin
ClientSocket.Active := False;
StatusBar1.SimpleText := '';
end;

procedure TForm1.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
IsServer := True;
StatusBar1.SimpleText := 'Accept connection from:' + Socket.RemoteAddress;
end;

procedure TForm1.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Listening ...';
end;

procedure TForm1.ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ShowMessage('ErrorCode:' + InttoStr(ErrorCode));
end;

procedure TForm1.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Connected to:' + Socket.RemoteHost;
end;

procedure TForm1.ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Memo2.Lines.Add('Error connecting to:' + Server);
ErrorCode :=0;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if Key = VK_RETURN then
if IsServer then
//如果客户端作为服务器，用服务器的Socket发送文本（客户端有ServerSocket）
ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count - 1])
else

ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.count - 1]);
end;

end.
 
服务器是把监听到的客户端的发言（发给服务器的）再发给每个客户端，应该每个客户端的连接是一个线程，服务器会显示所有的线程信息，如线程ID和线程总数。
我这是Delphi6分布式应用系统开发（中国铁道出版社）上的例程，没有光盘，看不到原程序，所以自己按照书上写的做的：
我的服务器代码如下：U_main.pas和U_myServerThread.pas
//--------服务器U_main.pas----------------------
unit U_main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, ScktComp;
type
Tfrmmain = class(TForm)
listenBtn: TBitBtn;
GroupBox1: TGroupBox;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
GroupBox2: TGroupBox;
Label3: TLabel;
Edit2: TEdit;
Label5: TLabel;
Edit3: TEdit;
Label4: TLabel;
Edit4: TEdit;
GroupBox3: TGroupBox;
Label6: TLabel;
Memo2: TMemo;
StatusBar1: TStatusBar;
BitBtn2: TBitBtn;
ServerSocket: TServerSocket;
ListBox1: TListBox;
ListBox2: TListBox;
procedure ServerSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
procedure ServerSocketThreadStart(Sender: TObject;
Thread: TServerClientThread);
procedure ServerSocketThreadEnd(Sender: TObject;
Thread: TServerClientThread);
procedure ServerSocketListen(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure BitBtn2Click(Sender: TObject);
procedure listenBtnClick(Sender: TObject);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
private
{ Private declarations }
public
{ Public declarations }
ListenPort:String;
IsServer:Boolean;
end;

var
frmmain: Tfrmmain;
implementation


uses U_myServerThread;
{$R *.dfm}
{ TForm1 }
procedure Tfrmmain.ServerSocketGetThread(Sender: TObject;
ClientSocket: TServerClientWinSocket;
var SocketThread: TServerClientThread);
begin
SocketThread:=MyServerThread.Create(Memo2,ListBox1,False,ClientSocket);
end;

procedure Tfrmmain.ServerSocketThreadStart(Sender: TObject;
Thread: TServerClientThread);
begin
ListBox2.Items.Add('Thread<' + InttoStr(Thread.ThreadID) + '>');
Edit2.Text := InttoStr(Thread.ServerSocket.ActiveThreads);
Edit3.Text := InttoStr(Thread.ServerSocket.IdleThreads);
Edit4.Text := InttoStr(Thread.ServerSocket.ThreadCacheSize);
end;

procedure Tfrmmain.ServerSocketThreadEnd(Sender: TObject;
Thread: TServerClientThread);
begin
ListBox2.Items.Delete(ListBox2.Items.IndexOf('Thread<' + InttoStr(Thread.ThreadID) + '>'));
Edit2.Text := InttoStr(Thread.ServerSocket.ActiveThreads);
Edit3.Text := InttoStr(Thread.ServerSocket.IdleThreads);
Edit4.Text := InttoStr(Thread.ServerSocket.ThreadCacheSize);
end;

procedure Tfrmmain.ServerSocketListen(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Listening ' + ListenPort + '...';
end;

procedure Tfrmmain.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
IsServer :=True;
ListBox1.Items.Add('Client<' + Socket.RemoteHost + ':' + InttoStr(Socket.RemotePort)
+ '>Server<' + Socket.LocalHost + ':' + InttoStr(Socket.LocalPort)
+ '>SocketHandle<' + InttoStr(Socket.SocketHandle)
+ {'>Thread<' + InttoStr(ThreadID) +} '>');
Edit1.Text := InttoStr(ServerSocket.Socket.ActiveConnections);
StatusBar1.SimpleText := 'Accept connection from :' + Socket.RemoteHost;
end;

procedure Tfrmmain.ServerSocketClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Client connected.';
end;

procedure Tfrmmain.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var
con:Integer;
ActiveAfterDisconnect:Integer;
begin
ActiveAfterDisconnect := ServerSocket.Socket.ActiveConnections;
for con:=0 to ServerSocket.Socket.ActiveConnections - 1do
if Socket=ServerSocket.Socket.Connections[con] then
begin
ListBox1.Items.Delete(con);
ActiveAfterDisconnect := ActiveAfterDisconnect -1;
end;
Edit1.Text := InttoStr(ActiveAfterDisconnect);
StatusBar1.SimpleText := 'Client disconnect.';
end;

procedure Tfrmmain.BitBtn2Click(Sender: TObject);
begin
Close;
end;

procedure Tfrmmain.listenBtnClick(Sender: TObject);
begin
if ServerSocket.Active then
begin
ServerSocket.Active := False;
StatusBar1.SimpleText := '';
end;
if InputQuery('Port to listen','Port:',ListenPort) then
ServerSocket.Port := StrtoInt(ListenPort);
ServerSocket.Active := True;
StatusBar1.SimpleText := 'Listening @' + ListenPort + '...';
end;

procedure Tfrmmain.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure Tfrmmain.ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ShowMessage('ErrorCode is ' + InttoStr(ErrorCode) + '.');
end;

end.
//--------------------U_myServerThread.pas-----------
unit U_myServerThread;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ComCtrls, ScktComp;
type
MyServerThread = class(TServerClientThread)
private
FMemo:TMemo;
FListBuffer:TListBox;
Buffer:array[0..80] of Char;
procedure Execute;
protected
procedure ClientExecute;override;
proceduredo
DisplayCreate;
proceduredo
DisplayBuffer;
public
constructor Create(Memo:TMemo;ListBox:TListBox;CreateSuspended:Boolean;
ASocket:TServerClientWinSocket);
end;

implementation
uses U_main;
{ Important: Methods and properties of objects in visual components can only be
used in a method called using Synchronize, for example,
Synchronize(UpdateCaption);
and UpdateCaption could look like,
procedure MyServerThread.UpdateCaption;
begin
Form1.Caption := 'Updated in a thread';
end;
}
{ MyServerThread }
procedure MyServerThread.ClientExecute;
var
Stream:TWinSocketStream;
begin
inherited;
//----------debug-------------
showMessage('ClientExecute!');
//----------------------------
while (not Terminated) and ClientSocket.Connecteddo
begin
try
Stream:=TWinSocketStream.Create(ClientSocket,60000);
try
FillChar(Buffer,80,0);
if Stream.WaitForData(60000) then
begin
if Stream.Read(Buffer,80)=0 then
ClientSocket.Close;
//Ö´ÐÐDoDisplayBufferº¯Êý
Synchronize(DoDisplayBuffer);
end;
finally
Stream.Free;
end;
except
HandleException;
end;
end;

end;

constructor MyServerThread.Create(Memo: TMemo;
ListBox: TListBox;
CreateSuspended: Boolean;
ASocket: TServerClientWinSocket);
begin
FMemo:=Memo;
FListBox:=ListBox;
end;

procedure MyServerThread.DoDisplayBuffer;
var
con:Integer;
begin
//ÔÚMemoÖÐÏÔʾÊÕµ½µÄÐÅÏ¢
FMemo.Lines.Add('Thread<' + InttoStr(threadId) + '>
Client<' + ClientSocket.RemoteHost + ':' + InttoStr( ClientSocket.RemotePort) + '>:' + Buffer);
//½«ÊÕµ½µÄÐÅÏ¢·¢¸øÿ¸öÕýÁ¬½ÓÔڸķþÎñÆ÷ÉϵĿͻ§¶Ë
for con:=0 to ClientSocket.ServerWinSocket.ActiveConnections - 1do
ClientSocket.ServerWinSocket.Connections[con].SendText(Buffer);
end;

procedure MyServerThread.DoDisplayCreate;
begin

end;

procedure MyServerThread.Execute;
begin
ClientExecute;
end;

end.
我的客户端代码：U_main.pas
//----------------客户端U_main-----------------
unit U_main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ScktComp, ComCtrls;
type
TForm1 = class(TForm)
ClientSocket: TClientSocket;
ServerSocket: TServerSocket;
Label1: TLabel;
Label2: TLabel;
GroupBox1: TGroupBox;
ListenButton: TButton;
ConnectButton: TButton;
DisconnectButton: TButton;
Memo1: TMemo;
Memo2: TMemo;
StatusBar1: TStatusBar;
procedure ListenButtonClick(Sender: TObject);
procedure ConnectButtonClick(Sender: TObject);
procedure DisconnectButtonClick(Sender: TObject);
procedure ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
procedure Memo1KeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
private
{ Private declarations }
public
{ Public declarations }
ListenPort :String;
Server :String;
ConnectPort :String;//服务器端口
IsServer :Boolean;
end;

var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.ListenButtonClick(Sender: TObject);
begin
if ServerSocket.Active then
begin
ServerSocket.Active := False;
StatusBar1.Panels[0].Text := '';
end;
if InputQuery('Port to listen','Port:',ListenPort) then
ServerSocket.Port:=StrtoInt(ListenPort);
ClientSocket.Active := False;
ServerSocket.Active := True;
StatusBar1.SimpleText := 'Listening @'+ListenPort+' ...';
end;

procedure TForm1.ConnectButtonClick(Sender: TObject);
begin
if ClientSocket.Active then
begin
ClientSocket.Active := False;
StatusBar1.SimpleText := '';
end;

if InputQuery('Computer to connect to','Address Name:',Server) then
if InputQuery('Port to connect to','Port:',ConnectPort) then
if Length(Server)>0 then
with ClientSocketdo
begin
Host := Server;
Port := StrtoInt(ConnectPort);
Active := True;
end;
end;

procedure TForm1.DisconnectButtonClick(Sender: TObject);
begin
ClientSocket.Active := False;
StatusBar1.SimpleText := '';
end;

procedure TForm1.ServerSocketAccept(Sender: TObject;
Socket: TCustomWinSocket);
begin
IsServer := True;
StatusBar1.SimpleText := 'Accept connection from:' + Socket.RemoteAddress;
end;

procedure TForm1.ServerSocketClientRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Listening ...';
end;

procedure TForm1.ServerSocketClientError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
ShowMessage('ErrorCode:' + InttoStr(ErrorCode));
end;

procedure TForm1.ClientSocketConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.SimpleText := 'Connected to:' + Socket.RemoteHost;
end;

procedure TForm1.ClientSocketRead(Sender: TObject;
Socket: TCustomWinSocket);
begin
Memo2.Lines.Add(Socket.ReceiveText);
end;

procedure TForm1.ClientSocketError(Sender: TObject;
Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
Memo2.Lines.Add('Error connecting to:' + Server);
ErrorCode :=0;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject;
var Key: Word;
Shift: TShiftState);
begin
if Key = VK_RETURN then
if IsServer then
//如果客户端作为服务器，用服务器的Socket发送文本（客户端有ServerSocket）
ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count - 1])
else

ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.count - 1]);
end;

end.
 
你应该把整本书的代码都抄下来，这样大家就有更多的时间看了！
 
有道理[:(!]
 
您必须登录或注册才可回复。

Similar threads

I
一个群发邮件的DELPHI代码
回复
0
查看
780
import
I
I
监测程序多久没有用户输入
回复
0
查看
613
import
I
I
程序的自动升级
回复
0
查看
622
import
I
I
如何得知某端口一打开
回复
0
查看
693
import
I
I
用Delphi设计自己的代理服务器
回复
0
查看
768
import
I
后退
顶部