Using the URL request demo source as inspiration (In fact basically a copy and paste for debugging my issue) I have tried to incorporate TCEFUrlRequestClientComponent to download images from a website.
Usage scenario is that I iterate through a JSON file of Image URL's one at a time and parse each URL to TCEFUrlRequestClientComponent to download to a Stream using the demo code.I base64 encode the stream and output to a log file.
If I click on a button on the form everything works perfectly.
BUT I need to build and parse the JSON programmatically based on other Chromium browser components on the same form. All are using the default Global chromium defaults. Now I have the problem that If I invoke this from a ChromiumTextResultAvailable event the TCEFUrlRequestClientComponent events don't seem to get fired. I get nothing in the Stream Object and the success message doesn't ever seem to get processed to set FSendingGET to false. To remove anything that I might have done I simply placed a line of code that programmatically clicks the button (that I know works manually) in the ChromiumTextResultAvailable event and it still doesn't fire the events.
I've been stuck on this for a number of days and I haven't been able to work it out. I suspect that it may have something to do with threading.
I have tried to synchronize the button click with the main thread and with the current thread but it hasn't made any difference.
Any assistance would be most welcome. I've tried to provide relevant code samples to show what I mean. I know that there's things below in the code that aren't great..... I've been trying all sorts of things, it is not representative of anything fit for production. It's just a sample to show my problem.
I use Delphi Sydney 10.4.2 on Win 10. CEF4Delphi CEF 91.1.22 This is a single form VCL app just for debugging.
Thanks John.
Code: Select all
program GetData;
{$I cef.inc}
uses
{$IFDEF DELPHI16_UP}
Vcl.Forms,
WinApi.Windows,
{$ELSE}
Forms,
Windows,
{$ENDIF }
uCEFApplication,
Main in 'Main.pas' {Form1};
{$R *.res}
// CEF3 needs to set the LARGEADDRESSAWARE flag which allows 32-bit processes to use up to 3GB of RAM.
// If you don't add this flag the rederer process will crash when you try to load large images.
{$SetPEFlags IMAGE_FILE_LARGE_ADDRESS_AWARE}
begin
ReportMemoryLeaksOnShutdown:=True;
GlobalCEFApp:= TCefApplication.Create;
GlobalCEFApp.DeleteCache := True;
GlobalCEFApp.DeleteCookies := True;
GlobalCEFApp.PersistUserPreferences :=True;
GlobalCEFApp.PersistSessionCookies :=True;
if GlobalCEFApp.StartMainProcess then
begin
Application.Initialize;
{$IFDEF DELPHI11_UP}
Application.MainFormOnTaskbar := True;
{$ENDIF}
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
DestroyGlobalCEFApp;
end.
Code: Select all
procedure TForm1.Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser;
const frame: ICefFrame; httpStatusCode: Integer);
begin
Chromium1.RetrieveHTML('');
end;
Code: Select all
procedure TForm1.Chromium1TextResultAvailable(Sender: TObject;
const aText: ustring);
begin
Button1.Click;
end;
Code: Select all
procedure TForm1.Button1Click(Sender: TObject);
Var
FileName :TFileName;
ThisElementObject :TJSONOBJECT;
ThisJSONValue :TJSONValue;
ThisJSONObject :TJSONOBJECT;
JSARR :TJSONArray;
I, X : Integer;
ThisURL, ThisStockcode :String;
ThisEncodedImage:String;
ThisJSONFile: TextFile;
begin
ThisJSONOBJECT:=nil;
ThisElementObject:=nil;
JSARR:=Nil;
ThisEncodedImage:='';
fileName := TPath.Combine(JSONPath, JSONFileName);
// Open File and read array
i:=0;
x:=0;
// DEBUG SAVE FILE SETUP FILE PARAMETERS
AssignFile(ThisJSONFile, 'C:\AA_JSONOBJECT.JSON');
ReWrite(ThisJSONFile);
try
try
ThisJSONOBJECT := TJSONObject.ParseJSONValue(TFile.ReadAllText(fileName)) AS TJSONOBJECT;
ThisJSONValue:=ThisJSONObject.GetValue('MultiProduct');
if ThisJSONValue is TJSONARRAY then JSArr:=TJSONARRAY(ThisJSONValue);
begin
x:=JSARR.Count;
for I := 0 to x-1 do
begin
ThisElementObject :=TJSONObject(JSARR[i]);
WriteLog(IntToStr(i));
ThisURL:= ThisElementObject.GetValue<String>('ImageFile');
FStockcode:=ThisElementObject.GetValue<String>('Stockcode');
ThisStockCode:=FStockCode;
WriteLog(ThisElementObject.GetValue<String>('ImageFile'));
ThisEncodedImage:=GetImages( ThisURL, ThisStockcode);
ThisElementObject.AddPair('ImageData',ThisEncodedImage);
end;
end;
except
end;
finally
//DEBUG SAVE FILE
WriteLn (ThisJSONFile,ThisJSONObject.ToJson);
Flush(ThisJSONFile);
Closefile(ThisJSONFile);
if assigned(ThisJSONOBJECT) then ThisJSONOBJECT.Free;
label1.Caption:='FINISHED';
end;
end;
Code: Select all
function TForm1.GetImages(aURL:String; aStockcode : String): String;
var
TempParts : TUrlParts;
I: word;
begin
Result:='';
FSendingPOST := False;
FSendingGET := True;
FPendingURL:=aURL;
I:=0;
//This line is CRUCIAL to Cef working as it hooks everything up to send URL request
if CefParseUrl(aURL, TempParts)=false then
begin
label1.caption:='FALSE';
Exit;
end;
// TCEFUrlRequestClientComponent.AddURLRequest will trigger the
// TCEFUrlRequestClientComponent.OnCreateURLRequest event in the right
// thread where you can create your custom requests.
CEFUrlRequestClientComponent1.AddURLRequest;
Repeat
begin
Application.ProcessMessages;
Sleep(50);
inc(i);
writelog(IntToStr(i)+ '--> '+datetimetostr(Now));
end;
Until ((FSendingGet=False) or (i > 19));
FOutputStr.Clear;
Result:= EncodeImage;
end { GetImages };
Code: Select all
//******** ENCODE IMAGE START ********************
function TForm1.EncodeImage: string;
begin
Result:='';
FMemStream.Position:=0;
FOutputStr.clear;
TNetEncoding.Base64.Encode(FMemStream,FOutputStr);
Result:=FoutputStr.DataString;
WriteLog(Result);
end;
//******** ENCODE IMAGE END********************
Code: Select all
procedure TFORM1.URLRequestSuccessMsg(var aMessage : TMessage);
var
TempMessage : string;
begin
if FSendingGET then
begin
TempMessage := 'Download complete!';
// SaveStreamToFile;
end
else
if FSendingPOST then
TempMessage := 'Parameters sent!';
FSendingGET := False;
FSendingPOST := False;
end;
procedure TForm1.SaveStreamToFile;
begin
try
FMemStream.SaveToFile(JSONPath+FStockcode+'.jpg');
FMemStream.Clear;
except
on e : exception do
if CustomExceptionHandler('TURLRequestFrm.SaveStreamToFile', e) then raise;
end;
end;
Code: Select all
//*** CEFURLREQUESTCLIENT Component DEPENDIENCIES START ***
procedure TFORM1.CreateGETRequest;
var
TempRequest : ICefRequest;
begin
try
if (length(FPendingURL) > 0) then
begin
FBusy := True;
TempRequest := TCefRequestRef.New;
TempRequest.URL := FPendingURL;
TempRequest.Method := 'GET';
TempRequest.Flags := UR_FLAG_ALLOW_STORED_CREDENTIALS;
// 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, form1.CEFUrlRequestClientComponent1.Client, nil);
end;
finally
TempRequest := nil;
end;
end;
procedure TForm1.CEFUrlRequestClientComponent1CreateURLRequest(Sender: TObject);
begin
if FSendingGET then
CreateGETRequest
else
if FSendingPOST then
//CreatePOSTRequest;
end;
procedure Tform1.CEFUrlRequestClientComponent1DownloadData(Sender: TObject; const request: ICefUrlRequest; data: Pointer; dataLength: NativeUInt);
begin
try
if FClosing then
request.Cancel
else
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;
end;
end;
procedure TForm1.CEFUrlRequestClientComponent1DownloadProgress(Sender: TObject;
const request: ICefUrlRequest; current, total: Int64);
begin
// Not Needed
end;
procedure TForm1.CEFUrlRequestClientComponent1RequestComplete(Sender: TObject;
const request: ICefUrlRequest);
begin
FBusy := False;
// Use request.response here to get a ICefResponse interface with all the response headers, status, error code, etc.
if FClosing then
begin
FCanClose := True;
PostMessage(Handle, WM_CLOSE, 0, 0);
WriteLog(Sender.ClassName);
end
else
if (request <> nil) and (request.RequestStatus = UR_SUCCESS) then
PostMessage(Handle, URLREQUEST_SUCCESS, 0, 0)
else
PostMessage(Handle, URLREQUEST_ERROR, 0, request.RequestError);
end;