delphi判断线程是否正在运行

时间:2023-01-12 14:58:14

相关资料:
http://www.delphitop.com/html/xiancheng/376.html

 unit Unit1;

 interface

 uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls; type
TMyThread = class(TThread)//自定义的线程
protected
procedure Execute; override;
end; TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1;
mytd: TMyThread;//线程对像
implementation {$R *.dfm} //返回值:0-已释放;1-正在运行;2-已终止但未释放;3-未建立或不存在
function CheckThreadFreed(aThread: TThread): Byte;
var
I: DWord;
IsQuit: Boolean;
begin
if Assigned(aThread) then
begin
IsQuit := GetExitCodeThread(aThread.Handle, I);
if IsQuit then //If the function succeeds, the return value is nonzero.
//If the function fails, the return value is zero.
begin
if I = STILL_ACTIVE then //If the specified thread has not terminated,
//the termination status returned is STILL_ACTIVE.
Result :=
else
Result := ; //aThread未Free,因为Tthread.Destroy中有执行语句
end
else
Result := ; //可以用GetLastError取得错误代码
end
else
Result := ;
end; procedure TMyThread.Execute;
var
I: Integer;
begin
for I := to do
begin
Form1.Canvas.Lock;
Form1.Canvas.TextOut(, , IntToStr(I));
Form1.Canvas.Unlock;
end;
end; procedure TForm1.Button1Click(Sender: TObject);
begin
if CheckThreadFreed(mytd)<> then //判断线程是否存在
begin
mytd := TMyThread.Create(True);
mytd.FreeOnTerminate := True;
mytd.Resume;
end;
end; end.