delphi多线程编程

◆delphi多线程编程之一create和Free◆

（调试环境：Delphi2007+WinXPsp3 例程Tst_）

Google搜到线程的例子都是那个画图的，猛禽那个多线程又太过高深（对于我这一滴水来说），万一老师开线程的博还是要等。只有自己看着《Delphi5开发人员指南》中文版PDF一步一步来弄懂些初步的东西，到时候可以跟上万一老师的课程。

一、创建：

1、直接书写：

unit Unit1;

interface

uses Classes;

TMyThead = class(TThread)

private

{ Private declarations }

protected

procedure Execute; override;

end;

implementation

{用鼠标放在上面的TMyThead上按ctrl+alt+c直接自动生成下面的}

procedure e;

begin

inherited;

end;

2、在File菜单的New—Others—Delphi Files里面选Thread Object，出来一个对话框，你在Thread名字里填TMyThread后，就会自动生成一个新的Unit2，里面的内容和上面一样。

二、简单例子：（例程：Tst_）

在一个Form上放3个按钮和一个Memo，然后加上下面这段。

TMyThead = class(TThread)

private

{ Private declarations }

protected

procedure Execute; override;

end;

var

Form1: TForm1;

m:integer;

implementation

{$R *.dfm}

{ TMyThead }

function Func1(const n:Integer):Integer; // 定义一个耗时函数来运行

begin

Result:=Round(abs(Sin(Sqrt(n))));

end;

procedure e;

var

i:integer;

begin

for i := 0 to 20000000 do

inc(m,Func1(i)); //m全局变量

end;

procedure 1Click(Sender: TObject);

var

i:integer;

begin

for i := 0 to 20000000 do

inc(m,Func1(i)); //m全局变量

end;

procedure 2Click(Sender: TObject);

var

MyThread:TMyThead;

begin

m:=0;

MyThread:=(False);

end;

procedure 3Click(Sender: TObject);

begin

('ok'+inttostr(m));

end;

end.

Button1Click后，Button3要过好几秒才能按下（嘿嘿，我的机子好，书上的例子i才200万，我加到2000万Button3才延迟几秒）。Button2Click后，立刻可以按Button3，这就是线程的好处。另外，我这里还没搞懂线程在哪安全free，所以干脆不free了。

注意：当TThread的Create()被调用时，需要传递一个布尔型的参数CreateSuspended。如果把这个参数设成False，那么当调用Create()后，Excute()会被自动地调用，也就是自动地执行线程代码。如果该参数设为True，则需要运行TThread的Resume()来唤醒线程。一般情况下，当你调用Create()后，还会有一些其他的属性要求设置。所以，应当把CreateSuspended参数设为True，因为在TThread已执行的情况下设置TThread的属性可能会引起麻烦。

再深入一点讲，在构造函数Create()中隐含调用了一个RTL例程BeginThread()，而它又调用了一个API函数CreateThread()来创建一个线程对象的实例。CreateSuspended参数表明是否传递CREATE_ SUSPEDED标志给CreateThread()。

三、线程的安全Free：（ps：这是我从PDF上copy整理的，例子稍微改过，本人没有那么高深）

当线程对象的Excute()执行完毕，我们就认为此线程终止了。这时，它会调用Delphi的一个标准例程EndThread()，这个例程再调用API函数ExitThread()。由ExitThread() 来清除线程所占用的栈。

当结束使用TThread对象时，应该确保已经把这个Object Pascal对象从内存中清除了。这才能确保所有内存占有都释放掉。尽管在进程终止时会自动清除所有的线程对象，但及时清除已不再用的对象,可以使内存的使用效率提高。利用将FreeOnTerminate的属性设为True的方法来及时清除线程对象是最方便的办法，这只需要在Excute()退出前设置就行了。设置方法如下：

procedure e;

var

i:integer;

begin

FreeOnTerminate:=True;

for i := 0 to 20000000 do

inc(m,Func1(i));

end;

这样，当一个线程终止时，就会触发OnTerminate事件，就有机会在事件处理过程内清除线程对象了。

若提前退出，Excute()就要不断检查Terminated属性的值。上面的代码继续加上：

procedure e;

var

i:integer;

begin

FreeOnTerminate:=True; //终止后自动free

for i:= 0 to 20000000 do

begin

if Terminated then Break;

inc(m,Func1(i));

end;

end;

注意：某些紧急情况下，你可以使用Win32API函数TerminateThread()来终止一个线程。但是，除非没有别的办法了，否则不要用它。例如，当线程代码陷入死循环时。

TerminateThread()的声明如下：

function TerminateThread(hThread:THandle;dwExitCode:DWORD);

TThread的Handle属性可以作为第一个参数，因此，TerminateThread()常这样调用：

TerminateThread(,0)

如果选择使用这个函数，应该考虑到它的负面影响。首先，此函数在Windows NT与在

Windows 95/98下并不相同。在Windows 95/98 下，这个函数能够自动清除线程所占用的栈；而在Windows NT下，在进程被终止前栈仍然保留。其次，无论线程代码中是否有finally块，这个函数都会使线程立即停止执行。这意味着，被线程打开的文件没有被关闭、由线程申请的内存没有被释放等情况。而且，这个函数在终止线程的时候也不通知DLL，当DLL关闭时，这也容易出现问题。

四、线程的挂起和唤醒：

当线程Create()中的CreateSuspended属性为True时，线程创建后并不立即执行。可以用用Suspend()和Resume()来动态地挂起或唤醒。

//挂起和唤醒

procedure Func2(MyThread:TMyThead;Memo:TMemo);

var

PassTime:Cardinal;

begin

d;

PassTime:=GetTickCount;

('m:'+inttostr(m));

Sleep(2000); //等待2秒

PassTime:=GetTickCount-PassTime;

('SuspendTime:'+inttostr(PassTime)+'*m:'+inttostr(m));

;

PassTime:=GetTickCount;

Sleep(2000);

PassTime:=GetTickCount-PassTime;

('ReSumeTime:'+inttostr(PassTime)+'*m:'+inttostr(m));

end;

procedure 5Click(Sender: TObject);

var

MyThread:TMyThead;

begin

m:=0;

MyThread:=(False);

Func2(MyThread,Memo1);

end;

运行结果：

Memo1

m:0

SuspendTime:2000*m:0

ReSumeTime:2000*m:9630399

五、取得线程的时间：(本节只是介绍GetThreadTimes()的用法，可略过)

上例可以看见，用kCount()来取得线程运行时间是不准确的。Win32提供了一个API函数GetThreadTimes()，定义如下：

BOOL WINAPI GetThreadTimes(

HANDLE hThread,

LPFILETIME lpCreationTime, 线程创建的时间

LPFILETIME lpExitTime, 线程退出的时间。如果线程还在执行，此值无意义。

LPFILETIME lpKernelTime, 执行操作系统代码所用的时间。

LPFILETIME lpUserTime 执行应用程序本身代码所用的时间。

);

函数返回值失败时为0，成功为不等于零的数。可用GetLastError()来取得更详细的资料。

以上四个参数都是TFileTime类型。此类型在Windows单元中声明如下：

typedef struct _FILETIME {

DWORD dwLowDateTime;

DWORD dwHighDateTime;

} 64位数，以100纳秒（1纳秒=10亿分之一秒）的时间间隔自1601年1月1号(UTC)表示。

TFileTime的长度是64位，为了进行数学运算可以把它转换为Int64。例如两个TFileTime的值比较大小：

If Int64(UserTime)> Int64(KernelTime) then Beep;

Delphi只提供了FileTimeToDosDateTime，FileTimeToLocalFileTime和FileTimeToSystemTime这三个转换函数，所以要自己写和TdateTime的转换函数。

上面的例子加多一个函数：

procedure Func3(MyThread:TMyThead;Memo:TMemo); //计算线程时间

function FileTimeToDateTime(FileTime:TFileTime):TDateTime; //TFileTime转化成TDateTime

var

SysTime:TSystemTime;

begin

if not FileTimeToSystemTime(FileTime,SysTime) then

Raise Fmt('FileTimeToSystemTime failed.'+

'Error code %d',[GetLastError]);

with SysTime do

Result:=EncodeDate(wYear,wMonth,wDay)+

EncodeTime(wHour,wMinute,wSecond,wMilliseconds);

end;

var

CreateTime,ExitTime,KernelTime,UserTime:TFileTime;

begin

if GetThreadTimes(,CreateTime,ExitTime,KernelTime,UserTime) then

begin

('创建时间：'+DateTimeToStr(FileTimeToDateTime(CreateTime)));

('退出时间：'+DateTimeToStr(FileTimeToDateTime(ExitTime)));

('Win时间：'+DateTimeToStr(FileTimeToDateTime(KernelTime)));

('进程时间：'+DateTimeToStr(FileTimeToDateTime(UserTime)));

end;

end;

procedure 5Click(Sender: TObject);

var

MyThread:TMyThead;

begin

m:=0;

MyThread:=(False);

Func2(MyThread,Memo1);

('---------------');

Func3(MyThread,Memo1);

end;

运行结果：

Memo1

m:0

SuspendTime:2000*m:0

ReSumeTime:2000*m:9585649

---------------

创建时间：2008-10-10 19:59:31

退出时间：1601-1-1

Win时间：1601-1-1

进程时间：1601-1-2 23:59:58

还是不清楚如何具体运用。

◆delphi多线程编程之二 ◆

（调试环境：Delphi2007+WinXPsp3 例程：Tst_）

一、线程的局部变量threadvar

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

TMyThread=class(TThread)

private

FNewStr:string;

protected

procedure Execute;override;

public

constructor Create(const ANewStr:string);

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

var

n:integer;

threadvar

GlobalStr:string;

procedure SetShowStr(const S:string;Memo:TMemo);

begin

if s=''then

//MessageBox(0,pchar(GlobalStr),'The ',MB_OK)

begin

inc(n);

(inttostr(n)+GlobalStr);

end else GlobalStr:=S;

end;

constructor (const ANewStr: string);

begin

FNewStr:=ANewStr;

Inherited Create(False);

end;

procedure e;

begin

FreeOnTerminate:=True; //终止后自动free

SetShowStr(FnewStr, 1);

SetShowStr('', 1);

end;

procedure 1Click(Sender: TObject);

begin

n:=1;

SetShowStr('Hello World', 1); //Global:='Hello World'

SetShowStr('', 1); //show 1Global

('Mygodsos'); //Global:='Mygodsos',show 2Global

Sleep(100);

SetShowStr('', 1); //show 3Global

end;

end.

当GlobalStr 声明不同时，结果分别是：

Threadvar var

1Hello World 1Hello World

3Hello World 3Mygodsos

2Mygodsos 2Mygodsos

Delphi利用关键字threadvar封装API线程局部存储。它能使你在第一个运行的线程中创建一个全局变量的拷贝。如果用ThreadVar声明变量，则在程序结束前必须手动释放其占用的空间（这个手动释放的问题不知道d2007解决没有？）

（ps 我看到很多关于threadvar释放要 := ''的，若不是string类型的给如何释放？）

二、双线程看看Threadvar:

把Execute()里Create(False)改成Create(True)

procedure 2Click(Sender: TObject);

var

MyThread1:TMyThread;

MyThread2:TMyThread;

begin

n:=0;

SetShowStr('Hello World',1); //Global:='Hello World'

SetShowStr('',1); //show Global

MyThread1:=('thread 1:'); //Global:='Mygodsos',show Global

MyThread2:=('thread 2:'); //Global:='Mygodsos',show Global

;

;

Sleep(100);

SetShowStr('',1); //show Global

end;

当GlobalStr 声明为不同，结果对比是：

Threadvar Var

1Hello World 1Hello World

4Hello World 4thread 2:

2thread 1: 3thread 2:

3thread 2: 2thread 1:

这里出现一个十分有趣的问题，若sleep()位置不同，结果不一样。

;

Sleep(100);

;

//Sleep(100);

改成这样后，结果是：

Threadvar Var

1Hello World 1Hello World

3Hello World 3thread 1:

2thread 1: 2thread 1:

4thread 2: 4thread 2:

留意一下前面的序号，似乎sleep()的作用比较奇怪。

三、Sleep()函数

Win32API过程Sleep()。此过程声明如下：

procedure Sleep(dwMilliseconds:DWORD); stdcall;

Sleep()过程用来告诉操作系统，当前的线程在参数dwMilliseconds指定的时间内不需要分配任何CPU时间。插入这个调用是使很多的任务在发生时，使执行哪个线程有一些随机性。通常，可以把参数dwMilliseconds设为0。尽管，这并没有使当前的线程真的“睡眠”，但它使操作系统把CPU时间分给了其他优先级相等或更高的线程。要小心Sleep()神秘的时间调整问题。Sleep()可能会使你的机器出现特别的问题。这种问题在另一台机器上可能无法再现。

对上面的例子，改回以下，把global设成var声明：

;

;

Sleep(100);

执行几次，结果：

1Hello World 1Hello World

4thread 2: 4thread 2:

3thread 2: 2thread 1:

2thread 1: 3thread 2:

看来sleep后，在主进程中先返回哪个线程是有一定的随机性的。但前面的序号还是一样的，意思是虽然主进程返回哪个线程的次序不一样，但线程执行的次序还是没变。不知道我这样理解对不对。

◆Delphi多线程编程之三同步读写全局数据 ◆

（调试环境：Delphi2007+WinXPsp3 例程：Tst_）

unit Tst_Thread3U;

interface

uses

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

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

Button2: TButton;

Button3: TButton;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

procedure Button3Click(Sender: TObject);

private

procedure ThreadsDone(Sender: TObject);

end;

TMyThread=class(TThread)

protected

procedure Execute;override;

end;

开始研究最重要的多线程读写全局数据了，结合书上的例子，我修改成下面的情况：

var

Form1: TForm1;

implementation

{$R *.dfm}

const

MaxSize=128;

var

NextNumber:Integer=0;

DoneFlags:Integer=0;

GlobalArry:array[1..MaxSize] of Integer;

Lock:byte; //1-不同步 2-临界区 3-互斥

CS:TRTLCriticalSection; //临界区

hMutex:THandle; //互斥

function GetNextNumber:Integer;

begin

Result:=NextNumber;

inc(NextNumber);

end;

procedure e;

var

i:Integer;

begin

FreeOnTerminate:=True; //终止后自动free

OnTerminate:=sDone;

if Lock<>3 then //非互斥情况

begin

if Lock=2 then EnterCriticalSection(CS); //建立临界区

for i := 1 to MaxSize do

begin

GlobalArry[i]:=GetNextNumber;

Sleep(5);

end;

if Lock=2 then LeaveCriticalSection(CS);//离开临界区

end else //-------互斥

begin

if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then

begin

for i := 1 to MaxSize do

begin

GlobalArry[i]:=GetNextNumber;

Sleep(5);

end;

end;

ReleaseMutex(hMutex); //释放

end;

end;

procedure sDone(Sender: TObject);

var

i:Integer;

begin

Inc(DoneFlags);

if DoneFlags=2 then

begin

for i := 1 to MaxSize do

(inttostr(GlobalArry[i]));

if Lock=2 then DeleteCriticalSection(CS); //删除临界区

If Lock=3 then CloseHandle(hMutex); //关闭互斥

end;

end;

//非同步

procedure 1Click(Sender: TObject);

begin

Lock:=1;

(False);

(False);

end;

//临界区

procedure 2Click(Sender: TObject);

begin

Lock:=2;

InitializeCriticalSection(CS); //初始化临界区

(False);

(False);

end;

//互斥

procedure 3Click(Sender: TObject);

begin

Lock:=3; // 互斥

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

(False);

(False);

end;

end.

没有临界区和互斥的帮助，两个线程都不断地在Memo1输出，而且数字是乱的。

一、临界区

所谓临界区，就是一次只能由一个线程来执行的一段代码。如果把初始化数组的代码放在临界区内，另一个线程在第一个线程处理完之前是不会被执行的。

使用临界区的步骤：

1、先声明一个全局变量类型为TRTLCriticalSection；

2、在线程Create()前调用InitializeCriticalSection()过程来初始化，该函数定义是：

void WINAPI InitializeCriticalSection(LPCRITICAL_SECTION lpCriticalSection);

类型lpCriticalSection即是Delphi封装的TRTLCriticalSection。

3、在线程的需要放入临界区的代码前面使用EnterCriticalSection(lpCriticalSection)过程来开始建立临界区。在代码完成后用LeaveCriticalSection(lpCriticalSection)来标志临界区的结束。

4、在线程执行完后用DeleteCriticalSection(lpCriticalSection)来清除临界区。这个清除过程必须放在线程执行完后的地方，比如FormDesroy事件中。上面的例子中，若把该过程放在(False);后，会产生错误。

二、互斥：

互斥非常类似于临界区，除了两个关键的区别：首先，互斥可用于跨进程的线程同步。其次，互斥能被赋予一个字符串名字，并且通过引用此名字创建现有互斥对象的附加句柄。

提示临界区与事件对象(比如互斥对象)的最大的区别是在性能上。临界区在没有线程冲突时，要用10~15个时间片，而事件对象由于涉及到系统内核要用400~600个时间片。

使用互斥的步骤：

1、声明一个类型为Thandle或Hwnd的全局变量,其实都是Cardinal类型。Hwnd是handle of window,主要用于窗口句柄；而Thandle则没有限制。

2、线程Create()前用CreateMutex()来创建一个互斥量。该函数定义为：

HANDLE WINAPI CreateMutex(

LPSECURITY_ATTRIBUTES lpMutexAttributes,

BOOL bInitialOwner,

LPCTSTR lpName:Pchar);

LPSECURITY_ATTRIBUTES参数为一个指向TSecurityAttributtes记录的指针。此参数设为nil，表示访问控制列表默认的安全属性。

bInitalOwner参数表示创建互斥对象的线程是否要成为此互斥对象的拥有者。当此参数为False时，表示互斥对象没有拥有者。

lpName参数指定互斥对象的名称。设为nil表示无命名，如果参数不是设为nil，函数会搜索是否有同名的互斥对象存在。如果有，函数就会返回同名互斥对象的句柄。否则，就新创建一个互斥对象并返回其句柄。

返回值是一handle。当错误发生时，返回null，此时用GetLastError函数可查看错误的信息。

利用CreateMutex()可以防止程序多个实例运行，如下例：

Program ABC;

Uses

Forms,Windows,„;

{$R *.res}

Var

hMutex:Hwnd;

Begin

lize;

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

if GetLastError<>ERROR_ALREADY_EXISTS then

begin

//项目要运行的咚咚

end;

ReleaseMutex(hMutex);

;

End;

在本节的例程中，我们只是要防止线程进入同步代码区域中，所以lpName参数设置为nil。

3、在同步代码前用WaitForSingleObject()函数。该函数使得线程取得互斥对象（同步代码）的拥有权。该函数定义为：

DWORD WINAPI WaitForSingleObject(

HANDLE hHandle,

DWORD dwMilliseconds);

这个函数可以使当前线程在dwMilliseconds指定的时间内睡眠，直到hHandle参数指定的对象进入发信号状态为止。一个互斥对象不再被线程拥有时，它就进入发信号状态。当一个进程要终止时，它就进入发信号状态。dwMilliseconds参数可以设为0，这意味着只检查hHandle参数指定的对象是否处于发信号状态，而后立即返回。dwMilliseconds参数设为INFINITE，表示如果信号不出现将一直等下去。

这个函数的返回值含义：

WAIT_ABANDONED 指定的对象是互斥对象，并且拥有这个互斥对象的线程在没有释放此对象之前就已终止。此时就称互斥对象被抛弃。这种情况下，这个互斥对象归当前线程所有，并把它设为非发信号状态

WAIT_OBJECT_0 指定的对象处于发信号状态

WAIT_TIMEOUT 等待的时间已过，对象仍然是非发信号状态

再次声明，当一个互斥对象不再被一个线程所拥有,它就处于发信号状态。此时首先调用WaitForSingleObject()函数的线程就成为该互斥对象的拥有者，此互斥对象设为不发信号状态。当线程调用ReleaseMutex()函数并传递一个互斥对象的句柄作为参数时，这种拥有关系就被解除，互斥对象重新进入发信号状态。

注意除WaitForSingleObject()函数外，你还可以使用WaitForMultipleObject()和MsgWaitForMultipleObject()函数，它们可以等待几个对象变为发信号状态。这两个函数的详细情况请看Win32 API联机文档。

4、在同步代码结束后，使用ReleaseMutex(THandle)函数来标志。该函数只是释放互斥对象和线程的拥有者关系，并不释放互斥对象的句柄。

5、调用CloseHandle(THandle)来关闭互斥对象。请注意例程中该函数的使用位置。

三、还有一种用信号量对象来管理线程同步的，它是在互斥的基础上建立的，但信号量增加了资源计数的功能，预定数目的线程允许同时进入要同步的代码。有点复杂，想不到在哪可以用，现在就不研究论了。

◆Delphi多线程编程之四 线程安全和VCL ◆

算了，整个文章当代码来弄

◆Delphi多线程编程之四 线程安全和VCL ◆

（调试环境：Delphi 2007+WinXP sp3 例程：Tst_）

由于Delphi VCL在设计成大部分在主线程访问，因而，当多个线程同时访问VCL时，就非安全。

其实线程的安全性如上面那个读全局变量来说，那个全局变量是非线程安全的，因为当另外一个线程访问它的时候，它的数值还在被前一个线程改动中。这在非线程安全的对象中就会造成很严重的后果，比如一个对象的创立时的初始值被另一个线程改变了，后果相当地严重。

VCL中，连很基础的Tlist都是非线程安全，要多个线程操纵List时，用TThreadList来替代。

unit Tst_Thread4U;

interface

uses

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

Dialogs, StdCtrls;

type

TForm1 = class(TForm)

Button1: TButton;

Memo1: TMemo;

procedure Button1Click(Sender: TObject);

procedure Button2Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

TMyThread=class(TThread)

protected

procedure Execute;override;

procedure ShowInMemo;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

const

MaxSize=1000;

var

NextNumber:Integer=0;

GlobalNum:Integer;

function GetNextNumber:Integer;

begin

Result:=NextNumber;

inc(NextNumber);

end;

{ TMyThread }

procedure e;

var

i:Integer;

begin

FreeOnTerminate:=True; //终止后自动free

for i := 1 to MaxSize do

begin

GlobalNum:=GetNextNumber;

Sleep(5);

Synchronize(ShowInMemo);

// ShowInMemo;

end;

end;

procedure Memo;

begin

(inttostr(GlobalNum));

end;

procedure 1Click(Sender: TObject);

begin

(False);

(False);

end;

end.

上面这个例程，把输出到Memo1放在线程里了，所以要在Execute()内用到Synchronize()函数，这样才是线程安全。

Synchronize()函数是个重载函数，有两种引用形式：

class procedure Synchronize(AThread: TThread; AMethod: TThreadMethod); overload;

procedure Synchronize(AMethod: TThreadMethod); overload;

Amethod是线程的一个自定义不带参数过程（！！太烦了，不能带参数，好不方便）。

Synchronize()调用了Windows的SendMessage()向主线程发一消息。主线程必须已建立消息队列，并且不断地从消息队类中检索消息。一旦主线程检索到消息，就执行Synchronize()所指定的代码。（ps:我查了Vcl源程序，发现也是调用临界区，这个太不方便了，还是使用临界区好）。