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

[Ludo Brands]

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