unit mtTestWebSockets; interface uses TestFramework, IdHTTPWebsocketClient, IdServerWebsocketContext, IdWebsocketServer, IdContext, IdCustomHTTPServer; type TTextCallback = reference to procedure(aText: string); TTestWebSockets = class(TTestCase) private class var IndyHTTPWebsocketServer1: TIdWebsocketServer; class var IndyHTTPWebsocketClient1: TIdHTTPWebsocketClient; protected FLastWSMsg: string; FLastSocketIOMsg: string; procedure HandleHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); procedure WebsocketTextMessage(const aData: string); procedure HandleWebsocketTextMessage(const AContext: TIdServerWSContext; const aText: string); public procedure SetUp; override; procedure TearDown; override; published procedure CreateObjects; procedure StartServer; procedure TestPlainHttp; procedure TestWebsocketMsg; 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, IdIOHandlerWebsocket; 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.HandleHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); var sfile: string; begin if ARequestInfo.Document = '/index.html' then AResponseInfo.ContentText := 'dummy index.html' else begin sfile := ExtractFilePath(Application.ExeName) + ARequestInfo.Document; if FileExists(sfile) then AResponseInfo.ContentStream := TFileStream.Create(sfile, fmOpenRead); end; end; procedure TTestWebSockets.StartServer; begin IndyHTTPWebsocketServer1.Active := True; end; procedure TTestWebSockets.TestPlainHttp; var strm: TMemoryStream; s: string; client: TIdHTTPWebsocketClient; begin client := TIdHTTPWebsocketClient.Create(nil); try client.Host := 'localhost'; client.Port := 8099; client.SocketIOCompatible := False; //plain http now IndyHTTPWebsocketServer1.OnCommandGet := HandleHTTPServerCommandGet; IndyHTTPWebsocketServer1.OnCommandOther := HandleHTTPServerCommandGet; strm := TMemoryStream.Create; try client.Get('http://localhost:8099/index.html', strm); with TStreamReader.Create(strm) do begin strm.Position := 0; s := ReadToEnd; Free; end; CheckEquals('dummy index.html', s); finally strm.Free; end; finally client.Free; end; 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: ISocketIOCallback) 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: ISocketIOCallback) 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: ISocketIOCallback) begin Abort; end; IndyHTTPWebsocketClient1.SocketIO.Send('test message', procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback) 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: ISocketIOCallback) 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(True); IndyHTTPWebsocketClient1.ResetChannel; IndyHTTPWebsocketClient1.SocketIOCompatible := True; IndyHTTPWebsocketClient1.Connect; IndyHTTPWebsocketClient1.UpgradeToWebsocket; //* client to server */ FLastSocketIOMsg := ''; IndyHTTPWebsocketServer1.SocketIO.OnSocketIOMsg := procedure(const ASocket: ISocketIOContext; const aText: string; const aCallback: ISocketIOCallback) 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: ISocketIOCallback) 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; procedure TTestWebSockets.TestWebsocketMsg; var client: TIdHTTPWebsocketClient; begin client := TIdHTTPWebsocketClient.Create(nil); try client.Host := 'localhost'; client.Port := 8099; client.SocketIOCompatible := False; client.OnTextData := WebsocketTextMessage; IndyHTTPWebsocketServer1.OnMessageText := HandleWebsocketTextMessage; //client.Connect; client.UpgradeToWebsocket; client.IOHandler.Write('websocket client to server'); MaxWait( function: Boolean begin Result := FLastWSMsg <> ''; end, 10 * 1000); CheckEquals('websocket server to client', FLastWSMsg); finally client.Free; end; end; procedure TTestWebSockets.HandleWebsocketTextMessage( const AContext: TIdServerWSContext; const aText: string); begin if aText = 'websocket client to server' then AContext.IOHandler.Write('websocket server to client'); end; procedure TTestWebSockets.WebsocketTextMessage(const aData: string); begin FLastWSMsg := aData; end; end.