error handling and unit test
This commit is contained in:
parent
cb2855115f
commit
be087753c5
22
.gitattributes
vendored
Normal file
22
.gitattributes
vendored
Normal file
|
@ -0,0 +1,22 @@
|
|||
# Auto detect text files and perform LF normalization
|
||||
* text=auto
|
||||
|
||||
# Custom for Visual Studio
|
||||
*.cs diff=csharp
|
||||
*.sln merge=union
|
||||
*.csproj merge=union
|
||||
*.vbproj merge=union
|
||||
*.fsproj merge=union
|
||||
*.dbproj merge=union
|
||||
|
||||
# Standard to msysgit
|
||||
*.doc diff=astextplain
|
||||
*.DOC diff=astextplain
|
||||
*.docx diff=astextplain
|
||||
*.DOCX diff=astextplain
|
||||
*.dot diff=astextplain
|
||||
*.DOT diff=astextplain
|
||||
*.pdf diff=astextplain
|
||||
*.PDF diff=astextplain
|
||||
*.rtf diff=astextplain
|
||||
*.RTF diff=astextplain
|
220
.gitignore
vendored
Normal file
220
.gitignore
vendored
Normal file
|
@ -0,0 +1,220 @@
|
|||
#################
|
||||
## Eclipse
|
||||
#################
|
||||
|
||||
*.pydevproject
|
||||
.project
|
||||
.metadata
|
||||
bin/
|
||||
tmp/
|
||||
*.tmp
|
||||
*.bak
|
||||
*.swp
|
||||
*~.nib
|
||||
local.properties
|
||||
.classpath
|
||||
.settings/
|
||||
.loadpath
|
||||
|
||||
dcu/
|
||||
*.dproj
|
||||
*.local
|
||||
*.skincfg
|
||||
|
||||
# External tool builders
|
||||
.externalToolBuilders/
|
||||
|
||||
# Locally stored "Eclipse launch configurations"
|
||||
*.launch
|
||||
|
||||
# CDT-specific
|
||||
.cproject
|
||||
|
||||
# PDT-specific
|
||||
.buildpath
|
||||
|
||||
|
||||
#################
|
||||
## Visual Studio
|
||||
#################
|
||||
|
||||
## Ignore Visual Studio temporary files, build results, and
|
||||
## files generated by popular Visual Studio add-ons.
|
||||
|
||||
# User-specific files
|
||||
*.suo
|
||||
*.user
|
||||
*.sln.docstates
|
||||
|
||||
# Build results
|
||||
|
||||
[Dd]ebug/
|
||||
[Rr]elease/
|
||||
x64/
|
||||
build/
|
||||
[Bb]in/
|
||||
[Oo]bj/
|
||||
|
||||
# MSTest test Results
|
||||
[Tt]est[Rr]esult*/
|
||||
[Bb]uild[Ll]og.*
|
||||
|
||||
*_i.c
|
||||
*_p.c
|
||||
*.ilk
|
||||
*.meta
|
||||
*.obj
|
||||
*.pch
|
||||
*.pdb
|
||||
*.pgc
|
||||
*.pgd
|
||||
*.rsp
|
||||
*.sbr
|
||||
*.tlb
|
||||
*.tli
|
||||
*.tlh
|
||||
*.tmp
|
||||
*.tmp_proj
|
||||
*.log
|
||||
*.vspscc
|
||||
*.vssscc
|
||||
.builds
|
||||
*.pidb
|
||||
*.log
|
||||
*.scc
|
||||
|
||||
# Visual C++ cache files
|
||||
ipch/
|
||||
*.aps
|
||||
*.ncb
|
||||
*.opensdf
|
||||
*.sdf
|
||||
*.cachefile
|
||||
|
||||
# Visual Studio profiler
|
||||
*.psess
|
||||
*.vsp
|
||||
*.vspx
|
||||
|
||||
# Guidance Automation Toolkit
|
||||
*.gpState
|
||||
|
||||
# ReSharper is a .NET coding add-in
|
||||
_ReSharper*/
|
||||
*.[Rr]e[Ss]harper
|
||||
|
||||
# TeamCity is a build add-in
|
||||
_TeamCity*
|
||||
|
||||
# DotCover is a Code Coverage Tool
|
||||
*.dotCover
|
||||
|
||||
# NCrunch
|
||||
*.ncrunch*
|
||||
.*crunch*.local.xml
|
||||
|
||||
# Installshield output folder
|
||||
[Ee]xpress/
|
||||
|
||||
# DocProject is a documentation generator add-in
|
||||
DocProject/buildhelp/
|
||||
DocProject/Help/*.HxT
|
||||
DocProject/Help/*.HxC
|
||||
DocProject/Help/*.hhc
|
||||
DocProject/Help/*.hhk
|
||||
DocProject/Help/*.hhp
|
||||
DocProject/Help/Html2
|
||||
DocProject/Help/html
|
||||
|
||||
# Click-Once directory
|
||||
publish/
|
||||
|
||||
# Publish Web Output
|
||||
*.Publish.xml
|
||||
*.pubxml
|
||||
|
||||
# NuGet Packages Directory
|
||||
## TODO: If you have NuGet Package Restore enabled, uncomment the next line
|
||||
#packages/
|
||||
|
||||
# Windows Azure Build Output
|
||||
csx
|
||||
*.build.csdef
|
||||
|
||||
# Windows Store app package directory
|
||||
AppPackages/
|
||||
|
||||
# Others
|
||||
sql/
|
||||
*.Cache
|
||||
ClientBin/
|
||||
[Ss]tyle[Cc]op.*
|
||||
~$*
|
||||
*~
|
||||
*.dbmdl
|
||||
*.[Pp]ublish.xml
|
||||
*.pfx
|
||||
*.publishsettings
|
||||
|
||||
# RIA/Silverlight projects
|
||||
Generated_Code/
|
||||
|
||||
# Backup & report files from converting an old project file to a newer
|
||||
# Visual Studio version. Backup files are not needed, because we have git ;-)
|
||||
_UpgradeReport_Files/
|
||||
Backup*/
|
||||
UpgradeLog*.XML
|
||||
UpgradeLog*.htm
|
||||
|
||||
# SQL Server files
|
||||
App_Data/*.mdf
|
||||
App_Data/*.ldf
|
||||
|
||||
#############
|
||||
## Windows detritus
|
||||
#############
|
||||
|
||||
# Windows image file caches
|
||||
Thumbs.db
|
||||
ehthumbs.db
|
||||
|
||||
# Folder config file
|
||||
Desktop.ini
|
||||
|
||||
# Recycle Bin used on file shares
|
||||
$RECYCLE.BIN/
|
||||
|
||||
# Mac crap
|
||||
.DS_Store
|
||||
|
||||
|
||||
#############
|
||||
## Python
|
||||
#############
|
||||
|
||||
*.py[co]
|
||||
|
||||
# Packages
|
||||
*.egg
|
||||
*.egg-info
|
||||
dist/
|
||||
build/
|
||||
eggs/
|
||||
parts/
|
||||
var/
|
||||
sdist/
|
||||
develop-eggs/
|
||||
.installed.cfg
|
||||
|
||||
# Installer logs
|
||||
pip-log.txt
|
||||
|
||||
# Unit test / coverage reports
|
||||
.coverage
|
||||
.tox
|
||||
|
||||
#Translations
|
||||
*.mo
|
||||
|
||||
#Mr Developer
|
||||
.mr.developer.cfg
|
135
DUnit/NewLibrary_Intf.pas
Normal file
135
DUnit/NewLibrary_Intf.pas
Normal file
|
@ -0,0 +1,135 @@
|
|||
unit NewLibrary_Intf;
|
||||
|
||||
{----------------------------------------------------------------------------}
|
||||
{ This unit was automatically generated by the RemObjects SDK after reading }
|
||||
{ the RODL file associated with this project . }
|
||||
{ }
|
||||
{ Do not modify this unit manually, or your changes will be lost when this }
|
||||
{ unit is regenerated the next time you compile the project. }
|
||||
{----------------------------------------------------------------------------}
|
||||
|
||||
{$I RemObjects.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{vcl:} Classes, TypInfo,
|
||||
{RemObjects:} uROXMLIntf, uROClasses, uROClient, uROTypes, uROClientIntf;
|
||||
|
||||
const
|
||||
//RBK modification: storing timestamp of generation, to be able to check version mismatch between client and server
|
||||
//RBK modification, done in: "\Lib\Componenten\RemObjects SDK for Delphi\Source\CodeGen\uRODLToPascalIntf.pas"
|
||||
C_GenerateDateTime = '18-09-2013 15:29:06:712 by amussche';
|
||||
|
||||
const
|
||||
{ Library ID }
|
||||
LibraryUID = '{37BBB078-915E-4B4D-B5CB-FD43C7359A58}';
|
||||
TargetNamespace = '';
|
||||
|
||||
{ Service Interface ID's }
|
||||
INewService_IID : TGUID = '{5C59475D-E65E-4634-998F-B2DE324E381B}';
|
||||
|
||||
type
|
||||
TSeekOrigin = Classes.TSeekOrigin; // fake declaration
|
||||
{ Forward declarations }
|
||||
INewService = interface;
|
||||
|
||||
|
||||
{ INewService }
|
||||
INewService = interface
|
||||
['{5C59475D-E65E-4634-998F-B2DE324E381B}']
|
||||
function Sum(const a: Integer; const b: Integer): Integer;
|
||||
function LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer;
|
||||
end;
|
||||
|
||||
{ CoNewService }
|
||||
CoNewService = class
|
||||
class function Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): INewService;
|
||||
end;
|
||||
|
||||
{ TNewService_Proxy }
|
||||
TNewService_Proxy = class(TROProxy, INewService)
|
||||
protected
|
||||
function __GetInterfaceName:string; override;
|
||||
|
||||
function Sum(const a: Integer; const b: Integer): Integer;
|
||||
function LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{vcl:} SysUtils,
|
||||
{RemObjects:} uROEventRepository, uROSerializer, uRORes;
|
||||
|
||||
{ CoNewService }
|
||||
|
||||
class function CoNewService.Create(const aMessage: IROMessage; aTransportChannel: IROTransportChannel): INewService;
|
||||
begin
|
||||
Result := TNewService_Proxy.Create(aMessage, aTransportChannel);
|
||||
end;
|
||||
|
||||
{ TNewService_Proxy }
|
||||
|
||||
function TNewService_Proxy.__GetInterfaceName:string;
|
||||
begin
|
||||
Result := 'NewService';
|
||||
end;
|
||||
|
||||
function TNewService_Proxy.Sum(const a: Integer; const b: Integer): Integer;
|
||||
var
|
||||
lMessage: IROMessage;
|
||||
lTransportChannel: IROTransportChannel;
|
||||
begin
|
||||
lMessage := __GetMessage;
|
||||
lTransportChannel := __TransportChannel;
|
||||
try
|
||||
lMessage.InitializeRequestMessage(lTransportChannel, 'NewLibrary', __InterfaceName, 'Sum');
|
||||
lMessage.Write('a', TypeInfo(Integer), a, []);
|
||||
lMessage.Write('b', TypeInfo(Integer), b, []);
|
||||
lMessage.Finalize;
|
||||
|
||||
lTransportChannel.Dispatch(lMessage);
|
||||
|
||||
lMessage.Read('Result', TypeInfo(Integer), Result, []);
|
||||
finally
|
||||
lMessage.UnsetAttributes(lTransportChannel);
|
||||
lMessage.FreeStream;
|
||||
lMessage := nil;
|
||||
lTransportChannel := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TNewService_Proxy.LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer;
|
||||
var
|
||||
lMessage: IROMessage;
|
||||
lTransportChannel: IROTransportChannel;
|
||||
begin
|
||||
lMessage := __GetMessage;
|
||||
lTransportChannel := __TransportChannel;
|
||||
try
|
||||
lMessage.InitializeRequestMessage(lTransportChannel, 'NewLibrary', __InterfaceName, 'LongDurationIntermediateSocketIOResults');
|
||||
lMessage.Write('aDuration_ms', TypeInfo(Integer), aDuration_ms, []);
|
||||
lMessage.Write('aSleep_ms', TypeInfo(Integer), aSleep_ms, []);
|
||||
lMessage.Finalize;
|
||||
|
||||
lTransportChannel.Dispatch(lMessage);
|
||||
|
||||
lMessage.Read('Result', TypeInfo(Integer), Result, []);
|
||||
finally
|
||||
lMessage.UnsetAttributes(lTransportChannel);
|
||||
lMessage.FreeStream;
|
||||
lMessage := nil;
|
||||
lTransportChannel := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterProxyClass(INewService_IID, TNewService_Proxy);
|
||||
|
||||
|
||||
finalization
|
||||
UnregisterProxyClass(INewService_IID);
|
||||
|
||||
|
||||
end.
|
90
DUnit/NewLibrary_Invk.pas
Normal file
90
DUnit/NewLibrary_Invk.pas
Normal file
|
@ -0,0 +1,90 @@
|
|||
unit NewLibrary_Invk;
|
||||
|
||||
{----------------------------------------------------------------------------}
|
||||
{ This unit was automatically generated by the RemObjects SDK after reading }
|
||||
{ the RODL file associated with this project . }
|
||||
{ }
|
||||
{ Do not modify this unit manually, or your changes will be lost when this }
|
||||
{ unit is regenerated the next time you compile the project. }
|
||||
{----------------------------------------------------------------------------}
|
||||
|
||||
{$I RemObjects.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{vcl:} Classes,
|
||||
{RemObjects:} uROXMLIntf, uROServer, uROServerIntf, uROTypes, uROClientIntf,
|
||||
{Generated:} NewLibrary_Intf;
|
||||
|
||||
type
|
||||
TSeekOrigin = Classes.TSeekOrigin; // fake declaration
|
||||
TNewService_Invoker = class(TROInvoker)
|
||||
private
|
||||
protected
|
||||
public
|
||||
constructor Create; override;
|
||||
published
|
||||
procedure Invoke_Sum(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
|
||||
procedure Invoke_LongDurationIntermediateSocketIOResults(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
{RemObjects:} uRORes, uROClient;
|
||||
|
||||
{ TNewService_Invoker }
|
||||
|
||||
constructor TNewService_Invoker.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FAbstract := False;
|
||||
end;
|
||||
|
||||
procedure TNewService_Invoker.Invoke_Sum(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
|
||||
{ function Sum(const a: Integer; const b: Integer): Integer; }
|
||||
var
|
||||
a: Integer;
|
||||
b: Integer;
|
||||
lResult: Integer;
|
||||
begin
|
||||
try
|
||||
__Message.Read('a', TypeInfo(Integer), a, []);
|
||||
__Message.Read('b', TypeInfo(Integer), b, []);
|
||||
|
||||
lResult := (__Instance as INewService).Sum(a, b);
|
||||
|
||||
__Message.InitializeResponseMessage(__Transport, 'NewLibrary', 'NewService', 'SumResponse');
|
||||
__Message.Write('Result', TypeInfo(Integer), lResult, []);
|
||||
__Message.Finalize;
|
||||
__Message.UnsetAttributes(__Transport);
|
||||
|
||||
finally
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TNewService_Invoker.Invoke_LongDurationIntermediateSocketIOResults(const __Instance:IInterface; const __Message:IROMessage; const __Transport:IROTransport; out __oResponseOptions:TROResponseOptions);
|
||||
{ function LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer; }
|
||||
var
|
||||
aDuration_ms: Integer;
|
||||
aSleep_ms: Integer;
|
||||
lResult: Integer;
|
||||
begin
|
||||
try
|
||||
__Message.Read('aDuration_ms', TypeInfo(Integer), aDuration_ms, []);
|
||||
__Message.Read('aSleep_ms', TypeInfo(Integer), aSleep_ms, []);
|
||||
|
||||
lResult := (__Instance as INewService).LongDurationIntermediateSocketIOResults(aDuration_ms, aSleep_ms);
|
||||
|
||||
__Message.InitializeResponseMessage(__Transport, 'NewLibrary', 'NewService', 'LongDurationIntermediateSocketIOResultsResponse');
|
||||
__Message.Write('Result', TypeInfo(Integer), lResult, []);
|
||||
__Message.Finalize;
|
||||
__Message.UnsetAttributes(__Transport);
|
||||
|
||||
finally
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
end.
|
92
DUnit/NewService_Impl.pas
Normal file
92
DUnit/NewService_Impl.pas
Normal file
|
@ -0,0 +1,92 @@
|
|||
unit NewService_Impl;
|
||||
|
||||
{----------------------------------------------------------------------------}
|
||||
{ This unit was automatically generated by the RemObjects SDK after reading }
|
||||
{ the RODL file associated with this project . }
|
||||
{ }
|
||||
{ This is where you are supposed to code the implementation of your objects. }
|
||||
{----------------------------------------------------------------------------}
|
||||
|
||||
{$I RemObjects.inc}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
{vcl:} Classes, SysUtils,
|
||||
{RemObjects:} uROXMLIntf, uROClientIntf, uROTypes, uROServer, uROServerIntf, uROSessions,
|
||||
{Required:} uRORemoteDataModule,
|
||||
{Generated:} NewLibrary_Intf;
|
||||
|
||||
type
|
||||
{ TNewService }
|
||||
TNewService = class(TRORemoteDataModule,
|
||||
INewService)
|
||||
private
|
||||
protected
|
||||
{ INewService methods }
|
||||
function Sum(const a: Integer; const b: Integer): Integer;
|
||||
function LongDurationIntermediateSocketIOResults(const aDuration_ms: Integer; const aSleep_ms: Integer): Integer;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{$IFDEF DELPHIXE2UP}
|
||||
{%CLASSGROUP 'System.Classes.TPersistent'}
|
||||
{$ENDIF}
|
||||
|
||||
{$IFNDEF FPC}
|
||||
{$R *.dfm}
|
||||
{$ELSE}
|
||||
{$R *.lfm}
|
||||
{$ENDIF}
|
||||
uses
|
||||
{Generated:} NewLibrary_Invk, DateUtils, uROHTTPWebsocketServer,
|
||||
IdServerSocketIOHandling;
|
||||
|
||||
procedure Create_NewService(out anInstance : IUnknown);
|
||||
begin
|
||||
anInstance := TNewService.Create(nil);
|
||||
end;
|
||||
|
||||
var
|
||||
fClassFactory: IROClassFactory;
|
||||
{ TNewService }
|
||||
|
||||
function TNewService.LongDurationIntermediateSocketIOResults(const aDuration_ms,
|
||||
aSleep_ms: Integer): Integer;
|
||||
var
|
||||
tstart: TDateTime;
|
||||
ctx: TROTransportContext;
|
||||
iCounter: Integer;
|
||||
begin
|
||||
tstart := Now;
|
||||
iCounter := 0;
|
||||
while MilliSecondsBetween(Now, tstart) < aDuration_ms do
|
||||
begin
|
||||
//send intermediate (!) response to client back (for progress etc)
|
||||
Assert(Transport is TROTransportContext);
|
||||
ctx := Transport as TROTransportContext;
|
||||
Inc(iCounter);
|
||||
if ctx.Context.IsSocketIO then
|
||||
ctx.Context.SocketIO.SendTo(ctx.Context, IntToStr(iCounter));
|
||||
|
||||
Sleep(aSleep_ms);
|
||||
end;
|
||||
|
||||
Result := iCounter;
|
||||
end;
|
||||
|
||||
function TNewService.Sum(const a, b: Integer): Integer;
|
||||
begin
|
||||
Result := a + b;
|
||||
end;
|
||||
|
||||
initialization
|
||||
fClassFactory := TROClassFactory.Create('NewService', {$IFDEF FPC}@{$ENDIF}Create_NewService, TNewService_Invoker);
|
||||
// RegisterForZeroConf(fClassFactory,'_NewService_rosdk._tcp.');
|
||||
|
||||
finalization
|
||||
UnRegisterClassFactory(fClassFactory);
|
||||
fClassFactory := nil;
|
||||
|
||||
end.
|
31
DUnit/UnitTestWebsockets.dpr
Normal file
31
DUnit/UnitTestWebsockets.dpr
Normal file
|
@ -0,0 +1,31 @@
|
|||
program UnitTestWebsockets;
|
||||
{
|
||||
|
||||
Delphi DUnit Test Project
|
||||
-------------------------
|
||||
This project contains the DUnit test framework and the GUI/Console test runners.
|
||||
Add "CONSOLE_TESTRUNNER" to the conditional defines entry in the project options
|
||||
to use the console test runner. Otherwise the GUI test runner will be used by
|
||||
default.
|
||||
|
||||
}
|
||||
|
||||
{$IFDEF CONSOLE_TESTRUNNER}
|
||||
{$APPTYPE CONSOLE}
|
||||
{$ENDIF}
|
||||
|
||||
{$R *.RES}
|
||||
|
||||
uses
|
||||
DUnitTestRunner,
|
||||
TestFramework,
|
||||
mtTestWebSockets in 'mtTestWebSockets.pas',
|
||||
IdHTTPWebsocketClient in '..\IdHTTPWebsocketClient.pas',
|
||||
superobject in '..\superobject\superobject.pas';
|
||||
|
||||
begin
|
||||
RegisterTest(TTestWebSockets.Suite);
|
||||
|
||||
DUnitTestRunner.RunRegisteredTests;
|
||||
end.
|
||||
|
BIN
DUnit/UnitTestWebsockets.res
Normal file
BIN
DUnit/UnitTestWebsockets.res
Normal file
Binary file not shown.
292
DUnit/mtTestROWebSockets.pas
Normal file
292
DUnit/mtTestROWebSockets.pas
Normal file
|
@ -0,0 +1,292 @@
|
|||
unit mtTestROWebSockets;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
TestFramework, NewLibrary_Intf,
|
||||
uROIndyHTTPWebsocketChannel, uROHTTPWebsocketServer,
|
||||
uROJSONMessage, uRORemoteService, IdHTTPWebsocketClient,
|
||||
IdServerWebsocketContext;
|
||||
|
||||
type
|
||||
TTextCallback = reference to procedure(aText: string);
|
||||
|
||||
TTestROWebSockets = class(TTestCase)
|
||||
private
|
||||
class var ROIndyHTTPWebsocketServer1: TROIndyHTTPWebsocketServer;
|
||||
class var ROIndyHTTPWebsocketChannel1: TROIndyHTTPWebsocketChannel;
|
||||
class var ROJSONMessage1: TROJSONMessage;
|
||||
class var RORemoteService1: TRORemoteService;
|
||||
protected
|
||||
FLastSocketIOMsg: string;
|
||||
public
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
published
|
||||
procedure CreateObjects;
|
||||
|
||||
procedure StartRO;
|
||||
procedure TestSum;
|
||||
procedure TestIntermediateProgress;
|
||||
|
||||
procedure DestroyObjects;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
NewService_Impl, SysUtils, IdSocketIOHandling, superobject;
|
||||
|
||||
{ TTestROWebSockets }
|
||||
|
||||
procedure TTestROWebSockets.SetUp;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
//procedure TTestROWebSockets.SocketIOMsgClient(
|
||||
// const AClient: TIdHTTPWebsocketClient; const aText: string; aMsgNr: Integer);
|
||||
//begin
|
||||
// FLastSocketIOMsg := aText;
|
||||
// if Assigned(FOnSocketIOMsg) then
|
||||
// FOnSocketIOMsg(aText);
|
||||
//end;
|
||||
|
||||
//procedure TTestROWebSockets.SocketIOMsgServer(
|
||||
// const AContext: TIdServerWSContext; const aText: string; aMsgNr: Integer;
|
||||
// aHasCallback: Boolean);
|
||||
//begin
|
||||
// FLastSocketIOMsg := aText;
|
||||
// if aHasCallback then
|
||||
// AContext.IOHandler.WriteSocketIOResult(aMsgNr, '', aText);
|
||||
//end;
|
||||
|
||||
procedure TTestROWebSockets.TearDown;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TTestROWebSockets.CreateObjects;
|
||||
begin
|
||||
ROIndyHTTPWebsocketServer1 := TROIndyHTTPWebsocketServer.Create(nil);
|
||||
ROIndyHTTPWebsocketServer1.Port := 8099;
|
||||
ROIndyHTTPWebsocketServer1.KeepAlive := True;
|
||||
ROIndyHTTPWebsocketServer1.DisableNagle := True;
|
||||
//SendClientAccessPolicyXml = captAllowAll
|
||||
//SendCrossOriginHeader = True
|
||||
|
||||
ROIndyHTTPWebsocketChannel1 := TROIndyHTTPWebsocketChannel.Create(nil);
|
||||
ROIndyHTTPWebsocketChannel1.Port := 8099;
|
||||
ROIndyHTTPWebsocketChannel1.Host := '127.0.0.1';
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIOCompatible := True;
|
||||
|
||||
ROJSONMessage1 := TROJSONMessage.Create(nil);
|
||||
|
||||
ROIndyHTTPWebsocketServer1.Dispatchers.Add;
|
||||
ROIndyHTTPWebsocketServer1.Dispatchers[0].Message := ROJSONMessage1;
|
||||
ROIndyHTTPWebsocketServer1.Dispatchers[0].Enabled := True;
|
||||
|
||||
RORemoteService1 := TRORemoteService.Create(nil);
|
||||
RORemoteService1.Channel := ROIndyHTTPWebsocketChannel1;
|
||||
RORemoteService1.Message := ROJSONMessage1;
|
||||
end;
|
||||
|
||||
procedure TTestROWebSockets.DestroyObjects;
|
||||
begin
|
||||
ROIndyHTTPWebsocketServer1.Free;
|
||||
|
||||
RORemoteService1.Free;
|
||||
ROIndyHTTPWebsocketChannel1.Free;
|
||||
ROJSONMessage1.Free;
|
||||
end;
|
||||
|
||||
procedure TTestROWebSockets.StartRO;
|
||||
begin
|
||||
ROIndyHTTPWebsocketServer1.Active := True;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
|
||||
end;
|
||||
|
||||
procedure TTestROWebSockets.TestIntermediateProgress;
|
||||
var
|
||||
iresult: Integer;
|
||||
iprevious: Integer;
|
||||
begin
|
||||
// ROIndyHTTPWebsocketChannel1.IndyClient.OnSocketIOMsg := SocketIOMsgClient;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
var icount: Integer;
|
||||
begin
|
||||
FLastSocketIOMsg := aText;
|
||||
|
||||
icount := StrToInt(aText);
|
||||
//elke keer moet counter met 1 opgehoogd worden!
|
||||
//see NewService_Impl
|
||||
CheckEquals(iprevious+1, icount);
|
||||
iprevious := icount;
|
||||
end;
|
||||
|
||||
FLastSocketIOMsg := '';
|
||||
iprevious := 0;
|
||||
// FOnSocketIOMsg :=
|
||||
// procedure(aText: string)
|
||||
// var icount: Integer;
|
||||
// begin
|
||||
// icount := StrToInt(aText);
|
||||
// elke keer moet counter met 1 opgehoogd worden!
|
||||
// see NewService_Impl
|
||||
// CheckEquals(iprevious+1, icount);
|
||||
// iprevious := icount;
|
||||
// end;
|
||||
|
||||
iresult := (RORemoteService1 as INewService).LongDurationIntermediateSocketIOResults(
|
||||
2*1000, 100);
|
||||
//result = counter, dus moet overeenkomen met laatste callback
|
||||
CheckEquals(iprevious, iresult);
|
||||
end;
|
||||
|
||||
procedure TTestROWebSockets.TestSocketIOCallback;
|
||||
var
|
||||
received: string;
|
||||
begin
|
||||
//* client to server */
|
||||
received := '';
|
||||
ROIndyHTTPWebsocketServer1.SocketIO.OnEvent('TEST_EVENT',
|
||||
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
|
||||
begin
|
||||
received := aArgument.ToJson;
|
||||
end);
|
||||
|
||||
if not ROIndyHTTPWebsocketChannel1.IndyClient.Connected then
|
||||
begin
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.UpgradeToWebsocket;
|
||||
end;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Emit('TEST_EVENT',
|
||||
SO('test event'), nil);
|
||||
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := received <> '';
|
||||
end, 10 * 1000);
|
||||
received := StringReplace(received, #13#10, '', [rfReplaceAll]);
|
||||
CheckEqualsString('["test event"]', received);
|
||||
|
||||
//* server to client */
|
||||
received := '';
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.OnEvent('TEST_EVENT',
|
||||
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
|
||||
begin
|
||||
received := aArgument.ToJson;
|
||||
end);
|
||||
ROIndyHTTPWebsocketServer1.SocketIO.EmitEventToAll('TEST_EVENT',
|
||||
SO('test event'), nil);
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := received <> '';
|
||||
end, 10 * 1000);
|
||||
received := StringReplace(received, #13#10, '', [rfReplaceAll]);
|
||||
CheckEqualsString('["test event"]', received);
|
||||
end;
|
||||
|
||||
procedure TTestROWebSockets.TestSocketIOError;
|
||||
begin
|
||||
//disconnect: mag geen AV's daarna geven!
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.Disconnect(False);
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.UpgradeToWebsocket;
|
||||
|
||||
//* client to server */
|
||||
FLastSocketIOMsg := '';
|
||||
ROIndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
Abort;
|
||||
end;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Send('test message',
|
||||
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
FLastSocketIOMsg := aJSON.AsString;
|
||||
end);
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := FLastSocketIOMsg <> '';
|
||||
end, 10 * 1000);
|
||||
CheckEquals('[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]', FLastSocketIOMsg);
|
||||
|
||||
FLastSocketIOMsg := '';
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Send('test message',
|
||||
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
Assert(False, 'should go to error handling callback');
|
||||
FLastSocketIOMsg := 'error';
|
||||
end,
|
||||
procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string)
|
||||
begin
|
||||
FLastSocketIOMsg := aErrorMessage;
|
||||
end);
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := FLastSocketIOMsg <> '';
|
||||
end, 10 * 1000);
|
||||
CheckEquals('Operation aborted', FLastSocketIOMsg);
|
||||
end;
|
||||
|
||||
procedure TTestROWebSockets.TestSocketIOMsg;
|
||||
begin
|
||||
//disconnect: mag geen AV's daarna geven!
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.Disconnect(False);
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.UpgradeToWebsocket;
|
||||
|
||||
//* client to server */
|
||||
FLastSocketIOMsg := '';
|
||||
ROIndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
FLastSocketIOMsg := aText;
|
||||
end;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Send('test message');
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := FLastSocketIOMsg <> '';
|
||||
end, 10 * 1000);
|
||||
CheckEquals('test message', FLastSocketIOMsg);
|
||||
|
||||
//* server to client */
|
||||
FLastSocketIOMsg := '';
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
FLastSocketIOMsg := aText;
|
||||
end;
|
||||
if ROIndyHTTPWebsocketServer1.SocketIO.SendToAll('test message') = 0 then
|
||||
Check(False, 'nothing send');
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := FLastSocketIOMsg <> '';
|
||||
end, 10 * 1000);
|
||||
CheckEquals('test message', FLastSocketIOMsg);
|
||||
|
||||
//disconnect: mag geen AV's daarna geven!
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.Disconnect(False);
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.Connect;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.UpgradeToWebsocket;
|
||||
ROIndyHTTPWebsocketChannel1.IndyClient.SocketIO.Send('test message');
|
||||
end;
|
||||
|
||||
procedure TTestROWebSockets.TestSum;
|
||||
var
|
||||
iresult: Integer;
|
||||
begin
|
||||
iresult := (RORemoteService1 as INewService).Sum(1,2);
|
||||
CheckEquals(1+2, iresult);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
234
DUnit/mtTestWebSockets.pas
Normal file
234
DUnit/mtTestWebSockets.pas
Normal file
|
@ -0,0 +1,234 @@
|
|||
unit mtTestWebSockets;
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
TestFramework,
|
||||
IdHTTPWebsocketClient, IdServerWebsocketContext, IdWebsocketServer;
|
||||
|
||||
type
|
||||
TTextCallback = reference to procedure(aText: string);
|
||||
|
||||
TTestWebSockets = class(TTestCase)
|
||||
private
|
||||
class var IndyHTTPWebsocketServer1: TIdWebsocketServer;
|
||||
class var IndyHTTPWebsocketClient1: TIdHTTPWebsocketClient;
|
||||
protected
|
||||
FLastSocketIOMsg: string;
|
||||
public
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
published
|
||||
procedure CreateObjects;
|
||||
|
||||
procedure StartServer;
|
||||
|
||||
procedure TestSocketIOMsg;
|
||||
procedure TestSocketIOCallback;
|
||||
procedure TestSocketIOError;
|
||||
|
||||
procedure DestroyObjects;
|
||||
end;
|
||||
|
||||
TBooleanFunction = reference to function: Boolean;
|
||||
function MaxWait(aProc: TBooleanFunction; aMaxWait_msec: Integer): Boolean;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
Windows, Forms, DateUtils, SysUtils, Classes,
|
||||
IdSocketIOHandling, superobject;
|
||||
|
||||
function MaxWait(aProc: TBooleanFunction; aMaxWait_msec: Integer): Boolean;
|
||||
var
|
||||
tStart: TDateTime;
|
||||
begin
|
||||
tStart := Now;
|
||||
|
||||
Result := aProc;
|
||||
while not Result and
|
||||
(MilliSecondsBetween(Now, tStart) <= aMaxWait_msec) do
|
||||
begin
|
||||
Sleep(10);
|
||||
if GetCurrentThreadId = MainThreadID then
|
||||
CheckSynchronize(10);
|
||||
Result := aProc;
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TTestWebSockets }
|
||||
|
||||
procedure TTestWebSockets.SetUp;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TTestWebSockets.TearDown;
|
||||
begin
|
||||
inherited;
|
||||
end;
|
||||
|
||||
procedure TTestWebSockets.CreateObjects;
|
||||
begin
|
||||
IndyHTTPWebsocketServer1 := TIdWebsocketServer.Create(nil);
|
||||
IndyHTTPWebsocketServer1.DefaultPort := 8099;
|
||||
IndyHTTPWebsocketServer1.KeepAlive := True;
|
||||
//IndyHTTPWebsocketServer1.DisableNagle := True;
|
||||
//SendClientAccessPolicyXml = captAllowAll
|
||||
//SendCrossOriginHeader = True
|
||||
|
||||
IndyHTTPWebsocketClient1 := TIdHTTPWebsocketClient.Create(nil);
|
||||
IndyHTTPWebsocketClient1.Host := 'localhost';
|
||||
IndyHTTPWebsocketClient1.Port := 8099;
|
||||
IndyHTTPWebsocketClient1.SocketIOCompatible := True;
|
||||
end;
|
||||
|
||||
procedure TTestWebSockets.DestroyObjects;
|
||||
begin
|
||||
IndyHTTPWebsocketClient1.Free;
|
||||
IndyHTTPWebsocketServer1.Free;
|
||||
end;
|
||||
|
||||
procedure TTestWebSockets.StartServer;
|
||||
begin
|
||||
IndyHTTPWebsocketServer1.Active := True;
|
||||
end;
|
||||
|
||||
procedure TTestWebSockets.TestSocketIOCallback;
|
||||
var
|
||||
received: string;
|
||||
begin
|
||||
//* client to server */
|
||||
received := '';
|
||||
IndyHTTPWebsocketServer1.SocketIO.OnEvent('TEST_EVENT',
|
||||
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
|
||||
begin
|
||||
received := aArgument.ToJson;
|
||||
end);
|
||||
|
||||
if not IndyHTTPWebsocketClient1.Connected then
|
||||
begin
|
||||
IndyHTTPWebsocketClient1.Connect;
|
||||
IndyHTTPWebsocketClient1.UpgradeToWebsocket;
|
||||
end;
|
||||
IndyHTTPWebsocketClient1.SocketIO.Emit('TEST_EVENT',
|
||||
SO('test event'), nil);
|
||||
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := received <> '';
|
||||
end, 10 * 1000);
|
||||
received := StringReplace(received, #13#10, '', [rfReplaceAll]);
|
||||
CheckEqualsString('["test event"]', received);
|
||||
|
||||
//* server to client */
|
||||
received := '';
|
||||
IndyHTTPWebsocketClient1.SocketIO.OnEvent('TEST_EVENT',
|
||||
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj)
|
||||
begin
|
||||
received := aArgument.ToJson;
|
||||
end);
|
||||
IndyHTTPWebsocketServer1.SocketIO.EmitEventToAll('TEST_EVENT',
|
||||
SO('test event'), nil);
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := received <> '';
|
||||
end, 10 * 1000);
|
||||
received := StringReplace(received, #13#10, '', [rfReplaceAll]);
|
||||
CheckEqualsString('["test event"]', received);
|
||||
end;
|
||||
|
||||
procedure TTestWebSockets.TestSocketIOError;
|
||||
begin
|
||||
//disconnect: mag geen AV's daarna geven!
|
||||
IndyHTTPWebsocketClient1.Disconnect(False);
|
||||
IndyHTTPWebsocketClient1.Connect;
|
||||
IndyHTTPWebsocketClient1.UpgradeToWebsocket;
|
||||
|
||||
//* client to server */
|
||||
FLastSocketIOMsg := '';
|
||||
IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
Abort;
|
||||
end;
|
||||
IndyHTTPWebsocketClient1.SocketIO.Send('test message',
|
||||
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
FLastSocketIOMsg := aJSON.AsString;
|
||||
end);
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := FLastSocketIOMsg <> '';
|
||||
end, 10 * 1000);
|
||||
CheckEquals('[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]', FLastSocketIOMsg);
|
||||
|
||||
FLastSocketIOMsg := '';
|
||||
IndyHTTPWebsocketClient1.SocketIO.Send('test message',
|
||||
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
Assert(False, 'should go to error handling callback');
|
||||
FLastSocketIOMsg := 'error';
|
||||
end,
|
||||
procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string)
|
||||
begin
|
||||
FLastSocketIOMsg := aErrorMessage;
|
||||
end);
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := FLastSocketIOMsg <> '';
|
||||
end, 10 * 1000);
|
||||
CheckEquals('Operation aborted', FLastSocketIOMsg);
|
||||
end;
|
||||
|
||||
procedure TTestWebSockets.TestSocketIOMsg;
|
||||
begin
|
||||
//disconnect: mag geen AV's daarna geven!
|
||||
IndyHTTPWebsocketClient1.Disconnect(False);
|
||||
IndyHTTPWebsocketClient1.Connect;
|
||||
IndyHTTPWebsocketClient1.UpgradeToWebsocket;
|
||||
|
||||
//* client to server */
|
||||
FLastSocketIOMsg := '';
|
||||
IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
FLastSocketIOMsg := aText;
|
||||
end;
|
||||
IndyHTTPWebsocketClient1.SocketIO.Send('test message');
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := FLastSocketIOMsg <> '';
|
||||
end, 10 * 1000);
|
||||
CheckEquals('test message', FLastSocketIOMsg);
|
||||
|
||||
//* server to client */
|
||||
FLastSocketIOMsg := '';
|
||||
IndyHTTPWebsocketClient1.SocketIO.OnSocketIOMsg :=
|
||||
procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: TSocketIOCallbackObj)
|
||||
begin
|
||||
FLastSocketIOMsg := aText;
|
||||
end;
|
||||
if IndyHTTPWebsocketServer1.SocketIO.SendToAll('test message') = 0 then
|
||||
Check(False, 'nothing send');
|
||||
MaxWait(
|
||||
function: Boolean
|
||||
begin
|
||||
Result := FLastSocketIOMsg <> '';
|
||||
end, 10 * 1000);
|
||||
CheckEquals('test message', FLastSocketIOMsg);
|
||||
|
||||
//disconnect: mag geen AV's daarna geven!
|
||||
IndyHTTPWebsocketClient1.Disconnect(False);
|
||||
IndyHTTPWebsocketClient1.Connect;
|
||||
IndyHTTPWebsocketClient1.UpgradeToWebsocket;
|
||||
IndyHTTPWebsocketClient1.SocketIO.Send('test message');
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
@ -4,7 +4,13 @@ interface
|
|||
|
||||
uses
|
||||
Classes,
|
||||
IdHTTP, IdHashSHA1, IdIOHandler,
|
||||
IdHTTP,
|
||||
{$IF CompilerVersion <= 21.0} //D2010
|
||||
IdHashSHA1,
|
||||
{$else}
|
||||
IdHashSHA, //XE3 etc
|
||||
{$IFEND}
|
||||
IdIOHandler,
|
||||
IdIOHandlerWebsocket, ExtCtrls, IdWinsock2, Generics.Collections, SyncObjs,
|
||||
IdSocketIOHandling;
|
||||
|
||||
|
@ -147,8 +153,7 @@ implementation
|
|||
|
||||
uses
|
||||
IdCoderMIME, SysUtils, Math, IdException, IdStackConsts, IdStack,
|
||||
IdStackBSDBase, IdGlobal, Windows, StrUtils, mcBaseNamedThread,
|
||||
mcFinalizationHelper;
|
||||
IdStackBSDBase, IdGlobal, Windows, StrUtils;
|
||||
|
||||
//type
|
||||
// TAnonymousThread = class(TThread)
|
||||
|
@ -187,6 +192,7 @@ begin
|
|||
FHash := TIdHashSHA1.Create;
|
||||
|
||||
IOHandler := TIdIOHandlerWebsocket.Create(nil);
|
||||
IOHandler.UseNagle := False;
|
||||
ManagedIOHandler := True;
|
||||
|
||||
FSocketIO := TIdSocketIOHandling_Ext.Create;
|
||||
|
@ -216,19 +222,16 @@ end;
|
|||
|
||||
procedure TIdHTTPWebsocketClient.AsyncDispatchEvent(const aEvent: string);
|
||||
begin
|
||||
if FSocketIOCompatible then
|
||||
FSocketIO.ProcessSocketIORequest(FSocketIOContext as TSocketIOContext, aEvent)
|
||||
else
|
||||
begin
|
||||
if not Assigned(OnTextData) then Exit;
|
||||
//events during dispatch? channel is busy so offload event dispatching to different thread!
|
||||
TIdWebsocketDispatchThread.Instance.QueueEvent(
|
||||
procedure
|
||||
begin
|
||||
if Assigned(OnTextData) then
|
||||
OnTextData(aEvent);
|
||||
end);
|
||||
end;
|
||||
//if not Assigned(OnTextData) then Exit;
|
||||
//events during dispatch? channel is busy so offload event dispatching to different thread!
|
||||
TIdWebsocketDispatchThread.Instance.QueueEvent(
|
||||
procedure
|
||||
begin
|
||||
if FSocketIOCompatible then
|
||||
FSocketIO.ProcessSocketIORequest(FSocketIOContext as TSocketIOContext, aEvent)
|
||||
else if Assigned(OnTextData) then
|
||||
OnTextData(aEvent);
|
||||
end);
|
||||
end;
|
||||
|
||||
destructor TIdHTTPWebsocketClient.Destroy;
|
||||
|
@ -467,6 +470,10 @@ begin
|
|||
CheckForGracefulDisconnect(True);
|
||||
CheckConnected;
|
||||
Assert(Self.Connected);
|
||||
|
||||
if Response.ResponseCode = 0 then
|
||||
Response.ResponseText := Response.ResponseText;
|
||||
|
||||
if Response.ResponseCode <> 200{ok} then
|
||||
begin
|
||||
aFailedReason := Format('Error while upgrading: "%d: %s"',[ResponseCode, ResponseText]);
|
||||
|
@ -895,9 +902,11 @@ end;
|
|||
|
||||
procedure TIdWebsocketMultiReadThread.BreakSelectWait;
|
||||
var
|
||||
iResult: Integer;
|
||||
//iResult: Integer;
|
||||
LAddr: TSockAddrIn6;
|
||||
begin
|
||||
if FTempHandle = 0 then Exit;
|
||||
|
||||
FillChar(LAddr, SizeOf(LAddr), 0);
|
||||
//Id_IPv4
|
||||
with PSOCKADDR(@LAddr)^ do
|
||||
|
@ -915,17 +924,19 @@ begin
|
|||
//The only(?) other possibility is to make a "socket pair" and send a byte to it,
|
||||
//but this requires a dynamic server socket (which can trigger a firewall
|
||||
//exception/question popup in WindowsXP+)
|
||||
iResult := IdWinsock2.connect(FTempHandle, PSOCKADDR(@LAddr), SIZE_TSOCKADDRIN);
|
||||
//iResult :=
|
||||
IdWinsock2.connect(FTempHandle, PSOCKADDR(@LAddr), SIZE_TSOCKADDRIN);
|
||||
//non blocking socket, so will always result in "would block"!
|
||||
if (iResult <> Id_SOCKET_ERROR) or
|
||||
( (GStack <> nil) and (GStack.WSGetLastError <> WSAEWOULDBLOCK) )
|
||||
then
|
||||
GStack.CheckForSocketError(iResult);
|
||||
// if (iResult <> Id_SOCKET_ERROR) or
|
||||
// ( (GStack <> nil) and (GStack.WSGetLastError <> WSAEWOULDBLOCK) )
|
||||
// then
|
||||
// GStack.CheckForSocketError(iResult);
|
||||
end;
|
||||
|
||||
destructor TIdWebsocketMultiReadThread.Destroy;
|
||||
begin
|
||||
IdWinsock2.closesocket(FTempHandle);
|
||||
FTempHandle := 0;
|
||||
FChannels.Free;
|
||||
inherited;
|
||||
end;
|
||||
|
@ -963,8 +974,7 @@ end;
|
|||
|
||||
class function TIdWebsocketMultiReadThread.Instance: TIdWebsocketMultiReadThread;
|
||||
begin
|
||||
if (FInstance = nil) and
|
||||
not TFinalizationHelper.ApplicationIsTerminating then
|
||||
if (FInstance = nil) then
|
||||
begin
|
||||
FInstance := TIdWebsocketMultiReadThread.Create(True);
|
||||
FInstance.Start;
|
||||
|
@ -1126,6 +1136,7 @@ begin
|
|||
FPendingBreak := False;
|
||||
|
||||
IdWinsock2.closesocket(FTempHandle);
|
||||
FTempHandle := 0;
|
||||
InitSpecialEventSocket;
|
||||
end;
|
||||
|
||||
|
@ -1203,8 +1214,16 @@ class function TIdWebsocketDispatchThread.Instance: TIdWebsocketDispatchThread;
|
|||
begin
|
||||
if FInstance = nil then
|
||||
begin
|
||||
FInstance := TIdWebsocketDispatchThread.Create(True);
|
||||
FInstance.Start;
|
||||
GlobalNameSpace.BeginWrite;
|
||||
try
|
||||
if FInstance = nil then
|
||||
begin
|
||||
FInstance := TIdWebsocketDispatchThread.Create(True);
|
||||
FInstance.Start;
|
||||
end;
|
||||
finally
|
||||
GlobalNameSpace.EndWrite;
|
||||
end;
|
||||
end;
|
||||
Result := FInstance;
|
||||
end;
|
||||
|
@ -1231,7 +1250,8 @@ finalization
|
|||
if TIdWebsocketMultiReadThread.FInstance <> nil then
|
||||
begin
|
||||
TIdWebsocketMultiReadThread.Instance.Terminate;
|
||||
TBaseNamedThread.WaitForThread(TIdWebsocketMultiReadThread.Instance, 5 * 1000);
|
||||
TIdWebsocketMultiReadThread.Instance.WaitFor;
|
||||
// TBaseNamedThread.WaitForThread(TIdWebsocketMultiReadThread.Instance, 5 * 1000);
|
||||
TIdWebsocketMultiReadThread.RemoveInstance;
|
||||
end;
|
||||
|
||||
|
|
|
@ -35,7 +35,7 @@ type
|
|||
FWriteTextToTarget: Boolean;
|
||||
FCloseCodeSend: Boolean;
|
||||
|
||||
function InternalReadDataFromSource(var VBuffer: TIdBytes): Integer;
|
||||
function InternalReadDataFromSource(var VBuffer: TIdBytes; ARaiseExceptionOnTimeout: Boolean): Integer;
|
||||
function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override;
|
||||
function WriteDataToTarget (const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; override;
|
||||
|
||||
|
@ -228,8 +228,10 @@ begin
|
|||
end;
|
||||
|
||||
function TIdIOHandlerWebsocket.InternalReadDataFromSource(
|
||||
var VBuffer: TIdBytes): Integer;
|
||||
var VBuffer: TIdBytes; ARaiseExceptionOnTimeout: Boolean): Integer;
|
||||
begin
|
||||
SetLength(VBuffer, 0);
|
||||
|
||||
CheckForDisconnect;
|
||||
if not Readable(ReadTimeout) or
|
||||
not Opened or
|
||||
|
@ -241,7 +243,10 @@ begin
|
|||
else if not SourceIsAvailable then
|
||||
EIdClosedSocket.Toss(RSStatusDisconnected);
|
||||
GStack.CheckForSocketError(GStack.WSGetLastError); //check for socket error
|
||||
EIdReadTimeout.Toss(RSIdNoDataToRead); //exit, no data can be received
|
||||
if ARaiseExceptionOnTimeout then
|
||||
EIdReadTimeout.Toss(RSIdNoDataToRead) //exit, no data can be received
|
||||
else
|
||||
Exit;
|
||||
end;
|
||||
|
||||
SetLength(VBuffer, RecvBufferSize);
|
||||
|
@ -390,7 +395,8 @@ begin
|
|||
opcodes. *)
|
||||
lFirstDataCode := wdcNone;
|
||||
FMessageStream.Clear;
|
||||
repeat
|
||||
|
||||
repeat
|
||||
//read a single frame
|
||||
iReadCount := ReadFrame(bFIN, bRSV1, bRSV2, bRSV3, lDataCode, iaReadBuffer);
|
||||
if (iReadCount > 0) or
|
||||
|
@ -515,8 +521,10 @@ var
|
|||
while FWSInputBuffer.Size <= iInputPos do
|
||||
begin
|
||||
//FWSInputBuffer.AsString;
|
||||
InternalReadDataFromSource(temp);
|
||||
InternalReadDataFromSource(temp, True);
|
||||
FWSInputBuffer.Write(temp);
|
||||
if FWSInputBuffer.Size <= iInputPos then
|
||||
Sleep(1);
|
||||
end;
|
||||
|
||||
//Self.ReadByte copies all data everytime (because the first byte must be removed) so we use index (much more efficient)
|
||||
|
@ -531,8 +539,10 @@ var
|
|||
begin
|
||||
while FWSInputBuffer.Size < aCount do
|
||||
begin
|
||||
InternalReadDataFromSource(temp);
|
||||
InternalReadDataFromSource(temp, True);
|
||||
FWSInputBuffer.Write(temp);
|
||||
if FWSInputBuffer.Size < aCount then
|
||||
Sleep(1);
|
||||
end;
|
||||
|
||||
FWSInputBuffer.ExtractToBytes(Result, aCount);
|
||||
|
|
|
@ -26,7 +26,10 @@ function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
|
|||
begin
|
||||
Result := inherited Accept(ASocket, AListenerThread, AYarn);
|
||||
if Result <> nil then
|
||||
begin
|
||||
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
|
||||
(Result as TIdIOHandlerWebsocket).UseNagle := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TIdServerIOHandlerWebsocket.InitComponent;
|
||||
|
@ -40,7 +43,10 @@ function TIdServerIOHandlerWebsocket.MakeClientIOHandler(
|
|||
begin
|
||||
Result := inherited MakeClientIOHandler(ATheThread);
|
||||
if Result <> nil then
|
||||
begin
|
||||
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
|
||||
(Result as TIdIOHandlerWebsocket).UseNagle := False;
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
@ -13,14 +13,14 @@ type
|
|||
protected
|
||||
procedure ProcessHeatbeatRequest(const AContext: TSocketIOContext; const aText: string); override;
|
||||
public
|
||||
function SendToAll(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil): Integer;
|
||||
procedure SendTo (const aContext: TIdServerContext; const aMessage: string; const aCallback: TSocketIOMsgJSON = nil);
|
||||
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): Integer;
|
||||
function EmitEventToAll(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil): Integer;
|
||||
procedure EmitEventTo (const aContext: TSocketIOContext;
|
||||
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);overload;
|
||||
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);overload;
|
||||
const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);overload;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
@ -32,7 +32,7 @@ uses
|
|||
|
||||
procedure TIdServerSocketIOHandling.EmitEventTo(
|
||||
const aContext: TSocketIOContext; const aEventName: string;
|
||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON);
|
||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
var
|
||||
jsonarray: string;
|
||||
begin
|
||||
|
@ -47,32 +47,32 @@ begin
|
|||
jsonarray := '[' + aData.AsString + ']';
|
||||
|
||||
if not Assigned(aCallback) then
|
||||
WriteSocketIOEvent(aContext, ''{no room}, aEventName, jsonarray, nil)
|
||||
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);
|
||||
end, aOnError);
|
||||
end;
|
||||
|
||||
procedure TIdServerSocketIOHandling.EmitEventTo(
|
||||
const aContext: TIdServerContext; const aEventName: string;
|
||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON);
|
||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
var
|
||||
context: TSocketIOContext;
|
||||
begin
|
||||
Lock;
|
||||
try
|
||||
context := FConnections.Items[aContext];
|
||||
EmitEventTo(context, aEventName, aData, aCallback);
|
||||
EmitEventTo(context, aEventName, aData, aCallback, aOnError);
|
||||
finally
|
||||
UnLock;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIdServerSocketIOHandling.EmitEventToAll(const aEventName: string; const aData: ISuperObject;
|
||||
const aCallback: TSocketIOMsgJSON): Integer;
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
|
||||
var
|
||||
context: TSocketIOContext;
|
||||
jsonarray: string;
|
||||
|
@ -92,13 +92,13 @@ begin
|
|||
if context.IsDisconnected then Continue;
|
||||
|
||||
if not Assigned(aCallback) then
|
||||
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
|
||||
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);
|
||||
end, aOnError);
|
||||
Inc(Result);
|
||||
end;
|
||||
for context in FConnectionsGUID.Values do
|
||||
|
@ -106,13 +106,13 @@ begin
|
|||
if context.IsDisconnected then Continue;
|
||||
|
||||
if not Assigned(aCallback) then
|
||||
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
|
||||
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);
|
||||
end, aOnError);
|
||||
Inc(Result);
|
||||
end;
|
||||
finally
|
||||
|
@ -127,7 +127,7 @@ begin
|
|||
end;
|
||||
|
||||
procedure TIdServerSocketIOHandling.SendTo(const aContext: TIdServerContext;
|
||||
const aMessage: string; const aCallback: TSocketIOMsgJSON);
|
||||
const aMessage: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
var
|
||||
context: TSocketIOContext;
|
||||
begin
|
||||
|
@ -144,14 +144,14 @@ begin
|
|||
procedure(const aData: string)
|
||||
begin
|
||||
aCallback(context, SO(aData), nil);
|
||||
end);
|
||||
end, aOnError);
|
||||
finally
|
||||
UnLock;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TIdServerSocketIOHandling.SendToAll(const aMessage: string;
|
||||
const aCallback: TSocketIOMsgJSON): Integer;
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
|
||||
var
|
||||
context: TSocketIOContext;
|
||||
begin
|
||||
|
@ -169,7 +169,7 @@ begin
|
|||
procedure(const aData: string)
|
||||
begin
|
||||
aCallback(context, SO(aData), nil);
|
||||
end);
|
||||
end, aOnError);
|
||||
Inc(Result);
|
||||
end;
|
||||
for context in FConnectionsGUID.Values do
|
||||
|
|
|
@ -75,7 +75,7 @@ end;
|
|||
function TIdServerWSContext.IsSocketIO: Boolean;
|
||||
begin
|
||||
//FDocument = '/socket.io/1/websocket/13412152'
|
||||
Result := StartsText('/socket.io/1/websocket', FPath);
|
||||
Result := StartsText('/socket.io/1/websocket/', FPath);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
|
|
@ -3,7 +3,12 @@ unit IdServerWebsocketHandling;
|
|||
interface
|
||||
|
||||
uses
|
||||
IdContext, IdCustomHTTPServer, IdHashSHA1,
|
||||
IdContext, IdCustomHTTPServer,
|
||||
{$IF CompilerVersion <= 21.0} //D2010
|
||||
IdHashSHA1,
|
||||
{$else}
|
||||
IdHashSHA, //XE3 etc
|
||||
{$IFEND}
|
||||
IdServerSocketIOHandling, IdServerWebsocketContext,
|
||||
Classes, IdServerBaseHandling, IdIOHandlerWebsocket;
|
||||
|
||||
|
@ -263,9 +268,12 @@ begin
|
|||
if (sValue <> '') then
|
||||
begin
|
||||
context.WebSocketVersion := StrToIntDef(sValue, 0);
|
||||
if context.WebSocketVersion < 13 then
|
||||
Abort; //must be at least 13
|
||||
end
|
||||
|
||||
if context.WebSocketVersion < 13 then
|
||||
|
||||
Abort; //must be at least 13
|
||||
|
||||
end
|
||||
else
|
||||
Abort; //must exist
|
||||
|
||||
|
|
|
@ -19,6 +19,7 @@ type
|
|||
TSocketIOMsgJSON = reference to procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj);
|
||||
TSocketIONotify = reference to procedure(const ASocket: ISocketIOContext);
|
||||
TSocketIOEvent = reference to procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj);
|
||||
TSocketIOError = reference to procedure(const ASocket: ISocketIOContext; const aErrorClass, aErrorMessage: string);
|
||||
|
||||
TSocketIONotifyList = class(TList<TSocketIONotify>);
|
||||
TSocketIOEventList = class(TList<TSocketIOEvent>);
|
||||
|
@ -31,9 +32,9 @@ type
|
|||
function PeerIP: string;
|
||||
function PeerPort: Integer;
|
||||
|
||||
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
|
||||
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil);
|
||||
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
|
||||
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = 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);
|
||||
end;
|
||||
|
||||
TSocketIOContext = class(TInterfacedObject,
|
||||
|
@ -78,10 +79,10 @@ type
|
|||
//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);
|
||||
procedure EmitEvent(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
|
||||
// procedure BroadcastEventToOthers(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
|
||||
procedure Send(const aData: string; const aCallback: TSocketIOMsgJSON = nil);
|
||||
procedure SendJSON(const aJSON: 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);
|
||||
end;
|
||||
|
||||
TSocketIOCallbackObj = class
|
||||
|
@ -91,6 +92,7 @@ type
|
|||
FMsgNr: Integer;
|
||||
public
|
||||
procedure SendResponse(const aResponse: string);
|
||||
function IsResponseSend: Boolean;
|
||||
end;
|
||||
|
||||
TIdBaseSocketIOHandling = class(TIdServerBaseHandling)
|
||||
|
@ -113,6 +115,7 @@ type
|
|||
FSocketIOMsgNr: Integer;
|
||||
FSocketIOEventCallback: TDictionary<Integer,TSocketIOCallback>;
|
||||
FSocketIOEventCallbackRef: TDictionary<Integer,TSocketIOCallbackRef>;
|
||||
FSocketIOErrorRef: TDictionary<Integer,TSocketIOError>;
|
||||
|
||||
function WriteConnect(const ASocket: TSocketIOContext): string; overload;
|
||||
procedure WriteDisConnect(const ASocket: TSocketIOContext);overload;
|
||||
|
@ -122,10 +125,10 @@ type
|
|||
procedure WriteDisConnect(const AContext: TIdContext);overload;
|
||||
procedure WritePing(const AContext: TIdContext);overload;
|
||||
|
||||
procedure WriteSocketIOMsg(const ASocket: TSocketIOContext; const aRoom, aData: string; aCallback: TSocketIOCallbackRef = nil);
|
||||
procedure WriteSocketIOJSON(const ASocket: TSocketIOContext; const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil);
|
||||
procedure WriteSocketIOEvent(const ASocket: TSocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallback);
|
||||
procedure WriteSocketIOEventRef(const ASocket: TSocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef);
|
||||
procedure WriteSocketIOMsg(const ASocket: TSocketIOContext; const aRoom, aData: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
|
||||
procedure WriteSocketIOJSON(const ASocket: TSocketIOContext; const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
|
||||
procedure WriteSocketIOEvent(const ASocket: TSocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError);
|
||||
procedure WriteSocketIOEventRef(const ASocket: TSocketIOContext; const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError);
|
||||
procedure WriteSocketIOResult(const ASocket: TSocketIOContext; aRequestMsgNr: Integer; const aRoom, aData: string);
|
||||
|
||||
procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream);
|
||||
|
@ -160,8 +163,8 @@ type
|
|||
|
||||
TIdSocketIOHandling = class(TIdBaseSocketIOHandling)
|
||||
public
|
||||
procedure Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil);
|
||||
procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
|
||||
procedure Send(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
|
||||
procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
@ -181,6 +184,7 @@ begin
|
|||
|
||||
FSocketIOEventCallback := TDictionary<Integer,TSocketIOCallback>.Create;
|
||||
FSocketIOEventCallbackRef := TDictionary<Integer,TSocketIOCallbackRef>.Create;
|
||||
FSocketIOErrorRef := TDictionary<Integer,TSocketIOError>.Create;
|
||||
end;
|
||||
|
||||
destructor TIdBaseSocketIOHandling.Destroy;
|
||||
|
@ -189,6 +193,7 @@ var squid: string;
|
|||
begin
|
||||
FSocketIOEventCallback.Free;
|
||||
FSocketIOEventCallbackRef.Free;
|
||||
FSocketIOErrorRef.Free;
|
||||
|
||||
FOnEventList.Free;
|
||||
FOnConnectionList.Free;
|
||||
|
@ -348,7 +353,7 @@ procedure TIdBaseSocketIOHandling.ProcessCloseChannel(
|
|||
begin
|
||||
if aChannel <> '' then
|
||||
//todo: close channel
|
||||
else
|
||||
else if (ASocket.FContext <> nil) then
|
||||
ASocket.FContext.Connection.Disconnect;
|
||||
end;
|
||||
|
||||
|
@ -576,6 +581,8 @@ var
|
|||
callback: TSocketIOCallback;
|
||||
callbackref: TSocketIOCallbackRef;
|
||||
callbackobj: TSocketIOCallbackObj;
|
||||
errorref: TSocketIOError;
|
||||
error: ISuperObject;
|
||||
begin
|
||||
if not FConnections.ContainsValue(ASocket) and
|
||||
not FConnectionsGUID.ContainsValue(ASocket) then
|
||||
|
@ -640,7 +647,15 @@ begin
|
|||
callbackobj.FHandling := Self;
|
||||
callbackobj.FSocket := ASocket;
|
||||
callbackobj.FMsgNr := imsg;
|
||||
try
|
||||
OnSocketIOMsg(ASocket, sdata, callbackobj); //, imsg, bCallback);
|
||||
except
|
||||
on E:Exception do
|
||||
begin
|
||||
if not callbackobj.IsResponseSend then
|
||||
callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon );
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
callbackobj.Free;
|
||||
end
|
||||
|
@ -665,7 +680,15 @@ begin
|
|||
callbackobj.FHandling := Self;
|
||||
callbackobj.FSocket := ASocket;
|
||||
callbackobj.FMsgNr := imsg;
|
||||
try
|
||||
OnSocketIOJson(ASocket, SO(sdata), callbackobj); //, imsg, bCallback);
|
||||
except
|
||||
on E:Exception do
|
||||
begin
|
||||
if not callbackobj.IsResponseSend then
|
||||
callbackobj.SendResponse( SO(['Error', SO(['Type', e.ClassName, 'Message', e.Message])]).AsJSon );
|
||||
end;
|
||||
end;
|
||||
finally
|
||||
callbackobj.Free;
|
||||
end
|
||||
|
@ -700,6 +723,24 @@ begin
|
|||
imsg := StrToIntDef(smsg, 0);
|
||||
sData := Copy(sdata, Pos('+', sData)+1, Length(sData));
|
||||
|
||||
if FSocketIOErrorRef.TryGetValue(imsg, errorref) then
|
||||
begin
|
||||
FSocketIOErrorRef.Remove(imsg);
|
||||
//'[{"Error":{"Message":"Operation aborted","Type":"EAbort"}}]'
|
||||
if ContainsText(sdata, '{"Error":') then
|
||||
begin
|
||||
error := SO(sdata);
|
||||
if error.IsType(stArray) then
|
||||
error := error.O['0'];
|
||||
error := error.O['Error'];
|
||||
if error.S['Message'] <> '' then
|
||||
errorref(ASocket, error.S['Type'], error.S['Message'])
|
||||
else
|
||||
errorref(ASocket, 'Unknown', sdata);
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
if FSocketIOEventCallback.TryGetValue(imsg, callback) then
|
||||
begin
|
||||
FSocketIOEventCallback.Remove(imsg);
|
||||
|
@ -782,7 +823,7 @@ begin
|
|||
end;
|
||||
|
||||
procedure TIdBaseSocketIOHandling.WriteSocketIOEvent(const ASocket: TSocketIOContext; const aRoom, aEventName,
|
||||
aJSONArray: string; aCallback: TSocketIOCallback);
|
||||
aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError);
|
||||
var
|
||||
sresult: string;
|
||||
begin
|
||||
|
@ -799,12 +840,15 @@ begin
|
|||
sresult := Format('5:%d+:%s:{"name":"%s", "args":%s}',
|
||||
[FSocketIOMsgNr, aRoom, aEventName, aJSONArray]);
|
||||
FSocketIOEventCallback.Add(FSocketIOMsgNr, aCallback);
|
||||
|
||||
if Assigned(aOnError) then
|
||||
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
|
||||
end;
|
||||
WriteString(ASocket, sresult);
|
||||
end;
|
||||
|
||||
procedure TIdBaseSocketIOHandling.WriteSocketIOEventRef(const ASocket: TSocketIOContext;
|
||||
const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef);
|
||||
const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError);
|
||||
var
|
||||
sresult: string;
|
||||
begin
|
||||
|
@ -821,12 +865,15 @@ begin
|
|||
sresult := Format('5:%d+:%s:{"name":"%s", "args":%s}',
|
||||
[FSocketIOMsgNr, aRoom, aEventName, aJSONArray]);
|
||||
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
|
||||
|
||||
if Assigned(aOnError) then
|
||||
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
|
||||
end;
|
||||
WriteString(ASocket, sresult);
|
||||
end;
|
||||
|
||||
procedure TIdBaseSocketIOHandling.WriteSocketIOJSON(const ASocket: TSocketIOContext;
|
||||
const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil);
|
||||
const aRoom, aJSON: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
|
||||
var
|
||||
sresult: string;
|
||||
begin
|
||||
|
@ -843,13 +890,16 @@ begin
|
|||
sresult := Format('4:%d+:%s:%s',
|
||||
[FSocketIOMsgNr, aRoom, aJSON]);
|
||||
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
|
||||
|
||||
if Assigned(aOnError) then
|
||||
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
|
||||
end;
|
||||
|
||||
WriteString(ASocket, sresult);
|
||||
end;
|
||||
|
||||
procedure TIdBaseSocketIOHandling.WriteSocketIOMsg(const ASocket: TSocketIOContext;
|
||||
const aRoom, aData: string; aCallback: TSocketIOCallbackRef = nil);
|
||||
const aRoom, aData: string; aCallback: TSocketIOCallbackRef = nil; const aOnError: TSocketIOError = nil);
|
||||
var
|
||||
sresult: string;
|
||||
begin
|
||||
|
@ -866,6 +916,9 @@ begin
|
|||
sresult := Format('3:%d+:%s:%s',
|
||||
[FSocketIOMsgNr, aRoom, aData]);
|
||||
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
|
||||
|
||||
if Assigned(aOnError) then
|
||||
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
|
||||
end;
|
||||
|
||||
WriteString(ASocket, sresult);
|
||||
|
@ -896,7 +949,7 @@ begin
|
|||
|
||||
if (ASocket.FIOHandler <> nil) then
|
||||
begin
|
||||
Assert(ASocket.FIOHandler.IsWebsocket);
|
||||
//Assert(ASocket.FIOHandler.IsWebsocket);
|
||||
if DebugHook <> 0 then
|
||||
Windows.OutputDebugString(PChar('Send: ' + aText));
|
||||
ASocket.FIOHandler.Write(aText);
|
||||
|
@ -915,9 +968,15 @@ end;
|
|||
|
||||
{ TSocketIOCallbackObj }
|
||||
|
||||
function TSocketIOCallbackObj.IsResponseSend: Boolean;
|
||||
begin
|
||||
Result := (FMsgNr < 0);
|
||||
end;
|
||||
|
||||
procedure TSocketIOCallbackObj.SendResponse(const aResponse: string);
|
||||
begin
|
||||
FHandling.WriteSocketIOResult(FSocket, FMsgNr, '', aResponse);
|
||||
FMsgNr := -1;
|
||||
end;
|
||||
|
||||
{ TSocketIOContext }
|
||||
|
@ -940,17 +999,17 @@ begin
|
|||
end;
|
||||
|
||||
procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject;
|
||||
const aCallback: TSocketIOMsgJSON);
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
begin
|
||||
if not Assigned(aCallback) then
|
||||
FHandling.WriteSocketIOEvent(Self, '', aEventName, aData.AsJSon, nil)
|
||||
FHandling.WriteSocketIOEvent(Self, '', aEventName, aData.AsJSon, nil, nil)
|
||||
else
|
||||
begin
|
||||
FHandling.WriteSocketIOEventRef(Self, '', aEventName, aData.AsJSon,
|
||||
procedure(const aData: string)
|
||||
begin
|
||||
aCallback(Self, SO(aData), nil);
|
||||
end);
|
||||
end, aOnError);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -1007,7 +1066,7 @@ begin
|
|||
end;
|
||||
|
||||
procedure TSocketIOContext.Send(const aData: string;
|
||||
const aCallback: TSocketIOMsgJSON);
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
begin
|
||||
if not Assigned(aCallback) then
|
||||
FHandling.WriteSocketIOMsg(Self, '', aData)
|
||||
|
@ -1017,12 +1076,12 @@ begin
|
|||
procedure(const aData: string)
|
||||
begin
|
||||
aCallback(Self, SO(aData), nil);
|
||||
end);
|
||||
end, aOnError);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject;
|
||||
const aCallback: TSocketIOMsgJSON);
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
begin
|
||||
if not Assigned(aCallback) then
|
||||
FHandling.WriteSocketIOJSON(Self, '', aJSON.AsJSon())
|
||||
|
@ -1032,7 +1091,7 @@ begin
|
|||
procedure(const aData: string)
|
||||
begin
|
||||
aCallback(Self, SO(aData), nil);
|
||||
end);
|
||||
end, aOnError);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
@ -1131,7 +1190,7 @@ end;
|
|||
{ TIdSocketIOHandling }
|
||||
|
||||
procedure TIdSocketIOHandling.Emit(const aEventName: string;
|
||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON);
|
||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
var
|
||||
context: TSocketIOContext;
|
||||
jsonarray: string;
|
||||
|
@ -1154,13 +1213,13 @@ begin
|
|||
if context.IsDisconnected then Continue;
|
||||
|
||||
if not Assigned(aCallback) then
|
||||
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
|
||||
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);
|
||||
end, aOnError);
|
||||
Inc(isendcount);
|
||||
end;
|
||||
for context in FConnectionsGUID.Values do
|
||||
|
@ -1168,13 +1227,13 @@ begin
|
|||
if context.IsDisconnected then Continue;
|
||||
|
||||
if not Assigned(aCallback) then
|
||||
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
|
||||
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);
|
||||
end, aOnError);
|
||||
Inc(isendcount);
|
||||
end;
|
||||
|
||||
|
@ -1186,7 +1245,7 @@ begin
|
|||
end;
|
||||
|
||||
procedure TIdSocketIOHandling.Send(const aMessage: string;
|
||||
const aCallback: TSocketIOMsgJSON);
|
||||
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||
var
|
||||
context: TSocketIOContext;
|
||||
isendcount: Integer;
|
||||
|
@ -1209,7 +1268,7 @@ begin
|
|||
procedure(const aData: string)
|
||||
begin
|
||||
aCallback(context, SO(aData), nil);
|
||||
end);
|
||||
end, aOnError);
|
||||
Inc(isendcount);
|
||||
end;
|
||||
for context in FConnectionsGUID.Values do
|
||||
|
@ -1225,7 +1284,7 @@ begin
|
|||
procedure(const aData: string)
|
||||
begin
|
||||
aCallback(context, SO(aData), nil);
|
||||
end);
|
||||
end, aOnError);
|
||||
Inc(isendcount);
|
||||
end;
|
||||
|
||||
|
|
6572
superobject/superobject.pas
Normal file
6572
superobject/superobject.pas
Normal file
File diff suppressed because it is too large
Load diff
1391
superobject/superxmlparser.pas
Normal file
1391
superobject/superxmlparser.pas
Normal file
File diff suppressed because it is too large
Load diff
|
@ -405,6 +405,7 @@ procedure TROIndyHTTPSocketIOClient.AsyncDispatchEvent(const aEvent: TStream);
|
|||
var
|
||||
iEventNr: Integer;
|
||||
cWSNR: array[0..High(C_RO_WS_NR)] of AnsiChar;
|
||||
s: string;
|
||||
begin
|
||||
if aEvent.Size > Length(C_RO_WS_NR) + SizeOf(iEventNr) then
|
||||
begin
|
||||
|
@ -415,7 +416,16 @@ begin
|
|||
if cWSNR = C_RO_WS_NR then
|
||||
begin
|
||||
aEvent.Read(iEventNr, SizeOf(iEventNr));
|
||||
Assert(iEventNr < 0, 'must be negative number for RO events');
|
||||
if iEventNr >= 0 then
|
||||
begin
|
||||
aEvent.Position := 0;
|
||||
with TStreamReader.Create(aEvent) do
|
||||
begin
|
||||
s := ReadToEnd;
|
||||
Free;
|
||||
end;
|
||||
Assert(iEventNr < 0, 'must be negative number for RO events: ' + s);
|
||||
end;
|
||||
//trunc
|
||||
aEvent.Size := aEvent.Size - Length(C_RO_WS_NR) - SizeOf(iEventNr);
|
||||
|
||||
|
|
Loading…
Reference in a new issue