pascal/CEF4Delphi
1
0
Fork 0
mirror of https://github.com/salvadordf/CEF4Delphi.git synced 2024-11-24 08:02:15 +02:00
Code Issues Actions Releases Activity

Bug fix #222

Browse Source 
- Fixed ICEFPostData and TCefPostData declarations
- Fixed CustomAbsolutePath to convert the relative path to absolute path even when CustomPathCanonicalize fails.
- Added a POST example to the URLRequest demo.
- Updated the PostInspectorBrowser demo for the new ICEFPostData decalrations.
This commit is contained in:
Salvador Díaz Fau 2019-09-25 17:23:16 +02:00
parent 7ab6b9e9c6
commit 437c3bf4c0
17 changed files with 1013 additions and 441 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.dfm
View File

@ -60,14 +60,9 @@ object Form1: TForm1
Align = alClient
ItemIndex = 0
TabOrder = 1
Text =
'https://www.w3schools.com/php/showphp.asp?filename=demo_form_pos' +
't'
Text = 'https://tryphp.w3schools.com/showphp.php?filename=demo_form_post'
Items.Strings = (
'https://www.w3schools.com/php/showphp.asp?filename=demo_form_pos' +
't'
'https://www.w3schools.com/php/showphp.asp?filename=demo_form_get')
'https://tryphp.w3schools.com/showphp.php?filename=demo_form_post')
end
end
object CEFWindowParent1: TCEFWindowParent

83
demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.pas
View File

@ -252,52 +252,67 @@ end;
procedure TForm1.HandlePostData(const request : ICefRequest);
var
TempPostData : ICefPostData;
TempElement : ICefPostDataElement;
TempList : IInterfaceList;
TempArray : TCefPostDataElementArray;
i : integer;
begin
TempArray := nil;
try
TempPostData := request.PostData;
try
TempPostData := request.PostData;
if (TempPostData <> nil) and (TempPostData.GetCount > 0) then
begin
FRequestSL.Add('--------------------');
FRequestSL.Add('POST data :');
if TempPostData.HasExcludedElements then
FRequestSL.Add('Has excluded elements! (For example, multi-part file upload data.)');
if (TempPostData <> nil) and (TempPostData.GetElementCount > 0) then
begin
FRequestSL.Add('--------------------');
FRequestSL.Add('POST data :');
if TempPostData.HasExcludedElements then
FRequestSL.Add('Has excluded elements! (For example, multi-part file upload data.)');
TempList := TempPostData.GetElements(TempPostData.GetCount);
i := 0;
TempPostData.GetElements(TempPostData.GetElementCount, TempArray);
while (i < TempList.Count) do
begin
TempElement := TempList.Items[i] as ICefPostDataElement;
FRequestSL.Add('Element : ' + inttostr(i));
FRequestSL.Add('Size : ' + inttostr(TempElement.GetBytesCount));
i := 0;
while (i < length(TempArray)) do
begin
FRequestSL.Add('Element : ' + inttostr(i));
FRequestSL.Add('Size : ' + inttostr(TempArray[i].GetBytesCount));
case TempElement.GetType of
PDE_TYPE_BYTES :
begin
FRequestSL.Add('Type : Bytes');
HandlePostDataBytes(TempElement);
end;
case TempArray[i].GetType of
PDE_TYPE_BYTES :
begin
FRequestSL.Add('Type : Bytes');
HandlePostDataBytes(TempArray[i]);
end;
PDE_TYPE_FILE :
begin
FRequestSL.Add('Type : File');
// This element type can be read using a TBuffer like we do in HandlePostDataBytes
end
PDE_TYPE_FILE :
begin
FRequestSL.Add('Type : File');
// This element type can be read using a TBuffer like we do in HandlePostDataBytes
end
else
FRequestSL.Add('Type : Empty');
else
FRequestSL.Add('Type : Empty');
end;
inc(i);
end;
inc(i);
end;
// Set interfaces to nil to release them
i := 0;
while (i < length(TempArray)) do
begin
TempArray[i] := nil;
inc(i);
end;
end;
except
on e : exception do
if CustomExceptionHandler('TForm1.HandlePostData', e) then raise;
end;
finally
if (TempArray <> nil) then
begin
Finalize(TempArray);
TempArray := nil;
end;
except
on e : exception do
if CustomExceptionHandler('TForm1.HandlePostData', e) then raise;
end;
end;

2
demos/Delphi_VCL/URLRequest/URLRequest.dpr
View File

@ -57,7 +57,7 @@ uses
{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE}
begin
GlobalCEFApp := TCefApplication.Create;
CreateGlobalCEFApp;
if GlobalCEFApp.StartMainProcess then
begin

194
demos/Delphi_VCL/URLRequest/uURLRequest.dfm
View File

@ -4,14 +4,15 @@ object URLRequestFrm: TURLRequestFrm
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'URL request'
ClientHeight = 111
ClientWidth = 494
ClientHeight = 445
ClientWidth = 518
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
Padding.Top = 5
OldCreateOrder = False
Position = poScreenCenter
OnCloseQuery = FormCloseQuery
@ -19,52 +20,177 @@ object URLRequestFrm: TURLRequestFrm
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 16
Top = 19
Width = 19
Height = 13
Caption = 'URL'
end
object Edit1: TEdit
Left = 48
Top = 16
Width = 433
Height = 21
TabOrder = 0
Text =
'https://www.w3.org/WAI/ER/tests/xhtml/testfiles/resources/pdf/du' +
'mmy.pdf'
end
object DownloadBtn: TButton
Left = 16
Top = 51
Width = 465
Height = 25
Caption = 'Download'
TabOrder = 1
OnClick = DownloadBtnClick
end
object StatusBar1: TStatusBar
Left = 0
Top = 92
Width = 494
Top = 426
Width = 518
Height = 19
Panels = <
item
Width = 500
end>
end
object GETGbx: TGroupBox
Left = 10
Top = 8
Width = 494
Height = 105
Caption = ' GET example '
TabOrder = 1
object Label1: TLabel
Left = 16
Top = 30
Width = 19
Height = 13
Caption = 'URL'
end
object DownloadBtn: TButton
Left = 13
Top = 62
Width = 465
Height = 25
Caption = 'Download'
TabOrder = 0
OnClick = DownloadBtnClick
end
object GetURLEdt: TEdit
Left = 45
Top = 27
Width = 433
Height = 21
TabOrder = 1
Text =
'https://www.w3.org/WAI/ER/tests/xhtml/testfiles/resources/pdf/du' +
'mmy.pdf'
end
end
object POSTGbx: TGroupBox
Left = 10
Top = 136
Width = 494
Height = 274
Caption = ' POST example '
TabOrder = 2
object Label2: TLabel
Left = 16
Top = 29
Width = 19
Height = 13
Caption = 'URL'
end
object PostURLEdt: TEdit
Left = 45
Top = 26
Width = 433
Height = 21
TabOrder = 0
Text = 'https://ptsv2.com/t/cef4delphi/post'
end
object SendPostReqBtn: TButton
Left = 16
Top = 193
Width = 462
Height = 25
Caption = 'Send POST request'
TabOrder = 1
OnClick = SendPostReqBtnClick
end
object Button1: TButton
Left = 16
Top = 231
Width = 462
Height = 25
Caption = 'Check results in PTSV2.com'
TabOrder = 2
OnClick = Button1Click
end
object GroupBox1: TGroupBox
Left = 16
Top = 56
Width = 462
Height = 57
Caption = ' Parameter 1 '
TabOrder = 3
object Label3: TLabel
Left = 16
Top = 24
Width = 34
Height = 13
Caption = 'Name :'
end
object Label4: TLabel
Left = 264
Top = 24
Width = 33
Height = 13
Caption = 'Value :'
end
object PostParam1NameEdt: TEdit
Left = 56
Top = 21
Width = 121
Height = 21
TabOrder = 0
Text = 'name1'
end
object PostParam1ValueEdt: TEdit
Left = 304
Top = 21
Width = 137
Height = 21
TabOrder = 1
Text = 'value1'
end
end
object GroupBox2: TGroupBox
Left = 16
Top = 123
Width = 462
Height = 57
Caption = ' Parameter 2 '
TabOrder = 4
object Label5: TLabel
Left = 16
Top = 24
Width = 34
Height = 13
Caption = 'Name :'
end
object Label6: TLabel
Left = 264
Top = 24
Width = 33
Height = 13
Caption = 'Value :'
end
object PostParam2NameEdt: TEdit
Left = 56
Top = 21
Width = 121
Height = 21
TabOrder = 0
Text = 'name2'
end
object PostParam2ValueEdt: TEdit
Left = 304
Top = 21
Width = 137
Height = 21
TabOrder = 1
Text = 'value2'
end
end
end
object SaveDialog1: TSaveDialog
Left = 384
Top = 64
Left = 448
Top = 104
end
object CEFUrlRequestClientComponent1: TCEFUrlRequestClientComponent
OnRequestComplete = CEFUrlRequestClientComponent1RequestComplete
OnDownloadProgress = CEFUrlRequestClientComponent1DownloadProgress
OnDownloadData = CEFUrlRequestClientComponent1DownloadData
OnCreateURLRequest = CEFUrlRequestClientComponent1CreateURLRequest
Left = 80
Top = 64
Left = 304
Top = 104
end
end

233
demos/Delphi_VCL/URLRequest/uURLRequest.pas
View File

@ -55,14 +55,31 @@ const
type
TURLRequestFrm = class(TForm)
Edit1: TEdit;
Label1: TLabel;
DownloadBtn: TButton;
StatusBar1: TStatusBar;
SaveDialog1: TSaveDialog;
CEFUrlRequestClientComponent1: TCEFUrlRequestClientComponent;
GETGbx: TGroupBox;
DownloadBtn: TButton;
GetURLEdt: TEdit;
Label1: TLabel;
POSTGbx: TGroupBox;
PostURLEdt: TEdit;
Label2: TLabel;
SendPostReqBtn: TButton;
Button1: TButton;
GroupBox1: TGroupBox;
Label3: TLabel;
PostParam1NameEdt: TEdit;
Label4: TLabel;
PostParam1ValueEdt: TEdit;
GroupBox2: TGroupBox;
Label5: TLabel;
Label6: TLabel;
PostParam2NameEdt: TEdit;
PostParam2ValueEdt: TEdit;
procedure DownloadBtnClick(Sender: TObject);
procedure SendPostReqBtnClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -73,12 +90,19 @@ type
procedure CEFUrlRequestClientComponent1RequestComplete(Sender: TObject; const request: ICefUrlRequest);
procedure CEFUrlRequestClientComponent1CreateURLRequest(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FStream : TMemoryStream;
FMemStream : TMemoryStream;
FCanClose : boolean;
FClosing : boolean;
FDownloading : boolean;
FBusy : boolean;
FPendingURL : string;
FSendingGET : boolean;
FSendingPOST : boolean;
procedure CreateGETRequest;
procedure CreatePOSTRequest;
procedure URLRequestSuccessMsg(var aMessage : TMessage); message URLREQUEST_SUCCESS;
procedure URLRequestErrorMsg(var aMessage : TMessage); message URLREQUEST_ERROR;
@ -89,6 +113,8 @@ type
var
URLRequestFrm: TURLRequestFrm;
procedure CreateGlobalCEFApp;
implementation
{$R *.dfm}
@ -111,7 +137,14 @@ implementation
// 3- in the TCEFUrlRequestClientComponent.OnRequestComplete event we set FCanClose to TRUE and send WM_CLOSE to the form.
uses
uCEFMiscFunctions, uCEFTypes, uCEFPostData, uCEFPostDataElement, uCEFConstants;
ShellApi,
uCEFApplication, uCEFMiscFunctions, uCEFTypes, uCEFPostData, uCEFPostDataElement, uCEFConstants;
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.DisableFeatures := 'NetworkService,OutOfBlinkCors';
end;
procedure TURLRequestFrm.DownloadBtnClick(Sender: TObject);
var
@ -119,7 +152,7 @@ var
TempParts : TUrlParts;
i : integer;
begin
TempURL := trim(Edit1.Text);
TempURL := trim(GetURLEdt.Text);
if (length(TempURL) > 0) then
begin
@ -146,9 +179,13 @@ begin
(length(SaveDialog1.FileName) > 0) then
begin
FPendingURL := TempURL;
DownloadBtn.Enabled := False;
GETGbx.Enabled := False;
POSTGbx.Enabled := False;
StatusBar1.Panels[0].Text := 'Downloading...';
FStream.Clear;
FMemStream.Clear;
FSendingPOST := False;
FSendingGET := True;
// TCEFUrlRequestClientComponent.AddURLRequest will trigger the
// TCEFUrlRequestClientComponent.OnCreateURLRequest event in the right
@ -160,54 +197,52 @@ end;
procedure TURLRequestFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose or not(FDownloading);
CanClose := FCanClose or not(FBusy);
FClosing := True;
end;
procedure TURLRequestFrm.FormCreate(Sender: TObject);
begin
FStream := TMemoryStream.Create;
FMemStream := TMemoryStream.Create;
FCanClose := False;
FClosing := False;
FDownloading := False;
FBusy := False;
FSendingGET := False;
FSendingPOST := False;
end;
procedure TURLRequestFrm.FormDestroy(Sender: TObject);
begin
if (FStream <> nil) then FreeAndNil(FStream);
if (FMemStream <> nil) then FreeAndNil(FMemStream);
end;
procedure TURLRequestFrm.Button1Click(Sender: TObject);
begin
ShellExecute(0, 'open', 'https://ptsv2.com/t/cef4delphi', nil, nil, SW_SHOWNORMAL);
end;
procedure TURLRequestFrm.CEFUrlRequestClientComponent1CreateURLRequest(Sender: TObject);
begin
if FSendingGET then
CreateGETRequest
else
if FSendingPOST then
CreatePOSTRequest;
end;
procedure TURLRequestFrm.CreateGETRequest;
var
TempRequest : ICefRequest;
// TempPostData : ICefPostData;
// TempElement : ICefPostDataElement;
begin
try
if (length(FPendingURL) > 0) then
begin
FDownloading := True;
// GET request example
// -------------------
FBusy := True;
TempRequest := TCefRequestRef.New;
TempRequest.URL := FPendingURL;
TempRequest.Method := 'GET';
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
// POST request example
// --------------------
// TempElement := TCefPostDataElementOwn.Create(True);
// TempElement.SetToFile('c:\myfile.txt');
//
// TempPostData := TCefPostDataRef.New;
// TempPostData.AddElement := TempElement;
//
// TempRequest := TCefRequestRef.New;
// TempRequest.URL := FPendingURL;
// TempRequest.Method := 'POST';
// TempRequest.PostData := TempPostData;
// Set the "client" parameter to the TCEFUrlRequestClientComponent.Client property
// to use the TCEFUrlRequestClientComponent events.
// The "requestContext" parameter can be nil to use the global request context.
@ -218,14 +253,70 @@ begin
end;
end;
procedure TURLRequestFrm.CreatePOSTRequest;
var
TempRequest : ICefRequest;
TempPostData : ICefPostData;
TempElement : ICefPostDataElement;
TempParams : AnsiString;
begin
try
if (length(FPendingURL) > 0) then
begin
FBusy := True;
TempRequest := TCefRequestRef.New;
TempRequest.URL := FPendingURL;
TempRequest.Method := 'POST';
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
// TODO : The parameters should be converted to ansistring and encoded
if (length(PostParam1NameEdt.Text) > 0) and (length(PostParam1ValueEdt.Text) > 0) then
TempParams := PostParam1NameEdt.Text + '=' + PostParam1ValueEdt.Text;
if (length(PostParam2NameEdt.Text) > 0) and (length(PostParam2ValueEdt.Text) > 0) then
begin
if (length(TempParams) > 0) then
TempParams := TempParams + '&' + PostParam2NameEdt.Text + '=' + PostParam2ValueEdt.Text
else
TempParams := PostParam2NameEdt.Text + '=' + PostParam2ValueEdt.Text;
end;
if (length(TempParams) > 0) then
begin
TempElement := TCefPostDataElementRef.New;
TempElement.SetToBytes(length(TempParams), @TempParams[1]);
TempPostData := TCefPostDataRef.New;
TempPostData.AddElement(TempElement);
TempRequest.PostData := TempPostData;
// Set the "client" parameter to the TCEFUrlRequestClientComponent.Client property
// to use the TCEFUrlRequestClientComponent events.
// The "requestContext" parameter can be nil to use the global request context.
TCefUrlRequestRef.New(TempRequest, CEFUrlRequestClientComponent1.Client, nil);
end;
end;
finally
TempElement := nil;
TempPostData := nil;
TempRequest := nil;
end;
end;
procedure TURLRequestFrm.CEFUrlRequestClientComponent1DownloadData(Sender: TObject; const request: ICefUrlRequest; data: Pointer; dataLength: NativeUInt);
begin
try
if FClosing then
request.Cancel
else
if (data <> nil) and (dataLength > 0) then
FStream.WriteBuffer(data^, dataLength);
if FSendingGET then
begin
if (data <> nil) and (dataLength > 0) then
FMemStream.WriteBuffer(data^, dataLength);
end;
except
on e : exception do
if CustomExceptionHandler('TURLRequestFrm.CEFUrlRequestClientComponent1DownloadData', e) then raise;
@ -237,15 +328,18 @@ begin
if FClosing then
request.Cancel
else
if (total > 0) then
StatusBar1.Panels[0].Text := 'Downloading : ' + inttostr(round((current / total) * 100)) + ' %'
else
StatusBar1.Panels[0].Text := 'Downloading : ' + inttostr(current) + ' bytes';
if FSendingGET then
begin
if (total > 0) then
StatusBar1.Panels[0].Text := 'Downloading : ' + inttostr(round((current / total) * 100)) + ' %'
else
StatusBar1.Panels[0].Text := 'Downloading : ' + inttostr(current) + ' bytes';
end;
end;
procedure TURLRequestFrm.CEFUrlRequestClientComponent1RequestComplete(Sender: TObject; const request: ICefUrlRequest);
begin
FDownloading := False;
FBusy := False;
// Use request.response here to get a ICefResponse interface with all the response headers, status, error code, etc.
@ -262,27 +356,74 @@ begin
end;
procedure TURLRequestFrm.URLRequestSuccessMsg(var aMessage : TMessage);
var
TempMessage : string;
begin
DownloadBtn.Enabled := True;
StatusBar1.Panels[0].Text := 'Download complete!';
SaveStreamToFile;
if FSendingGET then
begin
TempMessage := 'Download complete!';
SaveStreamToFile;
end
else
if FSendingPOST then
TempMessage := 'Parameters sent!';
StatusBar1.Panels[0].Text := TempMessage;
showmessage(TempMessage);
GETGbx.Enabled := True;
POSTGbx.Enabled := True;
FSendingGET := False;
FSendingPOST := False;
end;
procedure TURLRequestFrm.URLRequestErrorMsg(var aMessage : TMessage);
var
TempMessage : string;
begin
DownloadBtn.Enabled := True;
StatusBar1.Panels[0].Text := 'Download error : ' + inttostr(aMessage.lParam);
TempMessage := 'Error code : ' + inttostr(aMessage.lParam);
StatusBar1.Panels[0].Text := TempMessage;
showmessage(TempMessage);
GETGbx.Enabled := True;
POSTGbx.Enabled := True;
FSendingGET := False;
FSendingPOST := False;
end;
procedure TURLRequestFrm.SaveStreamToFile;
begin
try
FStream.SaveToFile(SaveDialog1.FileName);
FStream.Clear;
FMemStream.SaveToFile(SaveDialog1.FileName);
FMemStream.Clear;
except
on e : exception do
if CustomExceptionHandler('TURLRequestFrm.SaveStreamToFile', e) then raise;
end;
end;
procedure TURLRequestFrm.SendPostReqBtnClick(Sender: TObject);
var
TempURL : string;
begin
TempURL := trim(PostURLEdt.Text);
if (length(TempURL) > 0) then
begin
FPendingURL := TempURL;
GETGbx.Enabled := False;
POSTGbx.Enabled := False;
StatusBar1.Panels[0].Text := 'Sending...';
FMemStream.Clear;
FSendingPOST := True;
FSendingGET := False;
// TCEFUrlRequestClientComponent.AddURLRequest will trigger the
// TCEFUrlRequestClientComponent.OnCreateURLRequest event in the right
// thread where you can create your custom requests.
CEFUrlRequestClientComponent1.AddURLRequest;
end;
end;
end.

116
demos/Lazarus/PostInspectorBrowser/PostInspectorBrowser.lps
View File

@ -4,13 +4,13 @@
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="2">
<Units Count="3">
<Unit0>
<Filename Value="PostInspectorBrowser.lpr"/>
<IsPartOfProject Value="True"/>
<TopLine Value="41"/>
<CursorPos Y="73"/>
<UsageCount Value="20"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit0>
@ -22,15 +22,23 @@
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="130"/>
<CursorPos X="69" Y="150"/>
<UsageCount Value="20"/>
<TopLine Value="325"/>
<CursorPos X="80" Y="341"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit1>
<Unit2>
<Filename Value="C:\lazarus\fpc\3.0.4\source\rtl\objpas\classes\classesh.inc"/>
<EditorIndex Value="2"/>
<TopLine Value="860"/>
<CursorPos X="15" Y="873"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
</Units>
<JumpHistory Count="4" HistoryIndex="3">
<JumpHistory Count="26" HistoryIndex="25">
<Position1>
<Filename Value="PostInspectorBrowser.lpr"/>
</Position1>
@ -46,10 +54,106 @@
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="78" Column="43" TopLine="68"/>
</Position4>
<Position5>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="292" Column="59" TopLine="263"/>
</Position5>
<Position6>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="113" Column="79" TopLine="100"/>
</Position6>
<Position7>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="281" Column="40" TopLine="257"/>
</Position7>
<Position8>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="287" Column="103" TopLine="263"/>
</Position8>
<Position9>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="353" TopLine="325"/>
</Position9>
<Position10>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="331" TopLine="315"/>
</Position10>
<Position11>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="332" TopLine="315"/>
</Position11>
<Position12>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="334" TopLine="315"/>
</Position12>
<Position13>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="336" TopLine="315"/>
</Position13>
<Position14>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="337" TopLine="315"/>
</Position14>
<Position15>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="338" TopLine="315"/>
</Position15>
<Position16>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="331" TopLine="315"/>
</Position16>
<Position17>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="332" TopLine="315"/>
</Position17>
<Position18>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="330" Column="61" TopLine="322"/>
</Position18>
<Position19>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="331" TopLine="322"/>
</Position19>
<Position20>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="333" TopLine="322"/>
</Position20>
<Position21>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="331" TopLine="322"/>
</Position21>
<Position22>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="333" TopLine="322"/>
</Position22>
<Position23>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="335" TopLine="322"/>
</Position23>
<Position24>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="336" TopLine="322"/>
</Position24>
<Position25>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="331" Column="86" TopLine="322"/>
</Position25>
<Position26>
<Filename Value="uPostInspectorBrowser.pas"/>
<Caret Line="340" TopLine="322"/>
</Position26>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>
<Modes Count="0" ActiveMode=""/>
</RunParams>
</ProjectSession>
<Debugging>
<Watches Count="1">
<Item1>
<Expression Value="pointer(TempBuffer)^"/>
<DisplayStyle Value="wdfChar"/>
</Item1>
</Watches>
</Debugging>
</CONFIG>

7
demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.lfm
View File

@ -15,7 +15,7 @@ object Form1: TForm1
OnDestroy = FormDestroy
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '2.0.2.0'
LCLVersion = '2.0.4.0'
object Splitter1: TSplitter
Cursor = crVSplit
Left = 0
@ -55,11 +55,10 @@ object Form1: TForm1
ItemHeight = 13
ItemIndex = 0
Items.Strings = (
'https://www.w3schools.com/php/showphp.asp?filename=demo_form_post'
'https://www.w3schools.com/php/showphp.asp?filename=demo_form_get'
'https://tryphp.w3schools.com/showphp.php?filename=demo_form_post'
)
TabOrder = 1
Text = 'https://www.w3schools.com/php/showphp.asp?filename=demo_form_post'
Text = 'https://tryphp.w3schools.com/showphp.php?filename=demo_form_post'
end
end
object CEFWindowParent1: TCEFWindowParent

112
demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.pas
View File

@ -251,59 +251,74 @@ end;
procedure TForm1.HandlePostData(const request : ICefRequest);
var
TempPostData : ICefPostData;
TempElement : ICefPostDataElement;
TempList : IInterfaceList;
TempArray : TCefPostDataElementArray;
i : integer;
begin
TempArray := nil;
try
TempPostData := request.PostData;
try
TempPostData := request.PostData;
if (TempPostData <> nil) and (TempPostData.GetCount > 0) then
begin
FRequestSL.Add('--------------------');
FRequestSL.Add('POST data :');
if TempPostData.HasExcludedElements then
FRequestSL.Add('Has excluded elements! (For example, multi-part file upload data.)');
if (TempPostData <> nil) and (TempPostData.GetElementCount > 0) then
begin
FRequestSL.Add('--------------------');
FRequestSL.Add('POST data :');
if TempPostData.HasExcludedElements then
FRequestSL.Add('Has excluded elements! (For example, multi-part file upload data.)');
TempList := TempPostData.GetElements(TempPostData.GetCount);
i := 0;
TempPostData.GetElements(TempPostData.GetElementCount, TempArray);
while (i < TempList.Count) do
begin
TempElement := TempList.Items[i] as ICefPostDataElement;
FRequestSL.Add('Element : ' + inttostr(i));
FRequestSL.Add('Size : ' + inttostr(TempElement.GetBytesCount));
i := 0;
while (i < length(TempArray)) do
begin
FRequestSL.Add('Element : ' + inttostr(i));
FRequestSL.Add('Size : ' + inttostr(TempArray[i].GetBytesCount));
case TempElement.GetType of
PDE_TYPE_BYTES :
begin
FRequestSL.Add('Type : Bytes');
HandlePostDataBytes(TempElement);
end;
case TempArray[i].GetType of
PDE_TYPE_BYTES :
begin
FRequestSL.Add('Type : Bytes');
HandlePostDataBytes(TempArray[i]);
end;
PDE_TYPE_FILE :
begin
FRequestSL.Add('Type : File');
// This element type can be read using a TBuffer like we do in HandlePostDataBytes
end
PDE_TYPE_FILE :
begin
FRequestSL.Add('Type : File');
// This element type can be read using a TBuffer like we do in HandlePostDataBytes
end
else
FRequestSL.Add('Type : Empty');
else
FRequestSL.Add('Type : Empty');
end;
inc(i);
end;
inc(i);
end;
// Set interfaces to nil to release them
i := 0;
while (i < length(TempArray)) do
begin
TempArray[i] := nil;
inc(i);
end;
end;
except
on e : exception do
if CustomExceptionHandler('TForm1.HandlePostData', e) then raise;
end;
finally
if (TempArray <> nil) then
begin
Finalize(TempArray);
TempArray := nil;
end;
except
on e : exception do
if CustomExceptionHandler('TForm1.HandlePostData', e) then raise;
end;
end;
procedure TForm1.HandlePostDataBytes(const aElement : ICefPostDataElement);
var
TempStream : TStringStream;
TempBuffer : TBytes;
TempBuffer : Pointer;
TempSize : NativeUInt;
begin
TempStream := nil;
@ -311,17 +326,22 @@ begin
try
try
if (aElement <> nil) and (aElement.GetBytesCount > 0) then
if (aElement <> nil) then
begin
SetLength(TempBuffer, aElement.GetBytesCount);
TempSize := aElement.GetBytes(aElement.GetBytesCount, @TempBuffer[0]);
TempSize := aElement.GetBytesCount;
if (TempSize > 0) then
begin
TempStream := TStringStream.Create('');
TempStream.WriteBuffer(TempBuffer, TempSize);
TempStream.Seek(0, soBeginning);
FRequestSL.Add(TempStream.ReadString(TempSize));
GetMem(TempBuffer, TempSize);
TempSize := aElement.GetBytes(TempSize, TempBuffer);
if (TempSize > 0) then
begin
TempStream := TStringStream.Create('');
TempStream.WriteBuffer(TempBuffer^, TempSize);
TempStream.Seek(0, soBeginning);
FRequestSL.Add(TempStream.ReadString(TempSize));
end;
end;
end;
except
@ -329,8 +349,12 @@ begin
if CustomExceptionHandler('TForm1.HandlePostDataBytes', e) then raise;
end;
finally
if (TempStream <> nil) then FreeAndNil(TempStream);
SetLength(TempBuffer, 0);
if (TempStream <> nil) then FreeAndNil(TempStream);
if (TempBuffer <> nil) then
begin
FreeMem(TempBuffer);
TempBuffer := nil;
end;
end;
end;

5
demos/Lazarus/URLRequest/URLRequest.lpi
View File

@ -52,12 +52,9 @@
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="..\..\..\bin\URLRequest"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
<UnitOutputDirectory Value="..\..\..\bin"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>

126
demos/Lazarus/URLRequest/URLRequest.lps
View File

@ -4,12 +4,13 @@
<PathDelim Value="\"/>
<Version Value="11"/>
<BuildModes Active="Default"/>
<Units Count="5">
<Units Count="2">
<Unit0>
<Filename Value="URLRequest.lpr"/>
<IsPartOfProject Value="True"/>
<TopLine Value="43"/>
<CursorPos X="18" Y="52"/>
<IsVisibleTab Value="True"/>
<TopLine Value="44"/>
<CursorPos X="17" Y="59"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
@ -20,134 +21,17 @@
<ComponentName Value="URLRequestFrm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="1"/>
<TopLine Value="104"/>
<CursorPos X="69" Y="121"/>
<UsageCount Value="20"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
<DefaultSyntaxHighlighter Value="Delphi"/>
</Unit1>
<Unit2>
<Filename Value="C:\lazarus\lcl\include\statuspanels.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="15"/>
<CursorPos Y="28"/>
<UsageCount Value="10"/>
</Unit2>
<Unit3>
<Filename Value="C:\lazarus\lcl\comctrls.pp"/>
<UnitName Value="ComCtrls"/>
<EditorIndex Value="-1"/>
<TopLine Value="60"/>
<CursorPos X="36" Y="74"/>
<UsageCount Value="10"/>
</Unit3>
<Unit4>
<Filename Value="C:\lazarus\lcl\include\statuspanel.inc"/>
<EditorIndex Value="-1"/>
<TopLine Value="122"/>
<CursorPos Y="132"/>
<UsageCount Value="10"/>
</Unit4>
</Units>
<JumpHistory Count="24" HistoryIndex="23">
<JumpHistory Count="1">
<Position1>
<Filename Value="uURLRequest.pas"/>
</Position1>
<Position2>
<Filename Value="uURLRequest.pas"/>
<Caret Line="75" Column="44" TopLine="65"/>
</Position2>
<Position3>
<Filename Value="uURLRequest.pas"/>
<Caret Line="84" Column="17" TopLine="69"/>
</Position3>
<Position4>
<Filename Value="uURLRequest.pas"/>
<Caret Line="70" Column="43" TopLine="53"/>
</Position4>
<Position5>
<Filename Value="uURLRequest.pas"/>
<Caret Line="233" TopLine="224"/>
</Position5>
<Position6>
<Filename Value="uURLRequest.pas"/>
<Caret Line="236" TopLine="224"/>
</Position6>
<Position7>
<Filename Value="uURLRequest.pas"/>
<Caret Line="233" TopLine="224"/>
</Position7>
<Position8>
<Filename Value="uURLRequest.pas"/>
<Caret Line="244" TopLine="236"/>
</Position8>
<Position9>
<Filename Value="uURLRequest.pas"/>
<Caret Line="248" TopLine="236"/>
</Position9>
<Position10>
<Filename Value="uURLRequest.pas"/>
<Caret Line="254" TopLine="236"/>
</Position10>
<Position11>
<Filename Value="uURLRequest.pas"/>
<Caret Line="79" Column="26" TopLine="63"/>
</Position11>
<Position12>
<Filename Value="uURLRequest.pas"/>
<Caret Line="263" TopLine="246"/>
</Position12>
<Position13>
<Filename Value="uURLRequest.pas"/>
<Caret Line="263" Column="27" TopLine="246"/>
</Position13>
<Position14>
<Filename Value="uURLRequest.pas"/>
<Caret Line="265" Column="35" TopLine="255"/>
</Position14>
<Position15>
<Filename Value="uURLRequest.pas"/>
<Caret Line="146" Column="58" TopLine="134"/>
</Position15>
<Position16>
<Filename Value="uURLRequest.pas"/>
<Caret Line="151" Column="16" TopLine="138"/>
</Position16>
<Position17>
<Filename Value="uURLRequest.pas"/>
<Caret Line="239" Column="42" TopLine="220"/>
</Position17>
<Position18>
<Filename Value="uURLRequest.pas"/>
<Caret Line="238" Column="42" TopLine="219"/>
</Position18>
<Position19>
<Filename Value="uURLRequest.pas"/>
<Caret Line="239" Column="42" TopLine="220"/>
</Position19>
<Position20>
<Filename Value="uURLRequest.pas"/>
<Caret Line="238" Column="42" TopLine="219"/>
</Position20>
<Position21>
<Filename Value="uURLRequest.pas"/>
<Caret Line="150" Column="54" TopLine="47"/>
</Position21>
<Position22>
<Filename Value="URLRequest.lpr"/>
<Caret Line="62" Column="22" TopLine="43"/>
</Position22>
<Position23>
<Filename Value="uURLRequest.pas"/>
<Caret Line="91" Column="29" TopLine="75"/>
</Position23>
<Position24>
<Filename Value="uURLRequest.pas"/>
<Caret Line="120" Column="3" TopLine="118"/>
</Position24>
</JumpHistory>
<RunParams>
<FormatVersion Value="2"/>

220
demos/Lazarus/URLRequest/uURLRequest.lfm
View File

@ -1,13 +1,13 @@
object URLRequestFrm: TURLRequestFrm
Left = 301
Height = 116
Top = 177
Width = 494
Left = 613
Height = 445
Top = 279
Width = 518
BorderIcons = [biSystemMenu]
BorderStyle = bsSingle
Caption = 'URL request'
ClientHeight = 116
ClientWidth = 494
ClientHeight = 445
ClientWidth = 518
Color = clBtnFace
Font.Color = clWindowText
Font.Height = -11
@ -16,51 +16,191 @@ object URLRequestFrm: TURLRequestFrm
OnCreate = FormCreate
OnDestroy = FormDestroy
Position = poScreenCenter
LCLVersion = '2.0.2.0'
object Label1: TLabel
Left = 16
Height = 13
Top = 19
Width = 19
Caption = 'URL'
ParentColor = False
end
object Edit1: TEdit
Left = 48
Height = 21
Top = 16
Width = 433
TabOrder = 0
Text = 'https://www.w3.org/WAI/ER/tests/xhtml/testfiles/resources/pdf/dummy.pdf'
end
object DownloadBtn: TButton
Left = 16
Height = 25
Top = 51
Width = 465
Caption = 'Download'
OnClick = DownloadBtnClick
TabOrder = 1
end
object StatusPnl: TPanel
LCLVersion = '2.0.4.0'
object StatusBar1: TStatusBar
Left = 0
Height = 23
Top = 93
Top = 422
Width = 518
Panels = <
item
Width = 500
end>
SimplePanel = False
end
object GETGbx: TGroupBox
Left = 10
Height = 105
Top = 8
Width = 494
Align = alBottom
BevelOuter = bvLowered
Caption = ' GET example '
ClientHeight = 87
ClientWidth = 490
TabOrder = 1
object Label1: TLabel
Left = 14
Height = 13
Top = 16
Width = 19
Caption = 'URL'
ParentColor = False
end
object DownloadBtn: TButton
Left = 11
Height = 25
Top = 48
Width = 465
Caption = 'Download'
OnClick = DownloadBtnClick
TabOrder = 0
end
object GetURLEdt: TEdit
Left = 43
Height = 21
Top = 13
Width = 433
TabOrder = 1
Text = 'https://www.w3.org/WAI/ER/tests/xhtml/testfiles/resources/pdf/dummy.pdf'
end
end
object POSTGbx: TGroupBox
Left = 10
Height = 274
Top = 136
Width = 494
Caption = ' POST example '
ClientHeight = 256
ClientWidth = 490
TabOrder = 2
object Label2: TLabel
Left = 14
Height = 13
Top = 15
Width = 19
Caption = 'URL'
ParentColor = False
end
object PostURLEdt: TEdit
Left = 43
Height = 21
Top = 12
Width = 433
TabOrder = 0
Text = 'https://ptsv2.com/t/cef4delphi/post'
end
object SendPostReqBtn: TButton
Left = 14
Height = 25
Top = 179
Width = 462
Caption = 'Send POST request'
OnClick = SendPostReqBtnClick
TabOrder = 1
end
object Button1: TButton
Left = 14
Height = 25
Top = 217
Width = 462
Caption = 'Check results in PTSV2.com'
OnClick = Button1Click
TabOrder = 2
end
object GroupBox1: TGroupBox
Left = 14
Height = 57
Top = 42
Width = 462
Caption = ' Parameter 1 '
ClientHeight = 39
ClientWidth = 458
TabOrder = 3
object Label3: TLabel
Left = 14
Height = 13
Top = 10
Width = 34
Caption = 'Name :'
ParentColor = False
end
object Label4: TLabel
Left = 262
Height = 13
Top = 10
Width = 33
Caption = 'Value :'
ParentColor = False
end
object PostParam1NameEdt: TEdit
Left = 54
Height = 21
Top = 7
Width = 121
TabOrder = 0
Text = 'name1'
end
object PostParam1ValueEdt: TEdit
Left = 302
Height = 21
Top = 7
Width = 137
TabOrder = 1
Text = 'value1'
end
end
object GroupBox2: TGroupBox
Left = 14
Height = 57
Top = 109
Width = 462
Caption = ' Parameter 2 '
ClientHeight = 39
ClientWidth = 458
TabOrder = 4
object Label5: TLabel
Left = 14
Height = 13
Top = 10
Width = 34
Caption = 'Name :'
ParentColor = False
end
object Label6: TLabel
Left = 262
Height = 13
Top = 10
Width = 33
Caption = 'Value :'
ParentColor = False
end
object PostParam2NameEdt: TEdit
Left = 54
Height = 21
Top = 7
Width = 121
TabOrder = 0
Text = 'name2'
end
object PostParam2ValueEdt: TEdit
Left = 302
Height = 21
Top = 7
Width = 137
TabOrder = 1
Text = 'value2'
end
end
end
object SaveDialog1: TSaveDialog
left = 384
top = 64
left = 448
top = 104
end
object CEFUrlRequestClientComponent1: TCEFUrlRequestClientComponent
OnRequestComplete = CEFUrlRequestClientComponent1RequestComplete
OnDownloadProgress = CEFUrlRequestClientComponent1DownloadProgress
OnDownloadData = CEFUrlRequestClientComponent1DownloadData
OnCreateURLRequest = CEFUrlRequestClientComponent1CreateURLRequest
left = 80
top = 64
left = 304
top = 104
end
end

244
demos/Lazarus/URLRequest/uURLRequest.pas
View File

@ -42,8 +42,13 @@ unit uURLRequest;
interface
uses
{$IFDEF DELPHI16_UP}
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls,
{$ELSE}
LCLIntf, LCLType, LMessages, Messages, SysUtils, Variants, Classes, Graphics,
Controls, Forms, Dialogs, ComCtrls, StdCtrls, ExtCtrls,
Controls, Forms, Dialogs, ComCtrls, StdCtrls,
{$ENDIF}
uCEFInterfaces, uCEFUrlRequestClientComponent, uCEFRequest, uCEFUrlRequest;
const
@ -51,18 +56,32 @@ const
URLREQUEST_ERROR = WM_APP + $102;
type
{ TURLRequestFrm }
TURLRequestFrm = class(TForm)
Edit1: TEdit;
Label1: TLabel;
DownloadBtn: TButton;
StatusPnl: TPanel;
StatusBar1: TStatusBar;
SaveDialog1: TSaveDialog;
CEFUrlRequestClientComponent1: TCEFUrlRequestClientComponent;
GETGbx: TGroupBox;
DownloadBtn: TButton;
GetURLEdt: TEdit;
Label1: TLabel;
POSTGbx: TGroupBox;
PostURLEdt: TEdit;
Label2: TLabel;
SendPostReqBtn: TButton;
Button1: TButton;
GroupBox1: TGroupBox;
Label3: TLabel;
PostParam1NameEdt: TEdit;
Label4: TLabel;
PostParam1ValueEdt: TEdit;
GroupBox2: TGroupBox;
Label5: TLabel;
Label6: TLabel;
PostParam2NameEdt: TEdit;
PostParam2ValueEdt: TEdit;
procedure DownloadBtnClick(Sender: TObject);
procedure SendPostReqBtnClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormCreate(Sender: TObject);
@ -72,12 +91,20 @@ type
procedure CEFUrlRequestClientComponent1DownloadProgress(Sender: TObject; const request: ICefUrlRequest; current, total: Int64);
procedure CEFUrlRequestClientComponent1RequestComplete(Sender: TObject; const request: ICefUrlRequest);
procedure CEFUrlRequestClientComponent1CreateURLRequest(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
FStream : TMemoryStream;
FMemStream : TMemoryStream;
FCanClose : boolean;
FClosing : boolean;
FDownloading : boolean;
FBusy : boolean;
FPendingURL : string;
FSendingGET : boolean;
FSendingPOST : boolean;
procedure CreateGETRequest;
procedure CreatePOSTRequest;
procedure URLRequestSuccessMsg(var aMessage : TMessage); message URLREQUEST_SUCCESS;
procedure URLRequestErrorMsg(var aMessage : TMessage); message URLREQUEST_ERROR;
@ -113,12 +140,11 @@ implementation
uses
uCEFApplication, uCEFMiscFunctions, uCEFTypes, uCEFPostData, uCEFPostDataElement, uCEFConstants;
procedure CreateGlobalCEFApp;
begin
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.DisableFeatures := 'NetworkService,OutOfBlinkCors';
GlobalCEFApp := TCefApplication.Create;
GlobalCEFApp.DisableFeatures := 'NetworkService,OutOfBlinkCors';
end;
procedure TURLRequestFrm.DownloadBtnClick(Sender: TObject);
@ -127,7 +153,7 @@ var
TempParts : TUrlParts;
i : integer;
begin
TempURL := trim(Edit1.Text);
TempURL := trim(GetURLEdt.Text);
if (length(TempURL) > 0) then
begin
@ -153,10 +179,14 @@ begin
if SaveDialog1.Execute and
(length(SaveDialog1.FileName) > 0) then
begin
FPendingURL := TempURL;
DownloadBtn.Enabled := False;
StatusPnl.Caption := 'Downloading...';
FStream.Clear;
FPendingURL := TempURL;
GETGbx.Enabled := False;
POSTGbx.Enabled := False;
StatusBar1.Panels[0].Text := 'Downloading...';
FMemStream.Clear;
FSendingPOST := False;
FSendingGET := True;
// TCEFUrlRequestClientComponent.AddURLRequest will trigger the
// TCEFUrlRequestClientComponent.OnCreateURLRequest event in the right
@ -168,54 +198,52 @@ end;
procedure TURLRequestFrm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := FCanClose or not(FDownloading);
CanClose := FCanClose or not(FBusy);
FClosing := True;
end;
procedure TURLRequestFrm.FormCreate(Sender: TObject);
begin
FStream := TMemoryStream.Create;
FMemStream := TMemoryStream.Create;
FCanClose := False;
FClosing := False;
FDownloading := False;
FBusy := False;
FSendingGET := False;
FSendingPOST := False;
end;
procedure TURLRequestFrm.FormDestroy(Sender: TObject);
begin
if (FStream <> nil) then FreeAndNil(FStream);
if (FMemStream <> nil) then FreeAndNil(FMemStream);
end;
procedure TURLRequestFrm.Button1Click(Sender: TObject);
begin
OpenURL('https://ptsv2.com/t/cef4delphi'); { *Converted from ShellExecute* }
end;
procedure TURLRequestFrm.CEFUrlRequestClientComponent1CreateURLRequest(Sender: TObject);
begin
if FSendingGET then
CreateGETRequest
else
if FSendingPOST then
CreatePOSTRequest;
end;
procedure TURLRequestFrm.CreateGETRequest;
var
TempRequest : ICefRequest;
// TempPostData : ICefPostData;
// TempElement : ICefPostDataElement;
begin
try
if (length(FPendingURL) > 0) then
begin
FDownloading := True;
// GET request example
// -------------------
FBusy := True;
TempRequest := TCefRequestRef.New;
TempRequest.URL := FPendingURL;
TempRequest.Method := 'GET';
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
// POST request example
// --------------------
// TempElement := TCefPostDataElementOwn.Create(True);
// TempElement.SetToFile('c:\myfile.txt');
//
// TempPostData := TCefPostDataRef.New;
// TempPostData.AddElement := TempElement;
//
// TempRequest := TCefRequestRef.New;
// TempRequest.URL := FPendingURL;
// TempRequest.Method := 'POST';
// TempRequest.PostData := TempPostData;
// Set the "client" parameter to the TCEFUrlRequestClientComponent.Client property
// to use the TCEFUrlRequestClientComponent events.
// The "requestContext" parameter can be nil to use the global request context.
@ -226,14 +254,70 @@ begin
end;
end;
procedure TURLRequestFrm.CreatePOSTRequest;
var
TempRequest : ICefRequest;
TempPostData : ICefPostData;
TempElement : ICefPostDataElement;
TempParams : AnsiString;
begin
try
if (length(FPendingURL) > 0) then
begin
FBusy := True;
TempRequest := TCefRequestRef.New;
TempRequest.URL := FPendingURL;
TempRequest.Method := 'POST';
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
// TODO : The parameters should be converted to ansistring and encoded
if (length(PostParam1NameEdt.Text) > 0) and (length(PostParam1ValueEdt.Text) > 0) then
TempParams := PostParam1NameEdt.Text + '=' + PostParam1ValueEdt.Text;
if (length(PostParam2NameEdt.Text) > 0) and (length(PostParam2ValueEdt.Text) > 0) then
begin
if (length(TempParams) > 0) then
TempParams := TempParams + '&' + PostParam2NameEdt.Text + '=' + PostParam2ValueEdt.Text
else
TempParams := PostParam2NameEdt.Text + '=' + PostParam2ValueEdt.Text;
end;
if (length(TempParams) > 0) then
begin
TempElement := TCefPostDataElementRef.New;
TempElement.SetToBytes(length(TempParams), @TempParams[1]);
TempPostData := TCefPostDataRef.New;
TempPostData.AddElement(TempElement);
TempRequest.PostData := TempPostData;
// Set the "client" parameter to the TCEFUrlRequestClientComponent.Client property
// to use the TCEFUrlRequestClientComponent events.
// The "requestContext" parameter can be nil to use the global request context.
TCefUrlRequestRef.New(TempRequest, CEFUrlRequestClientComponent1.Client, nil);
end;
end;
finally
TempElement := nil;
TempPostData := nil;
TempRequest := nil;
end;
end;
procedure TURLRequestFrm.CEFUrlRequestClientComponent1DownloadData(Sender: TObject; const request: ICefUrlRequest; data: Pointer; dataLength: NativeUInt);
begin
try
if FClosing then
request.Cancel
else
if (data <> nil) and (dataLength > 0) then
FStream.WriteBuffer(data^, dataLength);
if FSendingGET then
begin
if (data <> nil) and (dataLength > 0) then
FMemStream.WriteBuffer(data^, dataLength);
end;
except
on e : exception do
if CustomExceptionHandler('TURLRequestFrm.CEFUrlRequestClientComponent1DownloadData', e) then raise;
@ -245,15 +329,18 @@ begin
if FClosing then
request.Cancel
else
if (total > 0) then
StatusPnl.Caption := 'Downloading : ' + inttostr(round((current / total) * 100)) + ' %'
else
StatusPnl.Caption := 'Downloading : ' + inttostr(current) + ' bytes';
if FSendingGET then
begin
if (total > 0) then
StatusBar1.Panels[0].Text := 'Downloading : ' + inttostr(round((current / total) * 100)) + ' %'
else
StatusBar1.Panels[0].Text := 'Downloading : ' + inttostr(current) + ' bytes';
end;
end;
procedure TURLRequestFrm.CEFUrlRequestClientComponent1RequestComplete(Sender: TObject; const request: ICefUrlRequest);
begin
FDownloading := False;
FBusy := False;
// Use request.response here to get a ICefResponse interface with all the response headers, status, error code, etc.
@ -270,27 +357,74 @@ begin
end;
procedure TURLRequestFrm.URLRequestSuccessMsg(var aMessage : TMessage);
var
TempMessage : string;
begin
DownloadBtn.Enabled := True;
StatusPnl.Caption := 'Download complete!';
SaveStreamToFile;
if FSendingGET then
begin
TempMessage := 'Download complete!';
SaveStreamToFile;
end
else
if FSendingPOST then
TempMessage := 'Parameters sent!';
StatusBar1.Panels[0].Text := TempMessage;
showmessage(TempMessage);
GETGbx.Enabled := True;
POSTGbx.Enabled := True;
FSendingGET := False;
FSendingPOST := False;
end;
procedure TURLRequestFrm.URLRequestErrorMsg(var aMessage : TMessage);
var
TempMessage : string;
begin
DownloadBtn.Enabled := True;
StatusPnl.Caption := 'Download error : ' + inttostr(aMessage.lParam);
TempMessage := 'Error code : ' + inttostr(aMessage.lParam);
StatusBar1.Panels[0].Text := TempMessage;
showmessage(TempMessage);
GETGbx.Enabled := True;
POSTGbx.Enabled := True;
FSendingGET := False;
FSendingPOST := False;
end;
procedure TURLRequestFrm.SaveStreamToFile;
begin
try
FStream.SaveToFile(SaveDialog1.FileName);
FStream.Clear;
FMemStream.SaveToFile(SaveDialog1.FileName);
FMemStream.Clear;
except
on e : exception do
if CustomExceptionHandler('TURLRequestFrm.SaveStreamToFile', e) then raise;
end;
end;
procedure TURLRequestFrm.SendPostReqBtnClick(Sender: TObject);
var
TempURL : string;
begin
TempURL := trim(PostURLEdt.Text);
if (length(TempURL) > 0) then
begin
FPendingURL := TempURL;
GETGbx.Enabled := False;
POSTGbx.Enabled := False;
StatusBar1.Panels[0].Text := 'Sending...';
FMemStream.Clear;
FSendingPOST := True;
FSendingGET := False;
// TCEFUrlRequestClientComponent.AddURLRequest will trigger the
// TCEFUrlRequestClientComponent.OnCreateURLRequest event in the right
// thread where you can create your custom requests.
CEFUrlRequestClientComponent1.AddURLRequest;
end;
end;
end.

10
source/uCEFInterfaces.pas
View File

@ -143,11 +143,13 @@ type
ICefMenuButton = interface;
ICefUrlRequest = interface;
ICefAudioHandler = interface;
ICefPostDataElement = interface;
TCefv8ValueArray = array of ICefv8Value;
TCefX509CertificateArray = array of ICefX509Certificate;
TCefBinaryValueArray = array of ICefBinaryValue;
TCefFrameIdentifierArray = array of int64;
TCefPostDataElementArray = array of ICefPostDataElement;
@ -616,10 +618,10 @@ type
['{1E677630-9339-4732-BB99-D6FE4DE4AEC0}']
function IsReadOnly: Boolean;
function HasExcludedElements: Boolean;
function GetCount: NativeUInt;
function GetElements(Count: NativeUInt): IInterfaceList; // list of ICefPostDataElement
function RemoveElement(const element: ICefPostDataElement): Integer;
function AddElement(const element: ICefPostDataElement): Integer;
function GetElementCount: NativeUInt;
procedure GetElements(elementsCount: NativeUInt; var elements: TCefPostDataElementArray);
function RemoveElement(const element: ICefPostDataElement): Boolean;
function AddElement(const element: ICefPostDataElement): Boolean;
procedure RemoveElements;
end;

17
source/uCEFMiscFunctions.pas
View File

@ -1484,23 +1484,22 @@ end;
function CustomAbsolutePath(const aPath : string; aMustExist : boolean) : string;
var
TempPath : string;
TempNewPath, TempOldPath : string;
begin
if (length(aPath) > 0) then
begin
if CustomPathIsRelative(aPath) then
begin
if not(CustomPathCanonicalize(GetModulePath + aPath, TempPath)) then
TempPath := aPath;
end
TempOldPath := GetModulePath + aPath
else
if not(CustomPathCanonicalize(aPath, TempPath)) then
TempPath := aPath;
TempOldPath := aPath;
if aMustExist and not(DirectoryExists(TempPath)) then
if not(CustomPathCanonicalize(TempOldPath, TempNewPath)) then
TempNewPath := TempOldPath;
if aMustExist and not(DirectoryExists(TempNewPath)) then
Result := ''
else
Result := TempPath;
Result := TempNewPath;
end
else
Result := '';

67
source/uCEFPostData.pas
View File

@ -61,10 +61,10 @@ type
protected
function IsReadOnly: Boolean;
function HasExcludedElements: Boolean;
function GetCount: NativeUInt;
function GetElements(Count: NativeUInt): IInterfaceList; // ICefPostDataElement
function RemoveElement(const element: ICefPostDataElement): Integer;
function AddElement(const element: ICefPostDataElement): Integer;
function GetElementCount: NativeUInt;
procedure GetElements(elementsCount: NativeUInt; var elements: TCefPostDataElementArray);
function RemoveElement(const element: ICefPostDataElement): Boolean;
function AddElement(const element: ICefPostDataElement): Boolean;
procedure RemoveElements;
public
@ -88,45 +88,60 @@ begin
Result := PCefPostData(FData)^.has_excluded_elements(PCefPostData(FData)) <> 0;
end;
function TCefPostDataRef.AddElement(const element: ICefPostDataElement): Integer;
function TCefPostDataRef.AddElement(const element: ICefPostDataElement): Boolean;
begin
Result := PCefPostData(FData)^.add_element(PCefPostData(FData), CefGetData(element));
Result := PCefPostData(FData)^.add_element(PCefPostData(FData), CefGetData(element)) <> 0;
end;
function TCefPostDataRef.GetCount: NativeUInt;
function TCefPostDataRef.GetElementCount: NativeUInt;
begin
Result := PCefPostData(FData)^.get_element_count(PCefPostData(FData))
end;
function TCefPostDataRef.GetElements(Count: NativeUInt): IInterfaceList;
procedure TCefPostDataRef.GetElements(elementsCount: NativeUInt; var elements: TCefPostDataElementArray);
var
items : PCefPostDataElementArray;
i : NativeUInt;
TempArray : array of PCefPostDataElement;
i : NativeUInt;
begin
Result := nil;
items := nil;
TempArray := nil;
try
try
GetMem(items, SizeOf(PCefPostDataElement) * Count);
FillChar(items^, SizeOf(PCefPostDataElement) * Count, 0);
PCefPostData(FData)^.get_elements(PCefPostData(FData), @Count, items);
Result := TInterfaceList.Create;
i := 0;
while (i < Count) do
if (elementsCount > 0) then
begin
Result.Add(TCefPostDataElementRef.UnWrap(items^[i]));
inc(i);
SetLength(TempArray, elementsCount);
i := 0;
while (i < elementsCount) do
begin
TempArray[i] := nil;
inc(i);
end;
PCefPostData(FData)^.get_elements(PCefPostData(FData), elementsCount, TempArray[0]);
if (elementsCount > 0) then
begin
SetLength(elements, elementsCount);
i := 0;
while (i < elementsCount) do
begin
elements[i] := TCefPostDataElementRef.UnWrap(TempArray[i]);
inc(i);
end;
end;
end;
except
on e : exception do
if CustomExceptionHandler('TCefPostDataRef.GetElements', e) then raise;
end;
finally
if (items <> nil) then FreeMem(items);
if (TempArray <> nil) then
begin
Finalize(TempArray);
TempArray := nil;
end;
end;
end;
@ -135,9 +150,9 @@ begin
Result := UnWrap(cef_post_data_create());
end;
function TCefPostDataRef.RemoveElement(const element: ICefPostDataElement): Integer;
function TCefPostDataRef.RemoveElement(const element: ICefPostDataElement): Boolean;
begin
Result := PCefPostData(FData)^.remove_element(PCefPostData(FData), CefGetData(element));
Result := PCefPostData(FData)^.remove_element(PCefPostData(FData), CefGetData(element)) <> 0;
end;
procedure TCefPostDataRef.RemoveElements;

7
source/uCEFTypes.pas
View File

@ -90,7 +90,6 @@ type
PCefStringVisitor = ^TCefStringVisitor;
PCefRequest = ^TCefRequest;
PCefPostData = ^TCefPostData;
PCefPostDataElementArray = ^TCefPostDataElementArray;
PCefPostDataElement = ^TCefPostDataElement;
PPCefPostDataElement = ^PCefPostDataElement;
PCefv8Context = ^TCefv8Context;
@ -2245,8 +2244,6 @@ type
visit : procedure(self: PCefStringVisitor; const str: PCefString); stdcall;
end;
TCefPostDataElementArray = array[0..(High(Integer) div SizeOf(PCefPostDataElement)) - 1] of PCefPostDataElement;
// /include/capi/cef_request_capi.h (cef_post_data_element_t)
TCefPostDataElement = record
base : TCefBaseRefCounted;
@ -2263,10 +2260,10 @@ type
// /include/capi/cef_request_capi.h (cef_post_data_t)
TCefPostData = record
base : TCefBaseRefCounted;
is_read_only : function(self: PCefPostData):Integer; stdcall;
is_read_only : function(self: PCefPostData): Integer; stdcall;
has_excluded_elements : function(self: PCefPostData): Integer; stdcall;
get_element_count : function(self: PCefPostData): NativeUInt; stdcall;
get_elements : procedure(self: PCefPostData; elementsCount: PNativeUInt; elements: PCefPostDataElementArray); stdcall;
get_elements : procedure(self: PCefPostData; var elementsCount: NativeUInt; var elements: PCefPostDataElement); stdcall;
remove_element : function(self: PCefPostData; element: PCefPostDataElement): Integer; stdcall;
add_element : function(self: PCefPostData; element: PCefPostDataElement): Integer; stdcall;
remove_elements : procedure(self: PCefPostData); stdcall;

2
update_CEF4Delphi.json
View File

@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
"InternalVersion" : 32,
"InternalVersion" : 33,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "76.1.13.0"
}