FireMonkey Android NetHTTPClient OnReceiveData 無法更新畫面 |
尚未結案
|
blue
中階會員 發表:170 回覆:136 積分:81 註冊:2002-04-15 發送簡訊給我 |
Hi,各位先進大家好:
小弟想用NetHTTPClient 來做 HTTP 檔案下載, 為了取得下載進度,在OnReceiveData先寫下 TThread.Synchronize(nil, procedure begin LblInfo.Text := IntToStr(AReadCount); Application.ProcessMessages; end); 如此,在Windows平台的運作是正常, 可以在Android上,只要OnReceiveData有指定Even,即便一進入馬上exit, 程式就完全不會有回應, 不知是何原因? 謝謝! |
blue
中階會員 發表:170 回覆:136 積分:81 註冊:2002-04-15 發送簡訊給我 |
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
中階會員 發表:170 回覆:136 積分:81 註冊:2002-04-15 發送簡訊給我 |
貼上都會漏字
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 發送簡訊給我 |
|
blue
中階會員 發表:170 回覆:136 積分:81 註冊:2002-04-15 發送簡訊給我 |
Hi, 感謝 pcplayer99 大大指導:
使用 TIdHTTP 狀況好一點,不會Hung住,但只在下載結束後畫面才更新, 使用TNetHttpClient 的原因是之前用 TIdHTTP 在處理 WebDAV Digit 認證有問題, 謝謝! ===================引 用 pcplayer99 文 章=================== 你试试用 TIdHTTP 这个 Indy 的元件。 |
本站聲明 |
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇! |