Einzelnen Beitrag anzeigen

Ghostleader

Registriert seit: 22. Aug 2009
Ort: Hilden
116 Beiträge
 
Delphi 2010 Professional
 
#104

Re: Einen Chat mit den Sockets programmieren

  Alt 10. Okt 2009, 19:15
okay einen moment:
(server und client sind in einem... einzelnd hab ich es auch aber so finde ich es besser - beides hat nichgeklappt -selber fehler)

Delphi-Quellcode:
unit pChat3;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, DdeMan, IdBaseComponent, IdComponent, IdIPWatch,
  ExtDlgs, ComCtrls, Buttons, ScktComp, AppEvnts;

type
  TfmChat = class(TForm)
    MeChatlog: TMemo;
    BtSenden: TButton;
    EdSenden: TEdit;
    EdNickname: TEdit;
    btOK: TButton;
    MeWIO: TMemo;
    BtClose: TButton;
    MeChatverlauf: TMemo;
    CbStatus: TComboBox;
    cbOptionen: TComboBox;
    MeSupport: TMemo;
    MeCopyright: TMemo;
    MeHelp: TMemo;
    OpenDialog1: TOpenDialog;
    BtVerlauf: TButton;
    TmIP: TTimer;
    IdIPWatch1: TIdIPWatch;
    PaIP: TPanel;
    LaIPShow: TLabel;
    LaIP: TLabel;
    ImUser: TImage;
    BitBtn1: TBitBtn;
    ImStrich: TImage;
    DateTimePicker1: TDateTimePicker;
    OpenPictureDialog1: TOpenPictureDialog;
    ApplicationEvents1: TApplicationEvents;
    ClientSocket1: TClientSocket;
    PaServer: TPanel;
    ServerSocket1: TServerSocket;
    MeServer: TMemo;
    LaIPShow2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure btOKClick(Sender: TObject);
    procedure EdNicknameKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure EdNicknameClick(Sender: TObject);
    procedure BtSendenClick(Sender: TObject);
    procedure BtCloseClick(Sender: TObject);
    procedure CbStatusChange(Sender: TObject);
    procedure cbOptionenChange(Sender: TObject);
    procedure MeSupportDblClick(Sender: TObject);
    procedure BtVerlaufClick(Sender: TObject);
    procedure TmIPTimer(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure EdSendenChange(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Delay(time: word);
    procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  fmChat: TfmChat;

implementation

var Nickname: string;
var Nachricht: string;

procedure TFmChat.Delay(time:word);
var Start: Integer;
begin
Start:=GetTickCount;
while (GetTickCount)-(Start) <= time do
Application.ProcessMessages;
end;

{$R *.dfm}

procedure TfmChat.BtCloseClick(Sender: TObject);
begin
ClientSocket1.Socket.SendText (Nickname + 'hat den Chat verlassen.');
delay(500);
MeChatLog.Lines.SaveToFile ('Chat-Log.txt');
ClientSocket1.Close;
close;
end;

procedure TfmChat.btOKClick(Sender: TObject);
begin
Nickname:= EdNickname.text;
Nachricht:= (Nickname + ' hat den Raum betreten.');
delay(500);
ClientSocket1.Active:= True;
ClientSocket1.Socket.SendText (Nachricht);
BtSenden.Enabled:= True;
EdSenden.Enabled:= True;
MeChatlog.Enabled:= True;
Btok.Enabled:= False;
CbStatus.Enabled:= True;
MeWIO.Lines.Add (Nickname + ' <online>');
MeChatlog.Lines.SaveToFile ('Chat-Log.txt');
end;

procedure TfmChat.BtSendenClick(Sender: TObject);
begin
EdSenden.text:= Nachricht;
if (ClientSocket1.Active = True) and (EdSenden.text<>'') then
begin
  ClientSocket1.Socket.SendText (Nickname+ ' : '+ EdSenden.text);
end;
EdSenden.Text:='';

MeChatverlauf.Lines.LoadfromFile ('Chat-Log.txt');

end;

procedure TfmChat.BtVerlaufClick(Sender: TObject);
begin
OpenDialog1.Filter:= 'Text - Dokumente |*.txt';
OpenDialog1.FileName:= 'Wählen sie ihre Datei...';
OpenDialog1.Execute;
MeChatVerlauf.Lines.LoadFromFile (OpenDialog1.Filename);
end;

procedure TfmChat.CbStatusChange(Sender: TObject);
begin
if CbStatus.Itemindex = 1 then
begin
  MeChatlog.Lines.Add (Nickname + ' ist nun online.');
  MeWIO.Lines.Clear;
  MeWIO.Lines.Add (Nickname + ' <online>');
end;
if CbStatus.Itemindex = 2 then
begin
  MeChatlog.Lines.Add (Nickname + ' ist nun beschäftigt.');
  MeWIO.Lines.Clear;
  MeWIO.Lines.Add (Nickname + ' <Beschäftigt>');
end;
if CbStatus.Itemindex = 3 then
begin
  MeChatlog.Lines.Add (Nickname + ' ist nun abwesend.');
  MeWIO.Lines.Clear;
  MeWIO.Lines.Add (Nickname + ' <Abwesend>');
end;
if CbStatus.Itemindex = 4 then
begin
  MeChatlog.Lines.Add (Nickname + ' ist nun offline.');
  MeWIO.Lines.Clear;
  MeWIO.Lines.Add (Nickname + '-offline anzeigen-');
end;

end;

procedure TfmChat.ClientSocket1Connect(Sender: TObject;
  Socket: TCustomWinSocket);
begin

end;

procedure TfmChat.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
begin
FmChat.Show;
MeChatlog.Lines.Add (Socket.ReceiveText);
end;

procedure TfmChat.cbOptionenChange(Sender: TObject);
begin
if CbOptionen.itemindex = 0 then
begin
  FmChat.Color:= Clskyblue;
  MeHelp.Visible:= False;
  MeSupport.Visible:= False;
  MeCopyright.Visible:= False;
end;
if CbOptionen.itemindex = 1 then
begin
  MeHelp.Visible:= True;
end
else
begin
  MeHelp.Visible:= False;
end;
if cbOptionen.itemindex = 2 then
begin
  MeSupport.Visible:= True;
end
else
begin
  MeSupport.Visible:= False;
end;
if cbOptionen.ItemIndex = 3 then
begin
  MeCopyright.Visible:= True;
end
else
begin
  MeCopyright.Visible:= False;
end;
if cbOptionen.Itemindex = 4 then
begin
  OpenPictureDialog1.Filename:= 'Ihre Datei...';
  OpenPictureDialog1.Execute;
  ImUser.Picture.LoadFromFile (OpenPictureDialog1.Filename);
end;
end;

procedure TfmChat.EdNicknameClick(Sender: TObject);
begin
EdNickname.Clear;
end;

procedure TfmChat.EdNicknameKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
Btok.Enabled:= True;
end;

procedure TfmChat.EdSendenChange(Sender: TObject);
begin
if EdSenden.text = 'Server.Listthen
begin
  PaServer.Visible:= True;
  FmChat.Height:= 636;
end
else
begin
  PaServer.Visible:= False;
  FmChat.Height:= 285;
end;
end;

procedure TfmChat.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ServerSocket1.Close;
MeChatLog.Lines.SaveToFile('Chat-Log.txt');

end;

procedure TfmChat.FormCreate(Sender: TObject);
begin
LaIpShow2.Caption:= IdIPWatch1.LocalIP;
FmChat.Height:= 285;
ClientSocket1.Host:= '80.132.196.139' ;
ClientSocket1.Active:= True;
TmIP.Enabled:= True;
BtSenden.Enabled:= False;
EdSenden.Enabled:= False;
MeChatlog.Enabled:= False;
Btok.Enabled:= False;
MeChatverlauf.Lines.LoadfromFile ('Chat-Log.txt');
CbStatus.Enabled:= False;
CbOptionen.Enabled:= True;
MeSupport.Visible:= False;
MeCopyright.Visible:= False;
MeHelp.Visible:= False;

end;

procedure TfmChat.MeSupportDblClick(Sender: TObject);
begin
MeSupport.Visible:= False;
end;

procedure TfmChat.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
  Var Text: String;
      i: integer;
begin
Text:=Socket.ReceiveText;
MeChatlog.Lines.add(Timetostr(now)+': '+Text);
For I := 0 to ServerSocket1.Socket.ActiveConnections - 1 do
begin
with ServerSocket1.Socket.Connections [I] do
if (Connected) then SendText(Text);
end;
end;

procedure TfmChat.TmIPTimer(Sender: TObject);
begin
LaIP.Caption:=IdIPWatch1.LocalIP;
end;

end.
ist ziemlich viel.

Me steht für Memo
La steht für Label
Ed steht für Edit
Tm steht für Timer
Bt steht für Button...


ansonsten einfach nachfragen
Michael
  Mit Zitat antworten Zitat