[Indy] Programm hängt sich bei ReadBuffer auf

[Die Muhkuh]

Hi,

@heins

ne, geht auch nicht.

@Binärbaum

ich weiß, dass der Intervall in Millisek. ist


Ich poste grad ma den gesamten Code (ein hoch auf das Code-Folding ):

Client:

Delphi-Quellcode:

unit umain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, ExtCtrls, uutil, ComCtrls, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient;

type
  Tfmain = class(TForm)
    edUser: TLabeledEdit;
    sePort: TSpinEdit;
    Label1: TLabel;
    btnConnect: TButton;
    Bevel1: TBevel;
    reChat: TRichEdit;
    btnSend: TButton;
    edChat: TEdit;
    Client: TIdTCPClient;
    edHost: TLabeledEdit;
    Timer: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure btnConnectClick(Sender: TObject);
    procedure btnSendClick(Sender: TObject);
    procedure TimerTimer(Sender: TObject);
  private
    { Private-Deklarationen }
    Username: String;
  public
    { Public-Deklarationen }
  end;

var
  fmain: Tfmain;

implementation

{$R *.dfm}

procedure Tfmain.FormCreate(Sender: TObject);
begin
  sePort.Value := STANDARD_PORT;
end;

procedure Tfmain.btnConnectClick(Sender: TObject);
begin
  if btnConnect.Caption = 'Connect' then
  begin
  Username := edUser.Text;

  if Trim(Username) = '' then
  begin
    ShowMessage('Bitte Username angeben!');
    Exit;
  end;

  if Trim(edHost.Text) = '' then
  begin
    ShowMessage('Bitte Host angeben!');
    Exit;
  end;

  Client.Host := edHost.Text;
  Client.Port := sePort.Value;

  try
    Client.Connect();
  except
    ShowMessage('Sorry, Server nicht erreichbar!');
  end;

  if Client.Connected then
  begin
    edUser.Enabled := false;
    sePort.Enabled := false;
    edHost.Enabled := false;

    btnSend.Enabled := true;

    btnConnect.Caption := 'Disconnect';
  end;
  end
  else
  begin
    Client.Disconnect;

    edUser.Enabled := true;
    sePort.Enabled := true;
    edHost.Enabled := true;

    btnSend.Enabled := false;

    btnConnect.Caption := 'Connect';
  end;
end;

procedure Tfmain.btnSendClick(Sender: TObject);
var
  Msg: TMessageRecord;
begin
  Msg.From := PChar(UserName);
  Msg.Msg := PChar(edChat.Text);
  Msg.SysCommand := false;

  Client.WriteBuffer(Msg, SizeOf(TMessageRecord));
end;

procedure Tfmain.TimerTimer(Sender: TObject);
var
  Msg: TMessageRecord;
begin
  if Client.Connected then
  begin
    Client.ReadBuffer(Msg, SizeOf(Msg));

    if Trim(Msg.Msg) <> '' then
    begin
      reChat.Lines.Add(Msg.From + ': ' + Msg.Msg);
    end;      
  end;
end;

end.

Server:

Delphi-Quellcode:

unit umain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, uutil, IdBaseComponent, IdComponent, IdTCPServer, JvExControls,
  JvComponent, JvLED, StdCtrls, ExtCtrls, IdThreadMgr, IdThreadMgrDefault;

type
  Tfmain = class(TForm)
    Server: TIdTCPServer;
    btnServer: TButton;
    led: TJvLED;
    Thread: TIdThreadMgrDefault;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ServerConnect(AThread: TIdPeerThread);
    procedure btnServerClick(Sender: TObject);
    procedure ServerExecute(AThread: TIdPeerThread);
  private
    { Private-Deklarationen }
    Clients: TClients;
  public
    { Public-Deklarationen }
  end;

var
  fmain: Tfmain;

implementation

{$R *.dfm}

procedure Tfmain.FormCreate(Sender: TObject);
begin
  Clients := TClients.Create;
  Server.DefaultPort := STANDARD_PORT;
end;

procedure Tfmain.FormDestroy(Sender: TObject);
begin
  FreeAndNil(Clients);
end;

procedure Tfmain.ServerConnect(AThread: TIdPeerThread);
begin
  Clients.Add(aThread);
end;

procedure Tfmain.btnServerClick(Sender: TObject);
begin
  if btnServer.Caption = 'Start Server' then
  begin
    Server.Active := true;
    btnServer.Caption := 'Stopp Server';
    led.Status := true;
  end
  else
  begin
    Server.Active := false;
    btnServer.Caption := 'Start Server';
    led.Status := false;
  end;
end;

procedure Tfmain.ServerExecute(AThread: TIdPeerThread);
var
  Msg: TMessageRecord;
begin
  AThread.Connection.ReadBuffer(Msg, SizeOf(Msg));

  Clients.Broadcast(Msg);
end;

end.

uutil:

Delphi-Quellcode:

unit uutil;

interface

uses
  IdTCPServer;

const
  MAX_CLIENTS = 32;
  STANDARD_PORT = 5523;

type
  TMessageRecord = record
    From: ShortString;
    Msg: ShortString;
    Color: Integer;
    SysCommand: Boolean;
  end;

  TClients = class(TObject)
  private
    ArrCount: Byte;
    ClArray: array[1..MAX_CLIENTS] of TIdPeerThread;
    function GetClient(id: integer): TIdPeerThread;
  public
    constructor Create;
    procedure Add(Thread: TIdPeerThread);
    procedure Delete(id: integer);
    procedure Broadcast(MessageRecord: TMessageRecord);
    function IndexOf(Thread: TIdPeerThread): integer;
    property Count: Byte read ArrCount;
    property Clients[id: integer]: TIdPeerThread read GetClient; default;
  end;

implementation

constructor TClients.Create;
var
  i: Byte;
begin
  inherited Create;
  ArrCount := 0;
  for i := 1 to MAX_CLIENTS do
    ClArray[i] := nil;
end;

function TClients.GetClient(id: integer): TIdPeerThread;
begin
  Result := nil;
  if (id < 1) or (id > MAX_CLIENTS) then
    exit;
  Result := ClArray[id];
end;

procedure TClients.Add(Thread: TIdPeerThread);
var
  i: Byte;
begin
  for i := 1 to MAX_CLIENTS do
  begin
    if ClArray[i] = nil then
    begin
      ClArray[i] := Thread;
      inc(ArrCount);
      exit;
    end;
  end;
end;

procedure TClients.Delete(id: integer);
var
  i: Byte;
begin
  if (id < 1) or (id > MAX_CLIENTS) or (ClArray[id] = nil) then
    exit;

  ClArray[id] := nil;
  dec(ArrCount);

  for i := id to MAX_CLIENTS do
  begin
    if ClArray[i] <> nil then
      ClArray[i - 1] := ClArray[i];
  end;
end;

procedure TClients.Broadcast(MessageRecord: TMessageRecord);
var
  i: Byte;
begin
  for i := 1 to MAX_CLIENTS do
  begin
    try
      if ClArray[i] <> nil then
        ClArray[i].Connection.WriteBuffer(MessageRecord, SizeOf(MessageRecord),
          True);
    except
    end;
  end;
end;

function TClients.IndexOf(Thread: TIdPeerThread): integer;
var
  i: Byte;
begin
  Result := 0;
  if (Thread = nil) then
    exit;
  for i := 1 to MAX_CLIENTS do
  begin
    if ClArray[i] = Thread then
    begin
      Result := i;
      break;
    end;
  end;
end;

end.

[edit] Server mit dem Server-Code ersetzt [/edit]