// ************************************************************************
// ***************************** CEF4Delphi *******************************
// ************************************************************************
//
// CEF4Delphi is based on DCEF3 which uses CEF3 to embed a chromium-based
// browser in Delphi applications.
//
// The original license of DCEF3 still applies to CEF4Delphi.
//
// For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef
//
// Copyright © 2019 Salvador Diaz Fau. All rights reserved.
//
// ************************************************************************
// ************ vvvv Original license and comments below vvvv *************
// ************************************************************************
(*
* Delphi Chromium Embedded 3
*
* Usage allowed under the restrictions of the Lesser GNU General Public License
* or alternatively the restrictions of the Mozilla Public License 1.1
*
* Software distributed under the License is distributed on an "AS IS" basis,
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License for
* the specific language governing rights and limitations under the License.
*
* Unit owner : Henri Gourvest <hgourvest@gmail.com>
* Web site : http://www.progdigy.com
* Repository : http://code.google.com/p/delphichromiumembedded/
* Group : http://groups.google.com/group/delphichromiumembedded
*
* Embarcadero Technologies, Inc is not permitted to use or redistribute
* this source code without explicit permission.
*
*)
unit uCEFServerComponent;
{$IFDEF FPC}
{$MODE OBJFPC}{$H+}
{$ENDIF}
{$IFNDEF CPUX64}{$ALIGN ON}{$ENDIF}
{$MINENUMSIZE 4}
{$I cef.inc}
interface
uses
{$IFDEF DELPHI16_UP}
{$IFDEF MSWINDOWS}WinApi.Windows, WinApi.Messages, WinApi.ActiveX,{$ENDIF}
System.Classes, Vcl.Controls, Vcl.Graphics, Vcl.Forms, System.Math,
{$ELSE}
{$IFDEF MSWINDOWS}Windows, ActiveX,{$ENDIF} Classes, Forms, Controls, Graphics, Math,
{$IFDEF FPC}
LCLProc, LCLType, LCLIntf, LResources, LMessages, InterfaceBase,
{$ELSE}
Messages,
{$ENDIF}
{$ENDIF}
uCEFTypes, uCEFInterfaces, uCEFServer, uCEFServerEvents, uCEFServerHandler;
const
DEFAULT_CEFSERVER_ADDRESS = '127.0.0.1';
DEFAULT_CEFSERVER_PORT = 8099;
DEFAULT_CEFSERVER_BACKLOG = 10;
type
{$IFNDEF FPC}{$IFDEF DELPHI16_UP}[ComponentPlatformsAttribute(pidWin32 or pidWin64)]{$ENDIF}{$ENDIF}
TCEFServerComponent = class(TComponent, IServerEvents)
protected
FHandler : ICefServerHandler;
FServer : ICefServer;
FInitialized : boolean;
// IServerEvents
FOnServerCreated : TOnServerCreated;
FOnServerDestroyed : TOnServerDestroyed;
FOnClientConnected : TOnClientConnected;
FOnClientDisconnected : TOnClientDisconnected;
FOnHttpRequest : TOnHttpRequest;
FOnWebSocketRequest : TOnWebSocketRequest;
FOnWebSocketConnected : TOnWebSocketConnected;
FOnWebSocketMessage : TOnWebSocketMessage;
function GetInitialized : boolean;
function GetIsRunning : boolean;
function GetAddress : ustring;
function GetHasConnection : boolean;
// IServerEvents
procedure doOnServerCreated(const server: ICefServer); virtual;
procedure doOnServerDestroyed(const server: ICefServer); virtual;
procedure doOnClientConnected(const server: ICefServer; connection_id: Integer); virtual;
procedure doOnClientDisconnected(const server: ICefServer; connection_id: Integer); virtual;
procedure doOnHttpRequest(const server: ICefServer; connection_id: Integer; const client_address: ustring; const request: ICefRequest); virtual;
procedure doOnWebSocketRequest(const server: ICefServer; connection_id: Integer; const client_address: ustring; const request: ICefRequest; const callback: ICefCallback); virtual;
procedure doOnWebSocketConnected(const server: ICefServer; connection_id: Integer); virtual;
procedure doOnWebSocketMessage(const server: ICefServer; connection_id: Integer; const data: Pointer; data_size: NativeUInt); virtual;
procedure InitializeEvents;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure CreateServer(const address : ustring = DEFAULT_CEFSERVER_ADDRESS; port : uint16 = DEFAULT_CEFSERVER_PORT; backlog : Integer = DEFAULT_CEFSERVER_BACKLOG);
procedure Shutdown;
function IsValidConnection(connection_id: Integer) : boolean;
procedure SendHttp200response(connection_id: Integer; const content_type: ustring; const data: Pointer; data_size: NativeUInt);
procedure SendHttp404response(connection_id: Integer);
procedure SendHttp500response(connection_id: Integer; const error_message: ustring);
procedure SendHttpResponse(connection_id, response_code: Integer; const content_type: ustring; content_length: int64; const extra_headers: ICefStringMultimap);
procedure SendRawData(connection_id: Integer; const data: Pointer; data_size: NativeUInt);
procedure CloseConnection(connection_id: Integer);
procedure SendWebSocketMessage(connection_id: Integer; const data: Pointer; data_size: NativeUInt);
property Initialized : boolean read GetInitialized;
property IsRunning : boolean read GetIsRunning;
property Address : ustring read GetAddress;
property HasConnection : boolean read GetHasConnection;
published
property OnServerCreated : TOnServerCreated read FOnServerCreated write FOnServerCreated;
property OnServerDestroyed : TOnServerDestroyed read FOnServerDestroyed write FOnServerDestroyed;
property OnClientConnected : TOnClientConnected read FOnClientConnected write FOnClientConnected;
property OnClientDisconnected : TOnClientDisconnected read FOnClientDisconnected write FOnClientDisconnected;
property OnHttpRequest : TOnHttpRequest read FOnHttpRequest write FOnHttpRequest;
property OnWebSocketRequest : TOnWebSocketRequest read FOnWebSocketRequest write FOnWebSocketRequest;
property OnWebSocketConnected : TOnWebSocketConnected read FOnWebSocketConnected write FOnWebSocketConnected;
property OnWebSocketMessage : TOnWebSocketMessage read FOnWebSocketMessage write FOnWebSocketMessage;
end;
{$IFDEF FPC}
procedure Register;
{$ENDIF}
implementation
uses
uCEFLibFunctions, uCEFApplication, uCEFMiscFunctions;
// For more information about the TCEFServerComponent properties and functions
// read the code comments in the CEF3 source file /include/capi/cef_server_cap.h
constructor TCEFServerComponent.Create(AOwner: TComponent);
begin
inherited Create(aOwner);
FHandler := nil;
FServer := nil;
FInitialized := False;
InitializeEvents;
end;
destructor TCEFServerComponent.Destroy;
begin
FServer := nil;
FHandler := nil;
inherited Destroy;
end;
procedure TCEFServerComponent.InitializeEvents;
begin
FOnServerCreated := nil;
FOnServerDestroyed := nil;
FOnClientConnected := nil;
FOnClientDisconnected := nil;
FOnHttpRequest := nil;
FOnWebSocketRequest := nil;
FOnWebSocketConnected := nil;
FOnWebSocketMessage := nil;
end;
function TCEFServerComponent.GetInitialized : boolean;
begin
Result := FInitialized and (FHandler <> nil) and (FServer <> nil);
end;
function TCEFServerComponent.GetIsRunning : boolean;
begin
Result := Initialized and FServer.IsRunning;
end;
function TCEFServerComponent.GetAddress : ustring;
begin
if Initialized then
Result := FServer.GetAddress
else
Result := '';
end;
function TCEFServerComponent.GetHasConnection : boolean;
begin
Result := Initialized and FServer.HasConnection;
end;
procedure TCEFServerComponent.doOnServerCreated(const server: ICefServer);
begin
if (FServer = nil) and
(server <> nil) and
server.IsRunning and
not(server.HasConnection) then
begin
FServer := server;
FInitialized := True;
end;
if assigned(FOnServerCreated) then FOnServerCreated(self, server);
end;
procedure TCEFServerComponent.doOnServerDestroyed(const server: ICefServer);
begin
if assigned(FOnServerDestroyed) then FOnServerDestroyed(self, server);
FServer := nil;
FInitialized := False;
end;
procedure TCEFServerComponent.doOnClientConnected(const server: ICefServer; connection_id: Integer);
begin
if assigned(FOnClientConnected) then FOnClientConnected(self, server, connection_id);
end;
procedure TCEFServerComponent.doOnClientDisconnected(const server: ICefServer; connection_id: Integer);
begin
if assigned(FOnClientDisconnected) then FOnClientDisconnected(self, server, connection_id);
end;
procedure TCEFServerComponent.doOnHttpRequest(const server : ICefServer;
connection_id : Integer;
const client_address : ustring;
const request : ICefRequest);
begin
if assigned(FOnHttpRequest) then FOnHttpRequest(self, server, connection_id, client_address, request);
end;
procedure TCEFServerComponent.doOnWebSocketRequest(const server : ICefServer;
connection_id : Integer;
const client_address : ustring;
const request : ICefRequest;
const callback : ICefCallback);
begin
if assigned(FOnWebSocketRequest) then FOnWebSocketRequest(self, server, connection_id, client_address, request, callback);
end;
procedure TCEFServerComponent.doOnWebSocketConnected(const server: ICefServer; connection_id: Integer);
begin
if assigned(FOnWebSocketConnected) then FOnWebSocketConnected(self, server, connection_id);
end;
procedure TCEFServerComponent.doOnWebSocketMessage(const server : ICefServer;
connection_id : Integer;
const data : Pointer;
data_size : NativeUInt);
begin
if assigned(FOnWebSocketMessage) then FOnWebSocketMessage(self, server, connection_id, data, data_size);
end;
procedure TCEFServerComponent.CreateServer(const address : ustring; port : uint16; backlog : Integer);
const
CEFSERVER_MIN_PORT = 1025;
CEFSERVER_MAX_PORT = 65535;
var
TempAddress : TCefString;
TempPort : integer;
begin
if (GlobalCEFApp <> nil) and
(GlobalCEFApp.Status = asInitialized) and
not(Initialized) and
(length(address) > 0) then
begin
if (FHandler = nil) then FHandler := TCustomServerHandler.Create(self);
TempPort := max(CEFSERVER_MIN_PORT, min(CEFSERVER_MAX_PORT, port));
TempAddress := CefString(address);
cef_server_create(@TempAddress, TempPort, backlog, FHandler.Wrap);
end;
end;
procedure TCEFServerComponent.Shutdown;
begin
if Initialized then FServer.shutdown;
end;
function TCEFServerComponent.IsValidConnection(connection_id: Integer) : boolean;
begin
Result := Initialized and FServer.IsValidConnection(connection_id);
end;
procedure TCEFServerComponent.SendHttp200response(connection_id : Integer;
const content_type : ustring;
const data : Pointer;
data_size : NativeUInt);
begin
if Initialized then FServer.SendHttp200response(connection_id, content_type, data, data_size);
end;
procedure TCEFServerComponent.SendHttp404response(connection_id: Integer);
begin
if Initialized then FServer.SendHttp404response(connection_id);
end;
procedure TCEFServerComponent.SendHttp500response(connection_id: Integer; const error_message: ustring);
begin
if Initialized then FServer.SendHttp500response(connection_id, error_message);
end;
procedure TCEFServerComponent.SendHttpResponse(connection_id : Integer;
response_code : Integer;
const content_type : ustring;
content_length : int64;
const extra_headers : ICefStringMultimap);
begin
if Initialized then FServer.SendHttpResponse(connection_id, response_code, content_type, content_length, extra_headers);
end;
procedure TCEFServerComponent.SendRawData(connection_id: Integer; const data: Pointer; data_size: NativeUInt);
begin
if Initialized then FServer.SendRawData(connection_id, data, data_size);
end;
procedure TCEFServerComponent.CloseConnection(connection_id: Integer);
begin
if Initialized then FServer.CloseConnection(connection_id);
end;
procedure TCEFServerComponent.SendWebSocketMessage(connection_id: Integer; const data: Pointer; data_size: NativeUInt);
begin
if Initialized then FServer.SendWebSocketMessage(connection_id, data, data_size);
end;
{$IFDEF FPC}
procedure Register;
begin
{$I res/tcefservercomponent.lrs}
RegisterComponents('Chromium', [TCEFServerComponent]);
end;
{$ENDIF}
end.