Indy - Server schickt Nachricht an alle Clients

[NeoLuxembourg]

ich hab selber (vor 1. woche) versucht sowas zu bauen und jetzt klapts alles auch:

Client:

Delphi-Quellcode:

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdAntiFreezeBase, IdAntiFreeze;

 // ------- NETWORK PROTOKOL --------
 // v001
  type
        TNetConfig = record
                data : boolean;
                CMD  : string[20];
                SIP  : string[16];
                DIP  : string[16];
                end;

  // ---------------------------------
  
  type
        TForm1 = class(TForm)
    tcpClient: TIdTCPClient;
    GroupBox1: TGroupBox;
    btnConnect: TButton;
    edtHost: TEdit;
    edtPort: TEdit;
    edtUser: TEdit;
    edtPass: TEdit;
    btnDisconnect: TButton;
    Label1: TLabel;
    Label2: TLabel;
    memLog: TMemo;
    IdAntiFreeze1: TIdAntiFreeze;
    edtSend: TEdit;
    btnSend: TButton;
    procedure FormDestroy(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure btnDisconnectClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  inloop : integer = 1; //default value = 1 (while in thread = stop !)
  TOut : THandle;

implementation

{$R *.DFM}

function netscan(P : pointer): integer;
var
        Data:TNetConfig;
begin

// Code !
while inloop =0 do
        begin
          //read data from server
          Form1.tcpclient.ReadBuffer(Data,sizeof(Data));

          if Data.data = false then
                Form1.memLog.Lines.add('STR:'+Data.CMD)
          else
                Form1.memLog.Lines.add('CMD:'+Data.CMD);
                
          // read thread status (inloop value)
          sleep(300);
          Form1.Label1.Caption := inttostr(inLoop);

        end;

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
        //set inLoop to 1 (stops while in thread)
        InterlockedExchange(inLoop, 1);
        // TCP Disconnection !
        tcpclient.Disconnect;
end;

procedure TForm1.btnConnectClick(Sender: TObject);
var
  ThreadID: LongWord;
  p: Pointer;
begin

   // Server-IP (Data from edtHost)
        tcpclient.Host := edtHost.Text;
        // Server-Port (Data from edtPort)
        tcpclient.Port := strtoint(edtPort.Text);
        // Connection to server
        tcpClient.Connect;
        // If connection is succesfull, then start the thread !
        if tcpClient.Connected then
        begin
                memLog.Lines.Add('Connected to server!');
                //set inLoop to 0 (while in thread can run)
                InterlockedExchange(inLoop, 0);
                //start thread !
                TOut := BeginThread(nil, 0, @netscan, p, 0, ThreadID);
        end;
end;

procedure TForm1.btnDisconnectClick(Sender: TObject);
var ExitCode: DWORD;
begin
    InterlockedExchange(inLoop, 1);
    TerminateThread(Tout,ExitCode);
    tcpClient.Disconnect;
end;

procedure TForm1.btnSendClick(Sender: TObject);
var
        Data:TNetConfig;
begin
        if pos('/',edtSend.Text) = 1 then
                Data.data := true
        else
                Data.data := false;
                
        Data.CMD := edtSend.Text;
        Data.SIP := tcpClient.Socket.Binding.IP;
        Data.DIP := tcpClient.Host;

        tcpClient.WriteBuffer(Data,sizeof(Data));

end;

end.

Server:

Delphi-Quellcode:

unit UMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, IdThreadMgr, IdThreadMgrDefault, IdBaseComponent, IdComponent,
  IdTCPServer, StdCtrls;

  // ---- INTERN CLIENT RECORDS ------
type
  TSimpleClient = class(TObject)
    IP,
    Name        : String;
    ID    : Integer;
    Thread      : Pointer;
  end;
  // ---------------------------------

  // ------- NETWORK PROTOKOL --------
  // v001
  type
        TNetConfig = record
                data : boolean;
                CMD  : string[20];
                SIP  : string[16];
                DIP  : string[16];
                end;

  // ---------------------------------

type
  TMain = class(TForm)
    tcpServer: TIdTCPServer;
    IdThreadMgrDefault1: TIdThreadMgrDefault;
    btnStart: TButton;
    Memo1: TMemo;
    lbClients: TListBox;
    lblClientName: TLabel;
    lblClientDNS: TLabel;
    lblClientID: TLabel;
    edtSend: TEdit;
    Button1: TButton;
    Edit1: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure tcpServerConnect(AThread: TIdPeerThread);
    procedure btnStartClick(Sender: TObject);
    procedure tcpServerExecute(AThread: TIdPeerThread);
    procedure tcpServerDisconnect(AThread: TIdPeerThread);
    procedure lbClientsClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    Clients  : TList;
  end;

var
  Main: TMain;

implementation

{$R *.DFM}

procedure TMain.FormCreate(Sender: TObject);
begin
        Clients := TList.Create;
end;

procedure TMain.tcpServerConnect(AThread: TIdPeerThread);
var
  Client : TSimpleClient;
  Data : TNetConfig;
begin
        Memo1.Lines.Add('User connected');
        // Welcome MSG
        Data.data := false;
        Data.CMD := 'Welcome to Server';
        Data.SIP := AThread.Connection.Socket.Binding.IP;
        Data.DIP := AThread.Connection.Socket.Binding.PeerIP;

        AThread.Connection.WriteBuffer(Data,sizeof(Data));
        
        // Create a client object
        Client := TSimpleClient.Create;

        // Assign its default values
        Client.IP  := Athread.Connection.Socket.Binding.PeerIP;
        Client.Name := 'Logging In';
        Client.ID := lbClients.Items.Count;
        Client.Thread := AThread;

        lbClients.Items.Add(Client.IP);

        AThread.Data := Client;

        Clients.Add(Client);
end;

procedure TMain.btnStartClick(Sender: TObject);
begin
        tcpServer.DefaultPort := 10024;
        tcpServer.Active := true;
        memo1.Lines.add('Server start');
end;

procedure TMain.tcpServerExecute(AThread: TIdPeerThread);
var
        Data : TNetConfig;
begin
        AThread.Connection.ReadBuffer(Data,sizeof(Data));

        if Data.data = false then
                Memo1.Lines.add('From:'+Data.SIP+' To:'+Data.DIP+' STR:'+Data.CMD)
        else
                Memo1.Lines.add('From:'+Data.SIP+' To:'+Data.DIP+' CMD:'+Data.CMD)

end;

procedure TMain.tcpServerDisconnect(AThread: TIdPeerThread);
var
  Client : TSimpleClient;
begin
  {
  Client := Pointer(AThread.Data);

  memo1.Lines.Add('User ['+ Client.ip +'] disconnected');

  Clients.Delete(Client.ID);

  lbClients.Items.Delete(lbClients.Items.IndexOf(Client.IP));

  Client.Free;
  AThread.Data := nil;
  }
end;

procedure TMain.lbClientsClick(Sender: TObject);
var
  Client : TSimpleClient;
begin
  if lbClients.ItemIndex = -1 then
    exit;

  Client := Clients.Items[lbClients.ItemIndex];
  lblClientName.Caption := Client.Name;
  lblClientDNS.Caption  := Client.IP;
  lblClientID.Caption  := inttostr(Client.ID);

end;

procedure TMain.Button1Click(Sender: TObject);
var
  Client : TSimpleClient;
  Data : TNetConfig;
begin
         if (lbClients.ItemIndex <> -1) then
    begin
      Client := Clients.Items[lbClients.ItemIndex];

        if pos('/',edtSend.Text) = 1 then
                Data.data := true
        else
                Data.data := false;
                
        Data.CMD := edtSend.Text;
        Data.SIP := TIdPeerThread(Client.Thread).Connection.Socket.Binding.IP;
        Data.DIP := TIdPeerThread(Client.Thread).Connection.Socket.Binding.PeerIP;

      TIdPeerThread(Client.Thread).Connection.WriteBuffer(Data,sizeof(Data));

    end;
        
end;

end.

Hilfts ?

PS: Hab den code noch nicht ganz fertig (sind noch sachen da di raussollen ex: inloop var!)

BTW: Hab noch nem problem mit dem OnDisconnect im Server ... er findet den zu löschende user nicht ! Woran kann das liegen ?