Konsolen TCP + Socketserver

[Astat]

Zitat von RedShakal:

..wollte gerade meinem Konsolen TCP Server noch einen SocketChat hinzufügen. Der Server wird initialisiert, jedoch werden die Ereignisse nicht aufgerufen.

Hallo RedShakal, die Ereignisse werden nicht aufgerufen, weil Du kein Dispatch durchführst.

Delphi-Quellcode:

    repeat
      if PeekMessage(MsgRec, 0, 0, 0, PM_REMOVE) then
        DispatchMessage(MsgRec) else WaitMessage;
    until (MsgRec.Message = WM_QUIT) or (MsgRec.Message = WM_CLOSE);

Zitat von RedShakal:

Ich wollte euch Fragen ob ihr mal über meinen Source schauen könnt wo der Fehler liegen könnte. Der TCP Server funktioniert im übrigen.

Du synchronisierst Dateizugriffe und INI-File Read und Write im INDY Thread nicht, da ja mehrere Clients gleichzeitig zugreifen können, knallts da irgendwann. Also Thread synchronisieren. Auch haben Sleeps in so einer Anwendung nichts zu suchen.

Zitat von RedShakal:

Ich vermute der Fehler liegt darin, das ich 2 Server nacheinander erstelle und irgentwie die Ereignisse durch das While True do Sleep(50); nicht aufrufe. Der TCP Server funktioniert Standalone im übrigen Prima.

Solange du kein Binding und oder den gleichen Port verwendest, ist dies egal.

Beispiel wie man das in einer Konsole implementieren kann:

Delphi-Quellcode:

program ConsoleServer;

{$APPTYPE CONSOLE}

uses
  Windows,
  Messages,
  SysUtils,
  Winsock,
  ScktComp;

type
  TNotifyEvent = procedure(sender : TObject) of object;

type
  TChatServer = class
  private
    FServer: TServerSocket;
    procedure ServerSocketClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocketClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure ServerSocketClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
  public
    constructor create;
    destructor destroy; override;
end;

var
  ChatServer: TChatServer;
  MsgRec : TMsg;

procedure TChatServer.ServerSocketClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  writeln(
    'Ein Client hat sich mit folgendem eindeutigen Socket verbunden. Socket: ' +
      inttostr(Socket.SocketHandle)
      );
end;

procedure TChatServer.ServerSocketClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  writeln(
    'Ein Client hat sich mit folgendem eindeutigen Socket abgemeldet. Socket: '+
      inttostr(Socket.SocketHandle)
      );
end;

procedure TChatServer.ServerSocketClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  writeln(
    'Ein Clientverbindung mit folgendem eindeutigen Socket: ' +
      inttostr(Socket.SocketHandle) +
        ' hat einen Fehler verursacht, der socket Fehlercode:' +
          inttostr(ErrorCode)
      );
end;

procedure TChatServer.ServerSocketClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
var
  cbRcv: integer;
  RcvBuf: array [0..32767] of Byte;
  s: string;
begin
  cbRcv := Socket.ReceiveBuf(RcvBuf[0], Length(RcvBuf));
  if (cbRcv > 0) and (Socket.SocketHandle > 0) then begin
    SetLength(s, cbRcv);
    move(RcvBuf[0], s[1], cbRcv);
    writeln('Für Client mit folgendem eindeutigen Socket: ' +
      inttostr(Socket.SocketHandle) + ' wurden ' + IntToStr(cbRcv) + ' Bytes ' +
        'mit folgenden Daten [ ' + s + ' ] empfangen'
        );
  end;
end;

constructor TChatServer.create;
begin
  Self.FServer := TServerSocket.create(nil);
  with Self.FServer, Self do begin
    ServerType := stNonBlocking;
    Port := 8088;
    OnClientConnect := ServerSocketClientConnect;
    OnClientDisconnect := ServerSocketClientDisconnect;
    OnClientError := ServerSocketClientError;
    OnClientRead := ServerSocketClientRead;
    Active := true;
  end;
end;

destructor TChatServer.destroy;
var
  i: integer;
begin
  for i := 0 to Self.FServer.Socket.ActiveConnections - 1 do begin
    shutdown(Self.FServer.Socket.Connections[i].SocketHandle, SD_BOTH);
    Self.FServer.Socket.Connections[i].Close;
  end;
  inherited;
end;

begin
  ChatServer := TChatServer.Create;
  try
    repeat
      if PeekMessage(MsgRec, 0, 0, 0, PM_REMOVE) then
        DispatchMessage(MsgRec) else WaitMessage;
    until (MsgRec.Message = WM_QUIT) or (MsgRec.Message = WM_CLOSE);
  finally
    ChatServer.Free;
    ChatServer := nil;
  end;
end.

lg. Astat