Модераторы: Snowy, Poseidon, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> WinAPI Проблемы со скачиванием файлов из интернета, тормозит, зависает, пердит, греется 
:(
    Опции темы
RAIN666
Дата 26.3.2019, 12:05 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 15.2.2019

Репутация: нет
Всего: нет



Здравствуйте.
Нужно скачать много маленьких файлов, попутно объединяя их в один большой файл.
Написал код:
Код

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes,
  Vcl.Graphics, vcl.Controls, Vcl.Forms, Vcl.Dialogs, Winapi.WinInet;

type
  TEventWorkStart = procedure (Sender : TObject; iFileSize : UInt64) of object;
  TEventWork = procedure (Sender : TObject; iBytesTransfered : Int64) of object;
  TEventWorkEnd = procedure (Sender : TObject; iBytesTransfered : Int64;
                             ErrorCode : Integer) of object;

  TWinApiDownload = class(TObject)
    private
      fEventWorkStart : TEventWorkStart;
      fEventWork : TEventWork;
      fEventWorkEnd : TEventWorkEnd;
    public
      FileNameOutput : string;
      URL : string;
      fUserAgent : string;
      fStop : Boolean;
      fProgressUpdateInterval : Cardinal;
      constructor Create;
      destructor Destroy; override;
      function Download(Stream : TStream) : Integer;
      procedure Stop;
      procedure Clear;
      property UserAgent : string read fUserAgent write fUserAgent;
      property OnWorkStart : TEventWorkStart read fEventWorkStart write fEventWorkStart;
      property OnWork : TEventWork read fEventWork write fEventWork;
      property OnWorkEnd : TEventWorkEnd read fEventWorkEnd write fEventWorkEnd;
  end;

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    procedure DownloadWorkStart(Sender : TObject; iFileSize : UInt64);
    procedure DownloadWork(Sender : TObject; iBytesTransfered : Int64);
    procedure DownloadWorkEnd(Sender : TObject; iBytesTransfered : Int64;
                              ErrorCode : Integer);
  public
    { Public declarations }
  end;

const
  DOWNLOAD_ERROR_UNKNOWN = -1;
  DOWNLOAD_ABORTED_BY_USER = -2;

var
  Form1: TForm1;

implementation

{$R *.dfm}

constructor TWinApiDownload.Create;
begin
  inherited;
  fUserAgent := 'Mozilla/5.001 (windows; U; NT4.0; en-US; rv:1.0) Gecko/25250101';
  fProgressUpdateInterval := 100;
end;

destructor TWinApiDownload.Destroy;
begin
  Stop;
  inherited;
end;

function TWinApiDownload.Download(Stream : TStream) : Integer;
var
  hInet    : HINTERNET;
  hUrl : HINTERNET;
  buf : array [0..1023 * 3] of Byte;
  lpdwNumberOfBytesAvailable : DWORD;
  dwBufferLen, dwIndex : DWORD;
  pSize, pErrorCode : array [0..255] of Char;
  b, _pos, iter : Cardinal;
  transfered : Int64;
begin
  Result := DOWNLOAD_ERROR_UNKNOWN;
  fStop := False;

  hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG,
                        nil, nil, 0);
  if Assigned(hInet) then
  begin
    hUrl := InternetOpenUrl(hInet, PChar(URL), nil, 0,0,0);
    if Assigned(hUrl) then
    begin
      dwIndex := 0;
      dwBufferLen := 20;
      HttpQueryInfo(hUrl, HTTP_QUERY_STATUS_CODE, @pErrorCode, dwBufferLen, dwIndex);
      Result := StrToInt(pErrorCode);
      if Result <> 200 then
      begin
        InternetCloseHandle(hUrl);
        InternetCloseHandle(hInet);
        Exit;
      end;
      dwIndex := 0;
      dwBufferLen := 20;
      if HttpQueryInfo(hUrl, HTTP_QUERY_CONTENT_LENGTH, @pSize,
                             dwBufferLen, dwIndex) then
//      begin
        if Assigned(OnWorkStart) then
        OnWorkStart(Self, StrToInt(pSize));
//      end;
      _Pos := 1;
      iter := 0;
      transfered := 0;
      repeat
        if InternetQueryDataAvailable(hUrl,
                              lpdwNumberOfBytesAvailable, 0, 0) then
        begin
          if lpdwNumberOfBytesAvailable > 0 then
          begin
            if InternetReadFile(hUrl, @buf, SizeOf(buf), b) then
            begin
              transfered := transfered + b;
              Stream.WriteBuffer(buf, b);
              if Assigned(OnWork) then
              begin
                inc(iter);
                if iter >= fProgressUpdateInterval then
                begin
                  OnWork(Self, transfered);
                  iter := 0;
                end;
              end;
            end;
          end;
        end;
      until (lpdwNumberOfBytesAvailable = 0) or (b = 0) or (fStop);
      if fStop then
      Result := DOWNLOAD_ABORTED_BY_USER;
      if Assigned(fEventWorkEnd) then
      OnWorkEnd(Self, transfered, Result);
      InternetCloseHandle(hUrl);
    end;
    InternetCloseHandle(hInet);
  end;
end;

procedure TWinApiDownload.Stop;
begin
  fStop := True;
end;

procedure TForm1.FormCreate(Sender: TObject);
const
  MyURL = 'https://vod-secure.twitch.tv/35062d653e0f40c2b455_miramisu_33375945456_1154634538/chunked/';
var
  i, c : Integer;
  d : TWinApiDownload;
  stream : TStream; //эта переменная должна быть глобальной, но для примера не важно
begin
  stream := TFileStream.Create('D:\test.ts', fmCreate or fmOpenReadWrite);
  d := TWinApiDownload.Create;
  d.OnWorkStart := DownloadWorkStart;
  d.OnWork := DownloadWork;
  d.OnWorkEnd := DownloadWorkEnd;
  for I := 50 to 300 do
  begin
    d.URL := MyURL + IntToStr(i) + '.ts';
    c := d.Download(stream);
    if c <> 200 then
    Break;
  end;
  stream.Free;
  d.Free;
end;

procedure TForm1.DownloadWorkStart(Sender: TObject; iFileSize: UInt64);
begin
  //скачивание начато
end;

procedure TForm1.DownloadWork(Sender: TObject; iBytesTransfered: Int64);
begin
  {
  .....
  обновляем индикаторы скачивания
  iBytesTransfered - количество скачанных байт текущего файла
  .....
  }
  Application.ProcessMessages;
end;

procedure TForm1.DownloadWorkEnd(Sender: TObject;
                  iBytesTransfered: Int64; ErrorCode: Integer);
begin
  //скачивание завершено
end;

end.

Это работает, но есть проблемы.
Во-первых: иногда скачивание просто застревает. Иногда на пару секунд, иногда на минуту и более, а иногда вообще навсегда. Если оно застряло и возобновлилось, то иногда теряется несколько килобайт или мегабайт. А иногда не теряется. Если скачать один файл несколько раз, то размер, зачастую, получается разный. По-этому, приходится скачивать один файл несколько раз, выбирать те, у которых одинаковый размер, потом сравнивать их хэш. Если хэш сошёлся хотя-бы у двух файлов - файл считается успешно скачанным. Разумеется, это делается пользователем (мной) вручную. А так как размер скачиваемых файлов находится в промежутке 7-14гб, то 
выполнение этой процедуры каждый раз - довольно проблематично и ресурсозатратно. И времени уходит немерено.
Во-вторых: скорость скачивания упирается в ~3,7mb/s. Хотя интернет позволяет качать со скоростью ~6,5mb/s.
В-третьх: скорость может и не доходить до 3,7mb/s. Иногда она сильно колеблится 0,7mb/s, 2,0mb/s, 1,0mb/s, 0,2mb/s, 3,3mb/s и т.п. При этом, переключение в цикле с файла на файл происходит тоже сильно медленнее, чем когда оно стабильно качает на 3,7mb/s. Таким образом, один большой файл может качаться более четырёх часов.
Как это иправить?

Это сообщение отредактировал(а) RAIN666 - 26.3.2019, 12:12
PM MAIL   Вверх
RAIN666
Дата 20.4.2019, 08:15 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 15.2.2019

Репутация: нет
Всего: нет



странно, что никто не знает
PM MAIL   Вверх
kami
Дата 24.4.2019, 20:01 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
***


Профиль
Группа: Завсегдатай
Сообщений: 1806
Регистрация: 25.8.2007
Где: Санкт-Петербург

Репутация: 6
Всего: 72



Судя по комментариям автора mORMot - WinInet является весьма тормознутым встроенным механизмом.
Цитата

// note: WinINet is MUCH slower than THttpClientSocket or TWinHttp: do not
// use this, only if you find some configuration benefit on some old networks

Собственно, мне приходилось ловить отказы в обслуживании запросов при его использовании.

Я бы рекомендовал уйти на что-то немного более "оберточное" по отношению к прямым вызовам WinAPI.
Можете счесть за рекламу, но упомянутый мной выше mORMot в плане сетевого обмена ни разу не подвел. В данном случае - класс TWinHTTP с событием OnProgress из состава этого фреймворка  может спасти отца русской демократии smile если, конечно, нет прямого запрета на замену кода. Собственно, у меня прошла именно такая замена, и вот уже более года сервис, использующий этот компонент, не перезапускался smile
PM MAIL WWW   Вверх
_zorn_
Дата 25.4.2019, 15:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 988
Регистрация: 21.8.2007

Репутация: нет
Всего: 12




Модератор: Сообщение скрыто.

PM MAIL   Вверх
RAIN666
Дата 15.5.2019, 09:22 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 15.2.2019

Репутация: нет
Всего: нет



Цитата(kami @  24.4.2019,  20:01 Найти цитируемый пост)

Я бы рекомендовал уйти на что-то немного более "оберточное" по отношению к прямым вызовам WinAPI.

А какая разница, если под виндой все обёртки всё-равно используют WinAPI?

PM MAIL   Вверх
RAIN666
Дата 18.5.2019, 14:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 13
Регистрация: 15.2.2019

Репутация: нет
Всего: нет



Цитата(kami @  24.4.2019,  20:01 Найти цитируемый пост)
 TWinHTTP

а где его скачать?
PM MAIL   Вверх
goalken
Дата 13.6.2019, 11:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 2
Регистрация: 13.6.2019

Репутация: нет
Всего: нет



Я недавно присоединился к этому форуму и надеюсь, что все помогут мне, и хотел бы познакомиться со всеми run 3
PM MAIL WWW   Вверх
Google
  Дата 17.6.2019, 07:37 (ссылка)  





  Вверх
  
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Сети"
Snowy
Poseidon
MetalFan

Запрещено:

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делится вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам помогли и атмосфера форума Вам понравилась, то заходите к нам чаще! С уважением, Snowy, Poseidon, MetalFan.

 
1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Сети | Следующая тема »


 




[ Время генерации скрипта: 0.2647 ]   [ Использовано запросов: 21 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.