ConnectEvent := WSACreateEvent();
  WSAEventSelect(ClientSocket, ConnectEvent, FD_CONNECT);
  Result := connect(ClientSocket, Addr, SizeOf(Addr)); // вот тут возникает еще один поток

  ConnectEvent := WSACreateEvent();
// WSAEventSelect(ClientSocket, ConnectEvent, FD_CONNECT); закомментируем эту строку
  Result := connect(ClientSocket, Addr, SizeOf(Addr)); // тогда тут поток не возникает

 Сергей О.

procedure TForm1.WMSocketEvent(var Msg:TMessage);
var Sock:TSocket;
     SockError:Integer;
  begin
   Sock:=TSocket(Msg.WParam);
   SockError:=WSAGetSelectError(Msg.lParam);
   if SockError<>0 then
    begin
     // Здесь должен быть анализ ошибки
     CloseSocket(Sock);
     Exit
    end;
   case WSAGetSelectEvent(Msg.lParam) of
    FD_Read:
     begin
      // Пришёл запрос от клиента. Необходимо прочитать данные,
      // сформировать ответ и отправить его.
     end;
    FD_Accept:
     begin
      // Просто вызываем функцию Accept. Её результат нигде не
      // сохраняется, потому что вновь созданный сокет автоматически
      // начинает работать в асинхронном режиме, и его дескриптор при
      // необходимости будет передан через Msg.wParam при возникновении
      // события
      Accept(Sock,nil,nil)
     end;
    FD_Close:
     begin
      // Получив от клиента сигнал завершения, сервер, в принципе,
      // может попытаться отправить ему данные. После этого сервер
      // также должен соединение со своей стороны
      Shutdown(Sock,SD_Send);
      CloseSocket(Sock)
     end
   end
  end;

   if SockError<>0 then
    begin
     // Здесь должен быть анализ ошибки
     CloseSocket(Sock);
     Exit
    end;

  
  WSAStartup($101, Data);
  ClientSock := Socket(AF_Inet, Sock_Stream, 0);
  addr.sin_family := AF_INET;
  addr.sin_addr.s_addr := inet_addr(PAnsiChar('94.100.177.6')); //   htonl(INADDR_ANY);
  addr.sin_port := htons(110);
  connect(ClientSock, addr, sizeof(sockaddr_in));
  WSAAsyncSelect(ClientSock, Handle, WM_SocketEvent, FD_Read or FD_Accept or FD_Close);

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  S:TSocket;
  Addr:TSockAddr;
begin
  TAcceptThread.Create(False);
  S:=Socket(AF_Inet,Sock_Stream,0);
  Addr.sin_family:=PF_Inet;
  Addr.sin_addr.S_addr:=Inet_Addr('127.0.0.1');
  Addr.sin_port:=HtoNS(3320);
  FillChar(Addr.sin_zero,SizeOf(Addr.sin_zero),0);
  Connect(S,Addr,SizeOf(Addr));
  Sleep(1000);
  CloseSocket(S)
end;

type
  TAcceptThread = class(TThread)
  private
    FS:array of Byte;
    St:string;
  protected
    procedure ShowFS;
    procedure Execute; override;
  end;

...

function TestAccept(
lpCallerId,lpCallerData:PWSABuf;
lpSQOS,lpGQOS:Pointer;
lpCalleeID,lpCalleeData:PWSABuf;
g:Pointer;
dwCallbackData:DWORD):Integer;stdcall;
var
  Thread:TAcceptThread;
begin
  Thread:=TAcceptThread(dwCallbackData);
  SetLength(Thread.FS,lpCallerId.Len);
  Move(lpCallerId.Buf^,Thread.FS[0],lpCallerId.Len);
  Result:=1
end;

{ TAcceptThread }

procedure TAcceptThread.Execute;
var
  S:TSocket;
  Addr:TSockAddr;
  Sz:Integer;
  I:Integer;
begin
  S:=Socket(AF_Inet,Sock_Stream,0);
  Addr.sin_family:=PF_Inet;
  Addr.sin_addr.S_addr:=InAddr_Any;
  Addr.sin_port:=HtoNS(3320);
  FillChar(Addr.sin_zero,SizeOf(Addr.sin_zero),0);
  Bind(S,Addr,SizeOf(Addr));
  Listen(S,SoMaxConn);
  Sz:=SizeOf(Addr);
  WSAAccept(S,@Addr,@Sz,TestAccept,DWORD(Self));
  CloseSocket(S);
  for I:=0 to High(FS) do
    St:=St+IntToStr(FS[I])+' ';
  Synchronize(ShowFS)
end;

procedure TAcceptThread.ShowFS;
begin
  ShowMessage(St)
end;

 Антон Григорьев