paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 21:29:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-web: added TCustomWebsocketUpgrader.OnConnect

Browse Source
This commit is contained in:
mattias 2023-06-22 12:14:28 +02:00
parent 34f11a7a14
commit dea9aa56a7
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
packages/fcl-web/src/websocket/wsupgrader.pp
View File

@ -11,6 +11,7 @@ Type
{ TCustomWebsocketUpgrader } { TCustomWebsocketUpgrader }
TAllowUpgradeEvent = Procedure(Sender : TObject; aRequest : TRequest; var aAllow : Boolean) of object; TAllowUpgradeEvent = Procedure(Sender : TObject; aRequest : TRequest; var aAllow : Boolean) of object;
TWSConnectEvent = procedure(Sender: TObject; AConnection: TWSServerConnection) of object;
TCustomWebsocketUpgrader = Class(TCustomWSServer) TCustomWebsocketUpgrader = Class(TCustomWSServer)
private private
@ -22,8 +23,8 @@ Type
FHost: String; FHost: String;
function GetHandshakeRequest(aRequest: TFPHTTPConnectionRequest): TWSHandShakeRequest; function GetHandshakeRequest(aRequest: TFPHTTPConnectionRequest): TWSHandShakeRequest;
function GetUpgradeName: String; function GetUpgradeName: String;
procedure SetHost(const AValue: String); procedure SetHost(AValue: String);
procedure SetUpgradeName(const AValue: String); procedure SetUpgradeName(AValue: String);
procedure SetWebServer(AValue: TFPCustomHttpServer); procedure SetWebServer(AValue: TFPCustomHttpServer);
Protected Protected
// Override from custom server // Override from custom server
@ -64,6 +65,7 @@ Type
Property MessageWaitTime; Property MessageWaitTime;
Property Options; Property Options;
Property OnAllow; Property OnAllow;
property OnConnect;
property OnMessageReceived; property OnMessageReceived;
property OnDisconnect; property OnDisconnect;
property OnControlReceived; property OnControlReceived;
@ -117,7 +119,7 @@ begin
FreeConnectionHandler; FreeConnectionHandler;
end; end;
procedure TCustomWebsocketUpgrader.SetHost(const AValue: String); procedure TCustomWebsocketUpgrader.SetHost(AValue: String);
begin begin
if Host=AValue then Exit; if Host=AValue then Exit;
CheckInactive; CheckInactive;
@ -204,6 +206,8 @@ begin
aConn.DoHandshake(aHandshake); aConn.DoHandshake(aHandshake);
Connections.Add(aConn); Connections.Add(aConn);
ConnectionHandler.HandleConnection(aConn,False); ConnectionHandler.HandleConnection(aConn,False);
if Assigned(OnConnect) then
OnConnect(Self,aConn);
finally finally
aHandshake.Free; aHandshake.Free;
end; end;
@ -216,7 +220,7 @@ begin
end; end;
procedure TCustomWebsocketUpgrader.SetUpgradeName(const AValue: String); procedure TCustomWebsocketUpgrader.SetUpgradeName(AValue: String);
begin begin
if aValue=GetUpgradeName then if aValue=GetUpgradeName then
exit; exit;