program Server; {$mode objfpc}{$H+} uses {$IFDEF UNIX}cthreads,{$ENDIF} Classes, SysUtils, CustApp, ssockets, Sockets; type { TEchoThread } TEchoThread = class(TThread) private FSocket: TSocketStream; lastLine: String; FRemoteAddr: String; public procedure Execute; override; Constructor Create(ASocket: TSocketStream); end; { TEchoServer } TEchoServer = class(TCustomApplication) private FServer: TInetServer; procedure CreateCommunicationThread(Sender: TObject; Data: TSocketStream); protected procedure DoRun; override; public constructor Create(TheOwner: TComponent); override; destructor Destroy; override; end; { TEchoThread } procedure TEchoThread.Execute; var len: SizeInt; ch: Char; begin repeat len := FSocket.Read(ch, 1); FSocket.WriteByte(Ord(ch)); if ch = #13 then begin WriteLn(FRemoteAddr, '> ', lastLine); lastLine:=''; end else lastLine += ch; until len <> 1; WriteLn('Connection Closed: ', FRemoteAddr); end; constructor TEchoThread.Create(ASocket: TSocketStream); begin inherited Create(False); FSocket := ASocket; lastLine:=''; FRemoteAddr:=HostAddrToStr(NetToHost(FSocket.RemoteAddress.sin_addr)); end; { TEchoServer } procedure TEchoServer.CreateCommunicationThread(Sender: TObject; Data: TSocketStream); begin WriteLn('Accepting client: ', HostAddrToStr(NetToHost(Data.RemoteAddress.sin_addr))); TEchoThread.Create(Data).FreeOnTerminate:=True; end; procedure TEchoServer.DoRun; var ErrorMsg: String; begin // quick check parameters ErrorMsg:=CheckOptions('ha:p:', ['help', 'addr', 'port']); if ErrorMsg<>'' then begin ShowException(Exception.Create(ErrorMsg)); Terminate; Exit; end; // parse parameters if HasOption('h', 'help') or not HasOption('p', 'port') then begin WriteLn('Usage: ', ExeName, '[-a address] -p port'); Exit; end; WriteLn('Creating Socket'); if HasOption('a', 'addr') then FServer:=TInetServer.Create(GetOptionValue('a', 'addr'), GetOptionValue('p', 'port').ToInteger) else FServer:=TInetServer.Create(GetOptionValue('p', 'port').ToInteger); FServer.MaxConnections:=-1; FServer.OnConnect:=@CreateCommunicationThread; WriteLn('Binding to ', FServer.Host, ':', FServer.Port); FServer.Bind; Writeln('Start listening'); FServer.Listen; WriteLn('Waiting for clients...'); FServer.StartAccepting; WriteLn('Finished...'); // stop program loop Terminate; end; constructor TEchoServer.Create(TheOwner: TComponent); begin inherited Create(TheOwner); StopOnException:=True; end; destructor TEchoServer.Destroy; begin inherited Destroy; end; var Application: TEchoServer; begin Application:=TEchoServer.Create(nil); Application.Title:='Echo Server'; Application.Run; Application.Free; end.