Recent

Author Topic: Simple https download to file  (Read 845 times)

QuinnMartin

  • New Member
  • *
  • Posts: 27
Simple https download to file
« on: August 19, 2022, 07:34:41 pm »
Does anyone have an example of simple Lazarus code that downloads a single file from https to disk while updating a progress bar, plus having the option to click to cancel?  Downloading from an ftp:// URL would be nice but it's not important.

Also is this code cross-compatible or is it tied to a specific OS?

Leledumbo

  • Hero Member
  • *****
  • Posts: 8746
  • Programming + Glam Metal + Tae Kwon Do = Me
Re: Simple https download to file
« Reply #1 on: August 19, 2022, 11:12:25 pm »

HeavyUser

  • Sr. Member
  • ****
  • Posts: 397
Re: Simple https download to file
« Reply #2 on: August 20, 2022, 12:23:28 am »
online package manager in the IDE does that successfully for both http and https you should take a look on its source code.

QuinnMartin

  • New Member
  • *
  • Posts: 27
Re: Simple https download to file
« Reply #3 on: August 20, 2022, 05:17:42 am »
Thanks for the replies.  I will give the progress bar test project a look.

Nicole

  • Hero Member
  • *****
  • Posts: 970
Re: Simple https download to file
« Reply #4 on: August 20, 2022, 09:28:46 am »
Here is a working project, which was generously done for our community:
It downloads a pdf-file and converts it into a TMemo.
Sure, it can download no-pdfs as well. Would make the thing easier.

Progress bar and abort? Not in there.
But if you view the code, you may find lines to hook in.

https://forum.lazarus.freepascal.org/index.php/topic,60292.msg450492.html#msg450492

dje

  • Full Member
  • ***
  • Posts: 134
Re: Simple https download to file
« Reply #5 on: August 20, 2022, 03:34:42 pm »
This is about as small as I can get a threaded Http downloader with progress and cancel. Just under 200 lines. It supports downloading to file stream of your choice. It shows how to "proxy" a stream in order to obtain progress information. There are other ways, including inheriting from a chosen stream type, but then that limits usage. I think I have handled all the thread/gui synchronizing issues correctly. Hope its helpful.

Usage:
Code: Pascal  [Select][+][-]
  1.   try
  2.     ShowHttpDownloader('Downloading Pascal Book',
  3.       'https://archive.org/download/the-byte-book-of-pascal/TheByteBookOfPascal.pdf',
  4.       Application.Location + 'TheByteBookOfPascal.pdf');
  5.     ShowMessage('Download Complete');
  6.   except
  7.     on E: Exception do ShowMessage(E.Message);
  8.   end;  

Edit: Added redirection, fixed correct content positon counter, and fixed percentage for large files.

Code: Pascal  [Select][+][-]
  1. unit HttpDownloader;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   ButtonPanel, Classes, ComCtrls, Controls, Dialogs, ExtCtrls, Forms, fphttpclient, opensslsockets, StdCtrls, SysUtils;
  9.  
  10. procedure ShowHttpDownloader(const ACaption, AURL: string; AStream: TStream);
  11. procedure ShowHttpDownloader(const ACaption, AURL, AFileName: string);
  12.  
  13. implementation
  14.  
  15. type
  16.  
  17.   THttpDownloader = class(TForm)
  18.   private
  19.     FPanel: TPanel;
  20.     FProgressBar: TProgressBar;
  21.     FRaiseError: string;
  22.   public
  23.     constructor Create(AOwner: TComponent); override;
  24.   end;
  25.  
  26. type
  27.  
  28.   THttpDownloaderThread = class(TThread)
  29.   private
  30.     FURL: string;
  31.     FContentLength, FContentPosition: int64;
  32.     FUserStream: TStream;
  33.     FHttpClient: TFPHTTPClient;
  34.     FHttpDownloader: THttpDownloader;
  35.   public
  36.     constructor Create(AHttpForm: THttpDownloader; const AURL: string; AUserStream: TStream);
  37.   protected
  38.     procedure Execute; override;
  39.     procedure SynchronizedClose;
  40.     procedure SynchronizedWrite;
  41.   end;
  42.  
  43. type
  44.  
  45.   THttpDownloaderStreamProxy = class(TStream)
  46.   strict private
  47.     FThread: THttpDownloaderThread;
  48.     FStream: TStream;
  49.   public
  50.     constructor Create(AThread: THttpDownloaderThread; AStream: TStream);
  51.   public
  52.     function Write(const ABuffer; ACount: longint): longint; override;
  53.   end;
  54.  
  55. constructor THttpDownloaderStreamProxy.Create(AThread: THttpDownloaderThread; AStream: TStream);
  56. begin
  57.   inherited Create;
  58.   FThread := AThread;
  59.   FStream := AStream;
  60. end;
  61.  
  62. function THttpDownloaderStreamProxy.Write(const ABuffer; ACount: longint): longint;
  63. begin
  64.   Inc(FThread.FContentPosition, ACount);
  65.   if FThread.CheckTerminated then begin
  66.     raise Exception.Create('Download terminated by user');
  67.   end;
  68.   Result := FStream.Write(ABuffer, ACount);
  69.   FThread.Synchronize(@FThread.SynchronizedWrite);
  70. end;
  71.  
  72. constructor THttpDownloaderThread.Create(AHttpForm: THttpDownloader; const AURL: string; AUserStream: TStream);
  73. begin
  74.   FHttpDownloader := AHttpForm;
  75.   FURL := AURL;
  76.   FUserStream := AUserStream;
  77.   inherited Create(False);
  78. end;
  79.  
  80. procedure THttpDownloaderThread.SynchronizedClose;
  81. begin
  82.   FHttpDownloader.Close;
  83. end;
  84.  
  85. procedure THttpDownloaderThread.SynchronizedWrite;
  86. begin
  87.   if FHttpDownloader.FProgressBar.Style = pbstMarquee then begin
  88.     FHttpDownloader.FProgressBar.Style := pbstNormal;
  89.     FContentLength := StrToIntDef(FHttpClient.ResponseHeaders.Values['content-length'], 0);
  90.     FHttpDownloader.FProgressBar.Max := FContentLength;
  91.     FHttpDownloader.FProgressBar.Visible := FContentLength > 0;
  92.   end;
  93.   if FHttpDownloader.FProgressBar.Visible then begin
  94.     FHttpDownloader.FPanel.Caption :=
  95.       Format('Download @ %d%% (%d of %d bytes)', [FContentPosition * 100 div FContentLength, FContentPosition, FContentLength]);
  96.     FHttpDownloader.FProgressBar.Position := FContentPosition;
  97.   end else begin
  98.     FHttpDownloader.FPanel.Caption := Format('Downloaded %d bytes', [FContentPosition]);
  99.   end;
  100. end;
  101.  
  102. procedure THttpDownloaderThread.Execute;
  103. var
  104.   LStream: TStream;
  105. begin
  106.   try
  107.     try
  108.       LStream := THttpDownloaderStreamProxy.Create(Self, FUserStream);
  109.       try
  110.         FHttpClient := TFPHTTPClient.Create(nil);
  111.         try
  112.           FHttpClient.AllowRedirect := True;
  113.           FHttpClient.Get(FURL, LStream);
  114.         finally
  115.           FreeAndNil(FHttpClient);
  116.         end;
  117.       finally
  118.         FreeAndNil(LStream);
  119.       end;
  120.     except
  121.       on LException: Exception do begin
  122.         FHttpDownloader.FRaiseError := LException.Message;
  123.       end;
  124.     end;
  125.   finally
  126.     Synchronize(@SynchronizedClose);
  127.   end;
  128. end;
  129.  
  130. constructor THttpDownloader.Create(AOwner: TComponent);
  131. begin
  132.   inherited CreateNew(AOwner);
  133.   Width := 512;
  134.   Height := 128;
  135.   BorderStyle := bsDialog;
  136.   Position := poScreenCenter;
  137.   ChildSizing.TopBottomSpacing := 4;
  138.   ChildSizing.VerticalSpacing := 4;
  139.   ChildSizing.LeftRightSpacing := 4;
  140.   ChildSizing.HorizontalSpacing := 4;
  141.   FProgressBar := TProgressBar.Create(Self);
  142.   FProgressBar.Style := pbstMarquee;
  143.   FProgressBar.Smooth := True;
  144.   FProgressBar.Align := alBottom;
  145.   FProgressBar.Parent := Self;
  146.   with TButtonPanel.Create(Self) do begin
  147.     ShowBevel := False;
  148.     ShowButtons := [pbCancel];
  149.     BorderSpacing.Around := 0;
  150.     Align := alBottom;
  151.     Parent := Self;
  152.   end;
  153.   FPanel := TPanel.Create(Self);
  154.   FPanel.Caption := 'Waiting for connection';
  155.   FPanel.BorderStyle := bsSingle;
  156.   FPanel.BevelOuter := bvNone;
  157.   FPanel.Align := alClient;
  158.   FPanel.Parent := Self;
  159. end;
  160.  
  161. procedure ShowHttpDownloader(const ACaption, AURL: string; AStream: TStream);
  162. var
  163.   LHttpForm: THttpDownloader;
  164. begin
  165.   LHttpForm := THttpDownloader.Create(Application);
  166.   try
  167.     LHttpForm.Caption := ACaption;
  168.     with THttpDownloaderThread.Create(LHttpForm, AURL, AStream) do begin
  169.       try
  170.         LHttpForm.ShowModal;
  171.         Terminate;
  172.         WaitFor;
  173.       finally
  174.         Free;
  175.       end;
  176.     end;
  177.     if LHttpForm.FRaiseError <> EmptyStr then begin
  178.       raise Exception.Create(LHttpForm.FRaiseError);
  179.     end;
  180.   finally
  181.     FreeAndNil(LHttpForm);
  182.   end;
  183. end;
  184.  
  185. procedure ShowHttpDownloader(const ACaption, AURL, AFileName: string);
  186. var
  187.   LStream: TStream;
  188. begin
  189.   LStream := TFileStream.Create(AFileName, fmCreate);
  190.   try
  191.     ShowHttpDownloader(ACaption, AURL, LStream);
  192.   finally
  193.     FreeAndNil(LStream);
  194.   end;
  195. end;
  196.  
  197. end.
« Last Edit: August 20, 2022, 04:24:12 pm by derek.john.evans »

 

TinyPortal © 2005-2018