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]