急救：客户端或服务端程序结束了，还会不断地向对方发送重复的消息(30分)

http://expert.csdn.net/Expert/topic/1856/1856950.xml?temp=.5864374
帮忙看看，谢谢

没人吗？

客户端的代码：

unit Client;

interface

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

type
TSyncThread=class(TThread)
protected
procedure execute;override;
private
procedure RecvText;
end;
type
TMainFrame = class(TForm)
EditServerIP: TEdit;
EditServerPort: TEdit;
LbPort: TLabel;
LbIP: TLabel;
BtnConnect: TButton;
StatusBarClient: TStatusBar;
ListBoxUsers: TListBox;
ListBoxMsg: TListBox;
LbMsg: TLabel;
EditMsg: TEdit;
BtnSend: TButton;
BtnExit: TButton;
procedure BtnExitClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BtnConnectClick(Sender: TObject);
procedure BtnSendClick(Sender: TObject);

procedure EditMsgKeyPress(Sender: TObject; var Key: Char);
private
ThreadClient:TSyncThread;

{ Private declarations }
public
{ Public declarations }
end;

var
MainFrame: TMainFrame;
ClientSocket:TSocket;
BlockBuf:array [0..1024*4-1] of char;
RecvBuf:array[0..1024*4-1] of char;
const BufLength=1024*4;


implementation

{$R *.dfm}

procedure TSyncThread.execute;
begin
while (true) do
begin
recv(ClientSocket,RecvBuf,BufLength,0);
Synchronize(RecvText);
MainFrame.Update;
end;
end;

procedure TSyncThread.RecvText;
begin
MainFrame.ListBoxUsers.Items.Add('Server');
MainFrame.ListBoxMsg.Items.Add(RecvBuf);
end;

procedure TMainFrame.BtnExitClick(Sender: TObject);
begin
ThreadClient.Terminate;
Close;
end;

procedure TMainFrame.FormCreate(Sender: TObject);
var aWSAData:TWSAData;
begin
if WSAStartup($0101,aWSAData)<>0 then
begin
raise Exception.Create('Could not start up the Socket Dll');
end;

end;

procedure TMainFrame.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if WSACleanup<>0 then
begin
MessageBox(Handle,'Can not clean up the Winsock dll','Error Msg',MB_OK);
end;
CloseSocket(ClientSocket);
end;

procedure TMainFrame.BtnConnectClick(Sender: TObject);
var
ca: SOCKADDR_IN;
hostaddr:u_long;
begin
ClientSocket:=Socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
if ClientSocket=INVALID_SOCKET then
begin
StatusBarClient.SimpleText:='Can not Connect to a Server';
exit;
end;
ca.sin_family:=PF_INET;
ca.sin_port:=htons(StrToInt(Trim(EditServerPort.Text)));
hostaddr:=inet_addr(PChar(Trim(EditServerIP.Text)));
if(hostaddr=-1) then
begin
statusBarClient.SimpleText:='The ip Addr is wrong ';
exit;
end
else
ca.sin_addr.S_addr:=hostaddr;
if connect(ClientSocket,ca,sizeof(ca))<>0 then
begin
StatusBarClient.SimpleText:='Can not Connect to romete host';
exit;
end
else
begin
StatusBarClient.SimpleText:='Connect to remote host succeed';
ThreadClient:=TSyncThread.Create(false);
BtnConnect.Enabled:=false;
end;

end;

procedure TMainFrame.BtnSendClick(Sender: TObject);
begin
strpcopy(BlockBuf,MainFrame.EditMsg.Text);
send(ClientSocket,BlockBuf,BufLength,0);
MainFrame.ListBoxUsers.Items.Add('me');
MainFrame.ListBoxMsg.Items.Add(BlockBuf);
end;



procedure TMainFrame.EditMsgKeyPress(Sender: TObject; var Key: Char);
begin
if key=#13 then
BtnSendClick(Sender);

end;

end.

服务端的代码
unit Server;

interface

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

type
TSyncThread =class(TThread)
protected
procedure execute ; override;
public
procedure AddRecvMsg;
end;
TMainFrame = class(TForm)
BtnStartServer: TButton;
ListBoxUsers: TListBox;
ListBoxMsg: TListBox;
BtnExitServer: TButton;
LbMsg: TLabel;
EditMsg: TEdit;
BtnSendMsg: TButton;
StatusBarServer: TStatusBar;
procedure BtnStartServerClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtnExitServerClick(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure BtnSendMsgClick(Sender: TObject);
procedure EditMsgEnter(Sender: TObject);


private
{ Private declarations }
ThreadListen:TSyncThread;
public
{ Public declarations }
end;

var
MainFrame: TMainFrame;
ServerSocket :TSocket;
RecvSocket :TSocket;
BlockBuf:Array [0..1024*4-1] of char;
const BufLength =1024*4;

implementation

{$R *.dfm}
procedure TSyncThread.execute;
var
ra:SOCKADDR_IN;
ra_len:Integer;

begin
ra_len:=sizeof(ra);
RecvSocket:=accept(ServerSocket,@ra,@ra_len);
while (true) do
begin
recv(RecvSocket,BlockBuf,BufLength,0);
Synchronize(AddRecvMsg);
MainFrame.Update;
end;

;
end;
procedure TSyncThread.AddRecvMsg;

begin
MainFrame.ListBoxUsers.Items.Add('Client');
MainFrame.ListBoxMsg.Items.Add(BlockBuf);
end;

procedure TMainFrame.BtnStartServerClick(Sender: TObject);
var
ca:SOCKADDR_IN;
begin
ServerSocket:=Socket(PF_INET,SOCK_STREAM,IPPROTO_IP);
if ServerSocket=INVALID_SOCKET then
begin
StatusBarServer.SimpleText:='Creating Accept Socket Server Error';
Exit;
end
else

ca.sin_family:=PF_INET;
ca.sin_port:=htons(3000);
ca.sin_addr.S_addr:=INADDR_ANY;
if Bind(ServerSocket,ca,sizeof(ca))=SOCKET_ERROR then
begin
StatusBarServer.SimpleText:='Binding the Server Socket Error';
CloseSocket(ServerSocket);
exit;
end
else
StatusBarServer.SimpleText:='Binding the Server Socket Succeed!';
try
listen(ServerSocket,5);
except
on e:Exception do
showmessage(e.Message);
end;
BtnStartServer.Enabled:=false;
ThreadListen:=TsyncThread.Create(false);



end;

procedure TMainFrame.FormCreate(Sender: TObject);
var
aWSAData:TWSADATA;
begin
if WSAStartup($0101,aWSAData)<>0 then
raise Exception.Create('Can not load the Socket Dll#13');


end;

procedure TMainFrame.BtnExitServerClick(Sender: TObject);
begin
Close;
end;

procedure TMainFrame.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if ServerSocket<>INVALID_SOCKET then
closesocket(ServerSocket);
if WSACleanup<>0 then
MessageBox(Handle,'Clean the Winsock dll wrong','Error Messge',MB_OK);

end;

procedure TMainFrame.BtnSendMsgClick(Sender: TObject);
begin
strpcopy(BlockBuf,MainFrame.EditMsg.Text);
send(RecvSocket,BlockBuf,BufLength,0);
ListBoxMsg.Items.Add(BlockBuf);
ListBoxUsers.Items.Add('Me');
end;







procedure TMainFrame.EditMsgEnter(Sender: TObject);
begin
BtnSendMsgClick(Sender);
end;

end.

太令人失望了吧。。怎么一个会贴都没有呢？