как предотвратить поток, чтобы заморозить основное приложение в Delphi - PullRequest
Новая
       14

как предотвратить поток, чтобы заморозить основное приложение в Delphi

0 голосов
/ 24 октября 2019

Я работаю над проектом Delphi. Я создал класс, который помогает мне подключаться к сети внутри потока;

У меня проблема. Эта тема останавливает основное приложение до тех пор, пока не будет получен полный ответ.

, поэтому мне нужна ваша помощь для преодоления этой проблемы.

Web.pas 

unit Web;

interface

uses
  SysUtils, Classes, IdBaseComponent, Dialogs,
  IdComponent,
  IdTCPConnection,
  IdTCPClient,
  IdHTTP,
  idMultipartFormData;

type
  TCallBack = reference to procedure(res: String);

type
  TWebThread = class(TThread)
  private
    iniRes, iniURL: String;
    iniParams: TStringList;
    iniCallBack: TCallBack;
    Error : String;
    // var iniCallBack: reference to procedure(arg1:string);
  public
    constructor Create(url:String; Params:TStringList; CallBack:TCallBack);
    // destructor Destroy; override;
    procedure Execute(); override;
  end;

implementation

constructor TWebThread.Create(url:String; Params:TStringList; CallBack:TCallBack);
begin

  FreeOnTerminate := True;
  inherited Create(false);

  Self.FreeOnTerminate := True;
  Self.iniURL := url;
  Self.iniCallBack := CallBack;
  Self.iniParams := TStringList.Create;
  iniParams.Assign(Params);

end;


procedure TWebThread.Execute();
var
  lParam: TIdMultipartFormDataStream;
  IHTTP: TIDHTTP;
  i:Integer;
begin

  // inherited;
  IHTTP := TIDHTTP.Create(nil);
  lParam := TIdMultipartFormDataStream.Create;
  IHTTP.Request.UserAgent := 'Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/70.0.3538.77 Safari/537.36';

  for i := 0 to iniParams.Count-1 do
  begin
    lParam.AddFormField(iniParams.Names[i], iniParams.ValueFromIndex[i]);
  end;




  try
    try
      iniRes := IHTTP.Post(iniURL, lParam);

      Synchronize(PROCEDURE
                  BEGIN
                    iniCallBack(iniRes);
                  END);


    Except
      on E: Exception do
        Error := E.ClassName + ' error raised, with message : ' + E.Message;
    end;
  finally
    FreeAndNil(IHTTP);
    FreeAndNil(iniParams);
  end;

end;

end.

Ивот как использовать: 

procedure TMainForm.Button2Click(Sender: TObject);
var
  Params: TStringList;
  Web: TWebThread;

begin
  Params := TStringList.Create;
  Params.AddPair('Name','Ahmad');
  Params.AddPair('Family','Khaliq');
  Web := TWebThread.Create('http://localhost/get.php', Params,procedure (res : string)
        begin
           Label1.Caption := res;
        end);
  Web.Execute;
end;

Это моя проблема: эта тема останавливает основное приложение, пока не получит полный ответ idHTTP

1 Ответ

1 голос
/ 24 октября 2019

Я думаю (но не проверил), что причиной является ваш явный вызов Web.Execute из вашего основного потока.

Метод Execute потока должен быть (и будет автоматически) вызываться изв самом потоке - он не предназначен для вызова из основного потока.

Поэтому попробуйте удалить вызов Web.Execute и посмотреть, не решит ли это проблему, с которой вы столкнулись.

Синхронизировать извлечение кода: 

 if (CurrentThread.ThreadID = MainThreadID) and not (QueueEvent and ForceQueue) then
  begin
    if Assigned(ASyncRec.FMethod) then
      ASyncRec.FMethod()
    else if Assigned(ASyncRec.FProcedure) then
      ASyncRec.FProcedure();
  end else
...