main.pas

这有很多Delphi应用的例子

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, StdCtrls, Buttons, ScktComp, ExtCtrls, ComCtrls;

type
  TChatForm = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Exit1: TMenuItem;
    FileConnectItem: TMenuItem;
    FileListenItem: TMenuItem;
    StatusBar1: TStatusBar;
    Bevel1: TBevel;
    Panel1: TPanel;
    Memo1: TMemo;
    Memo2: TMemo;
    N1: TMenuItem;
    SpeedButton1: TSpeedButton;
    Disconnect1: TMenuItem;
    ServerSocket: TServerSocket;
    ClientSocket: TClientSocket;
    procedure FileListenItemClick(Sender: TObject);
    procedure FileConnectItemClick(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Memo1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocketError(Sender: TObject; Number: Smallint;
      var Description: string; Scode: Integer; const Source,
      HelpFile: string; HelpContext: Integer; var CancelDisplay: Wordbool);
    procedure Disconnect1Click(Sender: TObject);
    procedure ClientSocketConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketAccept(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
  protected
    IsServer: Boolean;
  end;

var
  ChatForm: TChatForm;
  Server: String;

implementation

{$R *.dfm}

procedure TChatForm.FileListenItemClick(Sender: TObject);
//单击菜单项"Listen"以后触发
begin
  //如果菜单项"Listen"前没有对号则在其前面显示对号
  //如果菜单项"Listen"前有对号则去掉其前面的对号
  FileListenItem.Checked := not FileListenItem.Checked;
  if FileListenItem.Checked then
  //如果菜单项"Listen"前有对号
  begin
    ClientSocket.Active := False;//使ClientSocket控件无效
    ServerSocket.Active := True; //使ServerSocket控件有效
    Statusbar1.Panels[0].Text := 'Listening...';//更新状态条的显示信息
  end
  else
  //如果菜单项"Listen"前没有对号
  begin
    if ServerSocket.Active then
      ServerSocket.Active := False;//如果ServerSocket控件有效则使其无效
    Statusbar1.Panels[0].Text := '';//清除状态条的显示信息
  end;
end;

procedure TChatForm.FileConnectItemClick(Sender: TObject);
//单击菜单项"Connect"后触发
begin
  //如果ClientSocket控件有效则使其无效
  if ClientSocket.Active then ClientSocket.Active := False;
  if InputQuery('Computer to connect to', 'Address Name:', Server) then
  //弹出对话框要求用户输入服务器端地址，如果用户单击"OK"按钮则执行以下代码
    if Length(Server) > 0 then
    //如果用户输入的服务器端地址不为空
      with ClientSocket do
      begin
        Host := Server;//指定ClientSocket控件要连接的服务器端的地址
        Active := True;//开始连接
        FileListenItem.Checked := False;//去掉菜单项"Listen"前的对号，表明本程序是客户端
      end;
end;

procedure TChatForm.Exit1Click(Sender: TObject);
//单击菜单项"Exit"时触发
begin
  ServerSocket.Close;//关闭ServerSocket控件的连接
  ClientSocket.Close;//关闭ClientSocket控件的连接
  Close;//关闭主窗口
end;

procedure TChatForm.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
//在Memo1控件上敲击键盘时触发
begin
  if Key = VK_Return then
  //如果敲击的是回车键
    if IsServer then
    //如果本程序是服务器端
//ServerSocket控件发送刚输入的一行文本
      ServerSocket.Socket.Connections[0].SendText(Memo1.Lines[Memo1.Lines.Count - 1]) 
    else//如果本程序是客户端
//ClientSocket控件发送刚输入的一行文本
      ClientSocket.Socket.SendText(Memo1.Lines[Memo1.Lines.Count - 1]); 
end;

procedure TChatForm.FormCreate(Sender: TObject);
//在主窗口创建时触发
begin
  FileListenItemClick(nil);//调用FileListenItemClick过程实现初始化
end;

procedure TChatForm.ServerSocketError(Sender: TObject; Number: Smallint;
  var Description: string; Scode: Integer; const Source, HelpFile: string;
  HelpContext: Integer; var CancelDisplay: Wordbool);
//在ServerSocket控件出错时触发
begin
  ShowMessage(Description); //显示出错信息
end;

procedure TChatForm.Disconnect1Click(Sender: TObject);
//单击菜单项"Disconnect"时触发
begin
  ClientSocket.Active := False;//使ClientSocket控件无效
  ServerSocket.Active := True; //使ServerSocket控件有效
  Statusbar1.Panels[0].Text := 'Listening...';//修改状态条的提示信息
end;

procedure TChatForm.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
//在ClientSocket控件连接到服务器端时触发
begin
  Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteHost;//在状态条中显示服务器端的地址
end;

procedure TChatForm.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
//在ClientSocket控件接收到服务器端发来的数据时触发
begin
  Memo2.Lines.Add(Socket.ReceiveText);//在Memo2控件中显示接收到的文本数据
end;

procedure TChatForm.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
//在ServerSocket控件接收到客户端发来的数据时触发
begin
  Memo2.Lines.Add(Socket.ReceiveText);//在Memo2控件中显示接收到的文本数据
end;

procedure TChatForm.ServerSocketAccept(Sender: TObject;
  Socket: TCustomWinSocket);
//在ServerSocket控件接受客户端的连接时触发
begin
  IsServer := True;//本程序是服务器端
  Statusbar1.Panels[0].Text := 'Connected to: ' + Socket.RemoteAddress;//在状态条中显示客户端的地址
end;

procedure TChatForm.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
//在ServerSocket控件和客户端建立连接时触发
begin
  Memo2.Lines.Clear;//清除Memo2中显示的文本
end;

procedure TChatForm.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
//在ClientSocket控件断开连接时触发
begin
  FileListenItemClick(nil);//重新初始化
end;

procedure TChatForm.ClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
//在ClientSocket控件出错时触发
begin
  Memo2.Lines.Add('Error connecting to : ' + Server);//显示出错的服务器端的地址
  ErrorCode := 0;//表明错误已被控制，不必系统再进行其他的处理
end;

procedure TChatForm.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
//在客户端断开到ServerSocket控件的连接时触发
begin
  Statusbar1.Panels[0].Text := 'Listening...';//更新状态条的显示信息
end;

end.