Download with progress using Lazarus and Synapse

Veröffentlicht von

The Synapse library provides a lot of TCP/IP functions for use in Delphi and Lazarus.

I needed to download something from a HTTP server. The basic download is very simple:

HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
if (HTTPSender.ResultCode >= 100) and (HTTPSender.ResultCode<=299) then begin
   HTTPSender.Document.SaveToFile(TargetFile);

While this code works, it is blocking and there is no information on the progress, nor any information how big the file is, which is downloaded.

So I started by implementing a class around the download function:

type
  { THttpDownloader }

  THttpDownloader = class
  public
    function DownloadHTTP(URL, TargetFile: string; ProgressMonitor : IProgress): Boolean;
  private
    Bytes : Integer;
    MaxBytes : Integer;
    HTTPSender: THTTPSend;
    ProgressMonitor : IProgress;
    procedure Status(Sender: TObject; Reason: THookSocketReason; const Value: String);
    function GetSizeFromHeader(Header: String):integer;
  end; 

I also defined an interface to get the UI notified about the progress:

type
  IProgress = interface
    procedure ProgressNotification(Text: String; CurrentProgress : integer; MaxProgress : integer);
  end;  

The download code from above moves to the "DownloadHTTP" function:

function THttpDownloader.DownloadHTTP(URL, TargetFile: string; ProgressMonitor : IProgress): Boolean;
var
  HTTPGetResult: Boolean;
begin
  Result := False;
  Bytes:= 0;
  MaxBytes:= -1;
  Self.ProgressMonitor:= ProgressMonitor;

  HTTPSender := THTTPSend.Create;
  try
    HTTPSender.Sock.OnStatus:= Status;
    HTTPGetResult := HTTPSender.HTTPMethod('GET', URL);
    if (HTTPSender.ResultCode >= 100) and (HTTPSender.ResultCode<=299) then begin
      HTTPSender.Document.SaveToFile(TargetFile);
      Result := True;
    end;
  finally
    HTTPSender.Free;
  end;
end;

To get updates on the progress we need to implement a callback function, which we assign in the line HTTPSender.Sock.OnStatus:= Status;.

This function looks like that:

procedure THttpDownloader.Status(Sender: TObject; Reason: THookSocketReason; const Value: String);
var
  V, currentHeader: String;
  i: integer;
begin
  //try to get filesize from headers
  if (MaxBytes = -1) then
  begin
    for i:= 0 to HTTPSender.Headers.Count - 1 do
    begin
      currentHeader:= HTTPSender.Headers[i];
      MaxBytes:= GetSizeFromHeader(currentHeader);
      if MaxBytes <> -1 then break;
    end;
  end;

  V := GetEnumName(TypeInfo(THookSocketReason), Integer(Reason)) + ' ' + Value;

  if Reason = THookSocketReason.HR_ReadCount then
  begin
    Bytes:= Bytes + StrToInt(Value);
    ProgressMonitor.ProgressNotification(V, Bytes, MaxBytes);
  end;
end;   

function THttpDownloader.GetSizeFromHeader(Header: String): integer;
var
  item : TStringList;
begin
  Result:= -1;

  if Pos('Content-Length:', Header) <> 0 then
  begin
    item:= TStringList.Create();
    item.Delimiter:= ':';
    item.StrictDelimiter:=true;
    item.DelimitedText:=Header;
    if item.Count = 2 then
    begin
      Result:= StrToInt(Trim(item[1]));
    end;
  end;
end;     

What are we doing here?

First of all we look into the headers to get the file size. We have to wait and check if the header is there. The first events do not contain the Content-Length: information.

Once found, we extract that information. There are several events popping up here, which you can react to. But we only check for THookSocketReason.HR_ReadCount in that example.

"HR_ReadCount" provides us with the information how many bytes where read since the last event.

The progress is then reported to the UI:

procedure TMainForm.ProgressNotification(Text: String; CurrentProgress: integer; MaxProgress: integer);
begin
  if (MaxProgress <> -1) then ProgressBar.Max:= MaxProgress;
  ProgressBar.Position:= CurrentProgress;
  memoStatus.Lines.Add(Text);
  Application.ProcessMessages;
end;

Well thats it! The complete source code can be downloaded here.

2 Kommentare

Kommentar hinterlassen

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert.