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.
啰哩啰嗦一大些, 才说了 CreateThread 一个参数, 下篇继续.
线程的学习还在入门中, 把我的理解写在这, 最期望的收获是得到指正.
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;
interfaceuses 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.
ResumeThread 和 SuspendThread 分别对应 TThread 的 Resume 和 Suspend 方法, 很好理解.
接下来应该是 CreateThread 的第四个参数了.
function CreateThread( lpThreadAttributes: Pointer;
dwStackSize: DWORD;
lpStartAddress: TFNThreadStartRoutine;
lpParameter: Pointer;
{入口函数的参数} dwCreationFlags: DWORD;
var lpThreadId: DWORD): THandle;
stdcall;
--------------------------------------------------------------------------------
线程入口函数的参数是个无类型指针(Pointer), 用它可以指定任何数据;
本例是把鼠标点击窗体的坐标传递给线程的入口函数, 每次点击窗体都会创建一个线程.
运行效果图:
--------------------------------------------------------------------------------
代码文件:
--------------------------------------------------------------------------------
unit Unit1;
interfaceuses 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.
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;
interfaceuses 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 -> Delphi Compiler -> Linking(如图)
--------------------------------------------------------------------------------
栈是私有的但堆是公用的, 如果不同的线程都来使用一个全局变量有点乱套;
为解决这个问题 Delphi 为我们提供了一个类似 var 的 ThreadVar 关键字, 线程在使用 ThreadVar 声明的全局变量时会在各自的栈中留一个副本, 这样就解决了冲突. 不过还是尽量使用局部变量, 或者在继承 TThread 时使用类的成员变量, 因为 ThreadVar 的效率不好, 据说比局部变量能慢 10 倍.
在下面的例子就测试了用 var 和 ThreadVar 定义变量的不同.
使用 var 效果图:
--------------------------------------------------------------------------------
使用 ThreadVar 效果图:
--------------------------------------------------------------------------------
代码文件:
--------------------------------------------------------------------------------
unit Unit1;
interfaceuses 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(临界区)
先看一段程序, 代码文件:
--------------------------------------------------------------------------------
unit Unit1;
interfaceuses 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;
interfaceuses 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;
interfaceuses 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.
不过最简单、最轻便(速度最快)的同步手段还是 CriticalSection(临界区), 但它不属于系统内核对象, 当然也就没有句柄、没有 TSecurityAttributes 这个安全属性, 这也导致它不能跨进程使用;
不过写多线程时一般不用跨进程啊, 所以 CriticalSection 应该是最常用的同步手段.
下次接上, 开始学习多线程的同步了.
认识等待函数 WaitForSingleObject
一下子跳到等待函数 WaitForSingleObject, 是因为下面的 Mutex、Semaphore、Event、WaitableTimer 等同步手段都要使用这个函数;
不过等待函数可不止 WaitForSingleObject 它一个, 但它最简单.
function WaitForSingleObject( hHandle: THandle;
{要等待的对象句柄} dwMilliseconds: DWORD {等待的时间, 单位是毫秒}): DWORD;
stdcall;
{返回值如下:}WAIT_OBJECT_0 {等着了, 本例中是: 等的那个进程终于结束了}WAIT_TIMEOUT {等过了点(你指定的时间), 也没等着}WAIT_ABANDONED {好不容易等着了, 但人家还是不让咱执行;
这一般是互斥对象}//WaitForSingleObject 的第二个参数一般给常数值 INFINITE, 表示一直等下去, 死等.
--------------------------------------------------------------------------------
WaitForSingleObject 等待什么? 在多线程里就是等待另一个线程的结束, 快来执行自己的代码;
不过它可以等待的对象可不止线程;
这里先来一个等待另一个进程结束的例子, 运行效果图:
--------------------------------------------------------------------------------
代码文件:
--------------------------------------------------------------------------------
unit Unit1;
interfaceuses 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;
end.
多线程同步之 Mutex (互斥对象) 原理分析:
互斥对象是系统内核对象, 各线程都可以拥有它, 谁拥有谁就能执行;
执行完毕, 用 ReleaseMutex 函数释放拥有权, 以让其他等待的线程使用.
其他线程可用 WaitForSingleObject 函数排队等候(等候也可以理解为排队申请).
使用过程:
var hMutex: THandle;
{应该先声明一个全局的互斥句柄}
CreateMutex {建立一个互斥对象}
WaitForSingleObject
{用等待函数排队等候}
ReleaseMutex
{释放拥有权}
CloseHandle
{最后释放互斥对象}
--------------------------------------------------------------------------------
ReleaseMutex、CloseHandle 的参数都是 CreateMutex 返回的句柄, 关键是 CreateMutex 函数:
function CreateMutex( lpMutexAttributes: PSecurityAttributes;
bInitialOwner: BOOL;
{是否让创建者(此例中是主线程)拥有该互斥对象} lpName: PWideChar {可以给此互斥对象取个名字, 如果不要名字可赋值为 nil}): THandle;
{1、第一个参数前面说过.2、第二个参数在这里一定要是 False, 如果让主线程拥有互斥, 从理论上讲, 得等程序退出后其他线程才有机会;
取值 False 时, 第一个执行的线程将会最先拥有互斥对象, 一旦拥有其他线程就得先等等.3、第三个参数, 如果给个名字, 函数将从系统中寻找是否有重名的互斥对象, 如果有则返回同名对象的存在的句柄;
如果赋值为 nil 将直接创建一个新的互斥对象;
下个例子将会有名字. }
--------------------------------------------------------------------------------
本例效果图:
--------------------------------------------------------------------------------
代码文件:
--------------------------------------------------------------------------------
unit Unit1;
interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;
var Form1: TForm1;
implementation{$R *.dfm}var f: Integer;
{用这个变量协调一下各线程输出的位置} hMutex: THandle;
{互斥对象的句柄}function MyThreadFun(p: Pointer): DWORD;
stdcall;
var i,y: Integer;
begin Inc(f);
y := 20 * f;
for i := 0 to 50000 do begin if WaitForSingleObject(hMutex, INFINITE) = WAIT_OBJECT_0 then begin Form1.Canvas.Lock;
Form1.Canvas.TextOut(20, y, IntToStr(i));
Form1.Canvas.Unlock;
Sleep(0);
{稍稍耽搁一点, 不然有时 Canvas 会协调不过来} ReleaseMutex(hMutex);
end;
end;
Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var ThreadID: DWORD;
begin Repaint;
f := 0;
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin hMutex := CreateMutex(nil, False, nil);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin CloseHandle(hMutex);
end;
end.SyncObjs 单元下有封装好的 TMutex 类, 好像不如 Api 快, 内部机制也稍有区别, 但使用方法差不多:
--------------------------------------------------------------------------------
unit Unit1;
interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type TForm1 = class(TForm) Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;
var Form1: TForm1;
implementation{$R *.dfm}uses SyncObjs;
var f: Integer;
MyMutex: TMutex;
function MyThreadFun(p: Pointer): DWORD;
stdcall;
var i,y: Integer;
begin Inc(f);
y := 20 * f;
for i := 0 to 50000 do begin if MyMutex.WaitFor(INFINITE) = wrSignaled then begin Form1.Canvas.Lock;
Form1.Canvas.TextOut(20, y, IntToStr(i));
Form1.Canvas.Unlock;
MyMutex.Release;
end;
end;
Result := 0;
end;
procedure TForm1.Button1Click(Sender: TObject);
var ThreadID: DWORD;
begin Repaint;
f := 0;
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
CreateThread(nil, 0, @MyThreadFun, nil, 0, ThreadID);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin MyMutex := TMutex.Create(False);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin MyMutex.Free;
end;
end.
多线程同步之 Mutex (互斥对象)
Mutex 作为系统核心对象是可以跨进程的(临界区就不行), 我们可以利用互斥对象禁止程序重复启动.
工作思路:
先用 OpenMutex 尝试打开一个自定义名称的 Mutex 对象, 如果打开失败说明之前没有这个对象存在;
如果之前没有这个对象, 马上用 CreateMutex 建立一个, 此时的程序应该是第一次启动;
再重复启动时, 那个 OpenMutex 就有结果了, 然后强制退出.
最后在程序结束时用 CloseHandle 释放 Mutex 对象.
function OpenMutex( dwDesiredAccess: DWORD;
{打开权限} bInheritHandle: BOOL;
{能否被当前程序创建的进程继承} pName: PWideChar {Mutex 对象的名称}): THandle;
stdcall;
{成功返回 Mutex 的句柄;
失败返回 0}
--------------------------------------------------------------------------------
注意, 这里的 CreateMutex 函数应该有个名了, 因为 OpenMutex 要用到;
另外, CreateMutex 的第二个参数已经不重要了(也就是 True 和 False 都行), 因为这里是用其名称来判断的.
程序可以这样写:
--------------------------------------------------------------------------------
unit Unit1;
interfaceuses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs;
type TForm1 = class(TForm) procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
end;
var Form1: TForm1;
implementation{$R *.dfm}var hMutex: THandle;
const NameMutex = 'MyMutex';
procedure TForm1.FormCreate(Sender: TObject);
begin if OpenMutex(MUTEX_ALL_ACCESS, False, NameMutex) <> 0 then begin ShowMessage('该程序已启动');
Application.Terminate;
end;
hMutex := CreateMutex(nil, False, NameMutex);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin CloseHandle(hMutex);
end;
end.
--------------------------------------------------------------------------------
这一般都是写在 dpr 主程序里, 省得让后启动的程序执行些无用的代码:
--------------------------------------------------------------------------------
program Project1;
uses Forms, Windows, Unit1 in 'Unit1.pas' {Form1};
{$R *.res}var hMutex: THandle;
const NameMutex = 'MyMutex';
begin {主线程入口} if OpenMutex(MUTEX_ALL_ACCESS, False, NameMutex) <> 0 then begin MessageBox(0, '该程序已启动', '提示', MB_OK);
Application.Terminate;
end;
hMutex := CreateMutex(nil, False, NameMutex);
Application.Initialize;
Application.MainFormOnTaskbar := True;
Application.CreateForm(TForm1, Form1);
Application.Run;
CloseHandle(hMutex);
{主线程出口}end.