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

Added the NetworkTrackerBrowser demo for Lazarus

Browse Source
This commit is contained in:
Salvador Díaz Fau 2024-03-04 17:33:45 +01:00
parent 74f6cb4019
commit 65103ad6e7
6 changed files with 522 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
demos/Lazarus_Windows/NetworkTrackerBrowser/00-Delete.bat Normal file
View File

@ -0,0 +1,2 @@
rmdir /S /Q lib
rmdir /S /Q backup

86
demos/Lazarus_Windows/NetworkTrackerBrowser/NetworkTrackerBrowser.lpi Normal file
View File

@ -0,0 +1,86 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<SessionStorage Value="InProjectDir"/>
<Title Value="NetworkTrackerBrowser"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<BuildModes>
<Item Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
<UseFileFilters Value="True"/>
</PublishOptions>
<RunParams>
<FormatVersion Value="2"/>
</RunParams>
<RequiredPackages>
<Item>
<PackageName Value="CEF4Delphi_Lazarus"/>
</Item>
<Item>
<PackageName Value="LCL"/>
</Item>
</RequiredPackages>
<Units>
<Unit>
<Filename Value="NetworkTrackerBrowser.lpr"/>
<IsPartOfProject Value="True"/>
</Unit>
<Unit>
<Filename Value="uMainForm.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
</Unit>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\..\bin\NetworkTrackerBrowser"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<SyntaxMode Value="Delphi"/>
</SyntaxOptions>
</Parsing>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf3"/>
</Debugging>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CustomOptions Value="-dBorland -dVer150 -dDelphi7 -dCompiler6_Up -dPUREPASCAL"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions>
<Item>
<Name Value="EAbort"/>
</Item>
<Item>
<Name Value="ECodetoolError"/>
</Item>
<Item>
<Name Value="EFOpenError"/>
</Item>
</Exceptions>
</Debugging>
</CONFIG>

47
demos/Lazarus_Windows/NetworkTrackerBrowser/NetworkTrackerBrowser.lpr Normal file
View File

@ -0,0 +1,47 @@
program NetworkTrackerBrowser;
{$MODE Delphi}
{$I ..\..\..\source\cef.inc}
uses
Forms, Interfaces,
uCEFApplication,
uCEFConstants,
uMainForm in 'uMainForm.pas' {MainForm};
// CEF needs to set the LARGEADDRESSAWARE ($20) flag which allows 32-bit processes to use up to 3GB of RAM.
{$IFDEF WIN32}
const
IMAGE_FILE_LARGE_ADDRESS_AWARE = $0020;
{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE}
{$ENDIF}
begin
GlobalCEFApp := TCefApplication.Create;
// In case you want to use custom directories for the CEF3 binaries, cache and user data.
// If you don't set a cache directory the browser will use in-memory cache.
{
GlobalCEFApp.FrameworkDirPath := 'c:\cef';
GlobalCEFApp.ResourcesDirPath := 'c:\cef';
GlobalCEFApp.LocalesDirPath := 'c:\cef\locales';
GlobalCEFApp.EnableGPU := True; // Enable hardware acceleration
GlobalCEFApp.cache := 'c:\cef\cache';
GlobalCEFApp.UserDataPath := 'c:\cef\User Data';
}
// You *MUST* call GlobalCEFApp.StartMainProcess in a if..then clause
// with the Application initialization inside the begin..end.
// Read this https://www.briskbard.com/index.php?lang=en&pageid=cef
if GlobalCEFApp.StartMainProcess then
begin
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end;
GlobalCEFApp.Free;
GlobalCEFApp := nil;
end.

106
demos/Lazarus_Windows/NetworkTrackerBrowser/uMainForm.lfm Normal file
View File

@ -0,0 +1,106 @@
object MainForm: TMainForm
Left = 0
Height = 624
Top = 0
Width = 1038
Caption = 'Initializing browser. Please wait...'
ClientHeight = 624
ClientWidth = 1038
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '3.2.0.0'
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
Height = 3
Top = 493
Width = 1038
Align = alBottom
ResizeAnchor = akBottom
end
object AddressPnl: TPanel
Left = 0
Height = 30
Top = 0
Width = 1038
Align = alTop
BevelOuter = bvNone
ClientHeight = 30
ClientWidth = 1038
Enabled = False
ParentBackground = False
TabOrder = 0
object AddressEdt: TEdit
Left = 0
Height = 30
Top = 0
Width = 1007
Align = alClient
TabOrder = 0
Text = 'http://www.google.com'
end
object GoBtn: TButton
Left = 1007
Height = 30
Top = 0
Width = 31
Align = alRight
Caption = 'Go'
TabOrder = 1
OnClick = GoBtnClick
end
end
object CEFWindowParent1: TCEFWindowParent
Left = 0
Height = 463
Top = 30
Width = 1038
Align = alClient
TabOrder = 1
end
object LogMemo: TMemo
Left = 0
Height = 128
Top = 496
Width = 1038
Align = alBottom
Lines.Strings = (
''
)
ReadOnly = True
ScrollBars = ssBoth
TabOrder = 2
WordWrap = False
end
object Timer1: TTimer
Enabled = False
Interval = 300
OnTimer = Timer1Timer
Left = 56
Top = 88
end
object Chromium1: TChromium
OnBeforePopup = Chromium1BeforePopup
OnAfterCreated = Chromium1AfterCreated
OnBeforeClose = Chromium1BeforeClose
OnClose = Chromium1Close
OnOpenUrlFromTab = Chromium1OpenUrlFromTab
OnDevToolsMethodResult = Chromium1DevToolsMethodResult
OnDevToolsRawEvent = Chromium1DevToolsRawEvent
Left = 56
Top = 152
end
object Timer2: TTimer
Interval = 500
OnTimer = Timer2Timer
Left = 56
Top = 224
end
end

280
demos/Lazarus_Windows/NetworkTrackerBrowser/uMainForm.pas Normal file
View File

@ -0,0 +1,280 @@
unit uMainForm;
{$I ..\..\..\source\cef.inc}
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, StdCtrls, ExtCtrls, SyncObjs,
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFConstants, uCEFTypes,
uCEFWinControl, uCEFChromiumCore;
const
DEVTOOLS_NETWORK_NESSAGE_ID = 1;
type
TMainForm = class(TForm)
AddressPnl: TPanel;
AddressEdt: TEdit;
GoBtn: TButton;
Timer1: TTimer;
Chromium1: TChromium;
CEFWindowParent1: TCEFWindowParent;
LogMemo: TMemo;
Splitter1: TSplitter;
Timer2: TTimer;
procedure GoBtnClick(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
procedure Chromium1Close(Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
procedure Chromium1BeforeClose(Sender: TObject; const browser: ICefBrowser);
procedure Chromium1BeforePopup(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl, targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; const popupFeatures: TCefPopupFeatures; var windowInfo: TCefWindowInfo; var client: ICefClient; var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue; var noJavascriptAccess, Result: Boolean);
procedure Chromium1OpenUrlFromTab(Sender: TObject; const browser: ICefBrowser; const frame: ICefFrame; const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition; userGesture: Boolean; out Result: Boolean);
procedure Chromium1DevToolsMethodResult(Sender: TObject; const browser: ICefBrowser; message_id: Integer; success: Boolean; const result: ICefValue);
procedure Chromium1DevToolsRawEvent(Sender: TObject; const browser: ICefBrowser; const method: ustring; const params: Pointer; params_size: NativeUInt);
protected
// Variables to control when can we destroy the form safely
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
FClosing : boolean; // Set to True in the CloseQuery event.
FLogLines : TStringList;
FCritSection : TCriticalSection;
// You have to handle this two messages to call NotifyMoveOrResizeStarted or some page elements will be misaligned.
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
// You also have to handle these two messages to set GlobalCEFApp.OsmodalLoop
procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
procedure WMExitMenuLoop(var aMessage: TMessage); message WM_EXITMENULOOP;
procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
procedure BrowserDestroyMsg(var aMessage : TMessage); message CEF_DESTROY;
procedure AddLogLine(const aLogLine: string);
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
uses
uCEFApplication, uCefMiscFunctions;
// This demo calls the "Network.enable" DevTools method to enable network events.
// Read this for more details :
// https://chromedevtools.github.io/devtools-protocol/tot/Network/#method-enable
// TChromium will receive the network events in TChromium.OnDevToolsEvent or
// TChromium.OnDevToolsRawEvent
// This demo uses TChromium.OnDevToolsRawEvent to log the event messages easily but
// if you can also use TChromium.OnDevToolsEvent to get a ICefValue parameter with the parsed JSON event.
// See all the network events here :
// https://chromedevtools.github.io/devtools-protocol/tot/Network/
// See the DOMVisitor demo to know how to read the values in the ICefValue parameter. For example, TDOMVisitorFrm.HandleErrorRslt
// Destruction steps
// =================
// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which triggers the TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEF_DESTROY message to destroy CEFWindowParent1 in the main thread, which triggers the TChromium.OnBeforeClose event.
// 3. TChromium.OnBeforeClose sets FCanClose := True and sends WM_CLOSE to the form.
procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose;
if not(FClosing) then
begin
FClosing := True;
Visible := False;
Chromium1.CloseBrowser(True);
end;
end;
procedure TMainForm.FormCreate(Sender: TObject);
begin
FCanClose := False;
FClosing := False;
Chromium1.DefaultURL := AddressEdt.Text;
FLogLines := TStringList.Create;
FCritSection := TCriticalSection.Create;
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
FLogLines.Free;
FCritSection.Free;
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
// You *MUST* call CreateBrowser to create and initialize the browser.
// This will trigger the AfterCreated event when the browser is fully
// initialized and ready to receive commands.
// GlobalCEFApp.GlobalContextInitialized has to be TRUE before creating any browser
// If it's not initialized yet, we use a simple timer to create the browser later.
if not(Chromium1.CreateBrowser(CEFWindowParent1)) then Timer1.Enabled := True;
end;
procedure TMainForm.AddLogLine(const aLogLine: string);
begin
FCritSection.Acquire;
FLogLines.Add(aLogLine);
FCritSection.Release;
end;
procedure TMainForm.Chromium1AfterCreated(Sender: TObject; const browser: ICefBrowser);
begin
// Now the browser is fully initialized we can send a message to the main form to load the initial web page.
PostMessage(Handle, CEF_AFTERCREATED, 0, 0);
Chromium1.ExecuteDevToolsMethod(DEVTOOLS_NETWORK_NESSAGE_ID, 'Network.enable', nil);
end;
procedure TMainForm.Chromium1BeforeClose(Sender: TObject;
const browser: ICefBrowser);
begin
FCanClose := True;
PostMessage(Handle, WM_CLOSE, 0, 0);
end;
procedure TMainForm.Chromium1BeforePopup(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; const targetUrl,
targetFrameName: ustring; targetDisposition: TCefWindowOpenDisposition;
userGesture: Boolean; const popupFeatures: TCefPopupFeatures;
var windowInfo: TCefWindowInfo; var client: ICefClient;
var settings: TCefBrowserSettings; var extra_info: ICefDictionaryValue;
var noJavascriptAccess, Result: Boolean);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB,
CEF_WOD_NEW_BACKGROUND_TAB,
CEF_WOD_NEW_POPUP,
CEF_WOD_NEW_WINDOW]);
end;
procedure TMainForm.Chromium1Close(Sender: TObject;
const browser: ICefBrowser; var aAction : TCefCloseBrowserAction);
begin
PostMessage(Handle, CEF_DESTROY, 0, 0);
aAction := cbaDelay;
end;
procedure TMainForm.Chromium1DevToolsMethodResult(Sender: TObject;
const browser: ICefBrowser; message_id: Integer; success: Boolean;
const result: ICefValue);
begin
if (message_id = DEVTOOLS_NETWORK_NESSAGE_ID) then
AddLogLine('Network.enable result: ' + BoolToStr(success, True));
end;
procedure TMainForm.Chromium1DevToolsRawEvent(Sender: TObject;
const browser: ICefBrowser; const method: ustring; const params: Pointer;
params_size: NativeUInt);
var
TempAnsiString : AnsiString;
begin
if (params_size > 0) then
begin
SetLength(TempAnsiString, params_size);
StrLCopy(PAnsiChar(TempAnsiString), PAnsiChar(params), params_size);
AddLogLine('method: ' + method + ' -> ' + UTF8Decode(TempAnsiString));
end;
end;
procedure TMainForm.Chromium1OpenUrlFromTab(Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const targetUrl: ustring; targetDisposition: TCefWindowOpenDisposition;
userGesture: Boolean; out Result: Boolean);
begin
// For simplicity, this demo blocks all popup windows and new tabs
Result := (targetDisposition in [CEF_WOD_NEW_FOREGROUND_TAB,
CEF_WOD_NEW_BACKGROUND_TAB,
CEF_WOD_NEW_POPUP,
CEF_WOD_NEW_WINDOW]);
end;
procedure TMainForm.BrowserCreatedMsg(var aMessage : TMessage);
begin
Caption := 'Network Tracker Browser';
AddressPnl.Enabled := True;
end;
procedure TMainForm.BrowserDestroyMsg(var aMessage : TMessage);
begin
CEFWindowParent1.Free;
end;
procedure TMainForm.GoBtnClick(Sender: TObject);
begin
// This will load the URL in the edit box
Chromium1.LoadURL(AddressEdt.Text);
end;
procedure TMainForm.Timer1Timer(Sender: TObject);
begin
Timer1.Enabled := False;
if not(Chromium1.CreateBrowser(CEFWindowParent1)) and not(Chromium1.Initialized) then
Timer1.Enabled := True;
end;
procedure TMainForm.Timer2Timer(Sender: TObject);
begin
FCritSection.Acquire;
if FLogLines.Count > 0 then
begin
LogMemo.Lines.AddStrings(FLogLines);
FLogLines.Clear;
end;
FCritSection.Release;
end;
procedure TMainForm.WMMove(var aMessage : TWMMove);
begin
inherited;
if (Chromium1 <> nil) then
Chromium1.NotifyMoveOrResizeStarted;
end;
procedure TMainForm.WMMoving(var aMessage : TMessage);
begin
inherited;
if (Chromium1 <> nil) then
Chromium1.NotifyMoveOrResizeStarted;
end;
procedure TMainForm.WMEnterMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then
GlobalCEFApp.OsmodalLoop := True;
end;
procedure TMainForm.WMExitMenuLoop(var aMessage: TMessage);
begin
inherited;
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then
GlobalCEFApp.OsmodalLoop := False;
end;
end.

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 567,
"InternalVersion" : 568,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "122.1.9"
}