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

Added a menu option to save as MHTML in the MiniBrowser demo

Browse Source
This commit is contained in:
Salvador Díaz Fau
2021-05-07 16:25:49 +02:00
parent ca1e47d947
commit 15e6332392
5 changed files with 192 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm
View File

@@ -304,6 +304,10 @@ object MiniBrowserFrm: TMiniBrowserFrm
Caption = 'Open file with a DATA URL...'
OnClick = OpenfilewithaDAT1Click
end
object SaveasMHTML1: TMenuItem
Caption = 'Save as MHTML...'
OnClick = SaveasMHTML1Click
end
object N2: TMenuItem
Caption = '-'
end

52
demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas
View File

@@ -139,6 +139,7 @@ type
Useragent1: TMenuItem;
ClearallstorageforcurrentURL1: TMenuItem;
CEFinfo1: TMenuItem;
SaveasMHTML1: TMenuItem;
procedure FormShow(Sender: TObject);
procedure FormCreate(Sender: TObject);
@@ -208,10 +209,12 @@ type
procedure Useragent1Click(Sender: TObject);
procedure ClearallstorageforcurrentURL1Click(Sender: TObject);
procedure CEFinfo1Click(Sender: TObject);
procedure SaveasMHTML1Click(Sender: TObject);
protected
FDevToolsMsgID : integer;
FScreenshotMsgID : integer;
FMHTMLMsgID : integer;
FDevToolsMsgValue : ustring;
FResponse : TStringList;
@@ -1218,24 +1221,32 @@ begin
begin
if (length(FDevToolsMsgValue) > 0) then
begin
TempData := TNetEncoding.Base64.DecodeStringToBytes(FDevToolsMsgValue);
TempLen := length(TempData);
if (aMessage.LParam = FScreenshotMsgID) then
begin
SaveDialog1.DefaultExt := 'png';
SaveDialog1.Filter := 'PNG files (*.png)|*.PNG';
TempData := TNetEncoding.Base64.DecodeStringToBytes(FDevToolsMsgValue);
end
else
if (aMessage.LParam = FMHTMLMsgID) then
begin
SaveDialog1.DefaultExt := 'mhtml';
SaveDialog1.Filter := 'MHTML files (*.mhtml)|*.MHTML';
TempData := BytesOf(FDevToolsMsgValue);
end
else
begin
SaveDialog1.DefaultExt := '';
SaveDialog1.Filter := 'All files (*.*)|*.*';
TempData := TNetEncoding.Base64.DecodeStringToBytes(FDevToolsMsgValue);
end;
TempLen := length(TempData);
if (TempLen > 0) then
begin
TempFile := nil;
if (aMessage.LParam = FScreenshotMsgID) then
begin
SaveDialog1.DefaultExt := 'png';
SaveDialog1.Filter := 'PNG files (*.png)|*.PNG';
end
else
begin
SaveDialog1.DefaultExt := '';
SaveDialog1.Filter := 'All files (*.*)|*.*';
end;
if SaveDialog1.Execute then
try
try
@@ -1474,6 +1485,21 @@ begin
SimpleTextViewerFrm.ShowModal;
end;
procedure TMiniBrowserFrm.SaveasMHTML1Click(Sender: TObject);
var
TempParams : ICefDictionaryValue;
begin
try
inc(FDevToolsMsgID);
FMHTMLMsgID := FDevToolsMsgID;
TempParams := TCefDictionaryValueRef.New;
TempParams.SetString('format', 'mhtml');
Chromium1.ExecuteDevToolsMethod(FMHTMLMsgID, 'Page.captureSnapshot', TempParams);
finally
TempParams := nil;
end;
end;
procedure TMiniBrowserFrm.SavePreferencesMsg(var aMessage : TMessage);
begin
SaveDialog1.DefaultExt := 'txt';

6
demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.lfm
View File

@@ -214,6 +214,7 @@ object MiniBrowserFrm: TMiniBrowserFrm
Align = alClient
TabStop = True
TabOrder = 0
OnDragDrop = CEFWindowParent1DragDrop
end
object DevTools: TCEFWindowParent
Left = 1184
@@ -264,6 +265,7 @@ object MiniBrowserFrm: TMiniBrowserFrm
OnBeforeResourceLoad = Chromium1BeforeResourceLoad
OnResourceResponse = Chromium1ResourceResponse
OnBeforePluginLoad = Chromium1BeforePluginLoad
OnDevToolsMethodResult = Chromium1DevToolsMethodResult
Left = 32
Top = 224
end
@@ -286,6 +288,10 @@ object MiniBrowserFrm: TMiniBrowserFrm
Caption = 'Open file with a DATA URL...'
OnClick = OpenfilewithaDAT1Click
end
object MenuItem6: TMenuItem
Caption = 'Save as MHTML...'
OnClick = MenuItem6Click
end
object N2: TMenuItem
Caption = '-'
end

146
demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.pas
View File

@@ -60,7 +60,8 @@ const
MINIBROWSER_SHOWNAVIGATION = WM_APP + $10A;
MINIBROWSER_COOKIESFLUSHED = WM_APP + $10B;
MINIBROWSER_PDFPRINT_END = WM_APP + $10C;
MINIBROWSER_PREFS_AVLBL = WM_APP + $10D;
MINIBROWSER_PREFS_AVLBL = WM_APP + $10D;
MINIBROWSER_DTDATA_AVLBL = WM_APP + $10E;
MINIBROWSER_HOMEPAGE = 'https://www.google.com';
@@ -89,6 +90,7 @@ type
MenuItem3: TMenuItem;
MenuItem4: TMenuItem;
MenuItem5: TMenuItem;
MenuItem6: TMenuItem;
NavControlPnl: TPanel;
NavButtonPnl: TPanel;
StatusPnl: TPanel;
@@ -127,11 +129,15 @@ type
OpenfilewithaDAT1: TMenuItem;
N5: TMenuItem;
Memoryinfo1: TMenuItem;
procedure CEFWindowParent1DragDrop(Sender, Source: TObject; X, Y: Integer);
procedure Chromium1BeforePluginLoad(Sender: TObject; const mimeType,
pluginUrl: ustring; isMainFrame: boolean; const topOriginUrl: ustring;
const pluginInfo: ICefWebPluginInfo; var pluginPolicy: TCefPluginPolicy;
var aResult: boolean);
procedure Chromium1CookiesFlushed(Sender: TObject);
procedure Chromium1DevToolsMethodResult(Sender: TObject;
const browser: ICefBrowser; message_id: integer; success: boolean;
const result: ICefValue);
procedure Chromium1DownloadImageFinished(Sender: TObject;
const imageUrl: ustring; httpStatusCode: Integer; const image: ICefImage);
procedure Chromium1ZoomPctAvailable(Sender: TObject; const aZoomPct: double
@@ -144,6 +150,7 @@ type
procedure MenuItem3Click(Sender: TObject);
procedure MenuItem4Click(Sender: TObject);
procedure MenuItem5Click(Sender: TObject);
procedure MenuItem6Click(Sender: TObject);
procedure ReloadBtnClick(Sender: TObject);
procedure Chromium1AfterCreated(Sender: TObject;
const browser: ICefBrowser);
@@ -243,6 +250,10 @@ type
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
FClosing : boolean; // Set to True in the CloseQuery event.
FDevToolsMsgID : integer;
FMHTMLMsgID : integer;
FDevToolsMsgValue : ustring;
procedure AddURL(const aURL : string);
procedure ShowDevTools(aPoint : TPoint); overload;
@@ -269,7 +280,8 @@ type
procedure TakeSnapshotMsg(var aMessage : TMessage); message MINIBROWSER_TAKESNAPSHOT;
procedure CookiesFlushedMsg(var aMessage : TMessage); message MINIBROWSER_COOKIESFLUSHED;
procedure PrintPDFEndMsg(var aMessage : TMessage); message MINIBROWSER_PDFPRINT_END;
procedure PreferencesAvailableMsg(var aMessage : TMessage); message MINIBROWSER_PREFS_AVLBL;
procedure PreferencesAvailableMsg(var aMessage : TMessage); message MINIBROWSER_PREFS_AVLBL;
procedure DevToolsDataAvailableMsg(var aMessage : TMessage); message MINIBROWSER_DTDATA_AVLBL;
procedure WMMove(var aMessage : TWMMove); message WM_MOVE;
procedure WMMoving(var aMessage : TMessage); message WM_MOVING;
procedure WMEnterMenuLoop(var aMessage: TMessage); message WM_ENTERMENULOOP;
@@ -291,7 +303,7 @@ implementation
uses
uPreferences, uCefStringMultimap, uCEFMiscFunctions, uSimpleTextViewer,
uCefClient;
uCefClient, uCEFDictionaryValue;
// Destruction steps
// =================
@@ -392,6 +404,21 @@ begin
showmessage(TempInfo);
end;
procedure TMiniBrowserFrm.MenuItem6Click(Sender: TObject);
var
TempParams : ICefDictionaryValue;
begin
try
inc(FDevToolsMsgID);
FMHTMLMsgID := FDevToolsMsgID;
TempParams := TCefDictionaryValueRef.New;
TempParams.SetString('format', 'mhtml');
Chromium1.ExecuteDevToolsMethod(FMHTMLMsgID, 'Page.captureSnapshot', TempParams);
finally
TempParams := nil;
end;
end;
procedure TMiniBrowserFrm.GoBtnClick(Sender: TObject);
begin
Chromium1.LoadURL(URLCbx.Text);
@@ -1033,6 +1060,8 @@ begin
FRequest := TStringList.Create;
FNavigation := TStringList.Create;
FDevToolsMsgID := 0;
// The MultiBrowserMode store all the browser references in TChromium.
// The first browser reference is the browser in the main form.
// When MiniBrowser allows CEF to create child popup browsers it will also
@@ -1071,6 +1100,70 @@ begin
PostMessage(Handle, MINIBROWSER_COOKIESFLUSHED, 0, 0);
end;
procedure TMiniBrowserFrm.Chromium1DevToolsMethodResult(Sender: TObject;
const browser: ICefBrowser; message_id: integer; success: boolean;
const result: ICefValue);
var
TempDict : ICefDictionaryValue;
TempValue : ICefValue;
TempResult : WPARAM;
TempCode : integer;
TempMessage : string;
begin
FDevToolsMsgValue := '';
TempResult := 0;
if success then
begin
TempResult := 1;
FDevToolsMsgValue := '';
if (result <> nil) then
begin
TempDict := result.GetDictionary;
if (TempDict <> nil) and (TempDict.GetSize > 0) then
begin
TempValue := TempDict.GetValue('data');
if (TempValue <> nil) and (TempValue.GetType = VTYPE_STRING) then
FDevToolsMsgValue := TempValue.GetString;
end;
end;
end
else
if (result <> nil) then
begin
TempDict := result.GetDictionary;
if (TempDict <> nil) then
begin
TempCode := 0;
TempMessage := '';
TempValue := TempDict.GetValue('code');
if (TempValue <> nil) and (TempValue.GetType = VTYPE_INT) then
TempCode := TempValue.GetInt;
TempValue := TempDict.GetValue('message');
if (TempValue <> nil) and (TempValue.GetType = VTYPE_STRING) then
TempMessage := TempValue.GetString;
if (length(TempMessage) > 0) then
FDevToolsMsgValue := 'DevTools Error (' + inttostr(TempCode) + ') : ' + quotedstr(TempMessage);
end;
end;
PostMessage(Handle, MINIBROWSER_DTDATA_AVLBL, TempResult, message_id);
end;
procedure TMiniBrowserFrm.CEFWindowParent1DragDrop(Sender, Source: TObject; X,
Y: Integer);
begin
end;
procedure TMiniBrowserFrm.Chromium1BeforePluginLoad(Sender: TObject;
const mimeType, pluginUrl: ustring; isMainFrame: boolean;
const topOriginUrl: ustring; const pluginInfo: ICefWebPluginInfo;
@@ -1087,7 +1180,7 @@ begin
aResult := False;
end;
procedure TMiniBrowserFrm.CookiesFlushedMsg(var aMessage : TMessage);
procedure TMiniBrowserFrm.CookiesFlushedMsg(var aMessage : TMessage);
begin
showmessage('The cookies were flushed successfully');
end;
@@ -1108,6 +1201,51 @@ begin
showmessage('There was a problem generating the preferences file.');
end;
procedure TMiniBrowserFrm.DevToolsDataAvailableMsg(var aMessage : TMessage);
var
TempData : TBytes;
TempFile : TFileStream;
TempLen : integer;
begin
if (aMessage.WParam <> 0) then
begin
if (length(FDevToolsMsgValue) > 0) and (aMessage.LParam = FMHTMLMsgID) then
begin
SaveDialog1.DefaultExt := 'mhtml';
SaveDialog1.Filter := 'MHTML files (*.mhtml)|*.MHTML';
TempData := BytesOf(FDevToolsMsgValue);
TempLen := length(TempData);
if (TempLen > 0) then
begin
TempFile := nil;
if SaveDialog1.Execute then
try
try
TempFile := TFileStream.Create(SaveDialog1.FileName, fmCreate);
TempFile.WriteBuffer(TempData[0], TempLen);
showmessage('File saved successfully');
except
showmessage('There was an error saving the file');
end;
finally
if (TempFile <> nil) then TempFile.Free;
end;
end
else
showmessage('There was an error decoding the data');
end
else
showmessage('DevTools method executed successfully!');
end
else
if (length(FDevToolsMsgValue) > 0) then
showmessage(FDevToolsMsgValue)
else
showmessage('There was an error in the DevTools method');
end;
procedure TMiniBrowserFrm.Chromium1DownloadImageFinished(Sender: TObject;
const imageUrl: ustring; httpStatusCode: Integer; const image: ICefImage);
var