idhttp как узнать что страница скачана/загружена до конца?

[Alar]

Пробовал несколько способов. опираясь на эту тему

http://programmersforum.ru/showthread.php?t=133875

Сейчас получил вот такой код, но он не работает. есть идеи?

цель - дождаться загрузки страницы, перед тем как перейти к загрузке следующей.

unit work;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    IdHTTP1: TIdHTTP;
    procedure Button1Click(Sender: TObject);
    procedure IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCount: Integer);
    procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
      const AWorkCountMax: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
   download_status:integer;
   WorkCountMax, WorkCount:integer;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var i:integer;
label a;
begin
for i:=0 to memo1.Lines.Count-1 do
  begin
   download_status:=1;
   memo2.text:=idhttp1.Get('http://'+memo1.Lines[i]);

   while WorkCount<>WorkCountMax do
   application.ProcessMessages;
  end;
end;

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
 WorkCount:=AWorkCount
end;

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  WorkCountMax:=AWorkCountMax;
end;

end.

Вот здесь подвисает цикл хотя по логике WorkCount должно сравняться с WorkCountMax

while WorkCount<>WorkCountMax do
   application.ProcessMessages;

[uberchel]

может что то не так понял, но а пробовал try finally ?

[Alar]

Сообщение от uberchel

может что то не так понял, но а пробовал try finally ?

а чем это поможет?

Сделал более визуально отслеживаемый вариант, на третей итерации спотыкается.

на форме memo1 со списком юрлов без http
кнопка и 3 label

Ушёл спать. может за ночь что-нибудь придумаю или кто подскажет

unit work;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, StdCtrls, IdAntiFreezeBase, IdAntiFreeze;


 Type TTransferThread = Class(TThread)
private
{ Private declarations }
FIdHTTP : TIdHTTP;
FConnected: Boolean;
FFileList : TStringList;
public
{ Public declarations }
WorkCountMax: Integer;
WorkCount : Integer;
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure IdHTTP1Work (Sender: TObject; AWorkMode: TWorkMode; const AWorkCount : Integer);
procedure IdHTTP1WorkEnd (Sender: TObject; AWorkMode: TWorkMode);
procedure IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
procedure Execute; override;
end;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    IdHTTP1: TIdHTTP;
    Button2: TButton;
    IdAntiFreeze1: TIdAntiFreeze;
    Label1: TLabel;
    Label2: TLabel;
    Label0: TLabel;
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    TransferThread: TTransferThread;
procedure UpdateCaption();
  end;

var
  Form1: TForm1;
   checkcount:integer;
implementation

{$R *.dfm}

{ TTransferThread }
constructor TTransferThread.Create(CreateSuspended: Boolean);
begin
inherited;
FFileList:= TStringList.Create;
FIdHTTP := TIdHTTP.Create(nil);
end;

destructor TTransferThread.Destroy;
begin
FIdHTTP.Free;
FFileList.Free;
inherited;
end;

procedure TTransferThread.Execute;
var i: Integer;
label a;
begin
FIdHTTP.OnWork:=IdHTTP1Work;
FIdHTTP.OnWorkBegin:=IdHTTP1WorkBegin;
FIdHTTP.OnWorkEnd:=IdHTTP1WorkEnd;

for checkcount:=0 to form1.memo1.lines.Count-1 do
begin

   form1.memo2.text:=FIdHTTP.Get('http://'+form1.memo1.Lines[checkcount]);

while form1.label1.caption<>form1.label2.caption do  application.ProcessMessages;
   end;

end;

procedure TTransferThread.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
begin
WorkCount := AWorkCount;
Synchronize(Form1.UpdateCaption);
end;

procedure TTransferThread.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
begin
FConnected:=True;
WorkCountMax:=AWorkCountMax ;
Synchronize(Form1.UpdateCaption);
end;

procedure TTransferThread.IdHTTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
FConnected:=False;
Synchronize(Form1.UpdateCaption);
end;

 procedure TForm1.UpdateCaption();
begin

Label0.Caption:=(inttostr(checkcount));
Label1.Caption:=(inttostr(TransferThread.WorkCount));
Label2.Caption:=(inttostr(TransferThread.WorkCountMax));

end;

procedure TForm1.Button1Click(Sender: TObject);
begin
TransferThread:=TTransferThread.Create(True);
TransferThread.Resume;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
checkcount:=0;
end;

end.

[Квэнди]

Ошибку в студию.
а вот так:

while form1.label1.caption<>form1.label2.caption do  application.ProcessMessages;
   end;

делать лучше не надо
application.ProcessMessages;
лучше писать в IdHTTP1Work

[Alar]

Второй код вполне рабочий. Запустил приложение без Delphi - есть один сайт на котором проиходит зависание. этот сайт был просмотрен в браузере и был заметен редирект на www. Это исправимо

[Квэнди]

сама по- себе проверка:
form1.label1.caption<>form1.label2. caption
не надежна, поэтому велика вероятность безконечного цикла.
А не надежна она потому, что страница может отдать один content-length, а какой- нибудь быдлокодер сделает там подгрузку на js-е чего -нибудь куда- нибудь...

[Alar]

Сообщение от Квэнди

Ошибку в студию.
а вот так:

while form1.label1.caption<>form1.label2.caption do  application.ProcessMessages;
   end;

делать лучше не надо
application.ProcessMessages;
лучше писать в IdHTTP1Work

Действительно работает. Хотя этот вариант рассматривался прежде всего. в любом случае редирект надо обрабатывать на www. Подвисает аналогично моему варианту

[GreyScall]

TIdHTTP работает синхронно... То есть пока файл не загрузится полностью управление не передаётся дальше... Это для какого-нибудь TWebBrowser'а нужно проверку делать "полностью ли загрузилось"...

Procedure TForm1.Button1Click(Sender: TObject);
Var i, n: integer;
Begin
n:=Memo1.Lines.Count-1;
ProgressBar1.Position:=0;
ProgressBar1.Max:=n+1;
For i:=0 To n Do
      Begin
      Memo2.Text:=IdHTTP1.Get('http://'+Memo1.Lines[i]);
      ProgressBar1.Position:=i+1;
      Application.ProcessMessages;
      End;
End;

Procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode; Const AWorkCount: Integer);
Begin
ProgressBar2.Position:=AWorkCount;
Application.ProcessMessages;
End;

Procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode; Const AWorkCountMax: Integer);
Begin
ProgressBar2.Position:=0;
ProgressBar2.Max:=AWorkCountMax;
Application.ProcessMessages;
End;

В чём выражается "подвисает"?

[Alar]

Сообщение от GreyScall

В чём выражается "подвисает"?

Если запускать не из среды. то при возникновения редиректа - программа зависает, но, теперь, поняв эту ошибку, я могу сделать обработчик редиректа.

[Квэнди]

То есть пока файл не загрузится полностью управление не передаётся дальше...

не совсем так. для передачи управления в процессе загрузки есть синхронизирующие события onwork...