[SOLVED] How to abort downloading a file from internet in a clean way?
lazarus / 38-Networking and Web Programming

----------------------------------------------------------------------
Hartmut · 2022-01-08 12:55

I use the following code to download files:

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i uses
sysutils,     fphttpclient,     openssl,{$IF FPC_FULLVERSION < 30200} 
   fpopenssl,     ssockets,     sslsockets;{$ELSE}   
 opensslsockets;{$ENDIF} function
download_file_with_progress(url,fspec: string;                       
            DataReceivedEvent: TDataEvent): string;   {downloads a
file from URL 'url' into filespec 'fspec';    I: DataReceivedEvent:
progress procedure to call whenever data is read;    O: result: '' =
OK / otherwise the Error-MSG}   var Client: TFPHTTPClient;       se:
string;   begin{$IF FPC_FULLVERSION < 30200} 
 InitSSLInterface;{$ENDIF}   Client:=TFPHTTPClient.Create(nil); 
 Client.AllowRedirect:=true; {allow redirections}   se:=''; {no error
until now}    try      try       
 Client.OnDataReceived:=@DataReceivedEvent; {to call when data is
read}         Client.Get(url, fspec); {does the download}      except 
       on E:Exception do  se:=E.Message;      end;   finally     
Client.Free;   end;   exit(se);   end; procedure
TMyClass.DataReceivedEvent(Sender: TObject; const ContentLength,     
                              CurrentPos: int64);   {progress
procedure to be called whenever data is read}   begin   // display
progress and detect request for abort...   end;
It can happen that the user decides to abort the download (of a big
file). I can detect this request in procedure DataReceivedEvent(). But
what must I do for a "clean" abort? Would a "Client.Free;" in the
middle of the download be OK and enough? Or must I "close the
connection" before or something like that? I'm a bloody beginner to
that internet and networking stuff...

I use FPC 3.0.4 on Linux Ubuntu 18.04. Thanks in advance.

----------------------------------------------------------------------
balazsszekely · 2022-01-08 13:13

@Hartmut

QuoteIt can happen that the user decides to abort the download (of a
big file). I can detect this request in procedure DataReceivedEvent().
But what must I do for a "clean" abort? Would a "Client.Free;" in the
middle of the download be OK and enough? Or must I "close the
connection" before or something like that? I'm a bloody beginner to
that internet and networking stuff...In order for your application to
become more responsive, move the download part to a worker thread.
When you wish to cancel the download, call the Client.Terminate
method, which was designed exactly for a clean abort. Something like
this:
Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
uDownload; {$mode objfpc}{$H+} interface uses  Classes, SysUtils,
FileUtil, fphttpclient, opensslsockets; type  TOnWriteStream =
procedure(Sender: TObject; APos: Int64) of object;  TDownloadStream =
class(TStream)  private    FOnWriteStream: TOnWriteStream;    FStream:
TStream;  public    constructor Create(AStream: TStream);   
destructor Destroy; override;    function Read(var Buffer; Count:
LongInt): LongInt; override;    function Write(const Buffer; Count:
LongInt): LongInt; override;    function Seek(Offset: LongInt; Origin:
Word): LongInt; override;    procedure DoProgress;  published   
property OnWriteStream: TOnWriteStream read FOnWriteStream write
FOnWriteStream;  end;   TOnDownloadProgress = procedure(Sender:
TObject; AFrom, ATo: String; APos, ASize, AElapsed, ARemaining,
ASpeed: LongInt) of object;  TOnDownloadError = procedure(Sender:
TObject; const AErrMsg: String = '') of object;  TOnDownloadCompleted
= TNotifyEvent;  TDownload = class(TThread)  private    FMS:
TMemoryStream;    FFPHTTPClient: TFPHTTPClient;    FURL: String;   
FLocalFile: String;    FRemaining: Integer;    FSpeed: Integer;   
FStartTime: QWord;    FElapsed: QWord;    FTick: Qword;    FPos:
Int64;    FSize: Int64;    FErrMsg: String;    FOnDownloadProgress:
TOnDownloadProgress;    FOnDownloadError: TOnDownloadError;   
FOnDownloadCompleted: TOnDownloadCompleted;    procedure
GetContentLength;    function FixProtocol(const AURL: String):
String;    procedure DoOnDataReceived(Sender: TObject; const
ContentLength, {%H-}CurrentPos: int64);    procedure
DoOnWriteStream(Sender: TObject; APos: Int64);    procedure
DoOnDownloadProgress;    procedure DoOnDownloadError;    procedure
DoOnDownloadCompleted;  protected    procedure Execute; override; 
public    constructor Create;    destructor Destroy; override;   
procedure DownloadFile(const AURL, ALocalFile: String);    procedure
CancelDownoad;  public    property OnDownloadProgress:
TOnDownloadProgress read FOnDownloadProgress write
FOnDownloadProgress;    property OnDownloadError: TOnDownloadError
read FOnDownloadError write FOnDownloadError;    property
OnDownloadCompleted: TOnDownloadCompleted read FOnDownloadCompleted
write FOnDownloadCompleted;  end; implementation constructor
TDownloadStream.Create(AStream: TStream);begin  inherited Create; 
FStream := AStream;  FStream.Position := 0;end; destructor
TDownloadStream.Destroy;begin  FStream.Free;  inherited
Destroy;end; function TDownloadStream.Read(var Buffer; Count:
LongInt): LongInt;begin  Result := FStream.Read(Buffer,
Count);end; function TDownloadStream.Write(const Buffer; Count:
LongInt): LongInt;begin  Result := FStream.Write(Buffer, Count); 
DoProgress;end; function TDownloadStream.Seek(Offset: LongInt; Origin:
Word): LongInt;begin  Result := FStream.Seek(Offset,
Origin);end; procedure TDownloadStream.DoProgress;begin  if
Assigned(FOnWriteStream) then    FOnWriteStream(Self,
Self.Position);end; constructor TDownload.Create;begin  inherited
Create(True);  FreeOnTerminate := True;  FMS := TMemoryStream.Create; 
FFPHTTPClient := TFPHTTPClient.Create(nil);end; destructor
TDownload.Destroy;begin  FFPHTTPClient.Free;  FMS.Free;  inherited
Destroy;end; procedure TDownload.DownloadFile(const AURL, ALocalFile:
String);begin  FURL := FixProtocol(AURL);  FLocalFile := ALocalFile; 
Self.Start;end; procedure TDownload.CancelDownoad;begin  if
Assigned(FFPHTTPClient) then    FFPHTTPClient.Terminate;end; procedure
TDownload.DoOnDataReceived(Sender: TObject; const ContentLength, 
CurrentPos: int64);begin  if ContentLength > 0 then   
Abort;end; procedure TDownload.DoOnWriteStream(Sender: TObject; APos:
Int64);begin  FElapsed := GetTickCount64 - FStartTime;  if FElapsed <
1000 then    Exit;  FElapsed := FElapsed div 1000;  FPos := APos; 
FSpeed := Round(FPos/FElapsed);  if FSpeed > 0 then    FRemaining :=
Round((FSize - FPos)/FSpeed);  if FElapsed >= FTick + 1 then  begin  
FTick := FElapsed;    Synchronize(@DoOnDownloadProgress); 
end;end; procedure TDownload.DoOnDownloadProgress;begin  if
Assigned(FOnDownloadProgress) then    FOnDownloadProgress(Self, FURL,
FLocalFile, FPos, FSize, FElapsed, FRemaining, FSpeed);end; procedure
TDownload.DoOnDownloadError;begin  if Assigned(FOnDownloadError) then 
  FOnDownloadError(Self, FErrMsg);end; procedure
TDownload.DoOnDownloadCompleted;begin  if
Assigned(FOnDownloadCompleted) then   
FOnDownloadCompleted(Self);end; procedure
TDownload.GetContentLength;var  SS: TStringStream;  HttpClient:
TFPHTTPClient;  URL: String;begin  FSize := 0;  SS :=
TStringStream.Create('');  try    URL := FixProtocol(FURL);   
HttpClient := TFPHTTPClient.Create(nil);    try     
HttpClient.OnDataReceived := @DoOnDataReceived;     
HttpClient.AllowRedirect := True;     
HttpClient.ResponseHeaders.NameValueSeparator := ':';      try       
HttpClient.HTTPMethod('GET', URL, SS, []);      except      end;     
if HttpClient.ResponseStatusCode = 200 then        FSize :=
StrToIntDef(HttpClient.ResponseHeaders.Values['CONTENT-LENGTH'], 0)  
finally      HttpClient.Free;    end;  finally    SS.Free 
end;end; function TDownload.FixProtocol(const AURL: String):
String;begin  Result := AURL;  if (Pos('http://', Result) = 0) and
(Pos('https://', Result) = 0) then    Result := 'https://' +
Result;end; procedure TDownload.Execute;var  DS: TDownloadStream; 
Flags: Word;begin  FStartTime := GetTickCount64;  GetContentLength; 
Flags := fmOpenWrite;  if not FileExists(FLocalFile) then  begin   
FPos := 0;    Flags := Flags or fmCreate;  end  else    FPos :=
FileUtil.FileSize(FLocalFile);   DS :=
TDownloadStream.Create(TFileStream.Create(FLocalFile, Flags));  try  
DS.FOnWriteStream := @DoOnWriteStream;    try      if (FPos > 0) and
(FPos < FSize) then      begin        DS.Position := FPos;       
FFPHTTPClient.AddHeader('Range', 'bytes=' + IntToStr(FPos) + '-'  +
IntToStr(FSize));      end;      FFPHTTPClient.AddHeader('User-
Agent','Mozilla/5.0 (compatible; fpweb)');     
FFPHTTPClient.AllowRedirect := True;     
FFPHTTPClient.HTTPMethod('GET', FURL, DS, [200, 206]);      if not
FFPHTTPClient.Terminated then      begin       
Synchronize(@DoOnDownloadProgress);       
Synchronize(@DoOnDownloadCompleted);      end;    except      on E:
Exception do      begin        FErrMsg := E.Message;       
Synchronize(@DoOnDownloadError);      end;    end;  finally   
DS.Free  end;end; end. 
The good part is that the attached project is capable of resuming
aborted downloads. Please give it a try. On windows you need the ssl
libraries(ssleay32.dll, libeay32.dll). You can download them from the
OPM repository.

----------------------------------------------------------------------
Hartmut · 2022-01-08 15:17

Hello GetMem again, that you very much for your quick reply. Your Unit
is very hard stuff for me as a beginner for that subject. I had a
deeper look at it and compiled your attached demo which is very
impressive. I had to delete Unit 'opensslsockets' from the uses list,
because I'm in FPC 3.0.4 where this Unit does not exist (but it worked
fine without it).

Currently I'm working on version 0.9 of a larger project. For this
time I will stay with my small function, because everything around it
is finished and I have added "Client.Terminate" to abort, which works
exactly what I needed. But when I work on version 2.0 I will come back
to your Unit and it's features. Thanks again.