unit1.pas

一个简单的局域网聊天程序

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ClientSocket: TClientSocket;
    ServerSocket: TServerSocket;
    Memo2: TMemo;
    MainMenu1: TMainMenu;
    N1: TMenuItem;
    FileListenItem: TMenuItem;
    FileConnectItem: TMenuItem;
    FileDisconnectItem: TMenuItem;
    N5: TMenuItem;
    FileExitItem: TMenuItem;
    StatusBar1: TStatusBar;
    Memo1: TMemo;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    SaveDialog1: TSaveDialog;
    procedure FileListenItemClick(Sender: TObject);
    procedure FileConnectItemClick(Sender: TObject);
    procedure FileExitItemClick(Sender: TObject);
    procedure FileDisconnectItemClick(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 ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure FormActivate(Sender: TObject);
    procedure Memo1KeyPress(Sender: TObject; var Key: Char);
    procedure N2Click(Sender: TObject);
    procedure N3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  Protected
   IsServer:boolean;
   Talk:boolean;
  end;

var
  Form1: TForm1;
  Server:String;
implementation

{$R *.dfm}

procedure TForm1.FileListenItemClick(Sender: TObject);
begin
 FileListenItem.Checked:=not FileListenItem.Checked;
 if FileListenItem.Checked then
   begin
      ClientSocket.Active:=false;
      ServerSocket.Active:=true;
      StatusBar1.Panels[0].Text:='正在监听...';
      FileConnectItem.Enabled:=false;
   end else
   begin
   FileConnectItem.Enabled:=true;
   FileDisconnectitem.Enabled:=false;
   if ServerSocket.Active then serversocket.Active:=false;
   statusbar1.Panels[0].Text:='';
   end;
end;

procedure TForm1.FileConnectItemClick(Sender: TObject);

begin
   if ClientSocket.Active then ClientSocket.Active:=false;
   if InputQuery('链接的计算机','计算机地址：',Server) then
     if Length(server)>0 then
     with ClientSocket do
       begin
          Host:=server;
          Active:=true;
          FileConnectItem.Enabled:=false;
          FileListenItem.enabled:=false;
          FileDisconnectItem.Enabled:=true;
          memo1.SetFocus;
          memo1.SelectAll;
       end;

end;

procedure TForm1.FileExitItemClick(Sender: TObject);
begin
    ServerSocket.Close;
    ClientSocket.Close;
    Close;
end;

procedure TForm1.FileDisconnectItemClick(Sender: TObject);
begin
FileDisconnectItem.Enabled:=false;
if IsServer then
begin
  ServerSocket.Active:=false;
  ServerSocket.Active:=true;
  FileListenItem.Enabled:=true;
  FileListenItem.Checked:=true;
  FileConnectItem.Enabled:=false;
  Statusbar1.Panels[0].Text:='正在监听...';
end else
begin
  ClientSocket.Active:=false;
  Statusbar1.Panels[0].Text:='没有与任何服务器链接';
  FileConnectItem.Enabled:=true;
  FileListenItem.Enabled:=true;
end;
end;

procedure TForm1.ClientSocketConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
     Talk:=true;
     StatusBar1.Panels[0].Text:='与服务器 "'+Socket.RemoteHost+'" 通话中...';
end;

procedure TForm1.ClientSocketRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    Memo2.Lines.Add('对方说：'+socket.ReceiveText); 
end;

procedure TForm1.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    Memo2.Lines.Add('对方说：'+socket.ReceiveText)
end;

procedure TForm1.ServerSocketAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
   IsServer:=true;
   Statusbar1.Panels[0].Text:='与客户端 "'+socket.RemoteAddress+'" 通话中...';
end;

procedure TForm1.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    Talk:=true;
    Memo2.Lines.Clear;
    FileDisconnectitem.Enabled:=true;
end;

procedure TForm1.ClientSocketDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  application.MessageBox('到主机的链接丢失','提示',mb_ok+mb_iconinformation);
  StatusBar1.Panels[0].Text:='没有与任何服务器链接';
  FileListenItem.Enabled:=true;
  FileConnectItem.Enabled:=true;
  FileDisconnectItem.Enabled:=false;
end;

procedure TForm1.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
    application.MessageBox('到客户端的链接丢失','提示',mb_ok+mb_iconinformation);
    StatusBar1.Panels[0].Text:='正在监听...';
    FileListenItem.Enabled:=true;
    FileListenItem.checked:=true;
    FileConnectItem.enabled:=false;
    FileDisconnectItem.Enabled:=false;
end;

procedure TForm1.ClientSocketError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
    application.MessageBox('指定服务器没有正在监听','错误',mb_ok+mb_iconerror);
    FileListenItem.Enabled:=true;
    FileListenItem.Checked:=false;
    FileConnectItem.Enabled:=true;
    FileDisconnectItem.Enabled:=false;

end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  memo1.SetFocus;
  memo1.SelectAll;
  Talk:=false;
end;

procedure TForm1.Memo1KeyPress(Sender: TObject; var Key: Char);
begin
    if (Key=#13) then
     if talk then
     begin
      if IsServer then
          ServerSocket.Socket.Connections[0].SendText(memo1.Lines[memo1.Lines.count-1])
             else
          ClientSocket.Socket.SendText(memo1.Lines[memo1.Lines.count-1]);
      Memo2.Lines.Add('我说：'+memo1.Lines[memo1.Lines.count-1]);
      memo1.Lines.Clear;
     end
     else application.MessageBox('没有谈话对象','错误',mb_ok+mb_iconerror)

end;

procedure TForm1.N2Click(Sender: TObject);
begin
  memo1.Lines.Clear;
  memo2.Lines.Clear;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
  if savedialog1.Execute then
  begin
  memo2.Lines.SaveToFile(savedialog1.FileName+'.txt');
  end;
end;

end.