paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 21:51: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 }
TAllowUpgradeEvent = Procedure(Sender : TObject; aRequest : TRequest; var aAllow : Boolean) of object;
TWSConnectEvent = procedure(Sender: TObject; AConnection: TWSServerConnection) of object;
TCustomWebsocketUpgrader = Class(TCustomWSServer)
private
@ -22,8 +23,8 @@ Type
FHost: String;
function GetHandshakeRequest(aRequest: TFPHTTPConnectionRequest): TWSHandShakeRequest;
function GetUpgradeName: String;
procedure SetHost(const AValue: String);
procedure SetUpgradeName(const AValue: String);
procedure SetHost(AValue: String);
procedure SetUpgradeName(AValue: String);
procedure SetWebServer(AValue: TFPCustomHttpServer);
Protected
// Override from custom server
@ -64,6 +65,7 @@ Type
Property MessageWaitTime;
Property Options;
Property OnAllow;
property OnConnect;
property OnMessageReceived;
property OnDisconnect;
property OnControlReceived;
@ -117,7 +119,7 @@ begin
FreeConnectionHandler;
end;
procedure TCustomWebsocketUpgrader.SetHost(const AValue: String);
procedure TCustomWebsocketUpgrader.SetHost(AValue: String);
begin
if Host=AValue then Exit;
CheckInactive;
@ -204,6 +206,8 @@ begin
aConn.DoHandshake(aHandshake);
Connections.Add(aConn);
ConnectionHandler.HandleConnection(aConn,False);
if Assigned(OnConnect) then
OnConnect(Self,aConn);
finally
aHandshake.Free;
end;
@ -216,7 +220,7 @@ begin
end;
procedure TCustomWebsocketUpgrader.SetUpgradeName(const AValue: String);
procedure TCustomWebsocketUpgrader.SetUpgradeName(AValue: String);
begin
if aValue=GetUpgradeName then
exit;