[Indy] Programm hängt sich bei ReadBuffer auf

[Die Muhkuh]

Hi,

bin ma wieder an nem Chat dran (ich weiß, es gibt viele^^).

Mein Source(client):

Delphi-Quellcode:

procedure Tfmain.TimerTimer(Sender: TObject);
var
  Msg: TMessageRecord;
begin
  if Client.Connected then
  begin
    Client.ReadBuffer(Msg, SizeOf(Msg));  // << Da gehts nimmer weiter

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

Intervall vom Timer ist 1.

Source(server):

Delphi-Quellcode:

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

  Clients.Broadcast(Msg);
end;

TMessageRecord:

Delphi-Quellcode:

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

Procedure Broadcast:

Delphi-Quellcode:

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;

(TClients ist von jfheins)


Warum geht das an der markierten Stelle nicht mehr weiter? Da bleibt der einfach stehen.

(Verwende Indy9)

[jfheins]

Zitat von Spider:

Delphi-Quellcode:

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

Hmmm ... verwende mal statt dem WideString einen Shortstring, vielleicht gehts dann ...

[Binärbaum]

Hab' ich das richtig gelesen, dass ser Intervall vom Timer auf 1 gesetzt ist?
Das würde ja bedeuten, dass aller 1 Millisekunde der Code ausgeführt wird. Sollte das wirklich so sein, oder sollte der OnTimer nur jede Sekunde ausgelöst werden? Dann müsste man den Intervall auf 1000 setzen, da der Intervall in Millisekunden angegeben wird.

MfG
Binärbaum

[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]