Delphi TIdHttp freezes thread

Question

У меня есть приложение, которое имеет несколько форм, каждая форма имеет поток, который выполняет GET() на заданном URL-адресе каждые 3 секунды ... проблема в том, что каждый вызов GET() пользовательского интерфейса зависает до тех пор, пока GET() не будет завершен, и как различные формы выполняют одно и то же действие каждые 3 секунды, приложение выполняется очень медленно, добавляет «IdAntiFreeze» в основную форму, большинство из них не работает, поэтому читайте «IdAntiFreeze», не работает в потоках, следует пример ниже:

private 
    { Private declarations } 
    GlobalHtml : String; 
    TimerGlobal : Integer; 

// Thread

TMyThread= class(TThread) 
private 
    FForm : TForm1; 
    strTemp: String; 
protected 
    procedure Execute; override; 
public 
    constructor Create(Form : TForm1; gpLinkTemp : String); 
    destructor Destroy; override; 
end; 

// получить строку HTTP

procedure TMyThread.GetStringHttp; 
var 
    meuIdHTTP : TIdHttp; 
    strResponse: String; 
begin 
    meuIdHTTP := TIdHTTP.Create(nil); 
    strResponse := meuIdHTTP.Get('url...'); //<-- freezes up complete 
    FForm.GlobalHtml := strResponse; //<-- private form variable 
end; 

// выполнить

procedure TMyThread.Execute; 
begin 
    while not (terminated) do 
    begin 
     Synchronize(GetStringHttp); 
     FForm.LabelStatus.Visible := False; 
     FForm.ButtonStatus.Enabled := False; 
     FForm.TimerStatus.Enabled := True; 
     if FForm.TimerGlobal >= 10 then 
     begin 
     Synchronize(UpdateGrid); 
     FForm.TimerGlobal := 0; 
     end; 
    end; 
end; 

// обновление TStringGrid по форме

procedure TForm1.UpdateGrid; 
begin 
//I update the TStringGrid here with the data of variable 
TSGridDados.Cells[0,1] := GlobalHtml; 
//... 
end; 

procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
Inc(TimerGlobal); 
end; 

Вызов Thread:

procedure TForm1.Button1Click(Sender: TObject); 
begin 
    TMyThread.Create(Self, 'string-url'); 
end; 

Если Интернет медленнее или сервер реагирует, еще хуже, Есть ли какая-либо специальная конфигурация в компоненте TIdHttp, чтобы избежать этого? Почему это происходит? Заранее спасибо!

Answer 1

Вот пример использования TIDHttp в потоке.
Вы можете использовать несколько потоков с TList или TThreadList вместо одного потока, как показано ниже.
Основная идея заключается в использовании «потокобезопасного» списка для waitinglist и resultlist.
waitinglist Используется для перечисления всех запросов на URL, а resultlist используется для отображения ответов от idhttp.get().

Timer по форме, используемой для ввода каждого элемента из resultlist для целей обновления графического интерфейса.

вот код:
.dfm:

object Form1: TForm1 
    Left = 0 
    Top = 0 
    Caption = 'Form1' 
    ClientHeight = 396 
    ClientWidth = 660 
    Color = clBtnFace 
    Font.Charset = DEFAULT_CHARSET 
    Font.Color = clWindowText 
    Font.Height = -11 
    Font.Name = 'Tahoma' 
    Font.Style = [] 
    OldCreateOrder = False 
    OnCloseQuery = FormCloseQuery 
    OnCreate = FormCreate 
    OnDestroy = FormDestroy 
    PixelsPerInch = 96 
    TextHeight = 13 
    object Splitter1: TSplitter 
    Left = 193 
    Top = 33 
    Height = 363 
    ExplicitLeft = 256 
    ExplicitTop = 248 
    ExplicitHeight = 100 
    end 
    object TreeView1: TTreeView 
    Left = 0 
    Top = 33 
    Width = 193 
    Height = 363 
    Align = alLeft 
    Indent = 19 
    ReadOnly = True 
    TabOrder = 0 
    OnChange = TreeView1Change 
    OnDeletion = TreeView1Deletion 
    end 
    object Memo1: TMemo 
    Left = 196 
    Top = 33 
    Width = 464 
    Height = 363 
    Align = alClient 
    Lines.Strings = (
     'Memo1') 
    ScrollBars = ssBoth 
    TabOrder = 1 
    WordWrap = False 
    end 
    object Panel1: TPanel 
    Left = 0 
    Top = 0 
    Width = 660 
    Height = 33 
    Align = alTop 
    BevelOuter = bvNone 
    TabOrder = 2 
    object Button1: TButton 
     Left = 5 
     Top = 5 
     Width = 75 
     Height = 25 
     Caption = 'get URL' 
     TabOrder = 0 
     OnClick = Button1Click 
    end 
    end 
    object IdAntiFreeze1: TIdAntiFreeze 
    Left = 56 
    Top = 64 
    end 
    object Timer1: TTimer 
    Interval = 33 
    OnTimer = Timer1Timer 
    Left = 56 
    Top = 120 
    end 
end 

.pas:

unit Unit1; 

interface 

uses 
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, 
    Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdAntiFreezeBase, 
    Vcl.IdAntiFreeze, IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, 
    Vcl.ComCtrls, Vcl.ExtCtrls, Vcl.StdCtrls, IdThreadSafe; 

type 

    TMyUrl = class(TStringlist) 
    private 
    fUrl:String; 
    end; 

    TMyThread= class(TThread) 
    private 
    fWaitingList : TIdThreadSafeObjectList; 
    fResultList : TIdThreadSafeObjectList; 
    protected 
    procedure Execute; override; 
    public 
    constructor Create(aWaitingList, aResultList:TIdThreadSafeObjectList); 
    end; 

    TForm1 = class(TForm) 
    IdAntiFreeze1: TIdAntiFreeze; 
    TreeView1: TTreeView; 
    Memo1: TMemo; 
    Splitter1: TSplitter; 
    Timer1: TTimer; 
    Panel1: TPanel; 
    Button1: TButton; 
    procedure FormCreate(Sender: TObject); 
    procedure FormDestroy(Sender: TObject); 
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
    procedure TreeView1Deletion(Sender: TObject; Node: TTreeNode); 
    procedure Timer1Timer(Sender: TObject); 
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode); 
    procedure Button1Click(Sender: TObject); 
    private 
    { Private declarations } 
    fWaitingList : TIdThreadSafeObjectList; 
    fResultList : TIdThreadSafeObjectList; 
    fThread  : TmyThread; //... You can change this to Multiple Threads instead 
    public 
    { Public declarations } 
    end; 

var 
    Form1: TForm1; 

implementation 

{$R *.dfm} 

{TMyThread} 
constructor TMyThread.Create(aWaitingList, aResultList:TIdThreadSafeObjectList); 
begin 
    inherited Create; 
    fWaitingList:=aWaitingList; 
    fResultList:=aResultList; 
end; 

procedure TMyThread.Execute; 
var 
    Url:TMyUrl; 
    http:TIdHttp; 
begin 
    while not Terminated do begin 
    url:=fWaitingList.Pop; 
    if assigned(url) then begin 
     http:=TIdHTTP.Create(nil); 
     try 
     try 
      url.Text:=http.Get(Url.fUrl); 
     except 
      on E:exception do 
      Url.Text:=E.Message; 
     end; 
     finally 
     http.Free; 
     fResultList.Add(Url); 
     end; 
    end else 
     sleep(100); 
    end; 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
    MyUrl:TMyUrl; 
    url:String; 
begin 
    url:='http://'; 
    if InputQuery('Add Url','Set Url',url) then begin 
    url:=trim(url); 
    if (sametext(copy(url,1,7),'http://')) and (length(url)>7) then begin 
     MyUrl:=TMyUrl.Create; 
     MyUrl.fUrl:=url; 
     fWaitingList.Add(MyUrl); 
    end; 
    end; 
end; 

procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
begin 
    fThread.Terminate; 
end; 

procedure TForm1.FormCreate(Sender: TObject); 
begin 
    fWaitingList:=TIdThreadSafeObjectList.Create; 
    fResultList:=TIdThreadSafeObjectList.Create; 
    fWaitingList.OwnsObjects:=true; 
    fResultList.OwnsObjects:=true; 
    fThread:=TMyThread.Create(fWaitingList, fResultList); 
end; 

procedure TForm1.FormDestroy(Sender: TObject); 
begin 
    FreeAndNil(fWaitingList); 
    FreeAndNil(fResultList); 
    FreeAndNil(fThread); 
end; 

//.... For updating GUI every 33 miliseconds 
procedure TForm1.Timer1Timer(Sender: TObject); 
var 
    url:TMyUrl; 
begin 
    url:=fResultList.Pop; 
    if assigned(url) then begin 
    with TreeView1.Items.AddChild(nil,url.fUrl) do 
     data:=url; 
    end; 
end; 

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode); 
begin 
    if TreeView1.Selected<>nil then 
    Memo1.Text:=TMyUrl(TreeView1.Selected.Data).Text; 
end; 

procedure TForm1.TreeView1Deletion(Sender: TObject; Node: TTreeNode); 
begin 
    TObject(Node.Data).Free; 
    Node.Data:=nil; 
end; 

end. 

Надежда этот небольшой пример может дать некоторое вдохновение для ваших работ.