VPF::IdHttp+IdAntiFreeze - Форум программистов

AndreyZ53

Дата 18.8.2009, 14:52 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 138
Регистрация: 22.8.2008

Репутация: 1
Всего: 2

Здравсвуйте, у меня такой вопрос: у меня на форме есть меню, таймер, IdHttp и IdAntiFreeze, на таймере через IdHttp я загружаю сраничку методом GET. Таймер стоит на 5 секунды, то есть каждые 5 секунд у меня загружается страница, так вот, когда я, во время загрузки страницы, выбираю пункт меню какой-нибудь, программа и само меню зависает на время, пока не загрузиться страничка, а потом отвисает и норм опять. Можно как-то сделать чтобы она не зависала и во время загрузки сраницы через IdHttp, программа работала как обычно?

Это сообщение отредактировал(а) AndreyZ53 - 18.8.2009, 15:24

--------------------

https://itbases.ru/

Matematik

Дата 18.8.2009, 16:03 (ссылка)

(голосов:2)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

> Можно как-то сделать чтобы она не зависала и во время загрузки сраницы через IdHttp

Самый надежный способ - вынести работу с HTTP в отдельный поток (thread)
Примерно так:

Код


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    procedure StatusEvent(ASender:TObject; const AString:String);
    procedure WorkEvent(ASender:TObject; const AWorkCount: Integer);
    procedure WorkBegin(ASender:TObject; const AWorkCountMax: Integer);
    procedure WorkEnd(ASender:TObject);
    procedure HttpFinish(ASender:TObject);
    procedure ThreadTerminate(Sender: TObject);
  public
    { Public declarations }
  end;

type
  TStatusEvent = procedure(ASender:TObject; const AString:String) of object;
  TWorkEvent   = procedure(ASender:TObject; const AWorkCount: Integer) of object;
  TWorkBegin   = procedure(ASender:TObject; const AWorkCountMax: Integer) of object;
  TWorkEnd     = procedure(ASender:TObject) of object;

type
  THttpThread = class(TThread)
  private
    FTmpStr      : String;
    FTmpInt      : Integer;
    FWorkMax     : Integer;
    FHttp        : TIdHTTP;
    FResponse    : string;
    FOnStatus    : TStatusEvent;
    FOnWork      : TWorkEvent;
    FOnWorkBegin : TWorkBegin;
    FOnWorkEnd   : TWorkEnd;
    FOnHttpGetFinish : TNotifyEvent
    //---------------------------
    procedure Status(const AString:String);
    procedure DoStatus;
    procedure Work(const AWorkCount:Integer);
    procedure DoWork;
    procedure WorkBegin(const AWorkCountMax:Integer);
    procedure DoWorkBegin;
    procedure WorkEnd;
    procedure DoWorkEnd;
    procedure HttpGetFinish;
    procedure DoHttpGetFinish;
    //---------------------------
    procedure HTTPWork(Sender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer);
    procedure HTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer);
    procedure HTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
    procedure HTTPStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string);
  public
    constructor Create;
    destructor Destroy; override;
    //---------------------------
    procedure Execute; override;
    //---------------------------
    property Response    : string       read FResponse    write FResponse;
    property OnStatus    : TStatusEvent read FOnStatus    write FOnStatus;
    property OnWork      : TWorkEvent   read FOnWork      write FOnWork;
    property OnWorkBegin : TWorkBegin   read FOnWorkBegin write FOnWorkBegin;
    property OnWorkEnd   : TWorkEnd     read FOnWorkEnd   write FOnWorkEnd;
    property OnHttpGetFinish: TNotifyEvent read FOnHttpGetFinish write FOnHttpGetFinish;

  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ THttpThread }

constructor THttpThread.Create;
begin
  inherited Create(True);
  FreeOnTerminate := True;
  FHttp := TIdHTTP.Create(nil);
  with FHttp do
  begin
    ReadTimeout     := 30000;
    ConnectTimeout  := 30000;
    SendBufferSize  := 1024;
    RecvBufferSize  := 1024;
    HTTPOptions     := [hoKeepOrigProtocol];
    HandleRedirects := False;
    RedirectMaximum := 5;
    AllowCookies    := True;
    OnWork          := HTTPWork;
    OnWorkBegin     := HTTPWorkBegin;
    OnWorkEnd       := HTTPWorkEnd;
    OnStatus        := HTTPStatus;
    with Request do
    begin
      UserAgent := 'Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.8.1.8) Gecko/20071022 Ubuntu/7.10 (gutsy) Firefox/2.0.0.11';
      Referer   := 'http://ipicture.ru/';
      Accept    := 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8';
      AcceptLanguage := 'ru,en-us;q=0.7,en;q=0.3';
      AcceptEncoding := 'gzip,deflate';
      AcceptCharset  := 'windows-1251,utf-8;q=0.7,*;q=0.7';
      Connection := 'keep-alive';
      with CustomHeaders do
      begin
        Add('Keep-Alive: 300');
      end;
    end;
  end;
  FFileName    := ''; 
  FResponse    := '';
  FOnStatus    := nil;
  FOnWork      := nil;
  FOnWorkBegin := nil;
  FOnWorkEnd   := nil;

end;

destructor THttpThread.Destroy;
begin
  FHttp.Free;
  inherited;
end;


procedure THttpThread.DoWork;
begin
  FOnWork(Self, FTmpInt);
end;

procedure THttpThread.Work(const AWorkCount: Integer);
begin
  if Assigned(FOnWork) then
  begin
    FTmpInt := AWorkCount;
    Synchronize(DoWork);
  end;
end;

procedure THttpThread.DoWorkBegin;
begin
  FOnWorkBegin(Self, FTmpInt);
end;

procedure THttpThread.WorkBegin(const AWorkCountMax: Integer);
begin
  if Assigned(FOnWorkBegin) then
  begin
    FTmpInt := AWorkCountMax;
    Synchronize(DoWorkBegin);
  end;
end;

procedure THttpThread.DoWorkEnd;
begin
  FOnWorkEnd(Self)
end;

procedure THttpThread.WorkEnd;
begin
  if Assigned(FOnWorkEnd) then
  begin
    Synchronize(DoWorkEnd);
  end;
end;

procedure THttpThread.DoStatus;
begin
  FOnStatus(Self, FTmpStr);
end;

procedure THttpThread.Status(const AString: String);
begin
  if Assigned(FOnStatus) then
  begin
    FTmpStr := AString;
    Synchronize(DoStatus);
  end;
end;

procedure THttpThread.DoHttpGetFinish;
begin
  FOnHttpGetFinish(Self)
end;

procedure THttpThread.HttpGetFinish;
begin
  if Assigned(FOnHttpGetFinish) then
  begin
    Synchronize(DoHttpGetFinish);
  end;
end;

procedure THttpThread.HTTPStatus(ASender: TObject; const AStatus: TIdStatus;
  const AStatusText: string);
begin
  Status(AStatusText);
end;

procedure THttpThread.HTTPWork(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  if FWorkMax<>0 then
    Work(Round(AWorkCount / FWorkMax * 100));
  if Termanated and (Sender is TIdHttp) then
    (Sender as TIdHttp).Disconnect;
end;

procedure THttpThread.HTTPWorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  if AWorkMode=wmWrite then
    Status('Отправка запроса')
  else if AWorkMode=wmRead then
    Status('Получение ответа');

  FWorkMax := AWorkCountMax;
  WorkBegin(AWorkCountMax);
end;

procedure THttpThread.HTTPWorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
  Status('Завершено');
  WorkEnd;
end;


procedure THttpThread.Execute;
var j:Integer;
begin
  Status('Start');
  while not Termanated do
  begin
    FResponse := FHttp.Get('http://ya.ru'); //***
    //---
    // пауза 5 секунд
    for j:=1 to 50 do
      if Termanated then Exit
      else sleep(100);
  end;
  Status('Stop');
end;

procedure TForm1.Button1Click(Sender: TObject);
var T:THttpThread;
begin
  T := THttpThread.Create;
  T.OnStatus    := StatusEvent;
  T.OnWork      := WorkEvent;
  T.OnWorkBegin := WorkBegin;
  T.OnWorkEnd   := WorkEnd;
  T.OnTerminate := ThreadTerminate;
  T.OnHttpGetFinish := HttpFinish;
  T.Resume;
end;

procedure TForm1.StatusEvent(ASender: TObject; const AString: String);
begin
  Memo1.Lines.Add(AString)
end;

procedure TForm1.ThreadTerminate(Sender: TObject);
begin
  if (Sender is THttpThread) then
  begin
    with (Sender as THttpThread) do
    begin
      if FatalException<>nil then
      begin
        Application.ShowException(Exception(FatalException));
      end;
      Memo1.Lines.Add(Response)
    end;
  end;
end;

procedure TForm1.WorkBegin(ASender: TObject; const AWorkCountMax: Integer);
begin
//  Memo1.Lines.Add('WorkBegin '+IntToStr(AWorkCountMax))
end;

procedure TForm1.WorkEnd(ASender: TObject);
begin
//  Memo1.Lines.Add('WorkEnd')
end;

procedure TForm1.HttpFinish(ASender: TObject);
begin
  if Sender is THttpThread then
    Showmessage((Sender as THttpThread).Response)
end;

procedure TForm1.WorkEvent(ASender: TObject; const AWorkCount: Integer);
begin
  Memo1.Lines.Add(IntToStr(AWorkCount)+'%')
end;

end.

AndreyZ53

Дата 18.8.2009, 16:54 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 138
Регистрация: 22.8.2008

Репутация: 1
Всего: 2

Цитата(Matematik @ 18.8.2009, 16:03)

> Можно как-то сделать чтобы она не зависала и во время загрузки сраницы через IdHttp

Самый надежный способ - вынести работу с HTTP в отдельный поток (thread)

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

--------------------

https://itbases.ru/

Matematik

Дата 18.8.2009, 17:23 (ссылка)

(голосов:2)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

Попробуй поставить IdAntiFreeze1.OnlyWhenIdle в False.
Но это по прежнему костыль, понормальному надо выносить долгие операция тем более с блокировкой в отдельный от главного поток

AndreyZ53

Дата 18.8.2009, 17:36 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 138
Регистрация: 22.8.2008

Репутация: 1
Всего: 2

Хорошо, начну с простого в потоках. Например я подключаюсь к БД MYSQL на хостинге и на время подключения форма зависает, а у меня там есть анимация типа Имитация подключения, но когда идет подключение она зависает и анимация не проигрывается, её даже на форме не видно, так вот как я выношу в поток, я правильно делаю (З. Ы. с потоками работай сейчас в первый раз)

Код


type
 TNewThread = class(TThread)
 public
  procedure DoConnectMySql;
 protected
  procedure Execute; override;
 end;



procedure TNewThread.DoConnectMySql;
begin
   Form2.MyConnection1.Server:='';
   Form2.MyConnection1.Username:='';
   Form2.MyConnection1.Password:='';
   Form2.MyConnection1.Database:='';
   Form2.MyConnection1.Connect;
end;


procedure TNewThread.Execute;
begin
  inherited;
   Synchronize(DoConnectMySql);
end;

И вот как мне сейчас сделать по нажатию на кнопку, чтобы высота окна расширялась на 100px и там появлялись

Код


   RxGIFAnimator1.Visible:=True;
   Label9.Visible:=True;

Ну то, что я говорил анимация появлялаль, но не зависала. Я вот чуток из примера вашего что понял сделал так, а вот не получается у меня чего-то, чтобы не зависало по нажатию на кнопку "Подключиться"

Это сообщение отредактировал(а) AndreyZ53 - 18.8.2009, 17:39

--------------------

https://itbases.ru/

Matematik

Дата 18.8.2009, 20:37 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1027
Регистрация: 11.3.2006

Репутация: 24
Всего: 50

Очень рекомендую почитать о потоках в Delphi http://forum.vingrad.ru/forum/topic-60076.html

По коду:
- inherited; в методе Execute не нужен
- Synchronize() используется для синхронизации данных с основным потоком; выполняется Synchronize в контексте основного потока, доп. поток при этом останавливается и ждет завершения выполнения метода DoConnectMySql

Код


// Это будет выполнено в основном потоке, соответственно его заблокирует.
procedure TNewThread.DoConnectMySql;
begin
   Form2.MyConnection1.Server:='';
   Form2.MyConnection1.Username:='';
   Form2.MyConnection1.Password:='';
   Form2.MyConnection1.Database:='';
   Form2.MyConnection1.Connect;
end;

- Обращение к компонентам на форме (Form2.MyConnection1) из доп.потока чревато неконтролируемыми ошибками. Например, при завершении программы MyConnection1 уничтожится из главного потока (MyConnection1.Free;) и в это самое время доп. поток что-нибудь сделает с MyConnection1 - в лучшем случае последует access violation at address.
Тут можно создавать (и уничтожать) объекты в контексте доп.потока или сделать так, чтобы главный поток не обращался к компонентам, когда с ними работает доп.поток.

AndreyZ53

Дата 29.8.2009, 16:15 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 138
Регистрация: 22.8.2008

Репутация: 1
Всего: 2

Вот как-то замолчал я, просто чуток появилось время и начал разбираться в потоках, не хотел я тревожить так часто своими глупыми вопросами, и поэтому пытался как-то вссе уладить сам. Но я вот уже даже и обрадывался, как нажал на кнопку подключить и форма расширелась и появился процесс загрузки без зависона формы. Но не тут то было теперь почему-то данные для подключения не подходят, хотя если подлкючаюсь с этими данными с зависоном формы, то все норм. Может поможет мне кто
Вот мои 2 процедуры, которые я использую для подключения

Код


procedure TForm2.ConnectionMySQL(Connet: TMyConnection);
begin
   Connet.Server:='host';
   Connet.Username:='user';
   Connet.Password:='pass';
   Connet.Database:='bd';
   Connet.Connect;
end;

procedure TForm2.Con;
begin
   ConnectionMySQL(MyConnection1);
end;

Вот unit моего потока

Код


unit Unit9;

interface

uses
  Classes,unit2;

type
  TMyThread = class(TThread)
  private
    { Private declarations }
  protected
    procedure Execute; override;
  end;

implementation

{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure TMyThread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ TMyThread }

procedure TMyThread.Execute;
begin
  { Place thread code here }
  //while not Terminated do
   Synchronize(Form2.Con);
end;

end.

А вот, что я пишу на кнопку

Код


var
T:TMyThread;
begin
  try
   Form2.Height:=314;
   RxGIFAnimator1.Visible:=True;
   Label9.Visible:=True;
   T:=TMyThread.Create(True);
   T.Priority := tpLower;
   T.Resume;
   .........
  здесь идет затем запрос к БД, если подрубилось и переход на 2 форму Form3.Show;
   except
   end;

Так вот зависно уже нету, форма нормально расширяется и показывается анимация, все норм, но сейчас уже не подключается. Но если я возвращаю в прежнюю ситуацию с зависоном, то подключается все норм с теми же данными, что и в потоке для подключения. Может я не правильно оформил как-то процедуры или что, может кто и подскажет. Спасибо

--------------------

https://itbases.ru/

MetalFan

Дата 29.8.2009, 21:56 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 14
Всего: 128

AndreyZ53, прочитай внимательно пост Matematikа, и затем предложенную им статью... бред пока что у тебя написан

--------------------

There are always someone smarter than you...

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Сети \| Следующая тема »