Einzelnen Beitrag anzeigen

chillywilly

Registriert seit: 1. Okt 2005
11 Beiträge
 
#6

Re: delphi konsolen tcp server

  Alt 4. Okt 2005, 19:00
Hiho Leute!
Ich hab mein Prog nun mit Threads gemacht und dachte eigentlich das es nun funktionieren würde.
Mir wurde gesagt es würde an dem readln liegen, da dies alles andere blockieren würde.
nun mit threads is das aber genau so
+ onlisten geht
+ alle anderen nich
+ connecten kann man

ich würd echt gerne mal wissen wo da der fehler is. bitte helft mir.

main program
Delphi-Quellcode:
// Programm : mice (multi interface chat engine)
// Version : 0.1
// Erstellt am : 03.10.2005
// Erstellt von: Michael Pawlik

// Geändert am : 04.10.2005
// 03.10.2005 - Programm erstellt.

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 := true;
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 = 'statusthen

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

var strCmdLn: string;
begin
 srvServer := TServer.create;
 srvServer.Priority := tpIdle;
 srvServer.resume;

 main := TMain.create;
 main.Priority := tpIdle;
 main.Resume;


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

 srvServer.Terminate;
 main.Terminate;
end.
server thread unit
Delphi-Quellcode:
// Unit Name : unitServer
// Version : 0.1
// Erstellt am : 04.10.2005
// Erstellt von: Michael Pawlik

// Geändert am : 04.10.2005
// Protokoll:
// 04.10.2005 - Unit erstellt.


unit unitServer;

interface

uses SysUtils, Classes, ScktComp, unitLog;

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

implementation

 procedure TServer.Execute;
 begin
 FServerSocket := TServerSocket.create(nil);
  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(true);
   freeOnTerminate := true;
 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('* ongconnect');
  socket.SendText('sdfsdf');
 end;

end.
  Mit Zitat antworten Zitat