出處: http://delphi.ktop.com.tw/board.php?cid=169&fid=957&tid=20274
●[範例說明]
//*******************************************************************
// 線上聊天室(Chat Server)程式示範 **********************************
//*******************************************************************
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ScktComp;
type
TForm1 = class(TForm)
ServerSocket1: TServerSocket;
Memo1: TMemo;
Memo2: TMemo;
procedure FormCreate(Sender: TObject);
procedure ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Form建立後就將Server通道開啟
procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Active:=True; // 打開通道
end;
// 有Client連上主機
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
var i:integer;
begin
memo1.lines.clear; // Memo1用來顯示目前所有的Client通道編號
for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do // 一個一個Client找
begin
if ServerSocket1.Socket.Connections[i].SocketHandle=Socket.SocketHandle then // 如果找到目前連上的通道
memo1.lines.add('*'+inttostr(Socket.SocketHandle)) // 通道編號前面加一*號代表剛連上線的Client
else
memo1.lines.add(inttostr(ServerSocket1.Socket.Connections[i].SocketHandle)); // 通到編號加入memo1中
end;
end;
// 有Client與主機斷訊
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
var i:integer;
begin
memo1.lines.clear; // Memo1用來顯示目前所有的Client通道編號
for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do // 一個一個Client找
memo1.lines.add(inttostr(ServerSocket1.Socket.Connections[i].SocketHandle)); // 通到編號加入memo1中
memo1.lines.add('x'+inttostr(Socket.SocketHandle)) // 通道編號前面加一x號代表剛離開的Client
end;
// 有Client送來訊息
procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var i:integer;
str:string;
begin
str:=Socket.ReceiveText; // 一定要用一個變數str先存起來,不可直接使用receivetext
Memo2.Lines.Add(str); // 將收到的訊息加入memo2中
for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do // 一個一個Client找
begin
ServerSocket1.Socket.Connections[i].SendText(str); // 將收的的訊息送給所有的Client端
end;
end;
end.
//*******************************************************************
// 線上聊天室(Chat Client)程式示範 **********************************
//*******************************************************************
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ScktComp, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
ClientSocket1: TClientSocket;
Memo1: TMemo;
Memo2: TMemo;
procedure Button1Click(Sender: TObject);
procedure Memo1KeyPress(Sender: TObject; var Key: Char);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
ClientOk:boolean=false;
implementation
{$R *.dfm}
// 用來連上主機的Button
procedure TForm1.Button1Click(Sender: TObject);
var serverip:string;
begin
if InputQuery('連上主機', '請輸入主機的IP Address:', Serverip) then
if Length(Serverip) > 0 then
begin
ClientSocket1.Host := Serverip; // 設定主機的IP Address
ClientSocket1.Active := True; // 連上主機
end;
end;
// 主機已成功連上
procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
caption:='已連上主機';
ClientOk:=true;
end;
// 主機斷訊
procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
caption:='與主機斷訊';
ClientOk:=False;
end;
// 輸入訊息後按Enter
procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
if ClientOk then // 已連上主機
if Key = #13 then // 按了Enter
begin
ClientSocket1.Socket.SendText(Memo1.Lines.text); // 送訊息給主機
Key:=#0; // 清空這個Enter按鍵
memo1.clear; // 清空輸入的Memo1
end;
end;
// Client收到主機傳來的訊息
procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var str:string;
begin
str:=Socket.ReceiveText; // 讀出訊息
Memo2.Lines.Add(str); // 將訊息放入Memo2中
end;
end.
文章定位: