線上訂房服務-台灣趴趴狗聯合訂房中心
發文 回覆 瀏覽次數:2234
推到 Plurk!
推到 Facebook!

FireMonkey Android NetHTTPClient OnReceiveData 無法更新畫面

尚未結案
blue
中階會員


發表:169
回覆:136
積分:81
註冊:2002-04-15

發送簡訊給我
#1 引用回覆 回覆 發表時間:2019-08-20 11:56:24 IP:125.227.xxx.xxx 未訂閱
Hi,各位先進大家好:
小弟想用NetHTTPClient 來做 HTTP 檔案下載,
為了取得下載進度,在OnReceiveData先寫下
TThread.Synchronize(nil,
procedure
begin
LblInfo.Text := IntToStr(AReadCount);
Application.ProcessMessages;
end);
如此,在Windows平台的運作是正常,
可以在Android上,只要OnReceiveData有指定Even,即便一進入馬上exit,
程式就完全不會有回應,
不知是何原因?
謝謝!
blue
中階會員


發表:169
回覆:136
積分:81
註冊:2002-04-15

發送簡訊給我
#2 引用回覆 回覆 發表時間:2019-08-20 17:49:32 IP:125.227.xxx.xxx 未訂閱
Sorry,有點打字錯誤:
Hi,各位先進大家好:
小弟想用NetHTTPClient 來做 HTTP 檔案下載,
為了取得下載進度,在 OnReceiveData even中
TThread.Synchronize(nil,
procedure
begin
LblInfo.Text := IntToStr(AReadCount);
Application.ProcessMessages;
end);
如此,在Windows平台的運作是正常,
可是在Android上,只要OnReceiveData有指定Even,即便一進入馬上exit,
程式就完全不會有回應,
不知是何原因?
謝謝!
附上原始程式
unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
System.Math,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
System.Net.URLClient, System.Net.HttpClient, System.Net.HttpClientComponent,
FMX.StdCtrls, FMX.Controls.Presentation, FMX.Edit;

type
TForm1 = class(TForm)
txtSrcUrl: TEdit;
Label1: TLabel;
btnDownload: TButton;
btnCancel: TButton;
LblInfo: TLabel;
ProgressBar: TProgressBar;
txtDestFile: TEdit;
btnSospendi: TButton;
HTTPClient: TNetHTTPClient;
procedure btnDownloadClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure HTTPClientReceiveData(const Sender: TObject; AContentLength,
AReadCount: Int64; var Abort: Boolean);
private
FTimeStart: cardinal;
FCancelDownload: boolean;
FStartPosition: Int64;
FEndPosition: Int64;
FContentLength: Int64;

function Download(const ASrcUrl : string; const ADestFileName : string): Boolean;
public
{ Public declarations }
property CancelDownload : boolean read FCancelDownload write FCancelDownload;
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

function TForm1.Download(const ASrcUrl : string; const ADestFileName : string): Boolean;
// -----------------------------------------------------------------------------
// Download a file from ASrcUrl and store to ADestFileName
var
aResponse: IHTTPResponse;
aFileStream: TFileStream;
aTempFilename: string;
aAcceptRanges: boolean;
aTempFilenameExists: boolean;
begin
Result := false;
FEndPosition := -1;
FStartPosition := -1;
FContentLength := -1;


aResponse := nil;
aFileStream := nil;
try
// raise an exception if the file already exists on ADestFileName
if FileExists(ADestFileName) then
raise Exception.Create(Format('the file %s alredy exists', [ADestFileName]));


// reset the CancelDownload property
CancelDownload := false;


// set the time start of the download
FTimeStart := TThread.GetTickCount;


// until the download is incomplete the ADestFileName has *.parts extension
aTempFilename := ADestFileName '.parts';


// get the header from the server for aSrcUrl
aResponse := HTTPClient.Head(aSrcUrl);


// checks if the response StatusCode is 2XX (aka OK)
if (aResponse.StatusCode < 200) or (aResponse.StatusCode > 299) then
raise Exception.Create(Format('Server error %d: %s', [aResponse.StatusCode, aResponse.StatusText]));


// checks if the server accept bytes ranges
aAcceptRanges := SameText(aResponse.HeaderValue['Accept-Ranges'], 'bytes');


// get the content length (aka FileSize)
FContentLength := aResponse.ContentLength;


// checks if a "partial" download already exists
aTempFilenameExists := FileExists(aTempFilename);


// if a "partial" download already exists
if aTempFilenameExists then
begin
// re-utilize the same file stream, with position on the end of the stream
aFileStream := TFileStream.Create(aTempFilename, fmOpenWrite or fmShareDenyNone);
aFileStream.Seek(0, TSeekOrigin.soEnd);
end else begin
// create a new file stream, with the position on the beginning of the stream
aFileStream := TFileStream.Create(aTempFilename, fmCreate);
aFileStream.Seek(0, TSeekOrigin.soBeginning);
end;


// if the server doesn't accept bytes ranges, always start to write at beginning of the stream
if not(aAcceptRanges) then
aFileStream.Seek(0, TSeekOrigin.soBeginning);


// set the range of the request (from the stream position to server content length)
FStartPosition := aFileStream.Position;
FEndPosition := FContentLength;


// if the range is incomplete (the FStartPosition is less than FEndPosition)
if (FEndPosition > 0) and (FStartPosition < FEndPosition) then
begin
// ... and if a starting point is present
if FStartPosition > 0 then
begin
// makes a bytes range request from FStartPosition to FEndPosition
aResponse := HTTPClient.GetRange(aSrcUrl, FStartPosition, FEndPosition, aFileStream);
end else begin
// makes a canonical GET request
aResponse := HTTPClient.Get(aSrcUrl, aFileStream);
end;


// check if the response StatusCode is 2XX (aka OK)
if (aResponse.StatusCode < 200) or (aResponse.StatusCode > 299) then
raise Exception.Create(Format('Server error %d: %s', [aResponse.StatusCode, aResponse.StatusText]));
end;


// if the FileStream.Size is equal to server ContentLength, the download is completed!
if (aFileStream.Size > 0) and (aFileStream.Size = FContentLength) then begin


// free the FileStream otherwise doesn't renames the "partial file" into the DestFileName
FreeAndNil(aFileStream);


// renames the aTempFilename file into the ADestFileName
Result := RenameFile(aTempFilename, ADestFileName);


// What?
if not(Result) then
raise Exception.Create(Format('RenameFile from %s to %s: %s', [aTempFilename, ADestFileName, SysErrorMessage(GetLastError)]));
end;
finally
if aFileStream <> nil then aFileStream.Free;
aResponse := nil;
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
// initialize the class variables
FCancelDownload := false;
FEndPosition := -1;
FStartPosition := -1;
FContentLength := -1;
end;

procedure TForm1.HTTPClientReceiveData(const Sender: TObject; AContentLength,
AReadCount: Int64; var Abort: Boolean);
begin
exit;
TThread.Synchronize(nil,
procedure
begin
LblInfo.Text := IntToStr(AReadCount);
Application.ProcessMessages;
end);
end;

procedure TForm1.btnDownloadClick(Sender: TObject);
var
TBegin, TEnd: TDateTime;
begin
try
try
DeleteFile(txtDestFile.Text);
TBegin := Now;
if Download(txtSrcUrl.Text, txtDestFile.Text) then begin
TEnd := Now;
ShowMessage('File downloaded!');
end;
except on E : Exception do
ShowMessage(E.Message);
end;
finally
end;

end;

end.
blue
中階會員


發表:169
回覆:136
積分:81
註冊:2002-04-15

發送簡訊給我
#3 引用回覆 回覆 發表時間:2019-08-20 17:51:13 IP:125.227.xxx.xxx 未訂閱
貼上都會漏字


unit Unit1;

interface

uses
System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
System.Math,
FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
System.Net.URLClient, System.Net.HttpClient, System.Net.HttpClientComponent,
FMX.StdCtrls, FMX.Controls.Presentation, FMX.Edit;

type
TForm1 = class(TForm)
txtSrcUrl: TEdit;
Label1: TLabel;
btnDownload: TButton;
btnCancel: TButton;
LblInfo: TLabel;
ProgressBar: TProgressBar;
txtDestFile: TEdit;
btnSospendi: TButton;
HTTPClient: TNetHTTPClient;
procedure btnDownloadClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure HTTPClientReceiveData(const Sender: TObject; AContentLength,
AReadCount: Int64; var Abort: Boolean);
private
FTimeStart: cardinal;
FCancelDownload: boolean;
FStartPosition: Int64;
FEndPosition: Int64;
FContentLength: Int64;

function Download(const ASrcUrl : string; const ADestFileName : string): Boolean;
public
{ Public declarations }
property CancelDownload : boolean read FCancelDownload write FCancelDownload;
end;

var
Form1: TForm1;

implementation

{$R *.fmx}

function TForm1.Download(const ASrcUrl : string; const ADestFileName : string): Boolean;
// -----------------------------------------------------------------------------
// Download a file from ASrcUrl and store to ADestFileName
var
aResponse: IHTTPResponse;
aFileStream: TFileStream;
aTempFilename: string;
aAcceptRanges: boolean;
aTempFilenameExists: boolean;
begin
Result := false;
FEndPosition := -1;
FStartPosition := -1;
FContentLength := -1;


aResponse := nil;
aFileStream := nil;
try
// raise an exception if the file already exists on ADestFileName
if FileExists(ADestFileName) then
raise Exception.Create(Format('the file %s alredy exists', [ADestFileName]));


// reset the CancelDownload property
CancelDownload := false;


// set the time start of the download
FTimeStart := TThread.GetTickCount;


// until the download is incomplete the ADestFileName has *.parts extension
aTempFilename := ADestFileName '.parts';


// get the header from the server for aSrcUrl
aResponse := HTTPClient.Head(aSrcUrl);


// checks if the response StatusCode is 2XX (aka OK)
if (aResponse.StatusCode < 200) or (aResponse.StatusCode > 299) then
raise Exception.Create(Format('Server error %d: %s', [aResponse.StatusCode, aResponse.StatusText]));


// checks if the server accept bytes ranges
aAcceptRanges := SameText(aResponse.HeaderValue['Accept-Ranges'], 'bytes');


// get the content length (aka FileSize)
FContentLength := aResponse.ContentLength;


// checks if a "partial" download already exists
aTempFilenameExists := FileExists(aTempFilename);


// if a "partial" download already exists
if aTempFilenameExists then
begin
// re-utilize the same file stream, with position on the end of the stream
aFileStream := TFileStream.Create(aTempFilename, fmOpenWrite or fmShareDenyNone);
aFileStream.Seek(0, TSeekOrigin.soEnd);
end else begin
// create a new file stream, with the position on the beginning of the stream
aFileStream := TFileStream.Create(aTempFilename, fmCreate);
aFileStream.Seek(0, TSeekOrigin.soBeginning);
end;


// if the server doesn't accept bytes ranges, always start to write at beginning of the stream
if not(aAcceptRanges) then
aFileStream.Seek(0, TSeekOrigin.soBeginning);


// set the range of the request (from the stream position to server content length)
FStartPosition := aFileStream.Position;
FEndPosition := FContentLength;


// if the range is incomplete (the FStartPosition is less than FEndPosition)
if (FEndPosition > 0) and (FStartPosition < FEndPosition) then
begin
// ... and if a starting point is present
if FStartPosition > 0 then
begin
// makes a bytes range request from FStartPosition to FEndPosition
aResponse := HTTPClient.GetRange(aSrcUrl, FStartPosition, FEndPosition, aFileStream);
end else begin
// makes a canonical GET request
aResponse := HTTPClient.Get(aSrcUrl, aFileStream);
end;


// check if the response StatusCode is 2XX (aka OK)
if (aResponse.StatusCode < 200) or (aResponse.StatusCode > 299) then
raise Exception.Create(Format('Server error %d: %s', [aResponse.StatusCode, aResponse.StatusText]));
end;


// if the FileStream.Size is equal to server ContentLength, the download is completed!
if (aFileStream.Size > 0) and (aFileStream.Size = FContentLength) then begin


// free the FileStream otherwise doesn't renames the "partial file" into the DestFileName
FreeAndNil(aFileStream);


// renames the aTempFilename file into the ADestFileName
Result := RenameFile(aTempFilename, ADestFileName);


// What?
if not(Result) then
raise Exception.Create(Format('RenameFile from %s to %s: %s', [aTempFilename, ADestFileName, SysErrorMessage(GetLastError)]));
end;
finally
if aFileStream <> nil then aFileStream.Free;
aResponse := nil;
end;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
// initialize the class variables
FCancelDownload := false;
FEndPosition := -1;
FStartPosition := -1;
FContentLength := -1;
end;

procedure TForm1.HTTPClientReceiveData(const Sender: TObject; AContentLength,
AReadCount: Int64; var Abort: Boolean);
begin
exit;
TThread.Synchronize(nil,
procedure
begin
LblInfo.Text := IntToStr(AReadCount);
Application.ProcessMessages;
end);
end;

procedure TForm1.btnDownloadClick(Sender: TObject);
var
TBegin, TEnd: TDateTime;
begin
try
try
DeleteFile(txtDestFile.Text);
TBegin := Now;
if Download(txtSrcUrl.Text, txtDestFile.Text) then begin
TEnd := Now;
ShowMessage('File downloaded!');
end;
except on E : Exception do
ShowMessage(E.Message);
end;
finally
end;

end;

end.
pcplayer99
尊榮會員


發表:146
回覆:790
積分:632
註冊:2003-01-21

發送簡訊給我
#4 引用回覆 回覆 發表時間:2019-09-05 22:21:44 IP:183.17.xxx.xxx 未訂閱
你试试用 TIdHTTP 这个 Indy 的元件。
blue
中階會員


發表:169
回覆:136
積分:81
註冊:2002-04-15

發送簡訊給我
#5 引用回覆 回覆 發表時間:2019-09-18 09:53:58 IP:125.227.xxx.xxx 未訂閱
Hi, 感謝 pcplayer99 大大指導:
使用 TIdHTTP 狀況好一點,不會Hung住,但只在下載結束後畫面才更新,
使用TNetHttpClient 的原因是之前用 TIdHTTP 在處理 WebDAV Digit 認證有問題,
謝謝!
===================引 用 pcplayer99 文 章===================
你试试用 TIdHTTP 这个 Indy 的元件。
系統時間:2024-04-28 5:54:11
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!