diff --git a/samples/serversentevent_for_indy_based_servers/MainSSEClientViewerFormU.dfm b/samples/serversentevent_for_indy_based_servers/MainSSEClientViewerFormU.dfm new file mode 100644 index 00000000..de63200d --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/MainSSEClientViewerFormU.dfm @@ -0,0 +1,26 @@ +object MainForm: TMainForm + Left = 0 + Top = 0 + Caption = 'SSEClient Sample' + ClientHeight = 355 + ClientWidth = 741 + Color = clBtnFace + Font.Charset = DEFAULT_CHARSET + Font.Color = clWindowText + Font.Height = -12 + Font.Name = 'Segoe UI' + Font.Style = [] + OnCreate = FormCreate + OnDestroy = FormDestroy + TextHeight = 15 + object MessagesMemo: TMemo + Left = 0 + Top = 0 + Width = 741 + Height = 355 + Align = alClient + TabOrder = 0 + ExplicitWidth = 737 + ExplicitHeight = 354 + end +end diff --git a/samples/serversentevent_for_indy_based_servers/MainSSEClientViewerFormU.pas b/samples/serversentevent_for_indy_based_servers/MainSSEClientViewerFormU.pas new file mode 100644 index 00000000..0960f000 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/MainSSEClientViewerFormU.pas @@ -0,0 +1,65 @@ +unit MainSSEClientViewerFormU; + +interface + +uses + Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, + Vcl.Controls, Vcl.Forms, Vcl.Dialogs, MVCFramework.SSEClient, Vcl.StdCtrls; + +type + TMainForm = class(TForm) + MessagesMemo: TMemo; + procedure FormCreate(Sender: TObject); + procedure FormDestroy(Sender: TObject); + private + fSSEClient: TMVCSSEClient; + procedure OnSSEMessage(Sender: TObject; const MessageID: Integer; const Event, Data: string); + { Private declarations } + public + { Public declarations } + end; + +var + MainForm: TMainForm; + +implementation + +{$R *.dfm} + +procedure TMainForm.FormCreate(Sender: TObject); +begin + fSSEClient := TMVCSSEClient.Create('http://localhost:8080/stocks'); + fSSEClient.OnSSEEvent := OnSSEMessage; + fSSEClient.Start; +end; + +procedure TMainForm.FormDestroy(Sender: TObject); +begin + fSSEClient.Free; +end; + +procedure TMainForm.OnSSEMessage(Sender: TObject; const MessageID: Integer; + const Event, Data: string); +var + lMessageID: Integer; + lEvent, lData: string; +begin + lMessageID:= MessageID; + lEvent := Event; + lData:= Data; + TThread.Queue(nil, + procedure + begin + if Assigned(Self) and Assigned(MessagesMemo) then + begin + MessagesMemo.Lines.Add( + Format('ID: %d; Event: %s; Data: %s', [ + lMessageID, + lEvent, + lData + ])); + end; + end) +end; + +end. diff --git a/samples/serversentevent_for_indy_based_servers/ProjectGroup.groupproj b/samples/serversentevent_for_indy_based_servers/ProjectGroup.groupproj new file mode 100644 index 00000000..90449fa7 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/ProjectGroup.groupproj @@ -0,0 +1,48 @@ + + + {4A748032-8D79-477C-97CC-13AC36704CA5} + + + + + + + + + + + Default.Personality.12 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/samples/serversentevent_for_indy_based_servers/SSEClientViewer.dpr b/samples/serversentevent_for_indy_based_servers/SSEClientViewer.dpr new file mode 100644 index 00000000..3af6402c --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/SSEClientViewer.dpr @@ -0,0 +1,14 @@ +program SSEClientViewer; + +uses + Vcl.Forms, + MainSSEClientViewerFormU in 'MainSSEClientViewerFormU.pas' {MainForm}; + +{$R *.res} + +begin + Application.Initialize; + Application.MainFormOnTaskbar := True; + Application.CreateForm(TMainForm, MainForm); + Application.Run; +end. diff --git a/samples/serversentevent_for_indy_based_servers/SSEClientViewer.dproj b/samples/serversentevent_for_indy_based_servers/SSEClientViewer.dproj new file mode 100644 index 00000000..b8d2bc52 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/SSEClientViewer.dproj @@ -0,0 +1,966 @@ + + + {2C88FE3E-BCD9-4716-A13F-AF137D0CFF6E} + 19.5 + VCL + True + Debug + Win32 + 1 + Application + SSEClientViewer.dpr + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + .\$(Platform)\$(Config) + .\$(Platform)\$(Config) + false + false + false + false + false + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png + $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png + SSEClientViewer + + + RaizeComponentsVcl;JvNet;vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;VCLRESTComponents;FireDACCommonODBC;DBXMSSQLDriver;IndyIPCommon;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;Skia.Package.RTL;dbxcds;vcledge;IndyIPClient;bindcompvclwinx;FmxTeeUI;emsedge;bindcompfmx;DBXFirebirdDriver;JvBands;inetdb;JvAppFrm;ibmonitor;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;Tee;soapmidas;SVGIconImageListFMX;JclVcl;vclactnband;TeeUI;fmxFireDAC;dbexpress;Python;Jcl;FireDACInfxDriver;JvManagedThreads;CEF4DelphiVCLRTL;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;JvPascalInterpreter;PythonVcl;vcltouch;fmxase;JvPluginSystem;DBXOdbcDriver;JvDB;dbrtl;JvTimeFramework;FireDACDBXDriver;FireDACOracleDriver;Skia.Package.FMX;fmxdae;TeeDB;FireDACMSAccDriver;JvCustom;CustomIPTransport;FireDACMSSQLDriver;SVGIconPackage;JvSystem;DataSnapIndy10ServerTransport;JclDeveloperTools;JvControls;CEF4DelphiFMXRTL;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;JvCrypt;FireDACMongoDBDriver;JvJans;JvMM;IndySystem;JvWizards;FireDACTDataDriver;Skia.Package.VCL;JvGlobus;vcldb;ibxbindings;StyledComponents;SynEditDR;JclContainers;JvPageComps;vclFireDAC;JvCore;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;dmvcframeworkDT;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RaizeComponentsVclDb;MobilePermissions;RESTComponents;DBXSqliteDriver;vcl;dsnapxml;adortl;dsnapcon;DataSnapClient;DataSnapProviderClient;JvDotNetCtrls;JvHMI;IndyIPServer;DBXSybaseASEDriver;LockBoxDR;JvRuntimeDesign;DBXDb2Driver;JvXPCtrls;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;JvStdCtrls;ibxpress;JvDlgs;JvDocking;bindcompvcl;dsnap;JvPrintPreview;JvCmp;dmvcframeworkRT;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;vclib;fmxobj;bindcompvclsmp;FMXTee;DataSnapNativeClient;PythonFmx;DatasnapConnectorsFreePascal;soaprtl;SVGIconImageList;soapserver;FireDACIBDriver;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + true + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + $(BDS)\bin\default_app.manifest + + + RaizeComponentsVcl;vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;VCLRESTComponents;FireDACCommonODBC;DBXMSSQLDriver;IndyIPCommon;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;Skia.Package.RTL;dbxcds;vcledge;IndyIPClient;bindcompvclwinx;FmxTeeUI;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;ibmonitor;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;Tee;soapmidas;SVGIconImageListFMX;vclactnband;TeeUI;fmxFireDAC;dbexpress;Python;FireDACInfxDriver;CEF4DelphiVCLRTL;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;PythonVcl;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;Skia.Package.FMX;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;SVGIconPackage;DataSnapIndy10ServerTransport;CEF4DelphiFMXRTL;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;Skia.Package.VCL;vcldb;ibxbindings;StyledComponents;SynEditDR;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RaizeComponentsVclDb;RESTComponents;DBXSqliteDriver;vcl;dsnapxml;adortl;dsnapcon;DataSnapClient;DataSnapProviderClient;IndyIPServer;DBXSybaseASEDriver;LockBoxDR;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;ibxpress;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;vclib;fmxobj;bindcompvclsmp;FMXTee;DataSnapNativeClient;PythonFmx;DatasnapConnectorsFreePascal;soaprtl;SVGIconImageList;soapserver;FireDACIBDriver;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + true + true + + + false + PerMonitorV2 + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + PerMonitorV2 + + + + MainSource + + +
MainForm
+ dfm + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Application + + + + SSEClientViewer.dpr + + + + + + SSEClientViewer.exe + true + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + classes + 64 + + + classes + 64 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + Contents\MacOS + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + Contents\MacOS + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + Contents\Resources\StartUp\ + 0 + + + 0 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).launchscreen + 64 + + + ..\$(PROJECTNAME).launchscreen + 64 + + + + + 1 + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + ..\ + 1 + + + ..\ + 1 + + + ..\ + 1 + + + + + Contents + 1 + + + Contents + 1 + + + Contents + 1 + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + Contents\MacOS + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + + True + False + + + 12 + + + + + diff --git a/samples/serversentevent_for_indy_based_servers/SSEControllerU.pas b/samples/serversentevent_for_indy_based_servers/SSEControllerU.pas new file mode 100644 index 00000000..7d1785a0 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/SSEControllerU.pas @@ -0,0 +1,39 @@ +unit SSEControllerU; + + +interface + +uses + MVCFramework, MVCFramework.Commons, MVCFramework.SSEController; + +type + [MVCPath('/stocks')] + TMySSEController = class(TMVCSSEController) + protected + function GetServerSentEvents(const LastEventID: String): TMVCSSEMessages; override; + end; + +implementation + +uses + MVCFramework.Logger, System.SysUtils, StorageU, System.DateUtils; + +{ TMySSEController } + +function TMySSEController.GetServerSentEvents(const LastEventID: String): TMVCSSEMessages; +var + lCurrentEventID: Integer; + lSSEMessage: TSSEMessage; +begin + Sleep(1000); + lSSEMessage.Event := 'stockupdate'; + lSSEMessage.Data := GetNextDataToSend(StrToIntDef(LastEventID, 0), lCurrentEventID); + lSSEMessage.Id := lCurrentEventID.ToString; + lSSEMessage.Retry := 300; + Result := [ + lSSEMessage + ]; +end; + +end. + diff --git a/samples/serversentevent_for_indy_based_servers/SSEIndyBasedSample.dpr b/samples/serversentevent_for_indy_based_servers/SSEIndyBasedSample.dpr new file mode 100644 index 00000000..cc94c967 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/SSEIndyBasedSample.dpr @@ -0,0 +1,67 @@ +program SSEIndyBasedSample; + +{$APPTYPE CONSOLE} + +uses + System.SysUtils, + MVCFramework, + MVCFramework.Signal, + MVCFramework.Logger, + MVCFramework.Commons, +{$IFDEF MSWINDOWS} + Winapi.Windows, + Winapi.ShellAPI, +{$ENDIF} + ReqMulti, + Web.WebReq, + Web.WebBroker, + IdHTTPWebBrokerBridge, + SSEControllerU in 'SSEControllerU.pas', + WebModuleU in 'WebModuleU.pas' {MyWebModule: TWebModule} , + StorageU in 'StorageU.pas'; + +{$R *.res} + +procedure RunServer(APort: Integer); +var + LServer: TIdHTTPWebBrokerBridge; +begin + Writeln('** DMVCFramework Server ** build ' + DMVCFRAMEWORK_VERSION); + Writeln(Format('Starting HTTP Server on port %d', [APort])); + LServer := TIdHTTPWebBrokerBridge.Create(nil); + try + LServer.KeepAlive := True; + LServer.DefaultPort := APort; + { more info about MaxConnections + http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_MaxConnections.html } + LServer.MaxConnections := 0; + { more info about ListenQueue + http://www.indyproject.org/docsite/html/frames.html?frmname=topic&frmfile=TIdCustomTCPServer_ListenQueue.html } + LServer.ListenQueue := 200; + LServer.Active := True; + { Comment the next line to avoid the default browser startup } +{$IFDEF MSWINDOWS} + ShellExecute(0, 'open', PChar('http://localhost:' + inttostr(APort) + '/static'), nil, nil, SW_SHOWMAXIMIZED); +{$ENDIF} + Write('CTRL+C to stop the server'); + WaitForTerminationSignal; + EnterInShutdownState; + finally + LServer.Free; + end; +end; + +begin + ReportMemoryLeaksOnShutdown := True; + IsMultiThread := True; + try + if WebRequestHandler <> nil then + WebRequestHandler.WebModuleClass := WebModuleClass; + WebRequestHandlerProc.MaxConnections := 1024; + RunServer(8080); + except + on E: Exception do + Writeln(E.ClassName, ': ', E.Message); + end; + +end. diff --git a/samples/serversentevent_for_indy_based_servers/SSEIndyBasedSample.dproj b/samples/serversentevent_for_indy_based_servers/SSEIndyBasedSample.dproj new file mode 100644 index 00000000..2eff2ea3 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/SSEIndyBasedSample.dproj @@ -0,0 +1,897 @@ + + + {56928A09-5B7B-4920-ABAA-CB68F0AC2958} + 19.5 + VCL + SSEIndyBasedSample.dpr + True + Debug + Win32 + 1 + Console + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + .\$(Platform)\$(Config) + .\ + false + false + false + false + false + RESTComponents;emsclientfiredac;FireDACIBDriver;emsclient;FireDACCommon;RESTBackendComponents;soapserver;CloudService;FireDACCommonDriver;inet;FireDAC;FireDACSqliteDriver;soaprtl;soapmidas;$(DCC_UsePackage) + System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;$(DCC_Namespace) + true + $(BDS)\bin\delphi_PROJECTICON.ico + $(BDS)\bin\delphi_PROJECTICNS.icns + $(DMVC);$(DCC_UnitSearchPath) + VCL;$(DCC_Framework) + SSEIndyBasedSample + 1040 + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + + + true + Base + true + DBXSqliteDriver;DBXInterBaseDriver;DataSnapFireDAC;tethering;bindcompfmx;FmxTeeUI;fmx;RadiantShapesFmx;FireDACDBXDriver;dbexpress;IndyCore;dsnap;DataSnapCommon;bindengine;DataSnapClient;bindcompdbx;IndyIPCommon;IndyIPServer;IndySystem;fmxFireDAC;ibmonitor;FMXTee;DbxCommonDriver;ibxpress;xmlrtl;DataSnapNativeClient;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;CustomIPTransport;bindcomp;IndyIPClient;dbxcds;dsnapxml;DataSnapProviderClient;dbrtl;IndyProtocols;$(DCC_UsePackage);$(DCC_UsePackage) + android-support-v4.dex.jar;cloud-messaging.dex.jar;fmx.dex.jar;google-analytics-v2.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar;google-play-services.dex.jar + $(BDS)\bin\Artwork\Android\FM_LauncherIcon_192x192.png + + + DataSnapServerMidas;FireDACADSDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;inetdb;emsedge;IndyCore;dsnap;DataSnapCommon;DataSnapConnectors;bindengine;FireDACOracleDriver;FireDACMySQLDriver;FireDACCommonODBC;DataSnapClient;IndySystem;FireDACDb2Driver;FireDACInfxDriver;emshosting;FireDACPgDriver;FireDACASADriver;FireDACTDataDriver;DbxCommonDriver;DataSnapServer;xmlrtl;DataSnapNativeClient;rtl;DbxClientDriver;CustomIPTransport;bindcomp;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;dbrtl;FireDACMongoDBDriver;IndyProtocols;$(DCC_UsePackage) + + + DBXSqliteDriver;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;DataSnapFireDAC;svnui;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;svn;Intraweb;DBXOracleDriver;inetdb;RaizeComponentsVcl;FmxTeeUI;emsedge;RaizeComponentsVclDb;fmx;fmxdae;RadiantShapesFmx;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;DataSnapConnectors;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;RadiantShapesFmx_Design;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) + Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + Debug + CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= + 1033 + + + DBXSqliteDriver;DataSnapServerMidas;DBXDb2Driver;DBXInterBaseDriver;vclactnband;vclFireDAC;DataSnapFireDAC;tethering;FireDACADSDriver;DBXMSSQLDriver;DatasnapConnectorsFreePascal;FireDACMSSQLDriver;vcltouch;vcldb;bindcompfmx;Intraweb;DBXOracleDriver;inetdb;RaizeComponentsVcl;FmxTeeUI;emsedge;RaizeComponentsVclDb;fmx;fmxdae;RadiantShapesFmx;vclib;FireDACDBXDriver;dbexpress;IndyCore;vclx;dsnap;DataSnapCommon;DataSnapConnectors;VCLRESTComponents;vclie;bindengine;DBXMySQLDriver;FireDACOracleDriver;FireDACMySQLDriver;DBXFirebirdDriver;FireDACCommonODBC;DataSnapClient;bindcompdbx;IndyIPCommon;vcl;DBXSybaseASEDriver;IndyIPServer;IndySystem;FireDACDb2Driver;dsnapcon;FireDACMSAccDriver;fmxFireDAC;FireDACInfxDriver;vclimg;TeeDB;emshosting;FireDACPgDriver;ibmonitor;FireDACASADriver;DBXOdbcDriver;FireDACTDataDriver;FMXTee;DbxCommonDriver;ibxpress;Tee;DataSnapServer;xmlrtl;DataSnapNativeClient;fmxobj;vclwinx;ibxbindings;rtl;FireDACDSDriver;DbxClientDriver;DBXSybaseASADriver;CustomIPTransport;vcldsnap;bindcomp;appanalytics;DBXInformixDriver;IndyIPClient;bindcompvcl;TeeUI;dbxcds;VclSmp;adortl;FireDACODBCDriver;DataSnapIndy10ServerTransport;dsnapxml;DataSnapProviderClient;dbrtl;inetdbxpress;FireDACMongoDBDriver;IndyProtocols;fmxase;$(DCC_UsePackage) + + + DEBUG;$(DCC_Define) + true + false + true + true + true + + + false + 1033 + (None) + + + false + RELEASE;$(DCC_Define) + 0 + 0 + + + + MainSource + + + +
MyWebModule
+ TWebModule + + + + Base + + + Cfg_1 + Base + + + Cfg_2 + Base + + + + Delphi.Personality.12 + Console + + + + SSEIndyBasedSample.dpr + + + Embarcadero C++Builder Office 2000 Servers Package + Embarcadero C++Builder Office XP Servers Package + Microsoft Office 2000 Sample Automation Server Wrapper Components + Microsoft Office XP Sample Automation Server Wrapper Components + + + + + + + + + + SSEIndyBasedSample.exe + true + + + + + + 1 + + + 0 + + + + + classes + 64 + + + classes + 64 + + + + + res\xml + 1 + + + res\xml + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\armeabi + 1 + + + library\lib\armeabi + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + library\lib\mips + 1 + + + library\lib\mips + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + + + library\lib\armeabi-v7a + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\values-v21 + 1 + + + res\values-v21 + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + res\drawable + 1 + + + res\drawable + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-ldpi + 1 + + + res\drawable-ldpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-mdpi + 1 + + + res\drawable-mdpi + 1 + + + + + res\drawable-hdpi + 1 + + + res\drawable-hdpi + 1 + + + + + res\drawable-xhdpi + 1 + + + res\drawable-xhdpi + 1 + + + + + res\drawable-xxhdpi + 1 + + + res\drawable-xxhdpi + 1 + + + + + res\drawable-xxxhdpi + 1 + + + res\drawable-xxxhdpi + 1 + + + + + res\drawable-small + 1 + + + res\drawable-small + 1 + + + + + res\drawable-normal + 1 + + + res\drawable-normal + 1 + + + + + res\drawable-large + 1 + + + res\drawable-large + 1 + + + + + res\drawable-xlarge + 1 + + + res\drawable-xlarge + 1 + + + + + res\values + 1 + + + res\values + 1 + + + + + 1 + + + 1 + + + 0 + + + + + 1 + .framework + + + 1 + .framework + + + 1 + .framework + + + 0 + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .dll;.bpl + + + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 1 + .dylib + + + 0 + .bpl + + + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + 0 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\LaunchScreenImage.imageset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + ..\$(PROJECTNAME).launchscreen\Assets\AppIcon.appiconset + 1 + + + + + 1 + + + 1 + + + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF + 1 + + + + + + + + 1 + + + 1 + + + 1 + + + + + + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + Contents\Resources + 1 + + + + + library\lib\armeabi-v7a + 1 + + + library\lib\arm64-v8a + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 1 + + + 0 + + + + + library\lib\armeabi-v7a + 1 + + + + + 1 + + + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + Assets + 1 + + + Assets + 1 + + + + + + + + + + + + + + + + + False + False + True + False + + + 12 + + + + + diff --git a/samples/serversentevent_for_indy_based_servers/StorageU.pas b/samples/serversentevent_for_indy_based_servers/StorageU.pas new file mode 100644 index 00000000..c17d25e1 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/StorageU.pas @@ -0,0 +1,43 @@ +unit StorageU; + +interface + +const + TITLES: array [1 .. 4] of string = ('IBM', 'AAPL', 'GOOG', 'MSFT'); + +function GetNextDataToSend(const LastID: Integer; + out CurrentEventID: Integer): string; + +implementation + +uses + System.JSON; + +function GetNextDataToSend(const LastID: Integer; + out CurrentEventID: Integer): string; +var + lIndex: Integer; + lJOBJ: TJSONObject; +begin + // You can get the "next" event reading the LastID or, as in this case, + // just send another event + + lIndex := LastID; + while lIndex = LastID do + begin + lIndex := Random(Length(Titles)) + 1; + end; + + lJOBJ := TJSONObject.Create; + try + lJOBJ.AddPair('stock', TITLES[lIndex]); + lJOBJ.AddPair('value', TJSONNumber.Create((500 + Random(200)) + + (Random(50) / 100))); + Result := lJOBJ.ToJSON; + CurrentEventID := LastID + 1; + finally + lJOBJ.Free; + end; +end; + +end. diff --git a/samples/serversentevent_for_indy_based_servers/WebModuleU.dfm b/samples/serversentevent_for_indy_based_servers/WebModuleU.dfm new file mode 100644 index 00000000..02d66b97 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/WebModuleU.dfm @@ -0,0 +1,7 @@ +object MyWebModule: TMyWebModule + OnCreate = WebModuleCreate + OnDestroy = WebModuleDestroy + Actions = <> + Height = 230 + Width = 415 +end diff --git a/samples/serversentevent_for_indy_based_servers/WebModuleU.pas b/samples/serversentevent_for_indy_based_servers/WebModuleU.pas new file mode 100644 index 00000000..1e797534 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/WebModuleU.pas @@ -0,0 +1,71 @@ +unit WebModuleU; + +interface + +uses System.SysUtils, + System.Classes, + Web.HTTPApp, + MVCFramework; + +type + TMyWebModule = class(TWebModule) + procedure WebModuleCreate(Sender: TObject); + procedure WebModuleDestroy(Sender: TObject); + private + FMVC: TMVCEngine; + public + { Public declarations } + end; + +var + WebModuleClass: TComponentClass = TMyWebModule; + +implementation + +{$R *.dfm} + +uses + SSEControllerU, + MVCFramework.Commons, + MVCFramework.Middleware.StaticFiles; + +procedure TMyWebModule.WebModuleCreate(Sender: TObject); +begin + FMVC := TMVCEngine.Create(Self, + procedure(Config: TMVCConfig) + begin + // session timeout (0 means session cookie) + Config[TMVCConfigKey.SessionTimeout] := '0'; + // default content-type + Config[TMVCConfigKey.DefaultContentType] := + TMVCConstants.DEFAULT_CONTENT_TYPE; + // default content charset + Config[TMVCConfigKey.DefaultContentCharset] := + TMVCConstants.DEFAULT_CONTENT_CHARSET; + // unhandled actions are permitted? + Config[TMVCConfigKey.AllowUnhandledAction] := 'false'; + // default view file extension + Config[TMVCConfigKey.DefaultViewFileExtension] := 'html'; + // view path + Config[TMVCConfigKey.ViewPath] := 'templates'; + // Enable Server Signature in response + Config[TMVCConfigKey.ExposeServerSignature] := 'true'; + end); + FMVC.AddController(TMySSEController, + function : TMVCController + begin + Result := TMySSEController.Create; + end); + FMVC.AddMiddleware(TMVCStaticFilesMiddleware.Create( + '/static', { StaticFilesPath } + 'www', { DocumentRoot } + 'index.html' {IndexDocument - Before it was named fallbackresource} + )); +end; + +procedure TMyWebModule.WebModuleDestroy(Sender: TObject); +begin + FMVC.Free; +end; + +end. diff --git a/samples/serversentevent_for_indy_based_servers/www/index.html b/samples/serversentevent_for_indy_based_servers/www/index.html new file mode 100644 index 00000000..63412af3 --- /dev/null +++ b/samples/serversentevent_for_indy_based_servers/www/index.html @@ -0,0 +1,184 @@ + + + + + + Server Sent Events DelphiMVCFramework Example (INDY Based Web Server) - Stock Tickets + + + + + + + + + +

Server Sent Events DelphiMVCFramework Example

+

for INDY based servers

+
+ +
+ Your browser does not support Server Sent Events. Please use Firefox or Google Chrome. +
+ +

+ This is a simple Server Sent Events (SSE) example using DelphiMVCFramework that updates stock prices when market moves. Data source is predefined array with titles. These is random delay between 500 msec and 1 sec between each event. +

+ +

Quotes

+ +
+
+
IBM
+
0
+
+
+
AAPL
+
0
+
+
+
GOOG
+
0
+
+
+
MSFT
+
0
+
+ +
+ +
+ +
+ + + + + \ No newline at end of file diff --git a/sources/MVCFramework.SSEClient.pas b/sources/MVCFramework.SSEClient.pas new file mode 100644 index 00000000..f761ff2a --- /dev/null +++ b/sources/MVCFramework.SSEClient.pas @@ -0,0 +1,240 @@ +// *************************************************************************** } +// +// Delphi MVC Framework +// +// Copyright (c) 2010-2022 Daniele Teti and the DMVCFramework Team +// +// https://github.com/danieleteti/delphimvcframework +// +// +// *************************************************************************** +// +// Licensed under the Apache License, Version 2.0 (the "License"); +// you may not use this file except in compliance with the License. +// You may obtain a copy of the License at +// +// http://www.apache.org/licenses/LICENSE-2.0 +// +// Unless required by applicable law or agreed to in writing, software +// distributed under the License is distributed on an "AS IS" BASIS, +// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +// See the License for the specific language governing permissions and +// limitations under the License. +// +// *************************************************************************** +// +// Original Code has been donated by radek@communicator.pl +// (https://github.com/danieleteti/delphimvcframework/issues/613#issuecomment-1368555870) +// +// Follows the original comments: +// Delphi EventSource Client (SSE) +// +// radek@communicator.pl +// +// With reference to the specification the only "data" +// field of SSE Message if required +// +// If you want to use https put the +// libeay32.dll and ssleay32.dll (64 or 32 bit) +// in the exe folder +// +// !!!!!! Please note !!!!!! +// +// Event OnSSEEvent is raised from the thread +// make sure you handler is thread safe ! +// +// Use OnQueryExtraHeaders to add custom headers such as +// cookies (Set-Cookie) or +// Authentication: Bearer XXX.YYY.ZZZ +// +// *************************************************************************** + +unit MVCFramework.SSEClient; + +interface + +uses + IdHTTP, IdGlobal, System.SysUtils, IdSSLOpenSSL, + System.Classes, System.Threading, IdComponent; + +type + TOnSSEEvent = procedure(Sender: TObject; const MessageID: Integer; const Event, Data: string) of object; + TOnQueryExtraHeaders = procedure(Sender: TObject; Headers: TStrings) of object; + + TMVCSSEClient = class(TObject) + private + fWorkingTask: ITask; + fLastEventId: integer; + fReconnectTimeout: integer; + fEventStream: TIdEventStream; + fIdHTTP: TIdHTTP; + fIdSSL: TIdSSLIOHandlerSocketOpenSSL; + fURL: string; + fOnSSEEvent: TOnSSEEvent; + fOnQueryExtraHeaders: TOnQueryExtraHeaders; + fTerminated: Boolean; + protected + procedure DataAvailable(const ABuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint); + procedure ExtractMessage(const ASSEMessage: string); virtual; + procedure OnSSEWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); + public + constructor Create(const AURL: string); + destructor Destroy; override; + property OnSSEEvent: TOnSSEEvent read FOnSSEEvent write FOnSSEEvent; + property OnQueryExtraHeaders: TOnQueryExtraHeaders read FOnQueryExtraHeaders write FOnQueryExtraHeaders; + procedure Start; + procedure Stop; + end; + +implementation + +uses + System.DateUtils; + +const + DefaultReconnectTimeout = 10000; + CRLF = #13#10; + +constructor TMVCSSEClient.Create(const AURL: string); +begin + inherited Create; + fTerminated := False; + fURL := AURL; + fIdHTTP := TIdHTTP.Create(nil); + + fIdSSL := nil; + if AURL.ToLower.StartsWith('https') then + begin + fIdSSL := TIdSSLIOHandlerSocketOpenSSL.Create(nil); + fIdSSL.SSLOptions.Method := sslvSSLv23; //wildcard for accepting all versions + fIdHTTP.IOHandler := fIdSSL; + end; + fIdHTTP.Request.Accept := 'text/event-stream'; + fIdHTTP.Request.CacheControl := 'no-store'; + + fEventStream := TIdEventStream.Create; + fEventStream.OnWrite := DataAvailable; + + fLastEventId := -1; +end; + +destructor TMVCSSEClient.Destroy; +begin + Stop; + + fIdHTTP.Free; + fIdSSL.Free; + fEventStream.Free; + inherited; +end; + +procedure TMVCSSEClient.ExtractMessage(const ASSEMessage: string); +var + SSEMessage: TStrings; + event, data: string; +begin + SSEMessage := TStringList.Create; + SSEMessage.NameValueSeparator := ':'; + try + SSEMessage.Text := ASSEMessage; + + if SSEMessage.IndexOfName('id')>-1 then + fLastEventId := SSEMessage.Values['id'].ToInteger; + if SSEMessage.IndexOfName('event')>-1 then + event := SSEMessage.Values['event']; + if SSEMessage.IndexOfName('data')>-1 then + data := SSEMessage.Values['data']; + if SSEMessage.IndexOfName('retry')>-1 then + fReconnectTimeout := StrToIntDef(SSEMessage.Values['retry'], DefaultReconnectTimeout); + + fOnSSEEvent(Self, fLastEventId, event, data); + finally + SSEMessage.Free; + end; +end; + +procedure TMVCSSEClient.OnSSEWork(ASender: TObject; AWorkMode: TWorkMode; + AWorkCount: Int64); +begin + if fTerminated then + begin + IndyRaiseLastError; + end; +end; + +procedure TMVCSSEClient.DataAvailable(const ABuffer: TIdBytes; AOffset, ACount: Longint; var VResult: Longint); +var + lData: string; + lSSEItems: TArray; + lSSEItem: string; +begin + lData := IndyTextEncoding_UTF8.GetString(ABuffer).Trim; + + //============================================================================== + // PARSE THE FOLLOWING: + // + // id: 1 + // event: sampleEvent + // data: testData1 + // retry: 10000 + // + // + // id: 2 + // event: sampleEvent + // data: testData2 + // retry: 10000 + //============================================================================== + + lSSEItems := lData.Split([CRLF+CRLF]); + for lSSEItem in lSSEItems do + ExtractMessage(lSSEItem); + +end; + +procedure TMVCSSEClient.Start; +var + lNextRetry: TDateTime; +begin + fReconnectTimeout := DefaultReconnectTimeout; + if not Assigned(fOnSSEEvent) then + raise Exception.Create('No event handler defined for OnSSEEvent'); + + if Assigned(FOnQueryExtraHeaders) then + fOnQueryExtraHeaders(Self, fIdHTTP.Request.CustomHeaders); + + fWorkingTask := TTask.Run( + procedure + begin + //while (fWorkingTask.Status = TTaskStatus.Running) do + while not fTerminated do + begin + try + fIdHTTP.Request.CustomHeaders.AddValue('Last-Event-ID', fLastEventId.ToString); + fIdHTTP.OnWork := OnSSEWork; + fIdHTTP.Get(FURL, fEventStream); + except + //non blocking Sleep + lNextRetry := IncMilliSecond(Now, fReconnectTimeout); + while Now < lNextRetry do + begin + if fWorkingTask.Status <> TTaskStatus.Running then + Break; + TThread.Yield; + end; + end; + end; + end); +end; + +procedure TMVCSSEClient.Stop; +begin + fTerminated := True; + if Assigned(fWorkingTask) then + begin +// fWorkingTask.Cancel; + TTask.WaitForAll([fWorkingTask]); //this never returns... + end; + fIdHTTP.Disconnect; +end; + +end.