Delphi — загрузка файла с прогрессом с помощью Synapse

Я уже некоторое время использую Synapse, в основном для отправки электронных писем. Сегодня я создаю простой установщик и пытаюсь загрузить исполняемый файл приложения через HTTP. Размер файла составляет около 9 МБ, поэтому я хотел бы добавить статус выполнения для пользователя, но я не понимаю примеры, которые я нашел. Вот что я получил до сих пор:

type
  THookSocketStatus = Procedure(Sender: TObject; Reason: THookSocketReason; const Value: String) of Object;
  CallBack = class
    Class Procedure Status(Sender: TObject; Reason: THookSocketReason; const Value: String);
  end;


Class Procedure CallBack.Status(Sender: TObject; Reason: THookSocketReason; const Value: String);
var
  V: String;
Begin
  V := GetEnumName(TypeInfo(THookSocketReason), Integer(Reason)) + ' ' + Value;
  Form1.mem1.Lines.Add(V);
  application.ProcessMessages;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  HTTP: THTTPSend;
  MSTM: TMemoryStream;
begin
  Screen.Cursor := crHourGlass;
  HTTP := THTTPSend.Create;
  MSTM := TMemoryStream.Create;
  Try
    Try
      HTTP.Sock.OnStatus := CallBack.Status;
      If HTTP.HTTPMethod('GET', edt1.Text) Then
      Begin
        MSTM.Seek(0, soFromBeginning);
        MSTM.CopyFrom(HTTP.Document, 0);
        MSTM.SaveToFile(ExtractFilePath(Application.ExeName) + 'test.exe');
      end;
    Except
    end;
  Finally
    MSTM.Free;
    HTTP.Free;
    Screen.Cursor := crDefault;
  end;
end;

В этом простом тесте я получил такой результат:

HR_SocketClose
HR_ResolvingBegin www.website.com:80
HR_ResolvingEnd 176.102.295.18:80
HR_SocketCreate IPv4
HR_Connect www.website.com:80
HR_WriteCount 158
HR_CanRead
HR_ReadCount 288
HR_CanRead
HR_ReadCount 8192
HR_ReadCount 8192
HR_ReadCount 8192
HR_ReadCount 6720
HR_CanRead
HR_ReadCount 3299
.
.
.
HR_ReadCount 8192
HR_ReadCount 8192
HR_ReadCount 7828
HR_SocketClose
HR_SocketClose

Пожалуйста, что значит WriteCount и ReadCount? Как я могу получить общий размер файла, чтобы установить индикатор выполнения перед началом загрузки?

Спасибо вам, ребята!


download http delphi synapse
person Guybrush    schedule 02.05.2013    source источник
comment
Я предполагаю количество прочитанных или записанных байтов. Если содержимое не является текстом, вы должны иметь доступ к заголовкам, возвращенным из вашего запроса GET, и искать длину содержимого, как в Content-Length: 3495, и получать общий размер файла. К сожалению, я никогда не использовал Synapse, поэтому я не могу дать больше рекомендаций, чем это.   -  person Glenn1234    schedule 03.05.2013
comment
Привет @ Glenn1234, спасибо. Я постараюсь получить больше информации о том, как получить заголовок GET.   -  person Guybrush    schedule 03.05.2013
comment
Ну, я отказался от попыток сделать это с Synapse. Я снова использую Indy, это намного проще сделать. В любом случае, спасибо!   -  person Guybrush    schedule 03.05.2013

Ответы (1)


arrow_upward
2
arrow_downward

У меня была та же проблема, и я нашел решение, расширив приведенный выше код. Длина файла была доступна, как предложено выше, с использованием информации заголовка.

Вот мой код:

unit uhttpdownloader;


{$mode Delphi}{$H+}

interface

uses
  Classes, SysUtils, httpsend, blcksock, typinfo;

//Interface for notifications about the progress
type
  IProgress = interface
    procedure ProgressNotification(Text: String; CurrentProgress : integer; MaxProgress : integer);
  end;

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;

implementation

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
    //add callback function for status updates
    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;

//Callback function for status events
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;

  //HR_ReadCount contains the number of bytes since the last event
  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
  //the download size is contained in the header (e.g.: Content-Length: 3737722)
  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;
end.

Полный исходный код и пример также можно загрузить здесь: http://andydunkel.net/lazarus/delphi/2015/09/09/lazarus_synapse_progress.html

Энди

person DA.    schedule 10.09.2015