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
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
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. |
Narses
TSERVERSOCKET CONSOLE