PHP DM Gate v0.9 » Как остановить закачку в IdHttp? <span class="vd">[D7, WinXP]</span>

vegarulez (12.10.10 10:30) [0]

Привет всем мастерам!
Вопрос состоит в следующем в основном потоке создаётся дополнительный - который скачивает с сервера нужный мне файл, и докачивает его, потом если вдруг соединение к интернету было разорвано. Вопрос заключается в следующем - как принудительно отключить скачивание, по нажатию на кнопоку.
Т.к. там происходит взаиможействи на уровне idhttp в процедуре idHTTP1Work
пытаюсь сделать terminate потока - но закачка всёравно продолжается. подскажите.

...
const
MY_MESS = WM_USER + 1;
type
TFormMain = class(TForm)
ProgressBar1: TProgressBar;
Edit1: TEdit;
Edit2: TEdit;
Button3: TButton;
Button8: TButton;
...

type
TDownLoadfile = class(TThread)
private
FSourceFile, FSourceURL: string;
FSizeFile: Dword;
IdHTTP1:TidHttp;
protected
procedure Execute;override;
public
property SourceURL:string read FSourceURL write FSourceURL;
property SourceFile:string read FSourceFile write FSourceFile;
property SizeFile:Dword read FSizeFile write FSizeFile;
procedure idHTTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
procedure idHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
procedure idHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
end;

...

procedure TFormMain.Button3Click(Sender: TObject);
begin
SaveDialog1.FileName:=copy(Edit1.Text,LastDelimiter('\/',Edit1.Text)+1,maxint);
if SaveDialog1.Execute then
Edit2.Text:=SaveDialog1.FileName;
end;

procedure TFormMain.MyProgress(var msg: TMessage);
begin
case msg.WParam of
0:
begin
{label4.Caption:= formatfloat('0.00',msg.LParam / 1024 / 1024) +' мб ('+inttostr(msg.LParam)+')';
L_P_Num_1.Caption:= formatfloat('0.00',(RestartPos+msg.LParam) / 1024 / 1024) +' мб ('+inttostr(RestartPos+msg.LParam) +')';}

ProgressBar1.Max:=RestartPos+msg.LParam;
ProgressBar1.Position:=0;
end;
1:
begin
{label5.Caption:=formatfloat('0.00',msg.LParam / 1024 / 1024)+' мб ('+inttostr(msg.LParam)+')';
label10.Caption:= formatfloat('0.00',(RestartPos+msg.LParam) / 1024 / 1024) +' мб ('+inttostr(RestartPos+msg.LParam)+')'+' [ '+formatfloat('0',((RestartPos+msg.LParam)/ProgressBar1.Max*100)) +'% ]';}

ProgressBar1.Position:=RestartPos+msg.LParam;
end;
end;
end;

procedure TFormMain.thrTerminate(Sender: TObject);
begin
ShowMessage('Готово');
Button8.Enabled:=true;
end;

procedure TDownLoadfile.idHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Integer);
begin
PostMessage(Application.MainForm.Handle,MY_MESS,1,AWorkCount);
end;

procedure TDownLoadfile.idHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
AWorkCountMax: Integer);
begin
PostMessage(Application.MainForm.Handle,MY_MESS,0,AWorkCountMax);
end;

procedure TDownLoadfile.idHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
//
end;

procedure TFormMain.BT_Stop_downloadClick(Sender: TObject);
var
t:TDownLoadfile;
begin
t.IdHTTP1.EndWork;

end;

{ TDownLoadfile }

procedure TDownLoadfile.Execute;
var

FileDate: TDateTime;
FileType: string;
SourceFileSize: Dword; // размер исходного файла который собираемся скачивать
fDownloadStream: TFileStream;
begin
IdHTTP1:=TIdHTTP.Create(nil);
IdHTTP1.OnWork:=IdHTTP1Work;
IdHTTP1.OnWorkBegin:=IdHTTP1WorkBegin;
IdHTTP1.OnWorkEnd:=IdHTTP1WorkEnd;
IdHTTP1.ProtocolVersion := pv1_1; //pv1_1
IdHTTP1.HandleRedirects := True;
IdHTTP1.Head(SourceURL);
SourceFile :=IdHTTP1.Response.RawHeaders.Text; // Values['ETag'], '\"', '', [rfReplaceAll]), '-', '', [rfReplaceAll]); //
SourceFile := StringReplace(StringReplace(IdHTTP1.Response.RawHeaders.Values['ETag'], '\"', '', [rfReplaceAll]), '-', '', [rfReplaceAll]); // Text;
SourceFile := IdHTTP1.URL.Document;
SourceFileSize := IdHTTP1.Response.ContentLength;

if SourceFileSize>SizeFile then // значит файл не докачан или его нет вовсе.
Begin
FileDate := IdHTTP1.Response.LastModified;
FileType := IdHTTP1.Response.ContentType;

if FileExists(IdHTTP1.URL.Document) then
begin
fDownloadStream := TFileStream.Create(SourceFile, fmOpenReadWrite);
fDownloadStream.Position:=SizeFile;
Idhttp1.Request.Range:=Format('%d-%d',[fDownloadStream.Position,SourceFileSize]);
fDownloadStream.Seek(fDownloadStream.Position,soFromBeginning);
end
else
begin
fDownloadStream := TFileStream.Create(SourceFile, fmCreate);
fDownloadStream.Seek(0,soFromBeginning); //
end;
IdHTTP1.Request.ContentType := FileType;
IdHTTP1.Request.ContentRangeStart := fDownloadStream.Position;
IdHTTP1.Request.ContentRangeEnd := SourceFileSize;
try
IdHTTP1.Get(SourceURL,fDownloadStream);
finally
fDownloadStream.Free;
IdHTTP1.Free;
end;
End
else
terminate;
end;

function GetFileSize(FileName: String): Integer;
var
FS: TFileStream;
begin
try
FS := TFileStream.Create(Filename, fmOpenRead);
except
Result := -1;
end;
if Result <> -1 then Result := FS.Size;
FS.Free;
end;

procedure TFormMain.Button8Click(Sender: TObject);
var
t:TDownLoadfile;
begin

Button8.Enabled:=false;

//Создадим класс потока.
//Поток для начала будет остановлен
t:=TDownLoadfile.Create(true);
//Передадим параметры потоку
t.SourceURL:=Edit1.Text;
t.SourceFile:=Edit2.Text;
RestartPos:=0;
//Если на винте есть файл то считаем, что нужно докачивать
if FileExists(Edit2.Text) then
RestartPos:=GetFileSize(Edit2.Text); //*128
t.SizeFile:=RestartPos;

//Поток должен удалить себя по завершению своей работы
t.FreeOnTerminate:=true;
t.OnTerminate:=thrTerminate;

//И запустим его на закачку.
t.Resume;
//Теперь с процедуры мы выйдем, но поток работает
//и живёт своей жизней
end;

<Цитата>
Сергей М. © (12.10.10 11:06) [1]

Из другого потока вызови IdHTTP.Socket.Close, тогда IdHTTP.Get() возвратит управление с соотв.исключением

<Цитата>
vegarulez (12.10.10 11:16) [2]

перенёс описание idhttp1 в type

type
TDownLoadfile = class(TThread)
private
FSourceFile, FSourceURL: string;
FSizeFile: Dword;
IdHTTP1:TidHttp;

protected
procedure Execute;override;
public
property SourceURL:string read FSourceURL write FSourceURL;
property SourceFile:string read FSourceFile write FSourceFile;
property SizeFile:Dword read FSizeFile write FSizeFile;
procedure idHTTP1Work(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Integer);
procedure idHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Integer);
procedure idHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
end;

и пытаюсь
его остановить как ты посоветовал

procedure TFormMain.BT_Stop_downloadClick(Sender: TObject);
var
t:TDownLoadfile;
begin
t.IdHTTP1.Socket.Close;

end;

вывваливается ошибка (

<Цитата>
DiamondShark © (12.10.10 12:10) [3]

> вывваливается ошибка (

Где? Если здесь:
IdHTTP1.Get(SourceURL,fDownloadStream);
то так и должно быть.

<Цитата>
Сергей М. © (12.10.10 12:46) [4]

> перенёс описание idhttp1 в type
>

Нафига ?

Достаточно у TDownLoadfile объявить публ.метод а-ля AbortConnection, в теле которого вызывать IdHTTP.Socket.Close

<Цитата>
vegarulez (13.10.10 10:14) [5]

Вроде всё сделал как ты посоветовал.
Но ничего не получается... ((

Посмотри плиз, если не сложно - я отправил тестовый примерчик с которым работаю на
http://zalil.ru/29807305
весит 10 кб

У меня вываливается ошибка - Access violation at address ... in module...

<Цитата>
sniknik © (13.10.10 10:28) [6]

> Access violation at address ... in module...

procedure TFormMain.BT_Stop_downloadClick(Sender: TObject);
var
t:TDownLoadfile;
begin
t.IdHTTP1.Socket.Close;

end;

объект t не инициализирован/не существует.

<Цитата>
Сергей М. © (13.10.10 11:04) [7]

procedure TForm1.Button3Click(Sender: TObject);
var
t:TDownLoadfile;
begin
t.AbortConnection;
end;

в t мусор

<Цитата>
vegarulez (13.10.10 11:10) [8]

я же определяю переменную t как TDownLoadfile, иначе как мне из основного потока обращаться к элементам дочернего потока.

из примера который скинул на залил.ру:
procedure TDownLoadfile.AbortConnection();
begin
idhttp1.Socket.Close;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
t:TDownLoadfile;
begin
t.AbortConnection;
end;

<Цитата>
vegarulez (13.10.10 11:11) [9]

Сергей М. © (13.10.10 11:04) [7]

а как тогда правильно реализовать???

<Цитата>
Сергей М. © (13.10.10 11:23) [10]

1. Сделать t полем класса формы, а не лок.переменной

2. В обработчике OnTerminate нилить t:

procedure TForm1.thrTerminate(Sender: TObject);
begin
t := nil;
ShowMessage('Готово');
Button4.Enabled:=true;
end;

3.
procedure TForm1.Button3Click(Sender: TObject);
begin
if Assigned(t) then
t.AbortConnection;
end;

<Цитата>
vegarulez (13.10.10 16:35) [11]

давай по пунктам

что значит сделать полем класса формы?
т.е. объявить в type относящемуся к форме, т.е. к unit1 в public секции
t:Form1 ?

если сделать так, то процедура AbortConnection должна быть объявлена тоже в type относящемуся к unit1, чтобы компилятор её увидел и не сругнулся, соответсвенно если в этой процедуре будет обращаение к idhttp1 объявленному в type относящемуся к TDownLoadfile - то он его не видит и ругается... (

прошу не кидать в меня кирпичом - но реально ничего не понял (((

<Цитата>
vegarulez (13.10.10 16:38) [12]

если же t объявлять в type относящемуся к unit1
t:TDownLoadfile
то он пока ещё не видит объявления TDownLoadfile которое будет ниже и тоже ругается на переменную t...

p.s. про кирпичи - тоже что в предыдущем посте...

<Цитата>
Сергей М. © (13.10.10 16:55) [13]

TForm1 = class(TForm)
..
private
t:TDownLoadfile;
..
end;

....

t := TDownLoadfile.Create(...);

<Цитата>
Palladin © (13.10.10 20:35) [14]

по-моему на этом сайте не хватает еще одной конференции

<Цитата>
Сергей М. © (13.10.10 21:24) [15]

> Palladin © (13.10.10 20:35) [14]

"Патрепацца" ?)

<Цитата>
Palladin © (13.10.10 21:25) [16]

не )
Основная ("Начинающим" ("Никогда не закончащим"))

<Цитата>
Сергей М. © (13.10.10 22:02) [17]

> Palladin © (13.10.10 21:25) [16]

Я понял про что ты)

Но лучше бы таки "Орешник" реанимировать)

<Цитата>
sniknik © (15.10.10 18:27) [18]

> не )
> Основная ("Начинающим" ("Никогда не закончащим"))
детский сад. с лозунгом "нас не научишь..." под песню та-ту.

<Цитата>
vegarulez (17.10.10 14:38) [19]

Сергей М. © (13.10.10 16:55) [13]

Я же написал vegarulez (13.10.10 16:38) [12]
что когда так делаю - выскакивает ошибка при компиляции.
Так как

type
TDownLoadfile = class(TThread)
private
...
end;

Описан после описния TForm1 = class(TForm)
то он ругается при компиляции на

TForm1 = class(TForm)
..
private
t:TDownLoadfile;
..
end;

т.к. не знает что такое TDownLoadfile

<Цитата>
Anatoly Podgoretsky © (17.10.10 15:13) [20]

> vegarulez (17.10.2010 14:38:19) [19]

Поставь перед TDownLoadfile = class;

<Цитата>
sniknik © (17.10.10 15:42) [21]

имхо, лучше описать сам поток до формы... (какие то проблемы с тем что что форма не первая?), а еще лучше в отдельном модуле и прописать его в юзес раздела интерфасе.

<Цитата>
Плохиш © (17.10.10 16:14) [22]

> vegarulez (17.10.10 14:38) [19]

Тебе уже предлагали нанять программиста?

<Цитата>
Palladin © (17.10.10 16:47) [23]

Предлагаю нанять программиста.

<Цитата>
Anatoly Podgoretsky © (17.10.10 17:28) [24]

Все решение перебраны и это тоже.

<Цитата>
vegarulez (17.10.10 17:41) [25]

Anatoly Podgoretsky © (17.10.10 15:13) [20]
sniknik © (17.10.10 15:42) [21]

Спасибо большое.

<Цитата>
Anatoly Podgoretsky © (17.10.10 17:52) [26]

> vegarulez (17.10.2010 17:41:25) [25]

Да не за что, мы приложили все силы.

<Цитата>
HF-Trade © (19.10.10 07:27) [27]

> Из другого потока вызови IdHTTP.Socket.Close, тогда IdHTTP.
> Get() возвратит управление с соотв.исключением

Почему из другого потока?
Поясните почему не будет работать -
...
{В потоке}
AIdHttp := TIdHttp.Create(nil);
AIdHttp.OnWork := Form1.IdHttp1Work;
Try
Try
AIdHttp.Get(URL);
Except
end;
Finally
AIdHttp.Free;
....
{На форме}
procedure TForm1.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
IF Start = False Then
(ASender as TIdHttp).Socket.Close;
end;

<Цитата>
HF-Trade © (19.10.10 07:39) [28]

ошибся, Work, конечно, не workend

<Цитата>
sniknik © (19.10.10 08:10) [29]

> Почему из другого потока?
а почему у тебя так же? вот Http.Get у тебя в дополнительном, а Start для остановки ты False будешь присваивать в каком? судя по всему в другом, основном.
хочешь попытайся в том же, дополнительном, посмотрим как у тебя получится.

<Цитата>
HF-Trade © (19.10.10 08:37) [30]

ммм... событие Work можно описать и в доп.потоке.
Я и спрашиваю -
1. Почему из другого потока?
2. Почему не работает код выше? хотя там из VCL закрываем сокет, он тупо висит пока не закончится ConnectionTimeout

<Цитата>
HF-Trade © (19.10.10 08:43) [31]

То что Start присвоить false из другого потока понятно(основного к примеру), ибо доп.поток висит на Get, но сама процедура Work(если она созданна в доп. потоке), должна работать и в нем?

<Цитата>
sniknik © (19.10.10 09:32) [32]

> но сама процедура Work(если она созданна в доп. потоке), должна работать и в нем?
с чего такие инсинуации? код работает там где вызван, а не там где описан.

> Я и спрашиваю -
ты навыдумывал себе "страшилок" и спрашиваешь не по тому что предлагали, а по тому, что у тебя в голове.

<Цитата>
sniknik © (19.10.10 09:38) [33]

> Почему не работает код выше?
а он действительно не работает? тогда причина однозначна - вызов Get синхронный, пока не выполнится, дрогой код в этом потоке (неважно где описан) выполнятся не будет.

(вариант когда будет, это если описан метод типа onWorkInProccess который периодически вызывается в самом Get)

<Цитата>