2017-02-11 21:56:08 +01:00
// ************************************************************************
// ***************************** 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
//
2019-05-19 16:08:15 +02:00
// Copyright © 2019 Salvador Diaz Fau. All rights reserved.
2017-02-11 21:56:08 +01:00
//
// ************************************************************************
// ************ 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 uMiniBrowser;
{$I cef.inc}
interface
uses
2017-03-15 15:00:07 +01:00
Windows, Messages, SysUtils, Variants, Classes, Graphics, Menus,
2019-05-19 16:08:15 +02:00
Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Types, ComCtrls, ClipBrd, ActiveX, ShlObj,
2018-10-12 12:21:43 +02:00
uCEFChromium, uCEFWindowParent, uCEFInterfaces, uCEFApplication, uCEFTypes, uCEFConstants,
uCEFWinControl;
2017-02-11 21:56:08 +01:00
const
2017-11-04 09:40:31 +01:00
MINIBROWSER_SHOWDEVTOOLS = WM_APP + $101 ;
MINIBROWSER_HIDEDEVTOOLS = WM_APP + $102 ;
MINIBROWSER_COPYHTML = WM_APP + $103 ;
MINIBROWSER_SHOWRESPONSE = WM_APP + $104 ;
MINIBROWSER_COPYFRAMEIDS = WM_APP + $105 ;
MINIBROWSER_COPYFRAMENAMES = WM_APP + $106 ;
MINIBROWSER_SAVEPREFERENCES = WM_APP + $107 ;
2017-11-09 10:33:20 +01:00
MINIBROWSER_COPYALLTEXT = WM_APP + $108 ;
2017-12-05 10:02:07 +01:00
MINIBROWSER_TAKESNAPSHOT = WM_APP + $109 ;
2019-02-03 15:34:21 +01:00
MINIBROWSER_SHOWNAVIGATION = WM_APP + $10A ;
2017-02-11 21:56:08 +01:00
2017-03-15 14:53:45 +01:00
MINIBROWSER_HOMEPAGE = 'https://www.google.com' ;
2017-02-11 21:56:08 +01:00
2017-11-04 09:40:31 +01:00
MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS = MENU_ID_USER_FIRST + 1 ;
MINIBROWSER_CONTEXTMENU_HIDEDEVTOOLS = MENU_ID_USER_FIRST + 2 ;
MINIBROWSER_CONTEXTMENU_COPYHTML = MENU_ID_USER_FIRST + 3 ;
MINIBROWSER_CONTEXTMENU_JSWRITEDOC = MENU_ID_USER_FIRST + 4 ;
MINIBROWSER_CONTEXTMENU_JSPRINTDOC = MENU_ID_USER_FIRST + 5 ;
MINIBROWSER_CONTEXTMENU_SHOWRESPONSE = MENU_ID_USER_FIRST + 6 ;
MINIBROWSER_CONTEXTMENU_COPYFRAMEIDS = MENU_ID_USER_FIRST + 7 ;
MINIBROWSER_CONTEXTMENU_COPYFRAMENAMES = MENU_ID_USER_FIRST + 8 ;
MINIBROWSER_CONTEXTMENU_SAVEPREFERENCES = MENU_ID_USER_FIRST + 9 ;
2017-11-09 10:33:20 +01:00
MINIBROWSER_CONTEXTMENU_COPYALLTEXT = MENU_ID_USER_FIRST + 1 0 ;
2017-12-05 10:02:07 +01:00
MINIBROWSER_CONTEXTMENU_TAKESNAPSHOT = MENU_ID_USER_FIRST + 1 1 ;
2019-02-03 15:34:21 +01:00
MINIBROWSER_CONTEXTMENU_GETNAVIGATION = MENU_ID_USER_FIRST + 1 2 ;
2019-03-24 10:59:39 +01:00
MINIBROWSER_CONTEXTMENU_MUTEAUDIO = MENU_ID_USER_FIRST + 1 3 ;
MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO = MENU_ID_USER_FIRST + 1 4 ;
2017-02-11 21:56:08 +01:00
type
2019-05-19 16:08:15 +02:00
{ TMiniBrowserFrm }
2017-02-11 21:56:08 +01:00
TMiniBrowserFrm = class( TForm)
NavControlPnl: TPanel;
NavButtonPnl: TPanel;
2019-05-19 16:08:15 +02:00
StatusPnl: TPanel;
2017-02-11 21:56:08 +01:00
URLEditPnl: TPanel;
BackBtn: TButton;
ForwardBtn: TButton;
ReloadBtn: TButton;
CEFWindowParent1: TCEFWindowParent;
Chromium1: TChromium;
StopBtn: TButton;
DevTools: TCEFWindowParent;
Splitter1: TSplitter;
2017-03-15 14:53:45 +01:00
URLCbx: TComboBox;
ConfigPnl: TPanel;
ConfigBtn: TButton;
PopupMenu1: TPopupMenu;
DevTools1: TMenuItem;
N1: TMenuItem;
Preferences1: TMenuItem;
2017-03-16 19:09:42 +01:00
GoBtn: TButton;
2017-03-22 15:22:11 +01:00
N2: TMenuItem;
PrintinPDF1: TMenuItem;
Print1: TMenuItem;
N3: TMenuItem;
Zoom1: TMenuItem;
Inczoom1: TMenuItem;
Deczoom1: TMenuItem;
Resetzoom1: TMenuItem;
SaveDialog1: TSaveDialog;
2019-05-19 16:08:15 +02:00
ApplicationEvents1: TApplicationProperties;
2017-06-13 19:12:40 +02:00
OpenDialog1: TOpenDialog;
N4: TMenuItem;
Openfile1: TMenuItem;
2017-10-02 11:36:22 +02:00
Resolvehost1: TMenuItem;
2017-11-01 09:38:38 +01:00
Timer1: TTimer;
2018-04-27 17:42:03 +02:00
OpenfilewithaDAT1: TMenuItem;
2018-10-25 12:50:01 +02:00
N5: TMenuItem;
Memoryinfo1: TMenuItem;
2017-02-11 21:56:08 +01:00
procedure FormShow( Sender: TObject) ;
procedure BackBtnClick( Sender: TObject) ;
procedure ForwardBtnClick( Sender: TObject) ;
procedure ReloadBtnClick( Sender: TObject) ;
procedure Chromium1AfterCreated( Sender: TObject;
const browser: ICefBrowser) ;
procedure Chromium1LoadingStateChange( Sender: TObject;
const browser: ICefBrowser; isLoading, canGoBack,
canGoForward: Boolean ) ;
procedure Chromium1TitleChange( Sender: TObject;
const browser: ICefBrowser; const title: ustring) ;
procedure Chromium1AddressChange( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const url: ustring) ;
procedure Chromium1BeforeContextMenu( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; const model: ICefMenuModel) ;
procedure Chromium1StatusMessage( Sender: TObject;
const browser: ICefBrowser; const value: ustring) ;
2017-03-15 14:53:45 +01:00
procedure Chromium1TextResultAvailable( Sender: TObject;
2018-06-27 10:17:34 +02:00
const aText: ustring) ;
2017-03-15 14:53:45 +01:00
procedure PopupMenu1Popup( Sender: TObject) ;
procedure DevTools1Click( Sender: TObject) ;
procedure Preferences1Click( Sender: TObject) ;
procedure ConfigBtnClick( Sender: TObject) ;
2017-03-16 19:09:42 +01:00
procedure GoBtnClick( Sender: TObject) ;
2017-03-22 15:22:11 +01:00
procedure PrintinPDF1Click( Sender: TObject) ;
procedure Print1Click( Sender: TObject) ;
procedure Inczoom1Click( Sender: TObject) ;
procedure Deczoom1Click( Sender: TObject) ;
procedure Resetzoom1Click( Sender: TObject) ;
2017-05-18 11:44:47 +02:00
procedure Chromium1FullScreenModeChange( Sender: TObject;
const browser: ICefBrowser; fullscreen: Boolean ) ;
2017-05-20 19:20:38 +02:00
procedure Chromium1PreKeyEvent( Sender: TObject;
const browser: ICefBrowser; const event: PCefKeyEvent; osEvent: PMsg;
out isKeyboardShortcut, Result : Boolean ) ;
procedure Chromium1KeyEvent( Sender: TObject;
const browser: ICefBrowser; const event: PCefKeyEvent; osEvent: PMsg;
out Result : Boolean ) ;
procedure ApplicationEvents1Message( var Msg: tagMSG;
var Handled: Boolean ) ;
2017-06-13 19:12:40 +02:00
procedure Openfile1Click( Sender: TObject) ;
2017-07-18 17:50:28 +02:00
procedure Chromium1ContextMenuCommand( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; commandId: Integer ;
eventFlags: Cardinal ; out Result : Boolean ) ;
2017-08-10 20:27:10 +02:00
procedure Chromium1PdfPrintFinished( Sender: TObject;
aResultOK: Boolean ) ;
2017-08-12 16:22:34 +02:00
procedure Chromium1ResourceResponse( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const request: ICefRequest; const response: ICefResponse;
out Result : Boolean ) ;
2017-09-23 11:38:29 +02:00
procedure StopBtnClick( Sender: TObject) ;
2017-10-02 11:36:22 +02:00
procedure Resolvehost1Click( Sender: TObject) ;
procedure Chromium1ResolvedHostAvailable( Sender: TObject;
result : Integer ; const resolvedIps: TStrings) ;
2017-11-01 09:38:38 +01:00
procedure Timer1Timer( Sender: TObject) ;
2017-11-04 09:40:31 +01:00
procedure Chromium1PrefsAvailable( Sender: TObject; aResultOK: Boolean ) ;
2017-11-06 13:19:40 +01:00
procedure Chromium1BeforeDownload( Sender: TObject;
const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
const suggestedName: ustring;
const callback: ICefBeforeDownloadCallback) ;
procedure Chromium1DownloadUpdated( Sender: TObject;
const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
const callback: ICefDownloadItemCallback) ;
2018-01-31 18:52:34 +01:00
procedure FormCreate( Sender: TObject) ;
procedure FormDestroy( Sender: TObject) ;
procedure Chromium1BeforeResourceLoad( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const request: ICefRequest; const callback: ICefRequestCallback;
out Result : TCefReturnValue) ;
2018-03-29 20:02:04 +02:00
procedure FormCloseQuery( Sender: TObject; var CanClose: Boolean ) ;
2018-03-31 18:08:18 +02:00
procedure Chromium1Close( Sender: TObject; const browser: ICefBrowser;
2019-03-28 10:40:36 +01:00
var aAction : TCefCloseBrowserAction) ;
2018-03-31 18:08:18 +02:00
procedure Chromium1BeforeClose( Sender: TObject;
const browser: ICefBrowser) ;
procedure Chromium1RenderCompMsg( var aMessage : TMessage; var aHandled: Boolean ) ;
2018-04-20 12:45:06 +02:00
procedure Chromium1LoadingProgressChange( Sender: TObject;
const browser: ICefBrowser; const progress: Double ) ;
2018-04-27 17:42:03 +02:00
procedure OpenfilewithaDAT1Click( Sender: TObject) ;
2018-06-27 10:17:34 +02:00
procedure Chromium1LoadEnd( Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; httpStatusCode: Integer ) ;
2018-10-25 12:50:01 +02:00
procedure Memoryinfo1Click( Sender: TObject) ;
2018-11-28 11:53:54 +01:00
procedure Chromium1LoadError( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
errorCode: Integer ; const errorText, failedUrl: ustring) ;
procedure Chromium1CertificateError( Sender: TObject;
const browser: ICefBrowser; certError: Integer ;
const requestUrl: ustring; const sslInfo: ICefSslInfo;
const callback: ICefRequestCallback; out Result : Boolean ) ;
2019-02-03 15:34:21 +01:00
procedure Chromium1NavigationVisitorResultAvailable(
const entry: ICefNavigationEntry; current: Boolean ; index , total: Integer ;
var aResult: Boolean ) ;
2017-02-11 21:56:08 +01:00
protected
2019-02-03 15:34:21 +01:00
FResponse : TStringList;
FRequest : TStringList;
FNavigation : TStringList;
2018-03-31 18:08:18 +02:00
// 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.
2017-07-18 17:50:28 +02:00
2017-03-15 14:53:45 +01:00
procedure AddURL( const aURL : string ) ;
procedure ShowDevTools( aPoint : TPoint) ; overload ;
procedure ShowDevTools; overload ;
2017-02-11 21:56:08 +01:00
procedure HideDevTools;
2017-05-20 19:20:38 +02:00
procedure HandleKeyUp( const aMsg : TMsg; var aHandled : boolean ) ;
procedure HandleKeyDown( const aMsg : TMsg; var aHandled : boolean ) ;
2018-01-31 18:52:34 +01:00
procedure InspectRequest( const aRequest : ICefRequest) ;
procedure InspectResponse( const aResponse : ICefResponse) ;
2017-09-07 10:58:09 +02:00
procedure BrowserCreatedMsg( var aMessage : TMessage) ; message CEF_AFTERCREATED;
2018-03-31 18:08:18 +02:00
procedure BrowserDestroyMsg( var aMessage : TMessage) ; message CEF_DESTROY;
2017-02-11 21:56:08 +01:00
procedure ShowDevToolsMsg( var aMessage : TMessage) ; message MINIBROWSER_SHOWDEVTOOLS;
procedure HideDevToolsMsg( var aMessage : TMessage) ; message MINIBROWSER_HIDEDEVTOOLS;
2017-11-09 10:33:20 +01:00
procedure CopyAllTextMsg( var aMessage : TMessage) ; message MINIBROWSER_COPYALLTEXT;
2017-03-15 14:53:45 +01:00
procedure CopyHTMLMsg( var aMessage : TMessage) ; message MINIBROWSER_COPYHTML;
2017-09-24 12:48:04 +02:00
procedure CopyFramesIDsMsg( var aMessage : TMessage) ; message MINIBROWSER_COPYFRAMEIDS;
procedure CopyFramesNamesMsg( var aMessage : TMessage) ; message MINIBROWSER_COPYFRAMENAMES;
2017-08-12 16:22:34 +02:00
procedure ShowResponseMsg( var aMessage : TMessage) ; message MINIBROWSER_SHOWRESPONSE;
2019-02-03 15:34:21 +01:00
procedure ShowNavigationMsg( var aMessage : TMessage) ; message MINIBROWSER_SHOWNAVIGATION;
2017-11-04 09:40:31 +01:00
procedure SavePreferencesMsg( var aMessage : TMessage) ; message MINIBROWSER_SAVEPREFERENCES;
2017-12-05 10:02:07 +01:00
procedure TakeSnapshotMsg( var aMessage : TMessage) ; message MINIBROWSER_TAKESNAPSHOT;
2017-04-24 12:57:16 +02:00
procedure WMMove( var aMessage : TWMMove) ; message WM_MOVE;
procedure WMMoving( var aMessage : TMessage) ; message WM_MOVING;
2017-12-07 10:49:51 +01:00
procedure WMEnterMenuLoop( var aMessage: TMessage) ; message WM_ENTERMENULOOP;
procedure WMExitMenuLoop( var aMessage: TMessage) ; message WM_EXITMENULOOP;
2017-07-18 17:50:28 +02:00
2017-02-11 21:56:08 +01:00
public
2017-07-18 17:50:28 +02:00
procedure ShowStatusText( const aText : string ) ;
2017-02-11 21:56:08 +01:00
end ;
var
MiniBrowserFrm : TMiniBrowserFrm;
implementation
2019-05-19 16:08:15 +02:00
{$R *.lfm}
2017-02-11 21:56:08 +01:00
2017-03-15 14:53:45 +01:00
uses
2018-04-27 17:42:03 +02:00
uPreferences, uCefStringMultimap, uCEFMiscFunctions, uSimpleTextViewer;
2017-03-15 14:53:45 +01:00
2018-03-31 18:08:18 +02:00
// Destruction steps
// =================
// 1. FormCloseQuery sets CanClose to FALSE calls TChromium.CloseBrowser which triggers the TChromium.OnClose event.
// 2. TChromium.OnClose sends a CEFBROWSER_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.
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. BackBtnClick( Sender: TObject) ;
begin
Chromium1. GoBack;
end ;
procedure TMiniBrowserFrm. ForwardBtnClick( Sender: TObject) ;
begin
Chromium1. GoForward;
end ;
2017-03-16 19:09:42 +01:00
procedure TMiniBrowserFrm. GoBtnClick( Sender: TObject) ;
begin
Chromium1. LoadURL( URLCbx. Text ) ;
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. ReloadBtnClick( Sender: TObject) ;
begin
Chromium1. Reload;
end ;
2017-03-22 15:22:11 +01:00
procedure TMiniBrowserFrm. Resetzoom1Click( Sender: TObject) ;
begin
Chromium1. ResetZoomStep;
end ;
2017-10-02 11:36:22 +02:00
procedure TMiniBrowserFrm. Resolvehost1Click( Sender: TObject) ;
var
TempURL : string ;
begin
TempURL : = inputbox( 'Resolve host' , 'URL :' , 'http://google.com' ) ;
if ( length( TempURL) > 0 ) then Chromium1. ResolveHost( TempURL) ;
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. Chromium1AddressChange( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; const url: ustring) ;
begin
2018-02-16 18:41:13 +01:00
if Chromium1. IsSameBrowser( browser) then AddURL( url) ;
2017-02-11 21:56:08 +01:00
end ;
2017-09-07 10:58:09 +02:00
procedure TMiniBrowserFrm. Chromium1AfterCreated( Sender: TObject; const browser: ICefBrowser) ;
2017-02-11 21:56:08 +01:00
begin
2018-02-16 18:41:13 +01:00
if Chromium1. IsSameBrowser( browser) then
2018-03-31 18:08:18 +02:00
PostMessage( Handle, CEF_AFTERCREATED, 0 , 0 )
else
SendMessage( browser. Host. WindowHandle, WM_SETICON, 1 , application. Icon. Handle) ; // Use the same icon in the popup window
end ;
procedure TMiniBrowserFrm. Chromium1BeforeClose( Sender: TObject; const browser: ICefBrowser) ;
begin
2019-04-04 10:26:44 +02:00
// The main browser is being destroyed
if ( Chromium1. BrowserId = 0 ) then
2018-03-31 18:08:18 +02:00
begin
FCanClose : = True ;
PostMessage( Handle, WM_CLOSE, 0 , 0 ) ;
end ;
2017-02-11 21:56:08 +01:00
end ;
procedure TMiniBrowserFrm. Chromium1BeforeContextMenu( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; const model: ICefMenuModel) ;
begin
2018-02-16 18:41:13 +01:00
if not( Chromium1. IsSameBrowser( browser) ) then exit;
2017-12-05 10:02:07 +01:00
model. AddSeparator;
model. AddItem( MINIBROWSER_CONTEXTMENU_TAKESNAPSHOT, 'Take snapshot...' ) ;
2019-02-03 15:34:21 +01:00
model. AddItem( MINIBROWSER_CONTEXTMENU_GETNAVIGATION, 'Get navigation entries' ) ;
2017-02-11 21:56:08 +01:00
model. AddSeparator;
2017-11-09 10:33:20 +01:00
model. AddItem( MINIBROWSER_CONTEXTMENU_COPYALLTEXT, 'Copy displayed text to clipboard' ) ;
2017-11-04 09:40:31 +01:00
model. AddItem( MINIBROWSER_CONTEXTMENU_COPYHTML, 'Copy HTML to clipboard' ) ;
model. AddItem( MINIBROWSER_CONTEXTMENU_COPYFRAMEIDS, 'Copy HTML frame identifiers to clipboard' ) ;
model. AddItem( MINIBROWSER_CONTEXTMENU_COPYFRAMENAMES, 'Copy HTML frame names to clipboard' ) ;
2018-12-09 11:11:59 +01:00
2017-09-24 12:48:04 +02:00
model. AddSeparator;
2017-11-04 09:40:31 +01:00
model. AddItem( MINIBROWSER_CONTEXTMENU_SAVEPREFERENCES, 'Save preferences as...' ) ;
model. AddSeparator;
model. AddItem( MINIBROWSER_CONTEXTMENU_JSWRITEDOC, 'Modify HTML document' ) ;
model. AddItem( MINIBROWSER_CONTEXTMENU_JSPRINTDOC, 'Print using Javascript' ) ;
2018-01-31 18:52:34 +01:00
model. AddItem( MINIBROWSER_CONTEXTMENU_SHOWRESPONSE, 'Show server headers' ) ;
2017-02-11 21:56:08 +01:00
if DevTools. Visible then
model. AddItem( MINIBROWSER_CONTEXTMENU_HIDEDEVTOOLS, 'Hide DevTools' )
else
model. AddItem( MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS, 'Show DevTools' ) ;
2019-03-24 10:59:39 +01:00
if Chromium1. AudioMuted then
model. AddItem( MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO, 'Unmute audio' )
else
model. AddItem( MINIBROWSER_CONTEXTMENU_MUTEAUDIO, 'Mute audio' ) ;
2017-02-11 21:56:08 +01:00
end ;
2017-11-06 13:19:40 +01:00
function PathToMyDocuments : string ;
var
Allocator : IMalloc;
Path : pchar ;
idList : PItemIDList;
begin
Result : = '' ;
Path : = nil ;
idList : = nil ;
try
if ( SHGetMalloc( Allocator) = S_OK) then
begin
GetMem( Path, MAX_PATH) ;
if ( SHGetSpecialFolderLocation( 0 , CSIDL_PERSONAL, idList) = S_OK) and
SHGetPathFromIDList( idList, Path) then
Result : = string( Path) ;
end ;
finally
if ( Path < > nil ) then FreeMem( Path) ;
if ( idList < > nil ) then Allocator. Free( idList) ;
end ;
end ;
procedure TMiniBrowserFrm. Chromium1BeforeDownload( Sender: TObject;
const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
const suggestedName: ustring;
const callback: ICefBeforeDownloadCallback) ;
var
TempMyDocuments, TempFullPath, TempName : string ;
begin
2018-02-16 18:41:13 +01:00
if not( Chromium1. IsSameBrowser( browser) ) or
( downloadItem = nil ) or
not( downloadItem. IsValid) then
exit;
2017-11-06 13:19:40 +01:00
TempMyDocuments : = PathToMyDocuments;
if ( length( suggestedName) > 0 ) then
TempName : = suggestedName
else
TempName : = 'DownloadedFile' ;
if ( length( TempMyDocuments) > 0 ) then
TempFullPath : = IncludeTrailingPathDelimiter( TempMyDocuments) + TempName
else
TempFullPath : = TempName;
callback. cont( TempFullPath, False ) ;
end ;
2018-01-31 18:52:34 +01:00
procedure TMiniBrowserFrm. Chromium1BeforeResourceLoad( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const request: ICefRequest; const callback: ICefRequestCallback;
out Result : TCefReturnValue) ;
begin
Result : = RV_CONTINUE;
2018-02-16 18:41:13 +01:00
if Chromium1. IsSameBrowser( browser) and
( frame < > nil ) and
frame. IsMain then
2018-01-31 18:52:34 +01:00
InspectRequest( request) ;
end ;
2018-11-28 11:53:54 +01:00
procedure TMiniBrowserFrm. Chromium1CertificateError( Sender: TObject;
const browser: ICefBrowser; certError: Integer ;
const requestUrl: ustring; const sslInfo: ICefSslInfo;
const callback: ICefRequestCallback; out Result : Boolean ) ;
begin
CefDebugLog( 'Certificate error code:' + inttostr( certError) +
' - URL:' + requestUrl, CEF_LOG_SEVERITY_ERROR) ;
Result : = False ;
end ;
2019-03-28 10:40:36 +01:00
procedure TMiniBrowserFrm. Chromium1Close( Sender: TObject; const browser: ICefBrowser; var aAction : TCefCloseBrowserAction) ;
2018-03-31 18:08:18 +02:00
begin
if ( browser < > nil ) and ( Chromium1. BrowserId = browser. Identifier) then
begin
PostMessage( Handle, CEF_DESTROY, 0 , 0 ) ;
2019-03-28 10:40:36 +01:00
aAction : = cbaDelay;
end ;
2018-03-31 18:08:18 +02:00
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. Chromium1ContextMenuCommand( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const params: ICefContextMenuParams; commandId: Integer ;
2017-07-18 17:50:28 +02:00
eventFlags: Cardinal ; out Result : Boolean ) ;
2017-02-11 21:56:08 +01:00
var
2017-02-26 16:23:01 +01:00
TempParam : WParam;
2017-02-11 21:56:08 +01:00
begin
Result : = False ;
2018-02-16 18:41:13 +01:00
if not( Chromium1. IsSameBrowser( browser) ) then exit;
2017-02-11 21:56:08 +01:00
case commandId of
MINIBROWSER_CONTEXTMENU_HIDEDEVTOOLS :
PostMessage( Handle, MINIBROWSER_HIDEDEVTOOLS, 0 , 0 ) ;
MINIBROWSER_CONTEXTMENU_SHOWDEVTOOLS :
begin
2017-02-26 16:23:01 +01:00
TempParam : = ( ( params. XCoord and $FFFF ) shl 1 6 ) or ( params. YCoord and $FFFF ) ;
PostMessage( Handle, MINIBROWSER_SHOWDEVTOOLS, TempParam, 0 ) ;
2017-02-11 21:56:08 +01:00
end ;
2017-11-09 10:33:20 +01:00
MINIBROWSER_CONTEXTMENU_COPYALLTEXT :
PostMessage( Handle, MINIBROWSER_COPYALLTEXT, 0 , 0 ) ;
2017-03-15 14:53:45 +01:00
MINIBROWSER_CONTEXTMENU_COPYHTML :
PostMessage( Handle, MINIBROWSER_COPYHTML, 0 , 0 ) ;
2017-03-22 15:22:11 +01:00
2017-09-24 12:48:04 +02:00
MINIBROWSER_CONTEXTMENU_COPYFRAMEIDS :
PostMessage( Handle, MINIBROWSER_COPYFRAMEIDS, 0 , 0 ) ;
MINIBROWSER_CONTEXTMENU_COPYFRAMENAMES :
PostMessage( Handle, MINIBROWSER_COPYFRAMENAMES, 0 , 0 ) ;
2017-08-12 16:22:34 +02:00
MINIBROWSER_CONTEXTMENU_SHOWRESPONSE :
PostMessage( Handle, MINIBROWSER_SHOWRESPONSE, 0 , 0 ) ;
2017-07-18 17:50:28 +02:00
2017-11-04 09:40:31 +01:00
MINIBROWSER_CONTEXTMENU_SAVEPREFERENCES :
PostMessage( Handle, MINIBROWSER_SAVEPREFERENCES, 0 , 0 ) ;
2017-12-05 10:02:07 +01:00
MINIBROWSER_CONTEXTMENU_TAKESNAPSHOT :
PostMessage( Handle, MINIBROWSER_TAKESNAPSHOT, 0 , 0 ) ;
2019-02-03 15:34:21 +01:00
MINIBROWSER_CONTEXTMENU_GETNAVIGATION :
begin
FNavigation. Clear;
Chromium1. GetNavigationEntries( False ) ;
end ;
2017-04-06 10:07:06 +02:00
MINIBROWSER_CONTEXTMENU_JSWRITEDOC :
if ( browser < > nil ) and ( browser. MainFrame < > nil ) then
browser. MainFrame. ExecuteJavaScript(
'var css = ' + chr( 3 9 ) + '@page {size: A4; margin: 0;} @media print {html, body {width: 210mm; height: 297mm;}}' + chr( 3 9 ) + '; ' +
'var style = document.createElement(' + chr( 3 9 ) + 'style' + chr( 3 9 ) + '); ' +
'style.type = ' + chr( 3 9 ) + 'text/css' + chr( 3 9 ) + '; ' +
'style.appendChild(document.createTextNode(css)); ' +
'document.head.appendChild(style);' ,
'about:blank' , 0 ) ;
MINIBROWSER_CONTEXTMENU_JSPRINTDOC :
if ( browser < > nil ) and ( browser. MainFrame < > nil ) then
browser. MainFrame. ExecuteJavaScript( 'window.print();' , 'about:blank' , 0 ) ;
2019-03-24 10:59:39 +01:00
MINIBROWSER_CONTEXTMENU_UNMUTEAUDIO :
Chromium1. AudioMuted : = False ;
MINIBROWSER_CONTEXTMENU_MUTEAUDIO :
Chromium1. AudioMuted : = True ;
2017-02-11 21:56:08 +01:00
end ;
end ;
2017-11-06 13:19:40 +01:00
procedure TMiniBrowserFrm. Chromium1DownloadUpdated( Sender: TObject;
const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
const callback: ICefDownloadItemCallback) ;
var
TempString : string ;
begin
2018-02-16 18:41:13 +01:00
if not( Chromium1. IsSameBrowser( browser) ) then exit;
2017-11-06 13:19:40 +01:00
if downloadItem. IsComplete then
ShowStatusText( downloadItem. FullPath + ' completed' )
else
if downloadItem. IsCanceled then
ShowStatusText( downloadItem. FullPath + ' canceled' )
else
if downloadItem. IsInProgress then
begin
if ( downloadItem. PercentComplete > = 0 ) then
TempString : = downloadItem. FullPath + ' : ' + inttostr( downloadItem. PercentComplete) + '%'
else
TempString : = downloadItem. FullPath + ' : ' + inttostr( downloadItem. ReceivedBytes) + ' bytes received' ;
ShowStatusText( TempString) ;
end ;
end ;
2017-05-18 11:44:47 +02:00
procedure TMiniBrowserFrm. Chromium1FullScreenModeChange( Sender: TObject;
const browser: ICefBrowser; fullscreen: Boolean ) ;
2017-05-20 19:20:38 +02:00
begin
2018-02-16 18:41:13 +01:00
if not( Chromium1. IsSameBrowser( browser) ) then exit;
2018-03-17 11:12:03 +01:00
// This event is executed in a CEF thread and this can cause problems when
// you change the 'Enabled' and 'Visible' properties from VCL components.
// It's recommended to change the 'Enabled' and 'Visible' properties
// in the main application thread and not in a CEF thread.
// It's much safer to use PostMessage to send a message to the main form with
// all this information and update those properties in the procedure handling
// that message.
2017-05-18 11:44:47 +02:00
if fullscreen then
begin
NavControlPnl. Visible : = False ;
if ( WindowState = wsMaximized) then WindowState : = wsNormal;
BorderIcons : = [ ] ;
BorderStyle : = bsNone;
WindowState : = wsMaximized;
end
else
begin
BorderIcons : = [ biSystemMenu, biMinimize, biMaximize] ;
BorderStyle : = bsSizeable;
WindowState : = wsNormal;
NavControlPnl. Visible : = True ;
end ;
end ;
2017-05-20 19:20:38 +02:00
procedure TMiniBrowserFrm. Chromium1KeyEvent( Sender: TObject;
const browser: ICefBrowser; const event: PCefKeyEvent; osEvent: PMsg;
out Result : Boolean ) ;
var
TempMsg : TMsg;
begin
Result : = False ;
if ( event < > nil ) and ( osEvent < > nil ) then
case osEvent. Message of
WM_KEYUP :
begin
TempMsg : = osEvent^ ;
HandleKeyUp( TempMsg, Result ) ;
end ;
WM_KEYDOWN :
begin
TempMsg : = osEvent^ ;
HandleKeyDown( TempMsg, Result ) ;
end ;
end ;
end ;
procedure TMiniBrowserFrm. ApplicationEvents1Message( var Msg: tagMSG;
var Handled: Boolean ) ;
begin
case Msg. message of
WM_KEYUP : HandleKeyUp( Msg, Handled) ;
WM_KEYDOWN : HandleKeyDown( Msg, Handled) ;
end ;
end ;
procedure TMiniBrowserFrm. HandleKeyUp( const aMsg : TMsg; var aHandled : boolean ) ;
var
TempMessage : TMessage;
TempKeyMsg : TWMKey;
begin
TempMessage. Msg : = aMsg. message ;
TempMessage. wParam : = aMsg. wParam;
TempMessage. lParam : = aMsg. lParam;
TempKeyMsg : = TWMKey( TempMessage) ;
if ( TempKeyMsg. CharCode = VK_F12) then
begin
aHandled : = True ;
if DevTools. Visible then
PostMessage( Handle, MINIBROWSER_HIDEDEVTOOLS, 0 , 0 )
else
PostMessage( Handle, MINIBROWSER_SHOWDEVTOOLS, 0 , 0 ) ;
end ;
end ;
procedure TMiniBrowserFrm. HandleKeyDown( const aMsg : TMsg; var aHandled : boolean ) ;
var
TempMessage : TMessage;
TempKeyMsg : TWMKey;
begin
TempMessage. Msg : = aMsg. message ;
TempMessage. wParam : = aMsg. wParam;
TempMessage. lParam : = aMsg. lParam;
TempKeyMsg : = TWMKey( TempMessage) ;
if ( TempKeyMsg. CharCode = VK_F12) then aHandled : = True ;
end ;
2018-06-27 10:17:34 +02:00
procedure TMiniBrowserFrm. Chromium1LoadEnd( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
httpStatusCode: Integer ) ;
begin
if frame. IsMain then
2019-05-19 16:08:15 +02:00
StatusPnl. Caption : = 'main frame loaded : ' + quotedstr( frame. name )
2018-06-27 10:17:34 +02:00
else
2019-05-19 16:08:15 +02:00
StatusPnl. Caption : = 'frame loaded : ' + quotedstr( frame. name ) ;
2018-06-27 10:17:34 +02:00
end ;
2018-11-28 11:53:54 +01:00
procedure TMiniBrowserFrm. Chromium1LoadError( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame; errorCode: Integer ;
const errorText, failedUrl: ustring) ;
begin
CefDebugLog( 'Error code:' + inttostr( errorCode) +
' - Error text :' + quotedstr( errorText) +
' - URL:' + failedUrl, CEF_LOG_SEVERITY_ERROR) ;
end ;
2018-04-20 12:45:06 +02:00
procedure TMiniBrowserFrm. Chromium1LoadingProgressChange( Sender: TObject;
const browser: ICefBrowser; const progress: Double ) ;
begin
2019-05-19 16:08:15 +02:00
StatusPnl. Caption : = 'Loading... ' + FloatToStrF( progress * 1 0 0 , ffFixed, 3 , 0 ) + '%' ;
2018-04-20 12:45:06 +02:00
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. Chromium1LoadingStateChange( Sender: TObject;
const browser: ICefBrowser; isLoading, canGoBack, canGoForward: Boolean ) ;
begin
2018-03-29 20:02:04 +02:00
if not( Chromium1. IsSameBrowser( browser) ) or FClosing then exit;
2018-02-16 18:41:13 +01:00
2018-03-17 11:12:03 +01:00
// This event is executed in a CEF thread and this can cause problems when
// you change the 'Enabled' and 'Visible' properties from VCL components.
// It's recommended to change the 'Enabled' and 'Visible' properties
// in the main application thread and not in a CEF thread.
// It's much safer to use PostMessage to send a message to the main form with
// all this information and update those properties in the procedure handling
// that message.
2017-02-11 21:56:08 +01:00
BackBtn. Enabled : = canGoBack;
ForwardBtn. Enabled : = canGoForward;
2017-12-30 09:54:26 +01:00
if isLoading then
begin
2019-05-19 16:08:15 +02:00
StatusPnl. Caption : = 'Loading...' ;
2017-12-30 09:54:26 +01:00
ReloadBtn. Enabled : = False ;
StopBtn. Enabled : = True ;
end
else
begin
2019-05-19 16:08:15 +02:00
StatusPnl. Caption : = 'Finished' ;
2017-12-30 09:54:26 +01:00
ReloadBtn. Enabled : = True ;
StopBtn. Enabled : = False ;
end ;
2017-02-11 21:56:08 +01:00
end ;
2019-02-03 15:34:21 +01:00
procedure TMiniBrowserFrm. Chromium1NavigationVisitorResultAvailable(
const entry: ICefNavigationEntry; current: Boolean ; index , total: Integer ;
var aResult: Boolean ) ;
begin
if ( entry < > nil ) and entry. IsValid then FNavigation. Add( entry. Url) ;
if ( index < pred( total) ) then
aResult : = True
else
begin
aResult : = False ;
PostMessage( Handle, MINIBROWSER_SHOWNAVIGATION, 0 , 0 ) ;
end ;
end ;
2017-08-10 20:27:10 +02:00
procedure TMiniBrowserFrm. Chromium1PdfPrintFinished( Sender: TObject; aResultOK: Boolean ) ;
begin
if aResultOK then
showmessage( 'The PDF file was generated successfully' )
else
showmessage( 'There was a problem generating the PDF file.' ) ;
end ;
2017-11-04 09:40:31 +01:00
procedure TMiniBrowserFrm. Chromium1PrefsAvailable( Sender: TObject; aResultOK: Boolean ) ;
begin
if aResultOK then
showmessage( 'The preferences file was generated successfully' )
else
showmessage( 'There was a problem generating the preferences file.' ) ;
end ;
2017-05-20 19:20:38 +02:00
procedure TMiniBrowserFrm. Chromium1PreKeyEvent( Sender: TObject;
const browser: ICefBrowser; const event: PCefKeyEvent; osEvent: PMsg;
out isKeyboardShortcut, Result : Boolean ) ;
begin
Result : = False ;
2019-03-22 13:12:44 +01:00
if ( event < > nil ) and
2017-05-20 19:20:38 +02:00
( event. kind in [ KEYEVENT_KEYDOWN, KEYEVENT_KEYUP] ) and
( event. windows_key_code = VK_F12) then
isKeyboardShortcut : = True ;
end ;
2018-03-31 18:08:18 +02:00
procedure TMiniBrowserFrm. Chromium1RenderCompMsg( var aMessage : TMessage; var aHandled: Boolean ) ;
begin
if not( FClosing) and ( aMessage. Msg = WM_MOUSEMOVE) then
begin
2019-05-19 16:08:15 +02:00
StatusPnl. Caption : = 'x : ' + inttostr( aMessage. lParam and $FFFF ) + ' - ' +
'y : ' + inttostr( ( aMessage. lParam and $FFFF0000 ) shr 1 6 ) ;
2018-03-31 18:08:18 +02:00
end ;
end ;
2017-10-02 11:36:22 +02:00
procedure TMiniBrowserFrm. Chromium1ResolvedHostAvailable( Sender: TObject;
result : Integer ; const resolvedIps: TStrings) ;
begin
if ( result = ERR_NONE) then
2019-05-19 16:08:15 +02:00
StatusPnl. Caption : = 'Resolved IPs : ' + resolvedIps. CommaText
2017-10-02 11:36:22 +02:00
else
2019-05-19 16:08:15 +02:00
StatusPnl. Caption : = 'There was a problem resolving the host.' + CRLF +
'Error code : ' + inttostr( result ) ;
2017-10-02 11:36:22 +02:00
end ;
2018-01-31 18:52:34 +01:00
procedure TMiniBrowserFrm. InspectRequest( const aRequest : ICefRequest) ;
var
TempHeaderMap : ICefStringMultimap;
i, j : integer ;
begin
if ( aRequest < > nil ) then
begin
FRequest. Clear;
TempHeaderMap : = TCefStringMultimapOwn. Create;
aRequest. GetHeaderMap( TempHeaderMap) ;
i : = 0 ;
j : = TempHeaderMap. Size;
while ( i < j) do
begin
FRequest. Add( TempHeaderMap. Key[ i] + '=' + TempHeaderMap. Value[ i] ) ;
inc( i) ;
end ;
end ;
end ;
procedure TMiniBrowserFrm. InspectResponse( const aResponse : ICefResponse) ;
var
TempHeaderMap : ICefStringMultimap;
i, j : integer ;
begin
if ( aResponse < > nil ) then
begin
FResponse. Clear;
TempHeaderMap : = TCefStringMultimapOwn. Create;
aResponse. GetHeaderMap( TempHeaderMap) ;
i : = 0 ;
j : = TempHeaderMap. Size;
while ( i < j) do
begin
FResponse. Add( TempHeaderMap. Key[ i] + '=' + TempHeaderMap. Value[ i] ) ;
inc( i) ;
end ;
end ;
end ;
2018-10-25 12:50:01 +02:00
procedure TMiniBrowserFrm. Memoryinfo1Click( Sender: TObject) ;
const
BYTES_PER_MEGABYTE = 1 0 2 4 * 1 0 2 4 ;
var
TempMessage : string ;
begin
TempMessage : = 'Total memory used by this application : ' + inttostr( GlobalCEFApp. UsedMemory div BYTES_PER_MEGABYTE) + ' Mb' + CRLF +
'Total system memory : ' + inttostr( GlobalCEFApp. TotalSystemMemory div BYTES_PER_MEGABYTE) + ' Mb' + CRLF +
'Available physical memory : ' + inttostr( GlobalCEFApp. AvailableSystemMemory div BYTES_PER_MEGABYTE) + ' Mb' + CRLF +
'Memory load : ' + inttostr( GlobalCEFApp. SystemMemoryLoad) + ' %' ;
MessageDlg( TempMessage, mtInformation, [ mbOK] , 0 ) ;
end ;
2017-08-12 16:22:34 +02:00
procedure TMiniBrowserFrm. Chromium1ResourceResponse( Sender: TObject;
const browser: ICefBrowser; const frame: ICefFrame;
const request: ICefRequest; const response: ICefResponse;
out Result : Boolean ) ;
2017-02-11 21:56:08 +01:00
begin
2017-08-12 16:22:34 +02:00
Result : = False ;
2017-07-18 17:50:28 +02:00
2018-02-16 18:41:13 +01:00
if Chromium1. IsSameBrowser( browser) and
( frame < > nil ) and
frame. IsMain then
2018-01-31 18:52:34 +01:00
InspectResponse( response) ;
2017-07-18 17:50:28 +02:00
end ;
procedure TMiniBrowserFrm. ShowStatusText( const aText : string ) ;
begin
2019-05-19 16:08:15 +02:00
if not( FClosing) then StatusPnl. Caption : = aText;
2017-02-11 21:56:08 +01:00
end ;
2017-09-23 11:38:29 +02:00
procedure TMiniBrowserFrm. StopBtnClick( Sender: TObject) ;
begin
Chromium1. StopLoad;
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. Chromium1StatusMessage( Sender: TObject;
const browser: ICefBrowser; const value: ustring) ;
begin
2018-02-16 18:41:13 +01:00
if Chromium1. IsSameBrowser( browser) then ShowStatusText( value) ;
2017-02-11 21:56:08 +01:00
end ;
2018-06-27 10:17:34 +02:00
procedure TMiniBrowserFrm. Chromium1TextResultAvailable( Sender: TObject; const aText: ustring) ;
2017-03-15 14:53:45 +01:00
begin
clipboard. AsText : = aText;
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. Chromium1TitleChange( Sender: TObject;
const browser: ICefBrowser; const title: ustring) ;
begin
2018-02-16 18:41:13 +01:00
if not( Chromium1. IsSameBrowser( browser) ) then exit;
2017-02-11 21:56:08 +01:00
if ( title < > '' ) then
caption : = 'MiniBrowser - ' + title
else
caption : = 'MiniBrowser' ;
end ;
2018-03-29 20:02:04 +02:00
procedure TMiniBrowserFrm. FormCloseQuery( Sender: TObject; var CanClose: Boolean ) ;
begin
2018-03-31 18:08:18 +02:00
CanClose : = FCanClose;
if not( FClosing) then
begin
FClosing : = True ;
Visible : = False ;
Chromium1. CloseBrowser( True ) ;
end ;
2018-03-29 20:02:04 +02:00
end ;
2018-01-31 18:52:34 +01:00
procedure TMiniBrowserFrm. FormCreate( Sender: TObject) ;
begin
2019-02-03 15:34:21 +01:00
FCanClose : = False ;
FClosing : = False ;
FResponse : = TStringList. Create;
FRequest : = TStringList. Create;
FNavigation : = TStringList. Create;
2018-10-20 14:46:24 +02:00
Chromium1. DefaultURL : = MINIBROWSER_HOMEPAGE;
2018-01-31 18:52:34 +01:00
end ;
procedure TMiniBrowserFrm. FormDestroy( Sender: TObject) ;
begin
FResponse. Free;
FRequest. Free;
2019-02-03 15:34:21 +01:00
FNavigation. Free;
2018-01-31 18:52:34 +01:00
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. FormShow( Sender: TObject) ;
begin
2017-11-04 09:40:31 +01:00
ShowStatusText( 'Initializing browser. Please wait...' ) ;
// WebRTC's IP leaking can lowered/avoided by setting these preferences
// To test this go to https://www.browserleaks.com/webrtc
Chromium1. WebRTCIPHandlingPolicy : = hpDisableNonProxiedUDP;
Chromium1. WebRTCMultipleRoutes : = STATE_DISABLED;
Chromium1. WebRTCNonproxiedUDP : = STATE_DISABLED;
2017-11-01 09:38:38 +01:00
// 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 TMiniBrowserFrm. Timer1Timer( Sender: TObject) ;
begin
Timer1. Enabled : = False ;
2017-11-16 12:49:15 +01:00
if not( Chromium1. CreateBrowser( CEFWindowParent1, '' ) ) and not( Chromium1. Initialized) then
Timer1. Enabled : = True ;
2017-02-11 21:56:08 +01:00
end ;
procedure TMiniBrowserFrm. BrowserCreatedMsg( var aMessage : TMessage) ;
begin
2017-08-23 12:28:45 +02:00
CEFWindowParent1. UpdateSize;
2017-02-11 21:56:08 +01:00
NavControlPnl. Enabled : = True ;
end ;
2018-03-31 18:08:18 +02:00
procedure TMiniBrowserFrm. BrowserDestroyMsg( var aMessage : TMessage) ;
begin
CEFWindowParent1. Free;
end ;
2017-03-15 14:53:45 +01:00
procedure TMiniBrowserFrm. AddURL( const aURL : string ) ;
begin
if ( URLCbx. Items. IndexOf( aURL) < 0 ) then URLCbx. Items. Add( aURL) ;
URLCbx. Text : = aURL;
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. ShowDevToolsMsg( var aMessage : TMessage) ;
2017-02-26 16:23:01 +01:00
var
TempPoint : TPoint;
2017-02-11 21:56:08 +01:00
begin
2017-02-26 16:23:01 +01:00
TempPoint. x : = ( aMessage. wParam shr 1 6 ) and $FFFF ;
TempPoint. y : = aMessage. wParam and $FFFF ;
ShowDevTools( TempPoint) ;
2017-02-11 21:56:08 +01:00
end ;
procedure TMiniBrowserFrm. HideDevToolsMsg( var aMessage : TMessage) ;
begin
HideDevTools;
2019-03-22 13:12:44 +01:00
Chromium1. SetFocus( True ) ;
2017-02-11 21:56:08 +01:00
end ;
2017-03-22 15:22:11 +01:00
procedure TMiniBrowserFrm. Inczoom1Click( Sender: TObject) ;
begin
Chromium1. IncZoomStep;
end ;
2017-06-13 19:12:40 +02:00
procedure TMiniBrowserFrm. Openfile1Click( Sender: TObject) ;
begin
2018-04-27 17:42:03 +02:00
OpenDialog1. Filter : = 'Any file (*.*)|*.*' ;
if OpenDialog1. Execute then
begin
// This is a quick solution to load files. The file URL should be properly encoded.
Chromium1. LoadURL( 'file:///' + OpenDialog1. FileName) ;
end ;
end ;
procedure TMiniBrowserFrm. OpenfilewithaDAT1Click( Sender: TObject) ;
var
TempDATA : string ;
TempFile : TMemoryStream;
begin
TempFile : = nil ;
try
try
2018-09-07 11:53:31 +02:00
OpenDialog1. Filter : = 'HTML files (*.html)|*.HTML;*.HTM|PDF files (*.pdf)|*.PDF' ;
2018-04-27 17:42:03 +02:00
if OpenDialog1. Execute then
begin
// Use TByteStream instead of TMemoryStream if your Delphi version supports it.
TempFile : = TMemoryStream. Create;
TempFile. LoadFromFile( OpenDialog1. FileName) ;
2018-11-28 11:53:54 +01:00
if ( OpenDialog1. FilterIndex = 1 ) then
2018-09-07 11:53:31 +02:00
TempDATA : = 'data:text/html;charset=utf-8;base64,' + CefBase64Encode( TempFile. Memory, TempFile. Size)
else
TempDATA : = 'data:application/pdf;charset=utf-8;base64,' + CefBase64Encode( TempFile. Memory, TempFile. Size) ;
2018-04-27 17:42:03 +02:00
Chromium1. LoadURL( TempDATA) ;
end ;
except
on e : exception do
if CustomExceptionHandler( 'TMiniBrowserFrm.OpenfilewithaDAT1Click' , e) then raise ;
end ;
finally
if ( TempFile < > nil ) then FreeAndNil( TempFile) ;
end ;
2017-06-13 19:12:40 +02:00
end ;
2017-03-15 14:53:45 +01:00
procedure TMiniBrowserFrm. PopupMenu1Popup( Sender: TObject) ;
begin
if DevTools. Visible then
DevTools1. Caption : = 'Hide DevTools'
else
DevTools1. Caption : = 'Show DevTools' ;
end ;
procedure TMiniBrowserFrm. Preferences1Click( Sender: TObject) ;
begin
2017-12-30 15:42:29 +01:00
case Chromium1. ProxyScheme of
psSOCKS4 : PreferencesFrm. ProxySchemeCb. ItemIndex : = 1 ;
psSOCKS5 : PreferencesFrm. ProxySchemeCb. ItemIndex : = 2 ;
else PreferencesFrm. ProxySchemeCb. ItemIndex : = 0 ;
end ;
2017-12-30 09:54:26 +01:00
2017-03-15 14:53:45 +01:00
PreferencesFrm. ProxyTypeCbx. ItemIndex : = Chromium1. ProxyType;
2017-12-30 15:42:29 +01:00
PreferencesFrm. ProxyServerEdt. Text : = Chromium1. ProxyServer;
2017-03-15 14:53:45 +01:00
PreferencesFrm. ProxyPortEdt. Text : = inttostr( Chromium1. ProxyPort) ;
PreferencesFrm. ProxyUsernameEdt. Text : = Chromium1. ProxyUsername;
PreferencesFrm. ProxyPasswordEdt. Text : = Chromium1. ProxyPassword;
PreferencesFrm. ProxyScriptURLEdt. Text : = Chromium1. ProxyScriptURL;
PreferencesFrm. ProxyByPassListEdt. Text : = Chromium1. ProxyByPassList;
PreferencesFrm. HeaderNameEdt. Text : = Chromium1. CustomHeaderName;
PreferencesFrm. HeaderValueEdt. Text : = Chromium1. CustomHeaderValue;
if ( PreferencesFrm. ShowModal = mrOk) then
begin
Chromium1. ProxyType : = PreferencesFrm. ProxyTypeCbx. ItemIndex;
2017-12-30 15:42:29 +01:00
Chromium1. ProxyServer : = PreferencesFrm. ProxyServerEdt. Text ;
2017-03-15 14:53:45 +01:00
Chromium1. ProxyPort : = strtoint( PreferencesFrm. ProxyPortEdt. Text ) ;
Chromium1. ProxyUsername : = PreferencesFrm. ProxyUsernameEdt. Text ;
Chromium1. ProxyPassword : = PreferencesFrm. ProxyPasswordEdt. Text ;
Chromium1. ProxyScriptURL : = PreferencesFrm. ProxyScriptURLEdt. Text ;
Chromium1. ProxyByPassList : = PreferencesFrm. ProxyByPassListEdt. Text ;
Chromium1. CustomHeaderName : = PreferencesFrm. HeaderNameEdt. Text ;
Chromium1. CustomHeaderValue : = PreferencesFrm. HeaderValueEdt. Text ;
2017-12-30 09:54:26 +01:00
case PreferencesFrm. ProxySchemeCb. ItemIndex of
2017-12-30 15:42:29 +01:00
1 : Chromium1. ProxyScheme : = psSOCKS4;
2 : Chromium1. ProxyScheme : = psSOCKS5;
else Chromium1. ProxyScheme : = psHTTP;
2017-12-30 09:54:26 +01:00
end ;
2017-03-15 14:53:45 +01:00
Chromium1. UpdatePreferences;
end ;
end ;
2017-03-22 15:22:11 +01:00
procedure TMiniBrowserFrm. Print1Click( Sender: TObject) ;
begin
Chromium1. Print;
end ;
procedure TMiniBrowserFrm. PrintinPDF1Click( Sender: TObject) ;
begin
SaveDialog1. DefaultExt : = 'pdf' ;
SaveDialog1. Filter : = 'PDF files (*.pdf)|*.PDF' ;
if SaveDialog1. Execute and ( length( SaveDialog1. FileName) > 0 ) then
Chromium1. PrintToPDF( SaveDialog1. FileName, Chromium1. DocumentURL, Chromium1. DocumentURL) ;
end ;
2017-03-15 14:53:45 +01:00
procedure TMiniBrowserFrm. ConfigBtnClick( Sender: TObject) ;
var
TempPoint : TPoint;
begin
TempPoint. x : = ConfigBtn. left;
TempPoint. y : = ConfigBtn. top + ConfigBtn. Height;
TempPoint : = ConfigPnl. ClientToScreen( TempPoint) ;
PopupMenu1. Popup( TempPoint. x, TempPoint. y) ;
end ;
procedure TMiniBrowserFrm. CopyHTMLMsg( var aMessage : TMessage) ;
begin
Chromium1. RetrieveHTML;
end ;
2017-11-09 10:33:20 +01:00
procedure TMiniBrowserFrm. CopyAllTextMsg( var aMessage : TMessage) ;
begin
Chromium1. RetrieveText;
end ;
2017-09-24 12:48:04 +02:00
procedure TMiniBrowserFrm. CopyFramesIDsMsg( var aMessage : TMessage) ;
var
i : NativeUInt ;
TempCount : NativeUInt ;
TempArray : TCefFrameIdentifierArray;
TempString : string ;
begin
TempCount : = Chromium1. FrameCount;
if Chromium1. GetFrameIdentifiers( TempCount, TempArray) then
begin
TempString : = '' ;
i : = 0 ;
while ( i < TempCount) do
begin
TempString : = TempString + inttostr( TempArray[ i] ) + CRLF;
inc( i) ;
end ;
clipboard. AsText : = TempString;
end ;
end ;
procedure TMiniBrowserFrm. CopyFramesNamesMsg( var aMessage : TMessage) ;
var
TempSL : TStringList;
begin
try
TempSL : = TStringList. Create;
if Chromium1. GetFrameNames( TStrings( TempSL) ) then clipboard. AsText : = TempSL. Text ;
finally
FreeAndNil( TempSL) ;
end ;
end ;
2017-08-12 16:22:34 +02:00
procedure TMiniBrowserFrm. ShowResponseMsg( var aMessage : TMessage) ;
2017-07-18 17:50:28 +02:00
begin
2018-01-31 18:52:34 +01:00
SimpleTextViewerFrm. Memo1. Lines. Clear;
SimpleTextViewerFrm. Memo1. Lines. Add( '--------------------------' ) ;
SimpleTextViewerFrm. Memo1. Lines. Add( 'Request headers : ' ) ;
SimpleTextViewerFrm. Memo1. Lines. Add( '--------------------------' ) ;
if ( FRequest < > nil ) then SimpleTextViewerFrm. Memo1. Lines. AddStrings( FRequest) ;
SimpleTextViewerFrm. Memo1. Lines. Add( '' ) ;
SimpleTextViewerFrm. Memo1. Lines. Add( '--------------------------' ) ;
SimpleTextViewerFrm. Memo1. Lines. Add( 'Response headers : ' ) ;
SimpleTextViewerFrm. Memo1. Lines. Add( '--------------------------' ) ;
if ( FResponse < > nil ) then SimpleTextViewerFrm. Memo1. Lines. AddStrings( FResponse) ;
SimpleTextViewerFrm. ShowModal;
2017-07-18 17:50:28 +02:00
end ;
2019-02-03 15:34:21 +01:00
procedure TMiniBrowserFrm. ShowNavigationMsg( var aMessage : TMessage) ;
begin
SimpleTextViewerFrm. Memo1. Lines. Clear;
SimpleTextViewerFrm. Memo1. Lines. AddStrings( FNavigation) ;
SimpleTextViewerFrm. ShowModal;
end ;
2017-11-04 09:40:31 +01:00
procedure TMiniBrowserFrm. SavePreferencesMsg( var aMessage : TMessage) ;
begin
SaveDialog1. DefaultExt : = 'txt' ;
SaveDialog1. Filter : = 'Text files (*.txt)|*.TXT' ;
if SaveDialog1. Execute and ( length( SaveDialog1. FileName) > 0 ) then
Chromium1. SavePreferences( SaveDialog1. FileName) ;
end ;
2017-12-05 10:02:07 +01:00
procedure TMiniBrowserFrm. TakeSnapshotMsg( var aMessage : TMessage) ;
var
TempBitmap : TBitmap;
begin
TempBitmap : = nil ;
try
SaveDialog1. DefaultExt : = 'bmp' ;
SaveDialog1. Filter : = 'Bitmap files (*.bmp)|*.BMP' ;
if SaveDialog1. Execute and
( length( SaveDialog1. FileName) > 0 ) and
Chromium1. TakeSnapshot( TempBitmap) then
TempBitmap. SaveToFile( SaveDialog1. FileName) ;
finally
if ( TempBitmap < > nil ) then FreeAndNil( TempBitmap) ;
end ;
end ;
2017-04-24 12:57:16 +02:00
procedure TMiniBrowserFrm. WMMove( var aMessage : TWMMove) ;
begin
inherited ;
if ( Chromium1 < > nil ) then Chromium1. NotifyMoveOrResizeStarted;
end ;
procedure TMiniBrowserFrm. WMMoving( var aMessage : TMessage) ;
begin
inherited ;
if ( Chromium1 < > nil ) then Chromium1. NotifyMoveOrResizeStarted;
2017-03-22 15:22:11 +01:00
end ;
2017-12-07 10:49:51 +01:00
procedure TMiniBrowserFrm. WMEnterMenuLoop( var aMessage: TMessage) ;
begin
inherited ;
if ( aMessage. wParam = 0 ) and ( GlobalCEFApp < > nil ) then GlobalCEFApp. OsmodalLoop : = True ;
end ;
procedure TMiniBrowserFrm. WMExitMenuLoop( var aMessage: TMessage) ;
begin
inherited ;
if ( aMessage. wParam = 0 ) and ( GlobalCEFApp < > nil ) then GlobalCEFApp. OsmodalLoop : = False ;
end ;
2017-03-22 15:22:11 +01:00
procedure TMiniBrowserFrm. Deczoom1Click( Sender: TObject) ;
begin
Chromium1. DecZoomStep;
end ;
2017-03-15 14:53:45 +01:00
procedure TMiniBrowserFrm. DevTools1Click( Sender: TObject) ;
begin
if DevTools. Visible then
HideDevTools
else
ShowDevTools;
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. ShowDevTools( aPoint : TPoint) ;
begin
Splitter1. Visible : = True ;
DevTools. Visible : = True ;
DevTools. Width : = Width div 4 ;
Chromium1. ShowDevTools( aPoint, DevTools) ;
end ;
2017-03-15 14:53:45 +01:00
procedure TMiniBrowserFrm. ShowDevTools;
var
TempPoint : TPoint;
begin
TempPoint. x : = low( integer ) ;
TempPoint. y : = low( integer ) ;
ShowDevTools( TempPoint) ;
end ;
2017-02-11 21:56:08 +01:00
procedure TMiniBrowserFrm. HideDevTools;
begin
Chromium1. CloseDevTools( DevTools) ;
Splitter1. Visible : = False ;
DevTools. Visible : = False ;
2017-02-26 16:23:01 +01:00
DevTools. Width : = 0 ;
2017-02-11 21:56:08 +01:00
end ;
end .