MiniBrowser : Added a context menu option to inspect the response/request headers

demos/MiniBrowser/MiniBrowser.dpr

@@ -50,7 +50,8 @@ uses
   {$ENDIF }
   uCEFApplication,
   uMiniBrowser in 'uMiniBrowser.pas' {MiniBrowserFrm},
-  uPreferences in 'uPreferences.pas' {PreferencesFrm};
+  uPreferences in 'uPreferences.pas' {PreferencesFrm},
+  uSimpleTextViewer in 'uSimpleTextViewer.pas' {SimpleTextViewerFrm};
 
 {$R *.res}
 
@@ -67,6 +68,7 @@ begin
       {$ENDIF}
       Application.CreateForm(TMiniBrowserFrm, MiniBrowserFrm);
       Application.CreateForm(TPreferencesFrm, PreferencesFrm);
+      Application.CreateForm(TSimpleTextViewerFrm, SimpleTextViewerFrm);
       Application.Run;
     end;
 

demos/MiniBrowser/MiniBrowser.dproj

@@ -138,6 +138,10 @@
         <DCCReference Include="uPreferences.pas">
             <Form>PreferencesFrm</Form>
         </DCCReference>
+        <DCCReference Include="uSimpleTextViewer.pas">
+            <Form>SimpleTextViewerFrm</Form>
+            <FormType>dfm</FormType>
+        </DCCReference>
         <BuildConfiguration Include="Release">
             <Key>Cfg_2</Key>
             <CfgParent>Base</CfgParent>
@@ -166,6 +170,12 @@
             </Delphi.Personality>
             <Deployment Version="3">
                 <DeployFile LocalName="MiniBrowser.exe" Configuration="Debug" Class="ProjectOutput"/>
+                <DeployFile LocalName="..\..\bin\MiniBrowser.exe" Configuration="Debug" Class="ProjectOutput">
+                    <Platform Name="Win32">
+                        <RemoteName>MiniBrowser.exe</RemoteName>
+                        <Overwrite>true</Overwrite>
+                    </Platform>
+                </DeployFile>
                 <DeployClass Name="AdditionalDebugSymbols">
                     <Platform Name="iOSSimulator">
                         <Operation>1</Operation>

demos/MiniBrowser/uMiniBrowser.dfm

@@ -12,6 +12,8 @@ object MiniBrowserFrm: TMiniBrowserFrm
   Font.Style = []
   OldCreateOrder = False
   Position = poScreenCenter
+  OnCreate = FormCreate
+  OnDestroy = FormDestroy
   OnShow = FormShow
   PixelsPerInch = 96
   TextHeight = 13
@@ -256,6 +258,7 @@ object MiniBrowserFrm: TMiniBrowserFrm
     OnBeforeDownload = Chromium1BeforeDownload
     OnDownloadUpdated = Chromium1DownloadUpdated
     OnAfterCreated = Chromium1AfterCreated
+    OnBeforeResourceLoad = Chromium1BeforeResourceLoad
     OnResourceResponse = Chromium1ResourceResponse
     Left = 32
     Top = 224

demos/MiniBrowser/uMiniBrowser.pas

@@ -179,9 +179,16 @@ type
     procedure Chromium1DownloadUpdated(Sender: TObject;
       const browser: ICefBrowser; const downloadItem: ICefDownloadItem;
       const callback: ICefDownloadItemCallback);
+    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);
 
   protected
-    FResponse : string;
+    FResponse : TStringList;
+    FRequest  : TStringList;
 
     procedure AddURL(const aURL : string);
 
@@ -192,6 +199,9 @@ type
     procedure HandleKeyUp(const aMsg : TMsg; var aHandled : boolean);
     procedure HandleKeyDown(const aMsg : TMsg; var aHandled : boolean);
 
+    procedure InspectRequest(const aRequest : ICefRequest);
+    procedure InspectResponse(const aResponse : ICefResponse);
+
     procedure BrowserCreatedMsg(var aMessage : TMessage); message CEF_AFTERCREATED;
     procedure ShowDevToolsMsg(var aMessage : TMessage); message MINIBROWSER_SHOWDEVTOOLS;
     procedure HideDevToolsMsg(var aMessage : TMessage); message MINIBROWSER_HIDEDEVTOOLS;
@@ -220,7 +230,7 @@ implementation
 {$R *.dfm}
 
 uses
-  uPreferences;
+  uPreferences, uCefStringMultimap, uSimpleTextViewer;
 
 procedure TMiniBrowserFrm.BackBtnClick(Sender: TObject);
 begin
@@ -282,7 +292,7 @@ begin
   model.AddSeparator;
   model.AddItem(MINIBROWSER_CONTEXTMENU_JSWRITEDOC,      'Modify HTML document');
   model.AddItem(MINIBROWSER_CONTEXTMENU_JSPRINTDOC,      'Print using Javascript');
-  model.AddItem(MINIBROWSER_CONTEXTMENU_SHOWRESPONSE,    'Show last server response');
+  model.AddItem(MINIBROWSER_CONTEXTMENU_SHOWRESPONSE,    'Show server headers');
 
   if DevTools.Visible then
     model.AddItem(MINIBROWSER_CONTEXTMENU_HIDEDEVTOOLS, 'Hide DevTools')
@@ -338,6 +348,17 @@ begin
   callback.cont(TempFullPath, False);
 end;
 
+procedure TMiniBrowserFrm.Chromium1BeforeResourceLoad(Sender: TObject;
+  const browser: ICefBrowser; const frame: ICefFrame;
+  const request: ICefRequest; const callback: ICefRequestCallback;
+  out Result: TCefReturnValue);
+begin
+  Result := RV_CONTINUE;
+
+  if (frame <> nil) and frame.IsMain then
+    InspectRequest(request);
+end;
+
 procedure TMiniBrowserFrm.Chromium1ContextMenuCommand(Sender: TObject;
   const browser: ICefBrowser; const frame: ICefFrame;
   const params: ICefContextMenuParams; commandId: Integer;
@@ -569,6 +590,52 @@ begin
                 'Error code : ' + inttostr(result));
 end;
 
+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;
+
 procedure TMiniBrowserFrm.Chromium1ResourceResponse(Sender: TObject;
   const browser: ICefBrowser; const frame: ICefFrame;
   const request: ICefRequest; const response: ICefResponse;
@@ -576,15 +643,8 @@ procedure TMiniBrowserFrm.Chromium1ResourceResponse(Sender: TObject;
 begin
   Result := False;
 
-  if (frame <> nil) and frame.IsMain and (response <> nil) and (request <> nil) then
+  if (frame <> nil) and frame.IsMain then
-    begin
+    InspectResponse(response);
-      FResponse := 'URL : ' + request.Url + CRLF +
-                   'Status : ' + inttostr(response.Status) + CRLF +
-                   'MimeType : ' + response.MimeType;
-
-      if (request.postdata <> nil) then
-        FResponse := FResponse + CRLF + 'Post data elements : ' + inttostr(request.postdata.GetCount);
-    end;
 end;
 
 procedure TMiniBrowserFrm.ShowStatusText(const aText : string);
@@ -617,6 +677,18 @@ begin
     caption := 'MiniBrowser';
 end;
 
+procedure TMiniBrowserFrm.FormCreate(Sender: TObject);
+begin
+  FResponse := TStringList.Create;
+  FRequest  := TStringList.Create;
+end;
+
+procedure TMiniBrowserFrm.FormDestroy(Sender: TObject);
+begin
+  FResponse.Free;
+  FRequest.Free;
+end;
+
 procedure TMiniBrowserFrm.FormShow(Sender: TObject);
 begin
   ShowStatusText('Initializing browser. Please wait...');
@@ -801,7 +873,21 @@ end;
 
 procedure TMiniBrowserFrm.ShowResponseMsg(var aMessage : TMessage);
 begin
-  if (length(FResponse) > 0) then MessageDlg(FResponse, mtInformation, [mbOk], 0);
+  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;
 end;
 
 procedure TMiniBrowserFrm.SavePreferencesMsg(var aMessage : TMessage);

demos/MiniBrowser/uSimpleTextViewer.dfm

@@ -0,0 +1,29 @@
+object SimpleTextViewerFrm: TSimpleTextViewerFrm
+  Left = 0
+  Top = 0
+  BorderIcons = [biSystemMenu]
+  BorderStyle = bsSingle
+  Caption = 'Simple text viewer'
+  ClientHeight = 572
+  ClientWidth = 694
+  Color = clBtnFace
+  Font.Charset = DEFAULT_CHARSET
+  Font.Color = clWindowText
+  Font.Height = -11
+  Font.Name = 'Tahoma'
+  Font.Style = []
+  OldCreateOrder = False
+  Position = poScreenCenter
+  PixelsPerInch = 96
+  TextHeight = 13
+  object Memo1: TMemo
+    Left = 0
+    Top = 0
+    Width = 694
+    Height = 572
+    Align = alClient
+    ReadOnly = True
+    ScrollBars = ssBoth
+    TabOrder = 0
+  end
+end

demos/MiniBrowser/uSimpleTextViewer.pas

@@ -0,0 +1,31 @@
+unit uSimpleTextViewer;
+
+interface
+
+uses
+  {$IFDEF DELPHI16_UP}
+  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
+  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
+  {$ELSE}
+  Windows, Messages, SysUtils, Variants, Classes, Graphics,
+  Controls, Forms, Dialogs, StdCtrls;
+  {$ENDIF}
+
+
+type
+  TSimpleTextViewerFrm = class(TForm)
+    Memo1: TMemo;
+  private
+    { Private declarations }
+  public
+    { Public declarations }
+  end;
+
+var
+  SimpleTextViewerFrm: TSimpleTextViewerFrm;
+
+implementation
+
+{$R *.dfm}
+
+end.