DelphiWebsockets/IdServerSocketIOHandling.pas

unit IdServerSocketIOHandling;

interface

uses
  IdContext, IdCustomTCPServer,
  //IdServerWebsocketContext,
  Classes, Generics.Collections,
  superobject, IdException, IdServerBaseHandling, IdSocketIOHandling;

type
  TIdServerSocketIOHandling = class(TIdBaseSocketIOHandling)
  protected
    procedure ProcessHeatbeatRequest(const AContext: ISocketIOContext; const aText: string); override;
  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;
                             const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
    procedure EmitEventTo   (const aContext: TIdServerContext;
                             const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
  end;

implementation

uses
  SysUtils, StrUtils;

{ TIdServerSocketIOHandling }

procedure TIdServerSocketIOHandling.EmitEventTo(
  const aContext: ISocketIOContext; const aEventName: string;
  const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var
  jsonarray: string;
begin
  if aContext.IsDisconnected then
    raise EIdSocketIoUnhandledMessage.Create('socket.io connection closed!');

  if aData.IsType(stArray) then
    jsonarray := aData.AsString
  else if aData.IsType(stString) then
    jsonarray := '["' + aData.AsString + '"]'
  else
    jsonarray := '[' + aData.AsString + ']';

  if not Assigned(aCallback) then
    WriteSocketIOEvent(aContext, ''{no room}, aEventName, jsonarray, nil, nil)
  else
    WriteSocketIOEventRef(aContext, ''{no room}, aEventName, jsonarray,
      procedure(const aData: string)
      begin
        aCallback(aContext, SO(aData), nil);
      end, aOnError);
end;

procedure TIdServerSocketIOHandling.EmitEventTo(
  const aContext: TIdServerContext; const aEventName: string;
  const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
var
  context: ISocketIOContext;
begin
  Lock;
  try
    context := FConnections.Items[aContext];
    EmitEventTo(context, aEventName, aData, aCallback, aOnError);
  finally
    UnLock;
  end;
end;

function TIdServerSocketIOHandling.EmitEventToAll(const aEventName,
  aData: string; const aCallback: TSocketIOMsgJSON;
  const aOnError: TSocketIOError): Integer;
var
  context: ISocketIOContext;
  jsonarray: string;
begin
  Result := 0;
  jsonarray := '[' + aData + ']';

  Lock;
  try
    for context in FConnections.Values do
    begin
      if context.IsDisconnected then Continue;

      try
        if not Assigned(aCallback) then
          WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
        else
          WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
            procedure(const aData: string)
            begin
              aCallback(context, SO(aData), nil);
            end, aOnError);
      except
        //try to send to others
      end;
      Inc(Result);
    end;
    for context in FConnectionsGUID.Values do
    begin
      if context.IsDisconnected then Continue;

      try
        if not Assigned(aCallback) then
          WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
        else
          WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
            procedure(const aData: string)
            begin
              aCallback(context, SO(aData), nil);
            end, aOnError);
      except
        //try to send to others
      end;
      Inc(Result);
    end;
  finally
    UnLock;
  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
  context: ISocketIOContext;
begin
  Lock;
  try
    context := FConnections.Items[aContext];
    if context.IsDisconnected then
      raise EIdSocketIoUnhandledMessage.Create('socket.io connection closed!');

    if not Assigned(aCallback) then
      WriteSocketIOMsg(context, ''{no room}, aMessage, nil)
    else
      WriteSocketIOMsg(context, ''{no room}, aMessage,
        procedure(const aData: string)
        begin
          aCallback(context, SO(aData), nil);
        end, aOnError);
  finally
    UnLock;
  end;
end;

function TIdServerSocketIOHandling.SendToAll(const aMessage: string;
  const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
var
  context: ISocketIOContext;
begin
  Result := 0;
  Lock;
  try
    for context in FConnections.Values do
    begin
      if context.IsDisconnected then Continue;

      if not Assigned(aCallback) then
        WriteSocketIOMsg(context, ''{no room}, aMessage, nil)
      else
        WriteSocketIOMsg(context, ''{no room}, aMessage,
          procedure(const aData: string)
          begin
            aCallback(context, SO(aData), nil);
          end, aOnError);
      Inc(Result);
    end;
    for context in FConnectionsGUID.Values do
    begin
      if context.IsDisconnected then Continue;

      if not Assigned(aCallback) then
        WriteSocketIOMsg(context, ''{no room}, aMessage, nil)
      else
        WriteSocketIOMsg(context, ''{no room}, aMessage,
          procedure(const aData: string)
          begin
            aCallback(context, SO(aData), nil);
          end);
      Inc(Result);
    end;
  finally
    UnLock;
  end;
end;

end.