DelphiWebsockets/IdServerSocketIOHandling.pas

208 lines
6.5 KiB
ObjectPascal

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.