delphi konsolen tcp server

[chillywilly]

Hiho!
Hab nen Problem bei meinem Versuch nen Konsolenprogramm zu schreiben, welches als Chatserver dienen soll. Also verbindung herstellen geht wunderbar. nur würde ich gerne wissen wie der server daten zum client senden kann und wie ich auf ereignisse vom TServerSocket reagieren kann. (also zum beispiel OnGetSocket oder so)

wäre cool wenn ihr mir helfen könntet.

project

Delphi-Quellcode:

program mice_server;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  mice_main in 'mice_main.pas';

var strTemp: string;
begin
 mice_main.MainApp.procMain;
 
 repeat
  write('# ');
  readln(strTemp);
  mice_main.MainApp.procParseCommandline(strTemp);
 until lowercase(strTemp) = 'exit';
 
end.

unit

Delphi-Quellcode:

unit mice_main;

interface

uses SysUtils,
     ScktComp;

type
 TMainApp = class
  private
  public
      procedure procMain;
      procedure procError(intErrorID: integer);
      procedure procParseCommandline(strRaw: string);
      function  funcRunServer: integer;
  end;

var MainApp     : TMainApp;
    ServerSocket: TServerSocket;

implementation

procedure TMainApp.procError(intErrorID: integer);
var strErrorMessage: string;
begin
 case intErrorID of
 0: strErrorMessage := 'error during server start'
 else
  strErrorMessage := 'unknown error';
 end;
 writeln('! err: ['+inttostr(intErrorID)+'] '+strErrorMessage);
end;

procedure TMainApp.procMain;
var intErr: integer;
begin
 TMainApp.Create;
 writeln('> run mice');
 intErr := funcRunServer;

 if intErr <> 0 then procError(intErr)
 else writeln('> socket opened');
end;

function TMainApp.funcRunServer: integer;
begin
 ServerSocket := TServerSocket.Create(nil);
 ServerSocket.Port   := 1234;
 ServerSocket.Open;

 result := 0;
end;

procedure TMainApp.procParseCommandline(strRaw: string);
var strCommand, strResult: string;
begin
 if pos(#32, strRaw)<>0 then
  strCommand := LowerCase(copy(strRaw,0,pos(#32, strRaw)-1))
 else strCommand := LowerCase(copy(strRaw,0,length(strRaw)));

 if strCommand = 'info' then
  strResult := 'multi interface chat engine - (c) 2005 Michael Pawlik'

 else if strCommand = 'send' then
  if ServerSocket.Active then
   ServerSocket.Socket.Connections[0].SendText('test ^^')
  else strResult := 'server is not active'

 else if strCommand = 'status' then
  if ServerSocket.Active then strResult := 'server is active on port '+inttostr(ServerSocket.Port)
  else strResult := 'server is not active'

 else if strCommand = 'open' then
  if not(ServerSocket.Active) then begin
   ServerSocket.Open;
   strResult := 'socket opened'
  end else
   strResult := 'server is already active'

 else if strCommand = 'close' then
  if ServerSocket.Active then begin
   ServerSocket.Close;
   strResult := 'socket closed'
  end else
   strResult := 'server is not active'

 else if strCommand = 'exit' then
  strResult := 'shutting down'
 else strResult := 'unknown command: '+strCommand;
 writeln('> '+strResult);
end;

end.

[alzaimar]

Bei Francois Piette www.overbyte.be gibt es neben hervorragenden Komponenten rund um TCP / Sockets / HTTP etc auch ein Demoprojekt für einen Konsolen-HTTP Server. Da steht alles Drin, was Du wissen musst.

[chillywilly]

wo da genau? ^^

[alzaimar]

ICS runterladen und im Demo-Ordner ('Internet') das Projekt 'ConHttp' laden

Zitat von Francois Piette:

This demo shows how to use THttpCli component within a console mode application. It Connect to www.borland.com and display received (default) document on screen.

[chillywilly]

Hi leute.
Also hab es geschafft, dass beim Ereignis OnListen etwas passiert. bei onclientconnect getsocket und disconnect passiert aber nichts. (der client sagt aber er sei verbunden :/)

help plz

Delphi-Quellcode:

procedure TApplication.procStart;
begin
 ServerSocket                    := TServerSocket.Create(nil);
 ServerSocket.OnListen           := procSocketListen;
 ServerSocket.OnClientConnect    := procSocketClientConnect;
 ServerSocket.OnClientDisconnect := procSocketClientDisconnect;

 ServerSocket.Port := 1234;
 ServerSocket.Open;
end;

[chillywilly]

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 = '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
 srvServer := TServer.create;
 srvServer.Priority := tpIdle;
 srvServer.resume;

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


 while strCmdLn <> 'exit' do 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.

[Zerolith]

Hi,

habe gerade ein ähnliches Problem - bei einem Konsolen-Client. Ich kann mir das nur erklären, dass keine Events weitergeleitet werden.

Ich werde jetzt dann versuchen mit TranslateMessage und DispatchMessage die Nachrichten zu verarbeiten.
Wenn jmd. ne Idee hat wie wir dem SocketServer die Events weiterleiten können möge er es doch bitte schreiben.


bye, Daniel

[Zerolith]

ok - bei mir hat sich das erledigt... hab an einer Stelle ein Synchronize das nicht so ganz will in ner Konsolenanwendung.