Delphi 随印随流

Question

程序像往常一样冻结。中流怎么办？

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdCookieManager, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, ExtCtrls, Unit2;

type
  TForm1 = class(TForm)
    IdHTTP1: TIdHTTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    IdCookieManager1: TIdCookieManager;
    Button1: TButton;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
  private
    my:myth;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  my:=myth.Create(true);
  my.Priority:=tpNormal;
  my.FreeOnTerminate:=True;
  my.Resume;
end;

end.

流量

unit Unit2;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdCookieManager, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP, ExtCtrls;

type
  myth = class(TThread)
    IdHTTP1: TIdHTTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    IdCookieManager1: TIdCookieManager;
    Button1: TButton;
    Memo1: TMemo;
    Timer1: TTimer;
  private
    { Private declarations }
  protected
    procedure Execute; override;
    procedure meme;
    public
  end;

implementation

uses Unit1;

procedure myth.Execute;
begin
  Synchronize(meme);
end;

procedure myth.meme;
var
  s: string;
  list, lista: TStringList;
  resul: string;
begin
  list := TStringList.Create;
  Form1.Memo1.Clear;
  list.Add('...');
  list.Add('...');
  list.Add('...');
  list.Add('...');
  s := IdHTTP1.Post('https://,list);
  list.Free;
(LOGIN)
  resul := idHTTP1.Get('...');
  while Pos('tdn',resul) > 0 do begin //PRESS ON BUTTON
    lista := TStringList.Create;
    lista.Add('...');
    IdHTTP1.Post('https:...,lista);
    lista.Free;
  end;
end;

end.

Answer 1

您正在创建一个工作线程只是为了 Synchronize() 它的所有工作回到主 UI 线程。不要那样做！只同步真正需要它的部分。让线程直接调用 meme() 而无需 Synchronize()，然后让 meme() 使用 Synchronize() 访问 Form1.Memo1 和任何其他触及 UI 的内容。您的 TStringList 和 TIdHTTP 操作本身不需要同步，因为它们是 meme() 的本地操作（如果您创建 IdHTTP1、IdSSLIOHandlerSocketOpenSSL1 和 IdCookieManager1 在线程中动态对象，而不是在设计时在窗体上）。

尝试更像这样的东西：

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, Unit2;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
  private
    my: myth;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  my := myth.Create;
end;

end.

流量

unit Unit2;

interface

uses
  Classes, IdCookieManager, IdSSLOpenSSL, IdHTTP;

type
  myth = class(TThread)
    IdHTTP: TIdHTTP;
    IdSSLIOHandlerSocketOpenSSL: TIdSSLIOHandlerSocketOpenSSL;
    IdCookieManager: TIdCookieManager;
  private
    { Private declarations }
    procedure meme;
  protected
    procedure Execute; override;
  public
    constructor Create; reintroduce;
    destructor Destroy; override;
  end;

implementation

uses Unit1;

constructor myth.Create;
begin
  inherited Create(False);
  Priority := tpNormal;
  FreeOnTerminate := True;

  IdHTTP := TIdHTTP.Create(nil);

  IdSSLIOHandlerSocketOpenSSL := TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP);
  // configure as needed...
  IdHTTP.IOHandler := IdSSLIOHandlerSocketOpenSSL;

  IdCookieManager := TIdCookieManager.Create(IdHTTP);
  // configure as needed...
  IdHTTP.CookieManager := IdCookieManager;
end;

destructor myth.Destroy;
begin
  IdHTTP.Free;
  inherited;
end;

procedure myth.Execute;
begin
  meme;
end;

procedure myth.meme;
var
  list: TStringList;
  resul: string;
begin
  list := TStringList.Create;
  try
    Synchronize(ClearMemo);
    list.Add('...');
    list.Add('...');
    list.Add('...');
    list.Add('...');
    s := IdHTTP1.Post('https://...', list);
    list.Clear;
    ...
    resul := IdHTTP1.Get('...');
    while Pos('tdn', resul) > 0 do begin
      list.Clear;
      list.Add('...');
      IdHTTP1.Post('https://...', list);
      list.Clear;
    end;
  finally
    list.Free;
  end;
end;

procedure myth.ClearMemo;
begin
  Form1.Memo1.Clear;
end;

end.

Delphi 随印随流

Delphi flow with indy

delphi-7