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.
Muchas gracias justo lo que buscaba 🙂
Thank you so much my friend!
Thanks, looks good.
The sample program does not work here. I get the following download error:
HR_ReadCount 543
Error during download
Any idea how to fix this?
Sorry, this post was a long time ago, no idea.
The error is 301, redirection
The original link in the program is:
http://da-software.de/daform/daform.exe
is redirected to:
https://da-software.net/daform/daform.exe
1) Change the url to https://da-software.net/daform/daform.exe
2) Remove in the project inspector all Synapse links and add links for following Synapse files:
ssl_openssl.pas
ssl_openssl_lib.pas
3) Open synapse package file: laz_synapse.lpk
Run
Minor
Progressbar doesn’t work for too high max values. Change to:
procedure TMainForm.ProgressNotification(thetext: String; CurrentProgress: integer; MaxProgress: integer);
begin
ProgressBar.Position:= round(100*CurrentProgress/maxprogress);
memoStatus.Lines.Add(thetext);
Application.ProcessMessages;
end;
And add reporting HTTP errors:
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
else
ProgressMonitor.ProgressNotification('HTTP error: '+inttostr(HTTPSender.ResultCode), bytes, MaxBytes);//report errors
finally
HTTPSender.Free;
end;
end;
For Lazarus mode in umain.pas change "text" to "thetext":
-procedure ProgressNotification(Text: String; CurrentProgress : integer; MaxProgress : integer);
+procedure ProgressNotification(theText: String; CurrentProgress : integer; MaxProgress : integer);
Sorry but one more essential comment to get https working:
Add in unit uhttpdownloader to the Uses “ssl_openss”;
uses
– Classes, SysUtils, httpsend, blcksock, typinfo;
+ Classes, SysUtils, httpsend, blcksock, typinfo, ssl_openssl ;
https is not working without it. It only aborts with error 500.
Further more for https access:
Linux usually has openssl libs pre-installed. See code of unit ssl_openssl_lib.
For Windows add libraries ssleay32.dll libeay32.dll to the project directory. They are not always available.
The openssl libraries are not always installed in Linux distributions. You can get an advisory error message using the following modification:
function THttpDownloader.DownloadHTTP(URL, TargetFile: string; ProgressMonitor : IProgress): Boolean;
var
HTTPGetResult: Boolean;
mess : string;
begin
Result := False;
Bytes:= 0;
MaxBytes:= -1;
Self.ProgressMonitor:= ProgressMonitor;
HTTPSender := THTTPSend.Create;
try
if HTTPSender.Sock.SSL.LibName=’ssl_none’ then
begin
{$IFDEF LINUX}
mess:=’. No OpenSSL libs available. Do sudo apt-get install libssl-dev’;
{$ELSE}
{$IFDEF MSWINDOWS}
mess:=’. No OpenSSL libs available. Files ssleay32.dll libeay32.dll missing.’;
{$ELSE}
mess:=’. No OpenSSL libs available.’;
{$ENDIF}
end
else
mess:=”; // SSl available
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
else
ProgressMonitor.ProgressNotification('HTTP error: '+inttostr(HTTPSender.ResultCode)+mess, bytes, MaxBytes);//report errors
finally
HTTPSender.Free;
end;
end;