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 |