Konsolen TCP + Socketserver

[RedShakal]

Hallo, ich wollte gerade meinem Konsolen TCP Server noch einen SocketChat hinzufügen. Der Server wird initialisiert, jedoch werden die Ereignisse nicht aufgerufen. 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.

Delphi-Quellcode:

program Project1;

{$APPTYPE CONSOLE}

uses
 SysUtils, IdTCPServer, IdContext, IdBaseComponent, IdComponent, IniFiles, Classes, ScktComp;
type
 TServer = class(TObject)
   IdTCPServer1: TIdTCPServer;
   procedure IdTCPServer1Execute(AThread: TIdContext);
   procedure IdTCPServer1Connect(AThread: TIdContext);
 private
   { Private declarations }
   constructor Create;
 public
   { Public declarations }
 end;

 TChatServer = class(TObject)
    Chat: TServerSocket;
    Port: Word;
    constructor Create;
    procedure OnClientRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnClientConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure OnClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
  end;

 Const
   Serverver = '0.03';

type
  TDynStringArray = Array of string;

var
  sl        : TStringList;
  Zeile     : string;
  Clientver : string;
  i         : Integer;

function Explode(const Separator, S :String; Limit :Integer = 0): TDynStringArray;
  var
    SepLen: Integer;
    F, P: PChar;
begin
  SetLength(Result, 0);
  if (S = '') or (Limit < 0) then
    Exit;
  if Separator = '' then
    begin
      SetLength(Result, 1);
      Result[0] := S;
      Exit;
    end;
  SepLen := Length(Separator);

  P := PChar(S);
  while P^ <> #0 do
    begin
      F := P;
      P := AnsiStrPos(P, PChar(Separator));
      if (P = nil) or ((Limit > 0) and (Length(Result) = Limit - 1)) then
        P := StrEnd(F);
      SetLength(Result, Length(Result) + 1);
      SetString(Result[High(Result)], F, P - F);
      F := P;
      if P = Separator then
        SetLength(Result, Length(Result) + 1);
      while (P^ <> #0) and (P - F < SepLen) do
        Inc(P);
    end;
end;


// ---------------------------- Chatserver ---------------------------- \\


procedure TChatServer.OnClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  writeln(Socket.RemoteAddress+' hat sich im Chatserver eingeloggt.');
end;

procedure TChatServer.OnClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
  MSG : String;
begin
  MSG := Socket.RemoteAddress+' : '+Socket.ReceiveText;
  writeln(MSG);
  for i := 0 to Chat.Socket.ActiveConnections-1 do
    Chat.Socket.Connections[i].SendText(MSG);
end;

procedure TChatServer.OnClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  writeln(Socket.RemoteAddress+' hat sich vom Chatserver ausgeloggt.');
end;

// ---------------------------- Loginserver ---------------------------- \\

procedure TServer.IdTCPServer1Execute(AThread: TIdContext);
var
  Data         : String;
  StrArr       : TDynStringArray;
  ini          : TIniFile;
   f           : TextFile;
   Files       : string;
   y,m,d       : Word;
   Admin       : Integer;
begin
with AThread.Connection do
   begin
     DecodeDate(Now,d,m,y);
     Files := Format('log\%.2d-%.2d-%.2d.txt',[y,m,d]);

     //AssignFile(f, Files);

     //if FileExists(Files) then Append(f) else Rewrite(f);

     Data := String(Socket.ReadLn);
     Data := Trim(Data);

     if Length(Data) > 0 then
       begin
         StrArr := Explode('|', Data);
         if StrArr[0] = 'login' then
           begin
             AssignFile(f,'version.txt');
             Reset(f);
             If IoResult=0 then
               begin
                ReadLn(f, Clientver);
                CloseFile(f);
               end;
               if StrArr[3] = Clientver then
                 begin
                   if FileExists('accounts\'+StrArr[1]+'.ini') then
                     begin
                       ini := TIniFile.Create('accounts\'+StrArr[1]+'.ini');
                       try
                         if StrArr[2] = ini.ReadString('Login','Passwort','') then
                           begin
                             Admin := ini.ReadInteger('Admin','Level',0);
                             if Admin = 0 then
                               begin
                                 Socket.WriteLn('login');
                                 WriteLn('['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' hat sich eingeloggt.');
                                //WriteLn(f, '['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' hat sich eingeloggt.');
                               end;
                             if Admin = 1 then
                               begin
                                 Socket.WriteLn('login|admin');
                                 WriteLn('['+TimeToStr(Time)+']'+' Admin: '+StrArr[1]+' hat sich eingeloggt.');
                                //WriteLn(f, '['+TimeToStr(Time)+']'+' Admin: '+StrArr[1]+' hat sich eingeloggt.');
                               end;
                           end
                         else
                           begin
                             Socket.WriteLn('invalid');
                             WriteLn('['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' falsches Passwort.');
                             //WriteLn(f, '['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' falsches Passwort.');
                           end;
                       finally
                         ini.free;
                       end;
                     end
                   else
                     begin
                       Socket.WriteLn('na');
                       WriteLn('['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' existiert nicht.');
                       //WriteLn(f, '['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' existiert nicht.');
                     end;
                 end
                   else
                     begin
                       Socket.WriteLn('version');
                     end;
           end;

         if StrArr[0] = 'register' then
           begin
             if FileExists('accounts\'+StrArr[1]+'.ini') then
               begin
                 Socket.WriteLn('vorhanden');
                 WriteLn('['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' existiert bereits.');
                 //WriteLn(f, '['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' existiert bereits.');
               end
             else
               begin
                 try
                   ini := TIniFile.Create('accounts\'+StrArr[1]+'.ini');
                   ini.WriteString('Login','Passwort',StrArr[2]);
                   ini.WriteString('Login','E-Mail',StrArr[3]);
                   ini.WriteString('Data','Geschlecht',StrArr[4]);
                   ini.WriteString('Data','Geburtstag',StrArr[5]);
                   ini.WriteString('Data','ICQ',StrArr[6]);
                   ini.WriteString('Data','Name',StrArr[7]);
                   ini.WriteInteger('Stats','gespielt',0);
                   ini.WriteInteger('Stats','gewonnen',0);
                   ini.WriteInteger('Stats','verloren',0);
                   ini.WriteString('Stats','Spielzeit','00:00:00');
                   ini.WriteInteger('Admin','Level',0);
                   ini.WriteInteger('Admin','PermBan',0);
                   ini.WriteString('Admin','TempBan','1.1.2009');
                   ini.WriteString('Admin','Grund','');
                   ini.WriteString('Info','MAC','');
                 finally
                   Socket.WriteLn('erfolg');
                   ini.free;
                   WriteLn('['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' wurde registriert.');
                   //WriteLn(f, '['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' wurde registriert.');
                 end;
               end;
           end;
         if StrArr[0] = 'changepw' then
           begin
             if FileExists('accounts\'+StrArr[1]+'.ini') then
               begin
                 ini := TIniFile.Create('accounts\'+StrArr[1]+'.ini');
                   if StrArr[2] = ini.ReadString('Login','Passwort','') then
                     begin
                       ini.WriteString('Login','Passwort',StrArr[3]);
                       Socket.WriteLn('pwchange');
                       WriteLn('['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' hat sein Passwort geaendert.');
                     //WriteLn(f, '['+TimeToStr(Time)+']'+' Account: '+StrArr[1]+' hat sein Passwort geaendert.');
                     end
                  else Socket.WriteLn('pwfalsch');
               end;
           end;
         if StrArr[0] = 'AdminInfo' then
           begin
             if FileExists('accounts\'+StrArr[1]+'.ini') then
               begin
                 ini := TIniFile.Create('accounts\'+StrArr[1]+'.ini');
                 try
                   Admin := ini.ReadInteger('Admin','Level',0);
                   if (StrArr[2] = ini.ReadString('Login','Passwort','')) and (Admin = 1) then
                     begin
                       if FileExists('accounts\'+StrArr[3]+'.ini') then
                         begin
                           ini.Free;
                           ini := TIniFile.Create('accounts\'+StrArr[3]+'.ini');
                           Socket.WriteLn('AdminInfo'+'|'+ini.ReadString('Login','E-Mail','')+'|'+ini.ReadString('Data','Geschlecht','')+'|'+ini.ReadString('Data','Geburtstag','')+'|'+ini.ReadString('Data','ICQ','')+'|'+ini.ReadString('Data','Name','')+'|'+InttoStr(ini.ReadInteger('Stats','gespielt',0))+'|'+InttoStr(ini.ReadInteger('Stats','gewonnen',0))+'|'+InttoStr(ini.ReadInteger('Stats','verloren',0))+'|'+ini.ReadString('Stats','Spielzeit','')+'|'+InttoStr(ini.ReadInteger('Admin','Level',0))+'|'+InttoStr(ini.ReadInteger('Admin','PermBan',0))+'|'+ini.ReadString('Admin','TempBan','')+'|'+ini.ReadString('Admin','Grund',''));
                           WriteLn('['+TimeToStr(Time)+']'+' Admin: '+StrArr[1]+' hat Informationen über '+StrArr[3]+' angefordert.');
                           //WriteLn(f, '['+TimeToStr(Time)+']'+' Admin: '+StrArr[1]+' hat Informationen über '+StrArr[3]+' angefordert.');
                         end;
                     end
                   else Socket.WriteLn('AdminInfoNA');
                 finally
                   ini.free;
                 end;
               end;
           end;
       end;
   end;
    //CloseFile(f);
end;


procedure TServer.IdTCPServer1Connect(AThread: TIdContext);
begin
  //
end;

constructor TServer.Create;
begin
  inherited Create;
  WriteLn('#######################');
  WriteLn('##                   ##');
  WriteLn('## Masterserver '+Serverver+' ##');
  WriteLn('##                   ##');
  WriteLn('#######################');
  WriteLn('');
  IdTCPServer1 := TIdTCPServer.Create(nil);
  WriteLn('Server wurde initialisiert.');
  IdTCPServer1.DefaultPort := 5000;
  WriteLn('Server lauscht auf Port: '+InttoStr(IdTCPServer1.DefaultPort));
  WriteLn('');
  IdTCPServer1.TerminateWaitTime := 5000;
  IdTCPServer1.OnConnect := IdTCPServer1Connect;
  IdTCPServer1.OnExecute := IdTCPServer1Execute;
end;

constructor TChatServer.Create;
begin
  inherited Create;
  Chat := TServerSocket.Create(nil);
  WriteLn('Chatserver wurde initialisiert.');
  Chat.Port := 5002;
  WriteLn('Chatserver lauscht auf Port: '+InttoStr(Chat.Port));
  Chat.OnClientConnect    := OnClientConnect;
  Chat.OnClientDisconnect := OnClientDisconnect;
  Chat.OnClientRead       := OnClientRead;
end;


var
  Server     : TServer;
  ChatServer : TChatServer;
begin
  Server := TServer.Create;
  Server.IdTCPServer1.Active := True;
  ChatServer := TChatServer.Create;
  ChatServer.Chat.Active := True;
  While True do Sleep(50);
end.

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.

Ich hoffe ihr könnt mir helfen. Vielleicht findet der ein oder andere sogar noch etwas, was man verbessern könnte

[Die Muhkuh]

Es soll Leute geben, die machen einen Umbruch in ihren Quellcode, damit man es besser lesen kann...

[sirius]

Die Indys funktionieren IMHO nur bei VCL-Anwendungen, da sie intern TThread benutzen und dieses wiederum das globale TApplication-Objekt benötigt. Letzteres gibt es nur bei VCL-Anwendungen.


Edit: War das überhaupt bei Indys das Problem, oder bei den Socketkomponenten von Delphi... hmmm. Vielleicht habe ich mich auch geirrt

Edit 2: Doch, ich hatte das hier schonmal rausgefunden, dann stimmt es auch so.

[RedShakal]

Indy funktioniert ja. es scheitert erst seit ich versucht habe einen socketchat dazu zuschreiben

[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

[RedShakal]

Jetzt ist genau das passiert was ich vermeiden wollte

Delphi-Quellcode:

#######################
##                   ##
## Masterserver 0.03 ##
##                   ##
#######################

Server wurde initialisiert.
Server lauscht auf Port: 5000

Chatserver wurde initialisiert.
Chatserver lauscht auf Port: 5002
Application tried to create a window, but no driver could be loaded.
Make sure that your X server is running and that $DISPLAY is set correctly.
Application tried to create a window, but no driver could be loaded.
Make sure that your X server is running and that $DISPLAY is set correctly.
[12:58:31 AM] Admin: RedShakal hat sich eingeloggt.

Der TCP Server läuft, der Socks Server ist nicht ansprechbar. Gibt es da keiner alternative Methode?

Die Verbindung zum Chatserver steht, jedoch werden Nachichten nicht weiter gesendet. Unter Windows klappts im übrigen.

[Astat]

Zitat von RedShakal:

Jetzt ist genau das passiert was ich vermeiden wollte..
Application tried to create a window, but no driver could be loaded.

Naja, ich vermute mal du verwendes WINE oder?

[RedShakal]

Ja, der Masterserver läuft auf einem kleinem VServer. Ich weiß leider nicht wie man den Quellcode auf Linux basis umschreibt.

[Astat]

Zitat von RedShakal:

Ja, der Masterserver läuft auf einem kleinem VServer. Ich weiß leider nicht wie man den Quellcode auf Linux basis umschreibt.

Ok, die einfachte Möglichkeit ist LNet unter FPC mit Lazarus.

http://wiki.lazarus.freepascal.org/lNet#Installation
http://lnet.wordpress.com/

Für FPC 2.3.1 alias 2.4.1 waren einige Änderungen in den LNet-Componenten notwendig, beigefügt die aktualisierten Componenten.

Unter Sample unter ..\lnet\examples\visual\tcpudp findest Du genau das was Du brauchst.

Eine FPC und Lazarus Installation findest Du unter:

http://michael-ep3.physik.uni-halle.de/Lazarus/

"Lazarus + fpc 2.3.1" verwenden, fpc 2.3.1 ist gleich mit der offiziellen fpc 2.4.1


Möchtest Du FPC nicht verwenden, musst Du alles auf Blockierend, dh. "berkeley" kompatibler Socket-API umstellen.

Unter Suse hab ich mal ein "Virtual Framebuffer X server" package verwendet, bin aber nicht recht glücklich damit geworden.
Ist aber schon ne Weile her, und da tut sich laufend was.
Du kannst ja mal beim SUSE Team nachfragen.

lg. Astat

[RedShakal]

Also ich hab mir jetzt mittels apt-get install fpc und apt-get install lazarus die aktuellsten versionen geholt. Leider bin ich daran gescheitert das ich nicht rausgefunden habe, wie man Indy installiert.