* Splittet old HTTP unit into httpbase and httpclient

* Many improvements in fpSock (e.g. better disconnection detection)

fcl/net/Makefile

@@ -1,5 +1,5 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2004/01/05]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2004/01/26]
 #
 default: all
 MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
@@ -222,19 +222,16 @@ override TARGET_PROGRAMS+=mkxmlrpc
 endif
 override TARGET_UNITS+=servlets
 ifeq ($(OS_TARGET),linux)
-override TARGET_UNITS+=fpsock http httpsvlt xmlrpc
+override TARGET_UNITS+=fpsock httpbase httpsvlt xmlrpc
 endif
 ifeq ($(OS_TARGET),freebsd)
-override TARGET_UNITS+=fpsock http httpsvlt xmlrpc
+override TARGET_UNITS+=fpsock httpbase httpsvlt xmlrpc
 endif
 ifeq ($(OS_TARGET),netbsd)
-override TARGET_UNITS+=fpsock http httpsvlt xmlrpc
+override TARGET_UNITS+=fpsock httpbase httpsvlt xmlrpc
 endif
 ifeq ($(OS_TARGET),openbsd)
-override TARGET_UNITS+=fpsock http httpsvlt xmlrpc
-endif
-ifeq ($(OS_TARGET),darwin)
-override TARGET_UNITS+=fpsock http httpsvlt xmlrpc
+override TARGET_UNITS+=fpsock httpbase httpsvlt xmlrpc
 endif
 ifeq ($(OS_TARGET),linux)
 override TARGET_RSTS+=fpsock httpsvlt mkxmlrpc
@@ -1045,20 +1042,6 @@ REQUIRE_PACKAGES_NETDB=1
 REQUIRE_PACKAGES_LIBASYNC=1
 endif
 endif
-ifeq ($(OS_TARGET),netbsd)
-ifeq ($(CPU_TARGET),powerpc)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_NETDB=1
-REQUIRE_PACKAGES_LIBASYNC=1
-endif
-endif
-ifeq ($(OS_TARGET),netbsd)
-ifeq ($(CPU_TARGET),sparc)
-REQUIRE_PACKAGES_RTL=1
-REQUIRE_PACKAGES_NETDB=1
-REQUIRE_PACKAGES_LIBASYNC=1
-endif
-endif
 ifeq ($(OS_TARGET),amiga)
 ifeq ($(CPU_TARGET),m68k)
 REQUIRE_PACKAGES_RTL=1

fcl/net/Makefile.fpc

@@ -7,11 +7,10 @@ main=fcl
 
 [target]
 units=servlets
-units_linux=fpsock http httpsvlt xmlrpc
-units_freebsd=fpsock http httpsvlt xmlrpc
-units_darwin=fpsock http httpsvlt xmlrpc
-units_netbsd=fpsock http httpsvlt xmlrpc
-units_openbsd=fpsock http httpsvlt xmlrpc
+units_linux=fpsock httpbase httpsvlt xmlrpc
+units_freebsd=fpsock httpbase httpsvlt xmlrpc
+units_netbsd=fpsock httpbase httpsvlt xmlrpc
+units_openbsd=fpsock httpbase httpsvlt xmlrpc
 programs_linux=mkxmlrpc
 programs_freebsd=mkxmlrpc
 programs_darwin=mkxmlrpc

fcl/net/fpsock.pp

@@ -1,7 +1,7 @@
 {
     $Id$
 
-    Socket components    
+    Socket communication components    
     Copyright (c) 2003 by
       Areca Systems GmbH / Sebastian Guenther, [email protected]
 
@@ -17,7 +17,7 @@ unit fpSock;
 
 interface
 
-uses SysUtils, Sockets, Classes, fpAsync;
+uses Errors, SysUtils, Sockets, Classes, fpAsync, Resolve;
 
 type
 
@@ -27,10 +27,7 @@ type
   TSocketComponent = class(TComponent)
   private
     FEventLoop: TEventLoop;
-  protected
-    DataAvailableNotifyHandle: Pointer;
   public
-    destructor Destroy; override;
     property EventLoop: TEventLoop read FEventLoop write FEventLoop;
   end;
 
@@ -39,6 +36,8 @@ type
     FOnDisconnect: TNotifyEvent;
     function GetLocalAddress: TSockAddr;
     function GetPeerAddress: TSockAddr;
+  protected
+    procedure Disconnected; virtual;
   public
     destructor Destroy; override;
     function Read(var Buffer; Count: LongInt): LongInt; override;
@@ -49,87 +48,165 @@ type
     property OnDisconnect: TNotifyEvent read FOnDisconnect write FOnDisconnect;
   end;
 
-  // TCP/IP components
 
-  TTCPConnection = class(TSocketComponent)
+  // Connection-based sockets
+
+  TConnectionBasedSocket = class(TSocketComponent)
+  protected
+    FStream: TSocketStream;
+    FActive: Boolean;
+    procedure SetActive(Value: Boolean); virtual; abstract;
+    property Active: Boolean read FActive write SetActive;
+    property Stream: TSocketStream read FStream;
+  public
+    destructor Destroy; override;
   end;
 
-  TTCPClient = class(TTCPConnection)
+
+  TConnectionState = (
+    connDisconnected,
+    connResolving,
+    connConnecting,
+    connConnected);
+
+  TClientConnectionSocket = class;
+
+  TConnectionStateChangeEvent = procedure(Sender: TClientConnectionSocket;
+    OldState, NewState: TConnectionState) of object;
+
+  TClientConnectionSocket = class(TConnectionBasedSocket)
+  private
+    FOnStateChange: TConnectionStateChangeEvent;
+    FRetries: Integer;
+    FRetryDelay: Integer;	// Delay between retries in ms
+    RetryCounter: Integer;
+    RetryTimerNotifyHandle: Pointer;
+    CanWriteNotifyHandle: Pointer;
+    procedure RetryTimerNotify(Sender: TObject);
+    procedure SocketCanWrite(Sender: TObject);
+  protected
+    FConnectionState: TConnectionState;
+
+    procedure CreateSocket; virtual; abstract;
+    procedure DoResolve; virtual;
+    procedure DoConnect; virtual;
+    function GetPeerName: String; virtual; abstract;
+
+    procedure SetActive(Value: Boolean); override;
+    procedure SetConnectionState(NewState: TConnectionState);
+
+    property ConnectionState: TConnectionState read FConnectionState;
+    property Retries: Integer read FRetries write FRetries default 0;
+    property RetryDelay: Integer read FRetryDelay write FRetryDelay default 500;
+    property OnConnectionStateChange: TConnectionStateChangeEvent
+      read FOnStateChange write FOnStateChange;
+  public
+    constructor Create(AOwner: TComponent); override;
+    destructor Destroy; override;
   end;
 
-  TCustomTCPServer = class;
 
-  TQueryConnectEvent = procedure(Sender: TCustomTCPServer; Socket: Integer;
+  TQueryConnectEvent = procedure(Sender: TConnectionBasedSocket; Socket: Integer;
     var DoConnect: Boolean) of object;
-  TConnectEvent = procedure(Sender: TCustomTCPServer;
+  TConnectEvent = procedure(Sender: TConnectionBasedSocket;
     Stream: TSocketStream) of object;
 
-  TCustomTCPServer = class(TTCPConnection)
+  TSocketConnectionServer = class(TConnectionBasedSocket)
   private
-    FActive: Boolean;
-    FPort: Word;
     FOnQueryConnect: TQueryConnectEvent;
     FOnConnect: TConnectEvent;
-    procedure SetActive(Value: Boolean);
-    procedure ListenerDataAvailable(Sender: TObject);
   protected
-    FSocket: Integer;
-
-    function DoQueryConnect(ASocket: Integer): Boolean; virtual;
+    DataAvailableNotifyHandle: Pointer;
+    procedure ListenerDataAvailable(Sender: TObject);
+    function DoQueryConnect(ASocket: Integer): Boolean;
     procedure DoConnect(AStream: TSocketStream); virtual;
-
-    //!!!: Interface/bindings list?
-    property Active: Boolean read FActive write SetActive;
-    property Port: Word read FPort write FPort;
     property OnQueryConnect: TQueryConnectEvent read FOnQueryConnect
       write FOnQueryConnect;
     property OnConnect: TConnectEvent read FOnConnect write FOnConnect;
   end;
 
-  TTCPServer = class(TCustomTCPServer)
+
+  // TCP/IP components
+
+  TCustomTCPClient = class(TClientConnectionSocket)
+  private
+    FHost: String;
+    FPort: Word;
+    HostAddr: THostAddr;
+    procedure SetHost(const Value: String);
+    procedure SetPort(Value: Word);
+  protected
+    procedure CreateSocket; override;
+    procedure DoResolve; override;
+    procedure DoConnect; override;
+    function GetPeerName: String; override;
+
+    property Host: String read FHost write SetHost;
+    property Port: Word read FPort write SetPort;
   public
-    property Socket: Integer read FSocket;
+    destructor Destroy; override;
+  end;
+
+  TTCPClient = class(TCustomTCPClient)
+  public
+    property ConnectionState;
+    property Stream;
   published
     property Active;
+    property Host;
     property Port;
-    property OnQueryConnect;
-    property OnConnect;
+    property Retries;
+    property RetryDelay;
+    property OnConnectionStateChange;
   end;
 
+  TCustomTCPServer = class;
 
-  // UDP/IP components
-
-  TUDPBase = class(TSocketComponent)
-  end;
-
-  TUDPClient = class(TUDPBase)
+  TCustomTCPServer = class(TSocketConnectionServer)
+  private
+    FPort: Word;
+    procedure SetActive(Value: Boolean); override;
+  protected
+    //!!!: Interface/bindings list?
+    property Port: Word read FPort write FPort;
+  public
+    destructor Destroy; override;
   end;
 
-  TUDPServer = class(TUDPBase)
+  TTCPServer = class(TCustomTCPServer)
+  public
+    property Stream;
+  published
+    property Active;
+    property Port;
+    property OnQueryConnect;
+    property OnConnect;
   end;
 
 
 implementation
 
-uses Resolve;
+uses
+{$IFDEF VER1_0}
+  Linux;
+{$ELSE}
+  Unix;
+{$ENDIF}
 
 resourcestring
-  SSocketCreationError = 'Could not create socket';
-  SSocketBindingError = 'Could not bind socket to port %d';
-  SSocketAcceptError = 'Connection accept failed';
+  SSocketNoEventLoopAssigned = 'No event loop assigned';
+  SSocketCreationError = 'Could not create socket: %s';
+  SHostNotFound = 'Host "%s" not found';
+  SSocketConnectFailed = 'Could not connect to %s: %s';
+  SSocketBindingError = 'Could not bind socket to port %d: %s';
+  SSocketAcceptError = 'Connection accept failed: %s';
+  SSocketIsActive = 'Cannot change parameters while active';
+
 
-destructor TSocketComponent.Destroy;
-begin
-  if Assigned(DataAvailableNotifyHandle) then
-  begin
-    EventLoop.ClearDataAvailableNotify(DataAvailableNotifyHandle);
-    // Set to nil to be sure that descendant classes don't do something stupid
-    DataAvailableNotifyHandle := nil;
-  end;
-  inherited Destroy;
-end;
 
 
+// TSocketStream
+
 destructor TSocketStream.Destroy;
 begin
   FileClose(Handle);
@@ -142,8 +219,8 @@ begin
   if Result = -1 then
   begin
     Result := 0;
-    if Assigned(OnDisconnect) then
-      OnDisconnect(Self);
+    if SocketError <> Sys_EAGAIN then
+      Disconnected;
   end;
 end;
 
@@ -153,11 +230,17 @@ begin
   if Result = -1 then
   begin
     Result := 0;
-    if Assigned(OnDisconnect) then
-      OnDisconnect(Self);
+    if SocketError <> Sys_EAGAIN then
+      Disconnected;
   end;
 end;
 
+procedure TSocketStream.Disconnected;
+begin
+  if Assigned(OnDisconnect) then
+    OnDisconnect(Self);
+end;
+
 function TSocketStream.GetLocalAddress: TSockAddr;
 var
   len: LongInt;
@@ -177,21 +260,289 @@ begin
 end;
 
 
-function TCustomTCPServer.DoQueryConnect(ASocket: Integer): Boolean;
+// TConnectionBasedSocket
+
+destructor TConnectionBasedSocket.Destroy;
+begin
+  FreeAndNil(FStream);
+  inherited Destroy;
+end;
+
+
+// TClientConnectionSocket
+
+constructor TClientConnectionSocket.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FRetryDelay := 500;
+end;
+
+destructor TClientConnectionSocket.Destroy;
+begin
+  if Assigned(RetryTimerNotifyHandle) then
+    EventLoop.RemoveTimerNotify(RetryTimerNotifyHandle);
+  inherited Destroy;
+end;
+
+procedure TClientConnectionSocket.DoResolve;
+begin
+  // By default, no resolving is done, so continue directly with connecting
+  DoConnect;
+end;
+
+procedure TClientConnectionSocket.DoConnect;
+begin
+  SetConnectionState(connConnecting);
+
+  try
+    if not Assigned(EventLoop) then
+      raise ESocketError.Create(SSocketNoEventLoopAssigned);
+    CanWriteNotifyHandle := EventLoop.SetCanWriteNotify(Stream.Handle,
+      @SocketCanWrite, nil);
+  except
+    SetConnectionState(connDisconnected);
+    raise;
+  end;
+end;
+
+procedure TClientConnectionSocket.SetActive(Value: Boolean);
+begin
+  if Value <> Active then
+  begin
+    if Value then
+    begin
+      // Activate the connection
+      FActive := True;
+      RetryCounter := 0;
+
+      CreateSocket;
+      DoResolve;
+    end else
+    begin
+      // Close the connection
+      FActive := False;
+      try
+        FreeAndNil(FStream);
+        if Assigned(CanWriteNotifyHandle) then
+        begin
+          EventLoop.ClearCanWriteNotify(CanWriteNotifyHandle);
+          CanWriteNotifyHandle := nil;
+        end;
+        if Assigned(RetryTimerNotifyHandle) then
+        begin
+          EventLoop.RemoveTimerNotify(RetryTimerNotifyHandle);
+	  RetryTimerNotifyHandle := nil;
+        end;
+      finally
+        SetConnectionState(connDisconnected);
+      end;
+    end;
+  end;
+end;
+
+procedure TClientConnectionSocket.SetConnectionState(NewState:
+  TConnectionState);
+var
+  OldState: TConnectionState;
+begin
+  if NewState <> ConnectionState then
+  begin
+    OldState := ConnectionState;
+    FConnectionState := NewState;
+    if Assigned(OnConnectionStateChange) then
+      OnConnectionStateChange(Self, OldState, NewState);
+  end;
+end;
+
+
+procedure TClientConnectionSocket.RetryTimerNotify(Sender: TObject);
+begin
+  RetryTimerNotifyHandle := nil;
+  Active := True;
+end;
+
+procedure TClientConnectionSocket.SocketCanWrite(Sender: TObject);
+var
+  Error: Integer;
+  ErrorLen, GetResult: LongInt;
+begin
+  if ConnectionState = connConnecting then
+  begin
+    EventLoop.ClearCanWriteNotify(CanWriteNotifyHandle);
+    CanWriteNotifyHandle := nil;
+
+    ErrorLen := SizeOf(Error);
+    GetResult := Sockets.GetSocketOptions(Stream.Handle, SOL_SOCKET, SO_ERROR,
+      Error, ErrorLen);
+    if GetResult <> 0 then
+      raise ESocketError.CreateFmt(SSocketConnectFailed,
+	[GetPeerName, StrError(GetResult)]);
+    if Error <> 0 then
+      if (RetryCounter >= Retries) and (Retries >= 0) then
+        raise ESocketError.CreateFmt(SSocketConnectFailed,
+	  [GetPeerName, StrError(Error)])
+      else begin
+        Active := False;
+	RetryTimerNotifyHandle := EventLoop.AddTimerNotify(RetryDelay, False,
+	  @RetryTimerNotify, Self);
+	Inc(RetryCounter);
+      end
+    else
+    begin
+      RetryCounter := 0;
+      SetConnectionState(connConnected);
+    end;
+  end;
+end;
+
+
+// TSocketConnectionServer
+
+procedure TSocketConnectionServer.ListenerDataAvailable(Sender: TObject);
+var
+  ClientSocket: Integer;
+  Addr: TInetSockAddr;
+  AddrSize: Integer;
+begin
+  AddrSize := SizeOf(Addr);
+  ClientSocket := Accept(Stream.Handle, Addr, AddrSize);
+  if ClientSocket = -1 then
+    raise ESocketError.CreateFmt(SSocketAcceptError, [StrError(SocketError)]);
+
+  if DoQueryConnect(ClientSocket) then
+    DoConnect(TSocketStream.Create(ClientSocket));
+end;
+
+function TSocketConnectionServer.DoQueryConnect(ASocket: Integer): Boolean;
 begin
   Result := True;
   if Assigned(OnQueryConnect) then
     OnQueryConnect(Self, ASocket, Result);
 end;
 
-procedure TCustomTCPServer.DoConnect(AStream: TSocketStream);
+procedure TSocketConnectionServer.DoConnect(AStream: TSocketStream);
 begin
   if Assigned(OnConnect) then
     OnConnect(Self, AStream);
 end;
 
+
+// TCustomTCPClient
+
+type
+  TClientSocketStream = class(TSocketStream)
+  protected
+    Client: TCustomTCPClient;
+    procedure Disconnected; override;
+  end;
+
+procedure TClientSocketStream.Disconnected;
+begin
+  inherited Disconnected;
+  Client.Active := False;
+end;
+
+
+destructor TCustomTCPClient.Destroy;
+begin
+  if Assigned(CanWriteNotifyHandle) then
+  begin
+    EventLoop.ClearCanWriteNotify(CanWriteNotifyHandle);
+    // Set to nil to be sure that descendant classes don't do something stupid
+    CanWriteNotifyHandle := nil;
+  end;
+  inherited Destroy;
+end;
+
+procedure TCustomTCPClient.SetHost(const Value: String);
+begin
+  if Value <> Host then
+  begin
+    if Active then
+      raise ESocketError.Create(SSocketIsActive);
+    FHost := Value;
+  end;
+end;
+
+procedure TCustomTCPClient.SetPort(Value: Word);
+begin
+  if Value <> Port then
+  begin
+    if Active then
+      raise ESocketError.Create(SSocketIsActive);
+    FPort := Value;
+  end;
+end;
+
+procedure TCustomTCPClient.DoResolve;
+var
+  HostResolver: THostResolver;
+begin
+  HostAddr := StrToHostAddr(Host);
+  if HostAddr[1] = 0 then
+  begin
+    HostResolver := THostResolver.Create(nil);
+    try
+      SetConnectionState(connResolving);
+      if not HostResolver.NameLookup(FHost) then
+        raise ESocketError.CreateFmt(SHostNotFound, [Host]);
+      HostAddr := HostResolver.HostAddress;
+    finally
+      HostResolver.Free;
+    end;
+  end;
+  DoConnect;
+end;
+
+procedure TCustomTCPClient.CreateSocket;
+var
+  Socket: Integer;
+begin
+
+  Socket := Sockets.Socket(AF_INET, SOCK_STREAM, 0);
+  if Socket = -1 then
+    raise ESocketError.CreateFmt(SSocketCreationError,
+      [StrError(SocketError)]);
+  FStream := TClientSocketStream.Create(Socket);
+  TClientSocketStream(FStream).Client := Self;
+end;
+
+procedure TCustomTCPClient.DoConnect;
+var
+  SockAddr: TInetSockAddr;
+begin
+  inherited DoConnect;
+  SockAddr.Family := AF_INET;
+  SockAddr.Port := ShortHostToNet(Port);
+  SockAddr.Addr := Cardinal(HostAddr);
+  Sockets.Connect(Stream.Handle, SockAddr, SizeOf(SockAddr));
+  if (SocketError <> sys_EINPROGRESS) and (SocketError <> 0) then
+    raise ESocketError.CreateFmt(SSocketConnectFailed,
+      [GetPeerName, StrError(SocketError)]);
+end;
+
+function TCustomTCPClient.GetPeerName: String;
+begin
+  Result := Format('%s:%d', [Host, Port]);
+end;
+
+
+// TCustomTCPServer
+
+destructor TCustomTCPServer.Destroy;
+begin
+  if Assigned(DataAvailableNotifyHandle) then
+  begin
+    EventLoop.ClearDataAvailableNotify(DataAvailableNotifyHandle);
+    // Set to nil to be sure that descendant classes don't do something stupid
+    DataAvailableNotifyHandle := nil;
+  end;
+  inherited Destroy;
+end;
+
 procedure TCustomTCPServer.SetActive(Value: Boolean);
 var
+  Socket: Integer;
   Addr: TInetSockAddr;
 begin
   if Active <> Value then
@@ -199,47 +550,42 @@ begin
     FActive := False;
     if Value then
     begin
-      FSocket := Sockets.Socket(AF_INET, SOCK_STREAM, 0);
-      if FSocket = -1 then
-        raise ESocketError.Create(SSocketCreationError);
+      Socket := Sockets.Socket(AF_INET, SOCK_STREAM, 0);
+      if Socket = -1 then
+        raise ESocketError.CreateFmt(SSocketCreationError,
+	  [StrError(SocketError)]);
+      FStream := TSocketStream.Create(Socket);
       Addr.Family := AF_INET;
       Addr.Port := ShortHostToNet(Port);
       Addr.Addr := 0;
-      if not Bind(FSocket, Addr, SizeOf(Addr)) then
-        raise ESocketError.CreateFmt(SSocketBindingError, [Port]);
-      Listen(FSocket, 5);
-      DataAvailableNotifyHandle := EventLoop.SetDataAvailableNotify(FSocket,
+      if not Bind(Socket, Addr, SizeOf(Addr)) then
+        raise ESocketError.CreateFmt(SSocketBindingError,
+	  [Port, StrError(SocketError)]);
+      Listen(Socket, 5);
+      if not Assigned(EventLoop) then
+        raise ESocketError.Create(SSocketNoEventLoopAssigned);
+      DataAvailableNotifyHandle := EventLoop.SetDataAvailableNotify(Socket,
         @ListenerDataAvailable, nil);
+      FActive := True;
     end else
     begin
-      FileClose(FSocket);
+      FreeAndNil(FStream);
       EventLoop.ClearDataAvailableNotify(DataAvailableNotifyHandle);
       DataAvailableNotifyHandle := nil;
     end;
   end;
 end;
 
-procedure TCustomTCPServer.ListenerDataAvailable(Sender: TObject);
-var
-  ClientSocket: Integer;
-  Addr: TInetSockAddr;
-  AddrSize: Integer;
-begin
-  AddrSize := SizeOf(Addr);
-  ClientSocket := Accept(FSocket, Addr, AddrSize);
-  if ClientSocket = -1 then
-    raise ESocketError.Create(SSocketAcceptError);
-
-  if DoQueryConnect(ClientSocket) then
-    DoConnect(TSocketStream.Create(ClientSocket));
-end;
-
 end.
 
 
 {
   $Log$
-  Revision 1.1  2003-11-22 11:55:28  sg
+  Revision 1.2  2004-01-31 19:13:14  sg
+  * Splittet old HTTP unit into httpbase and httpclient
+  * Many improvements in fpSock (e.g. better disconnection detection)
+
+  Revision 1.1  2003/11/22 11:55:28  sg
   * First version, a simple starting point for further development
 
 }

fcl/net/http.pp → fcl/net/httpbase.pp

@@ -1,7 +1,7 @@
 {
     $Id$
 
-    HTTP: Classes for dealing with HTTP requests
+    HTTPBase: Common HTTP utility declarations and classes
     Copyright (C) 2000-2003 by Sebastian Guenther ([email protected])
 
     See the file COPYING.FPC, included in this distribution,
@@ -13,11 +13,11 @@
 }
 
 
-unit HTTP;
+unit HTTPBase;
 
 interface
 
-uses Classes, SSockets, fpAsync;
+uses Classes, fpAsync;
 
 const
 
@@ -197,117 +197,12 @@ type
   end;
 
 
-  TCustomHttpConnection = class
-  protected
-    FManager: TEventLoop;
-    FSocket: TInetSocket;
-    SendBuffer: TAsyncWriteStream;
-    FOnPrepareSending: TNotifyEvent;
-    FOnHeaderSent: TNotifyEvent;
-    FOnStreamSent: TNotifyEvent;
-    FOnPrepareReceiving: TNotifyEvent;
-    FOnHeaderReceived: TNotifyEvent;
-    FOnStreamReceived: TNotifyEvent;
-    FOnDestroy: TNotifyEvent;
-    RecvSize: Integer;	// How many bytes are still to be read. -1 if unknown.
-    DataAvailableNotifyHandle: Pointer;
-    ReceivedHTTPVersion: String;
-
-    procedure HeaderToSendCompleted(Sender: TObject);
-    procedure StreamToSendCompleted(Sender: TObject);
-    procedure ReceivedHeaderCompleted(Sender: TObject);
-    procedure ReceivedHeaderEOF(Sender: TObject);
-    procedure DataAvailable(Sender: TObject);
-    procedure ReceivedStreamCompleted(Sender: TObject);
-
-    property OnPrepareSending: TNotifyEvent read FOnPrepareSending write FOnPrepareSending;
-    property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
-    property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
-    property OnPrepareReceiving: TNotifyEvent read FOnPrepareReceiving write FOnPrepareReceiving;
-    property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
-    property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
-    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
-
-  public
-    HeaderToSend: THttpHeader;
-    StreamToSend: TStream;
-    ReceivedHeader: THttpHeader;
-    ReceivedStream: TStream;
-    DoDestroy: Boolean;
-
-    constructor Create(AManager: TEventLoop; ASocket: TInetSocket);
-    destructor Destroy; override;
-    procedure Receive;
-    procedure Send;
-  end;
-
-  THttpConnection = class(TCustomHttpConnection)
-  public
-    property OnPrepareSending;
-    property OnHeaderSent;
-    property OnStreamSent;
-    property OnPrepareReceiving;
-    property OnHeaderReceived;
-    property OnStreamReceived;
-    property OnDestroy;
-  end;
-
-  {TCustomHTTPClient = class
-  protected
-    FEventLoop: TEventLoop;
-    FSocket: TInetSocket;
-    SendBuffer: TAsyncWriteStream;
-    FOnPrepareSending: TNotifyEvent;
-    FOnHeaderSent: TNotifyEvent;
-    FOnStreamSent: TNotifyEvent;
-    FOnPrepareReceiving: TNotifyEvent;
-    FOnHeaderReceived: TNotifyEvent;
-    FOnStreamReceived: TNotifyEvent;
-    FOnDestroy: TNotifyEvent;
-    RecvSize: Integer;	// How many bytes are still to be read. -1 if unknown.
-    DataAvailableNotifyHandle: Pointer;
-    ReceivedHTTPVersion: String;
-
-    procedure HeaderToSendCompleted(Sender: TObject);
-    procedure StreamToSendCompleted(Sender: TObject);
-    procedure ReceivedHeaderCompleted(Sender: TObject);
-    procedure ReceivedHeaderEOF(Sender: TObject);
-    procedure DataAvailable(Sender: TObject);
-    procedure ReceivedStreamCompleted(Sender: TObject);
-
-    property OnPrepareSending: TNotifyEvent read FOnPrepareSending write FOnPrepareSending;
-    property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
-    property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
-    property OnPrepareReceiving: TNotifyEvent read FOnPrepareReceiving write FOnPrepareReceiving;
-    property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
-    property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
-    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
-
-  public
-    HeaderToSend: THttpHeader;
-    StreamToSend: TStream;
-    ReceivedHeader: THttpHeader;
-    ReceivedStream: TStream;
-    DoDestroy: Boolean;
-
-    constructor Create(AEventLoop: TEventLoop; ASocket: TInetSocket);
-    destructor Destroy; override;
-    procedure Receive;
-    procedure Send;
-  end;}
-
-
-// ===================================================================
-// ===================================================================
-
 implementation
 
 uses SysUtils;
 
 
-// -------------------------------------------------------------------
-//   THttpHeader
-// -------------------------------------------------------------------
+// THttpHeader
 
 procedure THttpHeader.LineReceived(const ALine: String);
 var
@@ -587,206 +482,14 @@ begin
   CodeText := 'OK';
 end;
 
-
-// -------------------------------------------------------------------
-//   TCustomHttpConnection
-// -------------------------------------------------------------------
-
-procedure TCustomHttpConnection.HeaderToSendCompleted(Sender: TObject);
-begin
-  // WriteLn('TCustomHttpConnection.HeaderToSendCompleted');
-  if Assigned(FOnHeaderSent) then
-    FOnHeaderSent(Self);
-  if Assigned(StreamToSend) then
-  begin
-    SendBuffer := TAsyncWriteStream.Create(FManager, FSocket);
-    SendBuffer.CopyFrom(StreamToSend, StreamToSend.Size);
-    SendBuffer.OnBufferSent := @StreamToSendCompleted;
-  end else
-  begin
-    StreamToSendCompleted(nil);
-    if DoDestroy then
-      Self.Free;
-  end;
-end;
-
-procedure TCustomHttpConnection.StreamToSendCompleted(Sender: TObject);
-begin
-  // WriteLn('TCustomHttpConnection.StreamToSendCompleted');
-  if Assigned(FOnStreamSent) then
-    FOnStreamSent(Self);
-  FreeAndNil(SendBuffer);
-  if DoDestroy then
-    Self.Free
-  else
-    Receive;
-end;
-
-procedure TCustomHttpConnection.ReceivedHeaderCompleted(Sender: TObject);
-var
-  BytesInBuffer: Integer;
-  NeedMoreData: Boolean;
-begin
-  // WriteLn('TCustomHttpConnection.ReceivedHeaderCompleted');
-  ReceivedHeader.DataReceived := False;
-  ReceivedHTTPVersion := ReceivedHeader.HttpVersion;
-  BytesInBuffer := ReceivedHeader.Reader.BytesInBuffer;
-  //WriteLn('BytesInBuffer: ', BytesInBuffer, ', Content length: ', ReceivedHeader.ContentLength);
-  if Assigned(FOnHeaderReceived) then
-    FOnHeaderReceived(Self);
-
-  RecvSize := ReceivedHeader.ContentLength;
-  if Assigned(ReceivedStream) then
-  begin
-    if BytesInBuffer = 0 then
-      NeedMoreData := True
-    else
-    begin
-      ReceivedStream.Write(ReceivedHeader.Reader.Buffer^, BytesInBuffer);
-      if RecvSize > 0 then
-        Dec(RecvSize, BytesInBuffer);
-      if BytesInBuffer = ReceivedHeader.ContentLength then
-	NeedMoreData := False
-      else
-        NeedMoreData := (not ReceivedHeader.InheritsFrom(THttpRequestHeader)) or
-	  (THttpRequestHeader(ReceivedHeader).Command <> 'GET');
-    end;
-  end else
-    NeedMoreData := False;
-
-  if NeedMoreData then
-    DataAvailableNotifyHandle :=
-      FManager.SetDataAvailableNotify(FSocket.Handle, @DataAvailable, FSocket)
-  else
-    ReceivedStreamCompleted(nil);
-
-  if DoDestroy then
-    Self.Free;
-end;
-
-procedure TCustomHttpConnection.ReceivedHeaderEOF(Sender: TObject);
-begin
-  Self.Free;
-end;
-
-procedure TCustomHttpConnection.DataAvailable(Sender: TObject);
-var
-  FirstRun: Boolean;
-  ReadNow, BytesRead: Integer;
-  buf: array[0..1023] of Byte;
-begin
-  FirstRun := True;
-  while True do
-  begin
-    if RecvSize >= 0 then
-    begin
-      ReadNow := RecvSize;
-      if ReadNow > 1024 then
-        ReadNow := 1024;
-    end else
-      ReadNow := 1024;
-    BytesRead := FSocket.Read(buf, ReadNow);
-    // WriteLn('TCustomHttpConnection.DataAvailable: Read ', BytesRead, ' bytes; RecvSize=', RecvSize);
-    if BytesRead <= 0 then
-    begin
-      if FirstRun then
-        ReceivedStreamCompleted(nil);
-      break;
-    end;
-    FirstRun := False;
-    ReceivedStream.Write(buf, BytesRead);
-    if RecvSize > 0 then
-      Dec(RecvSize, BytesRead);
-    if RecvSize = 0 then
-    begin
-      ReceivedStreamCompleted(nil);
-      break;
-    end;
-  end;
-  if DoDestroy then
-    Self.Free;
-end;
-
-procedure TCustomHttpConnection.ReceivedStreamCompleted(Sender: TObject);
-begin
-  // WriteLn('TCustomHttpConnection.ReceivedStreamCompleted');
-  if Assigned(DataAvailableNotifyHandle) then
-  begin
-    FManager.ClearDataAvailableNotify(DataAvailableNotifyHandle);
-    DataAvailableNotifyHandle := nil;
-  end;
-  if Assigned(FOnStreamReceived) then
-    FOnStreamReceived(Self);
-  if DoDestroy then
-    Self.Free
-  else
-    Send;
-end;
-
-constructor TCustomHttpConnection.Create(AManager: TEventLoop; ASocket: TInetSocket);
-begin
-  inherited Create;
-  FManager := AManager;
-  FSocket := ASocket;
-end;
-
-destructor TCustomHttpConnection.Destroy;
-begin
-  if Assigned(DataAvailableNotifyHandle) then
-    FManager.ClearDataAvailableNotify(DataAvailableNotifyHandle);
-  if Assigned(OnDestroy) then
-    OnDestroy(Self);
-  FreeAndNil(SendBuffer);
-  inherited Destroy;
-end;
-
-procedure TCustomHttpConnection.Receive;
-begin
-  // Start receiver
-  ReceivedHttpVersion := '';
-  if Assigned(OnPrepareReceiving) then
-    OnPrepareReceiving(Self);
-  if Assigned(ReceivedHeader) then
-  begin
-    ReceivedHeader.OnCompleted := @ReceivedHeaderCompleted;
-    ReceivedHeader.OnEOF := @ReceivedHeaderEOF;
-    ReceivedHeader.AsyncReceive(FManager, FSocket);
-  end;
-end;
-
-procedure TCustomHttpConnection.Send;
-begin
-  // Start sender
-  if Assigned(OnPrepareSending) then
-    OnPrepareSending(Self);
-  if Assigned(HeaderToSend) then
-  begin
-    if ReceivedHttpVersion <> '' then
-    begin
-      HeaderToSend.HttpVersion := ReceivedHttpVersion;
-      ReceivedHttpVersion := '';
-    end;
-    HeaderToSend.OnCompleted := @HeaderToSendCompleted;
-    HeaderToSend.AsyncSend(FManager, FSocket);
-  end;
-end;
-
-
 end.
 
 
 {
   $Log$
-  Revision 1.3  2003-11-22 11:59:19  sg
-  * Many many changes to prepare a shift to using the servlet classes for
-    HTTP servers; this unit will then contain basic HTTP definitions and a
-    client-only class
-
-  Revision 1.2  2003/06/18 19:13:04  sg
-  * Fixed silly typo in THttpHeader.SetHeaderValues
+  Revision 1.1  2004-01-31 19:13:14  sg
+  * Splittet old HTTP unit into httpbase and httpclient
+  * Many improvements in fpSock (e.g. better disconnection detection)
 
-  Revision 1.1  2002/04/25 19:30:29  sg
-  * First version (with exception of the HTTP unit: This is an improved version
-    of the old asyncio HTTP unit, now adapted to fpAsync)
 
 }

fcl/net/httpclient.pp

@@ -0,0 +1,314 @@
+{
+    $Id$
+
+    HTTPClient: HTTP client component
+    Copyright (C) 2000-2003 by Sebastian Guenther ([email protected])
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+}
+
+
+unit HTTPClient;
+
+interface
+
+uses Classes, HTTPBase, fpSock, fpAsync;
+
+type
+
+  TCustomHTTPClient = class(TCustomTCPClient)
+  protected
+    SendBuffer: TAsyncWriteStream;
+    FOnPrepareSending: TNotifyEvent;
+    FOnHeaderSent: TNotifyEvent;
+    FOnStreamSent: TNotifyEvent;
+    FOnPrepareReceiving: TNotifyEvent;
+    FOnHeaderReceived: TNotifyEvent;
+    FOnStreamReceived: TNotifyEvent;
+    FOnDestroy: TNotifyEvent;
+    RecvSize: Integer;	// How many bytes are still to be read. -1 if unknown.
+    DataAvailableNotifyHandle: Pointer;
+    ReceivedHTTPVersion: String;
+
+    procedure HeaderToSendCompleted(Sender: TObject);
+    procedure StreamToSendCompleted(Sender: TObject);
+    procedure ReceivedHeaderCompleted(Sender: TObject);
+    procedure ReceivedHeaderEOF(Sender: TObject);
+    procedure DataAvailable(Sender: TObject);
+    procedure ReceivedStreamCompleted(Sender: TObject);
+
+    property OnPrepareSending: TNotifyEvent read FOnPrepareSending write FOnPrepareSending;
+    property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
+    property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
+    property OnPrepareReceiving: TNotifyEvent read FOnPrepareReceiving write FOnPrepareReceiving;
+    property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
+    property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
+    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
+
+  public
+    HeaderToSend: THttpHeader;
+    StreamToSend: TStream;
+    ReceivedHeader: THttpHeader;
+    ReceivedStream: TStream;
+    DoDestroy: Boolean;
+
+    destructor Destroy; override;
+//    procedure Receive;
+//    procedure Send;
+  end;
+
+  THttpClient = class(TCustomHttpClient)
+  public
+    property OnPrepareSending;
+    property OnHeaderSent;
+    property OnStreamSent;
+    property OnPrepareReceiving;
+    property OnHeaderReceived;
+    property OnStreamReceived;
+    property OnDestroy;
+  end;
+
+  {TCustomHTTPClient = class
+  protected
+    FEventLoop: TEventLoop;
+    FSocket: TInetSocket;
+    SendBuffer: TAsyncWriteStream;
+    FOnPrepareSending: TNotifyEvent;
+    FOnHeaderSent: TNotifyEvent;
+    FOnStreamSent: TNotifyEvent;
+    FOnPrepareReceiving: TNotifyEvent;
+    FOnHeaderReceived: TNotifyEvent;
+    FOnStreamReceived: TNotifyEvent;
+    FOnDestroy: TNotifyEvent;
+    RecvSize: Integer;	// How many bytes are still to be read. -1 if unknown.
+    DataAvailableNotifyHandle: Pointer;
+    ReceivedHTTPVersion: String;
+
+    procedure HeaderToSendCompleted(Sender: TObject);
+    procedure StreamToSendCompleted(Sender: TObject);
+    procedure ReceivedHeaderCompleted(Sender: TObject);
+    procedure ReceivedHeaderEOF(Sender: TObject);
+    procedure DataAvailable(Sender: TObject);
+    procedure ReceivedStreamCompleted(Sender: TObject);
+
+    property OnPrepareSending: TNotifyEvent read FOnPrepareSending write FOnPrepareSending;
+    property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
+    property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
+    property OnPrepareReceiving: TNotifyEvent read FOnPrepareReceiving write FOnPrepareReceiving;
+    property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
+    property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
+    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
+
+  public
+    HeaderToSend: THttpHeader;
+    StreamToSend: TStream;
+    ReceivedHeader: THttpHeader;
+    ReceivedStream: TStream;
+    DoDestroy: Boolean;
+
+    constructor Create(AEventLoop: TEventLoop; ASocket: TInetSocket);
+    destructor Destroy; override;
+    procedure Receive;
+    procedure Send;
+  end;}
+
+
+implementation
+
+uses SysUtils;
+
+procedure TCustomHttpClient.HeaderToSendCompleted(Sender: TObject);
+begin
+  // WriteLn('TCustomHttpClient.HeaderToSendCompleted');
+  if Assigned(FOnHeaderSent) then
+    FOnHeaderSent(Self);
+  if Assigned(StreamToSend) then
+  begin
+    SendBuffer := TAsyncWriteStream.Create(EventLoop, FSocket);
+    SendBuffer.CopyFrom(StreamToSend, StreamToSend.Size);
+    SendBuffer.OnBufferSent := @StreamToSendCompleted;
+  end else
+  begin
+    StreamToSendCompleted(nil);
+    if DoDestroy then
+      Self.Free;
+  end;
+end;
+
+procedure TCustomHttpClient.StreamToSendCompleted(Sender: TObject);
+begin
+  // WriteLn('TCustomHttpClient.StreamToSendCompleted');
+  if Assigned(FOnStreamSent) then
+    FOnStreamSent(Self);
+  FreeAndNil(SendBuffer);
+  if DoDestroy then
+    Self.Free
+  else
+    Receive;
+end;
+
+procedure TCustomHttpClient.ReceivedHeaderCompleted(Sender: TObject);
+var
+  BytesInBuffer: Integer;
+  NeedMoreData: Boolean;
+begin
+  // WriteLn('TCustomHttpClient.ReceivedHeaderCompleted');
+  ReceivedHeader.DataReceived := False;
+  ReceivedHTTPVersion := ReceivedHeader.HttpVersion;
+  BytesInBuffer := ReceivedHeader.Reader.BytesInBuffer;
+  //WriteLn('BytesInBuffer: ', BytesInBuffer, ', Content length: ', ReceivedHeader.ContentLength);
+  if Assigned(FOnHeaderReceived) then
+    FOnHeaderReceived(Self);
+
+  RecvSize := ReceivedHeader.ContentLength;
+  if Assigned(ReceivedStream) then
+  begin
+    if BytesInBuffer = 0 then
+      NeedMoreData := True
+    else
+    begin
+      ReceivedStream.Write(ReceivedHeader.Reader.Buffer^, BytesInBuffer);
+      if RecvSize > 0 then
+        Dec(RecvSize, BytesInBuffer);
+      if BytesInBuffer = ReceivedHeader.ContentLength then
+	NeedMoreData := False
+      else
+        NeedMoreData := (not ReceivedHeader.InheritsFrom(THttpRequestHeader)) or
+	  (THttpRequestHeader(ReceivedHeader).Command <> 'GET');
+    end;
+  end else
+    NeedMoreData := False;
+
+  if NeedMoreData then
+    DataAvailableNotifyHandle :=
+      EventLoop.SetDataAvailableNotify(FSocket.Handle, @DataAvailable, FSocket)
+  else
+    ReceivedStreamCompleted(nil);
+
+  if DoDestroy then
+    Self.Free;
+end;
+
+procedure TCustomHttpClient.ReceivedHeaderEOF(Sender: TObject);
+begin
+  Self.Free;
+end;
+
+procedure TCustomHttpClient.DataAvailable(Sender: TObject);
+var
+  FirstRun: Boolean;
+  ReadNow, BytesRead: Integer;
+  buf: array[0..1023] of Byte;
+begin
+  FirstRun := True;
+  while True do
+  begin
+    if RecvSize >= 0 then
+    begin
+      ReadNow := RecvSize;
+      if ReadNow > 1024 then
+        ReadNow := 1024;
+    end else
+      ReadNow := 1024;
+    BytesRead := FSocket.Read(buf, ReadNow);
+    // WriteLn('TCustomHttpClient.DataAvailable: Read ', BytesRead, ' bytes; RecvSize=', RecvSize);
+    if BytesRead <= 0 then
+    begin
+      if FirstRun then
+        ReceivedStreamCompleted(nil);
+      break;
+    end;
+    FirstRun := False;
+    ReceivedStream.Write(buf, BytesRead);
+    if RecvSize > 0 then
+      Dec(RecvSize, BytesRead);
+    if RecvSize = 0 then
+    begin
+      ReceivedStreamCompleted(nil);
+      break;
+    end;
+  end;
+  if DoDestroy then
+    Self.Free;
+end;
+
+procedure TCustomHttpClient.ReceivedStreamCompleted(Sender: TObject);
+begin
+  // WriteLn('TCustomHttpClient.ReceivedStreamCompleted');
+  if Assigned(DataAvailableNotifyHandle) then
+  begin
+    EventLoop.ClearDataAvailableNotify(DataAvailableNotifyHandle);
+    DataAvailableNotifyHandle := nil;
+  end;
+  if Assigned(FOnStreamReceived) then
+    FOnStreamReceived(Self);
+  if DoDestroy then
+    Self.Free
+  else
+    Send;
+end;
+
+constructor TCustomHttpClient.Create(AManager: TEventLoop; ASocket: TInetSocket);
+begin
+  inherited Create;
+  EventLoop := AManager;
+  FSocket := ASocket;
+end;
+
+destructor TCustomHttpClient.Destroy;
+begin
+  if Assigned(DataAvailableNotifyHandle) then
+    EventLoop.ClearDataAvailableNotify(DataAvailableNotifyHandle);
+  if Assigned(OnDestroy) then
+    OnDestroy(Self);
+  FreeAndNil(SendBuffer);
+  inherited Destroy;
+end;
+
+procedure TCustomHttpClient.Receive;
+begin
+  // Start receiver
+  ReceivedHttpVersion := '';
+  if Assigned(OnPrepareReceiving) then
+    OnPrepareReceiving(Self);
+  if Assigned(ReceivedHeader) then
+  begin
+    ReceivedHeader.OnCompleted := @ReceivedHeaderCompleted;
+    ReceivedHeader.OnEOF := @ReceivedHeaderEOF;
+    ReceivedHeader.AsyncReceive(EventLoop, FSocket);
+  end;
+end;
+
+procedure TCustomHttpClient.Send;
+begin
+  // Start sender
+  if Assigned(OnPrepareSending) then
+    OnPrepareSending(Self);
+  if Assigned(HeaderToSend) then
+  begin
+    if ReceivedHttpVersion <> '' then
+    begin
+      HeaderToSend.HttpVersion := ReceivedHttpVersion;
+      ReceivedHttpVersion := '';
+    end;
+    HeaderToSend.OnCompleted := @HeaderToSendCompleted;
+    HeaderToSend.AsyncSend(EventLoop, FSocket);
+  end;
+end;
+
+
+end.
+
+
+{
+  $Log$
+  Revision 1.1  2004-01-31 19:13:14  sg
+  * Splittet old HTTP unit into httpbase and httpclient
+  * Many improvements in fpSock (e.g. better disconnection detection)
+
+}

fcl/net/httpsvlt.pp

@@ -17,7 +17,7 @@ unit HTTPSvlt;
 
 interface
 
-uses SysUtils, Classes, fpAsync, fpSock, HTTP, Servlets;
+uses SysUtils, Classes, fpAsync, fpSock, HTTPBase, Servlets;
 
 resourcestring
   SErrUnknownMethod = 'Unknown HTTP method "%s" used';
@@ -633,7 +633,11 @@ end.
 
 {
   $Log$
-  Revision 1.3  2003-11-22 12:01:18  sg
+  Revision 1.4  2004-01-31 19:13:14  sg
+  * Splittet old HTTP unit into httpbase and httpclient
+  * Many improvements in fpSock (e.g. better disconnection detection)
+
+  Revision 1.3  2003/11/22 12:01:18  sg
   * Adaptions to new version of HTTP unit: All server functionality now is
     in this unit, and not http.pp anymore
 

fcl/net/tests/rpcserv.pp

@@ -30,6 +30,7 @@ begin
   XMLRPCServlet.ServerClass := ServerClass;
 
   HttpServer := THttpServer.Create(Self);
+  HttpServer.EventLoop := EventLoop;
   if ParamCount = 2 then
     HttpServer.Port := StrToInt(ParamStr(1))
   else
@@ -51,7 +52,7 @@ end;
 procedure TServerApplication.Run;
 begin
   EventLoop.SetDataAvailableNotify(StdInputHandle, @OnKeyboardData, nil);
-  HttpServer.Start(EventLoop);
+  HttpServer.Active := True;
   EventLoop.Run;
 end;