[fpc-devel] Creating Socket server with indy classes on Linux without any form.

[TOUZEAU DAVID]

Dear

 i Try to create a socket server on 9000 port,

there is no real examples using Indy on linux without using the 
component in a form.

I'm trying to write a tcp socket server on unix by command line ...

Is there anybody already develop a SMTP server or socket server using 
Indy component without using a TForm ??

Best regards

here it is my example that does not working
program indysmtp;
*********************************************************************************************
{$mode objfpc}{$H+}

uses
    cthreads, Classes, smtpserv;


  var SMTPSERVER:TSmtpServ;

begin

SMTPSERVER.Create();
readln();


end.             

The port is open but when sending datas to it, the port will 
automatically disconnect itself

*********************************************************************************************

unit smtpserv;

{$MODE DELPHI}
{$LONGSTRINGS ON}
interface

uses

  SysUtils, Variants, Classes, Dialogs, IdBaseComponent, IdComponent, 
IdCustomTCPServer,IdTCPServer, IdContext, IdIntercept, 
IdServerInterceptLogBase, IdServerInterceptLogFile,IdSync;

type

 TClientinfo = class(TIdContext)

        public

            IP: String;
            cname: String;

            procedure SendResponse(const Clientname: String;const 
AResponse: String);

        end;

           TWriteResponse = class(TIdSync)

        protected

            FMsg: String;

            procedure DoSynchronize; override;

        public

            constructor Create(const AResponse: String);

            class procedure AddResponse(const AResponse: String);

        end;

  TSmtpServ = class

    IdTCPServer1: TIdTCPServer;
    IdServerInterceptLogFile1: TIdServerInterceptLogFile;
    procedure IdTCPServer1Connect(AContext: TIdContext);
    procedure IdTCPServer1Disconnect(AContext: TIdContext);
    procedure IdTCPServer1Execute(AContext: TIdContext);
    constructor Create();
    procedure Free();
  private

    { Private declarations }

  public

    { Public declarations }

  end;

implementation


procedure TSmtpServ.IdTCPServer1Connect(AContext: TIdContext);

begin

with TClientinfo(AContext) do

        begin

            if (Connection.Socket <> nil) then

            IP :=Connection.Socket.Binding.PeerIP;

            cname := Connection.IOHandler.ReadLn;

            if cname <> ''then

            begin

            connection.IOHandler.WriteLn('Welcome '+ cname);

            end

            else

            //Client did not send a name...

            begin

            connection.IOHandler.WriteLn('You did not send a name. 
Please send a name next time you try to connect!');

            connection.Disconnect;

            end;

end;        end;

procedure TSmtpServ.IdTCPServer1Disconnect(AContext: TIdContext);

begin

TWriteResponse.AddResponse(TClientinfo(AContext).cname + 'Disconnected');

end;

procedure TSmtpServ.IdTCPServer1Execute(AContext: TIdContext);

var

thedate,request,cmd,response,AFormat,sentfrom:string;

i,j:integer;

arr:Array[1..6] of String;

begin

//the request from the client is received in the request var

request:=acontext.Connection.IOHandler.ReadLn;

// we need to break the request up into command(cmd) and sender

writeln(request);
//showmessage(cmd+'===>'+sentfrom);

  //Check which command the client sent


 //Send the response to the client...

TClientinfo(AContext).SendResponse(sentfrom,arr[i]);

end;

procedure TClientInfo.SendResponse(const Clientname: String;
const AResponse: String);

    var

        List: TList;

        Context: TClientInfo;

        I: Integer;

    begin

       // FContextList is inherited from TIdContext

        List := FContextList.LockList;

        try

            for I := 0 to List.Count-1 do

            begin

                Context := TClientInfo(List[I]);

                if Context.cname = clientname then

                begin

                    try

        Context.Connection.IOHandler.WriteLn(AResponse);

  except

                    end;

                    Exit;

                end;

            end;

        finally

            FContextList.UnlockList;

        end;

        Self.Connection.IOHandler.WriteLn('this server cannot find the 
client you sent the message to.');

    end;

constructor TWriteResponse.Create(const AResponse: String);

    begin

        FMsg := AResponse;

        inherited Create;

    end;

procedure TWriteResponse.DoSynchronize;

     begin

writeln(FMsg);

end;

class procedure TWriteResponse.AddResponse (const AResponse:
String);

  begin

    with Create(AResponse) do try

            Synchronize;

        finally

            Free;

        end;

    end;

constructor TSmtpServ.Create();
begin

        inherited Create();

        idTCPServer1.ContextClass := TClientinfo;
        idTCPServer1.Bindings.Add.Port:=9000;
        idtcpserver1.Active:=true;
        idtcpserver1.StartListening;

end;

procedure TSmtpServ.Free();
begin

idtcpserver1.Active:=false;
end;


end.


-- 
David Touzeau -------------------------- Linux Ubuntu 7.04 feisty 
FreePascal-Lazarus,perl,delphi,php artica for postfix management console 
(http://www.artica.fr) icq:160018849