DelphiSocketDemo

原作者: [db:作者] 来自: [db:来源] 收藏邀请

转自 http://www.anqn.com/dev/delphi/2010-01-07/a09122531-1.shtml 自己对中间有点修改，下面是代码

服务端部分

unit Unit1;

interface

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

  const
    CMax=10;  //  客户端最大连接数

    // 利用此记录类型保存客户端的信息，同时保存当前客户端的连接状态
  type
    client_record=record
    CHandle:Integer;  //客户端套接字句柄
    CSocket:TCustomWinSocket;  //  客户端套接字
    CName:string;   // 客户端计算机名称
    CAddress:string;   //  客户端计算机IP地址
    CUsed:Boolean;   //客户端联机标志
  end;

type
  TForm1 = class(TForm)
    ServerSocket: TServerSocket;
    tbConnect: TButton;
    tbClose: TButton;
    tbDisconnected: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    StatusBar: TStatusBar;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Memo2: TMemo;
    lb_count: TLabel;
    procedure tbConnectClick(Sender: TObject);
    procedure tbCloseClick(Sender: TObject);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketListen(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure tbDisconnectedClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ServerSocketGetSocket(Sender: TObject; Socket: Integer;
      var ClientSocket: TServerClientWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
  private
    { Private declarations }
  public
    { Public declarations }

    session:array[0..CMax-1] of client_record;   //  客户端连接数组
        
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}


//  打开套接字连接，并使套接字进入监听状态
procedure TForm1.tbConnectClick(Sender: TObject);
begin
  ServerSocket.Open;
end;


//  关闭套接字连接，不再监听客户端的请求
procedure TForm1.tbCloseClick(Sender: TObject);
begin
  Close;      
end;


//  从客户端读取信息
procedure TForm1.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
  var
    i:Integer;
begin
  //  将从客户端读取的信息添加到Memo1中
  Memo1.Lines.Add(Socket.ReceiveText);
  for i:=0 to 9 do
  begin
    //  取得匹配的客户端
    if session[i].CHandle=Socket.SocketHandle then
    begin
      session[i].CSocket.SendText('Send String To Client: '+session[i].CAddress+' ==> '+Edit1.Text);
    end;
  end;
end;

//  服务器端套接字进入监听状态，以便监听客户端的连接
procedure TForm1.ServerSocketListen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar.Panels[0].Text:='Waiting for Client Connect...';
  
end;


//  当客户端连接到服务器端以后
procedure TForm1.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
  i,c:Integer;
begin
  c:=0;
  for i:=0 to 9 do
  begin
    if not session[i].CUsed then
    begin
      session[i].CHandle:=Socket.SocketHandle;  // 客户端套接字句柄
      session[i].CSocket:=Socket;  // 客户端套接字
      session[i].CName:=Socket.RemoteHost;  //  客户端计算机名称
      session[i].CAddress:=Socket.RemoteAddress; //  客户端计算机IP
      session[i].CUsed:=True; // 连接数组当前位置已经占用
      Break;
    end
  end;

  StatusBar.Panels[0].Text:='Client'+Socket.RemoteHost+'Connect';

  Memo2.Lines.Clear;
  for i:=0 to 9 do
  begin
    if session[i].CUsed then
    begin
      Memo2.Lines.Add('Client Name:'+session[i].CName+'Client Address:'+session[i].CAddress);
      c:=c+1;
    end;
  end;
  lb_count.Caption:=IntToStr(c);

end;

//  当客户端断开连接时
procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
var
    i,c:Integer;
begin
  for i:=0 to 9 do
  begin
    if session[i].CHandle=Socket.SocketHandle then
    begin
      session[i].CHandle:=0;
      session[i].CUsed:=False;
      Break;
    end;
  end;
  StatusBar.Panels[0].Text:='Client'+Socket.RemoteHost+'Disconnect';

  Memo2.Lines.Clear;
  for i:=0 to 9 do
  begin
    if session[i].CUsed then
    begin
      Memo2.Lines.Add('Client Name:'+session[i].CName+'Client Address:'+session[i].CAddress);
      c:=c+1;
    end;
  end;
  lb_count.Caption:=IntToStr(c);
end;

procedure TForm1.tbDisconnectedClick(Sender: TObject);
begin
  ServerSocket.Close;
  StatusBar.Panels[0].Text:='Server Socket is Close';
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ServerSocket.Close;
end;

//  当客户端正在与服务器端连接时
procedure TForm1.ServerSocketGetSocket(Sender: TObject; Socket: Integer;
  var ClientSocket: TServerClientWinSocket);
begin
  StatusBar.Panels[0].Text:='Client is Connecting...';
end;

procedure TForm1.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  StatusBar.Panels[0].Text:='Client'+Socket.RemoteHost+'Connect Error';
  ErrorCode:=0;
end;

end.

object Form1: TForm1
  Left = 420
  Top = 189
  Width = 522
  Height = 353
  Caption = 'Server'
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 200
    Top = 24
    Width = 69
    Height = 13
    Caption = 'Send to Client:'
  end
  object Label2: TLabel
    Left = 200
    Top = 48
    Width = 113
    Height = 13
    Caption = 'Receive from Client :'
  end
  object Label3: TLabel
    Left = 184
    Top = 192
    Width = 73
    Height = 13
    Caption = 'Connect Status'
  end
  object lb_count: TLabel
    Left = 296
    Top = 192
    Width = 41
    Height = 13
    Caption = 'lb_count'
  end
  object tbConnect: TButton
    Left = 16
    Top = 16
    Width = 75
    Height = 25
    Caption = 'tbConnect'
    TabOrder = 0
    OnClick = tbConnectClick
  end
  object tbClose: TButton
    Left = 16
    Top = 64
    Width = 75
    Height = 25
    Caption = 'tbClose'
    TabOrder = 1
    OnClick = tbCloseClick
  end
  object tbDisconnected: TButton
    Left = 16
    Top = 112
    Width = 97
    Height = 25
    Caption = 'tbDisconnected'
    TabOrder = 2
    OnClick = tbDisconnectedClick
  end
  object Edit1: TEdit
    Left = 280
    Top = 16
    Width = 113
    Height = 21
    TabOrder = 3
    Text = 'OK'
  end
  object Memo1: TMemo
    Left = 200
    Top = 72
    Width = 249
    Height = 105
    TabOrder = 4
  end
  object StatusBar: TStatusBar
    Left = 0
    Top = 307
    Width = 514
    Height = 19
    Panels = <
      item
        Width = 50
      end>
    SimplePanel = False
  end
  object Memo2: TMemo
    Left = 8
    Top = 208
    Width = 497
    Height = 89
    TabOrder = 6
  end
  object ServerSocket: TServerSocket
    Active = False
    Port = 1025
    ServerType = stNonBlocking
    OnListen = ServerSocketListen
    OnGetSocket = ServerSocketGetSocket
    OnClientConnect = ServerSocketClientConnect
    OnClientDisconnect = ServerSocketClientDisconnect
    OnClientRead = ServerSocketClientRead
    OnClientError = ServerSocketClientError
    Left = 112
    Top = 8
  end
end.

客户端部分

unit Unit1;

interface

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

  const
    SocketHost='192.168.86.28';  //  服务器端地址

type
  TForm1 = class(TForm)
    tbConnected: TButton;
    tbSend: TButton;
    tbClose: TButton;
    tbDisconnected: TButton;
    ClientSocket: TClientSocket;
    Edit1: TEdit;
    Memo1: TMemo;
    StatusBar: TStatusBar;
    procedure tbConnectedClick(Sender: TObject);
    procedure tbDisconnectedClick(Sender: TObject);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure tbSendClick(Sender: TObject);
    procedure tbCloseClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketConnecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

//  打开套接字连接
procedure TForm1.tbConnectedClick(Sender: TObject);
begin
  ClientSocket.Open;
end;

//  关闭套接字连接
procedure TForm1.tbDisconnectedClick(Sender: TObject);
begin
  ClientSocket.Close;
end;


//  接受服务器端的回复
procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  Memo1.Lines.Add(Socket.ReceiveText);
end;

//  发送信息到服务器
procedure TForm1.tbSendClick(Sender: TObject);
begin
  ClientSocket.Socket.SendText(Edit1.Text);
end;

procedure TForm1.tbCloseClick(Sender: TObject);
begin
  Close;
end;


//  设置要连接的服务器端地址
procedure TForm1.FormShow(Sender: TObject);
begin
  ClientSocket.Host:=SocketHost;
end;

//  已经连接到服务器端
procedure TForm1.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  tbSend.Enabled:=True;
  tbDisconnected.Enabled:=True;
  StatusBar.Panels[0].Text:='Connected'+Socket.RemoteAddress;
end;

//  正在连接到服务器端
procedure TForm1.ClientSocketConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  StatusBar.Panels[0].Text:='Connecting to server';
end;

//  当断开与服务器端的连接是发生
procedure TForm1.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  tbSend.Enabled:=False;
  tbDisconnected.Enabled:=False;
  StatusBar.Panels[0].Text:='Close Connect to'+Socket.RemoteHost;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ClientSocket.Close;
end;

procedure TForm1.ClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  StatusBar.Panels[0].Text:='Connect to server error';
  ErrorCode:=0;
end;


end.

object Form1: TForm1
  Left = 316
  Top = 279
  Width = 530
  Height = 325
  Caption = 'Client'
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnClose = FormClose
  OnShow = FormShow
  PixelsPerInch = 96
  TextHeight = 13
  object tbConnected: TButton
    Left = 16
    Top = 32
    Width = 75
    Height = 25
    Caption = 'tbConnected'
    TabOrder = 0
    OnClick = tbConnectedClick
  end
  object tbSend: TButton
    Left = 16
    Top = 80
    Width = 75
    Height = 25
    Caption = 'tbSend'
    TabOrder = 1
    OnClick = tbSendClick
  end
  object tbClose: TButton
    Left = 16
    Top = 128
    Width = 75
    Height = 25
    Caption = 'tbClose'
    TabOrder = 2
    OnClick = tbCloseClick
  end
  object tbDisconnected: TButton
    Left = 16
    Top = 176
    Width = 97
    Height = 25
    Caption = 'tbDisconnected'
    TabOrder = 3
    OnClick = tbDisconnectedClick
  end
  object Edit1: TEdit
    Left = 304
    Top = 16
    Width = 177
    Height = 21
    TabOrder = 4
    Text = 'Edit1'
  end
  object Memo1: TMemo
    Left = 304
    Top = 48
    Width = 185
    Height = 121
    Lines.Strings = (
      'Memo1')
    TabOrder = 5
  end
  object StatusBar: TStatusBar
    Left = 0
    Top = 279
    Width = 522
    Height = 19
    Panels = <
      item
        Width = 50
      end>
    SimplePanel = False
  end
  object ClientSocket: TClientSocket
    Active = False
    ClientType = ctNonBlocking
    Port = 1025
    OnConnecting = ClientSocketConnecting
    OnConnect = ClientSocketConnect
    OnDisconnect = ClientSocketDisconnect
    OnRead = ClientSocketRead
    OnError = ClientSocketError
    Left = 120
    Top = 32
  end
end.