程序像往常一样冻结。如何在流程中做?
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.
发布于 2018-12-11 08:30:36
创建工作线程只是为了将其所有工作Synchronize()
回主UI线程。别干那事!只同步实际需要的部分。让线程在没有Synchronize()
的情况下直接调用meme()
,然后让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.
https://stackoverflow.com/questions/53715229
复制相似问题