From 15e6332392e95133ec4965b4631ecec8a7249424 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Salvador=20D=C3=ADaz=20Fau?= Date: Fri, 7 May 2021 16:25:49 +0200 Subject: [PATCH] Added a menu option to save as MHTML in the MiniBrowser demo --- demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm | 4 + demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas | 52 +++++-- .../MiniBrowser/uMiniBrowser.lfm | 6 + .../MiniBrowser/uMiniBrowser.pas | 146 +++++++++++++++++- update_CEF4Delphi.json | 2 +- 5 files changed, 192 insertions(+), 18 deletions(-) diff --git a/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm b/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm index ecac61eb..cbd5e4ce 100644 --- a/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm +++ b/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.dfm @@ -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 diff --git a/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas b/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas index 99345a94..d6b108f3 100644 --- a/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas +++ b/demos/Delphi_VCL/MiniBrowser/uMiniBrowser.pas @@ -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'; diff --git a/demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.lfm b/demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.lfm index 4bf953e2..6ffee8cf 100644 --- a/demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.lfm +++ b/demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.lfm @@ -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 diff --git a/demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.pas b/demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.pas index ed5a707f..e5a9c690 100644 --- a/demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.pas +++ b/demos/Lazarus_Windows/MiniBrowser/uMiniBrowser.pas @@ -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 diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json index c9811964..b47919ad 100644 --- a/update_CEF4Delphi.json +++ b/update_CEF4Delphi.json @@ -2,7 +2,7 @@ "UpdateLazPackages" : [ { "ForceNotify" : true, - "InternalVersion" : 288, + "InternalVersion" : 289, "Name" : "cef4delphi_lazarus.lpk", "Version" : "90.6.5.0" }