Rede - fazendo um chat com indy completo

Top  Previous  Next

// CHAT COMPLETO USANDO INDY... ele é server/cliente (o form tá embaixo)

// © 2002 por Flavio Junior o mais macho da equipe.

unit ChatUnit;

 

interface

 

uses Forms, IdThreadMgr, IdThreadMgrDefault, IdTCPServer, IdBaseComponent,

     IdComponent, IdTCPConnection, IdTCPClient, StdCtrls, Classes, Controls;

 

type

  TChatForm = class(TForm)

    Cliente: TIdTCPClient;

    ConectarBtn: TButton;

    Memo1: TMemo;

    Edit1: TEdit;

    DesconectBtn: TButton;

    EnviarBtn: TButton;

    Edit2: TEdit;

    Server: TIdTCPServer;

    Mgr: TIdThreadMgrDefault;

    procedure ConectarBtnClick(Sender: TObject);

    procedure ClienteStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: String);

    procedure DesconectBtnClick(Sender: TObject);

    procedure EnviarBtnClick(Sender: TObject);

    procedure ServertextoCommand(ASender: TIdCommand);

    procedure FormCreate(Sender: TObject);

  end;

 

var

  ChatForm: TChatForm;

 

implementation

 

{$R *.dfm}

 

procedure TChatForm.ConectarBtnClick(Sender: TObject);

begin

  Cliente.Host := Edit2.Text;

  Cliente.Connect;

end;

 

procedure TChatForm.ClienteStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: String);

begin

  Memo1.Lines.Add('status: ' + AStatusText)

end;

 

procedure TChatForm.DesconectBtnClick(Sender: TObject);

begin

  Cliente.Disconnect;

end;

 

procedure TChatForm.EnviarBtnClick(Sender: TObject);

begin

  if Cliente.Connected then

    Cliente.WriteLn('texto ' + Edit1.Text)

  else

    Memo1.Lines.Add('--- not conected! ---');

end;

 

procedure TChatForm.ServertextoCommand(ASender: TIdCommand);

var

  I: Integer;

  S: string;

begin

  for I:= 0 to ASender.Params.Count-1 do S := S + ASender.Params[I];

  Memo1.Lines.Add(S);

end;

 

procedure TChatForm.FormCreate(Sender: TObject);

begin

  Server.Active := True;

end;

 

end.

 

----------------------------------------------------------------- form

 

object ChatForm: TChatForm

  Left = 325

  Top = 106

  Width = 304

  Height = 258

  Caption = 'Chat'

  Color = clBtnFace

  Font.Charset = DEFAULT_CHARSET

  Font.Color = clWindowText

  Font.Height = -11

  Font.Name = 'MS Sans Serif'

  Font.Style = []

  OldCreateOrder = False

  OnCreate = FormCreate

  PixelsPerInch = 96

  TextHeight = 13

  object ConectarBtn: TButton

    Left = 132

    Top = 172

    Width = 75

    Height = 25

    Caption = 'Conectar'

    TabOrder = 0

    OnClick = ConectarBtnClick

  end

  object Memo1: TMemo

    Left = 4

    Top = 4

    Width = 285

    Height = 161

    Color = clBlack

    Font.Charset = DEFAULT_CHARSET

    Font.Color = clLime

    Font.Height = -11

    Font.Name = 'MS Sans Serif'

    Font.Style = []

    ParentFont = False

    TabOrder = 1

  end

  object Edit1: TEdit

    Left = 0

    Top = 204

    Width = 193

    Height = 21

    TabOrder = 2

  end

  object DesconectBtn: TButton

    Left = 210

    Top = 172

    Width = 75

    Height = 25

    Caption = 'Desconectar'

    TabOrder = 3

    OnClick = DesconectBtnClick

  end

  object EnviarBtn: TButton

    Left = 210

    Top = 200

    Width = 75

    Height = 25

    Caption = 'Enviar'

    TabOrder = 4

    OnClick = EnviarBtnClick

  end

  object Edit2: TEdit

    Left = 4

    Top = 172

    Width = 121

    Height = 21

    TabOrder = 5

    Text = '196.0.1.222'

  end

  object Cliente: TIdTCPClient

    OnStatus = ClienteStatus

    MaxLineAction = maException

    ReadTimeout = 0

    Host = '196.0.1.222'

    Port = 23

    Left = 28

    Top = 28

  end

  object Server: TIdTCPServer

    OnStatus = ClienteStatus

    Bindings = <>

    CommandHandlers = <

      item

        CmdDelimiter = ' '

        Command = 'texto'

        Disconnect = False

        Name = 'texto'

        OnCommand = ServertextoCommand

        ParamDelimiter = ' '

        ReplyExceptionCode = 0

        ReplyNormal.NumericCode = 0

        ReplyNormal.Text.Strings = (

          'HI!')

        Tag = 0

      end>

    DefaultPort = 23

    Greeting.NumericCode = 0

    Greeting.Text.Strings = (

      'Welcome')

    MaxConnectionReply.NumericCode = 0

    ReplyExceptionCode = 0

    ReplyTexts = <>

    ReplyUnknownCommand.NumericCode = 0

    ThreadMgr = Mgr

    Left = 36

    Top = 88

  end

  object Mgr: TIdThreadMgrDefault

    Left = 80

    Top = 88

  end

end