| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

Как остановить закачку в IdHttp? [D7, WinXP]

Страницы:   < 1 2 >

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;


---

Сергей М.   (2010-10-13 16:55:00) [21]

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

....

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

---

vegarulez   (2010-10-13 16:38:00) [22]

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

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

---

vegarulez   (2010-10-13 16:35:00) [23]

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

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

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

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

---

Сергей М.   (2010-10-13 11:23:00) [24]

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   (2010-10-13 11:11:00) [25]

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

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

---

vegarulez   (2010-10-13 11:10:00) [26]

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

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

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

---

Сергей М.   (2010-10-13 11:04:00) [27]

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

в t мусор

---

sniknik   (2010-10-13 10:28:00) [28]

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

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

end;

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

---

vegarulez   (2010-10-13 10:14:00) [29]

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

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

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

---

Сергей М.   (2010-10-12 12:46:00) [30]

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


Нафига ?

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

---

DiamondShark   (2010-10-12 12:10:00) [31]

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

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

---

vegarulez   (2010-10-12 11:16:00) [32]

перенёс описание 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;

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

---

Сергей М.   (2010-10-12 11:06:00) [33]

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

---

Страницы:   < 1 2 >

Наверх