You've already forked CEF4Delphi
mirror of
https://github.com/salvadordf/CEF4Delphi.git
synced 2025-06-12 22:07:39 +02:00
Bug fix #222
- 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
@ -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.
|
||||
|
||||
Reference in New Issue
Block a user