Скачать: CL | DM;

idhttp.onwork   Найти похожие ветки 

← →
race1   (2004-08-06 08:20) [0]

в потоке создаём 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) [1]

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

---

Страницы: 1 вся ветка

Скачать: CL | DM;



Память: 0.45 MB
Время: 0.021 c