diff --git a/demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.dfm b/demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.dfm
index f6b43d48..278b7a11 100644
--- a/demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.dfm
+++ b/demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.dfm
@@ -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
diff --git a/demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.pas b/demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.pas
index 931bb910..e0f0cdba 100644
--- a/demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.pas
+++ b/demos/Delphi_VCL/PostInspectorBrowser/uPostInspectorBrowser.pas
@@ -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;
diff --git a/demos/Delphi_VCL/URLRequest/URLRequest.dpr b/demos/Delphi_VCL/URLRequest/URLRequest.dpr
index 37e73345..cf02975f 100644
--- a/demos/Delphi_VCL/URLRequest/URLRequest.dpr
+++ b/demos/Delphi_VCL/URLRequest/URLRequest.dpr
@@ -57,7 +57,7 @@ uses
{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE}
begin
- GlobalCEFApp := TCefApplication.Create;
+ CreateGlobalCEFApp;
if GlobalCEFApp.StartMainProcess then
begin
diff --git a/demos/Delphi_VCL/URLRequest/uURLRequest.dfm b/demos/Delphi_VCL/URLRequest/uURLRequest.dfm
index 69cfe61b..c28f9029 100644
--- a/demos/Delphi_VCL/URLRequest/uURLRequest.dfm
+++ b/demos/Delphi_VCL/URLRequest/uURLRequest.dfm
@@ -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
diff --git a/demos/Delphi_VCL/URLRequest/uURLRequest.pas b/demos/Delphi_VCL/URLRequest/uURLRequest.pas
index 220fbbed..108bc737 100644
--- a/demos/Delphi_VCL/URLRequest/uURLRequest.pas
+++ b/demos/Delphi_VCL/URLRequest/uURLRequest.pas
@@ -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.
diff --git a/demos/Lazarus/PostInspectorBrowser/PostInspectorBrowser.lps b/demos/Lazarus/PostInspectorBrowser/PostInspectorBrowser.lps
index a8734ae9..9c1a8e77 100644
--- a/demos/Lazarus/PostInspectorBrowser/PostInspectorBrowser.lps
+++ b/demos/Lazarus/PostInspectorBrowser/PostInspectorBrowser.lps
@@ -4,13 +4,13 @@
-
+
-
+
@@ -22,15 +22,23 @@
-
-
-
+
+
+
+
+
+
+
+
+
+
+
-
+
@@ -46,10 +54,106 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.lfm b/demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.lfm
index 78529331..7add8bc8 100644
--- a/demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.lfm
+++ b/demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.lfm
@@ -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
diff --git a/demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.pas b/demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.pas
index 4d21274e..7988652e 100644
--- a/demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.pas
+++ b/demos/Lazarus/PostInspectorBrowser/uPostInspectorBrowser.pas
@@ -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;
diff --git a/demos/Lazarus/URLRequest/URLRequest.lpi b/demos/Lazarus/URLRequest/URLRequest.lpi
index a51f3a44..dc8603f5 100644
--- a/demos/Lazarus/URLRequest/URLRequest.lpi
+++ b/demos/Lazarus/URLRequest/URLRequest.lpi
@@ -52,12 +52,9 @@
-
-
-
-
+
diff --git a/demos/Lazarus/URLRequest/URLRequest.lps b/demos/Lazarus/URLRequest/URLRequest.lps
index 6dbb004d..e360aabb 100644
--- a/demos/Lazarus/URLRequest/URLRequest.lps
+++ b/demos/Lazarus/URLRequest/URLRequest.lps
@@ -4,12 +4,13 @@
-
+
-
-
+
+
+
@@ -20,134 +21,17 @@
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/demos/Lazarus/URLRequest/uURLRequest.lfm b/demos/Lazarus/URLRequest/uURLRequest.lfm
index 36afbac3..172ec8da 100644
--- a/demos/Lazarus/URLRequest/uURLRequest.lfm
+++ b/demos/Lazarus/URLRequest/uURLRequest.lfm
@@ -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
diff --git a/demos/Lazarus/URLRequest/uURLRequest.pas b/demos/Lazarus/URLRequest/uURLRequest.pas
index db242a55..d20aa0c2 100644
--- a/demos/Lazarus/URLRequest/uURLRequest.pas
+++ b/demos/Lazarus/URLRequest/uURLRequest.pas
@@ -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.
diff --git a/source/uCEFInterfaces.pas b/source/uCEFInterfaces.pas
index fb64d703..22855673 100644
--- a/source/uCEFInterfaces.pas
+++ b/source/uCEFInterfaces.pas
@@ -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;
diff --git a/source/uCEFMiscFunctions.pas b/source/uCEFMiscFunctions.pas
index f7d05ee1..a4187272 100644
--- a/source/uCEFMiscFunctions.pas
+++ b/source/uCEFMiscFunctions.pas
@@ -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 := '';
diff --git a/source/uCEFPostData.pas b/source/uCEFPostData.pas
index f505687e..1b7930f3 100644
--- a/source/uCEFPostData.pas
+++ b/source/uCEFPostData.pas
@@ -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;
diff --git a/source/uCEFTypes.pas b/source/uCEFTypes.pas
index ee9acf2a..4c312bcf 100644
--- a/source/uCEFTypes.pas
+++ b/source/uCEFTypes.pas
@@ -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;
diff --git a/update_CEF4Delphi.json b/update_CEF4Delphi.json
index a5ea8f74..91dc2f25 100644
--- a/update_CEF4Delphi.json
+++ b/update_CEF4Delphi.json
@@ -2,7 +2,7 @@
"UpdateLazPackages" : [
{
"ForceNotify" : true,
- "InternalVersion" : 32,
+ "InternalVersion" : 33,
"Name" : "cef4delphi_lazarus.lpk",
"Version" : "76.1.13.0"
}