Merge remote-tracking branch 'refs/remotes/origin/openssl'
This commit is contained in:
commit
8c88e1704e
15
Demo/Project1.dpr
Normal file
15
Demo/Project1.dpr
Normal file
|
@ -0,0 +1,15 @@
|
||||||
|
program Project1;
|
||||||
|
|
||||||
|
uses
|
||||||
|
Vcl.Forms,
|
||||||
|
Unit1 in 'Unit1.pas' {Form1},
|
||||||
|
superobject in '..\superobject\superobject.pas';
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
Application.Initialize;
|
||||||
|
Application.MainFormOnTaskbar := True;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
41
Demo/Unit1.dfm
Normal file
41
Demo/Unit1.dfm
Normal file
|
@ -0,0 +1,41 @@
|
||||||
|
object Form1: TForm1
|
||||||
|
Left = 0
|
||||||
|
Top = 0
|
||||||
|
Caption = 'Form1'
|
||||||
|
ClientHeight = 337
|
||||||
|
ClientWidth = 635
|
||||||
|
Color = clBtnFace
|
||||||
|
Font.Charset = DEFAULT_CHARSET
|
||||||
|
Font.Color = clWindowText
|
||||||
|
Font.Height = -11
|
||||||
|
Font.Name = 'Tahoma'
|
||||||
|
Font.Style = []
|
||||||
|
OldCreateOrder = False
|
||||||
|
PixelsPerInch = 96
|
||||||
|
TextHeight = 13
|
||||||
|
object Button1: TButton
|
||||||
|
Left = 8
|
||||||
|
Top = 8
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = 'Button1'
|
||||||
|
TabOrder = 0
|
||||||
|
OnClick = Button1Click
|
||||||
|
end
|
||||||
|
object Button2: TButton
|
||||||
|
Left = 8
|
||||||
|
Top = 39
|
||||||
|
Width = 75
|
||||||
|
Height = 25
|
||||||
|
Caption = 'Button2'
|
||||||
|
TabOrder = 1
|
||||||
|
OnClick = Button2Click
|
||||||
|
end
|
||||||
|
object Timer1: TTimer
|
||||||
|
Enabled = False
|
||||||
|
Interval = 5000
|
||||||
|
OnTimer = Timer1Timer
|
||||||
|
Left = 128
|
||||||
|
Top = 16
|
||||||
|
end
|
||||||
|
end
|
139
Demo/Unit1.pas
Normal file
139
Demo/Unit1.pas
Normal file
|
@ -0,0 +1,139 @@
|
||||||
|
unit Unit1;
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
|
||||||
|
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ExtCtrls,
|
||||||
|
IdServerWebsocketContext;
|
||||||
|
|
||||||
|
type
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
Button1: TButton;
|
||||||
|
Timer1: TTimer;
|
||||||
|
Button2: TButton;
|
||||||
|
procedure Button1Click(Sender: TObject);
|
||||||
|
procedure Timer1Timer(Sender: TObject);
|
||||||
|
procedure Button2Click(Sender: TObject);
|
||||||
|
private
|
||||||
|
procedure ServerMessageTextReceived(const AContext: TIdServerWSContext; const aText: string);
|
||||||
|
procedure ClientBinDataReceived(const aData: TStream);
|
||||||
|
public
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.dfm}
|
||||||
|
|
||||||
|
uses
|
||||||
|
IdWebsocketServer, IdHTTPWebsocketClient, superobject, IdSocketIOHandling,
|
||||||
|
IdIOHandlerWebsocket;
|
||||||
|
|
||||||
|
var
|
||||||
|
server: TIdWebsocketServer;
|
||||||
|
client: TIdHTTPWebsocketClient;
|
||||||
|
|
||||||
|
const
|
||||||
|
C_CLIENT_EVENT = 'CLIENT_TO_SERVER_EVENT_TEST';
|
||||||
|
C_SERVER_EVENT = 'SERVER_TO_CLIENT_EVENT_TEST';
|
||||||
|
|
||||||
|
procedure ShowMessageInMainthread(const aMsg: string) ;
|
||||||
|
begin
|
||||||
|
TThread.Synchronize(nil,
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
ShowMessage(aMsg);
|
||||||
|
end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Button1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
server := TIdWebsocketServer.Create(Self);
|
||||||
|
server.DefaultPort := 12345;
|
||||||
|
server.SocketIO.OnEvent(C_CLIENT_EVENT,
|
||||||
|
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback)
|
||||||
|
begin
|
||||||
|
//show request (threadsafe)
|
||||||
|
ShowMessageInMainthread('REQUEST: ' + aArgument[0].AsJSon);
|
||||||
|
//send callback (only if specified!)
|
||||||
|
if aCallback <> nil then
|
||||||
|
aCallback.SendResponse( SO(['succes', True]).AsJSon );
|
||||||
|
end);
|
||||||
|
server.Active := True;
|
||||||
|
|
||||||
|
client := TIdHTTPWebsocketClient.Create(Self);
|
||||||
|
client.Port := 12345;
|
||||||
|
client.Host := 'localhost';
|
||||||
|
client.SocketIOCompatible := True;
|
||||||
|
client.SocketIO.OnEvent(C_SERVER_EVENT,
|
||||||
|
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback)
|
||||||
|
begin
|
||||||
|
ShowMessageInMainthread('Data PUSHED from server: ' + aArgument[0].AsJSon);
|
||||||
|
//server wants a response?
|
||||||
|
if aCallback <> nil then
|
||||||
|
aCallback.SendResponse('thank for the push!');
|
||||||
|
end);
|
||||||
|
client.Connect;
|
||||||
|
client.SocketIO.Emit(C_CLIENT_EVENT, SO([ 'request', 'some data']),
|
||||||
|
//provide callback
|
||||||
|
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
|
||||||
|
begin
|
||||||
|
//show response (threadsafe)
|
||||||
|
ShowMessageInMainthread('RESPONSE: ' + aJSON.AsJSon);
|
||||||
|
end);
|
||||||
|
|
||||||
|
//start timer so server pushes (!) data to all clients
|
||||||
|
Timer1.Interval := 5 * 1000; //5s
|
||||||
|
// Timer1.Enabled := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Button2Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
server := TIdWebsocketServer.Create(Self);
|
||||||
|
server.DefaultPort := 12346;
|
||||||
|
server.Active := True;
|
||||||
|
|
||||||
|
client := TIdHTTPWebsocketClient.Create(Self);
|
||||||
|
client.Port := 12346;
|
||||||
|
client.Host := 'localhost';
|
||||||
|
client.Connect;
|
||||||
|
client.UpgradeToWebsocket;
|
||||||
|
|
||||||
|
client.OnBinData := ClientBinDataReceived;
|
||||||
|
server.OnMessageText := ServerMessageTextReceived;
|
||||||
|
client.IOHandler.Write('test');
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ClientBinDataReceived(const aData: TStream);
|
||||||
|
begin
|
||||||
|
//
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.ServerMessageTextReceived(const AContext: TIdServerWSContext; const aText: string);
|
||||||
|
var
|
||||||
|
strm: TStringStream;
|
||||||
|
begin
|
||||||
|
ShowMessageInMainthread('WS REQUEST: ' + aText);
|
||||||
|
strm := TStringStream.Create('SERVER: ' + aText);
|
||||||
|
AContext.IOHandler.Write(strm, wdtBinary);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Timer1Timer(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Timer1.Enabled := false;
|
||||||
|
server.SocketIO.EmitEventToAll(C_SERVER_EVENT, SO(['data', 'pushed from server']),
|
||||||
|
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
|
||||||
|
begin
|
||||||
|
//show response (threadsafe)
|
||||||
|
TThread.Synchronize(nil,
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
ShowMessage('RESPONSE from a client: ' + aJSON.AsJSon);
|
||||||
|
end);
|
||||||
|
end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
|
@ -625,7 +625,12 @@ begin
|
||||||
//ws://host:port/<resourcename>
|
//ws://host:port/<resourcename>
|
||||||
//about resourcename, see: http://dev.w3.org/html5/websockets/ "Parsing WebSocket URLs"
|
//about resourcename, see: http://dev.w3.org/html5/websockets/ "Parsing WebSocket URLs"
|
||||||
//sURL := Format('ws://%s:%d/%s', [Host, Port, WSResourceName]);
|
//sURL := Format('ws://%s:%d/%s', [Host, Port, WSResourceName]);
|
||||||
|
sURL := Format('https://%s:%d/%s', [Host, Port, WSResourceName]);
|
||||||
|
{$IFDEF WS_NO_SSL}
|
||||||
|
//TODO: depend protocol on usessl - param passing in here
|
||||||
sURL := Format('http://%s:%d/%s', [Host, Port, WSResourceName]);
|
sURL := Format('http://%s:%d/%s', [Host, Port, WSResourceName]);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
ReadTimeout := Max(5 * 1000, ReadTimeout);
|
ReadTimeout := Max(5 * 1000, ReadTimeout);
|
||||||
|
|
||||||
{ voorbeeld:
|
{ voorbeeld:
|
||||||
|
|
|
@ -11,6 +11,9 @@ uses
|
||||||
Classes, SysUtils,
|
Classes, SysUtils,
|
||||||
IdIOHandlerStack, IdGlobal, IdException, IdBuffer,
|
IdIOHandlerStack, IdGlobal, IdException, IdBuffer,
|
||||||
SyncObjs,
|
SyncObjs,
|
||||||
|
{$IFNDEF WS_NO_SSL}
|
||||||
|
IdSSLOpenSSL,
|
||||||
|
{$ENDIF}
|
||||||
Generics.Collections;
|
Generics.Collections;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
@ -22,11 +25,14 @@ type
|
||||||
TIdIOHandlerWebsocket = class;
|
TIdIOHandlerWebsocket = class;
|
||||||
EIdWebSocketHandleError = class(EIdSocketHandleError);
|
EIdWebSocketHandleError = class(EIdSocketHandleError);
|
||||||
|
|
||||||
{$if CompilerVersion >= 26} //XE5
|
{.$if CompilerVersion >= 26} //XE5
|
||||||
TIdTextEncoding = IIdTextEncoding;
|
//TIdTextEncoding = IIdTextEncoding;
|
||||||
{$ifend}
|
{.$ifend}
|
||||||
|
{$IFDEF WS_NO_SSL}
|
||||||
TIdIOHandlerWebsocket = class(TIdIOHandlerStack)
|
TIdIOHandlerWebsocket = class(TIdIOHandlerStack)
|
||||||
|
{ELSE}
|
||||||
|
TIdIOHandlerWebsocketSSL = class(TIdSSLIOHandlerSocketOpenSSL)
|
||||||
|
{$ENDIF}
|
||||||
private
|
private
|
||||||
FIsServerSide: Boolean;
|
FIsServerSide: Boolean;
|
||||||
FBusyUpgrading: Boolean;
|
FBusyUpgrading: Boolean;
|
||||||
|
@ -55,12 +61,15 @@ type
|
||||||
function ReadFrame(out aFIN, aRSV1, aRSV2, aRSV3: boolean; out aDataCode: TWSDataCode; out aData: TIdBytes): Integer;
|
function ReadFrame(out aFIN, aRSV1, aRSV2, aRSV3: boolean; out aDataCode: TWSDataCode; out aData: TIdBytes): Integer;
|
||||||
function ReadMessage(var aBuffer: TIdBytes; out aDataCode: TWSDataCode): Integer;
|
function ReadMessage(var aBuffer: TIdBytes; out aDataCode: TWSDataCode): Integer;
|
||||||
|
|
||||||
{$if CompilerVersion >= 26} //XE5
|
{.$if CompilerVersion >= 26} //XE5
|
||||||
function UTF8Encoding: IIdTextEncoding;
|
//function UTF8Encoding: IIdTextEncoding;
|
||||||
{$else}
|
{.$else}
|
||||||
function UTF8Encoding: TEncoding;
|
function UTF8Encoding: TEncoding;
|
||||||
{$ifend}
|
{.$ifend}
|
||||||
public
|
public
|
||||||
|
{$IFNDEF WS_NO_SSL}
|
||||||
|
procedure ClearSSLOptions;
|
||||||
|
{$ENDIF}
|
||||||
function WriteData(aData: TIdBytes; aType: TWSDataCode;
|
function WriteData(aData: TIdBytes; aType: TWSDataCode;
|
||||||
aFIN: boolean = true; aRSV1: boolean = false; aRSV2: boolean = false; aRSV3: boolean = false): integer;
|
aFIN: boolean = true; aRSV1: boolean = false; aRSV2: boolean = false; aRSV3: boolean = false): integer;
|
||||||
property BusyUpgrading : Boolean read FBusyUpgrading write FBusyUpgrading;
|
property BusyUpgrading : Boolean read FBusyUpgrading write FBusyUpgrading;
|
||||||
|
@ -258,6 +267,14 @@ begin
|
||||||
FPendingWriteCount := 0;
|
FPendingWriteCount := 0;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
{$IFNDEF WS_NO_SSL}
|
||||||
|
procedure TIdIOHandlerWebsocketSSL.ClearSSLOptions;
|
||||||
|
begin
|
||||||
|
self.fxSSLOptions.Free;
|
||||||
|
self.fxSSLOptions := nil;
|
||||||
|
end;
|
||||||
|
{$ENDIF
|
||||||
|
|
||||||
procedure TIdIOHandlerWebsocket.Close;
|
procedure TIdIOHandlerWebsocket.Close;
|
||||||
var
|
var
|
||||||
iaWriteBuffer: TIdBytes;
|
iaWriteBuffer: TIdBytes;
|
||||||
|
@ -827,17 +844,17 @@ begin
|
||||||
FLock.Leave;
|
FLock.Leave;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
{$if CompilerVersion >= 26} //XE5
|
{.$if CompilerVersion >= 26} //XE5
|
||||||
function TIdIOHandlerWebsocket.UTF8Encoding: IIdTextEncoding;
|
//function TIdIOHandlerWebsocket.UTF8Encoding: IIdTextEncoding;
|
||||||
begin
|
//begin
|
||||||
Result := IndyTextEncoding_UTF8;
|
// Result := IndyTextEncoding_UTF8;
|
||||||
end;
|
//end;
|
||||||
{$else}
|
{.$else}
|
||||||
function TIdIOHandlerWebsocket.UTF8Encoding: TEncoding;
|
function TIdIOHandlerWebsocket.UTF8Encoding: TEncoding;
|
||||||
begin
|
begin
|
||||||
Result := TIdTextEncoding.UTF8;
|
Result := TIdTextEncoding.UTF8;
|
||||||
end;
|
end;
|
||||||
{$ifend}
|
{.$ifend}
|
||||||
|
|
||||||
function TIdIOHandlerWebsocket.ReadFrame(out aFIN, aRSV1, aRSV2, aRSV3: boolean;
|
function TIdIOHandlerWebsocket.ReadFrame(out aFIN, aRSV1, aRSV2, aRSV3: boolean;
|
||||||
out aDataCode: TWSDataCode; out aData: TIdBytes): Integer;
|
out aDataCode: TWSDataCode; out aData: TIdBytes): Integer;
|
||||||
|
@ -1131,10 +1148,11 @@ begin
|
||||||
|
|
||||||
AppendBytes(bData, aData); //important: send all at once!
|
AppendBytes(bData, aData); //important: send all at once!
|
||||||
ioffset := 0;
|
ioffset := 0;
|
||||||
|
iDataLength := Length(bData);
|
||||||
repeat
|
repeat
|
||||||
Result := Binding.Send(bData, ioffset);
|
result := inherited WriteDataToTarget(bdata,iOffset, (iDataLength-ioffset));
|
||||||
Inc(ioffset, Result);
|
Inc(ioffset, Result);
|
||||||
until ioffset >= Length(bData);
|
until ioffset >= iDataLenght;
|
||||||
|
|
||||||
// if debughook > 0 then
|
// if debughook > 0 then
|
||||||
// OutputDebugString(PChar(Format('Written (TID:%d, P:%d): %s',
|
// OutputDebugString(PChar(Format('Written (TID:%d, P:%d): %s',
|
||||||
|
|
|
@ -5,10 +5,18 @@ interface
|
||||||
uses
|
uses
|
||||||
Classes,
|
Classes,
|
||||||
IdServerIOHandlerStack, IdIOHandlerStack, IdGlobal, IdIOHandler, IdYarn, IdThread, IdSocketHandle,
|
IdServerIOHandlerStack, IdIOHandlerStack, IdGlobal, IdIOHandler, IdYarn, IdThread, IdSocketHandle,
|
||||||
|
{$IFNDEF WS_NO_SSL}
|
||||||
|
IdSSLOpenSSL,
|
||||||
|
sysutils,
|
||||||
|
{$ENDIF}
|
||||||
IdIOHandlerWebsocket;
|
IdIOHandlerWebsocket;
|
||||||
|
|
||||||
type
|
type
|
||||||
|
{$IFNDEF WS_NO_SSL}
|
||||||
TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerStack)
|
TIdServerIOHandlerWebsocket = class(TIdServerIOHandlerStack)
|
||||||
|
{$ELSE}
|
||||||
|
TIdServerIOHandlerWebsocket = class(TIdServerIOHandlersslOpenSSL)
|
||||||
|
{$ENDIF}
|
||||||
protected
|
protected
|
||||||
procedure InitComponent; override;
|
procedure InitComponent; override;
|
||||||
public
|
public
|
||||||
|
@ -23,8 +31,40 @@ implementation
|
||||||
|
|
||||||
function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
|
function TIdServerIOHandlerWebsocket.Accept(ASocket: TIdSocketHandle;
|
||||||
AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
|
AListenerThread: TIdThread; AYarn: TIdYarn): TIdIOHandler;
|
||||||
|
{$IFNDEF WS_NO_SSL}
|
||||||
|
var
|
||||||
|
LIO: TIdIOHandlerWebsocketSSL;
|
||||||
|
{$ENDIF}
|
||||||
begin
|
begin
|
||||||
|
{$IFDEF WS_NO_SSL}
|
||||||
Result := inherited Accept(ASocket, AListenerThread, AYarn);
|
Result := inherited Accept(ASocket, AListenerThread, AYarn);
|
||||||
|
{$ELSE}
|
||||||
|
Assert(ASocket<>nil);
|
||||||
|
Assert(fSSLContext<>nil);
|
||||||
|
LIO := TIdIOHandlerWebsocket.Create(nil);
|
||||||
|
try
|
||||||
|
LIO.PassThrough := True;
|
||||||
|
LIO.Open;
|
||||||
|
if LIO.Binding.Accept(ASocket.Handle) then
|
||||||
|
begin
|
||||||
|
//we need to pass the SSLOptions for the socket from the server
|
||||||
|
LIO.ClearSSLOptions;
|
||||||
|
LIO.IsPeer := True;
|
||||||
|
LIO.SSLOptions := SSLOptions;
|
||||||
|
LIO.SSLSocket := TIdSSLSocket.Create(Self);
|
||||||
|
LIO.SSLContext := fSSLContext;
|
||||||
|
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
FreeAndNil(LIO);
|
||||||
|
end;
|
||||||
|
except
|
||||||
|
LIO.Free;
|
||||||
|
raise;
|
||||||
|
end;
|
||||||
|
Result := LIO;
|
||||||
|
{$ENDIF}
|
||||||
if Result <> nil then
|
if Result <> nil then
|
||||||
begin
|
begin
|
||||||
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
|
(Result as TIdIOHandlerWebsocket).IsServerSide := True; //server must not mask, only client
|
||||||
|
@ -35,6 +75,7 @@ end;
|
||||||
procedure TIdServerIOHandlerWebsocket.InitComponent;
|
procedure TIdServerIOHandlerWebsocket.InitComponent;
|
||||||
begin
|
begin
|
||||||
inherited InitComponent;
|
inherited InitComponent;
|
||||||
|
//TODO: Check if this is necessary for SSL
|
||||||
IOHandlerSocketClass := TIdIOHandlerWebsocket;
|
IOHandlerSocketClass := TIdIOHandlerWebsocket;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
|
@ -137,7 +137,9 @@ begin
|
||||||
aSocketIOHandler.WritePing(context);
|
aSocketIOHandler.WritePing(context);
|
||||||
end
|
end
|
||||||
else
|
else
|
||||||
|
begin
|
||||||
context.IOHandler.WriteData(nil, wdcPing);
|
context.IOHandler.WriteData(nil, wdcPing);
|
||||||
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
end;
|
end;
|
||||||
|
@ -325,13 +327,22 @@ begin
|
||||||
hash.Free;
|
hash.Free;
|
||||||
end;
|
end;
|
||||||
AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Accept'] := sValue;
|
AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Accept'] := sValue;
|
||||||
|
{$IFNDEF WS_NO_SSL}
|
||||||
|
//keep alive the ssl connection
|
||||||
|
AResponseInfo.CustomHeaders.Values['Keep-alive'] := 'true';
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
//send same protocol back?
|
//send same protocol back?
|
||||||
AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Protocol'] := context.WebSocketProtocol;
|
AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Protocol'] := context.WebSocketProtocol;
|
||||||
//we do not support extensions yet (gzip deflate compression etc)
|
//we do not support extensions yet (gzip deflate compression etc)
|
||||||
//AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Extensions'] := context.WebSocketExtensions;
|
//AResponseInfo.CustomHeaders.Values['Sec-WebSocket-Extensions'] := context.WebSocketExtensions;
|
||||||
//http://www.lenholgate.com/blog/2011/07/websockets---the-deflate-stream-extension-is-broken-and-badly-designed.html
|
//http://www.lenholgate.com/blog/2011/07/websockets---the-deflate-stream-extension-is-broken-and-badly-designed.html
|
||||||
//but is could be done using idZlib.pas and DecompressGZipStream etc
|
//but is could be done using idZlib.pas and DecompressGZipStream etc
|
||||||
|
{$IFNDEF WS_NO_SSL}
|
||||||
|
//YD: TODO: Check if this is really necessary
|
||||||
|
AResponseInfo.CustomHeaders.Values['sec-websocket-extensions'] := '';
|
||||||
|
context.WebSocketExtensions := '';
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
//send response back
|
//send response back
|
||||||
context.IOHandler.InputBuffer.Clear;
|
context.IOHandler.InputBuffer.Clear;
|
||||||
|
|
|
@ -4,7 +4,7 @@ interface
|
||||||
|
|
||||||
uses
|
uses
|
||||||
IdServerWebsocketHandling, IdServerSocketIOHandling, IdServerWebsocketContext,
|
IdServerWebsocketHandling, IdServerSocketIOHandling, IdServerWebsocketContext,
|
||||||
IdHTTPServer, IdContext, IdCustomHTTPServer, Classes, IdIOHandlerWebsocket;
|
IdHTTPServer, IdContext, IdCustomHTTPServer, Classes, IdIOHandlerWebsocket, IdServerIOHandler;
|
||||||
|
|
||||||
type
|
type
|
||||||
TWebsocketMessageText = procedure(const AContext: TIdServerWSContext; const aText: string) of object;
|
TWebsocketMessageText = procedure(const AContext: TIdServerWSContext; const aText: string) of object;
|
||||||
|
@ -43,7 +43,12 @@ type
|
||||||
implementation
|
implementation
|
||||||
|
|
||||||
uses
|
uses
|
||||||
IdServerIOHandlerWebsocket, IdStreamVCL, IdGlobal, Windows, IdWinsock2;
|
IdServerIOHandlerWebsocket, IdStreamVCL, IdGlobal, Windows,
|
||||||
|
{$IFNDEF WS_NO_SSL}
|
||||||
|
idIOHandler,
|
||||||
|
idssl,
|
||||||
|
{$ENDIF}
|
||||||
|
IdWinsock2;
|
||||||
|
|
||||||
{ TIdWebsocketServer }
|
{ TIdWebsocketServer }
|
||||||
|
|
||||||
|
|
81
README.md
Normal file
81
README.md
Normal file
|
@ -0,0 +1,81 @@
|
||||||
|
# DelphiWebsockets
|
||||||
|
Websockets and Socket.io for Delphi
|
||||||
|
|
||||||
|
See below for an event driven async example of an socket.io server and client:
|
||||||
|
```delphi
|
||||||
|
uses
|
||||||
|
IdWebsocketServer, IdHTTPWebsocketClient, superobject, IdSocketIOHandling;
|
||||||
|
|
||||||
|
var
|
||||||
|
server: TIdWebsocketServer;
|
||||||
|
client: TIdHTTPWebsocketClient;
|
||||||
|
|
||||||
|
const
|
||||||
|
C_CLIENT_EVENT = 'CLIENT_TO_SERVER_EVENT_TEST';
|
||||||
|
C_SERVER_EVENT = 'SERVER_TO_CLIENT_EVENT_TEST';
|
||||||
|
|
||||||
|
procedure ShowMessageInMainthread(const aMsg: string) ;
|
||||||
|
begin
|
||||||
|
TThread.Synchronize(nil,
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
ShowMessage(aMsg);
|
||||||
|
end);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Button1Click(Sender: TObject);
|
||||||
|
begin
|
||||||
|
server := TIdWebsocketServer.Create(Self);
|
||||||
|
server.DefaultPort := 12345;
|
||||||
|
server.SocketIO.OnEvent(C_CLIENT_EVENT,
|
||||||
|
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback)
|
||||||
|
begin
|
||||||
|
//show request (threadsafe)
|
||||||
|
ShowMessageInMainthread('REQUEST: ' + aArgument[0].AsJSon);
|
||||||
|
//send callback (only if specified!)
|
||||||
|
if aCallback <> nil then
|
||||||
|
aCallback.SendResponse( SO(['succes', True]).AsJSon );
|
||||||
|
end);
|
||||||
|
server.Active := True;
|
||||||
|
|
||||||
|
client := TIdHTTPWebsocketClient.Create(Self);
|
||||||
|
client.Port := 12345;
|
||||||
|
client.Host := 'localhost';
|
||||||
|
client.SocketIOCompatible := True;
|
||||||
|
client.SocketIO.OnEvent(C_SERVER_EVENT,
|
||||||
|
procedure(const ASocket: ISocketIOContext; const aArgument: TSuperArray; const aCallback: ISocketIOCallback)
|
||||||
|
begin
|
||||||
|
ShowMessageInMainthread('Data PUSHED from server: ' + aArgument[0].AsJSon);
|
||||||
|
//server wants a response?
|
||||||
|
if aCallback <> nil then
|
||||||
|
aCallback.SendResponse('thank for the push!');
|
||||||
|
end);
|
||||||
|
client.Connect;
|
||||||
|
client.SocketIO.Emit(C_CLIENT_EVENT, SO([ 'request', 'some data']),
|
||||||
|
//provide callback
|
||||||
|
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
|
||||||
|
begin
|
||||||
|
//show response (threadsafe)
|
||||||
|
ShowMessageInMainthread('RESPONSE: ' + aJSON.AsJSon);
|
||||||
|
end);
|
||||||
|
|
||||||
|
//start timer so server pushes (!) data to all clients
|
||||||
|
Timer1.Interval := 5 * 1000; //5s
|
||||||
|
Timer1.Enabled := True;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.Timer1Timer(Sender: TObject);
|
||||||
|
begin
|
||||||
|
Timer1.Enabled := false;
|
||||||
|
server.SocketIO.EmitEventToAll(C_SERVER_EVENT, SO(['data', 'pushed from server']),
|
||||||
|
procedure(const ASocket: ISocketIOContext; const aJSON: ISuperObject; const aCallback: ISocketIOCallback)
|
||||||
|
begin
|
||||||
|
//show response (threadsafe)
|
||||||
|
TThread.Synchronize(nil,
|
||||||
|
procedure
|
||||||
|
begin
|
||||||
|
ShowMessage('RESPONSE from a client: ' + aJSON.AsJSon);
|
||||||
|
end);
|
||||||
|
end);
|
||||||
|
end;
|
||||||
|
```
|
Loading…
Reference in a new issue