Napisałem program do pobierania. Załączam go. Problem polega na tym, że gdy pobieram pierwszy raz - działa poprawnie, ale za drugim razem pokazuje się "Access violation....". Źle zamykam formę? Jest wywoływana jako druga poprzez
if not Assigned(GetForm) then
begin
GetForm := TGetForm.Create(nil);
end;
GetForm.Show;
W pierwszej mam kilka wątków.
Pozdrawiam.
W pliku, który dołączyłeś jest zmienna globalna
var GetForm: TGetForm;
ale nie podałeś kiedy ten obiekt jest zwalniany
Nie zwalniam. Robi to chyba kompilator.
Kompilator kompiluje, a potem nie bierze udziału w procesie działania aplikacji; Natomiast jeżeli sam tworzysz zasób to sam go musisz zwolnić; Dotyczy to wielu rzeczy w Delphi, a przede wszystkim instancji klas (obiektów); Tym bardziej, że w parametrze konstruktora podajesz wartość Nil, czyli nie nadajesz formularzowi ownera, który by nim zarządzał;
Problem może leżeć gdzieś indziej; Mimo wszystko najpierw popraw kod i dopisz zwalnianie formularza;
PS: Co nawyprawiałeś z tymi Begin End w metodzie SockCallBack? Nie za dużo ich? Powywalaj zbędne, a stanowią one połowę wszystkich w tej metodzie :D
Dodam, że plik projektu wygląda tak:
uses
Forms,
Windows,
Main in 'Main.pas' {MainForm},
Search in 'Search.pas' {SearchForm},
GetFile in 'GetFile.pas' {GetForm},
Login in 'Login.pas' {LoginForm},
Status in 'Status.pas' {StatusForm};
{$R *.res}
begin
CreateMutex(nil, True, 'xenix33');
RestoreMsg := RegisterWindowMessage('xenix33');
if GetLastError = ERROR_ALREADY_EXISTS then
begin
SendMessage(HWND_BROADCAST, RegisterWindowMessage('xenix33'), 0, 0);
Halt;
end;
SearchForm := TSearchForm.Create(nil);
StatusForm := TStatusForm.Create(nil);
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TLoginForm, LoginForm);
Application.Run;
end.
Zwolniłem formę i usunąłem beginy. To samo. Albo coś z wątkiem, albo dostępem do danych z MainForm.
Za drugim razem brak dostępu Do danych z Main Form w:
procedure TGetFile.Execute;
var
URL : string;
begin
URL := PChar(MainForm.Edit1.Text);
GetForm.DownloadHTTP(URL);
end;
Po kolei. Po pierwsze nie jest dobrze panowie :(. Ale skoro tu napisałeś więc chcesz się czegoś nauczyć o to już coś :)
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".
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ść.
EnglishMessageBox
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.
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.
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.
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.
Dzięki za przykład i cenne uwagi. Przeanalizuję go w wolnej chwili. Jest dobrze opisany, więc nie będzie problemu. Jedna uwaga.
Jeśli napiszę:
Application.CreateForm(TSearchForm,SearchForm);
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.CreateForm(TLoginForm, LoginForm);
,to forma SearchForm wyświetla się przed formą główną przy uruchomieniu programu. Jest zatem różnica między
SearchForm := TSearchForm.Create(nil);
,a
Application.CreateForm(TSearchForm,SearchForm);
Jeszcze raz dzięki za kawał dobrej roboty.
to jeśli nie potrzebujesz danej formy "od razu" to nie powinieneś jej tworzyć wcześniej.
Zgadzam się.