(整理自网络)
Delphi多线程处理
1-1多线程的基本概念
WIN 98/NT/2000/XP 是个多任务操作系统，也就是：一个进程可以划分为多个线程，每个线程轮流占用CPU 运行时间和资源，或者说，把CPU 时间划成片，每个片分给不同的线程，这样，每个线程轮流的“挂起”和“唤醒”，由于时间片很小，给人的感觉是同时运行的。
多线程带来如下好处：（自己阅读）
1）避免瓶颈；
2）并行操作；
3）提高效率；
在多线程中，通过优先级管理，可以使重要的程序优先操作，提高了任务管理的灵活性。
另一方面，在多CPU 系统中，可以把不同的线程在不同的CPU 中执行，真正做到同时处理多任务（Win 98 只是模拟的，而Win/NT/2000是真正的多CPU同时操作）。
多线程的两个概念：
1）进程：也称任务，程序载入内存，并分配资源，称为“一个进程”。
注意：进程本身并不一定要正在执行。进程由以下几部分组成：
a>一个私有的地址空间，它是进程可以使用的一组虚拟内存地址空间；
b>程序的相关代码、数据源；
c>系统资源，比如操作系统同步对象等；
d>至少包含一个线程（主线程）；
2）线程：是程序的执行单位（线程本身并不包括程序代码，真正拥有代码的是进程），每个进程至少包括一个线程，称为主线程，一个进程如果有多个线程，就可以共享同一进程的资源，并可以并发执行。
线程是进程的一个执行单元，是操作系统分配CPU 时间的基本实体，线程主要由如下两部分组成：
a>数据结构；
b>CPU 寄存器和堆栈；
一个进程中的线程，可以独立运行，也可以控制另一个线程的运行。
请注意：
多线程不能滥用，书上提到了多线程的几个缺点（自阅）。
1-2 Tthread 对象
虽然Windows 提供了比较多的多线程设计的API 函数，但是直接使用API 函数一方面极其不方便，而且使用不当还容易出错。为解决这个问题，Borland 公司率先推出了一种Tthread 对象，来解决多线程设计上的困难，简化了多线程问题的处理。
应该注意，Tthread 对象是没有实例的，它和界面的交流，主要依靠主窗体（主VCL线程），这和其他对象使用上有些区别。
一、Tthread 对象的主要方法
构造线程：
constructor Create(CreateSuspended:boolean)
其中：CreateSuspended=true 构造但不唤醒
false 构造的同时即唤醒
也可以用如下方法
inheried Create(CreateSuspended:boolean)
挂起线程：
suspend
（把线程挂起的次数加一）
唤醒线程：
resume
（注意：注意这个属性是把线程挂起的次数减一，当次数为0 时，即唤醒。也就是说，线程挂起多少次，唤醒也需要多少次。同时挂起的时候将保持线程的地址指针不变，所以线程挂起后再唤醒，将从挂起的地方开始运行）
析构（清除线程所占用的内存）：
destroy
终止线程（后面会具体讨论）:
Terminate
二、线程应用的简单例子：
下面通过一个例子说明上述方法的应用。我们知道，循环是独占性最强的运行方式之一，现在希望建立两个线程对象，实现循环的并行运行。具体方法如下：
File---New---Thread Object
这就自动在主Form中建立了一个线程单元（在对话框里写上线程名字），默认的名字是Unit2。同样方法建立第二个线程单元Unit3。
要注意的是：Unit2和Unit3中有一个给定的过程：
procedure Object.Execute;
begin
end;
其中的程序是线程唤醒后自动执行的程序，也可以在里面调用其他自定义的过程和函数。这个过程的结束，意味着线程程序的结束。
为了构造线程，在interface的Type区，定义一个构造过程：
type
Object = class(TThread) //自动给出的，也可以直接改
private
protected
procedure Execute; override;
public
constructor create; //自己写的
并且在implementation区域写上：
constructor Object.create;
begin
inherited create(true);
end
其中Object 为线程对象的名字。所以这么写，是希望在主Form中调用这个构造过程。
Create()的参数用True，表明构造出的线程为挂起状态。
注意一下，在同一个线程对象里，如果两次构造，将产生两个独立的线程，不但运行是独立的，而且使用线程的局部变量也是独立的。但这里为了简化问题，还是建立了两个独立的线程对象，而且两个循环数
是不同的，在并行运算时容易判断出是两个不同的程序在运行。
假定我们给两个线程对象起的名字是：
mymath1
mymath2
这样在Unit1，应该作如下声明：
implementation
{$R *.DFM}
uses unit2,unit3;
var thread1:mymath1;
thread2:mymath2;
这样在主线程，将可以通过这两个线程变量调用对应的线程方法。
在主线程区构造线程的方法是：
thread1:=mymath1.create;
thread2:=mymath2.create;
挂起：
thread1.suspend;
thread2.suspend;
唤醒：
thread1.resume;
thread2.resume;
析构：
thread1.destroy;
thread2.destroy;
这里需要说明的是，由于线程单元需要调用Form的Edit控件（对象），可以采用两种方法：
1）在线程单元定义一个TEdit对象，例如
edit4:Tedit;
在Execute过程内直接引用
但在Unit1中一定要在FormCreate过程里作一个赋值：
procedure TForm1.FormCreate(Sender: TObject);
begin
thread1.edit4:=edit1;
end;
这样，就把第一线程的edit4与Form上的edit1联系来。
2）在第二个线程中首先声明调用Unti1，也就是要加上
Uses Unit1;
这样就可以在该线程单元直接调用主Form的控件了，比如在Unit3中可以写：
form1.edit2.text:=inttostr(i)
了解了这些基本规则，就可以写出比较复杂的多线程程序了。
还有一点要说明的，默认生成的线程单元，调用的单元只有一个：
Uses Classes;
这样，往往很多函数和对象在线程单元里不能使用，所以在必要时，应该根据需要User相应的单元，这个例程为了简单，把大部分常用的单元都拷过去了，这并不是推荐的办法，因为这样一来会使程序的垃圾过
多，所以，一般要用什么拷什么。
三、常用的API 函数
在处理多线程问题的时候,也经常用到Windows提供的API 函数，需要说明的是，Tthread 对象内部封装的方法，其实主要也是调用API 函数，但是，考虑更全面，更安全。而直接调用API 函数，往往会因为运用不当，出现一些不应有的错误。所以，我个人以为，只要用Tthread 对象的方法能解决的，就不要直接调用API 函数，API 函数只应该在用在Tthread 对象方法解决不了的时候。
例如Tthread 对象方法内部调用API 函数的时候，一般使用推荐的默认值，但需要更精细的控制时，就可以直接使用API 函数。
其实，Tthread 对象方法已经受到了大多数程序设计者的认可，比如，原来VB是不具备直接处理多线程的能力的，但是，现在VB.Net就宣称，它具备了简单处理多线程问题的能力，这就很说明问题。
下面简单介绍几种API 函数，为了清晰方便，这里着重在于说明，函数正确的描述可以自己阅读书上的例子和手册：
构建线程：
CreateThread(参数1，--安全属性（一般=Nil，默认安全属性）
参数2，--线程堆栈尺寸（一般=0，与主线程相同长度，而且可以根据需要自动变化）
参数3，--指向函数名指针，@函数名，这个参数十分重要，不正确将无法调用成功。
参数4，--用户需要向线程传递的参数，是一个指向结构的指针，不需传递参数时，为Nil。
参数5）--传入与线程有关的一些参数，例如：
CREATE_SUSPENDED 创建一个挂起的线程；
0 创建后立即激活。
书上有这个函数应用的十分清晰的例子，可以自己阅读。
一般并不推荐使用 CreateTheard函数，而推荐使用RTL 库里的System单元中定义的 BeginTheard函数，因为这除了能创建一个线程和一个入口函数以外，还增加了几项保护措施，具体的请参阅书上的第10页说明。
对应suspend（挂起）和resume（唤醒）的两个API 函数为：
Function SuspendThread(hThread:Thandle):DWORD;
Function ResumeThread（hThread:Thandle):DWORD;
其中，Thandle被要求控制线程的句柄，函数调用成功，返回挂起的次数，调用不成功。则返回0xFFFFFFFF。
四、线程的终止和退出：
1)自动退出：
一个线程从Execute()过程中退出，即意味着线程的终止，此时将调用Windows的ExitThread()函数来清除线程所占用的堆栈。
如果线程对象的 FreeOnTerminate 属性设为True，则线程对象将自动删除，并释放线程所占用的资源。
这是消除线程对象最简单的办法。
2)受控退出：
利用线程对象的Terminate属性，可以由进程或者由其他线程控制线程的退出。只需要简单的调用该线程的Terminate方法，并设直线程对象的Terminate属性为True。
在线程中，应该不断监视Terminate的值，一旦发现为True，则退出，例如在Execute()过程中可以这样写：
While not Terminate do
begin
........
end;
3)退出的API 函数：
关于线程退出的API 函数声明如下：code
Function TerminateThread(hThread:Thandle;dwExitCode:DWORD);
不过，这个函数会使代码立刻终止，而不管程序中有没有
try....finally
机制，可能会导致错误，不到万不得已，最好不要使用。
4) 利用挂起线程的方法（suspend）
利用挂起线程的suspend方法，后面跟个Free，也可以释放线程，
例如：
thread1.suspend; //挂起
thread2.free; //释放
书上有相应的例子。
五、线程的优先级：
在多线程的情况下，一般要根据线程执行任务的重要性，给线程适当的优先级，一般如果量的线程同时申请CPU 时间，优先级高的线程优先。
在Windows下，给线程的优先级分为30级，而Delphi中Tthread 对象相对简单的把优先级分为七级。也就是在Tthread中声明了一个枚举类型TTthreadPriority:
type
TTthreadPriority(tpidle,tpLowest,tpLower,tpNormal,
tpHight,tpHighest,tpTimecrital)
分别对应的是最低（系统空闲时有效，-15），较低（-2），低（-1），正常（普通0），高（1），较高（2），最高（15）。
其中tpidle和tpTimecrital有些特殊，具体情况请阅读书上有关内容。
设置优先级可使用thread对象的priority属性：
threadObject.priority:=Tthreadpriority(级别);
这里给出了一个演示多线程优先级的实例：
1-3在数据库中使用多线程
一）使用ADO模式
由于Delphi 6.0的ADO 数据源控件内置了多线程能力，所以，在ADO模式下，使用多线程不需要做更多的工作。用两个ADOTable控件，分别连到两个数据库，并且分别通过DataSource控件，与数据帮定控件联系就可以了，这样就可以实现前后台处理数据库问题。
二）使用BDE模式和Tseeion对象
如果需要使用BDE 模式，那么多线程使用数据库，就要考虑Session的问题。在单线程时，每个数据源的建立就自动生成一个Session，这是这个数据源私有的关于数据库信息的文件。但多线程时，必须统一管理，所以在BDE 中专门提供了一个Tsession对象，它可以同时管理不同的Databas数据源对象。
Databas数据源可以接受来自不同数据平台的数据库。
数据库1---databas(2)----table(Qurey)(3)---datasource
| |
| |
|--------- Tsession(1)
| |
| |
数据库2---databas(2)----table(Qurey)(3)---datasource
方法：
1）Tsession
属性：SessionName=名（自起）
Active=true （激活）
2）Database（可以有多个）
属性：SessionName=Tsession名
Dataname=名（自起，作为Table的标识）
AliasName=数据库别名
Connected=True （激活）
3）Table或Qurey
属性：SessionName=Tsession名（不要用默认值）
DatabaseName=如果前面起了名，这里就会出现Database
的名字。
Tablename=表名
Active=true （激活）
以后比如加入Datasoucre和其他一样，这样就可以构造两个前后台处理的数据库管理系统了。
2.多线程的同步机制
同步机制，实际上是事件驱动机制，意思是让线程平时处于“休眠”状态，除非发生某个事件才触发。
例如一个拷贝文件，拷贝线程完成一个程序块后，再唤醒进程条线程做一个格的填充。
研究多线程的同步机制的必要性在于，多线程同步工作时，如果同时调用相同的资源，就可能会出现问题，一般读出是不会有问题的，但是，如果写入（全局变量、数据库），就会发生冲突，甚至产生死
锁和竞争问题。
一、使用Synchronize方法
这个方法用于访问VCL 主线程所管理的资源，其方法的应用是：
第一步：把访问主窗口（或主窗口控件资源）的代码放到线程的一个方法中；
第二步：是在线程对象的Execute方法中，通过Synchronize方法使用该方法。
实例：
procedure Theater.Execute;
begin
Synchronize(update);
end;
procedure Theater.update;
begin
.........
end;
这里通过 Synchronize使线程方法update同步。
二、使用VCL类的Look方法
在Delphi的IDE提供的构件中，有一些对象内部提供了线程的同步机制，工作线程可以直接使用这些控件，比如：Tfont，Tpen，TBitmap，TMetafile，Ticon等。另外，一个很重要的控件对象叫TCanvas，提供了一个Lock方法用于线程的同步，当一个线程使用此控件对象的时候，首先调用这个对象的Lock方法，然后对这个控件进行操作，完毕后再调用Unlock方法，释放对控间的控制权。
例如：
CanversObject.look;
try
画图
finally
CanversObject.unlock;
end;
{使用这个保护机制,保证不论有没有异常，unlock都会被执行否则很可能会发生死锁。在多线程设计的时候，应该很注意发生死锁的问题}
三、Waitfor方法
当一个线程应该等待另一个线程结束时，可以调用Waitfor方法。这个方法属于等待线程对象，Waitfor方法的原型如下:
Function Waitfor(Const Astring:string):string;
比如在前面最基本的线程的例子中，唤醒线程的语句中加上
thread1.resume;
thread1.waitfor;
thread2.resume;
那么所有的线程都必须等待thread1运行完毕后才能运行，其中包括主线程，可以预想，由于thread1调用了主窗体的Edit控件，那么，在thread1运行中间，Edie1也不会显示。
这就告诉我们，这样的代码是不能作为主线程的一部分的，如果与主窗体连接的线程内等待另一个线程结束，而另一个线程又要等待访问用户界面，就可能是程序陷于死锁。
这点在应用的时候要谨慎。
四、利用Windows的API
Windows API函数提供了很多同步技术，下面简要介绍。
1. Critical Sections（临界区），源代码中如果有不能由两个或两个以上线程同时执行的部分，可以用临界段来使这部分的代码执行串行化。它只能在一个独立的进程或一个独立的应用程序中使用。使用方法如下：
//在窗体创建中
InitializeCriticalSection(Critical1)
//在窗体销毁中
DeleteCriticalSection(Critical1)
//在线程中
EnterCriticalSection(Critical1)
……保护的代码
LeaveCriticalSection(Critical1)
2. Mutex（互斥对象），是用于串行化访问资源的全局对象。我们首先设置互斥对象，然后访问资源，最后释放互斥对象。在设置互斥对象时，如果另一个线程（或进程）试图设置相同的互斥对象，该线程将会停下来，直到前一个线程（或进程）释放该互斥对象为止。注意它可以由不同应用程序共享。使用方法如下：
//在窗体创建中
hMutex:=CreateMutex(nil,false,nil)
//在窗体销毁中
CloseHandle(hMutex)
//在线程中
WaitForSingleObject(hMutex,INFINITE)
……保护的代码
ReleaseMutex(hMutex)
3. Semaphore（信号量），它与互斥对象相似，但它可以计数。例如可以允许一个给定资源同时同时被三个线程访问。其实Mutex就是最大计数为一的Semaphore。使用方法如下：
//在窗体创建中
hSemaphore:= CreateSemaphore(nil,lInitialCount,lMaximumCount,lpName)
//在窗体销毁中
CloseHandle(hSemaphore)
//在线程中
WaitForSingleObject(hSemaphore,INFINITE)
……保护的代码
ReleaseSemaphore(hSemaphore, lReleaseCount, lpPreviousCount)
4、事件
delphi多线程
2017年09月30日 09:53:31 一叶青晨 阅读数：2282更多
（推荐）
个人分类： delphi
序
在了解多线程之前我们先了解一下进程和线程的关系
一个程序至少有一个主进程,一个进程至少有一个线程。
为了保证线程的安全性请大家看看下面介绍 Delphi多线程同步的一些处理方案大家可以参考:http://www.cr173.com/html/16747_1.html
主线程又程为UI线程。
进程和线程的主要差别在于它们是不同的操作系统资源管理方式。进程有独立的地址空间，一个进程崩溃后，在保护模式下不会对其它进程产生影响，而线程只是一个进程中的不同执行路径。线程有自己的堆栈和局部变量，但线程之间没有单独的地址空间，一个线程死掉就等于整个进程死掉，所以多进程的程序要比多线程的程序健壮，但在进程切换时，耗费资源较大，效率要差一些。但对于一些要求同时进行并且又要共享某些变量的并发操作，只能用线程，不能用进程。如果有兴趣深入的话，我建议你们看看《现代操作系统》或者《操作系统的设计与实现》。对就个问题说得比较清楚。
多线程应该是编程工作者的基础技能, 但这个基础我从来没学过，所以仅仅是看上去会一些，明白了2+2的时候，其实我还不知道1+1。
开始本应该是一篇洋洋洒洒的文字, 不过我还是提倡先做起来, 在尝试中去理解.
先试试这个:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i := 0 to 500000 do
begin
Canvas.TextOut(10, 10, IntToStr(i));
end;
end;
上面程序运行时, 我们的窗体基本是 "死" 的, 可以在你在程序运行期间拖动窗体试试...
Delphi 为我们提供了一个简单的办法(Application.ProcessMessages)来解决这个问题:
procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
begin
for i := 0 to 500000 do
begin
Canvas.TextOut(10, 10, IntToStr(i));
Application.ProcessMessages;
end;
end;
这个 Application.ProcessMessages; 一般用在比较费时的循环中, 它会检查并先处理消息队列中的其他消息.
但这算不上多线程, 譬如: 运行中你拖动窗体, 循环会暂停下来...
在使用多线程以前, 让我们先简单修改一下程序:
function MyFun: Integer;
var
i: Integer;
begin
for i := 0 to 500000 do
begin
Form1.Canvas.Lock;
Form1.Canvas.TextOut(10, 10, IntToStr(i));
Form1.Canvas.Unlock;
end;
Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
MyFun;
end;
细数上面程序的变化:
1、首先这还不是多线程的, 也会让窗体假 "死" 一会;
2、把执行代码写在了一个函数里, 但这个函数不属于 TForm1 的方法, 所以使用 Canvas 是必须冠以名称(Form1);
3、既然是个函数, (不管是否必要)都应该有返回值;
4、使用了 500001 次 Lock 和 Unlock.
Canvas.Lock 好比在说: Canvas(绘图表面)正忙着呢, 其他想用 Canvas 的等会;
Canvas.Unlock : 用完了, 解锁!
在 Canvas 中使用 Lock 和 Unlock 是个好习惯, 在不使用多线程的情况下这无所谓, 但保不准哪天程序会扩展为多线程的; 我们现在学习多线程, 当然应该用.
在 Delphi 中使用多线程有两种方法: 调用 API、使用 TThread 类; 使用 API 的代码更简单.
function MyFun(p: Pointer): Integer; stdcall;
var
i: Integer;
begin
for i := 0 to 500000 do
begin
Form1.Canvas.Lock;
Form1.Canvas.TextOut(10, 10, IntToStr(i));
Form1.Canvas.Unlock;
end;
Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ID: THandle;
begin
CreateThread(nil, 0, @MyFun, nil, 0, ID);
end;
代码分析:
CreateThread 一个线程后, 算上原来的主线程, 这样程序就有两个线程、是标准的多线程了;
CreateThread 第三个参数是函数指针, 新线程建立后将立即执行该函数, 函数执行完毕, 系统将销毁此线程从而结束多线程的故事.
CreateThread 要使用的函数是系统级别的, 不能是某个类(譬如: TForm1)的方法, 并且有严格的格式(参数、返回值)要求, 不管你暂时是不是需要都必须按格式来;
因为是系统级调用, 还要缀上 stdcall, stdcall 是协调参数顺序的, 虽然这里只有一个参数没有顺序可言, 但这是使用系统函数的惯例.
CreateThread 还需要一个 var 参数来接受新建线程的 ID, 尽管暂时没用, 但这也是格式; 其他参数以后再说吧.
这样一个最简单的多线程程序就出来了, 咱们再用 TThread 类实现一次
type
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
procedure TMyThread.Execute;
var
i: Integer;
begin
FreeOnTerminate := True; {这可以让线程执行完毕后随即释放}
for i := 0 to 500000 do
begin
Form1.Canvas.Lock;
Form1.Canvas.TextOut(10, 10, IntToStr(i));
Form1.Canvas.Unlock;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
TMyThread.Create(False);
end;
TThread 类有一个抽象方法(Execute), 因而是个抽象类, 抽象类只能继承使用, 上面是继承为 TMyThread.
继承 TThread 主要就是实现抽象方法 Execute(把我们的代码写在里面), 等我们的 TMyThread 实例化后, 首先就会执行 Execute 方法中的代码.
按常规我们一般这样去实例化:
procedure TForm1.Button1Click(Sender: TObject);
var
MyThread: TMyThread;
begin
MyThread := TMyThread.Create(False);
end;
因为 MyThread 变量在这里毫无用处(并且编译器还有提示), 所以不如直接写做 TMyThread.Create(False);
我们还可以轻松解决一个问题, 如果: TMyThread.Create(True) ?
这样线程建立后就不会立即调用 Execute, 可以在需要的时候再用 Resume 方法执行线程, 譬如:
procedure TForm1.Button1Click(Sender: TObject);
var
MyThread: TMyThread;
begin
MyThread := TMyThread.Create(True);
MyThread.Resume;
end;
//可简化为:
procedure TForm1.Button1Click(Sender: TObject);
begin
with TMyThread.Create(True) do Resume;
end;
一、入门
㈠、CreateThread 函数
function CreateThread(
lpThreadAttributes: Pointer; {安全设置}
dwStackSize: DWORD; {堆栈大小}
lpStartAddress: TFNThreadStartRoutine; {入口函数}
lpParameter: Pointer; {函数参数}
dwCreationFlags: DWORD; {启动选项}
var lpThreadId: DWORD {输出线程 ID }
): THandle; stdcall; {返回线程句柄}
在 Windows 上建立一个线程, 离不开 CreateThread 函数;
TThread.Create 就是先调用了 BeginThread (Delphi 自定义的), BeginThread 又调用的 CreateThread.
既然有建立, 就该有释放, CreateThread 对应的释放函数是: ExitThread, 譬如下面代码:
procedure TForm1.Button1Click(Sender: TObject);
begin
ExitThread(0); {此句即可退出当前程序, 但不建议这样使用}
end;
代码注释:
当前程序是一个进程, 进程只是一个工作环境, 线程是工作者;
每个进程都会有一个启动线程(或叫主线程), 也就是说: 我们之前大量的编码都是写给这个主线程的;
上面的 ExitThread(0); 就是退出这个主线程;
系统不允许一个没有线程的进程存在, 所以程序就退出了.
另外: ExitThread 函数的参数是一个退出码, 这个退出码是给之后的其他函数用的, 这里随便给个无符号整数即可.
或许你会说: 这个 ExitThread 挺好用的; 其实不管是用 API 还是用 TThread 类写多线程, 我们很少用到它; 因为:
1、假如直接使用 API 的 CreateThread, 它执行完入口函数后会自动退出, 无需 ExitThread;
2、用 TThread 类建立的线程又绝不能使用 ExitThread 退出; 因为使用 TThread 建立线程时会同时分配更多资源(譬如你自定义的成员、还有它的祖先类(TObject)分配的资源等等), 如果用 ExitThread 给草草退出了, 这些资源将得不到释放而导致内存泄露. 尽管 Delphi 提供了 EndThread(其内部调用 ExitThread), 这也不需要我们手动操作(假如非要手动操作也是件很麻烦的事情, 因为很多时候你不知道线程是什么时候执行完毕的).
除了 CreateThread, 还有一个 CreateRemoteThread, 可在其他进程中建立线程, 这不应该是现在学习的重点;
现在先集中精力把 CreateThread 的参数搞彻底.
倒着来吧, 先谈谈 CreateThread 将要返回的 "线程句柄".
"句柄" 类似指针, 但通过指针可读写对象, 通过句柄只是使用对象;
有句柄的对象一般都是系统级别的对象(或叫内核对象); 之所以给我们的是句柄而不是指针, 目的只有一个: "安全";
貌似通过句柄能做很多事情, 但一般把句柄提交到某个函数(一般是系统函数)后, 我们也就到此为止很难了解更多了; 事实上是系统并不相信我们.
不管是指针还是句柄, 都不过是内存中的一小块数据(一般用结构描述), 微软并没有公开句柄的结构细节, 猜一下它应该包括: 真实的指针地址、访问权限设置、引用计数等等.
既然 CreateThread 可以返回一个句柄, 说明线程属于 "内核对象".
实际上不管线程属于哪个进程, 它们在系统的怀抱中是平等的; 在优先级(后面详谈)相同的情况下, 系统会在相同的时间间隔内来运行一下每个线程, 不过这个间隔很小很小, 以至于让我们误以为程序是在不间断地运行.
这时你应该有一个疑问: 系统在去执行其他线程的时候, 是怎么记住前一个线程的数据状态的?
有这样一个结构 TContext, 它基本上是一个 CPU 寄存器的集合, 线程是数据就是通过这个结构切换的, 我们也可以通过 GetThreadContext 函数读取寄存器看看.
附上这个结构 TContext(或叫: CONTEXT、_CONTEXT) 的定义:
PContext = ^TContext;
_CONTEXT = record
ContextFlags: DWORD;
Dr0: DWORD;
Dr1: DWORD;
Dr2: DWORD;
Dr3: DWORD;
Dr6: DWORD;
Dr7: DWORD;
FloatSave: TFloatingSaveArea;
SegGs: DWORD;
SegFs: DWORD;
SegEs: DWORD;
SegDs: DWORD;
Edi: DWORD;
Esi: DWORD;
Ebx: DWORD;
Edx: DWORD;
Ecx: DWORD;
Eax: DWORD;
Ebp: DWORD;
Eip: DWORD;
SegCs: DWORD;
EFlags: DWORD;
Esp: DWORD;
SegSs: DWORD;
end;
CreateThread 的最后一个参数是 "线程的 ID";
既然可以返回句柄, 为什么还要输出这个 ID? 现在我知道的是:
1、线程的 ID 是唯一的; 而句柄可能不只一个, 譬如可以用 GetCurrentThread 获取一个伪句柄、可以用 DuplicateHandle 复制一个句柄等等.
2、ID 比句柄更轻便.
在主线程中 GetCurrentThreadId、MainThreadID、MainInstance 获取的都是主线程的 ID.
㈡、启动选项
function CreateThread(
lpThreadAttributes: Pointer;
dwStackSize: DWORD;
lpStartAddress: TFNThreadStartRoutine;
lpParameter: Pointer;
dwCreationFlags: DWORD; {启动选项}
var lpThreadId: DWORD
): THandle; stdcall;
CreateThread 的倒数第二个参数 dwCreationFlags(启动选项) 有两个可选值:
0: 线程建立后立即执行入口函数;
CREATE_SUSPENDED: 线程建立后会挂起等待.
可用 ResumeThread 函数是恢复线程的运行; 可用 SuspendThread 再次挂起线程.
这两个函数的参数都是线程句柄, 返回值是执行前的挂起计数.
什么是挂起计数?
SuspendThread 会给这个数 +1; ResumeThread 会给这个数 -1; 但这个数最小是 0.
当这个数 = 0 时, 线程会运行; > 0 时会挂起.
如果被 SuspendThread 多次, 同样需要 ResumeThread 多次才能恢复线程的运行.
在下面的例子中, 有新线程不断给一个全局变量赋随机值;
同时窗体上的 Timer 控件每隔 1/10 秒就把这个变量写在窗体标题;
在这个过程中演示了 ResumeThread、SuspendThread 两个函数.
//上面图片中演示的代码。
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
hThread: THandle; {线程句柄}
num: Integer; {全局变量, 用于记录随机数}
{线程入口函数}
function MyThreadFun(p: Pointer): Integer; stdcall;
begin
while True do {假如线程不挂起, 这个循环将一直循环下去}
begin
num := Random(100);
end;
Result := 0;
end;
{建立并挂起线程}
procedure TForm1.Button1Click(Sender: TObject);
var
ID: DWORD;
begin
hThread := CreateThread(nil, 0, @MyThreadFun, nil, CREATE_SUSPENDED, ID);
Button1.Enabled := False;
end;
{唤醒并继续线程}
procedure TForm1.Button2Click(Sender: TObject);
begin
ResumeThread(hThread);
end;
{挂起线程}
procedure TForm1.Button3Click(Sender: TObject);
begin
SuspendThread(hThread);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Timer1.Interval := 100;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Text := IntToStr(num);
end;
end.
㈢、入口函数的参数
function CreateThread(
lpThreadAttributes: Pointer;
dwStackSize: DWORD;
lpStartAddress: TFNThreadStartRoutine;
lpParameter: Pointer; {入口函数的参数}
dwCreationFlags: DWORD;
var lpThreadId: DWORD
): THandle; stdcall;
线程入口函数的参数是个无类型指针(Pointer), 用它可以指定任何数据; 本例是把鼠标点击窗体的坐标传递给线程的入口函数, 每次点击窗体都会创建一个线程.
运行效果图:
//上面演示的代码
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);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
pt: TPoint; {这个坐标点将会已指针的方式传递给线程, 它应该是全局的}
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);
CreateThread(nil, 0, @MyThreadFun, @pt, 0, ID);
{下面这种写法更好理解, 其实不必, 因为 PPoint 会自动转换为 Pointer 的}
//CreateThread(nil, 0, @MyThreadFun, Pointer(@pt), 0, ID);
end;
end.
这个例子还有不严谨的地方: 当一个线程 Lock 窗体的 Canvas 时, 其他线程在等待; 线程在等待时, 其中的计数也还在增加. 这也就是说: 现在并没有去处理线程的同步; 同步是多线程中最重要的课题, 快到了.
另外有个小技巧: 线程函数的参数是个 32 位(4个字节)的指针, 仅就本例来讲, 可以让它的 "高16位" 和 "低16位" 分别携带 X 和 Y; 这样就不需要哪个全局的 pt 变量了.
其实在 Windows 的消息中就是这样传递坐标的, 在 Windows 的消息中一般高字节是 Y、低字节是 X; 咱们这么来吧, 这样还可以使用给消息准备的一些方便的函数.
重写本例代码(当然运行效果和窗体文件都是一样的):
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);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function MyThreadFun(p: Pointer): Integer; stdcall;
var
i: Integer;
x,y: Word;
begin
x := LoWord(Integer(p));
y := HiWord(Integer(p));
{如果不使用 LoWord、HiWord 函数可以像下面这样: }
//x := Integer(p);
//y := Integer(p) shr 16;
for i := 0 to 1000000 do
begin
with Form1.Canvas do begin
Lock;
TextOut(x, y, IntToStr(i));
Unlock;
end;
end;
Result := 0;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
ID: DWORD;
num: Integer;
begin
num := MakeLong(X, Y);
{如果不使用 MekeLong、MakeWParam、MakeLParam、MakeResult 等函数, 可以像下面这样: }
//num := Y shl 16 + X;
CreateThread(nil, 0, @MyThreadFun, Ptr(num), 0, ID);
{上面的 Ptr 是专门将一个数字转换为指针的函数, 当然也可以这样: }
//CreateThread(nil, 0, @MyThreadFun, Pointer(num), 0, ID);
end;
end.
㈣、入口函数的指针
function CreateThread(
lpThreadAttributes: Pointer;
dwStackSize: DWORD;
lpStartAddress: TFNThreadStartRoutine; {入口函数的指针}
lpParameter: Pointer;
dwCreationFlags: DWORD;
var lpThreadId: DWORD
): THandle; stdcall;
到了入口函数了, 学到这个地方, 我查了一个入口函数的标准定义, 这个函数的标准返回值应该是 DWORD, 不过这函数在 Delphi 的 System 单元定义的是: TThreadFunc = function(Parameter: Pointer): Integer; 我以后会尽量使用 DWORD 做入口函数的返回值.
这个返回值有什么用呢?
等线程退出后, 我们用 GetExitCodeThread 函数获取的退出码就是这个返回值!
如果线程没有退出, GetExitCodeThread 获取的退出码将是一个常量 STILL_ACTIVE (259); 这样我们就可以通过退出码来判断线程是否已退出.
还有一个问题: 前面也提到过, 线程函数不能是某个类的方法! 假如我们非要线程去执行类中的一个方法能否实现呢?
尽管可以用 Addr(类名.方法名) 或 MethodAddress('published 区的方法名') 获取类中方法的地址, 但都不能当做线程的入口函数, 原因可能是因为类中的方法的地址是在实例化为对象时动态分配的.
后来换了个思路, 其实很简单: 在线程函数中再调用方法不就得了, 估计 TThread 也应该是这样.
下面的例子就尝试了用线程调用 TForm1 类中的方法, 并测试了退出码的相关问题.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
procedure FormProc; {准备给线程使用的方法}
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
var
hThread: THandle;
{线程入口函数}
function MyThreadFun(p: Pointer): DWORD; stdcall;
begin
Form1.FormProc; {调用 TForm1 类的方法}
Result := 99; {这个返回值将成为线程的退出代码, 99 是我随意给的数字}
end;
{TForm1 的方法, 本例中是给线程的入口函数调用的}
procedure TForm1.FormProc;
var
i: Integer;
begin
for i := 0 to 200000 do
begin
with Form1.Canvas do begin
Lock;
TextOut(10, 10, IntToStr(i));
Unlock;
end;
end;
end;
{建立并执行线程}
procedure TForm1.Button1Click(Sender: TObject);
var
ID: DWORD;
begin
hThread := CreateThread(nil, 0, @MyThreadFun, nil, 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.
㈤、堆栈大小
function CreateThread(
lpThreadAttributes: Pointer;
dwStackSize: DWORD; {堆栈大小}
lpStartAddress: TFNThreadStartRoutine;
lpParameter: Pointer;
dwCreationFlags: DWORD;
var lpThreadId: DWORD
): THandle; stdcall;
CreateThread 的第二个参数是分配给线程的堆栈大小.
这首先这可以让我们知道: 每个线程都有自己独立的堆栈(也拥有自己的消息队列).
什么是堆栈? 其实堆是堆、栈是栈, 有时 "栈" 也被叫做 "堆栈".
它们都是进程中的内存区域, 主要是存取方式不同(栈:先进后出; 堆:先进先出);
"栈"(或叫堆栈)适合存取临时而轻便的变量, 主要用来储存局部变量; 譬如 for i := 0 to 99 do 中的 i 就只能存于栈中, 你把一个全局的变量用于 for 循环计数是不可以的.
现在我们知道了线程有自己的 "栈", 并且在建立线程时可以分配栈的大小.
前面所有的例子中, 这个值都是 0, 这表示使用系统默认的大小, 默认和主线程栈的大小一样, 如果不够用会自动增长;
那主线程的栈有多大? 这个值是可以设定的: Project -> Options -> linker -> memory size(如图)
栈是私有的但堆是公用的, 如果不同的线程都来使用一个全局变量有点乱套;
为解决这个问题 Delphi 为我们提供了一个类似 var 的 ThreadVar 关键字, 线程在使用 ThreadVar 声明的全局变量时会在各自的栈中留一个副本, 这样就解决了冲突. 不过还是尽量使用局部变量, 或者在继承 TThread 时使用类的成员变量, 因为 ThreadVar 的效率不好, 据说比局部变量能慢 10 倍.
在下面的例子就测试了用 var 和 ThreadVar 定义变量的不同.
使用 var 效果图:
使用 ThreadVar 效果图:
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 num: Integer; {全局变量}
threadvar num: Integer; {支持多线程的全局变量}
function MyThreadFun(p: Pointer): DWORD; stdcall;
var
py: Integer;
begin
py := Integer(p);
while True do
begin
Inc(num);
with Form1.Canvas do begin
Lock;
TextOut(20, py, IntToStr(num));
Unlock;
end;
Sleep(1000); {然线程挂起 1 秒钟再继续}
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ID: DWORD;
begin
{借入口函数的参数传递了一个坐标点中的 Y 值, 以让各线程把结果输出在不同位置}
CreateThread(nil, 0, @MyThreadFun, Ptr(20), 0, ID);
CreateThread(nil, 0, @MyThreadFun, Ptr(40), 0, ID);
CreateThread(nil, 0, @MyThreadFun, Ptr(60), 0, ID);
end;
end.
㈥、安全设置
function CreateThread(
lpThreadAttributes: Pointer; {安全设置}
dwStackSize: DWORD;
lpStartAddress: TFNThreadStartRoutine;
lpParameter: Pointer;
dwCreationFlags: DWORD;
var lpThreadId: DWORD
): THandle; stdcall;
CreateThread 的第一个参数 lpThreadAttributes 是指向 TSecurityAttributes 结构的指针, 一般都是置为 nil, 这表示没有访问限制; 该结构的定义是:
//TSecurityAttributes(又名: SECURITY_ATTRIBUTES、_SECURITY_ATTRIBUTES)
_SECURITY_ATTRIBUTES = record
nLength: DWORD; {结构大小}
lpSecurityDescriptor: Pointer; {默认 nil; 这是另一个结构 TSecurityDescriptor 的指针}
bInheritHandle: BOOL; {默认 False, 表示不可继承}
end;
//TSecurityDescriptor(又名: SECURITY_DESCRIPTOR、_SECURITY_DESCRIPTOR)
_SECURITY_DESCRIPTOR = record
Revision: Byte;
Sbz1: Byte;
Control: SECURITY_DESCRIPTOR_CONTROL;
Owner: PSID;
Group: PSID;
Sacl: PACL;
Dacl: PACL;
end;
够复杂的, 但我们在多线程编程时不需要去设置它们, 大都是使用默认设置(也就是赋值为 nil).
我觉得有必要在此刻了解的是: 建立系统内核对象时一般都有这个属性(TSecurityAttributes);
在接下来多线程的课题中要使用一些内核对象, 不如先盘点一下, 到时碰到这个属性时给个 nil 即可, 不必再费神.
{建立事件}
function CreateEvent(
lpEventAttributes: PSecurityAttributes; {!}
bManualReset: BOOL;
bInitialState: BOOL;
lpName: PWideChar
): THandle; stdcall;
{建立互斥}
function CreateMutex(
lpMutexAttributes: PSecurityAttributes; {!}
bInitialOwner: BOOL;
lpName: PWideChar
): THandle; stdcall;
{建立信号}
function CreateSemaphore(
lpSemaphoreAttributes: PSecurityAttributes; {!}
lInitialCount: Longint;
lMaximumCount: Longint;
lpName: PWideChar
): THandle; stdcall;
{建立等待计时器}
function CreateWaitableTimer(
lpTimerAttributes: PSecurityAttributes; {!}
bManualReset: BOOL;
lpTimerName: PWideChar
): THandle; stdcall;
上面的四个系统内核对象(事件、互斥、信号、计时器)都是线程同步的手段, 从这也能看出处理线程同步的复杂性; 不过这还不是全部, Windows Vista 开始又增加了 Condition variables(条件变量)、Slim Reader-Writer Locks(读写锁)等同步手段.
不过最简单、最轻便(速度最快)的同步手段还是 CriticalSection(临界区), 但它不属于系统内核对象, 当然也就没有句柄、没有 TSecurityAttributes 这个安全属性, 这也导致它不能跨进程使用; 不过写多线程时一般不用跨进程, 所以 CriticalSection 应该是最常用的同步手段.
二、线程同步之临界区。
先看一段程序, 代码文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function MyThreadFun(p: Pointer): DWORD; stdcall;
var
i: Integer;
begin
for i := 0 to 99 do Form1.ListBox1.Items.Add(IntToStr(i));
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;
end;
end.
在这段程序中, 有三个线程几乎是同时建立, 向窗体中的 ListBox1 中写数据, 最后写出的结果是这样的:
能不能让它们别打架, 一个完了另一个再来? 这就要用到多线程的同步技术.
前面说过, 最简单的同步手段就是 "临界区".
先说这个 "同步"(Synchronize), 首先这个名字起的不好, 我们好像需要的是 "异步"; 其实异步也不准确...
管它叫什么名字呢, 它的目的就是保证不冲突、有次序、都发生.
"临界区"(CriticalSection): 当把一段代码放入一个临界区, 线程执行到临界区时就独占了, 让其他也要执行此代码的线程先等等; 这和前面用的 Lock 和 UnLock 差不多; 使用格式如下:
var CS: TRTLCriticalSection; {声明一个 TRTLCriticalSection 结构类型变量; 它应该是全局的}
InitializeCriticalSection(CS); {初始化}
EnterCriticalSection(CS); {开始: 轮到我了其他线程走开}
LeaveCriticalSection(CS); {结束: 其他线程可以来了}
DeleteCriticalSection(CS); {删除: 注意不能过早删除}
//也可用 TryEnterCriticalSection 替代 EnterCriticalSection.
用上临界区, 重写上面的代码, 运行效果图:
//用临界区重写后的代码文件:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
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;
end.
Delphi 在 SyncObjs 单元给封装了一个 TCriticalSection 类, 用法差不多, 代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
ListBox1: TListBox;
Button1: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
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;
end.
三、等待函数aitForSingleObject
一下子跳到等待函数 WaitForSingleObject, 是因为下面的 Mutex、Semaphore、Event、WaitableTimer 等同步手段都要使用这个函数; 不过等待函数可不止 WaitForSingleObject 它一个, 但它最简单.
function WaitForSingleObject(
hHandle: THandle; {要等待的对象句柄}
dwMilliseconds: DWORD {等待的时间, 单位是毫秒}
): DWORD; stdcall; {返回值如下:}
WAIT_OBJECT_0 {等着了, 本例中是: 等的那个进程终于结束了}
WAIT_TIMEOUT {等过了点(你指定的时间), 也没等着}
WAIT_ABANDONED {好不容易等着了, 但人家还是不让咱执行; 这一般是互斥对象}
//WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等.
WaitForSingleObject 等待什么? 在多线程里就是等待另一个线程的结束, 快来执行自己的代码; 不过它可以等待的对象可不止线程; 这里先来一个等待另一个进程结束的例子, 运行效果图:
//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, ' otepad.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;
end.
Delphi TThread类详解
我们常有工作线程和主线程之分，工作线程负责作一些后台操作，比如接收邮件；主线程负责界面上的一些显示。工作线程的好处在某些时候是不言而喻的，你的主界面可以响应任何操作，而背后的线程却在默默地工作。
VCL中，工作线程执行在Execute方法中，你必须从TThread继承一个类并覆盖Execute方法，在这个方法中，所有代码都是在另一个 线程中执行的，除此之外，你的线程类的其他方法都在主线程执行，包括构造方法，析构方法，Resume等，很多人常常忽略了这一点。
最简单的一个线程类如下：
TMyThread = class(TThread)
protected
procedure Execute; override;
end;
在Execute中的代码，有一个技术要点，如果你的代码执行时间很短，像这样，Sleep(1000)，那没有关系；如果是这样Sleep (10000)，10秒，那么你就不能直接这样写了，须把这10秒拆分成10个1秒，然后判断Terminated属性，像下面这样：
procedure TMyThread.Execute;
var
i: Integer;
begin
for i := 0 to 9 do
if not Terminated then
Sleep(1000)
else
Break;
end;
这样写有什么好处呢，想想你要关闭程序，在关闭的时候调用MyThread.Free，这个时候线程并没有马上结束，它调用WaitFor，等待 Execute执行完后才能释放。你的程序就必须等10秒以后才能关闭，受得了吗。如果像上面那样写，在程序关闭时，调用Free之后，它顶多再等一秒就 会关闭。为什么？答案得去线程类的Destroy中找，它会先调用Terminate方法，在这个方法里面它把Terminated设为True（仅此而 已，很多人以为是结束线程，其实不是）。请记住这一切是在主线程中操作的，所以和Execute是并行执行的。既然Terminated属性已为 Ture，那么在Execute中判断之后，当然就Break了，Execute执行完毕，线程类也正常释放。
或者有人说，TThread可以设FreeOnTerminate属性为True，线程类就能自动释放。除非你的线程执行的任务很简单，不然，还是不要去理会这个属性，一切由你来操作，才能使线程更灵活强大。
接下来的问题是如何使工作线程和主线程很好的通信，很多时候主线程必须得到工作线程的通知，才能做出响应。比如接收邮件，工作线程向服务器收取邮件，收取完毕之后，它得通知主线程收到多少封邮件，主线程才能弹出一个窗口通知用户。
在VCL中，我们可以用两种方法，一种是向主线程中的窗体发送消息，另一种是使用异步事件。第一种方法其实没有第二种来得方便。想想线程类中的OnTerminate事件，这个事件由线程函数的堆栈引起，却在主线程执行。
事实上，真正的线程函数是这个：
function ThreadProc(Thread: TThread): Integer;
函数里面有Thread.Execute，这就是为什么Execute是在其他线程中执行，该方法执行之后，有如下句：
Thread.DoTerminate;
而线程类的DoTerminate方法里面是
if Assigned(FOnTerminate) then Synchronize(CallOnTerminate);
显然Synchronize方法使得CallOnTerminate在主线程中执行，而CallOnTerminate里面的代码其实就是：
if Assigned(FOnTerminate) then FOnTerminate(Self);
只要Execute方法一执行完就发生OnTerminate事件。不过有一点是必须注意，OnTerminate事件发生后，线程类不一定会释 放，只有在FreeOnTerminate为True之后，才会Thread.Free。看一下ThreadProc函数就知道。
依照Onterminate事件，我们可以设计自己的异步事件。
Synchronize方法只能传进一个无参数的方法类型，但我们的事件经常是要带一些参数的，这个稍加思考就可以得到解决，即在线程类中保存参数，触发事件前先设置参数，再调用异步事件，参数复杂的可以用记录或者类来实现。
假设这样，上面的代码每睡一秒，线程即向外面引发一次事件，我们的类可以这样设计：
TSecondEvent = procedure (Second: Integer) of object;
TMyThread = class(TThread)
private
FSecond: Integer;
FSecondEvent: TSecondEvent;
procedure CallSecondEvent;
protected
procedure Execute; override;
public
property SencondEvent: TSecondEvent read FSecondEvent
write FSecondEvent;
end;
{ TMyThread }
procedure TMyThread.CallSecondEvent;
begin
if Assigned(FSecondEvent) then
FSecondEvent(FSecond);
end;
procedure TMyThread.Execute;
var
i: Integer;
begin
for i := 0 to 9 do
if not Terminated then
begin
Sleep(1000);
FSecond := i;
Synchronize(CallSecondEvent);
end
else
Break;
end;
在主窗体中假设我们这样操作线程：
procedure TForm1.Button1Click(Sender: TObject);
begin
MyThread := TMyThread.Create(true);
MyThread.OnTerminate := ThreadTerminate;
MyThread.SencondEvent := SecondEvent;
MyThread.Resume;
end;
procedure TForm1.ThreadTerminate(Sender: TObject);
begin
ShowMessage('ok');
end;
procedure TForm1.SecondEvent(Second: Integer);
begin
Edit1.Text := IntToStr(Second);
end;
我们将每隔一秒就得到一次通知并在Edit中显示出来。
现在我们已经知道如何正确使用Execute方法，以及如何在主线程与工作线程之间通信了。但问题还没有结束，有一种情况出乎我的意料之外，即如果 线程中有一些资源，Execute正在使用这些资源，而主线程要释放这个线程，这个线程在释放的过程中会释放掉资源。想想会不会有问题呢，两个线程，一个 在使用资源，一个在释放资源，会出现什么情况呢，
用下面代码来说明：
type
TMyClass = class
private
FSecond: Integer;
public
procedure SleepOneSecond;
end;
TMyThread = class(TThread)
private
FMyClass: TMyClass;
protected
procedure Execute; override;
public
constructor MyCreate(CreateSuspended: Boolean);
destructor Destroy; override;
end;
implementation
{ TMyThread }
constructor TMyThread.MyCreate(CreateSuspended: Boolean);
begin
inherited Create(CreateSuspended);
FMyClass := TMyClass.Create;
end;
destructor TMyThread.Destroy;
begin
FMyClass.Free;
FMyClass := nil;
inherited;
end;
procedure TMyThread.Execute;
var
i: Integer;
begin
for i := 0 to 9 do
FMyClass.SleepOneSecond;
end;
{ TMyClass }
procedure TMyClass.SleepOneSecond;
begin
FSecond := 0;
Sleep(1000);
end;
end.
用下面的代码来调用上面的类：
procedure TForm1.Button1Click(Sender: TObject);
begin
MyThread := TMyThread.MyCreate(true);
MyThread.OnTerminate := ThreadTerminate;
MyThread.Resume;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
MyThread.Free;
end;
先点击Button1创建一个线程，再点击Button2释放该类，出现什么情况呢，违法访问，是的，MyThread.Free时，MyClass被释放掉了
FMyClass.Free;
FMyClass := nil;
而此时Execute却还在执行，并且调用MyClass的方法，当然就出现违法访问。对于这种情况，有什么办法来防止呢，我想到一种方法，即在线程类中使用一个成员，假设为FFinished，在Execute方法中有如下的形式：
FFinished := False;
try
//... ...
finally
FFinished := True;
End;
接着在线程类的Destroy中有如下形式：
While not FFinished do
Sleep(100);
MyClass.Free;
这样便能保证MyClass能被正确释放。
线程是一种很有用的技术。但使用不当，常使人头痛。在CSDN论坛上看到一些人问，我的窗口在线程中调用为什么出错，主线程怎么向其他线程发送消息等等，其实，我们在抱怨线程难用时，也要想想我们使用的方法对不对，只要遵循一些正确的使用规则，线程其实很简单。
后记
上面有一处代码有些奇怪：FMyClass.Free; FMyClass := nil;如果你只写FMyClass.Free，线程类还不会出现异常，即调用FMyClass.SleepOneSecond不会出错。我在主线程中试了下面的代码
MyClass := TMyClass.Create;
MyClass.SleepOneSecond;
MyClass.Free;
MyClass.SleepOneSecond;
同样也不会出错，但关闭程序时就出错了，如果是这样：
MyClass := TMyClass.Create;
MyClass.SleepOneSecond;
MyClass.Free;
MyThread := TMyThread.MyCreate(true);
MyThread.OnTerminate := ThreadTerminate;
MyThread.Resume;
MyClass.SleepOneSecond;
马上就出错。所以这个和线程类无线，应该是Delphi对于堆栈空间的释放规则，我想MyClass.Free之后，该对象在堆栈上空间还是保留 着，只是允许其他资源使用这个空间，所以接着调用下面这一句MyClass.SleepOneSecond就不会出错，当程序退出时可能对堆栈作一些清理 导致出错。而如果MyClass.Free之后即创建MyThread，大概MyClass的空间已经被MyThread使用，所以再调用 MyClass.SleepOneSecond就出错了。
DELPHI 多线程之TThread类的实现
TThread类
先新建一个普通的工程，再新建一个线程类File>>New>>Othre>>Delphi File>Thread Object，取个名字，DELPHI会自动生成一个单元，我们只需往里简单添加功能代码，和在要使用的单元里实例引用即可。
为了节省篇幅，现把TMyThread类集成主窗体单元里，在窗体单元里声明类也是可以的。
例：用工作线程在窗体输出0~500000的数字。
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls;
8
9 type
10 TMyThread = class(TThread)
11 private
12 { Private declarations }
13 protected
14 procedure Execute; override; {执行}
15 procedure Run; {声明多一个过程，把功能代码写在这里再给Execute调用}
16 end;
17 TForm1 = class(TForm)
18 btn1: TButton;
19 procedure btn1Click(Sender: TObject);
20 private
21 { Private declarations }
22 public
23 { Public declarations }
24 end;
25
26
27
28 var
29 Form1: TForm1;
30
31
32 implementation
33
34 {$R *.dfm}
35
36 var
37 MyThread:TMyThread; {声明一个线程类对象]
38
39 procedure TMyThread.Execute;
40 begin
41 { Place thread code here }
42 FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
43 Run;
44 end;
45
46 procedure TMyThread.Run;
47 var
48 i:integer;
49 begin
50 for i := 0 to 500000 do
51 begin
52 Form1.Canvas.Lock;
53 Form1.Canvas.TextOut(10,10,IntToStr(i));
54 Form1.Canvas.Unlock;
55 end;
56 end;
57
58 procedure TForm1.btn1Click(Sender: TObject);
59 begin
60 MyThread:=TMyThread.Create(False); {实例化这个类，为False时立即运行，为True时可加MyThread.Resume用来启动}
61 end;
CriticalSection(临界区)
uses SyncObjs;用TCriticalSection类的方法处理。
例：用三个线程，按顺序给ListBox添加0~99.
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls;
8
9 type
10 TMyThread = class(TThread)
11 private
12 { Private declarations }
13 protected
14 procedure Execute; override; {执行}
15 procedure Run; {运行}
16 end;
17 TForm1 = class(TForm)
18 btn1: TButton;
19 lst1: TListBox;
20 procedure btn1Click(Sender: TObject);
21 procedure FormDestroy(Sender: TObject);
22 private
23 { Private declarations }
24 public
25 { Public declarations }
26 end;
27
28
29
30 var
31 Form1: TForm1;
32
33
34 implementation
35
36 {$R *.dfm}
37
38 uses SyncObjs;
39
40 var
41 MyThread:TMyThread; {声明线程}
42 CS:TCriticalSection; {声明临界}
43
44
45 procedure TMyThread.Execute;
46 begin
47 { Place thread code here }
48 FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
49 Run; {运行}
50 end;
51
52 procedure TMyThread.Run;
53 var
54 i:integer;
55 begin
56 CS.Enter; {我要用了，其它人等下}
57 for i := 0 to 100 - 1 do
58 begin
59 Form1.lst1.Items.Add(IntToStr(i));
60 end;
61 CS.Leave; {我用完了，下一个}
62 end;
63
64 procedure TForm1.btn1Click(Sender: TObject);
65 begin
66 CS:=TCriticalSection.Create; {实例化临界}
67 MyThread:=TMyThread.Create(False); {实例化这个类，为False时立即运行，为True时可加MyThread.Resume用来启动}
68 MyThread:=TMyThread.Create(False);
69 MyThread:=TMyThread.Create(False);
70 end;
71
72
73 procedure TForm1.FormDestroy(Sender: TObject);
74 begin
75 CS.Free;{释放临界体}
76 end;
77
78 end.
Mutex (互斥对象)
uses SyncObjs;用TMutex类的方法处理(把释放语句放在循环内外可以决定执行顺序)
例：互斥输出三个0~2000的数字到窗体在不同位置。
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls;
8
9 type
10 TMyThread = class(TThread)
11 private
12 { Private declarations }
13 protected
14 procedure Execute; override; {执行}
15 procedure Run; {运行}
16 end;
17 TForm1 = class(TForm)
18 btn1: TButton;
19 procedure FormDestroy(Sender: TObject);
20 procedure btn1Click(Sender: TObject);
21 private
22 { Private declarations }
23 public
24 { Public declarations }
25 end;
26
27
28
29 var
30 Form1: TForm1;
31
32
33 implementation
34
35 {$R *.dfm}
36
37 uses SyncObjs;
38
39 var
40 MyThread:TMyThread; {声明线程}
41 Mutex:TMutex; {声明互斥体}
42 f:integer;
43
44
45 procedure TMyThread.Execute;
46 begin
47 { Place thread code here }
48 FreeOnTerminate:=True; {加上这句线程用完了会自动注释}
49 Run; {运行}
50 end;
51
52 procedure TMyThread.Run;
53 var
54 i,y:integer;
55 begin
56 Inc(f);
57 y:=20*f;
58 for i := 0 to 2000 do
59 begin
60 if Mutex.WaitFor(INFINITE)=wrSignaled then {判断函数，能用时就用}
61 begin
62 Form1.Canvas.Lock;
63 Form1.Canvas.TextOut(10,y,IntToStr(i));
64 Form1.Canvas.Unlock;
65 Sleep(1);
66 Mutex.Release; {释放，谁来接下去用}
67 end;
68 end;
69 end;
70
71 procedure TForm1.btn1Click(Sender: TObject);
72 begin
73 f:=0;
74 Repaint;
75 Mutex:=TMutex.Create(False); {参数为是否让创建者拥有该互斥体，一般为False}
76 MyThread:=TMyThread.Create(False);
77 MyThread:=TMyThread.Create(False);
78 MyThread:=TMyThread.Create(False);
79 end;
80
81 procedure TForm1.FormDestroy(Sender: TObject);
82 begin
83 Mutex.Free;{释放互斥体}
84 end;
85
86 end.
Semaphore(信号或叫信号量)
{DELPHI2007不支持信号量，DELPHI2009才开始支持}
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls;
8
9 type
10 TForm1 = class(TForm)
11 Button1: TButton;
12 Edit1: TEdit;
13 procedure Button1Click(Sender: TObject);
14 procedure FormCreate(Sender: TObject);
15 procedure FormDestroy(Sender: TObject);
16 procedure Edit1KeyPress(Sender: TObject; var Key: Char);
17 end;
18
19 var
20 Form1: TForm1;
21
22 implementation
23
24 {$R *.dfm}
25
26 uses SyncObjs;
27 var
28 f: Integer;
29 MySemaphore: TSemaphore;
30
31 function MyThreadFun(p: Pointer): DWORD; stdcall;
32 var
33 i,y: Integer;
34 begin
35 Inc(f);
36 y := 20 * f;
37 if MySemaphore.WaitFor(INFINITE) = wrSignaled then
38 begin
39 for i := 0 to 1000 do
40 begin
41 Form1.Canvas.Lock;
42 Form1.Canvas.TextOut(20, y, IntToStr(i));
43 Form1.Canvas.Unlock;
44 Sleep(1);
45 end;
46 end;
47 MySemaphore.Release;
48 Result := 0;
49 end;
50
51 procedure TForm1.Button1Click(Sender: TObject);
52 var
53 ThreadID: DWORD;
54 begin
55 if Assigned(MySemaphore) then MySemaphore.Free;
56 MySemaphore := TSemaphore.Create(nil, StrToInt(Edit1.Text), 5, ''); {创建，参数一为安全默认为nil，参数2可以填写运行多少线程，参数3是运行总数，参数4可命名用于多进程}
57
58 Self.Repaint;
59 f := 0;
60 CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
61 CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
62 CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
63 CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
64 CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
65 end;
66
67 {让 Edit 只接受 1 2 3 4 5 五个数}
68 procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
69 begin
70 if not CharInSet(Key, ['1'..'5']) then Key := #0;
71 end;
72
73 procedure TForm1.FormCreate(Sender: TObject);
74 begin
75 Edit1.Text := '1';
76 end;
77
78 procedure TForm1.FormDestroy(Sender: TObject);
79 begin
80 if Assigned(MySemaphore) then MySemaphore.Free;
81 end;
82
83 end.
Event (事件对象)
注：相比API的处理方式，此类没有启动步进一次后暂停的方法。
1 unit Unit1;
2
3 interface
4
5 uses
6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7 Dialogs, StdCtrls;
8
9 type
10 TMyThread = class(TThread)
11 private
12 { Private declarations }
13 protected
14 procedure Execute; override;
15 procedure Run;
16 end;
17
18 TForm1 = class(TForm)
19 btn1: TButton;
20 btn2: TButton;
21 btn3: TButton;
22 btn4: TButton;
23 procedure btn1Click(Sender: TObject);
24 procedure FormDestroy(Sender: TObject);
25 procedure btn2Click(Sender: TObject);
26 procedure btn3Click(Sender: TObject);
27 procedure btn4Click(Sender: TObject);
28 procedure FormCreate(Sender: TObject);
29 private
30 { Private declarations }
31 public
32 { Public declarations }
33 end;
34
35 var
36 Form1: TForm1;
37
38 implementation
39
40 {$R *.dfm}
41
42 uses SyncObjs;
43
44 var
45 f:integer;
46 MyEvent:TEvent;
47 MyThread:TMyThread;
48
49 { TMyThread }
50
51
52 procedure TMyThread.Execute;
53 begin
54 inherited;
55 FreeOnTerminate:=True; {线程使用完自己注销}
56 Run;
57 end;
58
59 procedure TMyThread.Run;
60 var
61 i,y:integer;
62 begin
63 Inc(f);
64 y:=20*f;
65
66 for i := 0 to 20000 do
67 begin
68 if MyEvent.WaitFor(INFINITE)=wrSignaled then {判断事件在用没，配合事件的启动和暂停，对事件相关线程起统一控制}
69 begin
70 Form1.Canvas.lock;
71 Form1.Canvas.TextOut(10,y,IntToStr(i));
72 Form1.Canvas.Unlock;
73 Sleep(1);
74 end;
75
76 end;
77
78 end;
79
80 procedure TForm1.btn1Click(Sender: TObject);
81 begin
82 Repaint;
83 f:=0;
84 if Assigned(MyEvent) then MyEvent.Free; {如果有，就先销毁}
85
86 {参数1安全设置，一般为空；参数2为True时可手动控制暂停，为Flase时对象控制一次后立即暂停
87 参数3为True时对象建立后即可运行，为false时对象建立后控制为暂停状态，参数4为对象名称，用于跨进程，不用时默认''}
88 MyEvent:=TEvent.Create(nil,True,True,''); {创建事件}
89
90 end;
91
92 procedure TForm1.btn2Click(Sender: TObject);
93 var
94 ID:DWORD;
95 begin
96 MyThread:=TMyThread.Create(False); {创建线程}
97 end;
98
99 procedure TForm1.btn3Click(Sender: TObject);
100 begin
101 MyEvent.SetEvent; {启动} {事件类没有PulseEvent启动一次后轻描谈写}
102 end;
103
104 procedure TForm1.btn4Click(Sender: TObject);
105 begin
106 MyEvent.ResetEvent; {暂停}
107 end;
108
109 procedure TForm1.FormCreate(Sender: TObject);
110 begin
111 btn1.Caption:='创建事件';
112 btn2.Caption:='创建线程';
113 btn3.Caption:='启动';
114 btn4.Caption:='暂停';
115 end;
116
117 procedure TForm1.FormDestroy(Sender: TObject);
118 begin
119 MyEvent.Free; {释放}
120 end;
121
122 end.
总结
多线程用TThread类以及Uses syncobjs后使用的 TCriticalSection (临界区)，TMutex(互斥体)，TSemaphore (信号对象，D2009才开始有)，TEvent (事件对象)很多都是引用了API的方法进行了一定的简化，不过也有部分功能的缺失，如Event (事件对象)缺少了启动步进一次后暂停的功能，不过基本在同步上已经够用了，另外在TThread类声明的Execute过程里，加上FreeOnTerminate := True;这句会让线程执行完后自动释放，还可以把功能代码的方法套在Synchronize()里，用于同步一些非线程安全的控件对象，避免多个线程同时对一个对象操作引发的问题。
Delphi 线程同步技术
（转）
上次跟大家分享了线程的标准代码，其实在线程的使用中最重要的是线程的同步问题，如果你在使用线程后，发现你的界面经常被卡死，或者无法显示出来，显示混乱，你的使用的变量值老是不按预想的变化，结果往往出乎意料，那么你很有可能是忽略了线程同步的问题。
当有多个线程的时候，经常需要去同步这些线程以访问同一个数据或资源。例如，假设有一个程序，其中一个线程用于把文件读到内存，而另一个线程用于统计文件中的字符数。当然，在把整个文件调入内存之前，统计它的计数是没有意义的。但是，由于每个操作都有自己的线程，操作系统会把两个线程当作是互不相干的任务分别执行，这样就可能在没有把整个文件装入内存时统计字数。为解决此问题，你必须使两个线程同步工作。存在一些线程同步地址的问题，Windows 提供了许多线程同步的方式。在本节您将看到使用临界区、互斥、信号量、事件、全局原子和Synchronize 函数来解决线程同步的问题。
下面的同步技术一般均有两种使用方式，一种是直接使用Windows API 函数，一种是使用
由Delphi 对API 函数进行封装的类。
以下函数以Delphi 2009 中的函数格式为准。
1. Critical Sections 临界区
临界区是一种最直接的线程同步方式。所谓临界区，就是一次只能由一个线程来执行的一段
代码。例如把初始化数组的代码放在临界区内，另一个线程在第一个线程处理完之前是不会
被执行的。临界区非常适合于序列化对一个进程中的数据的访问，因为它们的速度很快。
(1). 使用EnterCriticalSection( ) 和LeaveCriticalSection( ) API 函数
在使用临界区之前， 必须定义一个TRTLCriticalSection 类型的记录变量并使用
InitializeCriticalSection( ) 过程来初始化临界区。该过程多半在窗体创建时或在程序初始化时
执行。
其声明如下：
procedure InitializeCriticalSection(var lpCriticalSection : TRTLCriticalSection);stdcall;
lpCriticalSection 参数是一个TRTLCriticalSection 类型的记录， 并且是变参。至于
TRTLCriticalSection 是如何定义的，这并不重要，因为很少需要查看这个记录中的具体内容。
只需要在lpCriticalSection 中传递未初始化的记录， InitializeCriticalSection( ) 过程就会填充这个记录。
注意：Microsoft 故意隐瞒了TRTLCriticalSection 的细节。因为，其内容在不同的硬件平台上是不同的。在基于Intel 的平台上，TRTLCriticalSection 包含一个计数器、一个指示当前线程句柄的域和一个系统事件的句柄。在Alpha 平台上，计数器被替换为一种Alpha-CPU数据结构，称为spinlock 。
在记录被填充后，我们就可以开始创建临界区了。这时我们需要用EnterCriticalSection( ) 和LeaveCriticalSection( ) 来封装代码块，这两个函数分别代表进入和离开临界区，将要同步的代码块放在这两个函数中间。在第一个线程调用了EnterCriticalSection( ) 之后，所有别的线程就不能再进入代码块并挂起等待第一个线程离开临界区。下一个线程要等第一个线程调用LeaveCriticalSection( ) 后才能被唤醒。这两个过程的声明如下：
procedure EnterCriticalSection(var lpCriticalSection : TRTLCriticalSection);stdcall; //进入临界区
procedure LeaveCriticalSection(var lpCriticalSection : TRTLCriticalSection);stdcall; //离开临界
区
正如你所想的，参数lpCriticalSection 就是由InitializeCriticalSection( ) 填充的记录。如果在某个子线程执行EnterCriticalSection( ) 前，已经有另一个线程进入临界区且还未离开临界区，则该子线程将挂起并无限期等待另一个线程离开临界区，要想不挂起且0 时间等待，必须使用TryEnterCriticalSection( ) 。该过程声明如下：
function TryEnterCriticalSection(var lpCriticalSection: TRTLCriticalSection): BOOL; stdcall;
TryEnterCriticalSection( ) 不同于EnterCriticalSection( ) 的声明在于多出一个布尔型的返回值，如果返回True 代表成功进入临界区，如果返回False 代表临界区已占用且不进入临界区。运用这个函数，线程能够迅速查看它是否可以访问某个共享资源，如果不能访问，那么它可以继续执行某些其他操作，而不必进行等待。
使用TryEnterCriticalSection( ) ，必须判断其返回值。
当你不需要临界区时，应当调用DeleteCriticalSection( ) 过程删除临界区，该函数多半在窗
体销毁时或程序终止前执行。下面是它的声明：
procedure DeleteCriticalSection(var lpCriticalSection : TRTLCriticalSection); stdcall;
例：
type
TMyThread = class(TThread)
protected
procedure Execute; override;
public
constructor Create; virtual;
end;
var
Form1 : TForm1;
CriticalSection : TRTLCriticalSection;//定义临界区
implementation
{$R *.dfm}
var
tick: Integer = 1;
procedure TMyThread.Execute;
begin
EnterCriticalSection(CriticalSection);//进入临界区
try
Form1.Edit1.Text := IntToStr(tick);
Inc(tick);
Sleep(10);
finally
LeaveCriticalSection(CriticalSection); //离开临界区
end;
end;
constructor TMyThread.Create;
begin
inherited Create(False);
FreeOnTerminate := True;
end;
procedure TForm1.RzButton1Click(Sender : TObject);
var
index: Integer;
begin
for index := 0 to 15 do
TMyThread.Create;
end;
procedure TForm1.FormCreate(Sender : TObject);
begin
InitializeCriticalSection(CriticalSection); //初始化临界区
end;
procedure TForm1.FormDestroy(Sender : TObject);
begin
DeleteCriticalSection(CriticalSection); //删除临界区
end;
(2). 使用TcriticalSection 类
TcriticalSection 是在SyncObjs 单元中定义的类，要使用它需要先uses SyncObjs 。它对上面的那些临界区操作API 函数进行了封装，简化并方便了在Delphi 中的使用。例如TcriticalSection.Enter 其实是调用了TRTLCriticalSection.Enter 。
使用TcriticalSection 类和一般类差不多，首先实例化TcriticalSection 类。使用的时候只要
在主线程当中创建这个临界对象（注意一定要在需要同步的子线程之外建立这个对象）。
Tcriticalsection 类的构造函数比较简单，没有带参数。
TcriticalSection.Enter 等效于EnterCriticalSection( ) 。
TcriticalSection.TryEnter 等效于TryEnterCriticalSection( ) 。
TcriticalSection.Leave 等效于LeaveCriticalSection( ) 。
例：
//在主线程中定义
var criticalsection : TCriticalsection;
criticalsection := TCriticalsection.Create;
…
//在子线程中使用
criticalsection.Enter;
try
...
finally
criticalsection.Leave;
end;
警告：临界区只有在所有的线程都使用它来访问全局内存时才起作用，如果有线程直接调用
内存，而不通过临界区，也会造成同时访问的问题。
注意：临界区主要是为实现线程之间同步的，但是使用的时候要注意，一定要在使用临界区
同步的线程之外建立该临界区（一般在主线程中定义临界区并初始化临界区）。临界区是一
个进程里的所有线程同步的最好办法，它不是系统级的，只是进程级的，也就是说它可能利
用进程内的一些标志来保证该进程内的线程同步，据Richter 说是一个记数循环。临界区只
能在同一进程内使用。
2. Mutex 互斥
互斥是在序列化访问资源时使用操作系统内核对象的一种方式。我们首先设置一个互斥对
象，然后访问资源，最后释放互斥对象。在设置互斥时，如果另一个线程（或进程）试图设
置相同的互斥对象，该线程将会停下来，直到前一个线程（或进程）释放该互斥对象为止。
注意它可以由不同应用程序共享。互斥的效果非常类似于临界区，除了两个关键的区别：首
先，互斥可用于跨进程的线程同步。其次，互斥对象能被赋予一个字符串名字，并且通过引
用此名字创建现有内核对象的附加句柄。线程同步使用临界区，进程同步使用互斥。
当一个互斥对象不再被一个线程所拥有， 它就处于发信号状态。此时首先调用
WaitForSingleObject( ) 函数(实现WaitFor 功能的API 还有几个，这是最简单的一个)的线
程就成为该互斥对象的拥有者，将互斥对象设为不发信号状态。当线程调用ReleaseMutex( )
函数并传递一个互斥对象的句柄作为参数时，这种拥有关系就被解除，互斥对象重新进入发
信号状态。
提示：临界区和互斥的作用类似，都是用来进行同步的，但它们间有以下一点差别。临界区
只能在进程内使用，也就是说只能是进程内的线程间的同步；而互斥则还可用在进程之间的；
临界区随着进程的终止而终止，而互斥，如果你不用CloseHandle( ) 的话，在进程终止后
仍然在系统内存在，也就是说它是操作系统全局内核对象；临界区与互斥最大的区别是在性
能上，临界区在没有线程冲突时，要用10 ~ 15 个时间片，而互斥由于涉及到系统内核要用
400 ~ 600 个时间片；临界区不是内核对象，它不由操作系统的低级部件管理，而且不能使
用句柄来操纵，而互斥属于操作系统内核对象。
(1). 使用CreateMutex( ) API 函数
调用函数CreateMutex( ) 来创建一个互斥。下面是函数的声明：
function CreateMutex(lpMutexAttributes: PSecurityAttributes; bInitialOwner: BOOL; lpName:
PWideChar): THandle; stdcall;
lpMutexAttributes 参数为一个指向TsecurityAttributtes 记录的指针。此参数通常设为nil ，
表示默认的安全属性。bInitalOwner 参数表示创建互斥的线程是否要成为此互斥对象的初始
拥有者，当此参数为False 时，表示互斥对象没有拥有者。lpName 参数指定互斥对象的名
称，该名称是大小写区分的，设为nil 表示无命名，如果参数不是设为nil ，函数会搜索
是否有同名的互斥对象存在，如果有，函数就会返回同名互斥对象的句柄。否则，就新创建
一个互斥对象并返回其句柄。
当使用完互斥时，应当调用CloseHandle( ) 来关闭它。
WaitForSingleObject( ) 函数的使用：
在线程中使用WaitForSingleObject( ) 来防止其他线程进入同步区域的代码。第一个调用
WaitForSingleObject( ) 函数的线程会将事件对象(不限于互斥对象)设为无信号状态，其它线
程调用WaitForSingleObject( ) 函数时会检查事件对象是否处于发信号状态，这时状态处于
无信号状态，所以其它线程会挂起等待而不执行同步区域中的代码。当第一个线程执行完同
步代码后会释放事件对象，事件对象重新进入发信号状态并唤醒等待线程，其它线程会再次
将事件对象设为无信号状态，防止另外的线程执行同步代码。这就实现了线程同步。
此函数声明如下：
function WaitForSingleObject(hHandle : THandle; dwMilliseconds : DWORD): DWORD; stdcall;
这个函数可以使当前线程在dwMilliseconds 参数指定的时间内等待事件对象信号，直到
hHandle 参数指定的事件对象进入发信号状态为止。当一个事件对象不再被线程拥有时，它
就进入发信号状态。当一个进程要终止时，它就进入发信号状态。dwMilliseconds 参数设为
0 ，这意味着只检查hHandle 参数指定的事件对象是否处于发信号状态，而后立即返回该
信号状态。dwMilliseconds 参数设为INFINITE ，表示如果信号不出现将一直等下去。
WaitForSingleObject( ) 在一个指定时间（dwMilliseconds）内等待一个事件对象变为有信号，
在此时间内，若等待的事件对象一直是无信号的，则调用线程将处于挂起状态，否则继续执
行。超过此时间后，线程继续运行。
WaitForSingleObject( ) 函数返回值及含义：
WAIT_ABANDONED 指定的对象是一个事件对象，该对象没有被拥有线程在线程结束前释
放。此时就称事件对象被抛弃。互斥对象的所有权被同意授予调用该函数的线程。互斥对象
被设置成为无信号状态
WAIT_OBJECT_0 指定的对象处于发信号状态
WAIT_TIMEOUT 等待的时间已过，对象仍然是非发信号状态
WAIT_FAILED 语句出错
WaitForMultipleObjects( ) 函数的使用：
WaitForMultipleObjects( ) 与WaitForSingleObject( ) 类似，只是它要么等待指定列表（由
lpHandles 指定）中若干个互斥对象（由nCount 决定）都变为有信号，要么等待一个列表
（由lpHandles 指定）中的一个对象变为有信号（由bWaitAll 决定）。该函数声明如下：
function WaitForMultipleObjects(nCount: DWORD; lpHandles: PWOHandleArray; bWaitAll:
BOOL; dwMilliseconds: DWORD): DWORD; stdcall;
nCount 参数表示句柄的数量，最大值为MAXIMUM_WAIT_OBJECTS(64)，lpHandles 参数
是指向句柄数组的指针，lpHandles 类型可以为(Event，Mutex，Process，Thread，Semaphore)
数组，bWaitAll 参数表示等待的类型，如果为True 则等待所有信号量有效再往下执行，设
为False 则当有其中一个信号量有效时就向下执行，dwMilliseconds 参数表示超时时间，超
时后向下继续执行。
注意： 除WaitForSingleObject( ) 和WaitForMultipleObjects( ) 外， 你还可以使用
MsgWaitForMultipleObjects( ) 函数。该函数的详细情况请看Win32 API 联机文档。
WaitForSingleObject( ) 不仅仅用于互斥，也用于信号量或事件，因此这里用词为“事件对象”
而非互斥对象。在互斥例中，可以用互斥对象代替事件对象，同样，在信号量例中，也能以
信号量对象代替事件对象。
再次提示，当一个互斥对象不再被一个线程所拥有，它就处于发信号状态。此时首先调用
WaitForSingleObject( ) 函数的线程就成为该互斥对象的拥有者，此互斥对象设为无信号状
态。当线程调用ReleaseMutex( ) 函数并传递一个互斥对象的句柄作为参数时，这种拥有关
系就被解除，互斥对象重新进入发信号状态。ReleaseMutex( ) 声明如下：
function ReleaseMutex(hMutex: THandle): BOOL; stdcall;
进程间需要同步时，只需要执行CreateMutex( ) 建立一个互斥对象，需要同步的时候只需
要WaitForSingleObject(mutexhandle, INFINITE) ，释放时只需要ReleaseMutex(mutexhandle)
即可。
例：
//先在主线程中创建互斥对象
var
hMutex : THandle = 0;//定义一个句柄
...
hMutex := CreateMutex(nil, False, nil);//创建互斥对象，并返回其句柄
//在子线程的Execute 方法中加入以下代码
WaitForSingleObject(hMutex, INFINITE);//互斥对象处于发信号状态时进入同步区，否则等待
...
ReleaseMutex(hMutex);
//最后记得要在主线程中释放互斥对象
CloseHandle(hMutex);//关闭句柄
(2). 使用TMutex 类
TMutex 是在SyncObjs 单元中定义的类，其是ThandleObject 类的子类，要使用它需要先
uses SyncObjs 。它对上面的那些互斥操作API 函数进行了封装，简化并方便了在Delphi
中的使用。
使用前先实例化TMutex 类，其有多个重载的构造函数。声明如下：
constructor Create(UseCOMWait: Boolean = False); overload;
constructor Create(MutexAttributes: PSecurityAttributes; InitialOwner: Boolean; const Name:
string; UseCOMWait: Boolean = False); overload;
constructor Create(DesiredAccess: LongWord; InheritHandle: Boolean; const Name: string;
UseCOMWait: Boolean = False); overload;
其实简单的直接调用TMutex.Create 就可以返回一个TMutex 对象。
第一个版本将创建一个无名的、使用默认安全属性、创建其的线程非互斥对象的初始拥有者
的TMutex 对象，其中的参数UseCOMWait 设为True 时表示当某个线程阻塞且等待互斥
对象时，任何单线程单元( STA ) COM 组件调用可以发回到该线程，其默认为False 。
第二个版本的MutexAttributes 参数通常设为nil 表示使用默认的安全属性。InitialOwner 参
数表示创建线程是否是互斥对象的初始拥有者。Name 参数表示互斥对象的名字，大小写区
分。
第三个版本的DesiredAccess 参数表示访问互斥的方式，如果传递的访问方式没有被允许那
么构造函数会失败，其参数可以是下面几个常量的任意组合：
MUTEX_ALL_ACCESS， MUTEX_MODIFY_STATE， SYNCHRONIZE， _DELETE，
READ_CONTROL ， WRITE_DAC ， WRITE_OWNER 。但任何组合必须包含
SYNCHRONIZE 访问权。InheritHandle 参数表示子进程是否可继承该互斥对象句柄。
TMutex.Acquire 等效于WaitForSingleObject(mutexhandle, INFINITE) ，其实际上就是执行
THandleObject.WaitFor(INFINITE)。
TMutex.Release 实际上就是执行ReleaseMutex(mutexhandle)。
TMutex.Acquire 只能无限期等待一个互斥对象，要设置等待时间或等待多个互斥对象要使
用TMutex.WaitFor( ) 或TMutex.WaitForMultiple( )。
WaitFor( ) 是定义在TMutex 的父类ThandleObject 中的虚函数，声明如下：
function WaitFor(Timeout: LongWord): TWaitResult; virtual;
其中返回值枚举型TWaitResult 可以指示操作结果，wrSignaled 代表信号已set ，
wrTimeOut 代表超时且信号未set ，wrAbandoned 代表超时前事件对象被销毁，wrError 代
表等待时出错。
WaitForMultiple( ) 是定义在TMutex 的父类ThandleObject 中的类函数，声明如下：
class function WaitForMultiple(const HandleObjs: THandleObjectArray; Timeout: LongWord;
AAll: Boolean; out SignaledObj: THandleObject; UseCOMWait: Boolean = False; Len: Integer =
0): TWaitResult;
其中HandleObjs 参数是包含了要等待的一系列事件对象的数组，AAll 参数设为True 时，
当所有事件对象都进入发信号状态后该函数调用才会完成，当返回值为wrSignaled 且
AAll 参数设为False 时，第一个发信号的事件对象会被传给SignaledObj 参数，Len 参数
设置监视事件对象的数量。
注意：WaitFor( ) 和WaitForMultiple( ) 均定义在ThandleObject 类中，而ThandleObject 类
是TMutex 、TSemaphore 、TEvent 类的父类，所以在描述WaitFor( ) 和WaitForMultiple( )
时使用的是事件对象而非互斥对象或信号量对象。
3. Semaphore 信号量
另一种使线程同步的技术是使用信号量对象。它是在互斥的基础上建立的，它与互斥相似，
但它可以计数。信号量增加了资源计数的功能，预定数目的线程允许同时进入要同步的代码。
例如可以允许一个给定资源同时被三个线程访问。其实互斥就是最大计数为1 的信号量。
信号量的使用和互斥差不多。
(1). 使用CreateSemaphore( ) API 函数
可以用CreateSemaphore( ) 来创建一个信号量对象，其声明如下：
function CreateSemaphore(lpSemaphoreAttributes: PSecurityAttributes;
lInitialCount, lMaximumCount: Longint; lpName: PWideChar): THandle; stdcall;
和CreateMutex( ) 函数一样， CreateSemaphore( ) 的第一个参数也是一个指向
TSecurityAttributes 记录的指针，此参数的缺省值可以设为nil 。
lInitialCount 参数用来指定一个信号量的初始计数值，这个值必须在0 和lMaximumCount
之间。此参数大于0 ，就表示信号量处于发信号状态。参数lMaximumCount 指定计数值
的最大值。如果这个信号量代表某种资源，那么这个值代表可用资源总数。
参数lpName 用于给出信号量对象的名称，它类似于CreateMutex( ) 函数的lpName 参数。
在程序中使用WaitForSingleObject( ) 来防止其他线程进入同步区域的代码。当调用
WaitForSingleObject( ) 函数( 或其他WaitFor 函数) 时， 此计数值就减1 。当调用
ReleaseSemaphore( ) 时，此计数值加1 ，此时同步区域代码可以被其它线程访问。其声明
如下：
function ReleaseSemaphore(hSemaphore: THandle; lReleaseCount: Longint;
lpPreviousCount: Pointer): BOOL; stdcall;
其中hSemaphore 参数是创建的信号量句柄，lReleaseCount 参数是释放时要增加的信号量
计数，lpPreviousCount 参数是通过该指针参数来获得释放前的信号量计数，如果不用设为
nil 。
当使用完信号量时，应当调用CloseHandle( ) 来关闭它。
注意：一般的同步使用互斥，是因为其有一个特别之处，当一个持有互斥的线程DOWN 掉
的时候，互斥可以自动让其它等待这个对象的线程接受，而其它的内核对象则不具体这个功
能。之所以要使用信号量则是因为其可以提供一个活动线程的上限，即lMaximumCount 参
数，这才是它的真正有用之处。
例：
var
Form1 : TForm1;
HSem : THandle = 0;//定义一个信号量
implementation
var
tick : Integer = 0;
procedure TMyThread.Execute;
var
WaitReturn : DWord ;
begin
WaitReturn := WaitForSingleObject(HSem, INFINITE);//使用信号量对象，信号量减1
Form1.Edit1.Text := IntToStr(tick);
Inc(tick);
Sleep(10);
ReleaseSemaphore(HSem, 1, Nil);//释放信号量对象，信号量加1
end;
…
procedure TForm1.FormCreate(Sender: TObject);
begin
HSem := CreateSemaphore(Nil, 1, 1, Nil);//创建信号量对象
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseHandle(HSem);//销毁信号量
end;
procedure TForm1.Button1Click(Sender: TObject);
var
index : Integer;
begin
for index := 0 to 10 do
TMyThread.Create;
end;
(2). 使用TSemaphore 类
TSemaphore 是在SyncObjs 单元中定义的类，其是ThandleObject 类的子类，要使用它需
要先uses SyncObjs 。它对上面的API 函数进行了封装，简化并方便了在Delphi 中的使
用。
其有三个版本的构造器，简单执行TSemaphore.Create 就可实例化一个对象：
constructor Create(UseCOMWait: Boolean = False); overload;
constructor Create(SemaphoreAttributes: PSecurityAttributes; AInitialCount: Integer;
AMaximumCount: Integer; const Name: string; UseCOMWait: Boolean = False); overload;
constructor Create(DesiredAccess: LongWord; InheritHandle: Boolean;
const Name: string; UseCOMWait: Boolean = False); overload;
参数参见上面介绍。
TSemaphore.Acquire 等效于WaitForSingleObject(semaphorehandle, INFINITE) ，其实际上就
是执行THandleObject.WaitFor(INFINITE)。或者使用WaitFor( ) 和WaitForMultiple( ) 函数，
这两个函数可以设置等待的时间或等待多个事件对象。
TSemaphore.Release 有两个版本，声明如下：
procedure Release; override; overload;
function Release(AReleaseCount: Integer): Integer; overload; reintroduce;
第一个版本实际执行ReleaseSemaphore(FHandle, 1, nil)
第二个版本AReleaseCount 参数表示释放时增加的信号量计数值，返回值是释放前的信号
量计数值。实际执行ReleaseSemaphore(FHandle, AReleaseCount, @Result)，其中@Result 是
指向Release 函数返回值Integer 类型的指针。如果要指定增加计数值应使用第二个版本。
4. Event 事件
事件( Event )与Delphi 中的事件有所不同。从本质上说，Event 其实相当于一个全局的布
尔变量。它有两个赋值操作： SetEvent 和ResetEvent ，相当于把它设置为True 或False 。
而检查它的值是通过WaitForSingleObject( ) (或其它WaitFor 函数)操作进行。SetEvent 和
ResetEvent 操作是原语操作，所以Event 可以实现一般布尔变量不能实现的在多线程中的
应用。
当Event 从Reset 状态向Set 状态转换时，唤醒其它挂起的线程，这就是它为什么叫
Event 的原因。所谓“事件”就是指“状态的转换”。通过Event 可以在线程间传递这种“状
态转换”信息。所以其本质是用来通知某事已经发生的信号，在这里可用来表示共享资源已
经在使用或已经使用完的信号。
(1). 使用CreateEvent( ) API 函数
使用CreateEvent( ) 创建一个事件，声明如下：
function CreateEvent(lpEventAttributes: PSecurityAttributes;
bManualReset, bInitialState: BOOL; lpName: PWideChar): THandle; stdcall;
其中bManualReset 参数代表创建的Event 是自动复位还是人工复位，如果设为True 表示
人工复位，一旦该Event 被设置为有信号，则它一直会等到手动执行ResetEvent( ) 时才会
变为无信号，设为False 表示自动复位，Event 被设置为有信号时，则当有一个线程执行
WaitForSingleObject( ) 时该Event 就会自动复位，变成无信号。bInitialState 参数代表事件
的初始状态，设为True，事件创建后为有信号，设为False 则为无信号。
不同于互斥或信号量，Event 不使用Release 相关函数设置相关对象进入发信号状态，而使
用SetEvent( ) 函数，当线程执行完同步代码要从同步区域中离开时应执行该函数，声明如
下：
function SetEvent(hEvent: THandle): BOOL; stdcall;
当事件创建为人工复位时，在线程进入同步区域执行同步代码前应执行ResetEvent( ) 函数，
将Event 设为无信号。声明如下：
function ResetEvent(hEvent: THandle): BOOL; stdcall;
PulseEvent( ) 是一个比较有意思的方法，正如名字，它使一个Event 对象的状态发生一次
脉冲变化，将无信号设为有信号，唤醒等待的线程，再设为无信号，而整个操作是原子的。
对自动复位的Event 对象，它仅唤醒第一个等到该事件的线程(如果有的话)，而对于人工复
位的Event 对象，它唤醒所有等待的线程。声明如下：
function PulseEvent(hEvent: THandle): BOOL; stdcall;
当使用完事件时，应当调用CloseHandle( ) 来关闭它。
(2). 使用TEvent 类
TEvent 是在SyncObjs 单元中定义的类，其是ThandleObject 类的子类，要使用它需要先
uses SyncObjs 。它对上面的API 函数进行了封装，简化并方便了在Delphi 中的使用。
TEvent 若在多线程环境中可用于与其它线程同步；若在单线程环境中可用于调整响应不同
异步事件(如系统消息或用户动作)的代码段。构造函数如下：
constructor Create(EventAttributes: PSecurityAttributes; ManualReset: Boolean;
InitialState: Boolean; const Name: string; UseCOMWait: Boolean = False); overload;
constructor Create(UseCOMWait: Boolean = False); overload;
ManualReset 参数为是否手工复位，InitialState 参数为初始状态。
TEvent.SetEvent( ) 和TEvent.ResetEvent( ) 均无参数。
TEvent 类中没有定义与PulseEvent 功能一样的方法。
TEvent 类同样可以使用WaitFor( ) 和WaitForMultiple( ) 函数。
但要注意的是，TEvent 类并没有实现Acquire 函数，该函数是定义在TSynchroObject 类
中仅作为接口、没有执行代码的虚函数。TSynchroObject 是ThandleObject 类的父类。其实
自己实现Acquire 函数也不难，它实际上是执行THandleObject.WaitFor(INFINITE) 函数，
仿照上面的TMutex 类写就可以。
另外，Delphi 中定义了一个更简单的事件类，TSimpleEvent 类，但从源代码上看，该类仅
有TSimpleEvent = class(TEvent); 一句，并未定义任何属于TSimpleEvent 的成员。估计是
作为向后兼容而存在。
5. Global Atom 全局原子
Windows 系统中，为了实现信息共享，系统维护了一张全局原子表( Global Atom Table )，
用于保存字符串与之对应的标志符(原子)的组合，系统能保证其中的每个原子都是唯一的，
管理其引用计数，并且当该全局原子的引用计数为0 时，从内存中清除。应用程序在原子表
中可以放置字符串，并接收一个16 位整数值(叫做原子，即Atom )，它可以用来提取该字
符串。放在原子表中的字符串叫做原子的名字。系统提供了许多原子表。每个表有不同的目
的。例如，动态数据交换( DDE )应用程序使用全局原子表与其他应用程序共享项目名称和
主题名称字符串，不传递实际的字符串，一个DDE 应用程序传递全局原子给它的父进程，
父进程使用原子提取原子表中的字符串，这就是利用全局原子进行进程或线程间的数据交
换；使用全局原子也可防止多次启动某个程序。
应用程序可以使用本地原子表来有效地管理大量只用于程序内部的字符串。这些字符串，以
及相关联的原子，只对创建该原子表的应用程序可用。一个在许多数据结构中需要相同字符
串的应用程序，可以通过使用本地原子表来减少内存使用。程序可以把字符串放入原子表，
把相关的原子放入结构，而无需把字符串拷到每个结构中。这样，一个字符串在内存中只出
现一次，但可以在程序中多次使用。应用程序也可以使用本地原子表来快速搜索特定的字符
串。要实现这样的搜索，程序只需把要搜索的字符串放入原子表中，然后把结果原子与相关
数据结构中的原子相比较。通常情况下，比较原子要比比较字符串要快得多。原子表是用哈
希表实现的。默认时，一个本地原子表使用37 个bucket 的哈希表。不过，你可以通过调
用InitAtomTable 函数来改变bucket 数量。如果程序准备调用InitAtomTable ，那它必须
在调用任何其他原子管理函数前调用它。这里只简单介绍本地原子表。它有多个相关的函数，
function InitAtomTable(nSize: DWORD): BOOL; stdcall;
function DeleteAtom(nAtom: ATOM): ATOM; stdcall;
function AddAtom(lpString: PWideChar): ATOM; stdcall;
function FindAtom(lpString: PWideChar): ATOM; stdcall;
function GetAtomName(nAtom: ATOM; lpBuffer: PWideChar; nSize: Integer): UINT; stdcall;
以下介绍全局原子表相关函数。
function GlobalAddAtom(lpString: PWideChar): ATOM; stdcall;
增加一个字符串到全局原子表中，并返回一个唯一标识值。
lpString 参数为要添加到全局原子表中的字符串。
如果成功返回新增加的全局原子，失败则返回0 。ATOM 类型等于Word 类型。
function GlobalDeleteAtom(nAtom: ATOM): ATOM; stdcall;
减少对指定全局原子的引用计数，引用计数减1 ，如果引用计数为零，系统会在全局原子
表中删除此原子。
此函数一直返回0 。
只要全局原子的引用计数大于0 ，其原子名称将保留在全局原子表中，即使把它放入表中
的应用程序终结了。一个本地的原子表在应用程序终结时被销毁，而不管其中原子的引用计
数是多少。
function GlobalFindAtom(lpString: PWideChar): ATOM; stdcall;
在全局原子表中查找是否存在指定字符串。
lpString 参数为要查找的字符串。
如果在全局原子表中存在要查找的字符串，则返回此字符串对应的原子，没有找到则返回0。
function GlobalGetAtomName(nAtom: ATOM;
lpBuffer: PWideChar; nSize: Integer): UINT; stdcall;
返回指定原子所对应的字符串。
nAtom 参数为指定查找的原子，lpBuffer 参数为要存放字符串的缓冲区，nSize 参数为缓冲
区大小。
若操作成功返回缓冲区接受长度，若失败返回0 。UINT 类型等于LongWord 类型。
例：
//在程序的program 文件中
...
if GlobalFindAtom(iAtom) = 0 then
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end
else
MessageBox(0, '已经有一个程序在运行', ' ', mb_OK);
...
6. Synchronize 同步
Synchronize( ) 是定义在TThread 类中的函数，它可以让要执行的代码实现线程同步，但这
种同步其实是伪同步，其原理是将子线程要执行的代码通过消息传递给主线程，由主线程来
执行，主线程将代码放在一个隐蔽的窗口里运行，而子线程会等待主线程将执行结果发给它，
这样的话，这段代码就不是子线程代码，而是一般的主线程代码。Synchronize( ) 只是将该
线程的代码放到主线程中运行，并非实际意义的线程同步。RAD Studio VCL Reference 中也
描述为：Executes a method call within the main thread，Synchronize causes the call specified by
AMethod(参数) to be executed using the main thread,，thereby avoiding multi-thread conflicts。
这里有一个问题，如果Synchronize( ) 执行的代码很繁忙，例如执行的代码运算过于复杂、
庞大或者从数据库中取出大量数据，数据库不会立即返回数据时或者使用ADO 组件连接
数据库，而这时数据库无法连接，ADO 组件需要超时才会终止运行，这些都会导致主窗口
会阻塞掉，看似死机一般。因此，通常对用户界面类VCL 组件的访问才使用Synchronize( )
函数，一般用户界面类VCL 组件都由主线程创建、存在于主窗口中，而且对VCL 组件的
访问或修改的执行效率都比较高，不会过多的影响性能。绝对不能在主线程中执行
Synchronize( ) 函数，这会导致无限循环。
Synchronize( ) 函数一般在线程的Execute 函数中调用。其有四个版本，两个是类函数，两
个是静态函数，声明如下：
class procedure Synchronize(AThread: TThread; AMethod: TThreadMethod); overload;
class procedure Synchronize(AThread: TThread; AThreadProc: TThreadProcedure); overload;
procedure Synchronize(AMethod: TThreadMethod); overload;
procedure Synchronize(AThreadProc: TThreadProcedure); overload;
AThread 参数是当前线程，TThreadMethod 是对象的函数指针类型，TThreadProcedure 是匿
名函数类型。
注意：Synchronize( ) 的AMethod 或AThreadProc 参数必须是一个无参数的procedure ，
故在此procedure 中无法传递参数值，通常的解决方法是在线程类中增加额外的成员，用其
代替参数来传递信息。
例：
type
TMyThread = class(TThread)
str : string;//额外的域，代替参数将字符串写入Memo
...
procedure TMyThread.WriteMemo;
begin
Memo.Lines.Add(str);
end;
...
procedure TMyThread.Execute;
begin
str := 'Hello';
synchronize(WriteMemo);
end;