pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2025-11-23 21:34:53 +02:00
Code Issues Actions Releases Activity

Show more post information in the SimpleServer demo

Browse Source 
Launch the default web browser from the SimpleServer demo.
This commit is contained in:
Salvador Díaz Fau
2025-11-09 18:19:56 +01:00
parent 0c00b11083
commit 5a5548141d
5 changed files with 178 additions and 85 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
demos/Delphi_VCL/SimpleServer/uSimpleServer.dfm
View File

@@ -78,21 +78,31 @@ object SimpleServerFrm: TSimpleServerFrm
Left = 312
Top = 8
Width = 105
Height = 79
Height = 21
Caption = 'Start'
TabOrder = 3
OnClick = StartBtnClick
end
object StopBtn: TButton
Left = 434
Top = 8
Left = 312
Top = 37
Width = 105
Height = 79
Height = 21
Caption = 'Stop'
Enabled = False
TabOrder = 4
OnClick = StopBtnClick
end
object OpenBtn: TButton
Left = 312
Top = 65
Width = 105
Height = 21
Caption = 'Open web browser'
Enabled = False
TabOrder = 5
OnClick = OpenBtnClick
end
end
object ConnectionLogMem: TMemo
Left = 0

63
demos/Delphi_VCL/SimpleServer/uSimpleServer.pas
View File

@@ -8,9 +8,11 @@ uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.Samples.Spin, Vcl.ExtCtrls, System.Math,
Winapi.ShellAPI,
{$ELSE}
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, Spin, ExtCtrls, Math,
ShellAPI,
{$ENDIF}
uCEFInterfaces, uCEFServerComponent, uCEFTypes, uCEFMiscFunctions;
@@ -27,9 +29,11 @@ type
BacklogEdt: TSpinEdit;
StartBtn: TButton;
StopBtn: TButton;
OpenBtn: TButton;
procedure StartBtnClick(Sender: TObject);
procedure StopBtnClick(Sender: TObject);
procedure OpenBtnClick(Sender: TObject);
procedure AddressEdtChange(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
@@ -161,11 +165,18 @@ begin
try
if (aPostData <> nil) and (aPostData.GetElementCount > 0) then
begin
ConnectionLogMem.Lines.Add('Post element count : ' + inttostr(aPostData.GetElementCount));
aPostData.GetElements(aPostData.GetElementCount, TempArray);
i := 0;
while (i < length(TempArray)) do
begin
case TempArray[i].GetType of
PDE_TYPE_EMPTY : ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' type : empty');
PDE_TYPE_FILE : ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' type : file. ' + TempArray[i].GetFile);
PDE_TYPE_BYTES :
begin
ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' type : bytes');
if (TempArray[i].GetBytesCount > 0) then
begin
SetLength(TempBytes, TempArray[i].GetBytesCount);
@@ -173,18 +184,15 @@ begin
if (TempLen > 0) then
begin
ConnectionLogMem.Lines.Add('Post contents length : ' + inttostr(TempLen));
ConnectionLogMem.Lines.Add('Post contents sample : ' + BufferToString(TempBytes));
ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' length : ' + inttostr(TempLen));
ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' contents : ' + BufferToString(TempBytes));
end;
end;
end;
inc(i);
else
ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' type : unknown');
end;
i := 0;
while (i < length(TempArray)) do
begin
TempArray[i] := nil;
inc(i);
end;
end;
@@ -195,6 +203,12 @@ begin
finally
if (TempArray <> nil) then
begin
i := 0;
while (i < length(TempArray)) do
begin
TempArray[i] := nil;
inc(i);
end;
Finalize(TempArray);
TempArray := nil;
end;
@@ -204,11 +218,21 @@ end;
function TSimpleServerFrm.BufferToString(const aBuffer : TBytes) : string;
var
i, j : integer;
TempStream : TStringStream;
begin
Result := '';
TempStream := TStringStream.Create(aBuffer);
try
Result := TempStream.DataString;
finally
TempStream.Free;
end;
if (length(Result) = 0) then
begin
i := 0;
j := min(length(aBuffer), 5);
j := length(aBuffer);
while (i < j) do
begin
@@ -216,6 +240,15 @@ begin
inc(i);
end;
end;
end;
procedure TSimpleServerFrm.OpenBtnClick(Sender: TObject);
var
TempURL : string;
begin
TempURL := 'http://' + AddressEdt.Text + ':' + inttostr(PortEdt.Value);
ShellExecute(0, 'Open', PChar(TempURL), nil, nil, SW_SHOW);
end;
procedure TSimpleServerFrm.CEFServerComponent1ServerCreated(Sender: TObject; const server: ICefServer);
begin
@@ -223,7 +256,11 @@ begin
begin
ConnectionLogMem.Lines.Add('Server created');
StartBtn.Enabled := False;
StopBtn.Enabled := True;
StopBtn.Enabled := not(StartBtn.Enabled);
OpenBtn.Enabled := not(StartBtn.Enabled);
AddressEdt.Enabled := StartBtn.Enabled;
PortEdt.Enabled := StartBtn.Enabled;
BacklogEdt.Enabled := StartBtn.Enabled;
end
else
ConnectionLogMem.Lines.Add('Server creation error!');
@@ -237,7 +274,11 @@ begin
begin
ConnectionLogMem.Lines.Add('Server destroyed');
StartBtn.Enabled := True;
StopBtn.Enabled := False;
StopBtn.Enabled := not(StartBtn.Enabled);
OpenBtn.Enabled := not(StartBtn.Enabled);
AddressEdt.Enabled := StartBtn.Enabled;
PortEdt.Enabled := StartBtn.Enabled;
BacklogEdt.Enabled := StartBtn.Enabled;
end;
end;

19
demos/Lazarus_Windows/SimpleServer/uSimpleServer.lfm
View File

@@ -13,7 +13,6 @@ object SimpleServerFrm: TSimpleServerFrm
Font.Height = -11
Font.Name = 'Tahoma'
Position = poScreenCenter
LCLVersion = '4.0.0.4'
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
object ButtonPnl: TPanel
@@ -82,7 +81,7 @@ object SimpleServerFrm: TSimpleServerFrm
end
object StartBtn: TButton
Left = 312
Height = 79
Height = 22
Top = 8
Width = 105
Caption = 'Start'
@@ -90,15 +89,25 @@ object SimpleServerFrm: TSimpleServerFrm
OnClick = StartBtnClick
end
object StopBtn: TButton
Left = 434
Height = 79
Top = 8
Left = 312
Height = 22
Top = 35
Width = 105
Caption = 'Stop'
Enabled = False
TabOrder = 4
OnClick = StopBtnClick
end
object OpenBtn: TButton
Left = 312
Height = 22
Top = 64
Width = 105
Caption = 'Open web browser'
Enabled = False
TabOrder = 5
OnClick = OpenBtnClick
end
end
object ConnectionLogMem: TMemo
Left = 0

101
demos/Lazarus_Windows/SimpleServer/uSimpleServer.pas
View File

@@ -8,11 +8,15 @@ interface
uses
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, Spin, ExtCtrls, Math,
Controls, Forms, Dialogs, StdCtrls, Spin, ExtCtrls, Math, ShellAPI,
uCEFInterfaces, uCEFServerComponent, uCEFTypes, uCEFMiscFunctions;
type
{ TSimpleServerFrm }
TSimpleServerFrm = class(TForm)
OpenBtn: TButton;
CEFServerComponent1: TCEFServerComponent;
ButtonPnl: TPanel;
ConnectionLogMem: TMemo;
@@ -24,31 +28,24 @@ type
BacklogEdt: TSpinEdit;
StartBtn: TButton;
StopBtn: TButton;
procedure StartBtnClick(Sender: TObject);
procedure AddressEdtChange(Sender: TObject);
procedure CEFServerComponent1ServerCreated(Sender: TObject;
const server: ICefServer);
procedure CEFServerComponent1ServerDestroyed(Sender: TObject;
const server: ICefServer);
procedure CEFServerComponent1ClientConnected(Sender: TObject;
const server: ICefServer; connection_id: Integer);
procedure CEFServerComponent1ClientDisconnected(Sender: TObject;
const server: ICefServer; connection_id: Integer);
procedure StopBtnClick(Sender: TObject);
procedure OpenBtnClick(Sender: TObject);
procedure AddressEdtChange(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormCreate(Sender: TObject);
procedure CEFServerComponent1HttpRequest(Sender: TObject;
const server: ICefServer; connection_id: Integer;
const client_address: ustring; const request: ICefRequest);
procedure CEFServerComponent1WebSocketConnected(Sender: TObject;
const server: ICefServer; connection_id: Integer);
procedure CEFServerComponent1WebSocketMessage(Sender: TObject;
const server: ICefServer; connection_id: Integer;
const data: Pointer; data_size: NativeUInt);
procedure CEFServerComponent1WebSocketRequest(Sender: TObject;
const server: ICefServer; connection_id: Integer;
const client_address: ustring; const request: ICefRequest;
const callback: ICefCallback);
procedure CEFServerComponent1ServerCreated(Sender: TObject; const server: ICefServer);
procedure CEFServerComponent1ServerDestroyed(Sender: TObject; const server: ICefServer);
procedure CEFServerComponent1ClientConnected(Sender: TObject; const server: ICefServer; connection_id: Integer);
procedure CEFServerComponent1ClientDisconnected(Sender: TObject; const server: ICefServer; connection_id: Integer);
procedure CEFServerComponent1HttpRequest(Sender: TObject; const server: ICefServer; connection_id: Integer; const client_address: ustring; const request: ICefRequest);
procedure CEFServerComponent1WebSocketConnected(Sender: TObject; const server: ICefServer; connection_id: Integer);
procedure CEFServerComponent1WebSocketMessage(Sender: TObject; const server: ICefServer; connection_id: Integer; const data: Pointer; data_size: NativeUInt);
procedure CEFServerComponent1WebSocketRequest(Sender: TObject; const server: ICefServer; connection_id: Integer; const client_address: ustring; const request: ICefRequest; const callback: ICefCallback);
protected
FClosing : boolean;
@@ -166,11 +163,18 @@ begin
try
if (aPostData <> nil) and (aPostData.GetElementCount > 0) then
begin
ConnectionLogMem.Lines.Add('Post element count : ' + inttostr(aPostData.GetElementCount));
aPostData.GetElements(aPostData.GetElementCount, TempArray);
i := 0;
while (i < length(TempArray)) do
begin
case TempArray[i].GetType of
PDE_TYPE_EMPTY : ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' type : empty');
PDE_TYPE_FILE : ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' type : file. ' + TempArray[i].GetFile);
PDE_TYPE_BYTES :
begin
ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' type : bytes');
if (TempArray[i].GetBytesCount > 0) then
begin
SetLength(TempBytes, TempArray[i].GetBytesCount);
@@ -178,18 +182,15 @@ begin
if (TempLen > 0) then
begin
ConnectionLogMem.Lines.Add('Post contents length : ' + inttostr(TempLen));
ConnectionLogMem.Lines.Add('Post contents sample : ' + BufferToString(TempBytes));
ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' length : ' + inttostr(TempLen));
ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' contents : ' + BufferToString(TempBytes));
end;
end;
end;
inc(i);
else
ConnectionLogMem.Lines.Add('Post element ' + inttostr(i) + ' type : unknown');
end;
i := 0;
while (i < length(TempArray)) do
begin
TempArray[i] := nil;
inc(i);
end;
end;
@@ -200,21 +201,36 @@ begin
finally
if (TempArray <> nil) then
begin
i := 0;
while (i < length(TempArray)) do
begin
TempArray[i] := nil;
inc(i);
end;
Finalize(TempArray);
TempArray := nil;
end;
end;
end;
function TSimpleServerFrm.BufferToString(const aBuffer : TBytes) : string;
var
i, j : integer;
TempStream : TStringStream;
begin
Result := '';
TempStream := TStringStream.Create(aBuffer);
try
Result := TempStream.DataString;
finally
TempStream.Free;
end;
if (length(Result) = 0) then
begin
i := 0;
j := min(length(aBuffer), 5);
j := length(aBuffer);
while (i < j) do
begin
@@ -222,6 +238,15 @@ begin
inc(i);
end;
end;
end;
procedure TSimpleServerFrm.OpenBtnClick(Sender: TObject);
var
TempURL : string;
begin
TempURL := 'http://' + AddressEdt.Text + ':' + inttostr(PortEdt.Value);
ShellExecute(0, 'Open', PChar(TempURL), nil, nil, SW_SHOW);
end;
procedure TSimpleServerFrm.CEFServerComponent1ServerCreated(Sender: TObject; const server: ICefServer);
begin
@@ -229,7 +254,11 @@ begin
begin
ConnectionLogMem.Lines.Add('Server created');
StartBtn.Enabled := False;
StopBtn.Enabled := True;
StopBtn.Enabled := not(StartBtn.Enabled);
OpenBtn.Enabled := not(StartBtn.Enabled);
AddressEdt.Enabled := StartBtn.Enabled;
PortEdt.Enabled := StartBtn.Enabled;
BacklogEdt.Enabled := StartBtn.Enabled;
end
else
ConnectionLogMem.Lines.Add('Server creation error!');
@@ -243,7 +272,11 @@ begin
begin
ConnectionLogMem.Lines.Add('Server destroyed');
StartBtn.Enabled := True;
StopBtn.Enabled := False;
StopBtn.Enabled := not(StartBtn.Enabled);
OpenBtn.Enabled := not(StartBtn.Enabled);
AddressEdt.Enabled := StartBtn.Enabled;
PortEdt.Enabled := StartBtn.Enabled;
BacklogEdt.Enabled := StartBtn.Enabled;
end;
end;

2
update_CEF4Delphi.json
View File

@@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 816,
"InternalVersion" : 817,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "142.0.8"
}