unit1.~pas

indy例子程序,老外开发的多人聊天程序

(*Basic Multi Chat Program Coded By Jerome At The Request of
TRandy*)
unit Unit1;

interface

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

type
  TCliStatus = (csIdle, csOnlineUsers, csUserText);
  TForm1 = class(TForm)
    ClientSocket1: TClientSocket;
    GroupBox1: TGroupBox;
    ChatMemo: TMemo;
    GroupBox2: TGroupBox;
    OnlineUserListBox: TListBox;
    ChatText: TEdit;
    SendBn: TButton;
    StatusBar1: TStatusBar;
    ConnectBn: TButton;
    procedure FormCreate(Sender: TObject);
    procedure ClientSocket1Connecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ChatTextKeyPress(Sender: TObject; var Key: Char);
    procedure SendBnClick(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ConnectBnClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  UserName : String;
  ClientStatus : TCliStatus;
  implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
ClientStatus := csIdle;
end;

procedure TForm1.ClientSocket1Connecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
StatusBar1.Panels[0].Text := 'Status: Connecting...';
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
StatusBar1.Panels[0].Text := 'Status: Connected!';
Socket.SendText('CCON!' + Username);
ConnectBn.Caption := 'Disconnect'
end;

procedure TForm1.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
StatusBar1.Panels[0].Text := 'Status: Disconnected :(';
ConnectBn.Caption := 'Connect';
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
ErrorCode := 0;
StatusBar1.Panels[0].Text := 'Status: Error Disconnected No Server Active';
ConnectBn.Caption := 'Connect';
end;

procedure TForm1.ChatTextKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then
begin
key := #0;
Sendbn.Click;
end;
end;

procedure TForm1.SendBnClick(Sender: TObject);
begin
ClientSocket1.Socket.SendText('USER!' + Username + ': ' + ChatText.Text);
ChatText.Text := '';
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
FullString, After5Char, First5Char : String;
Buffer : Array[0..255] of char;
begin
case ClientStatus of
csIdle:
begin
Socket.ReceiveBuf(Buffer,5);
First5Char := copy(buffer,1,5);
After5Char := Copy(FullString,6,Length(FullString));
if First5Char = 'CCON!' then
ClientStatus := csOnlineUsers
else if First5char = 'USER!' then
ClientStatus := csUserText;
end;

csOnlineUsers:
begin
OnlineUserListBox.Clear;
FullString := Socket.ReceiveText;
OnlineUserListBox.Items.Text := fullstring;
ClientStatus := csIdle;
end;

csUserText:
begin
Fullstring := Socket.ReceiveText;
ChatMemo.Lines.Add(FullString);
ClientStatus := csIdle;
end;
end;



end;

procedure TForm1.ConnectBnClick(Sender: TObject);
var
server : String;
begin
OnlineUserListBox.Clear;
If ClientSocket1.Active = False then
begin
if InputQuery('Host ip','Enter In Host Ip',server) then
ClientSocket1.Host := Server;
if InputQuery('Username','Enter In A UserName',UserName) then
if Username <> '' then
ClientSocket1.Active := True;
end
else
begin
ClientSocket1.Active := False;
ClientSocket1.Socket.SendText('DISC!' + Username);
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ClientSocket1.Socket.SendText('DISC!' + Username);
end;

end.