Einzelnen Beitrag anzeigen

Benutzerbild von ArmyMan
ArmyMan

Registriert seit: 25. Mai 2004
Ort: Wil Sg
193 Beiträge
 
#6

Re: Users online in einem Chat

  Alt 3. Jul 2004, 21:45
Sorry, es ist nicht dass ich kein bock habe, aber ich weiss nicht wie es geht.

Server:
Delphi-Quellcode:
unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdIPWatch, ScktComp, StdCtrls,
  ExtCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ServerSocket1: TServerSocket;
    IdIPWatch1: TIdIPWatch;
    lblip: TLabel;
    Panel1: TPanel;
    ListBox1: TListBox;
    Edit1: TEdit;
    Button1: TButton;
    ClientSocket1: TClientSocket;
    ListBox2: TListBox;
    procedure FormActivate(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    function GetToken(aString, SepChar: string; TokenNum: Byte): string;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
lblip.Caption := IdIPWatch1.LocalIP;
clientsocket1.Host := IdIPWatch1.LocalIP;
clientsocket1.Active := true;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var i :integer;
    Text:string;
    nickname: string;
    message: string;
begin
Text:=Socket.ReceiveText;
nickname := (Trim(GetToken(Text,': ',1)));
message := (Trim(GetToken(Text,': ',2)));
begin
 Memo1.Lines.add(Timetostr(now) + ': '+ nickname + ': ' + message);
  For I := 0 to ServerSocket1.Socket.ActiveConnections - 1 do
   begin
   with ServerSocket1.Socket.Connections [I] do
  if (Connected) then SendText(nickname + ': ' + message);
 end;
end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
serversocket1.Close;
memo1.Lines.SaveToFile('chat-log.txt');
end;

procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
ListBox1.Items.Delete(ListBox1.Items.IndexOf(Socket.RemoteAddress+'('+Socket.RemoteHost+')'));
end;

procedure TForm1.ServerSocket1ClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
var nickname: string;
    text: string;
begin
Text := Socket.ReceiveText;
nickname := (Trim(GetToken(Text,': ',1)));
ListBox1.Items.Add(Socket.RemoteAddress + nickname);
end;

function TForm1.GetToken(aString, SepChar: string; TokenNum: Byte): string;
var
  Token: string;
  StrLen: Byte;
  Num: Byte;
  EndofToken: Byte;
begin
  StrLen := Length(aString);
  Num := 1;
  EndofToken := StrLen;
  while ((Num <= TokenNum) and (EndofToken <> 0)) do
  begin
    EndofToken := Pos(SepChar, aString);
    if EndofToken <> 0 then
    begin
      Token := Copy(aString, 1, EndofToken - 1);
      Delete(aString, 1, EndofToken);
      Inc(Num);
    end
    else
      Token := aString;
  end;
  if Num >= TokenNum then
    Result := Token
  else
    Result := '';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if (clientsocket1.Active = true) and (edit1.Text <> '')
then clientsocket1.Socket.SendText('console: ' + edit1.Text);
edit1.Clear;
edit1.SetFocus;
end;

end.
Client:
Delphi-Quellcode:
implementation

uses mainemail;

{$R *.dfm}

procedure TTDP_MultiTool.delay(time: word);
var start: integer;
begin
  start := GetTickCount;
  while (GetTickCount)-(Start) <= time do
  application.ProcessMessages;
end;

procedure TTDP_MultiTool.lblcloseClick(Sender: TObject);
begin
close;
end;

procedure TTDP_MultiTool.editmessageChange(Sender: TObject);
begin
if editmessage.Text = ''
then btnsend.Enabled := false
else btnsend.Enabled := true;
if memochat.Modified
then tab1.ActivePage := 'Chat';
end;

procedure TTDP_MultiTool.btnloginClick(Sender: TObject);
begin
clientsocket1.Open;
delay(2000);
if clientsocket1.Active
then
  btnlogoff.BringToFront
else
  begin
  clientsocket1.Close;
  lbonline.Clear;
  application.MessageBox('Server not online', 'Error', 0+64);
  end;
end;

procedure TTDP_MultiTool.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
clientsocket1.Socket.SendText(lblusername.caption + ' has logged on');
editmessage.Enabled := true;
editmessage.SetFocus;
end;

procedure TTDP_MultiTool.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
btnlogoff.Click;
end;

procedure TTDP_MultiTool.btnlogoffClick(Sender: TObject);
begin
clientsocket1.Socket.SendText(lblusername.caption + ' has logged off');
delay(500);
clientsocket1.Close;
btnlogin.BringToFront;
end;

procedure TTDP_MultiTool.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
begin
memochat.Lines.Add(socket.ReceiveText);
end;

procedure TTDP_MultiTool.btnsendClick(Sender: TObject);
begin
if clientsocket1.Active
then
  begin
  editmessage.SetFocus;
  clientsocket1.Socket.SendText(lblusername.caption + ': ' + editmessage.Text);
  editmessage.Clear;
  editmessage.SetFocus;
  end
else
  btnlogin.SetFocusl
end;

procedure TTDP_MultiTool.ClientSocket1Disconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
lbonline.Clear;
editmessage.Enabled := false;
end;

end.
Wo kann ich dass mit dem Info senden einfügen?

ArmyMan
ArmyMan
Reden ist Schweigen, Silber ist Gold!
Der Soldat friert nicht. Er zittert nur vor Wut, weil es so kalt ist.
  Mit Zitat antworten Zitat