Pobieranie plików według listy

0

Zrobiłem pobieranie pliku na zasadzie "pobieraj z różnych serwerów, dotąd aż pobierzesz".

W ListBoxie "Lista" jest kilka adresów do tego samego pliku, lecz na różnych serwerach. Przykład ten ma za zadanie pobrać, jeśli mu się uda, tylko jeden plik.

Wszystko ładnie pracuje, plik jest pobierany, ale w pewnych okolicznościach
(zapewne przy łączeniu się z serwerem - czas odpowiedzi serwera jest zbyt długi),
program przestaje reagować. Nie pomaga Application.ProcessMessages.
Label "Status" będący na formie staje się cały biały...
Dopiero po kilku sekundach, program "odżywa" i łączy się z kolejnym serwerem.

Czy jest tutaj jakiś błąd ?
TimerPobierz jest ustawiony na 3000ms.

uses 
  WinIntet;

private
  procedure Download(const URL: String; FileName: String);

var
  Pobrano, Kolejka: integer;
  Serwer: string;


procedure TForm1.Download(const URL: String; FileName: String);
var
  Buffer : array[1..1024] of Byte; // bufor zawierający ściągnięty fragment pliku
  hSession, hURL : HINTERNET;
  dwRead : DWORD; // ilość odczytanych danych
  dwSize : DWORD;  // rozmiar pliku
  F : File;
  pBuf : Pointer;
  dwBufLen : DWORD;
  dwIndex : DWORD;
  TotalRead : Integer;
  Broken : boolean;
begin
  Broken    := False;
  TotalRead := 0;
  hSession := InternetOpen('Fast Download', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  Application.ProcessMessages;
  Status.Caption := 'Łączenie z serwerem: ' + Serwer;
  Pobierz.Enabled := False;

  try
    hURL := InternetOpenURL(hSession, PChar(URL), nil, 0, 0, 0);
    Application.ProcessMessages;

    dwBufLen := 1024;
    dwIndex := 0;
    GetMem(pBuf, dwBufLen);

    { pobranie informacji na temat wielkości pliku }
    HttpQueryInfo(hURL, HTTP_QUERY_CONTENT_LENGTH,pBuf, dwBufLen, dwIndex);
    dwSize := StrToInt(StrPas(pBuf));
    Progress.Max := (dwSize div 1024);
    FreeMem(pBuf, dwBufLen);

    try
      AssignFile(F, FileName);
      try
        Rewrite(F, 1);
        repeat
          if Broken = True then Break;
          InternetReadFile(hURL, @Buffer, SizeOf(Buffer), dwRead);
          BlockWrite(F, Buffer, dwRead);
          
          Application.ProcessMessages;
          Inc(TotalRead,dwRead);
          Status.Caption    := 'Pobieranie z: ' + Serwer +#10+ 'Pobrano: ' + IntToStr(TotalRead div 1024) + ' kB z: ' + IntToStr(dwSize div 1024) + ' kB';
          Progress.Position := TotalRead div 1024;
        until dwRead = 0;
      finally
        CloseFile(F);
      end;
    finally
      InternetCloseHandle(hSession);
    end;
  finally
    InternetCloseHandle(hURL);
  end;
  Pobrano := 2;
  Pobierz.Enabled := True;
end;

procedure TForm1.PobierzClick(Sender: TObject);
var
 m: integer;
 a: string;
begin
 if Kolejka < Lista.Items.Count then Inc(Kolejka);
 Serwer := Lista.Items.Strings[Lista.Items.Count - Kolejka];
 a := Serwer;
  for m := 1 to length(a) do
   begin
    if a[m] = '/' then a[m] := '\';
   end;
 TimerPobierz.Enabled := True;

 try
  Download(Serwer,ExtractFilePath(Application.ExeName) + ExtractFileName(a));
 except
  Pobrano := 0;
 end;
end;

procedure TForm1.TimerPobierzTimer(Sender: TObject);
begin
 if Pobrano = 0 then
   begin
    Pobrano := 1;
    Status.Caption := 'Przekierowanie...';
    Application.ProcessMessages;
    Pobierz.Click;
   end
 else
 if Pobrano = 2 then
   begin
    Status.Caption       := 'Pobrano... !';
    TimerPobierz.Enabled := False;
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Kolejka := 0;
end;

Czy problem rozwiąże utworzenie tego w wątku ?
Dziękuję za odpowiedzi [soczek]

0

Sposób pobierania pliku bazujący na WinInet używa połączenia z serwerem w głównym wątku aplikacji, co przy braku odpowiedzi ze strony serwera ma prawo zawieszać formę. Przeniesienie mechanizmu pobierającego plik do innego wątku powinno rozwiązać ten problem. Chyba że użyjesz komponentu HTTPGet (był kiedyś taki) - wygodny w obsłudze, działający w oddzielnym wątku.

1 użytkowników online, w tym zalogowanych: 0, gości: 1