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

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

idhttp.onwork [D7]

race1 ©   (2004-08-06 08:20:00) 

в потоке создаём tidhttp, нчинаем качать файл (idhttp.get). но событие onwork происходит только один раз. оно же должно происходить пока файл не скачается, так?


type
 Tmy = class(TThread)
 private
   Fhttp: TIdHTTP;

   FAddress: String;
   FWork: Boolean;
   FWorking: Boolean
   FMemStream: TMemoryStream;

   FLogText: String;

   procedure OnWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
   procedure Synch;
 protected
   procedure Execute; override;
 public
   property Address: String read FAddress write FAddress;
   property Work: Boolean read FWork write FWork;
 end;

var
 myTh: Tmy;

implementation

uses
 Mainu, Math;

procedure Tmy.Execute;
begin
 Fhttp := TIdHTTP.Create(nil);
 Fhttp.OnWork := OnWork;
 FMemStream := TMemoryStream.Create;

 while not Terminated do
 begin
   // work - нужно начать качать, working - уже качаем, т.е. вызвали get
   if FWork and (not FWorking) then
   begin
     FWorking := True;
     FLogText := Format('Get (%s)', [FAddress]);
     Synchronize(Synch);

     Fhttp.Get(FAddress, FMemStream);
   end else
     Sleep(100);
 end;

 Fhttp.Free;
 FMemStream.Free;
end;

procedure Tmy.OnWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
 // если нужно прекратить закачку
 if FWork = False then
   Fhttp.Disconnect;

 FLogText := 'Working';
 Synchronize(Synch);
end;

procedure TRadio.Synch;
begin
 frmMain.lblOutSize.Caption := Format(frmMain.lblOutSize.Hint, [FMemStream.Size]);
 if FLogText <> '' then
   frmMain.mmLog.Lines.Add(FLogText);

 FLogText := '';  
end;


где не так?

---

race1   (2004-08-06 09:54:00) [1]

хм... после задания useragent'а заработало...

---

Наверх