24h購物| | PChome| 登入
2009-04-02 14:40:50| 人氣967| 回應0 | 上一篇 | 下一篇

[轉貼]VCL InterNet 元件篇(TServerSocket,TClientSocket)-程式

推薦 0 收藏 0 轉貼0 訂閱站台

出處: 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.

台長: kk_july
人氣(967) | 回應(0)| 推薦 (0)| 收藏 (0)| 轉寄
全站分類: 不分類 | 個人分類: 程式設計 |
此分類下一篇:Bat 批次檔_關閉已開啟的程式 ( taskkill )
此分類上一篇:[轉貼]VCL InterNet 元件篇(TServerSocket,TClientSocket)-介紹

是 (若未登入"個人新聞台帳號"則看不到回覆唷!)
* 請輸入識別碼:
請輸入圖片中算式的結果(可能為0) 
(有*為必填)
TOP
詳全文