Delphi 线程

不是原创，只是看到好的内容复制了保存下来，留着学习。

CreadteThred参考，同步参考，WaitForSingleObject参考，互斥参考，

一、在 Delphi 中使用多线程有两种方法: 调用 API、使用 TThread 类; 使用 API 的代码更简单.

1、调用 API:CreateThread()

function CreateThread(
  lpThreadAttributes: Pointer;       {安全设置}
  dwStackSize: DWORD;           {堆栈大小}
  lpStartAddress: TFNThreadStartRoutine; {入口函数}
  lpParameter: Pointer;          {函数参数}
  dwCreationFlags: DWORD;         {启动选项}
  var lpThreadId: DWORD          {输出线程 ID }
): THandle; stdcall;            {返回线程句柄}

 CreateThread 要使用的函数是系统级别的, 不能是某个类(譬如: TForm1)的方法, 并且有严格的格式(参数、返回值)要求, 不管你暂时是不是需要都必须按格式来;

{函数参数} 因为是系统级调用, 函数参数还要缀上 stdcall；还需要一个 var 参数来接受新建线程的 ID。

{安全设置} ：

CreateThread 的第一个参数  是指向 TSecurityAttributes 结构的指针, 一般都是置为 nil, 这表示没有访问限制;

但我们在多线程编程时不需要去设置它们, 大都是使用默认设置(也就是赋值为 nil). 

{堆栈大小} ：

CreateThread 的第二个参数是分配给线程的堆栈大小.
这首先这可以让我们知道: 每个线程都有自己独立的堆栈(也拥有自己的消息队列)

 

这个值都是 0, 这表示使用系统默认的大小, 默认和主线程栈的大小一样, 如果不够用会自动增长;
那主线程的栈有多大? 这个值是可以设定的: Project -> Options -> linker -> memory size

 

Delphi 为我们提供了一个类似 var 的 ThreadVar 关键字, 线程在使用 ThreadVar 声明的全局变量时会在各自的栈中留一个副本, 这样就解决了线程冲突. 不过还是尽量使用局部变量, 或者在继承 TThread 时使用类的成员变量, 因为 ThreadVar 的效率不好, 据说比局部变量能慢 10 倍.

 

{入口函数} ：

线程执行的函数

该函数返回的值可以判断线程是否退出，用GetExitCodeThread 函数获取的退出码就是这个返回值!

如果线程没有退出, GetExitCodeThread 获取的退出码将是一个常量 STILL_ACTIVE (259); 这样我们就可以通过退出码来判断线程是否已退出

 

{函数参数} ：线程入口函数的参数是个无类型指针(Pointer), 用它可以指定任何数据;

{启动选项} ：有两个可选值:
0: 线程建立后立即执行入口函数;
CREATE_SUSPENDED: 线程建立后会挂起等待.

可用 ResumeThread 函数是恢复线程的运行; 可用 SuspendThread 再次挂起线程.
这两个函数的参数都是线程句柄, 返回值是执行前的挂起计数.

什么是挂起计数?
SuspendThread 会给这个数 +1; ResumeThread 会给这个数 -1; 但这个数最小是 0.
当这个数 = 0 时, 线程会运行; > 0 时会挂起.
如果被 SuspendThread 多次, 同样需要 ResumeThread 多次才能恢复线程的运行.

{输出线程ID} ：

 1、线程的 ID 是唯一的; 而句柄可能不只一个, 譬如可以用 GetCurrentThread 获取一个伪句柄、可以用 DuplicateHandle 复制一个句柄等等.
 2、ID 比句柄更轻便.

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button2Click(Sender: TObject); 



  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

var
  pt: TPoint; {这个坐标点将会已指针的方式传递给线程, 它应该是全局的}
  hThread : THandlde;  {生成的线程}

function MyThreadFun(p: Pointer): Integer; stdcall;
var
  i: Integer;
  pt2: TPoint;       {因为指针参数给的点随时都在变, 需用线程的局部变量存起来}
begin
  pt2 := PPoint(p)^; {转换}
  for i := 0 to 1000000 do
  begin
    with Form1.Canvas do begin
      Lock;
      TextOut(pt2.X, pt2.Y, IntToStr(i));
      Unlock;
    end;
  end;
  Result := 0;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  ID: DWORD;

begin
  pt := Point(X, Y);
  hThread := CreateThread(nil, 0, @MyThreadFun, @pt, 0, ID);
  {下面这种写法更好理解, 其实不必, 因为 PPoint 会自动转换为 Pointer 的}
  //CreateThread(nil, 0, @MyThreadFun, Pointer(@pt), 0, ID);
end;

{获取线程的退出代码, 并判断线程是否退出} 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  ExitCode: DWORD; 
begin 
  GetExitCodeThread(hThread, ExitCode); 
 
  if hThread = 0 then 
  begin 
    Text := '线程还未启动'; 
    Exit; 
  end; 
 
  if ExitCode = STILL_ACTIVE then 
    Text := Format('线程退出代码是: %d, 表示线程还未退出', [ExitCode]) 
  else 
    Text := Format('线程已退出, 退出代码是: %d', [ExitCode]); 
end;

end.

2、使用TTHread类

如果Create里面的参数是True，这样线程建立后就不会立即调用 Execute, 可以在需要的时候再用 Resume 方法执行线程。

    procedure TForm1.Button1Click(Sender: TObject); 
    var 
      MyThread: TMyThread; 
    begin 
      MyThread := TMyThread.Create(False); 
    end;
 

OnTerminate属性：表示在线程执行完Execute之后，还没有被释放之前，要紧接着执行的方法。

procedure TTestThread.Execute;
var
  i: Integer;
begin
  OnTerminate:= Form1.ThreadDone;    //在这里设置OnTerminate属性的值为Form1的ThreadDone方法，
                                    //表示在线程执行完Execute之后，还没有被释放之前，要紧接着执行Form1的ThreadDone方法。
  EnterCriticalSection(CS);
  for i:= 1 to MaxSize do
  begin
    GlobalArray[i]:= GetNextNumber;
    Sleep(5);
  end;
  LeaveCriticalSection(CS);
end;

二、同步

1、临界区

"临界区"(CriticalSection): 当把一段代码放入一个临界区, 线程执行到临界区时就独占了, 让其他也要执行此代码的线程先等等;

var CS: TRTLCriticalSection;   {声明一个 TRTLCriticalSection 结构类型变量; 它应该是全局的} 
InitializeCriticalSection(CS); {初始化}
EnterCriticalSection(CS);      {开始: 轮到我了其他线程走开}
LeaveCriticalSection(CS);      {结束: 其他线程可以来了}
DeleteCriticalSection(CS);     {删除: 注意不能过早删除}

var 
  CS: TRTLCriticalSection; 
     
function MyThreadFun(p: Pointer): DWORD; stdcall; 
var 
  i: Integer; 
begin
  EnterCriticalSection(CS);
  for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i));
  LeaveCriticalSection(CS);
  Result := 0;
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var
  ID: DWORD;
begin 
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin 
  ListBox1.Align := alLeft;
  InitializeCriticalSection(CS);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DeleteCriticalSection(CS);
end;

Delphi 在 SyncObjs 单元给封装了一个 TCriticalSection 类, 用法差不多, 代码如下:

uses SyncObjs; 
 
var 
  CS: TCriticalSection; 
 
function MyThreadFun(p: Pointer): DWORD; stdcall; 
var 
  i: Integer; 
begin 
  CS.Enter; 
  for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i)); 
  CS.Leave; 
  Result := 0; 
end; 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  ID: DWORD; 
begin 
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
  CreateThread(nil, 0, @MyThreadFun, nil, 0, ID); 
end; 
 
procedure TForm1.FormCreate(Sender: TObject); 
begin 
  ListBox1.Align := alLeft; 
  CS := TCriticalSection.Create; 
end; 
 
procedure TForm1.FormDestroy(Sender: TObject); 
begin 
  CS.Free; 
end;

2、互斥

互斥量（原文链接）是系统内核对象，谁拥有就谁执行。它与临界区工作很类似。不同处在于：1、互斥量可以跨进程边界同步线程。2、可以给互斥量取个名字，通过引用互斥量的名字来使用一个已知的互斥量对象。

     使用互斥量之类的对象需要反复调用系统内核，期间需要进行进程上下文转换和控制级别转换，大概需要耗费400到600个时间周期。

      又是图书馆的比喻，现在是搞一个锁，把钥匙（互斥量句柄）交给管理员（操作系统），每一个人（线程）想要借书的时候，都要向管理员拿钥匙。当有人在使用的时候，另一人必须等待，等到钥匙有空的时候（互斥量进入信号状态），才能拿到钥匙（拥有了句柄）办理借书业务（此时互斥量进入非信号状态直到办完业务）。

   使用互斥量的步骤：

1、声明一个全局的互斥量句柄变量（var hMutex: THandle;）；

2、创建互斥量：CreateMutex(
                          lpMutexAttributes: PSecurityAttributes;
                          bInitialOwner: BOOL; 
                          lpName: PWideChar   ): THandle;

  （lpMutexAttributes参数：指向TSecurityAttributes的指针，安全属性，一般用缺省安全属性nil；

    bInitialOwer参数：表示创建的互斥量线程是否是互斥量的属主，如果该参数为False互斥量就没属主，一般来讲应设为False，否则如果设为True的话，要当主线程结束其他线程才成为它的属主才能运行；

   lpName参数：是互斥量的名字，若打算取名的话，则传入nil。）


hMutex:= CreateMutex(nil, False, nil);

3、用等待函数控制线程进入同步代码块：

if WaitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then
begin
   //执行语句
end;

4、执行线程运行代码。

5、线程运行完后释放互斥量的拥有权：ReleaseMutex(hMutex: THandle);

6、最后关闭互斥量：CloseHandle(hMutex: THandle);

3、信号量

信号量（原文链接）是建立在互斥量的基础之上，同时加入重要特性：提供了资源计数功能，因此预定义数量的线程同时可以进入同步的代码块中。

      信号量是维护0到指定最大值之间的计数器的同步对象，当线程完成一次信号量的等待时，计数器自减1，当线程释放信号量对象时，计数器自增1。

      借用上面的图书馆例子，信号量好像是多设几把管理钥匙。每次可以设定N把钥匙同时工作，那就有N个人员可以同时办理业务。

     信号量使用的一般步骤：

1、声明一个全局的信号量名柄，如：hSem:THandle;

2、创建信号量：CreateSemphore(

                              lpSemaphoreAttributes:PSecurityAttributes;

                              lInitialCount,lMaximumCount:LongInt;

                              lpName:PChar):THandle;stdcall;

  （lpSemaphoreAttributes参数，指向TSecurityAttributes记录的指针，一般可以缺省填入nil值；

    lInitialCount参数，是信号量对象的初始计数，是0~lMaximumCount之间的数。当它大于0时，信号量就进入了信号状态，当WaiForSingleObject函数释放了一个线程，信号量计数就减1。使用ReleaseSemphore函数可以增加信号量计数；

   lMaximumCount参数，是信号量对象计数的最大值；

   lpName参数，指定信号量的名字。）

hSem:=CreateSemaphore(nil,2,3,nil);

3、用等待函数WaiForSingleObject协调线程。

4、当一个线程用完一个信号，释放。使用ReleaseSemphore(

                                                          hSemaphore:THandle;

                                                          lReleaseCount:LongInt;

                                                          lpPreviousCount:Pointer):BOOL;StdCall;

（hSemphore参数，是信号量对象句柄；

   lReleaseCount参数，要增加的信号量计数的数量；

  lpPreviousCount参数，当前资源数量的原始值，一般为nil。）

ReleaseSemaphore(hSem,1,nil); 

5、最后关闭信号量句柄，CloseHandle(hSem)。

CloseHandle(hSem);  

如果最大信号量计数为1，那么就相当于Mutex。

 三、WaitForSingleObject

DWORD WaitForSingleObject( HANDLE hHandle, DWORDdwMilliseconds);

有两个参数，分别是THandle和Timeout(毫秒单位)。

如果想要等待一条线程，那么你需要指定线程的Handle，以及相应的Timeout时间。当然，如果你想无限等待下去，Timeout参数可以指定系统常量INFINITE。

2. 使用对象

它可以等待如下几种类型的对象：

Event，Mutex，Semaphore，Process，Thread 

3. 返回类型

有三种返回类型：

WAIT_OBJECT_0, 表示等待的对象有信号。（对线程来说，表示执行结束；对互斥量对象来说，指定的对象进入信号状态，可以执行）

 WAIT_TIMEOUT, 表示等待指定时间内，对象一直没有信号。（线程没执行完；对互斥量来说，等到时间已过，对象依然是无信号状态）；

WAIT_ABANDONED 表示对象有信号，但还是不能执行  一般是因为未获取到锁或其他原因（对于互斥量对象，拥有这个互斥量对象的线程在没有释放互斥量之前就已经终止，称作废弃互斥量，此时该互斥量归调用线程所拥有，并把这个互斥量设为非信号状态）

 

function WaitForSingleObject( 
  hHandle: THandle;      {要等待的对象句柄} 
  dwMilliseconds: DWORD  {等待的时间, 单位是毫秒} 
): DWORD; stdcall;       {返回值如下:} 
 
WAIT_OBJECT_0  {等着了, 本例中是: 等的那个进程终于结束了} 
WAIT_TIMEOUT   {等过了点(你指定的时间), 也没等着} 
WAIT_ABANDONED {好不容易等着了, 但人家还是不让咱执行; 这一般是互斥对象} 
 
//WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等

//WaitForSingleObject的示例代码文件: 
 
unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls; 
 
type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
{$R *.dfm} 
 
var 
  hProcess: THandle; {进程句柄} 
 
{等待一个指定句柄的进程什么时候结束} 
function MyThreadFun(p: Pointer): DWORD; stdcall; 
begin 
  if WaitForSingleObject(hProcess, INFINITE) = WAIT_OBJECT_0 then 
    Form1.Text := Format('进程 %d 已关闭', [hProcess]); 
  Result := 0; 
end; 
 
{启动一个进程, 并建立新线程等待它的结束} 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  pInfo: TProcessInformation; 
  sInfo: TStartupInfo; 
  Path: array[0..MAX_PATH-1] of Char; 
  ThreadID: DWORD; 
begin 
  {先获取记事本的路径} 
  GetSystemDirectory(Path, MAX_PATH); 
  StrCat(Path, '\notepad.exe'); 
 
  {用 CreateProcess 打开记事本并获取其进程句柄, 然后建立线程监视} 
  FillChar(sInfo, SizeOf(sInfo), 0); 
  if CreateProcess(Path, nil, nil, nil, False, 0, nil, nil, sInfo, pInfo) then 
  begin 
    hProcess := pInfo.hProcess;                           {获取进程句柄} 
    Text := Format('进程 %d 已启动', [hProcess]);  
    CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID); {建立线程监视} 
  end; 
end;