Delphi/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-16 00:05:55 +01:00
Code Issues Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Salvador Díaz Fau 2018-01-31 18:52:34 +01:00
parent 8da85dd1a8
commit fad77c99ea
6 changed files with 175 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
demos/MiniBrowser/MiniBrowser.dpr
View File

@ -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;

10
demos/MiniBrowser/MiniBrowser.dproj
View File

@ -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>

3
demos/MiniBrowser/uMiniBrowser.dfm
View File

@ -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

112
demos/MiniBrowser/uMiniBrowser.pas
View File

@ -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
begin
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;
if (frame <> nil) and frame.IsMain then
InspectResponse(response);
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);

29
demos/MiniBrowser/uSimpleTextViewer.dfm Normal file
View File

@ -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

31
demos/MiniBrowser/uSimpleTextViewer.pas Normal file
View File

@ -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.