Anastasia Chat Server

[OnlyOne]

imagem do servidor:




E entao amigos , eu venho ate aqui hoje para mostrar a vcs o meu ultimo soft , um servidor de chat chamado Anastasia , com ele vc pode :

* escolher a porta do servidor
* escolher o numero de pessoas q podem entrar na sala de chat
* bater um papo privado

funciona como no chat do UOL , vc fala para todos da sala ou entao para uma pessoa especifica , simples , facil e rapido

eu gostaria q vcs fizessem um teste , e depois me dessem a opnião de vcs a respeito do soft , se funcionou direito , se tem bugs etc ....

se depois alguem se interessar eu coloco os fontes aqui


See you Later !!

OnlyOne


link pra download :

http://rapidshare.de/files/31254974/Anastasia.zip.html

[rodweb]

ae, legal kra, só deu uns erros na primeira vez pq deu conflito na porta...

eu to a um tempo fazendo um chat nesse estilo, mais edito ele direto e ainda não terminei ele...nesse momento ele tah assim...





tem como postar os codes?

eu queria saber como vc fez a autenticação pra não ter nicks repitidos...

Flws..

[OnlyOne]

muito simples , quando um cliente conecta , eu pego o nick dele e procuro o nick em uma TStringList de nicks q eu crio , se o nick for encontrado na lista quer dizer q ele e repetido , entao envio uma msg ao client , ele interpreta a msg e se desconecta pq seu nick e repetido


hehehehehehehe

mas olha ai os codes ......

servidor :

Code Select Expand


{  Anastasia server chat

  Servidor de chat com suporte a chat privado

  coded by FSS (OnlyOne)

  There is no knowledge that is not power

}


unit Unit1;

interface

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

// Classes ********************************************************************/

type
  Tj = class(TForm)
    image: TImage;
    server: TServerSocket;
    porta: TLabeledEdit;
    iniciar: TButton;
    parar: TButton;
    xp: TXPManifest;
    status: TStatusBar;
    con: TLabeledEdit;

procedure FormCreate(Sender: TObject);
procedure serverClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure enviar(index : Integer ; val : String);
procedure replicar(val : String ; index : Integer);
procedure pararClick(Sender: TObject);
procedure iniciarClick(Sender: TObject);
procedure serverClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure serverClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);



end;

// Variaveis ******************************************************************/

var
  j: Tj;
  n : TStringList;
  cont : Integer = 0;

// Metodos ********************************************************************/

implementation

{$R *.dfm}


//funçao q envia dados na conexao * * * * * * * * * * * * * * * * * * * * * * */
procedure Tj.enviar(index : Integer ; val : String);
begin

server.Socket.Connections[index].SendText(val);

end; // end of Tj.enviar



//funçao q envia dados a todos os clientes * * * * * * * * * * * * * * * * * * /
procedure Tj.replicar(val : String ; index : Integer);

var i : Integer;

begin

for i := 0 to index do
 begin
 server.Socket.Connections[i].SendText(val);
 Sleep(100);
 end;

end; //end of Tj.replicar



//ao criar o form * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
procedure Tj.FormCreate(Sender: TObject);
begin

//desabilita opçoes
iniciar.Enabled := false;
porta.Enabled := false;
con.Enabled := false;

//cria lista de nicks
n := TStringList.Create();

server.Port := StrToInt(porta.Text); //porta listen
server.Active := true; //ativa servidor
server.Socket.Accept(StrToInt(con.Text)); //conexoes aceitas

//titulo do programa
Application.Title := 'Anastasia';


end; //end of Tj.FormCreate



//ao fechar o form * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /
procedure Tj.FormClose(Sender: TObject; var Action: TCloseAction);
begin

//destroi lista de nicks
n.Free;

//fecha servidor
server.Socket.Close;


end; //end of  Tj.FormClose



//quando um cliente conecta * * * * * * * * * * * * * * * * * * * * * * * * * /
procedure Tj.serverClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin

//incrementa contador
Inc(cont);

status.Panels[0].Text := 'Clientes : ' + IntToStr(cont);

end; //end of Tj.serverClientConnect



//quando um cliente disconecta * * * * * * * * * * * * * * * * * * * * * * * * /
procedure Tj.serverClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin

//decrementa contador
Dec(cont);

status.Panels[0].Text := 'Clientes : ' + IntToStr(cont);

end; //end of Tj.serverClientDisconnect



//recebendo dados do cliente * * * * * * * * * * * * * * * * * * * * * * * * * /
procedure Tj.serverClientRead(Sender: TObject; Socket: TCustomWinSocket);

var msg,s,source,dest : String;
    one,two,index,i : Integer;

label INIC;

begin

INIC:

msg := Socket.ReceiveText; //recebe msg

s := Copy(msg,0,1); //pega primeira letra da msg

if s = '#' then //se for um nick
 begin

 if cont > StrToInt(con.Text) then
 begin
 enviar(cont - 1,'-' + 'garbage');
 goto INIC;
 end;



 s := Copy(msg,2,Length(msg)); //pega o nick

 index := n.IndexOf(s); //ve se o nick existe na lista

 if index > -1 then
  begin
  enviar(server.Socket.ActiveConnections - 1,'%'); //se existir nao adiciona
  end

  else
     begin
     n.Add(s); //adiciona nick na lista

     for i := 0 to n.Count - 1 do //manda a lista de nick para o ultimo cliente
      begin
      enviar(cont - 1,'#' + n.Strings[i]);
      Sleep(100);
      end;

      replicar('#' + s, cont - 2); //manda o ultimo nick para todos clientes
      replicar('*' + s + ' entrou na sala :',cont - 1);

      end;

 end;


if s = '@' then // se for msg prive
 begin

 one := Pos('>',msg); //pega a posiçao do caracter
 two := Pos(':',msg); //pega a posiçao do caracter

 source := Copy(msg,2,one - 2); //remetente
 dest := Copy(msg,one + 1,two - one - 1); //destinatario
 s := Copy(msg,two + 1,Length(msg)); //mensagem

 index := n.IndexOf(dest); //pega a posiçao do destinatario na lista de nick

 if index = -1 then // se ele nao existir
  begin
  index := n.IndexOf(source); //pega a posiçao do remetente na lista de nick
  enviar(index,'*' + dest + ' não esta na sala'); //avisa q nick nao existi
  end

  else
     begin
     enviar(index,'*' + source + ' fala (reservadamente) para ' + dest + ' : ' + s); //envia msg prive
     end;

 end;


if s = '*' then // se for msg comum
 begin
 replicar(msg,cont - 1); //manda pra todo mundo
 end;


if s = '$' then // se cliente saiu da sala
 begin
 s := Copy(msg,2,Length(msg)); //pega nick

 index := n.IndexOf(s); //posiçao do nick na lista
 n.Delete(index); //apaga nick
 replicar('*' + s + ' saiu da sala',cont - 1);
 replicar('$' + s,cont - 1);
 end;

end; // end of Tj.serverClientRead


//parando servidor * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /
procedure Tj.pararClick(Sender: TObject);
begin

//desabilita botao
parar.Enabled := false;

//habilita opçoes
iniciar.Enabled := true;
porta.Enabled := true;
con.Enabled := true;

//fecha socket
server.Socket.Close;

//destroi lista de nicks
n.Free;

end; // end of Tj.pararClick


//inicia servidor * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
procedure Tj.iniciarClick(Sender: TObject);
begin

//pega porta de conexao
try

server.Port := StrToInt(porta.Text);

except
     status.Panels[0].Text := 'Porta Inválida';
     Exit;
     end;

//habilita botao
parar.Enabled := true;

//desabilita opçoes
iniciar.Enabled := false;
porta.Enabled := false;
con.Enabled := false;

//abre socket
server.Active := true;

//cria lista de nicks
n := TStringList.Create();


end; //end of Tj.iniciarClick






end.




e o cliente :

Code Select Expand



{    Anastasia client chat

     client do servidor de chat Anastasia

     coded by FSS (OnlyOne)

     There is no knowledge that is not power
}


unit Unit1;

interface

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


// Classes ********************************************************************/

type
  Tj = class(TForm)
    memo: TMemo;
    enviar: TButton;
    cli: TClientSocket;
    todos: TCheckBox;
    nick: TLabeledEdit;
    texto: TLabeledEdit;
    status: TStatusBar;
    xp: TXPManifest;
    lista: TListBox;
    menu: TMainMenu;
    Opes1: TMenuItem;
    op1: TMenuItem;
    op2: TMenuItem;
    host: TLabeledEdit;
    porta: TLabeledEdit;

procedure cliRead(Sender: TObject; Socket: TCustomWinSocket);
procedure enviarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure op1Click(Sender: TObject);
procedure op2Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure cliConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure cliDisconnect(Sender: TObject; Socket: TCustomWinSocket);

end;

// Variaveis ******************************************************************/

var
  j: Tj;

// Metodos ********************************************************************/

implementation

{$R *.dfm}


//ao criar o form * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
procedure Tj.FormCreate(Sender: TObject);
begin

//limpa memo
memo.Clear;

//desabilita comandos
texto.Enabled := false;
todos.Enabled := false;
enviar.Enabled := false;

//titulo do programa
Application.Title := 'Anastasia';

end; //end of Tj.FormCreate



//ao fechar o form * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * /
procedure Tj.FormClose(Sender: TObject; var Action: TCloseAction);
begin

//envia o nick
cli.Socket.SendText('$' + nick.Text);

//exibi mensagem
ShowMessage('Operação cancelada pelo usuário');

//fecha socket
cli.Socket.Close;

end; //end of Tj.FormClose



//conecta no servidor * * * * * * * * * * * * * * * * * * * * * * * * * * * * */
procedure Tj.op1Click(Sender: TObject);
begin

//verifica se esta conectado
if cli.Socket.Connected = true then
 begin
 status.Panels[0].Text := 'Você ja esta conectado';
 Exit;
 end;

//verifica nick
if nick.GetTextLen = 0 then
 begin
 status.Panels[0].Text := 'Forneça um nick';
 Exit;
 end;

//verifica host
if host.GetTextLen = 0 then
 begin
 status.Panels[0].Text := 'Forneça um host';
 Exit;
 end;

//verifica porta
if porta.GetTextLen = 0 then
 begin
 status.Panels[0].Text := 'Forneça uma porta';
 Exit;
 end

 else
    begin

    try

    StrToInt(porta.Text);

    except
         status.Panels[0].Text := 'Forneça uma porta válida';
         Exit;
         end;
         
         end;//else

cli.Host := host.Text; //host
cli.Port := StrToInt(porta.Text); //porta
cli.Open; //faz aconexao

end; //end of Tj.op1Click



//desconecta do servidor * * * * * * * * * * * * * * * * * * * * * * * * * * * /
procedure Tj.op2Click(Sender: TObject);
begin

//envia nick
cli.Socket.SendText('$' + nick.Text);

Sleep(1000);

//fecha socket
cli.Socket.Close;

end; //end of Tj.op2Click



//quando estiver conectado  * * * * * * * * * * * * * * * * * * * * * * * * * */
procedure Tj.cliConnect(Sender: TObject; Socket: TCustomWinSocket);
begin

//avisa q conectou
status.Panels[0].Text := 'Conectado';

//determina titulo na aplicação
Application.Title := 'Anastasia' + ' - ' + nick.Text;

//desabilita opçoes
nick.Enabled := false;
host.Enabled := false;
porta.Enabled := false;

//hanilita opçoes
texto.Enabled := true;
todos.Enabled := true;
enviar.Enabled := true;

//envia o nick
cli.Socket.SendText('#' + nick.Text);

end; //end of Tj.cliConnect



//quando estiver desconectado * * * * * * * * * * * * * * * * * * * * * * * * */
procedure Tj.cliDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin

//avisa q conectou
status.Panels[0].Text := 'Desconectado';

//determina titulo na aplicação
Application.Title := 'Anastasia';

//desabilita opçoes
nick.Enabled := true;
host.Enabled := true;
porta.Enabled := true;

//hanilita opçoes
texto.Enabled := false;
todos.Enabled := false;
enviar.Enabled := false;

//limpa lista
lista.Items.Clear;

//limpa memo
memo.Clear;

end; //end of Tj.cliDisconnect



//recebe dados do servidor * * * * * * * * * * * * * * * * * * * * * * * * * * /
procedure Tj.cliRead(Sender: TObject; Socket: TCustomWinSocket);

var msg,s : String;
    index : Integer;

begin

msg := cli.Socket.ReceiveText;

s := Copy(msg,0,1);

if s = '*' then
 begin
 s := Copy(msg,2,Length(msg));
 memo.Lines.Add(s);
 end;

if s = '#' then
 begin
 s := Copy(msg,2,Length(msg));
 lista.Items.Add(s);
 end;

if s = '%' then
 begin
 cli.Socket.Close;
 ShowMessage('Escolha outro nick');
 end;

if s = '-' then
 begin
 cli.Socket.Close;
 ShowMessage('Sala cheia');
 end;


if s = '$' then
 begin
 s := Copy(msg,2,Length(msg));
 index := lista.Items.IndexOf(s);
 lista.Items.Delete(index);
 end;


end; //end of Tj.cliRead



//envia texto ao servidor * * * * * * * * * * * * * * * * * * * * * * * * * * */
procedure Tj.enviarClick(Sender: TObject);
begin

if todos.Checked = true then
 begin
 cli.Socket.SendText('*' + nick.Text + ' fala para Todos : ' + texto.Text);
 end

 else
    begin
    cli.Socket.SendText('@' + nick.Text + '>' + lista.Items.Strings[lista.ItemIndex] +
    ':' + texto.Text);

    memo.Lines.Add(nick.Text + ' fala (reservadamente) para ' + lista.Items.Strings[lista.ItemIndex] +
    ':' + texto.Text);

    end;


end; //end of Tj.enviarClick




end.






espero q seja util pra vcs

OnlyOne

[rodweb]

ahh simm.....vlw....

[shake]

Massa o programa!!!
Melhor ainda o source pra gnt estudar!
Uma pergunta:
Ele não funciona com DNS não?
Aqui deu o seguinte erro quando eu tentei


Vlw ai OnlyOne!

[OnlyOne]

funciona sim

[shake]

Ah vlw funcionou sim!
Bloqueio de firewall!
hehe
Malz ai!
O programa ficou legal!
Parabéns amigo!
Abraços

[Anonymous]

É o meu projeto desse semestre na facul, só que o meu eu vou ter que fazer em java 
O link ta off tem como dar um jeito?