Entwickler-Ecke :: Thema anzeigen - TThread + TServerSocket auf Konsole

chillywilly - Do 06.10.05 11:57
Titel: TThread + TServerSocket auf Konsole

Halli Hallo!
Ich hab da ein kleines aber extrem nerviges Problem mit meiner selbstgeschriebenen Konsolenanwendung. das Problem lautet wie folgt:

Da man ja bei Konsolenanwendungen ein readln (oder eine endlosschleige mit diesen) in das Programm schreiben muss, behindert dieses leider alle anderen Sachen im Programm. dazu gehören natürlich auch TNotifyEvents.

Ich habe in meinem Programm ein TServerSocket eingebaut, der aber nun nicht auf seine NotifyEvents reagieren kann, da diese halt blockiert werden.

Ich habe mich ein wenig schlau gemacht, und habe herausgefunden, das man dieses Problem eigentlich mit TThreads lösen sollte und habe mich auch gleich an die Arbeit gemacht.

Das Problem ist: Auf das OnListen ereignis reagiert der ServerSocket und auf alle anderen nicht. Er reagiert auf die anderen außerdem nicht obwohl ein client sich mit ihm verbinden kann.

schaut euch mal bitte den code an und sagt mir bitte wo der fehler liegen könnte.

ServerThread Unit

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:

unit unitServer;

interface

uses SysUtils, Classes, ScktComp, unitLog;

type TServer = class(TThread)
      FServerSocket: TServerSocket;
      constructor create; virtual;
     private
      procedure procServerOnListen(Sender: TObject;
        Socket: TCustomWinSocket);
      procedure procServerOnGetSocket(Sender: TObject; Socket: Integer;
        var ClientSocket: TServerClientWinSocket);
      procedure procServerOnClientConnect(Sender: TObject;
        Socket: TCustomWinSocket);
     protected
      procedure Execute; override;
     public
     end;

implementation

 procedure TServer.Execute;
 begin
   with FServerSocket do begin
    OnListen        := procServerOnListen;
    OnClientConnect := procServerOnClientConnect;
    OnGetSocket     := procServerOnGetSocket;
    Port            := 1234;
    ServerType      := stNonBlocking;
    ThreadCacheSize := 10;
    Open;
   end;
 end;

 constructor TServer.create;
 begin
   inherited create(false);
   freeOnTerminate := false;
   FServerSocket := TServerSocket.create(FServerSocket);
 end;

 procedure TServer.procServerOnListen(Sender: TObject;
   Socket: TCustomWinSocket);
 begin
  writeln('* onlisten: port['+inttostr(FServerSocket.Port)+']');
 end;

 procedure TServer.procServerOnGetSocket(Sender: TObject; Socket: Integer;
   var ClientSocket: TServerClientWinSocket);
 begin
   writeln('* ongetsocket: port['+inttostr(socket)+']');
 end;

 procedure TServer.procServerOnClientConnect(Sender: TObject;
   Socket: TCustomWinSocket);
 begin   
  writeln('* onconnect');
 end;

end.

Programunit

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:

program mice;

{$APPTYPE CONSOLE}

uses SysUtils, classes, unitLog, unitSettings, unitServer, ScktComp;

type TMain = class(TThread)
     private
     protected
      procedure Execute; override;
     public
      constructor create; virtual;
      procedure procLogAdd(econtent: string; etype: char);
      procedure procParseSettings;
      procedure procParseCmd(strCmd: string);
     end;

var main           : TMain;
    logfile        : TLog;
    setSettingsfile: TSettings;
    srvServer      : TServer;

procedure TMain.Execute;
begin
  writeln('mice');
  procParseSettings;
  procLogAdd('server started','s');
end;

constructor TMain.create;
begin
  inherited create(true);
  freeOnTerminate := false;
end;

procedure TMain.procParseSettings;
begin
 setSettingsfile := TSettings.create('settings.cfg');
 writeln;
end;

procedure TMain.procLogAdd(econtent: string; etype:char);
begin
 logfile := TLog.create('log');
 logfile.procAddline(econtent,etype);
 logfile.free;
end;           

procedure TMain.procParseCmd(strCmd: string);
begin
 if strCmd = 'status' then

  if srvServer.FServerSocket.Active = true then begin
   writeln('* server is active');
  end else writeln('* server is not active')
  else if strCmd = 'exit' then
   procLogAdd('server is shutting down...','s')
   
  else writeln('X unknown command');
end;

var strCmdLn: string;
begin
 main := TMain.create;
 main.Priority := tpNormal;
 main.Resume;

 srvServer := TServer.create;
 srvServer.Priority := tpNormal;
 srvServer.resume;

 while strCmdLn <> 'exit' do begin
  readln(strCmdLn);
  main.procLogAdd('/rcon '+strCmdLn,'c');
  main.procParseCmd(strCmdLn);
 end;

 srvServer.Terminate;
 main.Terminate;
end.

Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2026 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!