[fpc-pascal] How to close TInetServer without except?

[silvioprog]

2013/5/4 Ludo Brands <ludo.brands at free.fr>

> On 05/04/2013 05:05 PM, Zaher Dirkey wrote:
> >
> > On Sat, May 4, 2013 at 5:40 PM, Ludo Brands <ludo.brands at free.fr
> > <mailto:ludo.brands at free.fr>> wrote:
> >
> >     Can you show the code you use? You tested on Windows, linux, Mac,
> ...?
> >
> >
> > Only on Windows XP
> >
>
>
> This is a small test program that works for me on XP and linux:
>
> program testselect;
>
> {$mode objfpc}{$H+}
>
> uses
>   Classes,sockets,
>   {$ifdef unix}
>   unix,baseunix,unixtype
>   {$else}
>   ctypes,WinSock2
>   {$endif}
>   ;
>
> CONST
>   LISTENPORT=1234;
> var
>   sock: cint;
>   sa,clsa:sockaddr;
>   tv:TTimeVal;
>   readfds,writefds,exceptfds:tfdset;
>   c: Integer;
>   res: cint;
>   len: tsocklen;
>   one: Integer;
> begin
>   sock:=fpsocket(AF_INET, SOCK_STREAM, 0);
>   if sock=-1 then
>     begin
>     writeln('socket failed with ',socketerror);
>     exit;
>     end;
>   one:=1;
>   if fpsetsockopt(sock, SOL_SOCKET, SO_REUSEADDR, @one, sizeof(one))=-1
> then
>     begin
>     writeln('setsockopt failed with ',socketerror);
>     exit;
>     end;
>   fillchar(sa,sizeof(sa),0);
>   sa.sin_port:=htons(LISTENPORT);
>   sa.sin_family:=AF_INET;
>   sa.sin_addr.s_addr:= INADDR_ANY;
>   if fpbind(sock, at sa,sizeof(sa))=-1 then
>     begin
>     writeln('bind failed with ',socketerror);
>     exit;
>     end;
>   if fplisten(sock,10)=-1 then
>     begin
>     writeln('listen failed with ',socketerror);
>     exit;
>     end;
>   c:=1;
>   repeat
>     tv.tv_sec:=1;
>     tv.tv_usec:=0;
>     {$ifdef unix}
>     fpFD_ZERO(readfds);
>     fpFD_ZERO(writefds);
>     fpFD_ZERO(exceptfds);
>     fpFD_SET(sock,readfds);
>     res:=fpselect(sock+1, at readfds, at writefds, at exceptfds, at tv);
>     if (res=-1) and (socketerror<>ESYSEINTR) then
>         begin
>         writeln('select failed with ',socketerror);
>         exit;
>         end;
>     if (res>0) and (fpFD_ISSET(sock,readfds)<>0) then
>       begin
>     {$else}
>     FD_ZERO(readfds);
>     FD_ZERO(writefds);
>     FD_ZERO(exceptfds);
>     FD_SET(sock,readfds);
>     res:=select(sock+1, at readfds, at writefds, at exceptfds, at tv);
>     if (res=-1) and (socketerror<>WSAEINTR) then
>        begin
>        writeln('select failed with ',socketerror);
>        exit;
>        end;
>     if (res>0) and (FD_ISSET(sock,readfds)) then
>       begin
>     {$endif}
>       fillchar(clsa,sizeof(clsa),0);
>       len:=sizeof(clsa);
>       if fpaccept(sock, at clsa, at len)=-1 then
>         begin
>         writeln('accept failed with ',socketerror);
>         exit;
>         end;
>       writeln('connection accepted');
>       c:=c+1;
>       end;
>   until c=2;
>   closesocket(sock);
>
> end.
>
> If you run the program and do from a console a
> telnet localhost 1234
> to connect to the program, it will print 'connection accepted' and close
> immediately.
>
> Ludo
>

I think you should make a server and client component and send it to the
Free Pascal team. :)

-- 
Silvio Clécio
My public projects - github.com/silvioprog
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20130504/5c25bc0d/attachment.html>