Recent

Author Topic: HTTP Get to reusme download  (Read 2740 times)

Zaher

  • Hero Member
  • *****
  • Posts: 683
    • parmaja.org
HTTP Get to reusme download
« on: January 05, 2021, 01:45:38 pm »
Any one know httpget that support resume file to download big file, and resume it if disconnected?
also should support ssl.

thank you

Warfley

  • Hero Member
  • *****
  • Posts: 1688
Re: HTTP Get to reusme download
« Reply #1 on: January 05, 2021, 02:22:23 pm »
I haven't build it myself, but in theory all you need to do is to set the range header in a request: https://www.wikiwand.com/en/List_of_HTTP_header_fields#/range-request-header

Quote
Range:
Request only part of an entity.  Bytes are numbered from 0.  See Byte serving
Code: [Select]
Range: bytes=500-999

balazsszekely

  • Guest
Re: HTTP Get to reusme download
« Reply #2 on: January 07, 2021, 01:28:48 pm »
@Zaher

Quote
Any one know httpget that support resume file to download big file, and resume it if disconnected?
also should support ssl.
What you are asking is not trivial. Using @Warfley suggestion, I created a small demo application(see attachment), hopefully it will be useful. Feel free to improve it.
In the attached example the following file is downloaded: https://packages.lazarus-ide.org/RESTDataware.zip(~28 MB). As a quick test cancel the download, restart the application then press the download button again. I tested with Lazarus Trunk(32)/FPC 3.2.0 on Win10 and Linux Mint. For windows you will need the ssl libraries, you can download from here:
   32 bit: https://packages.lazarus-ide.org/openssl-1.0.2j-i386-win32.zip
   64 bit: https://packages.lazarus-ide.org/openssl-1.0.2j-x64_86-win64.zip

Code: Pascal  [Select][+][-]
  1. unit uDownload;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, fphttpclient, opensslsockets;
  9.  
  10. type
  11.   { TDownloadStream }
  12.   TOnWriteStream = procedure(Sender: TObject; APos: Int64) of object;
  13.   TDownloadStream = class(TStream)
  14.   private
  15.     FOnWriteStream: TOnWriteStream;
  16.     FStream: TStream;
  17.   public
  18.     constructor Create(AStream: TStream);
  19.     destructor Destroy; override;
  20.     function Read(var Buffer; Count: LongInt): LongInt; override;
  21.     function Write(const Buffer; Count: LongInt): LongInt; override;
  22.     function Seek(Offset: LongInt; Origin: Word): LongInt; override;
  23.     procedure DoProgress;
  24.   published
  25.     property OnWriteStream: TOnWriteStream read FOnWriteStream write FOnWriteStream;
  26.   end;
  27.  
  28.   {TDownload}
  29.   TOnDownloadProgress = procedure(Sender: TObject; AFrom, ATo: String; APos, ASize, AElapsed, ARemaining, ASpeed: LongInt) of object;
  30.   TOnDownloadError = procedure(Sender: TObject; const AErrMsg: String = '') of object;
  31.   TOnDownloadCompleted = TNotifyEvent;
  32.   TDownload = class(TThread)
  33.   private
  34.     FMS: TMemoryStream;
  35.     FFPHTTPClient: TFPHTTPClient;
  36.     FURL: String;
  37.     FLocalFile: String;
  38.     FRemaining: Integer;
  39.     FSpeed: Integer;
  40.     FStartTime: QWord;
  41.     FElapsed: QWord;
  42.     FTick: Qword;
  43.     FPos: Int64;
  44.     FSize: Int64;
  45.     FErrMsg: String;
  46.     FOnDownloadProgress: TOnDownloadProgress;
  47.     FOnDownloadError: TOnDownloadError;
  48.     FOnDownloadCompleted: TOnDownloadCompleted;
  49.     procedure GetContentLength;
  50.     function FixProtocol(const AURL: String): String;
  51.     procedure DoOnDataReceived(Sender: TObject; const ContentLength, {%H-}CurrentPos: int64);
  52.     procedure DoOnWriteStream(Sender: TObject; APos: Int64);
  53.     procedure DoOnDownloadProgress;
  54.     procedure DoOnDownloadError;
  55.     procedure DoOnDownloadCompleted;
  56.   protected
  57.     procedure Execute; override;
  58.   public
  59.     constructor Create;
  60.     destructor Destroy; override;
  61.     procedure DownloadFile(const AURL, ALocalFile: String);
  62.     procedure CancelDownoad;
  63.   public
  64.     property OnDownloadProgress: TOnDownloadProgress read FOnDownloadProgress write FOnDownloadProgress;
  65.     property OnDownloadError: TOnDownloadError read FOnDownloadError write FOnDownloadError;
  66.     property OnDownloadCompleted: TOnDownloadCompleted read FOnDownloadCompleted write FOnDownloadCompleted;
  67.   end;
  68.  
  69. implementation
  70.  
  71. { TDownloadStream }
  72. constructor TDownloadStream.Create(AStream: TStream);
  73. begin
  74.   inherited Create;
  75.   FStream := AStream;
  76.   FStream.Position := 0;
  77. end;
  78.  
  79. destructor TDownloadStream.Destroy;
  80. begin
  81.   FStream.Free;
  82.   inherited Destroy;
  83. end;
  84.  
  85. function TDownloadStream.Read(var Buffer; Count: LongInt): LongInt;
  86. begin
  87.   Result := FStream.Read(Buffer, Count);
  88. end;
  89.  
  90. function TDownloadStream.Write(const Buffer; Count: LongInt): LongInt;
  91. begin
  92.   Result := FStream.Write(Buffer, Count);
  93.   DoProgress;
  94. end;
  95.  
  96. function TDownloadStream.Seek(Offset: LongInt; Origin: Word): LongInt;
  97. begin
  98.   Result := FStream.Seek(Offset, Origin);
  99. end;
  100.  
  101. procedure TDownloadStream.DoProgress;
  102. begin
  103.   if Assigned(FOnWriteStream) then
  104.     FOnWriteStream(Self, Self.Position);
  105. end;
  106.  
  107. {TDownload}
  108. constructor TDownload.Create;
  109. begin
  110.   inherited Create(True);
  111.   FreeOnTerminate := True;
  112.   FMS := TMemoryStream.Create;
  113.   FFPHTTPClient := TFPHTTPClient.Create(nil);
  114. end;
  115.  
  116. destructor TDownload.Destroy;
  117. begin
  118.   FFPHTTPClient.Free;
  119.   FMS.Free;
  120.   inherited Destroy;
  121. end;
  122.  
  123. procedure TDownload.DownloadFile(const AURL, ALocalFile: String);
  124. begin
  125.   FURL := FixProtocol(AURL);
  126.   FLocalFile := ALocalFile;
  127.   Self.Start;
  128. end;
  129.  
  130. procedure TDownload.CancelDownoad;
  131. begin
  132.   if Assigned(FFPHTTPClient) then
  133.     FFPHTTPClient.Terminate;
  134. end;
  135.  
  136. procedure TDownload.DoOnDataReceived(Sender: TObject; const ContentLength,
  137.   CurrentPos: int64);
  138. begin
  139.   if ContentLength > 0 then
  140.     Abort;
  141. end;
  142.  
  143. procedure TDownload.DoOnWriteStream(Sender: TObject; APos: Int64);
  144. begin
  145.   FElapsed := GetTickCount64 - FStartTime;
  146.   if FElapsed < 1000 then
  147.     Exit;
  148.   FElapsed := FElapsed div 1000;
  149.   FPos := APos;
  150.   FSpeed := Round(FPos/FElapsed);
  151.   if FSpeed > 0 then
  152.     FRemaining := Round((FSize - FPos)/FSpeed);
  153.   if FElapsed >= FTick + 1 then
  154.   begin
  155.     FTick := FElapsed;
  156.     Synchronize(@DoOnDownloadProgress);
  157.   end;
  158. end;
  159.  
  160. procedure TDownload.DoOnDownloadProgress;
  161. begin
  162.   if Assigned(FOnDownloadProgress) then
  163.     FOnDownloadProgress(Self, FURL, FLocalFile, FPos, FSize, FElapsed, FRemaining, FSpeed);
  164. end;
  165.  
  166. procedure TDownload.DoOnDownloadError;
  167. begin
  168.   if Assigned(FOnDownloadError) then
  169.     FOnDownloadError(Self, FErrMsg);
  170. end;
  171.  
  172. procedure TDownload.DoOnDownloadCompleted;
  173. begin
  174.   if Assigned(FOnDownloadCompleted) then
  175.     FOnDownloadCompleted(Self);
  176. end;
  177.  
  178. procedure TDownload.GetContentLength;
  179. var
  180.   SS: TStringStream;
  181.   HttpClient: TFPHTTPClient;
  182.   URL: String;
  183. begin
  184.   FSize := 0;
  185.   SS := TStringStream.Create('');
  186.   try
  187.     URL := FixProtocol(FURL);
  188.     HttpClient := TFPHTTPClient.Create(nil);
  189.     try
  190.       HttpClient.OnDataReceived := @DoOnDataReceived;
  191.       HttpClient.AllowRedirect := True;
  192.       HttpClient.ResponseHeaders.NameValueSeparator := ':';
  193.       try
  194.         HttpClient.HTTPMethod('GET', URL, SS, []);
  195.       except
  196.       end;
  197.       if HttpClient.ResponseStatusCode = 200 then
  198.         FSize := StrToIntDef(HttpClient.ResponseHeaders.Values['CONTENT-LENGTH'], 0)
  199.     finally
  200.       HttpClient.Free;
  201.     end;
  202.   finally
  203.     SS.Free
  204.   end;
  205. end;
  206.  
  207. function TDownload.FixProtocol(const AURL: String): String;
  208. begin
  209.   Result := AURL;
  210.   if (Pos('http://', Result) = 0) and (Pos('https://', Result) = 0) then
  211.     Result := 'https://' + Result;
  212. end;
  213.  
  214. procedure TDownload.Execute;
  215. var
  216.   DS: TDownloadStream;
  217.   Flags: Word;
  218. begin
  219.   FStartTime := GetTickCount64;
  220.   GetContentLength;
  221.   Flags := fmOpenWrite;
  222.   if not FileExists(FLocalFile) then
  223.   begin
  224.     FPos := 0;
  225.     Flags := Flags or fmCreate;
  226.   end
  227.   else
  228.     FPos := FileUtil.FileSize(FLocalFile);
  229.  
  230.   DS := TDownloadStream.Create(TFileStream.Create(FLocalFile, Flags));
  231.   try
  232.     DS.FOnWriteStream := @DoOnWriteStream;
  233.     try
  234.       if (FPos > 0) and (FPos < FSize) then
  235.       begin
  236.         DS.Position := FPos;
  237.         FFPHTTPClient.AddHeader('Range', 'bytes=' + IntToStr(FPos) + '-'  + IntToStr(FSize));
  238.       end;
  239.       FFPHTTPClient.AddHeader('User-Agent','Mozilla/5.0 (compatible; fpweb)');
  240.       FFPHTTPClient.AllowRedirect := True;
  241.       FFPHTTPClient.HTTPMethod('GET', FURL, DS, [200, 206]);
  242.       if not FFPHTTPClient.Terminated then
  243.       begin
  244.         Synchronize(@DoOnDownloadProgress);
  245.         Synchronize(@DoOnDownloadCompleted);
  246.       end;
  247.     except
  248.       on E: Exception do
  249.       begin
  250.         FErrMsg := E.Message;
  251.         Synchronize(@DoOnDownloadError);
  252.       end;
  253.     end;
  254.   finally
  255.     DS.Free
  256.   end;
  257. end;
  258.  
  259. end.
  260.  

Zaher

  • Hero Member
  • *****
  • Posts: 683
    • parmaja.org
Re: HTTP Get to reusme download
« Reply #3 on: February 03, 2021, 08:30:30 pm »
Thank you @GetMem
the most important line for is
Code: [Select]
FFPHTTPClient.HTTPMethod('GET', FURL, DS, [200, 206]);

trev

  • Global Moderator
  • Hero Member
  • *****
  • Posts: 2032
  • Former Delphi 1-7, 10.2 user
Re: HTTP Get to reusme download
« Reply #4 on: February 04, 2021, 07:03:30 am »
@GetMem - example tested OK on macOS aarch64 too :)

 

TinyPortal © 2005-2018