| Форумы
ЧАТ |
Орешник |
|
| Форумы -» | Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG |
|
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
Как остановить закачку в IdHttp? [D7, WinXP]
vegarulez © (2010-10-12 10:30:00)Привет всем мастерам!
Вопрос состоит в следующем в основном потоке создаётся дополнительный - который скачивает с сервера нужный мне файл, и докачивает его, потом если вдруг соединение к интернету было разорвано. Вопрос заключается в следующем - как принудительно отключить скачивание, по нажатию на кнопоку.
Т.к. там происходит взаиможействи на уровне 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;
sniknik (2010-10-19 09:38:00) [1]> Почему не работает код выше?
а он действительно не работает? тогда причина однозначна - вызов Get синхронный, пока не выполнится, дрогой код в этом потоке (неважно где описан) выполнятся не будет.
(вариант когда будет, это если описан метод типа onWorkInProccess который периодически вызывается в самом Get)
sniknik (2010-10-19 09:32:00) [2]> но сама процедура Work(если она созданна в доп. потоке), должна работать и в нем?
с чего такие инсинуации? код работает там где вызван, а не там где описан.
> Я и спрашиваю -
ты навыдумывал себе "страшилок" и спрашиваешь не по тому что предлагали, а по тому, что у тебя в голове.
HF-Trade (2010-10-19 08:43:00) [3]То что Start присвоить false из другого потока понятно(основного к примеру), ибо доп.поток висит на Get, но сама процедура Work(если она созданна в доп. потоке), должна работать и в нем?
HF-Trade (2010-10-19 08:37:00) [4]ммм... событие Work можно описать и в доп.потоке.
Я и спрашиваю -
1. Почему из другого потока?
2. Почему не работает код выше? хотя там из VCL закрываем сокет, он тупо висит пока не закончится ConnectionTimeout
sniknik (2010-10-19 08:10:00) [5]> Почему из другого потока?
а почему у тебя так же? вот Http.Get у тебя в дополнительном, а Start для остановки ты False будешь присваивать в каком? судя по всему в другом, основном.
хочешь попытайся в том же, дополнительном, посмотрим как у тебя получится.
HF-Trade (2010-10-19 07:39:00) [6]ошибся, Work, конечно, не workend
HF-Trade (2010-10-19 07:27:00) [7]
> Из другого потока вызови 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;
Anatoly Podgoretsky (2010-10-17 17:52:00) [8]> vegarulez (17.10.2010 17:41:25) [25]
Да не за что, мы приложили все силы.
vegarulez (2010-10-17 17:41:00) [9]Anatoly Podgoretsky © (17.10.10 15:13) [20]
sniknik © (17.10.10 15:42) [21]
Спасибо большое.
Anatoly Podgoretsky (2010-10-17 17:28:00) [10]Все решение перебраны и это тоже.
Palladin (2010-10-17 16:47:00) [11]Предлагаю нанять программиста.
Плохиш (2010-10-17 16:14:00) [12]
> vegarulez (17.10.10 14:38) [19]
Тебе уже предлагали нанять программиста?
sniknik (2010-10-17 15:42:00) [13]имхо, лучше описать сам поток до формы... (какие то проблемы с тем что что форма не первая?), а еще лучше в отдельном модуле и прописать его в юзес раздела интерфасе.
Anatoly Podgoretsky (2010-10-17 15:13:00) [14]> vegarulez (17.10.2010 14:38:19) [19]
Поставь перед TDownLoadfile = class;
vegarulez (2010-10-17 14:38:00) [15]Сергей М. © (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
sniknik (2010-10-15 18:27:00) [16]> не )
> Основная ("Начинающим" ("Никогда не закончащим"))
детский сад. с лозунгом "нас не научишь..." под песню та-ту.
Сергей М. (2010-10-13 22:02:00) [17]
> Palladin © (13.10.10 21:25) [16]
Я понял про что ты)
Но лучше бы таки "Орешник" реанимировать)
Palladin (2010-10-13 21:25:00) [18]не )
Основная ("Начинающим" ("Никогда не закончащим"))
Сергей М. (2010-10-13 21:24:00) [19]
> Palladin © (13.10.10 20:35) [14]
"Патрепацца" ?)
Palladin (2010-10-13 20:35:00) [20]по-моему на этом сайте не хватает еще одной конференции
| |
Страницы: 