Merge pull request #116 from wqmeng/master

Force Unicode data stream to be received until the complete file to a…
This commit is contained in:
Salvador Díaz Fau 2018-05-24 18:23:27 +02:00 committed by GitHub
commit f68312a1a6
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23

View File

@ -10,7 +10,7 @@
// For more information about CEF4Delphi visit : // For more information about CEF4Delphi visit :
// https://www.briskbard.com/index.php?lang=en&pageid=cef // https://www.briskbard.com/index.php?lang=en&pageid=cef
// //
// Copyright © 2018 Salvador Diaz Fau. All rights reserved. // Copyright ?2018 Salvador Diaz Fau. All rights reserved.
// //
// ************************************************************************ // ************************************************************************
// ************ vvvv Original license and comments below vvvv ************* // ************ vvvv Original license and comments below vvvv *************
@ -93,6 +93,8 @@ type
FStreamCS : TCriticalSection; // Critical section used to protect the memory stream FStreamCS : TCriticalSection; // Critical section used to protect the memory stream
FRscSize : int64; // size of the resource if the server sends the Content-Length header FRscSize : int64; // size of the resource if the server sends the Content-Length header
FRscCompleted : boolean; // This variable will be used to handle the results only once. FRscCompleted : boolean; // This variable will be used to handle the results only once.
FRscEncoding : TEncoding; // The resource response Encoding. When encoding is unicode. The response data may be sent by multi chains, will cause encoding parsing problem.
FRscMimeType : String;
// Variables to control when can we destroy the form safely // Variables to control when can we destroy the form safely
FCanClose : boolean; // Set to True in TChromium.OnBeforeClose FCanClose : boolean; // Set to True in TChromium.OnBeforeClose
FClosing : boolean; // Set to True in the CloseQuery event. FClosing : boolean; // Set to True in the CloseQuery event.
@ -108,6 +110,7 @@ type
procedure Filter_OnFilter(Sender: TObject; data_in: Pointer; data_in_size: NativeUInt; var data_in_read: NativeUInt; data_out: Pointer; data_out_size : NativeUInt; var data_out_written: NativeUInt; var aResult : TCefResponseFilterStatus); procedure Filter_OnFilter(Sender: TObject; data_in: Pointer; data_in_size: NativeUInt; var data_in_read: NativeUInt; data_out: Pointer; data_out_size : NativeUInt; var data_out_written: NativeUInt; var aResult : TCefResponseFilterStatus);
function IsMyResource(const aRequest : ICefRequest) : boolean; function IsMyResource(const aRequest : ICefRequest) : boolean;
procedure GetResponseEncoding(const aContentType: string);
public public
{ Public declarations } { Public declarations }
end; end;
@ -161,7 +164,8 @@ begin
data_out_written := 0; data_out_written := 0;
aResult := RESPONSE_FILTER_DONE; aResult := RESPONSE_FILTER_DONE;
if not(FRscCompleted) then if not(FRscCompleted) and (FStream.Size > 0) and
((FRscSize = -1) or (FRscSize = FStream.Size)) then
FRscCompleted := PostMessage(Handle, STREAM_COPY_COMPLETE, 0, 0); FRscCompleted := PostMessage(Handle, STREAM_COPY_COMPLETE, 0, 0);
end end
else else
@ -227,6 +231,7 @@ begin
FStream := TMemoryStream.Create; FStream := TMemoryStream.Create;
FStreamCS := TCriticalSection.Create; FStreamCS := TCriticalSection.Create;
FFilter := TCustomResponseFilter.Create; FFilter := TCustomResponseFilter.Create;
FRscEncoding := TEncoding.Default;
FCanClose := False; FCanClose := False;
FClosing := False; FClosing := False;
@ -300,6 +305,15 @@ begin
FRscSize := TempLen FRscSize := TempLen
else else
FRscSize := -1; FRscSize := -1;
FRscMimeType := response.MimeType;
if (response.MimeType = 'application/json') or
(response.MimeType = 'text/json') or
(response.MimeType = 'text/javascript') or
(response.MimeType = 'application/javascript') then
begin
GetResponseEncoding(response.GetHeader('Content-Type'));
end;
end end
else else
Result := nil; Result := nil;
@ -317,8 +331,18 @@ begin
// and CEF didn't send a data_in = nil in Filter_OnFilter // and CEF didn't send a data_in = nil in Filter_OnFilter
// we still can use this event to know when the resource is complete // we still can use this event to know when the resource is complete
if not(FRscCompleted) and IsMyResource(request) then if not(FRscCompleted) and IsMyResource(request) then
begin
FRscMimeType := response.MimeType;
if (response.MimeType = 'application/json')
or (response.MimeType = 'text/json')
or (response.MimeType = 'text/javascript')
or (response.MimeType = 'application/javascript')
then begin
GetResponseEncoding(response.GetHeader('Content-Type'));
end;
FRscCompleted := PostMessage(Handle, STREAM_COPY_COMPLETE, 0, 0); FRscCompleted := PostMessage(Handle, STREAM_COPY_COMPLETE, 0, 0);
end; end;
end;
procedure TResponseFilterBrowserFrm.BrowserCreatedMsg(var aMessage : TMessage); procedure TResponseFilterBrowserFrm.BrowserCreatedMsg(var aMessage : TMessage);
begin begin
@ -334,6 +358,9 @@ end;
// This procedure handles the stream contents after it's fully downloaded // This procedure handles the stream contents after it's fully downloaded
procedure TResponseFilterBrowserFrm.StreamCopyCompleteMsg(var aMessage : TMessage); procedure TResponseFilterBrowserFrm.StreamCopyCompleteMsg(var aMessage : TMessage);
var
LAS: AnsiString;
LS: String;
begin begin
try try
FStreamCS.Acquire; FStreamCS.Acquire;
@ -343,15 +370,34 @@ begin
FStream.Seek(0, soBeginning); FStream.Seek(0, soBeginning);
Memo1.Lines.Clear; Memo1.Lines.Clear;
if (FRscMimeType = 'application/json') or (FRscMimeType = 'text/json') or
(FRscMimeType = 'text/javascript') or
(FRscMimeType = 'application/javascript') then
begin
SetLength(LAS, FStream.Size);
FStream.Read(LAS[Low(LAS)], FStream.Size);
if FRscEncoding = TEncoding.UTF8 then
begin
// UTF8 Here
LS := UTF8Decode(LAS);
end
else
begin
// Others encoding text
LS := string(LAS);
end;
Memo1.Lines.Add(LS);
end
else
// Image or others
Memo1.Lines.LoadFromStream(FStream); Memo1.Lines.LoadFromStream(FStream);
FStream.Clear; FStream.Clear;
FRscSize := -1;
FRscCompleted := False;
end end
else else
Memo1.Lines.Clear; Memo1.Lines.Clear;
FRscSize := -1;
FRscCompleted := False;
finally finally
FStreamCS.Release; FStreamCS.Release;
end; end;
@ -397,4 +443,104 @@ begin
if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := False; if (aMessage.wParam = 0) and (GlobalCEFApp <> nil) then GlobalCEFApp.OsmodalLoop := False;
end; end;
procedure TResponseFilterBrowserFrm.GetResponseEncoding
(const aContentType: string);
var
LEncoding: String;
begin
{
(Name: 'Latin-US (DOS)'; CodePage: 437),
(Name: 'Western (DOS Latin 1)'; CodePage: 850),
(Name: 'Thai (Windows, DOS)'; CodePage: 874),
(Name: 'Japanese (Windows, DOS)'; CodePage: 932),
(Name: 'Simplified Chinese (Windows, DOS)'; CodePage: 936),
(Name: 'Korean (Windows, DOS)'; CodePage: 949),
(Name: 'Traditional Chinese (Windows, DOS)'; CodePage: 950),
(Name: 'Unicode (UTF-16)'; CodePage: 1200),
(Name: 'Unicode (UTF-16LE)'; CodePage: 1200),
(Name: 'Unicode (UTF-16BE)'; CodePage: 1201),
(Name: 'Central European (Windows Latin 2)'; CodePage: 1250),
(Name: 'Cyrillic (Windows)'; CodePage: 1251),
(Name: 'Western (Windows Latin 1)'; CodePage: 1252),
(Name: 'Greek (Windows)'; CodePage: 1253),
(Name: 'Turkish (Windows Latin 5)'; CodePage: 1254),
(Name: 'Hebrew (Windows)'; CodePage: 1255),
(Name: 'Arabic (Windows)'; CodePage: 1256),
(Name: 'Baltic (Windows)'; CodePage: 1257),
(Name: 'Vietnamese (Windows)'; CodePage: 1258),
(Name: 'Western (ASCII)'; CodePage: 20127),
(Name: 'Unicode (UTF-7)'; CodePage: CP_UTF7),
(Name: 'Unicode (UTF-8)'; CodePage: CP_UTF8),
// Windows code pages...
(Name: 'Windows-1252'; CodePage: 1252),
(Name: 'US-ASCII'; CodePage: 20127),
(Name: 'UTF-7'; CodePage: CP_UTF7),
(Name: 'UTF-8'; CodePage: CP_UTF8),
(Name: 'UTF-16'; CodePage: 1200),
(Name: 'UTF-16BE'; CodePage: 1201),
(Name: 'UTF-16LE'; CodePage: 1200),
(Name: 'SHIFT-JIS'; CodePage: 932),
(Name: 'ISO-8859-1'; CodePage: 28591),
(Name: 'iso-8859-1'; CodePage: 28591),
(Name: 'MACCROATIAN'; CodePage: 10082),
(Name: 'ASCII'; CodePage: 20127),
(Name: ''; CodePage: 0)
}
LEncoding := Trim(Copy(UpperCase(aContentType), Pos('CHARSET=',
UpperCase(aContentType)) + Length('CHARSET='), MaxInt));
if LEncoding = 'ANSI' then
begin
FRscEncoding := TEncoding.ANSI;
end
else if LEncoding = 'ASCII' then
begin
FRscEncoding := TEncoding.ASCII;
end
else if LEncoding = 'UTF-8' then
begin
FRscEncoding := TEncoding.UTF8;
end
else if LEncoding = 'UTF-7' then
begin
FRscEncoding := TEncoding.UTF7;
end
else if LEncoding = 'UTF-16' then
begin
FRscEncoding := TEncoding.Unicode;
end
else if LEncoding = 'UNICODEFFFE' then
begin
FRscEncoding := TEncoding.GetEncoding(1201);
end
else if LEncoding = 'UNICODE' then
begin
FRscEncoding := TEncoding.Unicode;
end
else if LEncoding = 'GB2312' then
begin
FRscEncoding := TEncoding.GetEncoding(936);
end
else if LEncoding = 'GBK' then
begin
FRscEncoding := TEncoding.GetEncoding(936);
end
else if LEncoding = 'GB18030' then
begin
FRscEncoding := TEncoding.GetEncoding(54936);
end
else if LEncoding = 'ISO-8859-1' then
begin
FRscEncoding := TEncoding.GetEncoding(28591);
end
else if LEncoding = 'BIG5' then
begin
FRscEncoding := TEncoding.GetEncoding(950);
end
else
begin
FRscEncoding := TEncoding.Default;
end;
end;
end. end.