![](https://images.cnblogs.com/OutliningIndicators/ContractedBlock.gif)
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type PMyParam = ^TMyParam; TMyParam = record title: pchar; str: pchar; end; type TForm1 = class(TForm) btn1: TButton; procedure btn1Click(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormDestroy(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; ThdHandle: THandle; //线程句柄 ThdCount: Integer; //全局变量: 显示线程数量 CS: TRTLCriticalSection; //临界变量 (对象在Windows单元中) implementation {$R *.dfm} function ThreadProc(P: Pointer): DWORD; stdcall; var h: hmodule; MyMessagebox: function(hWnd: hWnd; lpText, lpCaption: PChar; uType: UINT): Integer; stdcall; begin result := 0; h := LoadLibrary('user32.dll'); if h > 0 then begin EnterCriticalSection(CS); //临界开始 PMyParam(P)^.title := PChar('测试Thread[' + IntToStr(ThdCount) + ']'); @MyMessagebox := GetProcAddress(h, 'MessageBoxA'); if @MyMessagebox <> nil then MyMessagebox(0, PMyParam(P)^.str, PMyParam(P)^.title, 0); freeLibrary(h); ThdCount := ThdCount + 1; EnterCriticalSection(CS); //临界结束 end; end; procedure TForm1.btn1Click(Sender: TObject); var P: PMyParam; ID: DWORD; i: integer; begin GetMem(P, sizeof(PMyParam)); //分配内存 try P.title := '测试'; //填充 P.str := '线程MessageBoxA'; ThdHandle := createthread(nil, 0, @ThreadProc, P, 0, ID); //INFINITE一直等待信号 1000等1秒的信号 5000等待5秒内的信号 //信号结果: WAIT_OBJECT_0:线程退出 WAIT_TIMEOUT:现场超时 WAIT_FAILED调用线程失败 if WaitForSingleObject(ThdHandle, 5000) = WAIT_OBJECT_0 then begin Form1.Text := Format('进程 %d 已关闭', [ThdHandle]); end else begin //强制结束此进程 Form1.Text := Format('进程 %d 没有关闭', [ThdHandle]); end; finally if ThdHandle <> 0 then closehandle(ThdHandle); if P <> nil then FreeMem(P); end; end; procedure TForm1.FormShow(Sender: TObject); begin ThdCount := 1; InitializeCriticalSection(CS); //初始化临界 end; procedure TForm1.FormDestroy(Sender: TObject); begin DeleteCriticalSection(CS); //释放临界 end; end.