скачать несколько файлов одновременно (многопоточность не работает)

[BLACK_RAIN]

Здравствуйте.
Нужно скачать несколько файлов одновременно.
Для каждого файла создаю отдельный поток. В каждом экземпляре потока заранее прописан URL и имя файла, куда сохранять. Потом по кнопке запускаю несколько потоков. В папке для скачивания появляется столько файлов, сколько потоков я запустил. Но одновременно качаются только 2 файла. Когда скачался один, начинает качаться следующий. Но не более двух одновременно
Почему так? Где ошибка?

  TThreadDownload = class(TThread)
  public
    url : string;
    filename : string;
    completed : Boolean;
    active : Boolean;
  private
    procedure Execute; override;
  end;

var
  List : TList;
  MaxActiveThreadsCount : integer = 5;
  
  
procedure TThreadDownload.Execute;
var
  d : TWinApiDownload;
  fs : TStream;
begin
  inherited;
  active := True;
  completed := false;
  d := TWinApiDownload.Create;
  d.CachingEnabled := False;
  d.URL := url;
  if FileExists(filename) then
  DeleteFile(filename);
  fs := TFileStream.Create(filename, fmCreate or fmOpenWrite);
  d.Download(fs); //скачивание
  fs.Free;
  d.Free;
  completed := True;
  active := False;
end;

procedure TForm1.btnDownloadClick(Sender: TObject);
var
  i, max : Integer;
begin
  btnDownload.Enabled := False;
  if list.Count < MaxActiveThreadsCount then
  max := list.Count else
  max := MaxActiveThreadsCount;
  for I := 0 to max - 1 do
    TThreadDownload(list.items[i]).Resume;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  i : Integer;
  thread : TThreadDownload;
begin
  lb1.Items.LoadFromFile('c:\downloads\downList.txt');
  list := TList.Create;
  for I := 0 to lb1.Items.Count - 1 do
  begin
    Thread := TThreadDownload.Create(True);
    Thread.Priority := tpNormal;
    Thread.FreeOnTerminate := False;
    Thread.OnTerminate := ThreadTerminateProc;
    Thread.url := lb1.Items[i];
    thread.Filename := DownloadPath + ExtractURLFileName(lb1.Items[i]);
    list.Add(Thread);
  end;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  list.Free;
end;

[BLACK_RAIN]

Попробовал качать через компонент TIdHTTP - всё работает. Но компонент глюкавый и неудобный.
По-этому я написал такой код:

function TWinApiDownload.Download(Stream : TStream) : Integer;
var
  hInet, hUrl : HINTERNET;
  buf : array [0..4095] of Byte;
  lpdwNumberOfBytesAvailable : DWORD;
  dwBufferLen, dwIndex : DWORD;
  pSize, pErrorCode : array [0..255] of Char;
  b : Cardinal;
  transfered : Int64;
  ErrorDataReadIncomplete : boolean;
begin
  if URL = '' then
  begin
    Result := DOWNLOAD_ERROR_EMPTY_URL;
    Exit;
  end;
  if fStop then
  begin
    Result := DOWNLOAD_ABORTED_BY_USER;
    Exit;
  end;
  Result := DOWNLOAD_ERROR_UNKNOWN;

  hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG,
                        nil, nil, 0);
  if Assigned(hInet) then
  begin
    if CachingEnabled then
    hUrl := InternetOpenUrl(hInet, PChar(URL), nil, 0, 0, 0) else
    hUrl := InternetOpenUrl(hInet, PChar(URL), nil, 0,
                                 INTERNET_FLAG_NO_CACHE_WRITE,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;
      transfered := 0;
      repeat
        if InternetQueryDataAvailable(hUrl,
                              lpdwNumberOfBytesAvailable, 0, 0) then
        begin
          if lpdwNumberOfBytesAvailable > 0 then
          begin
            ZeroMemory(@buf, SizeOf(buf));
            if InternetReadFile(hUrl, @buf, SizeOf(buf), b) then
            begin
              if b > 0 then
              begin
                transfered := transfered + b;
                Stream.WriteBuffer(buf, b);
                if lpdwNumberOfBytesAvailable > SizeOf(buf) then
                ErrorDataReadIncomplete := b < SizeOf(buf) else
                ErrorDataReadIncomplete := b < lpdwNumberOfBytesAvailable;
                if ErrorDataReadIncomplete then
                begin
                  if Assigned(OnError) then
//                  begin
                    OnError(Self, DOWNLOAD_ERROR_INCOMPLETE_READ, URL);
//                  end;
                end else
//                begin
                  if Assigned(OnWork) then
                      OnWork(Self, transfered);
//                end;
              end else
              begin
                ErrorDataReadIncomplete := True;
                Break;
              end;
            end else
            begin
              if Assigned(OnError) then
                OnError(Self, DOWNLOAD_ERROR_INCOMPLETE_READ, URL);
              Result := DOWNLOAD_ERROR_DATA_READ;
              Break;
            end;
          end;
        end else
        begin
          Result := DOWNLOAD_ERROR_UNKNOWN;
          Break;
        end;
      until (lpdwNumberOfBytesAvailable = 0) or (b = 0) or
            (ErrorDataReadIncomplete) or (fStop);
      if fStop then
      Result := DOWNLOAD_ABORTED_BY_USER else
      if ErrorDataReadIncomplete then
      Result := DOWNLOAD_ERROR_INCOMPLETE_READ;
      if Assigned(OnWorkEnd) then
      OnWorkEnd(Self, transfered, Result);
      InternetCloseHandle(hUrl);
    end;
    InternetCloseHandle(hInet);
  end;
end;

но почему качаются только ДВА файла одновременно? Почему именно два, а не, допустим, три? Код ведь выполняется в РАЗНЫХ потоках. Каждый файл качается в своём потоке.
В другом проекте я создаю динамический массив из TFrame и в каждом фрейме создаю поток, в котором при помощи этого кода качается файл. Там даже синхронизация с формой есть. И всё работает.
А почему здесь качается не более двух файлов одновременно, хотя для каждого создан отдельный поток?

[BLACK_RAIN]

Я обнаружил вот что.
например, вот код, выполняемый в потоке:

  max := 1000000;
  if Assigned(OnWorkStart) then
  OnWorkStart(Self, max);
  for I := 0 to max - 1 do
  begin
    transfered := i;
    if Assigned(OnWork) then
    OnWork(Self, transfered);
    Sleep(7);
  end;
  if Assigned(OnWorkEnd) then
  OnWorkEnd(Self, transfered, 200);

Это работает. Можно запустить несколько таких потоков и все они будут выполняться одновременно без проблем.
Теперь добавим функции WinAPI, которые лезут в интернет:

var
  hInet, hUrl : HInternet;
  i, max : integer;
begin
  hInet := InternetOpen(PChar(UserAgent), INTERNET_OPEN_TYPE_PRECONFIG,
                        nil, nil, 0);
  if Assigned(hInet) then
  begin
	  max := 1000000;
	  if Assigned(OnWorkStart) then
	  OnWorkStart(Self, max);
	  for I := 0 to max - 1 do
	  begin
		transfered := i;
		if Assigned(OnWork) then
		OnWork(Self, transfered);
		Sleep(7);
	  end;
	  if Assigned(OnWorkEnd) then
	  OnWorkEnd(Self, transfered, 200);
  
    hUrl := InternetOpenUrl(hInet, PChar(URL), nil, 0, 0, 0);
.....bla-bla........
end;

Это тоже работает в нескольких потоках одновременно.
Однако, если переместить строчку hUrl := InternetOpenUrl(hInet, PChar(URL), nil, 0, 0, 0); до начала цикла, то есть сделать вот так:

	hUrl := InternetOpenUrl(hInet, PChar(URL), nil, 0, 0, 0);
	........
	for I := 0 to max - 1 do
	begin

то так уже не работает! Если запустить много таких потоков, то одновременно будут работать только два.
В чем прикол-то???

[Pavia]

ИБ требует от сервера ограничения потоков с IP Адреса как правило 4 иногда и вовсе 2.

[BLACK_RAIN]

Сообщение от Pavia

ИБ требует от сервера

Что такое ИБ?

Сообщение от Pavia

ИБ требует от сервера ограничения потоков с IP Адреса как правило 4 иногда и вовсе 2.

во-первых: каждый поток качает разные файлы
во-вторых: в другом проекте я создаю динамический массив из TFrame. В каждом фрейме создается поток, который качает файл. И всё работает.
в-третьх: в моем последнем посте в потоках ничего с интернета не качается. Там просто URL открывается. Перечитайте внимательней.
Каким образом открытый URL может остановить поток? Особенно, если в разных фреймах это работает? Почему без фреймов не работает?

[BLACK_RAIN]

Сообщение от BLACK_RAIN

Когда скачался один, начинает качаться следующий. Но не более двух одновременно

Поправочка.
Все потоки (кроме первых двух) просто зависают на строчке hUrl := InternetOpenUrl(hInet, PChar(URL), nil, 0, 0, 0); не зависимо от содержащегося далее кода. То есть, что бы там ни было написано, оно дальше строчки hUrl := InternetOpenUrl(hInet, PChar(URL), nil, 0, 0, 0); не доходит.
никто не знает, почему?

[BLACK_RAIN]

  hInet := InternetOpen(PChar('Mozilla 1.0'), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if Assigned(hInet) then
  begin
      i := 5;
      if not InternetSetOption(hInet, INTERNET_OPTION_MAX_CONNS_PER_1_0_SERVER, @i, SizeOf(i)) then
      MessageBox(0,'0','0',0);
      i := 5;
      if not InternetSetOption(hInet, INTERNET_OPTION_MAX_CONNS_PER_SERVER, @i, SizeOf(i)) then
      MessageBox(0,'1','1',0);

InternetSetOption() возвращает false

[BLACK_RAIN]

вчера методом тыка обнаружилось, что если вместо hInet написать nil - всё работает.
но почему надо писать именно nil?
и что такое ИБ?

[Аватар]

Сообщение от BLACK_RAIN

и что такое ИБ?

Надо полагать что информационная безопасность )

[BLACK_RAIN]

Сообщение от Аватар

Надо полагать что информационная безопасность )

У сервера, к которому я подклчаюсь, нет системы безопасности (ну или она вся в дырочку)