Delphi CreateThread的线程传多个参数处理方法

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.