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
|
uses
|
||||||
Classes,
|
Classes,
|
||||||
IdHTTP, IdHashSHA1, IdIOHandler,
|
IdHTTP,
|
||||||
|
{$IF CompilerVersion <= 21.0} //D2010
|
||||||
|
IdHashSHA1,
|
||||||
|
{$else}
|
||||||
|
IdHashSHA, //XE3 etc
|
||||||
|
{$IFEND}
|
||||||
|
IdIOHandler,
|
||||||
IdIOHandlerWebsocket, ExtCtrls, IdWinsock2, Generics.Collections, SyncObjs,
|
IdIOHandlerWebsocket, ExtCtrls, IdWinsock2, Generics.Collections, SyncObjs,
|
||||||
IdSocketIOHandling;
|
IdSocketIOHandling;
|
||||||
|
|
||||||
|
@ -147,8 +153,7 @@ implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
IdCoderMIME, SysUtils, Math, IdException, IdStackConsts, IdStack,
|
IdCoderMIME, SysUtils, Math, IdException, IdStackConsts, IdStack,
|
||||||
IdStackBSDBase, IdGlobal, Windows, StrUtils, mcBaseNamedThread,
|
IdStackBSDBase, IdGlobal, Windows, StrUtils;
|
||||||
mcFinalizationHelper;
|
|
||||||
|
|
||||||
//type
|
//type
|
||||||
// TAnonymousThread = class(TThread)
|
// TAnonymousThread = class(TThread)
|
||||||
|
@ -187,6 +192,7 @@ begin
|
||||||
FHash := TIdHashSHA1.Create;
|
FHash := TIdHashSHA1.Create;
|
||||||
|
|
||||||
IOHandler := TIdIOHandlerWebsocket.Create(nil);
|
IOHandler := TIdIOHandlerWebsocket.Create(nil);
|
||||||
|
IOHandler.UseNagle := False;
|
||||||
ManagedIOHandler := True;
|
ManagedIOHandler := True;
|
||||||
|
|
||||||
FSocketIO := TIdSocketIOHandling_Ext.Create;
|
FSocketIO := TIdSocketIOHandling_Ext.Create;
|
||||||
|
@ -216,20 +222,17 @@ end;
|
||||||
|
|
||||||
procedure TIdHTTPWebsocketClient.AsyncDispatchEvent(const aEvent: string);
|
procedure TIdHTTPWebsocketClient.AsyncDispatchEvent(const aEvent: string);
|
||||||
begin
|
begin
|
||||||
if FSocketIOCompatible then
|
//if not Assigned(OnTextData) then Exit;
|
||||||
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!
|
//events during dispatch? channel is busy so offload event dispatching to different thread!
|
||||||
TIdWebsocketDispatchThread.Instance.QueueEvent(
|
TIdWebsocketDispatchThread.Instance.QueueEvent(
|
||||||
procedure
|
procedure
|
||||||
begin
|
begin
|
||||||
if Assigned(OnTextData) then
|
if FSocketIOCompatible then
|
||||||
|
FSocketIO.ProcessSocketIORequest(FSocketIOContext as TSocketIOContext, aEvent)
|
||||||
|
else if Assigned(OnTextData) then
|
||||||
OnTextData(aEvent);
|
OnTextData(aEvent);
|
||||||
end);
|
end);
|
||||||
end;
|
end;
|
||||||
end;
|
|
||||||
|
|
||||||
destructor TIdHTTPWebsocketClient.Destroy;
|
destructor TIdHTTPWebsocketClient.Destroy;
|
||||||
var tmr: TObject;
|
var tmr: TObject;
|
||||||
|
@ -467,6 +470,10 @@ begin
|
||||||
CheckForGracefulDisconnect(True);
|
CheckForGracefulDisconnect(True);
|
||||||
CheckConnected;
|
CheckConnected;
|
||||||
Assert(Self.Connected);
|
Assert(Self.Connected);
|
||||||
|
|
||||||
|
if Response.ResponseCode = 0 then
|
||||||
|
Response.ResponseText := Response.ResponseText;
|
||||||
|
|
||||||
if Response.ResponseCode <> 200{ok} then
|
if Response.ResponseCode <> 200{ok} then
|
||||||
begin
|
begin
|
||||||
aFailedReason := Format('Error while upgrading: "%d: %s"',[ResponseCode, ResponseText]);
|
aFailedReason := Format('Error while upgrading: "%d: %s"',[ResponseCode, ResponseText]);
|
||||||
|
@ -895,9 +902,11 @@ end;
|
||||||
|
|
||||||
procedure TIdWebsocketMultiReadThread.BreakSelectWait;
|
procedure TIdWebsocketMultiReadThread.BreakSelectWait;
|
||||||
var
|
var
|
||||||
iResult: Integer;
|
//iResult: Integer;
|
||||||
LAddr: TSockAddrIn6;
|
LAddr: TSockAddrIn6;
|
||||||
begin
|
begin
|
||||||
|
if FTempHandle = 0 then Exit;
|
||||||
|
|
||||||
FillChar(LAddr, SizeOf(LAddr), 0);
|
FillChar(LAddr, SizeOf(LAddr), 0);
|
||||||
//Id_IPv4
|
//Id_IPv4
|
||||||
with PSOCKADDR(@LAddr)^ do
|
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,
|
//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
|
//but this requires a dynamic server socket (which can trigger a firewall
|
||||||
//exception/question popup in WindowsXP+)
|
//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"!
|
//non blocking socket, so will always result in "would block"!
|
||||||
if (iResult <> Id_SOCKET_ERROR) or
|
// if (iResult <> Id_SOCKET_ERROR) or
|
||||||
( (GStack <> nil) and (GStack.WSGetLastError <> WSAEWOULDBLOCK) )
|
// ( (GStack <> nil) and (GStack.WSGetLastError <> WSAEWOULDBLOCK) )
|
||||||
then
|
// then
|
||||||
GStack.CheckForSocketError(iResult);
|
// GStack.CheckForSocketError(iResult);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TIdWebsocketMultiReadThread.Destroy;
|
destructor TIdWebsocketMultiReadThread.Destroy;
|
||||||
begin
|
begin
|
||||||
IdWinsock2.closesocket(FTempHandle);
|
IdWinsock2.closesocket(FTempHandle);
|
||||||
|
FTempHandle := 0;
|
||||||
FChannels.Free;
|
FChannels.Free;
|
||||||
inherited;
|
inherited;
|
||||||
end;
|
end;
|
||||||
|
@ -963,8 +974,7 @@ end;
|
||||||
|
|
||||||
class function TIdWebsocketMultiReadThread.Instance: TIdWebsocketMultiReadThread;
|
class function TIdWebsocketMultiReadThread.Instance: TIdWebsocketMultiReadThread;
|
||||||
begin
|
begin
|
||||||
if (FInstance = nil) and
|
if (FInstance = nil) then
|
||||||
not TFinalizationHelper.ApplicationIsTerminating then
|
|
||||||
begin
|
begin
|
||||||
FInstance := TIdWebsocketMultiReadThread.Create(True);
|
FInstance := TIdWebsocketMultiReadThread.Create(True);
|
||||||
FInstance.Start;
|
FInstance.Start;
|
||||||
|
@ -1126,6 +1136,7 @@ begin
|
||||||
FPendingBreak := False;
|
FPendingBreak := False;
|
||||||
|
|
||||||
IdWinsock2.closesocket(FTempHandle);
|
IdWinsock2.closesocket(FTempHandle);
|
||||||
|
FTempHandle := 0;
|
||||||
InitSpecialEventSocket;
|
InitSpecialEventSocket;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -1201,11 +1212,19 @@ end;
|
||||||
|
|
||||||
class function TIdWebsocketDispatchThread.Instance: TIdWebsocketDispatchThread;
|
class function TIdWebsocketDispatchThread.Instance: TIdWebsocketDispatchThread;
|
||||||
begin
|
begin
|
||||||
|
if FInstance = nil then
|
||||||
|
begin
|
||||||
|
GlobalNameSpace.BeginWrite;
|
||||||
|
try
|
||||||
if FInstance = nil then
|
if FInstance = nil then
|
||||||
begin
|
begin
|
||||||
FInstance := TIdWebsocketDispatchThread.Create(True);
|
FInstance := TIdWebsocketDispatchThread.Create(True);
|
||||||
FInstance.Start;
|
FInstance.Start;
|
||||||
end;
|
end;
|
||||||
|
finally
|
||||||
|
GlobalNameSpace.EndWrite;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
Result := FInstance;
|
Result := FInstance;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -1231,7 +1250,8 @@ finalization
|
||||||
if TIdWebsocketMultiReadThread.FInstance <> nil then
|
if TIdWebsocketMultiReadThread.FInstance <> nil then
|
||||||
begin
|
begin
|
||||||
TIdWebsocketMultiReadThread.Instance.Terminate;
|
TIdWebsocketMultiReadThread.Instance.Terminate;
|
||||||
TBaseNamedThread.WaitForThread(TIdWebsocketMultiReadThread.Instance, 5 * 1000);
|
TIdWebsocketMultiReadThread.Instance.WaitFor;
|
||||||
|
// TBaseNamedThread.WaitForThread(TIdWebsocketMultiReadThread.Instance, 5 * 1000);
|
||||||
TIdWebsocketMultiReadThread.RemoveInstance;
|
TIdWebsocketMultiReadThread.RemoveInstance;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
|
@ -35,7 +35,7 @@ type
|
||||||
FWriteTextToTarget: Boolean;
|
FWriteTextToTarget: Boolean;
|
||||||
FCloseCodeSend: 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 ReadDataFromSource(var VBuffer: TIdBytes): Integer; override;
|
||||||
function WriteDataToTarget (const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; override;
|
function WriteDataToTarget (const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; override;
|
||||||
|
|
||||||
|
@ -228,8 +228,10 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TIdIOHandlerWebsocket.InternalReadDataFromSource(
|
function TIdIOHandlerWebsocket.InternalReadDataFromSource(
|
||||||
var VBuffer: TIdBytes): Integer;
|
var VBuffer: TIdBytes; ARaiseExceptionOnTimeout: Boolean): Integer;
|
||||||
begin
|
begin
|
||||||
|
SetLength(VBuffer, 0);
|
||||||
|
|
||||||
CheckForDisconnect;
|
CheckForDisconnect;
|
||||||
if not Readable(ReadTimeout) or
|
if not Readable(ReadTimeout) or
|
||||||
not Opened or
|
not Opened or
|
||||||
|
@ -241,7 +243,10 @@ begin
|
||||||
else if not SourceIsAvailable then
|
else if not SourceIsAvailable then
|
||||||
EIdClosedSocket.Toss(RSStatusDisconnected);
|
EIdClosedSocket.Toss(RSStatusDisconnected);
|
||||||
GStack.CheckForSocketError(GStack.WSGetLastError); //check for socket error
|
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;
|
end;
|
||||||
|
|
||||||
SetLength(VBuffer, RecvBufferSize);
|
SetLength(VBuffer, RecvBufferSize);
|
||||||
|
@ -390,6 +395,7 @@ begin
|
||||||
opcodes. *)
|
opcodes. *)
|
||||||
lFirstDataCode := wdcNone;
|
lFirstDataCode := wdcNone;
|
||||||
FMessageStream.Clear;
|
FMessageStream.Clear;
|
||||||
|
|
||||||
repeat
|
repeat
|
||||||
//read a single frame
|
//read a single frame
|
||||||
iReadCount := ReadFrame(bFIN, bRSV1, bRSV2, bRSV3, lDataCode, iaReadBuffer);
|
iReadCount := ReadFrame(bFIN, bRSV1, bRSV2, bRSV3, lDataCode, iaReadBuffer);
|
||||||
|
@ -515,8 +521,10 @@ var
|
||||||
while FWSInputBuffer.Size <= iInputPos do
|
while FWSInputBuffer.Size <= iInputPos do
|
||||||
begin
|
begin
|
||||||
//FWSInputBuffer.AsString;
|
//FWSInputBuffer.AsString;
|
||||||
InternalReadDataFromSource(temp);
|
InternalReadDataFromSource(temp, True);
|
||||||
FWSInputBuffer.Write(temp);
|
FWSInputBuffer.Write(temp);
|
||||||
|
if FWSInputBuffer.Size <= iInputPos then
|
||||||
|
Sleep(1);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
//Self.ReadByte copies all data everytime (because the first byte must be removed) so we use index (much more efficient)
|
//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
|
begin
|
||||||
while FWSInputBuffer.Size < aCount do
|
while FWSInputBuffer.Size < aCount do
|
||||||
begin
|
begin
|
||||||
InternalReadDataFromSource(temp);
|
InternalReadDataFromSource(temp, True);
|
||||||
FWSInputBuffer.Write(temp);
|
FWSInputBuffer.Write(temp);
|
||||||
|
if FWSInputBuffer.Size < aCount then
|
||||||
|
Sleep(1);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
FWSInputBuffer.ExtractToBytes(Result, aCount);
|
FWSInputBuffer.ExtractToBytes(Result, aCount);
|
||||||
|
|
|
@ -26,7 +26,10 @@ function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
|
||||||
begin
|
begin
|
||||||
Result := inherited Accept(ASocket, AListenerThread, AYarn);
|
Result := inherited Accept(ASocket, AListenerThread, AYarn);
|
||||||
if Result <> nil then
|
if Result <> nil then
|
||||||
|
begin
|
||||||
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
|
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
|
||||||
|
(Result as TIdIOHandlerWebsocket).UseNagle := False;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIdServerIOHandlerWebsocket.InitComponent;
|
procedure TIdServerIOHandlerWebsocket.InitComponent;
|
||||||
|
@ -40,7 +43,10 @@ function TIdServerIOHandlerWebsocket.MakeClientIOHandler(
|
||||||
begin
|
begin
|
||||||
Result := inherited MakeClientIOHandler(ATheThread);
|
Result := inherited MakeClientIOHandler(ATheThread);
|
||||||
if Result <> nil then
|
if Result <> nil then
|
||||||
|
begin
|
||||||
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
|
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
|
||||||
|
(Result as TIdIOHandlerWebsocket).UseNagle := False;
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
|
@ -13,14 +13,14 @@ type
|
||||||
protected
|
protected
|
||||||
procedure ProcessHeatbeatRequest(const AContext: TSocketIOContext; const aText: string); override;
|
procedure ProcessHeatbeatRequest(const AContext: TSocketIOContext; const aText: string); override;
|
||||||
public
|
public
|
||||||
function SendToAll(const aMessage: string; const aCallback: TSocketIOMsgJSON = nil): Integer;
|
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);
|
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;
|
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;
|
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;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
@ -32,7 +32,7 @@ uses
|
||||||
|
|
||||||
procedure TIdServerSocketIOHandling.EmitEventTo(
|
procedure TIdServerSocketIOHandling.EmitEventTo(
|
||||||
const aContext: TSocketIOContext; const aEventName: string;
|
const aContext: TSocketIOContext; const aEventName: string;
|
||||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON);
|
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||||
var
|
var
|
||||||
jsonarray: string;
|
jsonarray: string;
|
||||||
begin
|
begin
|
||||||
|
@ -47,32 +47,32 @@ begin
|
||||||
jsonarray := '[' + aData.AsString + ']';
|
jsonarray := '[' + aData.AsString + ']';
|
||||||
|
|
||||||
if not Assigned(aCallback) then
|
if not Assigned(aCallback) then
|
||||||
WriteSocketIOEvent(aContext, ''{no room}, aEventName, jsonarray, nil)
|
WriteSocketIOEvent(aContext, ''{no room}, aEventName, jsonarray, nil, nil)
|
||||||
else
|
else
|
||||||
WriteSocketIOEventRef(aContext, ''{no room}, aEventName, jsonarray,
|
WriteSocketIOEventRef(aContext, ''{no room}, aEventName, jsonarray,
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(aContext, SO(aData), nil);
|
aCallback(aContext, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIdServerSocketIOHandling.EmitEventTo(
|
procedure TIdServerSocketIOHandling.EmitEventTo(
|
||||||
const aContext: TIdServerContext; const aEventName: string;
|
const aContext: TIdServerContext; const aEventName: string;
|
||||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON);
|
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||||
var
|
var
|
||||||
context: TSocketIOContext;
|
context: TSocketIOContext;
|
||||||
begin
|
begin
|
||||||
Lock;
|
Lock;
|
||||||
try
|
try
|
||||||
context := FConnections.Items[aContext];
|
context := FConnections.Items[aContext];
|
||||||
EmitEventTo(context, aEventName, aData, aCallback);
|
EmitEventTo(context, aEventName, aData, aCallback, aOnError);
|
||||||
finally
|
finally
|
||||||
UnLock;
|
UnLock;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TIdServerSocketIOHandling.EmitEventToAll(const aEventName: string; const aData: ISuperObject;
|
function TIdServerSocketIOHandling.EmitEventToAll(const aEventName: string; const aData: ISuperObject;
|
||||||
const aCallback: TSocketIOMsgJSON): Integer;
|
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
|
||||||
var
|
var
|
||||||
context: TSocketIOContext;
|
context: TSocketIOContext;
|
||||||
jsonarray: string;
|
jsonarray: string;
|
||||||
|
@ -92,13 +92,13 @@ begin
|
||||||
if context.IsDisconnected then Continue;
|
if context.IsDisconnected then Continue;
|
||||||
|
|
||||||
if not Assigned(aCallback) then
|
if not Assigned(aCallback) then
|
||||||
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
|
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
|
||||||
else
|
else
|
||||||
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
|
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(context, SO(aData), nil);
|
aCallback(context, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
Inc(Result);
|
Inc(Result);
|
||||||
end;
|
end;
|
||||||
for context in FConnectionsGUID.Values do
|
for context in FConnectionsGUID.Values do
|
||||||
|
@ -106,13 +106,13 @@ begin
|
||||||
if context.IsDisconnected then Continue;
|
if context.IsDisconnected then Continue;
|
||||||
|
|
||||||
if not Assigned(aCallback) then
|
if not Assigned(aCallback) then
|
||||||
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
|
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
|
||||||
else
|
else
|
||||||
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
|
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(context, SO(aData), nil);
|
aCallback(context, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
Inc(Result);
|
Inc(Result);
|
||||||
end;
|
end;
|
||||||
finally
|
finally
|
||||||
|
@ -127,7 +127,7 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIdServerSocketIOHandling.SendTo(const aContext: TIdServerContext;
|
procedure TIdServerSocketIOHandling.SendTo(const aContext: TIdServerContext;
|
||||||
const aMessage: string; const aCallback: TSocketIOMsgJSON);
|
const aMessage: string; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||||
var
|
var
|
||||||
context: TSocketIOContext;
|
context: TSocketIOContext;
|
||||||
begin
|
begin
|
||||||
|
@ -144,14 +144,14 @@ begin
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(context, SO(aData), nil);
|
aCallback(context, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
finally
|
finally
|
||||||
UnLock;
|
UnLock;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
function TIdServerSocketIOHandling.SendToAll(const aMessage: string;
|
function TIdServerSocketIOHandling.SendToAll(const aMessage: string;
|
||||||
const aCallback: TSocketIOMsgJSON): Integer;
|
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError): Integer;
|
||||||
var
|
var
|
||||||
context: TSocketIOContext;
|
context: TSocketIOContext;
|
||||||
begin
|
begin
|
||||||
|
@ -169,7 +169,7 @@ begin
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(context, SO(aData), nil);
|
aCallback(context, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
Inc(Result);
|
Inc(Result);
|
||||||
end;
|
end;
|
||||||
for context in FConnectionsGUID.Values do
|
for context in FConnectionsGUID.Values do
|
||||||
|
|
|
@ -75,7 +75,7 @@ end;
|
||||||
function TIdServerWSContext.IsSocketIO: Boolean;
|
function TIdServerWSContext.IsSocketIO: Boolean;
|
||||||
begin
|
begin
|
||||||
//FDocument = '/socket.io/1/websocket/13412152'
|
//FDocument = '/socket.io/1/websocket/13412152'
|
||||||
Result := StartsText('/socket.io/1/websocket', FPath);
|
Result := StartsText('/socket.io/1/websocket/', FPath);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
|
|
@ -3,7 +3,12 @@ unit IdServerWebsocketHandling;
|
||||||
interface
|
interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
IdContext, IdCustomHTTPServer, IdHashSHA1,
|
IdContext, IdCustomHTTPServer,
|
||||||
|
{$IF CompilerVersion <= 21.0} //D2010
|
||||||
|
IdHashSHA1,
|
||||||
|
{$else}
|
||||||
|
IdHashSHA, //XE3 etc
|
||||||
|
{$IFEND}
|
||||||
IdServerSocketIOHandling, IdServerWebsocketContext,
|
IdServerSocketIOHandling, IdServerWebsocketContext,
|
||||||
Classes, IdServerBaseHandling, IdIOHandlerWebsocket;
|
Classes, IdServerBaseHandling, IdIOHandlerWebsocket;
|
||||||
|
|
||||||
|
@ -263,8 +268,11 @@ begin
|
||||||
if (sValue <> '') then
|
if (sValue <> '') then
|
||||||
begin
|
begin
|
||||||
context.WebSocketVersion := StrToIntDef(sValue, 0);
|
context.WebSocketVersion := StrToIntDef(sValue, 0);
|
||||||
|
|
||||||
if context.WebSocketVersion < 13 then
|
if context.WebSocketVersion < 13 then
|
||||||
|
|
||||||
Abort; //must be at least 13
|
Abort; //must be at least 13
|
||||||
|
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
Abort; //must exist
|
Abort; //must exist
|
||||||
|
|
|
@ -19,6 +19,7 @@ type
|
||||||
TSocketIOMsgJSON = reference to procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj);
|
TSocketIOMsgJSON = reference to procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: TSocketIOCallbackObj);
|
||||||
TSocketIONotify = reference to procedure(const ASocket: ISocketIOContext);
|
TSocketIONotify = reference to procedure(const ASocket: ISocketIOContext);
|
||||||
TSocketIOEvent = reference to procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallbackObj: TSocketIOCallbackObj);
|
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>);
|
TSocketIONotifyList = class(TList<TSocketIONotify>);
|
||||||
TSocketIOEventList = class(TList<TSocketIOEvent>);
|
TSocketIOEventList = class(TList<TSocketIOEvent>);
|
||||||
|
@ -31,9 +32,9 @@ type
|
||||||
function PeerIP: string;
|
function PeerIP: string;
|
||||||
function PeerPort: Integer;
|
function PeerPort: Integer;
|
||||||
|
|
||||||
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 Send(const aData: string; 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);
|
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TSocketIOContext = class(TInterfacedObject,
|
TSocketIOContext = class(TInterfacedObject,
|
||||||
|
@ -78,10 +79,10 @@ type
|
||||||
//todo: OnEvent per socket
|
//todo: OnEvent per socket
|
||||||
//todo: store session info per connection (see Socket.IO Set + Get -> Storing data associated to a client)
|
//todo: store session info per connection (see Socket.IO Set + Get -> Storing data associated to a client)
|
||||||
//todo: namespace using "Of"
|
//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 BroadcastEventToOthers(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil);
|
||||||
procedure Send(const aData: string; 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);
|
procedure SendJSON(const aJSON: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TSocketIOCallbackObj = class
|
TSocketIOCallbackObj = class
|
||||||
|
@ -91,6 +92,7 @@ type
|
||||||
FMsgNr: Integer;
|
FMsgNr: Integer;
|
||||||
public
|
public
|
||||||
procedure SendResponse(const aResponse: string);
|
procedure SendResponse(const aResponse: string);
|
||||||
|
function IsResponseSend: Boolean;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TIdBaseSocketIOHandling = class(TIdServerBaseHandling)
|
TIdBaseSocketIOHandling = class(TIdServerBaseHandling)
|
||||||
|
@ -113,6 +115,7 @@ type
|
||||||
FSocketIOMsgNr: Integer;
|
FSocketIOMsgNr: Integer;
|
||||||
FSocketIOEventCallback: TDictionary<Integer,TSocketIOCallback>;
|
FSocketIOEventCallback: TDictionary<Integer,TSocketIOCallback>;
|
||||||
FSocketIOEventCallbackRef: TDictionary<Integer,TSocketIOCallbackRef>;
|
FSocketIOEventCallbackRef: TDictionary<Integer,TSocketIOCallbackRef>;
|
||||||
|
FSocketIOErrorRef: TDictionary<Integer,TSocketIOError>;
|
||||||
|
|
||||||
function WriteConnect(const ASocket: TSocketIOContext): string; overload;
|
function WriteConnect(const ASocket: TSocketIOContext): string; overload;
|
||||||
procedure WriteDisConnect(const ASocket: TSocketIOContext);overload;
|
procedure WriteDisConnect(const ASocket: TSocketIOContext);overload;
|
||||||
|
@ -122,10 +125,10 @@ type
|
||||||
procedure WriteDisConnect(const AContext: TIdContext);overload;
|
procedure WriteDisConnect(const AContext: TIdContext);overload;
|
||||||
procedure WritePing(const AContext: TIdContext);overload;
|
procedure WritePing(const AContext: TIdContext);overload;
|
||||||
|
|
||||||
procedure WriteSocketIOMsg(const ASocket: TSocketIOContext; const aRoom, aData: string; aCallback: TSocketIOCallbackRef = nil);
|
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);
|
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);
|
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);
|
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 WriteSocketIOResult(const ASocket: TSocketIOContext; aRequestMsgNr: Integer; const aRoom, aData: string);
|
||||||
|
|
||||||
procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream);
|
procedure ProcessSocketIO_XHR(const aGUID: string; const aStrmRequest, aStrmResponse: TStream);
|
||||||
|
@ -160,8 +163,8 @@ type
|
||||||
|
|
||||||
TIdSocketIOHandling = class(TIdBaseSocketIOHandling)
|
TIdSocketIOHandling = class(TIdBaseSocketIOHandling)
|
||||||
public
|
public
|
||||||
procedure Send(const aMessage: string; 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);
|
procedure Emit(const aEventName: string; const aData: ISuperObject; const aCallback: TSocketIOMsgJSON = nil; const aOnError: TSocketIOError = nil);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
implementation
|
implementation
|
||||||
|
@ -181,6 +184,7 @@ begin
|
||||||
|
|
||||||
FSocketIOEventCallback := TDictionary<Integer,TSocketIOCallback>.Create;
|
FSocketIOEventCallback := TDictionary<Integer,TSocketIOCallback>.Create;
|
||||||
FSocketIOEventCallbackRef := TDictionary<Integer,TSocketIOCallbackRef>.Create;
|
FSocketIOEventCallbackRef := TDictionary<Integer,TSocketIOCallbackRef>.Create;
|
||||||
|
FSocketIOErrorRef := TDictionary<Integer,TSocketIOError>.Create;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
destructor TIdBaseSocketIOHandling.Destroy;
|
destructor TIdBaseSocketIOHandling.Destroy;
|
||||||
|
@ -189,6 +193,7 @@ var squid: string;
|
||||||
begin
|
begin
|
||||||
FSocketIOEventCallback.Free;
|
FSocketIOEventCallback.Free;
|
||||||
FSocketIOEventCallbackRef.Free;
|
FSocketIOEventCallbackRef.Free;
|
||||||
|
FSocketIOErrorRef.Free;
|
||||||
|
|
||||||
FOnEventList.Free;
|
FOnEventList.Free;
|
||||||
FOnConnectionList.Free;
|
FOnConnectionList.Free;
|
||||||
|
@ -348,7 +353,7 @@ procedure TIdBaseSocketIOHandling.ProcessCloseChannel(
|
||||||
begin
|
begin
|
||||||
if aChannel <> '' then
|
if aChannel <> '' then
|
||||||
//todo: close channel
|
//todo: close channel
|
||||||
else
|
else if (ASocket.FContext <> nil) then
|
||||||
ASocket.FContext.Connection.Disconnect;
|
ASocket.FContext.Connection.Disconnect;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -576,6 +581,8 @@ var
|
||||||
callback: TSocketIOCallback;
|
callback: TSocketIOCallback;
|
||||||
callbackref: TSocketIOCallbackRef;
|
callbackref: TSocketIOCallbackRef;
|
||||||
callbackobj: TSocketIOCallbackObj;
|
callbackobj: TSocketIOCallbackObj;
|
||||||
|
errorref: TSocketIOError;
|
||||||
|
error: ISuperObject;
|
||||||
begin
|
begin
|
||||||
if not FConnections.ContainsValue(ASocket) and
|
if not FConnections.ContainsValue(ASocket) and
|
||||||
not FConnectionsGUID.ContainsValue(ASocket) then
|
not FConnectionsGUID.ContainsValue(ASocket) then
|
||||||
|
@ -640,7 +647,15 @@ begin
|
||||||
callbackobj.FHandling := Self;
|
callbackobj.FHandling := Self;
|
||||||
callbackobj.FSocket := ASocket;
|
callbackobj.FSocket := ASocket;
|
||||||
callbackobj.FMsgNr := imsg;
|
callbackobj.FMsgNr := imsg;
|
||||||
|
try
|
||||||
OnSocketIOMsg(ASocket, sdata, callbackobj); //, imsg, bCallback);
|
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
|
finally
|
||||||
callbackobj.Free;
|
callbackobj.Free;
|
||||||
end
|
end
|
||||||
|
@ -665,7 +680,15 @@ begin
|
||||||
callbackobj.FHandling := Self;
|
callbackobj.FHandling := Self;
|
||||||
callbackobj.FSocket := ASocket;
|
callbackobj.FSocket := ASocket;
|
||||||
callbackobj.FMsgNr := imsg;
|
callbackobj.FMsgNr := imsg;
|
||||||
|
try
|
||||||
OnSocketIOJson(ASocket, SO(sdata), callbackobj); //, imsg, bCallback);
|
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
|
finally
|
||||||
callbackobj.Free;
|
callbackobj.Free;
|
||||||
end
|
end
|
||||||
|
@ -700,6 +723,24 @@ begin
|
||||||
imsg := StrToIntDef(smsg, 0);
|
imsg := StrToIntDef(smsg, 0);
|
||||||
sData := Copy(sdata, Pos('+', sData)+1, Length(sData));
|
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
|
if FSocketIOEventCallback.TryGetValue(imsg, callback) then
|
||||||
begin
|
begin
|
||||||
FSocketIOEventCallback.Remove(imsg);
|
FSocketIOEventCallback.Remove(imsg);
|
||||||
|
@ -782,7 +823,7 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIdBaseSocketIOHandling.WriteSocketIOEvent(const ASocket: TSocketIOContext; const aRoom, aEventName,
|
procedure TIdBaseSocketIOHandling.WriteSocketIOEvent(const ASocket: TSocketIOContext; const aRoom, aEventName,
|
||||||
aJSONArray: string; aCallback: TSocketIOCallback);
|
aJSONArray: string; aCallback: TSocketIOCallback; const aOnError: TSocketIOError);
|
||||||
var
|
var
|
||||||
sresult: string;
|
sresult: string;
|
||||||
begin
|
begin
|
||||||
|
@ -799,12 +840,15 @@ begin
|
||||||
sresult := Format('5:%d+:%s:{"name":"%s", "args":%s}',
|
sresult := Format('5:%d+:%s:{"name":"%s", "args":%s}',
|
||||||
[FSocketIOMsgNr, aRoom, aEventName, aJSONArray]);
|
[FSocketIOMsgNr, aRoom, aEventName, aJSONArray]);
|
||||||
FSocketIOEventCallback.Add(FSocketIOMsgNr, aCallback);
|
FSocketIOEventCallback.Add(FSocketIOMsgNr, aCallback);
|
||||||
|
|
||||||
|
if Assigned(aOnError) then
|
||||||
|
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
|
||||||
end;
|
end;
|
||||||
WriteString(ASocket, sresult);
|
WriteString(ASocket, sresult);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIdBaseSocketIOHandling.WriteSocketIOEventRef(const ASocket: TSocketIOContext;
|
procedure TIdBaseSocketIOHandling.WriteSocketIOEventRef(const ASocket: TSocketIOContext;
|
||||||
const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef);
|
const aRoom, aEventName, aJSONArray: string; aCallback: TSocketIOCallbackRef; const aOnError: TSocketIOError);
|
||||||
var
|
var
|
||||||
sresult: string;
|
sresult: string;
|
||||||
begin
|
begin
|
||||||
|
@ -821,12 +865,15 @@ begin
|
||||||
sresult := Format('5:%d+:%s:{"name":"%s", "args":%s}',
|
sresult := Format('5:%d+:%s:{"name":"%s", "args":%s}',
|
||||||
[FSocketIOMsgNr, aRoom, aEventName, aJSONArray]);
|
[FSocketIOMsgNr, aRoom, aEventName, aJSONArray]);
|
||||||
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
|
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
|
||||||
|
|
||||||
|
if Assigned(aOnError) then
|
||||||
|
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
|
||||||
end;
|
end;
|
||||||
WriteString(ASocket, sresult);
|
WriteString(ASocket, sresult);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIdBaseSocketIOHandling.WriteSocketIOJSON(const ASocket: TSocketIOContext;
|
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
|
var
|
||||||
sresult: string;
|
sresult: string;
|
||||||
begin
|
begin
|
||||||
|
@ -843,13 +890,16 @@ begin
|
||||||
sresult := Format('4:%d+:%s:%s',
|
sresult := Format('4:%d+:%s:%s',
|
||||||
[FSocketIOMsgNr, aRoom, aJSON]);
|
[FSocketIOMsgNr, aRoom, aJSON]);
|
||||||
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
|
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
|
||||||
|
|
||||||
|
if Assigned(aOnError) then
|
||||||
|
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
WriteString(ASocket, sresult);
|
WriteString(ASocket, sresult);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIdBaseSocketIOHandling.WriteSocketIOMsg(const ASocket: TSocketIOContext;
|
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
|
var
|
||||||
sresult: string;
|
sresult: string;
|
||||||
begin
|
begin
|
||||||
|
@ -866,6 +916,9 @@ begin
|
||||||
sresult := Format('3:%d+:%s:%s',
|
sresult := Format('3:%d+:%s:%s',
|
||||||
[FSocketIOMsgNr, aRoom, aData]);
|
[FSocketIOMsgNr, aRoom, aData]);
|
||||||
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
|
FSocketIOEventCallbackRef.Add(FSocketIOMsgNr, aCallback);
|
||||||
|
|
||||||
|
if Assigned(aOnError) then
|
||||||
|
FSocketIOErrorRef.Add(FSocketIOMsgNr, aOnError);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
WriteString(ASocket, sresult);
|
WriteString(ASocket, sresult);
|
||||||
|
@ -896,7 +949,7 @@ begin
|
||||||
|
|
||||||
if (ASocket.FIOHandler <> nil) then
|
if (ASocket.FIOHandler <> nil) then
|
||||||
begin
|
begin
|
||||||
Assert(ASocket.FIOHandler.IsWebsocket);
|
//Assert(ASocket.FIOHandler.IsWebsocket);
|
||||||
if DebugHook <> 0 then
|
if DebugHook <> 0 then
|
||||||
Windows.OutputDebugString(PChar('Send: ' + aText));
|
Windows.OutputDebugString(PChar('Send: ' + aText));
|
||||||
ASocket.FIOHandler.Write(aText);
|
ASocket.FIOHandler.Write(aText);
|
||||||
|
@ -915,9 +968,15 @@ end;
|
||||||
|
|
||||||
{ TSocketIOCallbackObj }
|
{ TSocketIOCallbackObj }
|
||||||
|
|
||||||
|
function TSocketIOCallbackObj.IsResponseSend: Boolean;
|
||||||
|
begin
|
||||||
|
Result := (FMsgNr < 0);
|
||||||
|
end;
|
||||||
|
|
||||||
procedure TSocketIOCallbackObj.SendResponse(const aResponse: string);
|
procedure TSocketIOCallbackObj.SendResponse(const aResponse: string);
|
||||||
begin
|
begin
|
||||||
FHandling.WriteSocketIOResult(FSocket, FMsgNr, '', aResponse);
|
FHandling.WriteSocketIOResult(FSocket, FMsgNr, '', aResponse);
|
||||||
|
FMsgNr := -1;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{ TSocketIOContext }
|
{ TSocketIOContext }
|
||||||
|
@ -940,17 +999,17 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject;
|
procedure TSocketIOContext.EmitEvent(const aEventName: string; const aData: ISuperObject;
|
||||||
const aCallback: TSocketIOMsgJSON);
|
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||||
begin
|
begin
|
||||||
if not Assigned(aCallback) then
|
if not Assigned(aCallback) then
|
||||||
FHandling.WriteSocketIOEvent(Self, '', aEventName, aData.AsJSon, nil)
|
FHandling.WriteSocketIOEvent(Self, '', aEventName, aData.AsJSon, nil, nil)
|
||||||
else
|
else
|
||||||
begin
|
begin
|
||||||
FHandling.WriteSocketIOEventRef(Self, '', aEventName, aData.AsJSon,
|
FHandling.WriteSocketIOEventRef(Self, '', aEventName, aData.AsJSon,
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(Self, SO(aData), nil);
|
aCallback(Self, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -1007,7 +1066,7 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TSocketIOContext.Send(const aData: string;
|
procedure TSocketIOContext.Send(const aData: string;
|
||||||
const aCallback: TSocketIOMsgJSON);
|
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||||
begin
|
begin
|
||||||
if not Assigned(aCallback) then
|
if not Assigned(aCallback) then
|
||||||
FHandling.WriteSocketIOMsg(Self, '', aData)
|
FHandling.WriteSocketIOMsg(Self, '', aData)
|
||||||
|
@ -1017,12 +1076,12 @@ begin
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(Self, SO(aData), nil);
|
aCallback(Self, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject;
|
procedure TSocketIOContext.SendJSON(const aJSON: ISuperObject;
|
||||||
const aCallback: TSocketIOMsgJSON);
|
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||||
begin
|
begin
|
||||||
if not Assigned(aCallback) then
|
if not Assigned(aCallback) then
|
||||||
FHandling.WriteSocketIOJSON(Self, '', aJSON.AsJSon())
|
FHandling.WriteSocketIOJSON(Self, '', aJSON.AsJSon())
|
||||||
|
@ -1032,7 +1091,7 @@ begin
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(Self, SO(aData), nil);
|
aCallback(Self, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -1131,7 +1190,7 @@ end;
|
||||||
{ TIdSocketIOHandling }
|
{ TIdSocketIOHandling }
|
||||||
|
|
||||||
procedure TIdSocketIOHandling.Emit(const aEventName: string;
|
procedure TIdSocketIOHandling.Emit(const aEventName: string;
|
||||||
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON);
|
const aData: ISuperObject; const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||||
var
|
var
|
||||||
context: TSocketIOContext;
|
context: TSocketIOContext;
|
||||||
jsonarray: string;
|
jsonarray: string;
|
||||||
|
@ -1154,13 +1213,13 @@ begin
|
||||||
if context.IsDisconnected then Continue;
|
if context.IsDisconnected then Continue;
|
||||||
|
|
||||||
if not Assigned(aCallback) then
|
if not Assigned(aCallback) then
|
||||||
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
|
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
|
||||||
else
|
else
|
||||||
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
|
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(context, SO(aData), nil);
|
aCallback(context, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
Inc(isendcount);
|
Inc(isendcount);
|
||||||
end;
|
end;
|
||||||
for context in FConnectionsGUID.Values do
|
for context in FConnectionsGUID.Values do
|
||||||
|
@ -1168,13 +1227,13 @@ begin
|
||||||
if context.IsDisconnected then Continue;
|
if context.IsDisconnected then Continue;
|
||||||
|
|
||||||
if not Assigned(aCallback) then
|
if not Assigned(aCallback) then
|
||||||
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil)
|
WriteSocketIOEvent(context, ''{no room}, aEventName, jsonarray, nil, nil)
|
||||||
else
|
else
|
||||||
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
|
WriteSocketIOEventRef(context, ''{no room}, aEventName, jsonarray,
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(context, SO(aData), nil);
|
aCallback(context, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
Inc(isendcount);
|
Inc(isendcount);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -1186,7 +1245,7 @@ begin
|
||||||
end;
|
end;
|
||||||
|
|
||||||
procedure TIdSocketIOHandling.Send(const aMessage: string;
|
procedure TIdSocketIOHandling.Send(const aMessage: string;
|
||||||
const aCallback: TSocketIOMsgJSON);
|
const aCallback: TSocketIOMsgJSON; const aOnError: TSocketIOError);
|
||||||
var
|
var
|
||||||
context: TSocketIOContext;
|
context: TSocketIOContext;
|
||||||
isendcount: Integer;
|
isendcount: Integer;
|
||||||
|
@ -1209,7 +1268,7 @@ begin
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(context, SO(aData), nil);
|
aCallback(context, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
Inc(isendcount);
|
Inc(isendcount);
|
||||||
end;
|
end;
|
||||||
for context in FConnectionsGUID.Values do
|
for context in FConnectionsGUID.Values do
|
||||||
|
@ -1225,7 +1284,7 @@ begin
|
||||||
procedure(const aData: string)
|
procedure(const aData: string)
|
||||||
begin
|
begin
|
||||||
aCallback(context, SO(aData), nil);
|
aCallback(context, SO(aData), nil);
|
||||||
end);
|
end, aOnError);
|
||||||
Inc(isendcount);
|
Inc(isendcount);
|
||||||
end;
|
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
|
var
|
||||||
iEventNr: Integer;
|
iEventNr: Integer;
|
||||||
cWSNR: array[0..High(C_RO_WS_NR)] of AnsiChar;
|
cWSNR: array[0..High(C_RO_WS_NR)] of AnsiChar;
|
||||||
|
s: string;
|
||||||
begin
|
begin
|
||||||
if aEvent.Size > Length(C_RO_WS_NR) + SizeOf(iEventNr) then
|
if aEvent.Size > Length(C_RO_WS_NR) + SizeOf(iEventNr) then
|
||||||
begin
|
begin
|
||||||
|
@ -415,7 +416,16 @@ begin
|
||||||
if cWSNR = C_RO_WS_NR then
|
if cWSNR = C_RO_WS_NR then
|
||||||
begin
|
begin
|
||||||
aEvent.Read(iEventNr, SizeOf(iEventNr));
|
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
|
//trunc
|
||||||
aEvent.Size := aEvent.Size - Length(C_RO_WS_NR) - SizeOf(iEventNr);
|
aEvent.Size := aEvent.Size - Length(C_RO_WS_NR) - SizeOf(iEventNr);
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue