Delphi多线程详解

时间 2019-11-19

原文原文链接

(整理自网络)

Delphi多线程处理

1-1多线程的基本概念

WIN 98/NT/2000/XP 是个多任务操做系统，也就是：一个进程能够划分为多个线程，每一个线程轮流占用CPU 运行时间和资源，或者说，把CPU 时间划成片，每一个片分给不一样的线程，这样，每一个线程轮流的“挂起”和“唤醒”，因为时间片很小，给人的感受是同时运行的。html

多线程带来以下好处：（本身阅读）数据库

1）避免瓶颈；编程

2）并行操做；数组

3）提升效率；安全

在多线程中，经过优先级管理，能够使重要的程序优先操做，提升了任务管理的灵活性。服务器

另外一方面，在多CPU 系统中，能够把不一样的线程在不一样的CPU 中执行，真正作到同时处理多任务（Win 98 只是模拟的，而Win/NT/2000是真正的多CPU同时操做）。网络

多线程的两个概念：session

1）进程：也称任务，程序载入内存，并分配资源，称为“一个进程”。数据结构

注意：进程自己并不必定要正在执行。进程由如下几部分组成：多线程

a>一个私有的地址空间，它是进程能够使用的一组虚拟内存地址空间；

b>程序的相关代码、数据源；

c>系统资源，好比操做系统同步对象等；

d>至少包含一个线程（主线程）；

2）线程：是程序的执行单位（线程自己并不包括程序代码，真正拥有代码的是进程），每一个进程至少包括一个线程，称为主线程，一个进程若是有多个线程，就能够共享同一进程的资源，并能够并发执行。

线程是进程的一个执行单元，是操做系统分配CPU 时间的基本实体，线程主要由以下两部分组成：

a>数据结构；

b>CPU 寄存器和堆栈；

一个进程中的线程，能够独立运行，也能够控制另外一个线程的运行。

请注意：

多线程不能滥用，书上提到了多线程的几个缺点（自阅）。

1-2 Tthread 对象

虽然Windows 提供了比较多的多线程设计的API 函数，可是直接使用API 函数一方面极其不方便，并且使用不当还容易出错。为解决这个问题，Borland 公司率先推出了一种Tthread 对象，来解决多线程设计上的困难，简化了多线程问题的处理。

应该注意，Tthread 对象是没有实例的，它和界面的交流，主要依靠主窗体（主VCL线程），这和其余对象使用上有些区别。

1、Tthread 对象的主要方法

构造线程：

constructor Create(CreateSuspended:boolean)

其中：CreateSuspended=true 构造但不唤醒

false 构造的同时即唤醒

也能够用以下方法

inheried Create(CreateSuspended:boolean)

挂起线程：

suspend

（把线程挂起的次数加一）

唤醒线程：

resume

（注意：注意这个属性是把线程挂起的次数减一，当次数为0 时，即唤醒。也就是说，线程挂起多少次，唤醒也须要多少次。同时挂起的时候将保持线程的地址指针不变，因此线程挂起后再唤醒，将从挂起的地方开始运行）

析构（清除线程所占用的内存）：

destroy

终止线程（后面会具体讨论）:

Terminate

2、线程应用的简单例子：

下面经过一个例子说明上述方法的应用。咱们知道，循环是独占性最强的运行方式之一，如今但愿创建两个线程对象，实现循环的并行运行。具体方法以下：

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相应的单元，这个例程为了简单，把大部分经常使用的单元都拷过去了，这并非推荐的办法，由于这样一来会使程序的垃圾过

多，因此，通常要用什么拷什么。

3、经常使用的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。

4、线程的终止和退出：

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; //释放

书上有相应的例子。

5、线程的优先级：

在多线程的状况下，通常要根据线程执行任务的重要性，给线程适当的优先级，通常若是量的线程同时申请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.多线程的同步机制

同步机制，其实是事件驱动机制，意思是让线程平时处于“休眠”状态，除非发生某个事件才触发。

例如一个拷贝文件，拷贝线程完成一个程序块后，再唤醒进程条线程作一个格的填充。

研究多线程的同步机制的必要性在于，多线程同步工做时，若是同时调用相同的资源，就可能会出现问题，通常读出是不会有问题的，可是，若是写入（全局变量、数据库），就会发生冲突，甚至产生死

锁和竞争问题。

1、使用Synchronize方法

这个方法用于访问VCL 主线程所管理的资源，其方法的应用是：

第一步：把访问主窗口（或主窗口控件资源）的代码放到线程的一个方法中；

第二步：是在线程对象的Execute方法中，经过Synchronize方法使用该方法。

实例：

procedure Theater.Execute;

begin

Synchronize(update);

end;

procedure Theater.update;

begin

.........

end;

这里经过 Synchronize使线程方法update同步。

2、使用VCL类的Look方法

在Delphi的IDE提供的构件中，有一些对象内部提供了线程的同步机制，工做线程能够直接使用这些控件，好比：Tfont，Tpen，TBitmap，TMetafile，Ticon等。另外，一个很重要的控件对象叫TCanvas，提供了一个Lock方法用于线程的同步，当一个线程使用此控件对象的时候，首先调用这个对象的Lock方法，而后对这个控件进行操做，完毕后再调用Unlock方法，释放对控间的控制权。

例如：

CanversObject.look;

try

画图

finally

CanversObject.unlock;

end;

{使用这个保护机制,保证不论有没有异常，unlock都会被执行不然极可能会发生死锁。在多线程设计的时候，应该很注意发生死锁的问题}

3、Waitfor方法

当一个线程应该等待另外一个线程结束时，能够调用Waitfor方法。这个方法属于等待线程对象，Waitfor方法的原型以下:

Function Waitfor(Const Astring:string):string;

好比在前面最基本的线程的例子中，唤醒线程的语句中加上

thread1.resume;

thread1.waitfor;

thread2.resume;

那么全部的线程都必须等待thread1运行完毕后才能运行，其中包括主线程，能够预想，因为thread1调用了主窗体的Edit控件，那么，在thread1运行中间，Edie1也不会显示。

这就告诉咱们，这样的代码是不能做为主线程的一部分的，若是与主窗体链接的线程内等待另外一个线程结束，而另外一个线程又要等待访问用户界面，就多是程序陷于死锁。

这点在应用的时候要谨慎。

4、利用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)

四、事件

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;

上面程序运行时, 咱们的窗体基本是 "死" 的, 能够在你在程序运行期间拖动窗体试试...

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;

这个 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;

细数上面程序的变化:

一、首先这还不是多线程的, 也会让窗体假 "死" 一会;

二、把执行代码写在了一个函数里, 但这个函数不属于 TForm1 的方法, 因此使用 Canvas 是必须冠以名称(Form1);

三、既然是个函数, (无论是否必要)都应该有返回值;

四、使用了 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;

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;

1、入门

㈠、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 类写多线程, 咱们不多用到它; 由于:

一、假如直接使用 API 的 CreateThread, 它执行完入口函数后会自动退出, 无需 ExitThread;

二、用 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? 如今我知道的是:

一、线程的 ID 是惟一的; 而句柄可能不仅一个, 譬如能够用 GetCurrentThread 获取一个伪句柄、能够用 DuplicateHandle 复制一个句柄等等.

二、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;

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;

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;

{创建并执行线程}

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;

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 应该是最经常使用的同步手段.

2、线程同步之临界区。

先看一段程序, 代码文件:

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);

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);

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);

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

ListBox1.Align := alLeft;

CS := TCriticalSection.Create;

end;

procedure TForm1.FormDestroy(Sender: TObject);

begin

CS.Free;

end;

end.

3、等待函数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, '\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.

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;

3 interface

5 uses

6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

7 Dialogs, StdCtrls;

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;

28 var

29 Form1: TForm1;

32 implementation

34 {$R *.dfm}

36 var

37 MyThread:TMyThread; {声明一个线程类对象]

39 procedure TMyThread.Execute;

40 begin

41 { Place thread code here }

42 FreeOnTerminate:=True; {加上这句线程用完了会自动注释}

43 Run;

44 end;

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;

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;

3 interface

5 uses

6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

7 Dialogs, StdCtrls;

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;

30 var

31 Form1: TForm1;

34 implementation

36 {$R *.dfm}

38 uses SyncObjs;

40 var

41 MyThread:TMyThread; {声明线程}

42 CS:TCriticalSection; {声明临界}

45 procedure TMyThread.Execute;

46 begin

47 { Place thread code here }

48 FreeOnTerminate:=True; {加上这句线程用完了会自动注释}

49 Run; {运行}

50 end;

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;

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;

73 procedure TForm1.FormDestroy(Sender: TObject);

74 begin

75 CS.Free;{释放临界体}

76 end;

78 end.

Mutex (互斥对象)

uses SyncObjs;用TMutex类的方法处理(把释放语句放在循环内外能够决定执行顺序)

例：互斥输出三个0~2000的数字到窗体在不一样位置。

1 unit Unit1;

3 interface

5 uses

6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

7 Dialogs, StdCtrls;

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;

29 var

30 Form1: TForm1;

33 implementation

35 {$R *.dfm}

37 uses SyncObjs;

39 var

40 MyThread:TMyThread; {声明线程}

41 Mutex:TMutex; {声明互斥体}

42 f:integer;

45 procedure TMyThread.Execute;

46 begin

47 { Place thread code here }

48 FreeOnTerminate:=True; {加上这句线程用完了会自动注释}

49 Run; {运行}

50 end;

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;

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;

81 procedure TForm1.FormDestroy(Sender: TObject);

82 begin

83 Mutex.Free;{释放互斥体}

84 end;

86 end.

Semaphore(信号或叫信号量)

{DELPHI2007不支持信号量，DELPHI2009才开始支持}

1 unit Unit1;

3 interface

5 uses

6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

7 Dialogs, StdCtrls;

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;

19 var

20 Form1: TForm1;

22 implementation

24 {$R *.dfm}

26 uses SyncObjs;

27 var

28 f: Integer;

29 MySemaphore: TSemaphore;

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;

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可命名用于多进程}

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;

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;

73 procedure TForm1.FormCreate(Sender: TObject);

74 begin

75 Edit1.Text := '1';

76 end;

78 procedure TForm1.FormDestroy(Sender: TObject);

79 begin

80 if Assigned(MySemaphore) then MySemaphore.Free;

81 end;

83 end.

Event (事件对象)

注：相比API的处理方式，此类没有启动步进一次后暂停的方法。

1 unit Unit1;

3 interface

5 uses

6 Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

7 Dialogs, StdCtrls;

9 type

10 TMyThread = class(TThread)

11 private

12 { Private declarations }

13 protected

14 procedure Execute; override;

15 procedure Run;

16 end;

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;

35 var

36 Form1: TForm1;

38 implementation

40 {$R *.dfm}

42 uses SyncObjs;

44 var

45 f:integer;

46 MyEvent:TEvent;

47 MyThread:TMyThread;

49 { TMyThread }

52 procedure TMyThread.Execute;

53 begin

54 inherited;

55 FreeOnTerminate:=True; {线程使用完本身注销}

56 Run;

57 end;

59 procedure TMyThread.Run;

60 var

61 i,y:integer;

62 begin

63 Inc(f);

64 y:=20*f;

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;

76 end;

78 end;

80 procedure TForm1.btn1Click(Sender: TObject);

81 begin

82 Repaint;

83 f:=0;

84 if Assigned(MyEvent) then MyEvent.Free; {若是有，就先销毁}

86 {参数1安全设置，通常为空；参数2为True时可手动控制暂停，为Flase时对象控制一次后当即暂停

87 参数3为True时对象创建后便可运行，为false时对象创建后控制为暂停状态，参数4为对象名称，用于跨进程，不用时默认''}

88 MyEvent:=TEvent.Create(nil,True,True,''); {建立事件}

90 end;

92 procedure TForm1.btn2Click(Sender: TObject);

93 var

94 ID:DWORD;

95 begin

96 MyThread:=TMyThread.Create(False); {建立线程}

97 end;

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;

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;