Po kolei. Po pierwsze nie jest dobrze panowie :(. Ale skoro tu napisałeś więc chcesz się czegoś nauczyć o to już coś :)
- Błąd logiczny
Thr.Suspend;
Thr.Terminate;
ten wątek nigdy się nie zakończy. Formatki się pozamykają, program zniknie z taskbara ale jak wejdziesz w menadżer zadań to program będzie wisiał. Dlaczego? - bo najpierw mówisz wątkowi aby szedł spać i nie wykonywał ŻADNEGO polecenia a potem ustawiasz mu flagę, która mu mówi, że powinien się jak najszybciej zakończyć. Tylko, że po suspend
on (wątek) nigdy tej flagi nie odczyta bo "śpi".
- Zagnieżdżony
with
- nie jest to błąd sensu stricto ale nie jest mile widziane, nawet trochę nie jest mile widziane, powiedział bym nawet, że w ogóle nie jest mile widziane. I niemile też nie jest widziane, po prostu tego nie rób.
with GetForm do
begin
Label1.Caption := 'Łączę się z serwerem...';
with SynHttp do
Kod syntaktycznie jest OK, kompiluje się i działa. Ale debugowanie/poprawianie takiego kodu to koszmar. Po pierwsze debugger nie pokazuje wartości zmiennych w takim kodzie. Po drugie nigdy nie wiadomo (o ile ktoś nie zna na pamięć metod/właściwości danej klasy) którego obiektu dotyczy dana metoda/właściwość.
- nie wnikam, tak mnie tylko zastanowiło
EnglishMessageBox
- Błąd logiczny
if SynHttp <> nil then
begin
SynHttp.Free;
end;
i to bardzo podobna sytuacja
if SynHttp = nil then
SynHttp := THttpSend.Create;
Zadziała tak jak myślisz TYLKO za pierwszym razem (bo zmienne globalne są ustawiane na domyślne wartości, tu obiekty na nil). Potem już nie. Dlaczego tak się dzieje? bo zmienna która wskazuje (jak to ładniej nazwać? zmienna obiektowa?) na obiekt (tu SynHttp
, która wskazuje na instancję klasy THttpSend) jest tylko wskaźnikiem na adres w pamięci. Robiąc SynHttp.Free
stwierdzasz, że już nie potrzebujesz tej konkretnej instancji klasy (obiektu) a pamięć, którą ona zajmowała jest z powrotem dostępna dla programu/systemu. Ale, i tu jest właśnie sedno problemu, zmienna SynHttp
nadal wskazuje na ten obszar pamięci. SynHttp <> nil
ZAWSZE będzie prawdziwe i analogicznie SynHttp = nil
NIGDY nie zajdzie. Rozwiązania są dwa - albo po SynHttp.Free
dodać polecenie SynHttp := nil
, albo zamiast SynHttp.Free
użyć FreeAndNil(SynHttp)
, które automatycznie ustawi wskaźnik na nil
.
- Drobna uwaga
Application.ProcessMessages;
Skoro starasz się używać wątków to po co jest ProcessMessages
? Jeśli musisz go użyć bo "program się wiesza na chwilę" to znaczy, że coś jest nie tak z samym algorytmem pobierania.
- ech ta elegancja :)
begin
begin
if SynHttp <> nil then
begin
begin
if (Reason = HR_ReadCount) then
begin
oraz
SearchForm := TSearchForm.Create(nil);
StatusForm := TStatusForm.Create(nil);
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TLoginForm, LoginForm);
W pierwszym przypadku ilość begin end
ów przytłacza :). Następnie nic nie stoi na przeszkodzie aby pierwsze dwa ify połączyć w jeden. No i na koniec jeden warunek ma nawiasy ()
a drugi nie ma.
W drugim wypadku masz tworzone cztery formy. Dwie przez Create
a dwie przez CreateForm
. Jeśli chodzi o efekt to większych różnic nie ma ale jednak wypadało by się trzymać jednej wybranej ścieżki.
- Błąd, i to poważny.
procedure TGetFile.Execute;
var
URL : string;
begin
URL := PChar(MainForm.Edit1.Text);
GetForm.DownloadHTTP(URL);
end;
O ile pierwsza linijka procedury nie powinna nikomu krzywdy zrobić (co nie znaczy, że jest OK) to już druga może (i pewnie będzie) powodować błędy. Ten kod skutkuje grzebaniem w kontrolkach z pobocznego wątku.
Po ogólnej krytyce czas na ogólny zarys jak to powinno wyglądać. Po pierwsze i najważniejsze: to dodatkowy wątek powinien implementować pobieranie pliku w całości. Po drugie i równie ważne: w dodatkowym wątku, nigdzie nie powinieneś mieć odwołania do jakiejkolwiek kontrolki interfejsu.
Kod wątku może wyglądać np. tak (jest tam trochę nadmiarowości ale to żeby pokazać ideę).
BTW przycisk przerwij przerywa tylko pierwszy wątek o ile nadal działa.
unit FileDownloaderThread;
interface
uses
Classes, blcksock, HTTPSend;
type
TProgressEvent = procedure(Sender: TObject; const ProgressPos, ProgressMax: Integer; var BreakDownload: Boolean) of object;
TInfoEvent = procedure(Sender: TObject; const Info: string) of object;
TFileDownloader = class(TThread)
private
FHTTPSend: THTTPSend;
FFileUrl: string;
FSaveFileName: string;
FOnInfo: TInfoEvent;
FOnProgress: TProgressEvent;
FProgressPos: Integer;
FProgressMax: Integer;
FBreakDownload: Boolean;
FInfo: string;
FFileSize: Integer;
FDownloaded: Integer;
FProgressId: Integer;
procedure SockCallBack(Sender : TObject; Reason : THookSocketReason; const Value : string);
//poniewaz przy synchronizacji nie mozna przeslac parametrow do synchronizowanej metody
//napiszemy dwie - jedna pomocnicza dla nas i druga, ktora bedziemy synchronizowac
//w tej pomocniczej zapiszemy parametry do zmiennych prywatnych, wywolamy synchronicznie
//metode druga i w niej odczytamy zmienne prywatne
procedure DoProgress(const ProgressPos, ProgressMax: Integer; var BreakDownload: Boolean);
procedure DoProgressSync;
procedure DoInfo(const Info: string);
procedure DoInfoSync;
function SizeToStr(const Size: Integer) : string;
protected
procedure Execute; override;
public
constructor Create(const FileUrl, SaveFileName: string); reintroduce;
property ProgressId: Integer read FProgressId write FProgressId;
property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
property OnInfo: TInfoEvent read FOnInfo write FOnInfo;
end;
implementation
uses
SysUtils, Math;
{ TFileDownloader }
constructor TFileDownloader.Create(const FileUrl, SaveFileName: string);
begin
//ustawiamy zmienne
FFileUrl := FileUrl;
FSaveFileName := SaveFileName;
//i wywolujemy konstruktor z klasy bazowej
inherited Create(True); //uspiony aby mozna bylo podpiac zdarzenia
end;
procedure TFileDownloader.DoInfo(const Info: string);
begin
//sprawdzamy czy w ogole ktos slucha
if Assigned(FOnInfo) then
begin
//parametry do zmiennych prywatnych
FInfo := Info;
//i wywolanie synchroniczne metody wlasciwej
Synchronize(DoInfoSync);
end;
end;
procedure TFileDownloader.DoInfoSync;
begin
//a tutaj juz wlasciwe wywolanie zdarzenia
FOnInfo(Self, FInfo);
end;
procedure TFileDownloader.DoProgress(const ProgressPos, ProgressMax: Integer; var BreakDownload: Boolean);
begin
//analogicznie jak w DoInfo
if Assigned(FOnProgress) then
begin
FProgressPos := ProgressPos;
FProgressMax := ProgressMax;
FBreakDownload := False;
Synchronize(DoProgressSync);
BreakDownload := FBreakDownload;
end;
end;
procedure TFileDownloader.DoProgressSync;
begin
FOnProgress(Self, FProgressPos, FProgressMax, FBreakDownload);
end;
procedure TFileDownloader.Execute;
begin
FFileSize := 0;
FDownloaded := 0;
//watek po zakonczeniu zwolni zajmowana przez siebie pamiec
FreeOnTerminate := True;
//tworzymy obiekt klasy THTTPSend
FHTTPSend := THTTPSend.Create;
try
//czyscimy obiekt
FHTTPSend.Clear;
//ustawiamy wlasciwosci obiektu
//tu uwaga - Clear powinno sie wywolywac najpierw poniewaz nie wiesz co ono tak naprawde czysci.
//w tym konkretnym przypadku np. ustawia MimeType, wiec ustawiona wczesniej wlasciwosc
//zostanie zastapiona domyslna
FHTTPSend.KeepAlive := True;
FHTTPSend.Protocol := '1.1';
FHTTPSend.MimeType := 'text/html'; //Default_MimeType;
FHTTPSend.UserAgent := 'moj user agent'; //Default_UserAgent;
FHTTPSend.Sock.OnStatus := SockCallBack;
//sprawdzamy w kluczowych miejscach czy mozemy pracowac nadal
if Terminated then
Exit;
try
//"wysylamy" info do wszystkich zainteresowanych
DoInfo('Rozpoczynanie pobierania');
if FHTTPSend.HTTPMethod('GET', FFileUrl) then
begin
FHTTPSend.Document.SaveToFile(FSaveFileName);
//jak ok to info, ze ok
DoInfo('Zakończono pobieranie. Plik zapisany w ' + FSaveFileName);
end
else
begin
//jak nie ok to info, ze nie ok
FHTTPSend.DecodeStatus(FHTTPSend.ResultString);
DoInfo(Format('Błąd podczas pobierania: %d %s', [FHTTPSend.ResultCode, FHTTPSend.ResultString]));
end;
except
//a jak blad to info, ze blad
on E: Exception do
DoInfo('Błąd pobierania: ' + E.Message);
end;
finally
//i dbamy o to aby zawsze, zostal zwolniony
FHTTPSend.Free;
end;
end;
function TFileDownloader.SizeToStr(const Size: Integer): string;
const
Description: Array [0 .. 3] of string = ('B', 'KB', 'MB', 'GB');
var
i: Integer;
begin
i := 0;
while Size > Power(1024, i + 1) do
Inc(i);
Result := FormatFloat('###0.#', Size / IntPower(1024, i)) + ' ' + Description[i];
end;
procedure TFileDownloader.SockCallBack(Sender: TObject;
Reason: THookSocketReason; const Value: string);
var
BreakDownload: Boolean;
begin
if (Reason = HR_ReadCount) then
begin
FFileSize := FHTTPSend.DownloadSize;
FDownloaded := FDownloaded + StrToIntDef(Value, 0);
DoInfo(Format('Pobrano %s z %s.', [SizeToStr(FDownloaded), SizeToStr(FFileSize)]));
DoProgress(FDownloaded, FFileSize, BreakDownload);
if BreakDownload then
TTCPBlockSocket(Sender).CloseSocket;
end;
end;
end.
Cały projekt w załączniku (razem z exe). Możesz np. kliknąć kilka razy Pobierz
i zobaczyć co Ci program będzie pokazywał :) Program ściąga jakieś testowe 5MB z tej strony http://www.thinkbroadband.com/download.html
Jeszcze odnośnie przerywania pobierania. W tym konkretnym wypadku Thread.Terminate
nie zakończy pobierania ponieważ całe "ciało" wątku (czyli to co jest w metodzie Execute
) to tak naprawdę jedna metoda klasy THTTPSend
. Po jej wywołaniu, następne polecenie wątek może wykonać dopiero po jej zakończeniu - czyli albo po pobraniu pliku albo np. zgłoszeniu błędu przez THTTPSend. TerminateThread
też nie jest rozwiązaniem bo w takim wypadku wątek nie ma szans posprzątać po sobie. Jedną z metod jest zamknięcie gniazda w obsłudze zdarzenia OnStatus
, co też tutaj zostało wykorzystane.