Update README.md

Missing file

DUnit/UnitTestWebsockets.dpr

@@ -14,7 +14,7 @@ program UnitTestWebsockets;
   {$APPTYPE CONSOLE}
 {$ENDIF}
 
-{$IFNDEF USE_JEDI_JCL} {$MESSAGE ERROR 'Must define "USE_JEDI_JCL" for location info of errors'} {$ENDIF}
+//{$IFNDEF USE_JEDI_JCL} {$MESSAGE ERROR 'Must define "USE_JEDI_JCL" for location info of errors'} {$ENDIF}
 
 {$R *.RES}
 

DUnit/mtTestWebSockets.pas

@@ -156,7 +156,7 @@ begin
   //* client to server */
   received := '';
   IndyHTTPWebsocketServer1.SocketIO.OnEvent('TEST_EVENT',
-    procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
+    procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: ISocketIOCallback)
     begin
       received := aArgument.ToJson;
     end);
@@ -180,7 +180,7 @@ begin
   //* server to client */
   received := '';
   IndyHTTPWebsocketClient1.SocketIO.OnEvent('TEST_EVENT',
-    procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
+    procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: ISocketIOCallback)
     begin
       received := aArgument.ToJson;
     end);
@@ -205,12 +205,12 @@ begin
   //* client to server */
   FLastSocketIOMsg := '';
   IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
-    procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
+    procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback)
     begin
       Abort;
     end;
   IndyHTTPWebsocketClient1.SocketIO.Send('test message',
-    procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
+    procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
     begin
       FLastSocketIOMsg := aJSON.AsString;
     end);
@@ -223,7 +223,7 @@ begin
 
   FLastSocketIOMsg := '';
   IndyHTTPWebsocketClient1.SocketIO.Send('test message',
-    procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
+    procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
     begin
       Assert(False, 'should go to error handling callback');
       FLastSocketIOMsg := 'error';
@@ -252,7 +252,7 @@ begin
   //* client to server */
   FLastSocketIOMsg := '';
   IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
-    procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
+    procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback)
     begin
       FLastSocketIOMsg := aText;
     end;
@@ -267,7 +267,7 @@ begin
   //* server to client */
   FLastSocketIOMsg := '';
   IndyHTTPWebsocketClient1.SocketIO.OnSocketIOMsg :=
-    procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
+    procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback)
     begin
       FLastSocketIOMsg := aText;
     end;

IdHTTPWebsocketClient.pas

@@ -1,23 +1,13 @@
 unit IdHTTPWebsocketClient;
-
 interface
-
+{$I wsdefines.pas}
 uses
   Classes,
   IdHTTP,
-  {$IF CompilerVersion <= 21.0}  //D2010
-  IdHashSHA1,
-  {$else}
   Types,
   IdHashSHA,                     //XE3 etc
-  {$IFEND}
   IdIOHandler,
   IdIOHandlerWebsocket,
-  {$ifdef FMX}
-  FMX.Types,
-  {$ELSE}
-  ExtCtrls,
-  {$ENDIF}
   IdWinsock2, Generics.Collections, SyncObjs,
   IdSocketIOHandling;
 
@@ -557,7 +547,11 @@ begin
     begin
       Request.Clear;
       Request.Connection := 'keep-alive';
+      {$IFDEF WEBSOCKETSSL}
+      sURL := Format('https://%s:%d/socket.io/1/', [Host, Port]);
+      {$ELSE}
       sURL := Format('http://%s:%d/socket.io/1/', [Host, Port]);
+      {$ENDIF}
       strmResponse.Clear;
 
       ReadTimeout := 5 * 1000;

IdIOHandlerWebsocket.pas

@@ -1,17 +1,19 @@
 unit IdIOHandlerWebsocket;
-
 {.$DEFINE DEBUG_WS}
-
 //The WebSocket Protocol, RFC 6455
 //http://datatracker.ietf.org/doc/rfc6455/?include_text=1
-
 interface
-
+{$I wsdefines.pas}
 uses
-  Classes, SysUtils,
+  Classes, SysUtils , SyncObjs , Generics.Collections
-  IdIOHandlerStack, IdGlobal, IdException, IdBuffer,
+  , IdIOHandlerStack
-  SyncObjs,
+  , IdGlobal
-  Generics.Collections;
+  , IdException
+  , IdBuffer
+  {$IFDEF WEBSOCKETSSL}
+  , IdSSLOpenSSL
+  {$ENDIF}
+  ;
 
 type
   TWSDataType      = (wdtText, wdtBinary);
@@ -26,7 +28,19 @@ type
   TIdTextEncoding = IIdTextEncoding;
   {$ifend}
 
+  TIOWSPayloadInfo = Record
+    aPayloadLength: Cardinal;
+    aDataCode: TWSDataCode;
+    procedure Initialize(iTextMode:Boolean; iPayloadLength:Cardinal);
+    function DecLength(value:Cardinal):boolean;
+    procedure Clear;
+  end;
+
+  {$IFDEF WEBSOCKETSSL}
+  TIdIOHandlerWebsocket = class(TIdSSLIOHandlerSocketOpenSSL)
+  {$ELSE}
   TIdIOHandlerWebsocket = class(TIdIOHandlerStack)
+  {$ENDIF}
   private
     FIsServerSide: Boolean;
     FBusyUpgrading: Boolean;
@@ -44,9 +58,9 @@ type
     procedure SetIsWebsocket(const Value: Boolean);
   protected
     FMessageStream: TMemoryStream;
-    FWriteTextToTarget: Boolean;
     FCloseCodeSend: Boolean;
     FPendingWriteCount: Integer;
+    fPayloadInfo: TIOWSPayloadInfo;
 
     function InternalReadDataFromSource(var VBuffer: TIdBytes; ARaiseExceptionOnTimeout: Boolean): Integer;
     function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override;
@@ -60,6 +74,7 @@ type
     {$else}
     function UTF8Encoding: TEncoding;
     {$ifend}
+    procedure InitComponent; override;
   public
     function WriteData(aData: TIdBytes; aType: TWSDataCode;
                         aFIN: boolean = true; aRSV1: boolean = false; aRSV2: boolean = false; aRSV3: boolean = false): integer;
@@ -68,8 +83,6 @@ type
     property IsServerSide  : Boolean read FIsServerSide  write FIsServerSide;
     property ClientExtensionBits : TWSExtensionBits read FExtensionBits write FExtensionBits;
   public
-    class constructor Create;
-    procedure  AfterConstruction;override;
     destructor Destroy; override;
 
     procedure Lock;
@@ -229,15 +242,45 @@ begin
   end;
 end;
 
+{ TIOWSPayloadInfo }
+
+procedure TIOWSPayloadInfo.Initialize(iTextMode:Boolean; iPayloadLength:Cardinal);
+begin
+  aPayloadLength := iPayloadLength;
+  if iTextMode
+     then aDataCode := wdcText
+     else aDataCode := wdcBinary;
+end;
+
+procedure TIOWSPayloadInfo.Clear;
+begin
+  aPayloadLength := 0;
+  aDataCode := wdcBinary;
+end;
+
+function TIOWSPayloadInfo.DecLength(value:Cardinal):boolean;
+begin
+  if aPayloadLength >= value then
+   begin
+     aPayloadLength := aPayloadLength - value;
+   end
+   else aPayloadLength := 0;
+  aDataCode := wdcContinuation;
+  Result := aPayloadLength = 0;
+end;
+
 { TIdIOHandlerStack_Websocket }
 
-procedure TIdIOHandlerWebsocket.AfterConstruction;
+procedure TIdIOHandlerWebsocket.InitComponent;
 begin
-  inherited;
+  inherited ;
   FMessageStream := TMemoryStream.Create;
   FWSInputBuffer := TIdBuffer.Create;
   FLock := TCriticalSection.Create;
   FSelectLock := TCriticalSection.Create;
+  {$IFDEF WEBSOCKETSSL}
+  //SendBufferSize := 15 * 1024;
+  {$ENDIF}
 end;
 
 procedure TIdIOHandlerWebsocket.Clear;
@@ -253,7 +296,7 @@ begin
   FCloseCode := 0;
   FLastActivityTime := 0;
   FLastPingTime := 0;
-  FWriteTextToTarget := False;
+  fPayloadInfo.Clear;
   FCloseCodeSend := False;
   FPendingWriteCount := 0;
 end;
@@ -340,11 +383,6 @@ begin
   end;
 end;
 
-class constructor TIdIOHandlerWebsocket.Create;
-begin
-  //UseSingleWriteThread := True;
-end;
-
 destructor TIdIOHandlerWebsocket.Destroy;
 begin
   while FPendingWriteCount > 0 do
@@ -400,8 +438,7 @@ begin
   SetLength(VBuffer, Result);
 end;
 
-procedure TIdIOHandlerWebsocket.WriteLn(const AOut: string;
+procedure TIdIOHandlerWebsocket.WriteLn(const AOut:string; AEncoding: TIdTextEncoding);
-  AEncoding: TIdTextEncoding);
 begin
   if UseSingleWriteThread and IsWebsocket and
      (GetCurrentThreadId <> TIdWebsocketWriteThread.Instance.ThreadID) then
@@ -418,10 +455,10 @@ begin
   begin
     Lock;
     try
-      FWriteTextToTarget := True;
+      fPayloadInfo.Initialize(True,0);
       inherited WriteLn(AOut, UTF8Encoding);  //must be UTF8!
     finally
-      FWriteTextToTarget := False;
+      fPayloadInfo.Clear;
       Unlock;
     end;
   end;
@@ -445,10 +482,10 @@ begin
   begin
     Lock;
     try
-      FWriteTextToTarget := True;
+      fPayloadInfo.Initialize(True,0);
       inherited WriteLnRFC(AOut, UTF8Encoding);  //must be UTF8!
     finally
-      FWriteTextToTarget := False;
+      fPayloadInfo.Clear;
       Unlock;
     end;
   end;
@@ -472,10 +509,10 @@ begin
   begin
     Lock;
     try
-      FWriteTextToTarget := True;
+      fPayloadInfo.Initialize(True,0);
       inherited Write(AOut, UTF8Encoding);  //must be UTF8!
     finally
-      FWriteTextToTarget := False;
+      fPayloadInfo.Clear;
       Unlock;
     end;
   end;
@@ -499,10 +536,10 @@ begin
   begin
     Lock;
     try
-      FWriteTextToTarget := True;
+      fPayloadInfo.Initialize(True,0);
       inherited Write(AValue, AWriteLinesCount, UTF8Encoding);  //must be UTF8!
     finally
-      FWriteTextToTarget := False;
+      fPayloadInfo.Clear;
       Unlock;
     end;
   end;
@@ -526,10 +563,10 @@ begin
   begin
     Lock;
     try
-      FWriteTextToTarget := (aType = wdtText);
+      fPayloadInfo.Initialize((aType = wdtText),AStream.Size);
       inherited Write(AStream);
     finally
-      FWriteTextToTarget := False;
+      fPayloadInfo.Clear;
       Unlock;
     end;
   end;
@@ -554,10 +591,8 @@ begin
     inherited WriteBufferFlush(AByteCount);
 end;
 
-function TIdIOHandlerWebsocket.WriteDataToTarget(const ABuffer: TIdBytes;
+function TIdIOHandlerWebsocket.WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer;
-  const AOffset, ALength: Integer): Integer;
+var data: TIdBytes; DataCode:TWSDataCode; fin:boolean;
-var
-  data: TIdBytes;
 begin
   if UseSingleWriteThread and IsWebsocket and (GetCurrentThreadId <> TIdWebsocketWriteThread.Instance.ThreadID) then
     Assert(False, 'Write done in different thread than TIdWebsocketWriteThread!');
@@ -584,12 +619,9 @@ begin
 
       {$ENDIF}
       try
-        if FWriteTextToTarget then
+        DataCode := fPayloadInfo.aDataCode;
-          Result := WriteData(data, wdcText, True{send all at once},
+        fin := fPayloadInfo.DecLength(ALength);
-                              webBit1 in ClientExtensionBits, webBit2 in ClientExtensionBits, webBit3 in ClientExtensionBits)
+        Result := WriteData(data, DataCode, fin,webBit1 in ClientExtensionBits, webBit2 in ClientExtensionBits, webBit3 in ClientExtensionBits);
-        else
-          Result := WriteData(data, wdcBinary, True{send all at once},
-                              webBit1 in ClientExtensionBits, webBit2 in ClientExtensionBits, webBit3 in ClientExtensionBits);
       except
         FClosedGracefully := True;
         Result := -1;
@@ -853,7 +885,7 @@ var
     temp: TIdBytes;
   begin
     //if HasData then Exit(True);
-    if (FWSInputBuffer.Size > 0) then Exit(True);
+    if (FWSInputBuffer.Size > iInputPos) then Exit(True);
 
     Result := InternalReadDataFromSource(temp, ARaiseExceptionOnTimeout) > 0;
     if Result then
@@ -1019,8 +1051,7 @@ begin
   {$ENDIF}
 end;
 
-function TIdIOHandlerWebsocket.WriteData(aData: TIdBytes;
+function TIdIOHandlerWebsocket.WriteData(aData:TIdBytes; aType:TWSDataCode; aFIN,aRSV1,aRSV2,aRSV3:boolean): integer;
-  aType: TWSDataCode; aFIN, aRSV1, aRSV2, aRSV3: boolean): integer;
 var
   iByte: Byte;
   i, ioffset: NativeInt;
@@ -1051,7 +1082,7 @@ begin
       | |1|2|3|       |K|             |                               |
       +-+-+-+-+-------+-+-------------+ - - - - - - - - - - - - - - - + *)
     //FIN, RSV1, RSV2, RSV3: 1 bit each
-    if aFIN  then iByte :=         (1 shl 7);
+    if aFIN  then iByte :=         (1 shl 7) else iByte := 0;
     if aRSV1 then iByte := iByte + (1 shl 6);
     if aRSV2 then iByte := iByte + (1 shl 5);
     if aRSV3 then iByte := iByte + (1 shl 4);
@@ -1137,7 +1168,17 @@ begin
     ioffset := 0;
     repeat
       //Result := Binding.Send(bData, ioffset);
-      Result := inherited WriteDataToTarget(bdata, iOffset, (Length(bData) - ioffset));    //ssl compatible?
+      //
+      Result := inherited WriteDataToTarget(bdata, iOffset, (Length(bData) - ioffset));  //ssl compatible?
+      if Result<0 then
+        begin
+         // IO error ; probably connexion closed by peer on protocol error ?
+         {$IFDEF DEBUG_WS}
+         if Debughook > 0 then
+           OutputDebugString(PChar(Format('WriteError ThrID:%d, L:%d, R:%d',[getcurrentthreadid,Length(bData)-ioffset,Result])));
+         {$ENDIF}
+         break;
+       end;
       Inc(ioffset, Result);
     until ioffset >= Length(bData);
 

IdServerIOHandlerWebsocket.pas

@@ -1,16 +1,33 @@
 unit IdServerIOHandlerWebsocket;
-
 interface
-
+{$I wsdefines.pas}
 uses
-  Classes,
+  Classes
-  IdServerIOHandlerStack, IdIOHandlerStack, IdGlobal, IdIOHandler, IdYarn, IdThread, IdSocketHandle,
+  , IdServerIOHandlerStack
-  IdIOHandlerWebsocket;
+  , IdIOHandlerStack
+  , IdGlobal
+  , IdIOHandler
+  , IdYarn
+  , IdThread
+  , IdSocketHandle
+  //
+  , IdIOHandlerWebsocket
+  {$IFDEF WEBSOCKETSSL}
+  , IdSSLOpenSSL
+  {$ENDIF}
+  ;
 
 type
+  {$IFDEF WEBSOCKETSSL}
+  TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerSSLOpenSSL)
+  {$ELSE}
   TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerStack)
+  {$ENDIF}
   protected
     procedure InitComponent; override;
+    {$IFDEF WEBSOCKETSSL}
+    function CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL; override;
+    {$ENDIF}
   public
     function Accept(ASocket: TIdSocketHandle; AListenerThread: TIdThread;
       AYarn: TIdYarn): TIdIOHandler; override;
@@ -21,6 +38,13 @@ implementation
 
 { TIdServerIOHandlerStack_Websocket }
 
+{$IFDEF WEBSOCKETSSL}
+function TIdServerIOHandlerWebsocket.CreateOpenSSLSocket:TIdSSLIOHandlerSocketOpenSSL;
+begin
+  Result := TIdIOHandlerWebsocket.Create(nil);
+end;
+{$ENDIF}
+
 function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
   AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
 begin
@@ -35,18 +59,22 @@ end;
 procedure TIdServerIOHandlerWebsocket.InitComponent;
 begin
   inherited InitComponent;
+  {$IFNDEF WEBSOCKETSSL}
   IOHandlerSocketClass := TIdIOHandlerWebsocket;
+  {$ENDIF}
 end;
 
 function TIdServerIOHandlerWebsocket.MakeClientIOHandler(
   ATheThread: TIdYarn): TIdIOHandler;
 begin
   Result := inherited MakeClientIOHandler(ATheThread);
+  {$IFNDEF WEBSOCKETSSL}
   if Result <> nil then
   begin
     (Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
     (Result as TIdIOHandlerWebsocket).UseNagle := False;
   end;
+  {$ENDIF}
 end;
 
 end.

IdServerSocketIOHandling.pas

@@ -1,12 +1,18 @@
 unit IdServerSocketIOHandling;
-
 interface
-
+{$I wsdefines.pas}
 uses
-  IdContext, IdCustomTCPServer,
+  Classes, Generics.Collections, SysUtils, StrUtils
-  //IdServerWebsocketContext,
+  , IdContext
-  Classes, Generics.Collections,
+  , IdCustomTCPServer
-  superobject, IdException, IdServerBaseHandling, IdSocketIOHandling;
+  , IdException
+  //
+  {$IFDEF SUPEROBJECT}
+  , superobject
+  {$ENDIF}
+  , IdServerBaseHandling
+  , IdSocketIOHandling
+  ;
 
 type
   TIdServerSocketIOHandling = class(TIdBaseSocketIOHandling)
@@ -15,22 +21,27 @@ type
   public
     function  SendToAll(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;
     procedure SendTo   (const aContext: TIdServerContext; const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
-
-    function  EmitEventToAll(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;overload;
     function  EmitEventToAll(const aEventName: string; const aData: string      ; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;overload;
-    procedure EmitEventTo   (const aContext: ISocketIOContext;
+    {$IFDEF SUPEROBJECT}
-                             const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
+    function  EmitEventToAll(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;overload;
     procedure EmitEventTo   (const aContext: TIdServerContext;
                              const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
+    procedure EmitEventTo   (const aContext: ISocketIOContext;
+                             const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
+    {$ENDIF}
   end;
 
 implementation
 
-uses
-  SysUtils, StrUtils;
-
 { TIdServerSocketIOHandling }
 
+procedure TIdServerSocketIOHandling.ProcessHeatbeatRequest(
+  const AContext: ISocketIOContext; const aText: string);
+begin
+  inherited ProcessHeatbeatRequest(AContext, aText);
+end;
+
+{$IFDEF SUPEROBJECT}
 procedure TIdServerSocketIOHandling.EmitEventTo(
   const aContext: ISocketIOContext; const aEventName: string;
   const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
@@ -72,6 +83,16 @@ begin
   end;
 end;
 
+function TIdServerSocketIOHandling.EmitEventToAll(const aEventName: string; const aData: ISuperObject;
+  const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
+begin
+  if aData.IsType(stString) then
+    Result := EmitEventToAll(aEventName, '"' + aData.AsString + '"', aCallback, aOnError)
+  else
+    Result := EmitEventToAll(aEventName, aData.AsString, aCallback, aOnError);
+end;
+{$ENDIF}
+
 function TIdServerSocketIOHandling.EmitEventToAll(const aEventName,
   aData: string; const aCallback: TSocketIOMsgJSON;
   const aOnError: TSocketIOError): Integer;
@@ -125,21 +146,6 @@ begin
   end;
 end;
 
-function TIdServerSocketIOHandling.EmitEventToAll(const aEventName: string; const aData: ISuperObject;
-  const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
-begin
-  if aData.IsType(stString) then
-    Result := EmitEventToAll(aEventName, '"' + aData.AsString + '"', aCallback, aOnError)
-  else
-    Result := EmitEventToAll(aEventName, aData.AsString, aCallback, aOnError);
-end;
-
-procedure TIdServerSocketIOHandling.ProcessHeatbeatRequest(
-  const AContext: ISocketIOContext; const aText: string);
-begin
-  inherited ProcessHeatbeatRequest(AContext, aText);
-end;
-
 procedure TIdServerSocketIOHandling.SendTo(const aContext: TIdServerContext;
   const aMessage: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
 var

IdServerWebsocketContext.pas

@@ -1,16 +1,22 @@
 unit IdServerWebsocketContext;
-
 interface
-
+{$I wsdefines.pas}
 uses
-  Classes,
+  Classes, strUtils
-  IdCustomTCPServer, IdIOHandlerWebsocket,
+  , IdContext
-  IdServerBaseHandling, IdServerSocketIOHandling, IdContext;
+  , IdCustomTCPServer
+  , IdCustomHTTPServer
+  //
+  , IdIOHandlerWebsocket
+  , IdServerBaseHandling
+  , IdServerSocketIOHandling
+  ;
 
 type
   TIdServerWSContext = class;
 
-  TWebsocketChannelRequest = procedure(const AContext: TIdServerWSContext; aType: TWSDataType; const strmRequest, strmResponse: TMemoryStream) of object;
+  TWebSocketUpgradeEvent = procedure(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean) of object;
+  TWebsocketChannelRequest = procedure(const AContext: TIdServerWSContext; var aType:TWSDataType; const strmRequest, strmResponse: TMemoryStream) of object;
 
   TIdServerWSContext = class(TIdServerContext)
   private
@@ -25,6 +31,7 @@ type
     FWebSocketExtensions: string;
     FCookie: string;
     //FSocketIOPingSend: Boolean;
+    fOnWebSocketUpgrade: TWebSocketUpgradeEvent;
     FOnCustomChannelExecute: TWebsocketChannelRequest;
     FSocketIO: TIdServerSocketIOHandling;
     FOnDestroy: TIdContextEvent;
@@ -50,14 +57,12 @@ type
     property WebSocketVersion   : Integer read FWebSocketVersion write FWebSocketVersion;
     property WebSocketExtensions: string  read FWebSocketExtensions write FWebSocketExtensions;
   public
+    property OnWebSocketUpgrade: TWebsocketUpgradeEvent read FOnWebSocketUpgrade write FOnWebSocketUpgrade;
     property OnCustomChannelExecute: TWebsocketChannelRequest read FOnCustomChannelExecute write FOnCustomChannelExecute;
   end;
 
 implementation
 
-uses
-  StrUtils;
-
 { TIdServerWSContext }
 
 destructor TIdServerWSContext.Destroy;

IdServerWebsocketHandling.pas

@@ -1,16 +1,24 @@
 unit IdServerWebsocketHandling;
-
 interface
-
+{$I wsdefines.pas}
 uses
-  IdContext, IdCustomHTTPServer,
+  Classes, StrUtils, SysUtils, DateUtils
+  , IdCoderMIME
+  , IdThread
+  , IdContext
+  , IdCustomHTTPServer
   {$IF CompilerVersion <= 21.0}  //D2010
-  IdHashSHA1,
+  , IdHashSHA1
   {$else}
-  IdHashSHA,                     //XE3 etc
+  , IdHashSHA                     //XE3 etc
   {$IFEND}
-  IdServerSocketIOHandling, IdServerWebsocketContext,
+  , IdServerSocketIOHandling
-  Classes, IdServerBaseHandling, IdIOHandlerWebsocket, IdSocketIOHandling;
+  //
+  , IdSocketIOHandling
+  , IdServerBaseHandling
+  , IdServerWebsocketContext
+  , IdIOHandlerWebsocket
+  ;
 
 type
   TIdServerSocketIOHandling_Ext = class(TIdServerSocketIOHandling)
@@ -19,7 +27,7 @@ type
   TIdServerWebsocketHandling = class(TIdServerBaseHandling)
   protected
     class procedure DoWSExecute(AThread: TIdContext; aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
-    class procedure HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
+    class procedure HandleWSMessage(AContext: TIdServerWSContext; var aType: TWSDataType;
                                     aRequestStrm, aResponseStrm: TMemoryStream;
                                     aSocketIOHandler: TIdServerSocketIOHandling_Ext);virtual;
   public
@@ -31,10 +39,6 @@ type
 
 implementation
 
-uses
-  StrUtils, SysUtils, DateUtils,
-  IdCustomTCPServer, IdCoderMIME, IdThread;
-
 { TIdServerWebsocketHandling }
 
 class function TIdServerWebsocketHandling.CurrentSocket: ISocketIOContext;
@@ -103,23 +107,20 @@ begin
             Continue;
           end;
 
-          if wscode = wdcText then
+          if wscode = wdcText
-            wstype := wdtText
+             then wstype := wdtText
-          else
+             else wstype := wdtBinary;
-            wstype := wdtBinary;
 
           HandleWSMessage(context, wstype, strmRequest, strmResponse, aSocketIOHandler);
 
           //write result back (of the same type: text or bin)
           if strmResponse.Size > 0 then
           begin
-            if wscode = wdcText then
+            if wstype = wdtText
-              context.IOHandler.Write(strmResponse, wdtText)
+               then context.IOHandler.Write(strmResponse, wdtText)
-            else
+               else context.IOHandler.Write(strmResponse, wdtBinary)
-              context.IOHandler.Write(strmResponse, wdtBinary)
           end
-          else
+          else context.IOHandler.WriteData(nil, wdcPing);
-            context.IOHandler.WriteData(nil, wdcPing);
         finally
           strmRequest.Free;
           strmResponse.Free;
@@ -152,9 +153,7 @@ begin
   end;
 end;
 
-class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; aType: TWSDataType;
+class procedure TIdServerWebsocketHandling.HandleWSMessage(AContext: TIdServerWSContext; var aType:TWSDataType; aRequestStrm, aResponseStrm: TMemoryStream; aSocketIOHandler: TIdServerSocketIOHandling_Ext);
-  aRequestStrm, aResponseStrm: TMemoryStream;
-  aSocketIOHandler: TIdServerSocketIOHandling_Ext);
 begin
   if AContext.IsSocketIO then
   begin
@@ -170,6 +169,7 @@ class function TIdServerWebsocketHandling.ProcessServerCommandGet(
   AThread: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo;
   AResponseInfo: TIdHTTPResponseInfo): Boolean;
 var
+  Accept: Boolean;
   sValue, squid: string;
   context: TIdServerWSContext;
   hash: TIdHashSHA1;
@@ -244,6 +244,13 @@ begin
     Result  := True;  //handled
     context := AThread as TIdServerWSContext;
 
+    if Assigned(Context.OnWebSocketUpgrade) then
+     begin
+        Accept := True;
+        Context.OnWebSocketUpgrade(Context,ARequestInfo,Accept);
+        if not Accept then Abort;
+     end;
+
     //Sec-WebSocket-Key: dGhlIHNhbXBsZSBub25jZQ==
     sValue := ARequestInfo.RawHeaders.Values['sec-websocket-key'];
     //"The value of this header field MUST be a nonce consisting of a randomly

IdSocketIOHandling.pas

@@ -1,14 +1,24 @@
 unit IdSocketIOHandling;
-
 interface
-
+{$I wsdefines.pas}
 uses
-  Classes, Generics.Collections,
+  windows, SyncObjs, SysUtils, StrUtils, Classes, Generics.Collections
-  superobject,
+  {$IFDEF SUPEROBJECT}
-  IdServerBaseHandling, IdContext, IdException, IdIOHandlerWebsocket, IdHTTP,
+  , superobject
-  SyncObjs, SysUtils;
+  {$ENDIF}
+  , IdContext
+  , IdException
+  , IdHTTP
+  //
+  , IdServerBaseHandling
+  , IdIOHandlerWebsocket
+  ;
 
 type
+  {$IFNDEF SUPEROBJECT}
+  TSuperArray = String;
+  {$ENDIF}
+
   TSocketIOContext = class;
   TSocketIOCallbackObj = class;
   TIdBaseSocketIOHandling = class;
@@ -18,9 +28,13 @@ type
   ISocketIOCallback = interface;
 
   TSocketIOMsg      = reference to procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback);
+  {$IFDEF SUPEROBJECT}
   TSocketIOMsgJSON  = reference to procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback);
-  TSocketIONotify   = reference to procedure(const ASocket: ISocketIOContext);
+  {$ELSE}
+  TSocketIOMsgJSON  = reference to procedure(const ASocket: ISocketIOContext; const aJSON:string; const aCallback: ISocketIOCallback);
+  {$ENDIF}
   TSocketIOEvent    = reference to procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback);
+  TSocketIONotify   = reference to procedure(const ASocket: ISocketIOContext);
   TSocketIOError    = reference to procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string);
   TSocketIOEventError = reference to procedure(const ASocket: ISocketIOContext; const aCallback: ISocketIOCallback; E: Exception);
 
@@ -48,14 +62,15 @@ type
 
     function IsDisconnected: Boolean;
 
+    {$IFDEF SUPEROBJECT}
     procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
+    procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
+    {$ENDIF}
     procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
     procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
-    procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
   end;
 
-  TSocketIOContext = class(TInterfacedObject,
+  TSocketIOContext = class(TInterfacedObject,ISocketIOContext)
-                           ISocketIOContext)
   private
     FLock: TCriticalSection;
     FPingSend: Boolean;
@@ -104,14 +119,15 @@ type
     property CustomData: TObject     read GetCustomData    write SetCustomData;
     property OwnsCustomData: Boolean read GetOwnsCustomData write SetOwnsCustomData;
 
+    procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
+    procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
+    {$IFDEF SUPEROBJECT}
     //todo: OnEvent per socket
     //todo: store session info per connection (see Socket.IO Set + Get -> Storing data associated to a client)
     //todo: namespace using "Of"
     procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
-    procedure EmitEvent(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
-//    procedure BroadcastEventToOthers(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
-    procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
     procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
+    {$ENDIF}
   end;
 
   ISocketIOCallback = interface
@@ -137,7 +153,9 @@ type
   protected
     Done, Success: Boolean;
     Error: Exception;
+    {$IFDEF SUPEROBJECT}
     Data : ISuperObject;
+    {$ENDIF}
     Event: TEvent;
   public
     procedure  AfterConstruction; override;
@@ -158,7 +176,9 @@ type
     FOnDisconnectList: TSocketIONotifyList;
     FOnEventList: TObjectDictionary<string,TSocketIOEventList>;
     FOnSocketIOMsg: TSocketIOMsg;
+    {$IFDEF SUPEROBJECT}
     FOnSocketIOJson: TSocketIOMsgJSON;
+    {$ENDIF}
 
     procedure ProcessEvent(const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer; aHasCallback: Boolean);
   private
@@ -186,7 +206,9 @@ type
     procedure WriteSocketIOJSON(const ASocket: ISocketIOContext; const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
     procedure WriteSocketIOEvent(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError);
     procedure WriteSocketIOEventRef(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError);
+    {$IFDEF SUPEROBJECT}
     function  WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName, aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject;
+    {$ENDIF}
     procedure WriteSocketIOResult(const ASocket: ISocketIOContext; aRequestMsgNr: Integer; const aRoom, aData: string);
 
     procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream);
@@ -215,7 +237,9 @@ type
     procedure FreeConnection(const ASocket: ISocketIOContext);overload;
 
     property  OnSocketIOMsg  : TSocketIOMsg read FOnSocketIOMsg  write FOnSocketIOMsg;
+    {$IFDEF SUPEROBJECT}
     property  OnSocketIOJson : TSocketIOMsgJSON read FOnSocketIOJson write FOnSocketIOJson;
+    {$ENDIF}
 
     procedure OnEvent     (const aEventName: string; const aCallback: TSocketIOEvent);
     procedure OnConnection(const aCallback: TSocketIONotify);
@@ -228,15 +252,29 @@ type
   TIdSocketIOHandling = class(TIdBaseSocketIOHandling)
   public
     procedure Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
+    procedure Emit(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
+    {$IFDEF SUPEROBJECT}
     procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
     function  EmitSync(const aEventName: string; const aData: ISuperObject; aMaxwait_ms: Cardinal = INFINITE): ISuperobject;
     //procedure Emit(const aEventName: string; const aData: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
+    {$ENDIF}
   end;
 
+{$IFNDEF SUPEROBJECT}
+function SO(const S:string):string; inline;
+{$ENDIF}
+
 implementation
 
 uses
-  StrUtils, IdServerWebsocketContext, IdHTTPWebsocketClient, Windows;
+  IdServerWebsocketContext,  IdHTTPWebsocketClient;
+
+{$IFNDEF SUPEROBJECT}
+function SO(const S:string):string; inline;
+begin
+  Result := S;
+end;
+{$ENDIF}
 
 procedure TIdBaseSocketIOHandling.AfterConstruction;
 begin
@@ -502,8 +540,7 @@ begin
   FOnDisconnectList.Add(aCallback);
 end;
 
-procedure TIdBaseSocketIOHandling.OnEvent(const aEventName: string;
+procedure TIdBaseSocketIOHandling.OnEvent(const aEventName: string;  const aCallback: TSocketIOEvent);
-  const aCallback: TSocketIOEvent);
 var list: TSocketIOEventList;
 begin
   if not FOnEventList.TryGetValue(aEventName, list) then
@@ -523,26 +560,86 @@ begin
     TSocketIOContext(ASocket).FContext.Connection.Disconnect;
 end;
 
-procedure TIdBaseSocketIOHandling.ProcessEvent(
+procedure TIdBaseSocketIOHandling.ProcessEvent(const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer;aHasCallback: Boolean);
-  const AContext: ISocketIOContext; const aText: string; aMsgNr: Integer;
-  aHasCallback: Boolean);
 var
-  json: ISuperObject;
   name: string;
+  {$IFNDEF SUPEROBJECT}
+  args: string;
+  {$ELSE}
   args: TSuperArray;
+  json: ISuperObject;
+  //  socket: TSocketIOContext;
+  {$ENDIF}
   list: TSocketIOEventList;
   event: TSocketIOEvent;
   callback: ISocketIOCallback;
-//  socket: TSocketIOContext;
+
+  {$IFNDEF SUPEROBJECT}
+  function _GetJsonMember(const aText:string; const iName:string):string;
+  var xs,xe,ctn:Integer;
+  begin
+    // Based on json formated content
+    Result := '';
+    xs := Pos('"'+iName+'"',aText);
+    if xs=0 then Exit;
+    xs := PosEx(':',aText,xs);
+    if xs=0 then Exit;
+    //
+    inc(xs);
+    while (xs<=length(aText)) and (aText[xs] in [' ',#13,#10,#8,#9]) do inc(xs);
+    if xs>=length(aText) then Exit;
+    //
+    if aText[xs]='[' then
+     begin
+       xe := xs+1; ctn := 1;
+       while (xe<=length(aText)) do
+        begin
+          if aText[xe]='[' then inc(ctn);
+          if aText[xe]=']' then dec(ctn);
+          if ctn=0 then break;
+          inc(xe);
+        end;
+       if ctn=0 then
+        Result := Copy(aText,xs,xe-xs+1);
+     end
+     else
+    if aText[xs]='{' then
+     begin
+       xe := xs+1; ctn := 1;
+       while (xe<=length(aText)) do
+        begin
+          if aText[xe]='{' then inc(ctn);
+          if aText[xe]='}' then dec(ctn);
+          if ctn=0 then break;
+          inc(xe);
+        end;
+       if ctn=0 then
+        Result := Copy(aText,xs,xe-xs+1);
+     end
+     else
+    if aText[xs]='"' then
+     begin
+       xe := PosEx('"',aText,xs+1);
+       if xe=0 then Exit;
+       Result := Copy(aText,xs+1,xe-xs-1);
+     end;
+  end;
+  {$ENDIF}
+
 begin
   //'5:' [message id ('+')] ':' [message endpoint] ':' [json encoded event]
   //5::/chat:{"name":"my other event","args":[{"my":"data"}]}
   //5:1+:/chat:{"name":"GetLocations","args":[""]}
+  {$IFNDEF SUPEROBJECT}
+   name := _GetJsonMember(aText,'name');  //"my other event
+   args := _GetJsonMember(aText,'args');  //[{"my":"data"}]
+  {$ELSE}
   json := SO(aText);
-//  args := nil;
+  //  args := nil;
   try
     name := json.S['name'];  //"my other event
     args := json.A['args'];  //[{"my":"data"}]
+  {$ENDIF}
 
     if FOnEventList.TryGetValue(name, list) then
     begin
@@ -563,7 +660,11 @@ begin
             OnEventError(AContext, callback, e)
           else
             if callback <> nil then
+              {$IFNDEF SUPEROBJECT}
+              callback.SendResponse('Error');
+              {$ELSE}
               callback.SendResponse( SO(['Error', SO(['msg', e.message])]).AsJSon );
+              {$ENDIF}
         end;
       finally
         callback := nil;
@@ -571,10 +672,13 @@ begin
     end
     else
       raise EIdSocketIoUnhandledMessage.Create(aText);
+
+  {$IFDEF SUPEROBJECT}
   finally
-//    args.Free;
+//args.Free;
-    json := nil;
+  json := nil;
   end;
+  {$ENDIF}
 end;
 
 procedure TIdBaseSocketIOHandling.ProcessHeatbeatRequest(const ASocket: ISocketIOContext; const aText: string);
@@ -749,7 +853,9 @@ var
   callbackref: TSocketIOCallbackRef;
   callbackobj: ISocketIOCallback;
   errorref: TSocketIOError;
+  {$IFDEF SUPEROBJECT}
   error: ISuperObject;
+  {$ENDIF}
   socket: TSocketIOContext;
 begin
   if ASocket = nil then Exit;
@@ -822,8 +928,12 @@ begin
           except
             on E:Exception do
             begin
+              {$IFDEF SUPEROBJECT}
               if not callbackobj.IsResponseSend then
                 callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon );
+              {$ELSE}
+              //TODO
+              {$ENDIF}
             end;
           end;
         finally
@@ -841,6 +951,7 @@ begin
   //4:1::{"a":"b"}
   else if StartsStr('4:', str) then
   begin
+    {$IFDEF SUPEROBJECT}
     if Assigned(OnSocketIOJson) then
     begin
       if bCallback then
@@ -864,6 +975,7 @@ begin
         OnSocketIOJson(ASocket, SO(sdata), nil); //, imsg, bCallback);
     end
     else
+    {$ENDIF}
       raise EIdSocketIoUnhandledMessage.Create(str);
   end
   //(5) Event
@@ -895,6 +1007,7 @@ begin
     begin
       FSocketIOErrorRef.Remove(imsg);
       //'[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]'
+      {$IFDEF SUPEROBJECT}
       if ContainsText(sdata, '{"Error":') then
       begin
         error := SO(sdata);
@@ -910,6 +1023,7 @@ begin
         FSocketIOEventCallbackRef.Remove(imsg);
         Exit;
       end;
+      {$ENDIF}
     end;
 
     if FSocketIOEventCallback.TryGetValue(imsg, callback) then
@@ -1049,6 +1163,7 @@ begin
   WriteString(ASocket, sresult);
 end;
 
+{$IFDEF SUPEROBJECT}
 function TIdBaseSocketIOHandling.WriteSocketIOEventSync(const ASocket: ISocketIOContext; const aRoom, aEventName,
   aJSONArray: string; aMaxwait_ms: Cardinal = INFINITE): ISuperObject;
 var
@@ -1133,7 +1248,7 @@ begin
     promise.Free;
   end;
 end;
-
+{$ENDIF}
 procedure TIdBaseSocketIOHandling.WriteSocketIOJSON(const ASocket: ISocketIOContext;
   const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
 var
@@ -1290,8 +1405,7 @@ begin
   inherited;
 end;
 
-procedure TSocketIOContext.EmitEvent(const aEventName, aData: string;
+procedure TSocketIOContext.EmitEvent(const aEventName, aData: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
-  const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
 begin
   Assert(FHandling <> nil);
 
@@ -1307,14 +1421,15 @@ begin
   end;
 end;
 
-procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject;
+{$IFDEF SUPEROBJECT}
-  const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
+procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
 begin
   if aData <> nil then
     EmitEvent(aEventName, aData.AsJSon, aCallback, aOnError)
   else
     EmitEvent(aEventName, '', aCallback, aOnError);
 end;
+{$ENDIF}
 
 function TSocketIOContext.GetCustomData: TObject;
 begin
@@ -1383,8 +1498,7 @@ begin
     Result := (FClient as TIdHTTPWebsocketClient).WSResourceName
 end;
 
-procedure TSocketIOContext.Send(const aData: string;
+procedure TSocketIOContext.Send(const aData: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
-  const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
 begin
   if not Assigned(aCallback) then
     FHandling.WriteSocketIOMsg(Self, '', aData)
@@ -1398,6 +1512,7 @@ begin
   end;
 end;
 
+{$IFDEF SUPEROBJECT}
 procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject;
   const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
 begin
@@ -1412,7 +1527,7 @@ begin
       end, aOnError);
   end;
 end;
-
+{$ENDIF}
 procedure TSocketIOContext.ServerContextDestroy(AContext: TIdContext);
 begin
   Self.Context    := nil;
@@ -1521,6 +1636,7 @@ end;
 
 { TIdSocketIOHandling }
 
+{$IFDEF SUPEROBJECT}
 procedure TIdSocketIOHandling.Emit(const aEventName: string;
   const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
 var
@@ -1621,6 +1737,52 @@ begin
 
   Result := WriteSocketIOEventSync(firstcontext, ''{no room}, aEventName, jsonarray, aMaxwait_ms);
 end;
+{$ENDIF}
+
+procedure TIdSocketIOHandling.Emit(const aEventName: string;
+  const aData: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
+var context: ISocketIOContext; isendcount: Integer;
+begin
+  Lock;
+  try
+    isendcount := 0;
+
+    //note: client has single connection?
+    for context in FConnections.Values do
+    begin
+      if context.IsDisconnected then Continue;
+
+      if not Assigned(aCallback) then
+        WriteSocketIOEvent(context, ''{no room}, aEventName, aData, nil, nil)
+      else
+        WriteSocketIOEventRef(context, ''{no room}, aEventName, aData,
+          procedure(const aData: string)
+          begin
+            aCallback(context, SO(aData), nil);
+          end, aOnError);
+      Inc(isendcount);
+    end;
+    for context in FConnectionsGUID.Values do
+    begin
+      if context.IsDisconnected then Continue;
+
+      if not Assigned(aCallback) then
+        WriteSocketIOEvent(context, ''{no room}, aEventName, aData, nil, nil)
+      else
+        WriteSocketIOEventRef(context, ''{no room}, aEventName, aData,
+          procedure(const aData: string)
+          begin
+            aCallback(context, SO(aData), nil);
+          end, aOnError);
+      Inc(isendcount);
+    end;
+
+    if isendcount = 0 then
+      raise EIdSocketIoUnhandledMessage.Create('Cannot emit: no socket.io connections!');
+  finally
+    UnLock;
+  end;
+end;
 
 procedure TIdSocketIOHandling.Send(const aMessage: string;
   const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
@@ -1669,6 +1831,7 @@ begin
   end;
 end;
 
+
 { TSocketIOPromise }
 
 procedure TSocketIOPromise.AfterConstruction;

IdWebsocketServer.pas

@@ -1,16 +1,41 @@
 unit IdWebsocketServer;
-
 interface
-
+{$I wsdefines.pas}
 uses
-  IdServerWebsocketHandling, IdServerSocketIOHandling, IdServerWebsocketContext,
+  Classes
-  IdHTTPServer, IdContext, IdCustomHTTPServer, Classes, IdIOHandlerWebsocket;
+  , IdStreamVCL
+  , IdGlobal
+  , IdWinsock2
+  , IdHTTPServer
+  , IdContext
+  , IdCustomHTTPServer
+  , IdHTTPWebBrokerBridge
+  //
+  , IdIOHandlerWebsocket
+  , IdServerIOHandlerWebsocket
+  , IdServerWebsocketContext
+  , IdServerWebsocketHandling
+  , IdServerSocketIOHandling
+  ;
 
 type
   TWebsocketMessageText = procedure(const AContext: TIdServerWSContext; const aText: string)  of object;
   TWebsocketMessageBin  = procedure(const AContext: TIdServerWSContext; const aData: TStream) of object;
 
+  {$IFDEF WEBSOCKETBRIDGE}
+  TMyIdHttpWebBrokerBridge = class(TidHttpWebBrokerBridge)
+  published
+    property OnCreatePostStream;
+    property OnDoneWithPostStream;
+    property OnCommandGet;
+  end;
+  {$ENDIF}
+
+  {$IFDEF WEBSOCKETBRIDGE}
+  TIdWebsocketServer = class(TMyIdHttpWebBrokerBridge)
+  {$ELSE}
   TIdWebsocketServer = class(TIdHTTPServer)
+  {$ENDIF}
   private
     FSocketIO: TIdServerSocketIOHandling_Ext;
     FOnMessageText: TWebsocketMessageText;
@@ -19,12 +44,13 @@ type
     function GetSocketIO: TIdServerSocketIOHandling;
     procedure SetWriteTimeout(const Value: Integer);
   protected
-    procedure DoCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
+    function WebSocketCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo):boolean;
-     AResponseInfo: TIdHTTPResponseInfo); override;
+    procedure DoCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); override;
     procedure ContextCreated(AContext: TIdContext); override;
     procedure ContextDisconnected(AContext: TIdContext); override;
 
-    procedure WebsocketChannelRequest(const AContext: TIdServerWSContext; aType: TWSDataType; const aStrmRequest, aStrmResponse: TMemoryStream);
+    procedure WebsocketUpgradeRequest(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean); virtual;
+    procedure WebsocketChannelRequest(const AContext: TIdServerWSContext; var aType:TWSDataType; const aStrmRequest, aStrmResponse: TMemoryStream); virtual;
   public
     procedure  AfterConstruction; override;
     destructor Destroy; override;
@@ -42,9 +68,6 @@ type
 
 implementation
 
-uses
-  IdServerIOHandlerWebsocket, IdStreamVCL, IdGlobal, Windows, IdWinsock2;
-
 { TIdWebsocketServer }
 
 procedure TIdWebsocketServer.AfterConstruction;
@@ -82,13 +105,20 @@ begin
   FSocketIO.Free;
 end;
 
-procedure TIdWebsocketServer.DoCommandGet(AContext: TIdContext;
+function TIdWebsocketServer.WebSocketCommandGet(AContext: TIdContext;
-  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
+  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo):boolean;
 begin
+  (AContext as TIdServerWSContext).OnWebSocketUpgrade := Self.WebSocketUpgradeRequest;
   (AContext as TIdServerWSContext).OnCustomChannelExecute := Self.WebsocketChannelRequest;
   (AContext as TIdServerWSContext).SocketIO               := FSocketIO;
 
-  if not TIdServerWebsocketHandling.ProcessServerCommandGet(AContext as TIdServerWSContext, ARequestInfo, AResponseInfo) then
+  Result := TIdServerWebsocketHandling.ProcessServerCommandGet(AContext as TIdServerWSContext, ARequestInfo, AResponseInfo);
+end;
+
+procedure TIdWebsocketServer.DoCommandGet(AContext: TIdContext;
+  ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
+begin
+  if not WebSocketCommandGet(AContext,ARequestInfo,AResponseInfo) then
     inherited DoCommandGet(AContext, ARequestInfo, AResponseInfo);
 end;
 
@@ -124,9 +154,12 @@ begin
   FWriteTimeout := Value;
 end;
 
-procedure TIdWebsocketServer.WebsocketChannelRequest(
+procedure TIdWebsocketServer.WebsocketUpgradeRequest(const AContext: TIdServerWSContext; ARequestInfo: TIdHTTPRequestInfo; var Accept:boolean);
-  const AContext: TIdServerWSContext; aType: TWSDataType; const aStrmRequest,
+begin
-  aStrmResponse: TMemoryStream);
+  Accept := True;
+end;
+
+procedure TIdWebsocketServer.WebsocketChannelRequest(const AContext: TIdServerWSContext; var aType:TWSDataType; const aStrmRequest,aStrmResponse: TMemoryStream);
 var s: string;
 begin
   if aType = wdtText then

README.md

@@ -1,3 +1,10 @@
+# Not active anymore
+Unfortunately I don't have time to support this project anymore. Also the websocket protocol has changed in the meantime, so it won't work with browser and other modern implementations. 
+
+Please take a look at the free (but closed) 3rd party component:
+* http://www.esegece.com/websockets/download
+* http://www.esegece.com/download/sgcWebSockets_free.zip
+
 # DelphiWebsockets
 Websockets and Socket.io for Delphi
 

wsdefines.pas

@@ -0,0 +1,3 @@
+{ $DEFINE WEBSOCKETSSL}
+{ $DEFINE WEBSOCKETBRIDGE}
+{$DEFINE SUPEROBJECT}