Sign in Join
Wiki copytemporary

Multithreaded Application Tutorial/zh CN: what changed

Revision 3 to 4. Removed lines have a minus sign; added lines have a plus sign.

OldNewLine
11## 概述
22
3-这个页面将试图解释如何在Free Pascal 和 Lazarus上编写和调试一个多线程应用程序。一个多线程应用程序创建两个或多个线程同时执行任务。如果你正需要使用多线程,请阅读"你需要多线程吗?",以确定你是否真的需要;这可以避免些麻烦。
4-
5-程序中的一个线程被称为主线程,也就是在应用程序启动时由操作系统创建的那个线程。主线程是**唯一**一个可以更新用户界面组件的线程,否则,应用程序可能会挂起。
6-
7-其主要思想是:应用程序使用第二个线程在后台处其他事情,同时用户可以继续使用主线程工作。
3+本文力图说清楚如何用 Free Pascal 和 Lazarus 编写和调试多线程应用。多线程应用会创建两个以上同时运行的线程。如果对多线程还不熟悉,请阅读“是否需要多线程”一节,以确定是否真的需要;这可能会避免很多麻烦。
84
9-线程的另一个用途是为了更好的响应应用程序。如,你创建了一个应用程序,在应用程序启动时,用户按下按钮启动一个大的任务……处理中……之后,程序停止响应,这让用户觉得应用程序假死了,在用户体验上这很不好。如果大的任务在另一个线程中运行,应用程序保持响应,它就像在闲置,在本例中它是个不错的选择。不过,在启用线程之前,你需要禁用表单按钮,以避用户启动多个线程。
5+多线程应用只有一个主线程,也即应用启动时由操作系统创建的那个线程。更新用户界面组件的**只能** 是主线程,否则应用可能会被挂起。
106
11-还有,服务器应用程序在使用多线程后,它能够同时响应多个客户端的请求。
7+多线程的主要思路是:应用可在第二个线程中后台处理一些任务,而用户可以继续使用主线程工作。
128
13-## 你需要多线程吗?
9+线程的另一个用途是让应用具备更好的响应能力。假设用户按下某个按钮后,应用开始处理一项大型任务……在处理过程中屏幕就会停止响应,用户会以为应用停滞不动了,用户体验就不大好,或引起误导。如果大型任务运行于另一个线程中,则应用几乎就能像空闲时一样保持响应。这时在启动大型任务的工作线程之前,最好是禁用窗体上的按钮,以免用户为同一任务启动多个线程。
1410
15-如果你刚想使用多线程,而只是想让你的应用程序长时间运行任务而不失去响应,那么,多线程可能超过你的需要。多线程应用程序难以调试并且很复杂,多数情况下你不需要多线程。单线程就足够了。如果你能将耗时的任务分隔成几块,并使用**Application.ProcessMessages**。这种方法让LCL处理所有等待的消息并返回。其核心是,在长时间运行任务时定期调用Application.ProcessMessages以处理用户点击了什么东西,或者重绘进度条等等。
11+多线程的另一个用途,可能就是服务器应用,以便能同时响应多个客户端的请求。
1612
17-例如:读取一个大文件并处理它。 参看 examples/multithreading/singlethreadingexample1.lpi。
13+## 是否需要多线程?
1814
19-使用多线程
15+如果对多线程编程不太熟悉,并且只是希望应用在执行稍长任务时能提升响应速度,那么可能并不一定需要用到多线程。多线程应用肯定更难调试,且往往更加复杂;很多情况下并不需要用到多线程。单线程就足以应付了。如果能将耗时任务拆分为多个部分,则应使用 Application.ProcessMessages 方法。此方法允许 LCL 处理所有等待的消息并返回。主要的思路是在执行长时间任务的过程中定期调用 Application.ProcessMessages,检测用户的点击,或者重绘进度条等。
2016
21-- blocking handles, like network communications(~~屏蔽处理,比如网络通信~~)
22-- 同时使用多个处理器 (SMP)
23-- 算法和库调用,必须通过一个 API 调用,如不能被分解成更小的部分。
17+例如:读取大文件并进行处理。参见示例文件 examples/multithreading/singlethreadingexample1.lpi。
2418
25-If you want to use multi-threading to increase speed by using multiple processors simultaneously, check if your current program now uses all 100% resources of 1 core CPU (for example, your program can actively use input-output operations, e.g. writing to file; this takes a lot of time, but doesn't load CPU; in this case your program will not be faster with multiple threads). Also check if optimisation level is set to maximum (3). When switching optimisation level from 1 to 3, a program may become about 5 times faster.
19+多线程仅适用于:
2620
27-~~你想使用多线程使用多个处理器来提高速度,检查当前程序使用1个核心的CPU上的100%资源(如,你的程序可以积极使用输入输出操作,如写入文件等等,这需要大量时间,但CPU没有负载;在这种情况下,你的程序将不会比多种线程快。)检查优化级别设置为最大(3)。切换优化级别1到3,程序运行可能会快5倍。~~
21+ * 阻塞句柄,比如网络通信
22+ * 同时使用多个处理器 (SMP)
23+ * 必须通过一次 API 调用完成的算法和库调用,无法分解成更小的部分
2824
29-## 多线程单元
25+若要通过多线程同时使用多个处理器以提高速度,请先检查程序目前是否已经跑满了单核 CPU 的资源(例如,程序可能是在做大量输入输出操作,比如写入文件,这很耗时但并不占用大量 CPU 资源;这种情况下,即便用了多线程也不会更快)。另外,请检查优化级别是否已设为最高(3级)。将优化级别从1级升至3级,程序运行速度可能会提升5倍左右。
3026
31-在Windows上你不需要任何特殊单元。
27+## 多线程应用所需单元
3228
33-然而在Linux、Mac OS X和FreeBSD上,你需要cthreads单元,并且,*必须*项目中第一个引入的单元(项目源文件,通常是 .lpr文件)!
29+Windows 系统下实现多线程应用,不需要用到什么特别的单元。但是在 Linux、macOS 和 FreeBSD 系统中,需要用到 cthreads 单元,还必须是项目第一个引用的单元(程序源代码通常是 .lpr 文件)!有时 cthreads、cmem 和 cwstrings 等多个单元都要放在前面时,由于各单元之间的依赖关系,合理的顺序是cmem、cthreads、cwstrings。
3430
35-所以,你的Lazarus应用程序代码看起来应该是:
31+
3632
37-``` pascal
33+所以 Lazarus 应用的源代码应如下所示:
34+```
3835program MyMultiThreadedProgram;
39-{$mode objfpc}{$H+}
40-uses
41-{$ifdef unix}
42- cthreads,
43- cmem, // the c memory manager is on some systems much faster for multi-threading(C内存管理器在某些系统中使多线程运行更快)
44-{$endif}
45- Interfaces, // this includes the LCL widgetset 引入LCL 部件工具箱
46- Forms
47- { you can add units here },
36+ {$mode objfpc}{$H+}
37+ uses
38+ {$ifdef unix}
39+ cthreads,
40+ cmem, // 在某些系统中,多线程时 c 语言的内存管理速度会快很多
41+ {$endif}
42+ Interfaces, // 引入 LCL 可视化组件
43+ Forms
44+ { 在此加入其它单元 },
4845```
4946
50-如果你忘记了这一点,使用TThread启动应用程序时,你会得到这样的错误:
51-
52-``` pascal
53- This binary has no thread support compiled in. (<strike>二进制文件编译时没有线程支持</strike>)
54- Recompile the application with a thread-driver in the program uses clause before other units using thread.(<strike>在引用线程单元前引用了其他单元</strike>)
47+如果忘记了 TThread 引用顺序,在应用启动时会显示如下错误:
5548```
56-
57-> **Note:** 提示"mcount"未找到的错误。在你的单元里包含了多线程代码,你需要添加 cthreads单元或使用智能链接。
58-
59-> **Note:** "Project raised exception class 'RunError(232)'" in procedure SYSTEM_NOTHREADERROR (项目引发的异常类)错误,你的代码里需要线程,你需要添加 cthreads单元。
60-
61-## TThread类
49+This binary has no thread support compiled in.
50+ Recompile the application with a thread-driver in the program uses clause before other units using thread.
51+```
6252
63-下面的例子可以在 examples/multithreading/ 目录中找到。
53+![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Note:** 如果链接时报错找不到“mcount”,可能是因为引用了包含多线程代码的某个单元,此时需添加 cthreads 单元或启用[[smart linking|智能链接]]功能。
6454
65-若要创建一个多线程的应用程序,最简单的方法是使用 TThread 类。This class permits the creation of an additional thread (alongside the main thread) in a simple way.(~~这个线程允许在主线程上创建一个附加线程)。~~)通常你只需要重写 2 个方法:创建构造函数(constructor)和执行方法(Execute)。
55+![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Note:** 如果报错“Project raised exception class 'RunError(232)' in procedure SYSTEM_NOTHREADERROR”,说明代码用到了线程,需添加 cthreads 单元的引用。
6656
67-在构造函数中,设置线程运行前初始化需要的变量,在TThread原始构造函数中有一参数Suspended,设置Suspended = True防止在创建后自动启动线程。设置为False,则在在调用Start方法后才执行。
57+
6858
69-> **Note:** 方法摘要在:[自FPC 2.4.4 弃用](http://wiki.freepascal.org/User_Changes_2.4.4#TThread.Suspend_and_TThread.Resume_have_been_deprecated)。它被Start代替。
59+## 纯用 FPC 实现的代码示例
7060
71-FPC 2.0.1及更高版本,TThread.Create有一个隐含的堆栈大小参数。根据需要,你可以改变默认堆栈的大小。深层递归过程是个很好的例子。如果你不指定堆栈大小,将使用系统默认的大小。
61+以下是非常简单的示例。在 Win7 及 FPC 3.0.4 中调试通过。
62+```
63+Program ThreadTest;
64+ {test multi threading capability }
65+ {
66+ OUTPUT
67+ thread 1 started
68+ thread 1 thri 0 Len(S)= 1
69+ thread 1 thri 1 Len(S)= 2
70+ thread 1 thri 2 Len(S)= 3
71+ thread 1 thri 3 Len(S)= 4
72+ thread 1 thri 4 Len(S)= 5
73+ thread 1 thri 5 Len(S)= 6
74+ thread 1 thri 6 Len(S)= 7
75+ thread 1 thri 7 Len(S)= 8
76+ thread 1 thri 8 Len(S)= 9
77+ thread 1 thri 9 Len(S)= 10
78+ thread 1 thri 10 Len(S)= 11
79+ thread 1 thri 11 Len(S)= 12
80+ thread 1 thri 12 Len(S)= 13
81+ thread 1 thri 13 Len(S)= 14
82+ thread 1 thri 14 Len(S)= 15
83+ thread 2 started
84+ thread 3 started
85+ thread 1 thri 15 Len(S)= 16
86+ thread 2 thri 0 Len(S)= 1
87+ thread 3 thri 0 Len(S)= 1
88+ thread 1 thri 16 Len(S)= 17
89+ ...
90+ ...
91+ thread 5 thri 997 Len(S)= 998
92+ thread 5 thri 998 Len(S)= 999
93+ thread 5 thri 999 Len(S)= 1000
94+ thread 5 finished
95+ thread 10 thri 828 Len(S)= 829
96+ thread 9 thri 675 Len(S)= 676
97+ thread 4 thri 656 Len(S)= 657
98+ thread 10 thri 829 Len(S)= 830
99+ thread 9 thri 676 Len(S)= 677
100+ thread 9 thri 677 Len(S)= 678
101+ thread 10 thri 830 Len(S)= 831
102+ thread 10 thri 831 Len(S)= 832
103+ thread 10 thri 832 Len(S)= 833
104+ thread 10 thri 833 Len(S)= 834
105+ thread 10 thri 834 Len(S)= 835
106+ thread 10 thri 835 Len(S)= 836
107+ thread 10 thri 836 Len(S)= 837
108+ thread 10 thri 837 Len(S)= 838
109+ thread 10 thri 838 Len(S)= 839
110+ thread 10 thri 839 Len(S)= 840
111+ thread 9 thri 678 Len(S)= 679
112+ ...
113+ ...
114+ thread 4 thri 994 Len(S)= 995
115+ thread 4 thri 995 Len(S)= 996
116+ thread 4 thri 996 Len(S)= 997
117+ thread 4 thri 997 Len(S)= 998
118+ thread 4 thri 998 Len(S)= 999
119+ thread 4 thri 999 Len(S)= 1000
120+ thread 4 finished
121+ 10
122+
123+ }
124+
125+ uses
126+ {$ifdef unix}cthreads, {$endif} sysutils;
127+
128+ const
129+ threadcount = 10;
130+ stringlen = 1000;
131+
132+ var
133+ finished : longint;
134+
135+ threadvar
136+ thri : ptrint;
137+
138+ function f(p : pointer) : ptrint;
139+ var
140+ s : ansistring;
141+ begin
142+ Writeln('thread ',longint(p),' started');
143+ thri:=0;
144+ while (thri<stringlen) do begin
145+ s:=s+'1'; { create a delay }
146+ writeln('thread ',longint(p),' thri ',thri,' Len(S)= ',length(s));
147+ inc(thri);
148+ end;
149+ Writeln('thread ',longint(p),' finished');
150+ InterLockedIncrement(finished);
151+ f:=0;
152+ end;
153+
154+
155+ var
156+ i : longint;
157+
158+ Begin
159+ finished:=0;
160+ for i:=1 to threadcount do
161+ BeginThread(@f,pointer(i));
162+ while finished<threadcount do ;
163+ Writeln(finished);
164+ End.
165+```
72166
73-重写Execute方法,编写将在线程中执行的代码。
167+## TThread 类
74168
75-TThread 类有一个重要属性:
169+以下例子位于 examples/multithreading/ 目录中。
76170
77-```text
78-Terminated : boolean;
79-```
171+创建多线程应用最简单的方法就是用 TThread 类,能以简单的方式创建一个额外的线程(与主线程并行)。通常仅需重写两个方法:构造函数 Create 和 Execute 方法。
80172
81-If the thread has a loop (and this is typical), the loop should be exited when Terminated is true (it is false by default). Within each pass, the value of Terminated must be checked, and if it is true then the loop should be exited as quickly as is appropriate, after any necessary cleanup. Bear in mind that the Terminate method does not do anything by default: the .Execute method must explicitly implement support for it to quit its job.
173+构造函数中需要进行线程运行的准备工作,设置变量或属性的初始值。TThread 的原始构造函数需一个 Suspended 参数。正如其名, Suspended 设为 True 会阻止线程创建后自动启动。如果 Suspended 设为 False,线程在创建后将立即开始运行。如果线程是以挂起状态创建的,则只会在调用 Start 方法后运行。
82174
83-(~~如果线程中包含循环(这是典型的),当 Terminated 为True时退出循环(默认为 False)。每次循环都将检查 Terminated值,如果为真将退出循环,之后做些必要的清理。牢记 Terminate方法不做任何事情,默认情况下:.Execute 方法实现退出循环后的操作。~~)
175+![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Note:** Resume 方法自[[User Changes 2.4.4|FPC 2.4.4 后已弃用]],已由 Start 替代。
84176
85-如上所述,线程不应该与可见组件交互,对可见组件操作应该在主线程的上下文中进行。
177+自 FPC 2.0.1 以后,TThread.Create 还有一个隐式的栈大小参数。可以按需修改所创建线程的默认栈大小。线程中的函数深度递归调用,就是需要扩大栈的很好例子。如未指定栈大小参数,则会采用操作系统的默认大小。
86178
87-To do this, a TThread method called Synchronize exists. Synchronize requires a method within the thread (that takes no parameters) as an argument. When you call that method through Synchronize(@MyMethod), the thread execution will be paused, the code of MyMethod will be called from the main thread, and then the thread execution will be resumed.
179+要在线程中执行的代码,通过重写 Execute 方法来完成。
88180
89-(~~要这样做,可以在TThread 方法调用Synchronize。以同步线程中的方法(不带参数)作为参数。当你调用Synchronize(@MyMethod),线程将暂停执行,并从主线程中调用MyMethod,之后线程恢复。~~)
181+TThread 类有一个重要属性:Terminated : boolean;
90182
91-The exact working of Synchronize depends on the platform, but basically it does this: (~~同步的具体工作取决于平台,它基本上是:~~)
183+如果线程中包含循环(很常见),那么当 Terminated 为 true 时(默认为 false)应退出循环。每次迭代均须检查 Terminated 值,为 true 则应在完成必要的清理工作后尽快退出循环。~~请记住,Terminate 方法默认不执行任何操作:必须在 Execute 方法中明确实现线程退出工作的机制。~~ Terminate 方法的工作只是将 Terminated 属性设为 True。
92184
93-- 发送消息到主消息队列并进入睡眠
94-- eventually the main thread processes the message and calls MyMethod. This way MyMethod is called without context, that means not during a mouse down event or during paint event, but after.
95-- 主线程执行 MyMethod后,唤醒睡眠的线程和下条消息
96-- 之后,线程继续执行
185+如前所述,线程不应与可视化组件发生交互。对可视化组件的更新必须在主线程中进行。
97186
98-另外,还有一重要属性: TThread: FreeOnTerminate。为True时,线程停止(.Execute 方法)后自动释放。否则,需要手动释放。
187+为实现与主线程的协作,TThread 类提供了 Synchronize 方法。Synchronize 需要一个不带参数的线程内部方法作为参数。以 Synchronize(@MyMethod) 的方式调用 MyMethod 时,线程将暂停运行,MyMethod 的代码将在主线程中调用,然后线程继续运行。
99188
100-示例:
189+Synchronize 的准确实现方式依不同平台而定,但基本任务是:
101190
102-``` pascal
103- Type
104- TMyThread = class(TThread)
105- private
106- fStatusText : string;
107- procedure ShowStatus;
108- protected
109- procedure Execute; override;
110- public
111- Constructor Create(CreateSuspended : boolean);
112- end;
191+ * 发送一条消息到主消息队列,然后进入休眠状态;
192+ * 主线程最终会处理这条消息,并调用 MyMethod。MyMethod 以没有上下文的方式调用,也就是不会在鼠标按下或界面绘制事件中,而是在这些事件之后调用;
193+ * 主线程执行完 MyMethod 后,会唤醒休眠线程,并处理下一条消息;
194+ * 线程继续运行。
113195
114- constructor TMyThread.Create(CreateSuspended : boolean);
115- begin
116- FreeOnTerminate := True;
117- inherited Create(CreateSuspended);
118- end;
196+TThread 还有一个重要的属性:FreeOnTerminate。如果 FreeOnTerminate 为 true,那么线程停止执行(Execute 方法)后,线程对象会自动释放。否则,应用需手动释放线程。
119197
120- procedure TMyThread.ShowStatus;
121- // this method is executed by the mainthread and can therefore access all GUI elements.
122- begin
123- Form1.Caption := fStatusText;
124- end;
125-
126- procedure TMyThread.Execute;
127- var
128- newStatus : string;
129- begin
130- fStatusText := 'TMyThread Starting...';
131- Synchronize(@Showstatus);
132- fStatusText := 'TMyThread Running...';
133- while (not Terminated) and ([any condition required]) do
198+示例:
199+```
200+Type
201+ TMyThread = class(TThread)
202+ private
203+ fStatusText : string;
204+ procedure ShowStatus;
205+ protected
206+ procedure Execute; override;
207+ public
208+ Constructor Create(CreateSuspended : boolean);
209+ end;
210+ constructor TMyThread.Create(CreateSuspended : boolean);
134211 begin
135- ...
136- [here goes the code of the main thread loop]
137- ...
138- if NewStatus <> fStatusText then
212+ inherited Create(CreateSuspended);
213+ FreeOnTerminate := True;
214+ end;
215+
216+ procedure TMyThread.ShowStatus;
217+ // 本方法由主线程执行,因此可以访问所有 GUI 元素。
218+ begin
219+ Form1.Caption := fStatusText;
220+ end;
221+
222+ procedure TMyThread.Execute;
223+ var
224+ newStatus : string;
225+ begin
226+ fStatusText := 'TMyThread Starting...';
227+ Synchronize(@Showstatus);
228+ fStatusText := 'TMyThread Running...';
229+ while (not Terminated) and ([其他条件]) do
139230 begin
140- fStatusText := newStatus;
141- Synchronize(@Showstatus);
231+ ...
232+ [here goes the code of the main thread loop]
233+ ...
234+ if NewStatus <> fStatusText then
235+ begin
236+ fStatusText := newStatus;
237+ Synchronize(@Showstatus);
238+ end;
142239 end;
143240 end;
144- end;
145241```
146242
147-在应用程序中,
148-
149-``` pascal
150- var
151- MyThread : TMyThread;
152- begin
153- MyThread := TMyThread.Create(True); // This way it doesn't start automatically
154- ...
155- [Here the code initialises anything required before the threads starts executing]
156- ...
157- MyThread.Start;
158- end;
243+在应用程序中,
159244```
160-
161-If you want to make your application more flexible you can create an event for the thread; this way your synchronized method won't be tightly coupled with a specific form or class: you can attach listeners to the thread's event. Here is an example:
162-
163-(~~如果想使你的应用更加灵活,可以创建一个事件的线程;这样一来,synchronized方法将不会被特定窗体或类紧耦合:你可以监听线程的事件。~~)
164-
165-下面是一个例子:
166-
167-``` pascal
168- Type
169- TShowStatusEvent = procedure(Status: String) of Object;
170-
171- TMyThread = class(TThread)
172- private
173- fStatusText : string;
174- FOnShowStatus: TShowStatusEvent;
175- procedure ShowStatus;
176- protected
177- procedure Execute; override;
178- public
179- Constructor Create(CreateSuspended : boolean);
180- property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
181- end;
182-
183- constructor TMyThread.Create(CreateSuspended : boolean);
184- begin
185- FreeOnTerminate := True;
186- inherited Create(CreateSuspended);
187- end;
188-
189- procedure TMyThread.ShowStatus;
190- // this method is executed by the mainthread and can therefore access all GUI elements.
191- begin
192- if Assigned(FOnShowStatus) then
193- begin
194- FOnShowStatus(fStatusText);
195- end;
196- end;
197-
198- procedure TMyThread.Execute;
199- var
200- newStatus : string;
201- begin
202- fStatusText := 'TMyThread Starting...';
203- Synchronize(@Showstatus);
204- fStatusText := 'TMyThread Running...';
205- while (not Terminated) and ([any condition required]) do
245+var
246+ MyThread : TMyThread;
206247 begin
248+ MyThread := TMyThread.Create(True); // 这样线程就不会自动启动
207249 ...
208- [here goes the code of the main thread loop]
250+ [此处放置线程开始执行前的初始化代码]
209251 ...
210- if NewStatus <> fStatusText then
252+ MyThread.Start;
253+ end;
254+```
255+
256+若要应用更加灵活,可为线程创建一个事件;这样同步方法就不会与哪个窗体或类绑在一起:可在线程事件上绑定监听器。下面给出一个示例:
257+```
258+Type
259+ TShowStatusEvent = procedure(Status: String) of Object;
260+
261+ TMyThread = class(TThread)
262+ private
263+ fStatusText : string;
264+ FOnShowStatus: TShowStatusEvent;
265+ procedure ShowStatus;
266+ protected
267+ procedure Execute; override;
268+ public
269+ Constructor Create(CreateSuspended : boolean);
270+ property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
271+ end;
272+
273+ constructor TMyThread.Create(CreateSuspended : boolean);
274+ begin
275+ inherited Create(CreateSuspended);
276+ FreeOnTerminate := True;
277+ end;
278+
279+ procedure TMyThread.ShowStatus;
280+ // 本方法由主线程执行,因此可以访问所有 GUI 元素。
281+ begin
282+ if Assigned(FOnShowStatus) then
283+ begin
284+ FOnShowStatus(fStatusText);
285+ end;
286+ end;
287+
288+ procedure TMyThread.Execute;
289+ var
290+ newStatus : string;
291+ begin
292+ fStatusText := 'TMyThread Starting...';
293+ Synchronize(@Showstatus);
294+ fStatusText := 'TMyThread Running...';
295+ while (not Terminated) and ([any condition required]) do
211296 begin
212- fStatusText := newStatus;
213- Synchronize(@Showstatus);
297+ ...
298+ [here goes the code of the main thread loop]
299+ ...
300+ if NewStatus <> fStatusText then
301+ begin
302+ fStatusText := newStatus;
303+ Synchronize(@Showstatus);
304+ end;
214305 end;
215306 end;
216- end;
217307```
218308
219-在应用程序中,
220-
221-``` pascal
222- Type
223- TForm1 = class(TForm)
224- Button1: TButton;
225- Label1: TLabel;
226- procedure FormCreate(Sender: TObject);
227- procedure FormDestroy(Sender: TObject);
228- private
229- { private declarations }
230- MyThread: TMyThread;
231- procedure ShowStatus(Status: string);
232- public
233- { public declarations }
234- end;
235-
236- procedure TForm1.FormCreate(Sender: TObject);
237- begin
238- inherited;
239- MyThread := TMyThread.Create(true);
240- MyThread.OnShowStatus := @ShowStatus;
241- end;
242-
243- procedure TForm1.FormDestroy(Sender: TObject);
244- begin
245- MyThread.Terminate;
246-
247- // FreeOnTerminate is true so we should not write:
248- // MyThread.Free;
249- inherited;
250- end;
251-
252- procedure TForm1.Button1Click(Sender: TObject);
253- begin
254- MyThread.Start;
255- end;
256-
257- procedure TForm1.ShowStatus(Status: string);
258- begin
259- Label1.Caption := Status;
260- end;
309+应用程序中的代码:
261310```
262-
263-## 特殊处理
264-
265-### Windows堆栈检查
266-
267-There is a potential headache in Windows with Threads if you use the -Ct (stack check) switch. For reasons not so clear the stack check will "trigger" on any TThread.Create if you use the default stack size. The only work-around for the moment is to simply not use -Ct switch. Note that it does NOT cause an exception in the main thread, but in the newly created one. This "looks" like if the thread was never started.
311+Type
312+ TForm1 = class(TForm)
313+ Button1: TButton;
314+ Label1: TLabel;
315+ procedure FormCreate(Sender: TObject);
316+ procedure FormDestroy(Sender: TObject);
317+ private
318+ { private declarations }
319+ MyThread: TMyThread;
320+ procedure ShowStatus(Status: string);
321+ public
322+ { public declarations }
323+ end;
324+
325+ procedure TForm1.FormCreate(Sender: TObject);
326+ begin
327+ inherited;
328+ MyThread := TMyThread.Create(true);
329+ MyThread.OnShowStatus := @ShowStatus;
330+ end;
331+
332+ procedure TForm1.FormDestroy(Sender: TObject);
333+ begin
334+ MyThread.Terminate;
335+
336+ // FreeOnTerminate 为 true,因此不应再放置释放代码:
337+ // MyThread.Free;
338+ inherited;
339+ end;
340+
341+ procedure TForm1.Button1Click(Sender: TObject);
342+ begin
343+ MyThread.Start;
344+ end;
345+
346+ procedure TForm1.ShowStatus(Status: string);
347+ begin
348+ Label1.Caption := Status;
349+ end;
350+```
268351
269-A good code to check for this and other exceptions which can occur in thread creation is:
352+## 特别注意事项
270353
271-如果在Windows使用-CT(堆栈检查)会引发一些问题。 如果你使用默认的堆栈大小在,堆栈检查将在TThread.Create时"触发",原因不是很清楚。 唯一的解决方法是,不使用-CT。请注意,它不会导致主线程的异常,但新创建的却不一定。如果线程从未启动过,它"看起来"会。
354+### Windows 栈检查
272355
273-下面的代码来检查它,用于在线程创建时抛出异常:
356+在 Windows 中使用线程时,如果启用了 -Ct(栈检查)开关,可能会遇到一个令人头疼的问题。原因尚不明,如果用了默认堆栈大小,那么在每次调用 TThread.Create 时都会“触发”栈检查。目前唯一的变通办法就是不启用 -Ct 开关。请注意,异常不是在主线程中触发,而是在新建的线程中。于是会造成线程就像是未曾启动。
274357
275-``` pascal
358+以下是一段良好的代码,用于检查这种情况以及线程创建过程中可能发生的其他异常:
359+```
276360MyThread := TThread.Create(False);
277-if Assigned(MyThread.FatalException) then
278- raise MyThread.FatalException;
361+
362+ if Assigned(MyThread.FatalException) then
363+ raise MyThread.FatalException;
279364```
280365
281-This code will assure that any exception which occurred during thread creation will be raised in your main thread.
366+上述代码确保线程创建过程中的所有异常都会在主线程中触发。
282367
283-~~上面的代码,将在某个线程创建时抛出任何异常在主线程中。~~
368+### Windows 的 GetDC 函数
284369
285-### 多线程包
370+GetDC(及 GetDCEx)函数用于检索指定窗口区域或整个屏幕的设备上下文(DC)句柄。比如可用于屏幕截图。但请注意,GetDC 不是线程安全函数:根据文档说明,设备上下文句柄任何时候只能由一个线程使用。
286371
287-Packages which uses multi-threading should add the **-dUseCThreads** flag to the custom usage options. Open the package editor of the package, then Options \> Usage \> Custom and add *-dUseCThreads*. This will define this flag to all projects and packages using this package, including the IDE. The IDE and all new applications created by the IDE have already the following code in their .lpr file:
372+### 多线程软件包
288373
289-``` pascal
374+用到多线程的软件包,应在自定义选项中添加 -dUseCThreads 标志。打开包编辑器,然后选择“选项>用法(Usage)>自定义”,加入 -dUseCThreads。这样将为使用此软件包的所有项目和包(包括 IDE)定义此标志。IDE 及其创建的所有新应用已在 .lpr 文件中包含了以下代码:
375+```
290376uses
291- {$IFDEF UNIX}{$IFDEF UseCThreads}
292- cthreads,
293- cmem, // the c memory manager is on some systems much faster for multi-threading
294- {$ENDIF}{$ENDIF}
377+ {$IFDEF UNIX}{$IFDEF UseCThreads}
378+ cthreads,
379+ cmem, // the c memory manager is on some systems much faster for multi-threading
380+ {$ENDIF}{$ENDIF}
295381```
296382
297383### Heaptrc
298384
299-You can not use the -gh switch with the *cmem* unit. The -gh switch uses the heaptrc unit, which extends the heap manager. Therefore the **heaptrc** unit must be used **after** the **cmem** unit.
300-
301-~~你不能使用-gh选项与 *cmem* 单元。-gh使用了heaptrc单元,它扩展了堆管理器。因此**heaptrc** 必须在**cmem**单元后引用。~~
302-
303-``` pascal
385+在用到 cmem 单元时不能启用 -gh 开关。-gh 开关会用到 heaptrc 单元,而 heaptrc 单元对堆管理器的代码做了扩充。因此,在引用 **cmem** 单元时,**heaptrc** 单元必须加在**后面** 。
386+```
304387uses
305- {$IFDEF UNIX}{$IFDEF UseCThreads}
306- cthreads,
307- cmem, // the c memory manager is on some systems much faster for multi-threading
308- {$ENDIF}{$ENDIF}
309- heaptrc,
388+ {$IFDEF UNIX}{$IFDEF UseCThreads}
389+ cthreads,
390+ cmem, // the c memory manager is on some systems much faster for multi-threading
391+ {$ENDIF}{$ENDIF}
392+ heaptrc,
310393```
311394
312-## SMP支持
395+### 线程的初始化和终止
313396
314-好消息是,如果你的应用程序在多线程上工作正常,看来SMP已经启用。
397+若要对线程对象本身进行初始化,可以用挂起状态启动并设置属性,也可以新建一个构造函数并调用继承的构造函数。
315398
316-## Lazarus调试多线程应用程序
399+**注意** :如 CreateSuspended=false,则使用 AfterConstruction 是很危险的,因为线程已经启动了。
317400
318-Lzarus上使用[GDB](http://zh.wikipedia.org/zh-cn/GDB)进行调试,它功能齐全、稳定。不过,在一些Linux发行版上存在一些问题。
401+析构函数则可用于释放对象所占资源。
402+```
403+type
404+ TMyThread = class(TThread)
405+ private
406+ fRTLEvent: PRTLEvent;
407+ public
408+ constructor Create(SomeData: TSomeObject; CreateSuspended: boolean);
409+ destructor Destroy; override;
410+ end;
411+
412+ constructor TMyThread.Create(SomeData: TSomeObject; CreateSuspended: boolean);
413+ begin
414+ // 示例:设置事件、临界区、其他文件或数据库连接之类的资源
415+ RTLEventCreate(fRTLEvent);
416+ inherited Create(CreateSuspended);
417+ end;
418+
419+ destructor TMyThread.Destroy;
420+ begin
421+ RTLeventDestroy(fRTLEvent);
422+ inherited Destroy;
423+ end;
424+```
319425
320-### 调试输出
426+### 非 LCL 程序
321427
322-In a single threaded application, you can simply write to console/terminal/whatever and the order of the lines is the same as they were written. In multi-threaded application things are more complicated. If two threads are writing, say a line is written by thread A before a line by thread B, then the lines are not necessarily written in that order. It can even happen, that a thread writes its output, while the other thread is writing a line.While under linux (maybe) you'll get proper DebugLn() output, under win32 you can get exceptions (probably DiskFull) because of DebugLn() usage outside of main thread.So, to avoid headaches use DebugLnThreadLog() mentioned below.
428+TThread.Synchronize 需要主线程定期调用 CheckSynchronize。LCL 会在事件循环中进行调用。如果不使用 LCL 的事件循环,那就必须自行完成调用。
323429
324-(在一个单线程的应用程序中,你可以很容易的写入(输出信息)到控制台/终端/其他,因为写入顺序是一样的。
430+## SMP支持
325431
326-在多线程应用程序中这样做会变得很复杂。如果两个线程在写,线程A在线程B之前输出一行,似乎输出结果并不会按写入顺序显示。甚至会发生,一个线程写入一个线程输出,其他的线程在写。在Linux下使用DebugLn()你会得到正确的输出结果。在Win32下可能得到异常(或许是DiskFull),它是因为,在主线程外使用DebugLn()。
432+好消息是,如果你的应用程序在多线程上工作正常,看来SMP已经启用。
327433
328-所以,为了避免这类问题,使用DebugLnThreadLog(),下面将会提到:)
434+## Lazarus 调试多线程应用
329435
330-LCLProc 单元包含几个过程,让每个线程写入它自己的日志文件:
436+Lazarus 的调试需要 GDB,并且其功能正在迅速变得更加全面和稳定。但仍有一些 Linux 版本存在问题。
331437
332-``` pascal
333- procedure DbgOutThreadLog(const Msg: string); overload;
334- procedure DebuglnThreadLog(const Msg: string); overload;
335- procedure DebuglnThreadLog(Args: array of const); overload;
336- procedure DebuglnThreadLog; overload;
337-```
438+### 调试时的输出
338439
339-示例: 不是*writeln('Some text ',123);* 而是,使用
440+在单线程应用中,写入控制台/终端/其他输出设备都很简单,并且输出顺序与写入顺序相同。但多线程应用中的情况要复杂得多。如果两个线程同时写入,比如线程A先写一行,线程B再写一行,这两行不一定会按这个顺序写入。甚至可能一个线程在输出时,另一个线程也在写入。在 Linux 下,DebugLn() 输出(可能)会得到正确顺序 。但在 Win32 下,由于是在主线程之外使用 DebugLn(),可能会引发异常(可能是 DiskFull)。因此,为了避免麻烦,请使用以下 DebugLnThreadLog()。
340441
341-```text
342- DebuglnThreadLog(['Some text ',123]);
442+LCLProc 单元中有几个函数,可供每个线程写入自己的日志文件:
343443```
444+procedure DbgOutThreadLog(const Msg: string); overload;
445+ procedure DebuglnThreadLog(const Msg: string); overload;
446+ procedure DebuglnThreadLog(Args: array of const); overload;
447+ procedure DebuglnThreadLog; overload;
448+```
344449
345-这将在**Log\<PID\>.txt**文件中添加一行'Some text 123'。\<PID\>是当前线程的进程ID。
450+比如,不用 _writeln('Some text ',123);_ 而是用
451+```
452+DebuglnThreadLog(['Some text ',123]);
453+```
346454
347-在每次运行前删除日志文件是个不错的选择:
455+这样就会在 **Log <PID>.txt** 文件中追加一行 'Some text 123',其中 <PID> 是当前线程的进程 ID。
348456
349-```text
350- rm -f Log* && ./project1
457+在每次运行线程前删除日志文件,是个好办法:
351458```
459+rm -f Log* && ./project1
460+```
352461
353462### Linux
354463
355-如果你尝试在Linux调试多线程应用程序,你将会遇到一个很大的问题:
356-
357-X服务器上的桌面管理器可能会**挂掉**。如应用程序已捕获鼠标/键盘gdb暂停,X服务器等待应用程序响应。
358-
359-发生这种情况时,你可以使用另一个用户登录计算机杀掉gdb或按Ctrl+Alt+F3退出会话并杀掉gdb。
360-
361-或者,你重新启动窗口管理器:输入 /etc/init.d/gdm restart。
362-
363-这将重新启动桌面管理器,让你回到桌面。
364-
365-Since it depends where gdb stops your program in some cases some tricks may help: 为Ubuntu x64设置项目选项用于调试所需的额外信息文件...
464+若要在 Linux 中调试多线程应用,会碰到一个大问题:X Windows 的桌面管理器可能会**挂起** 。比如应用捕获了鼠标/键盘并被 gdb 暂停时就会发生这种情况,此时 X 系统会等待应用响应。这时只要从另一台计算机登录并杀掉 gdb 即可,或者按 CTRL+ALT+F3 退出会话并杀掉 gdb。另外也可以重启窗口管理器:输入 sudo /etc/init.d/gdm restart,会重新回到桌面。
366465
367-```text
368- 工程菜单 -> 工程选项 -> 编译选项中的调试项,勾选使用外部gdb调试语法文件(-Xg)。
466+gdb 停止应用程序的时机不一定每次都一样,因此有些技巧还是有用的:Ubuntu x64 系统下可设置一下项目的选项,以便获得调试所需的额外信息文件……
369467```
370-
371-另一种选择是,打开另一个X桌面,在里面运行 IDE/GDB和其他应用程序,因此,只会在测试桌面中冻结。创建一个新的X实例:
372-
373-```text
374- X :1 &
468+项目选项->编译器选项->调试,勾选“使用外部调试符号文件(-Xg)”。
375469```
376470
377-It will open, and when you switch to another desktop (the one you are working with pressing CTRL+ALT+F7), you will be able to go back to the new graphical desktop with CTRL+ALT+F8 (if this combination does not work, try with CTRL+ALT+F2... this one worked on [Slackware](http://www.slackware.com)).
378-
379-(~~这将打开,按Ctrl+Alt+F7切换到另一个桌面,Ctrl+Alt+F8切换到原桌面(桌面快捷键没效果,尝试按Ctrl+Alt+F2,它工作在[Slackware](http://www.slackware.com))。~~)
380-
381-Then you could, if you want, create a desktop session on the X started with:
382-
383-(~~之后,如果你愿意,你可以在X开始时创建会话:~~)
384-
385-```text
386- gnome-session --display=:1 &
471+另一种做法是再开一个X桌面,一个桌面运行 IDE/gdb,另一个桌面运行应用程序,这样只会挂起调试的桌面。用以下命令新建 X 实例:
387472```
388-
389-Then, in Lazarus, on the run parameters dialog for the project, check "Use display" and enter :1.
473+X :1 &
474+```
390475
391-(~~之后在Lazarus运行参数对话框中检查Use display并设置为:1。~~)
476+这样就会新开一个桌面,切换到另一个桌面(比如按 CTRL+ALT+F7)时,就能按 CTRL+ALT+F8 返回新开的桌面(如果组合键不起作用,尝试按CTRL+ALT+F2 …… 在 [Slackware](<http://www.slackware.com>) 中是有效的)。
392477
393-现在应用程序运行在第二个X服务器上,你可以在第一个X服务器上调试它。。
478+然后即可创建桌面会话如下:
479+```
480+gnome-session --display=:1 &
481+```
394482
395-在Windows及Linux上的Free Pascal 2.0 和Lazarus 0.9.10 测试。
483+然后,在 Lazarus 中,在项目的“运行参数”对话框中,勾选“使用显示”并输入 :1。
396484
397-------------------------------------------------------------------------
485+应用将运行于第二个 X 服务上,且可在第一个 X 服务上进行调试。
398486
399-Instead of creating a new X session, one can use [Xnest](http://en.wikipedia.org/wiki/Xnest). Xnest is a X session on a window. Using it X server didn't lock while debugging threads, and it's much easier to debug without keeping changing terminals.
487+已在 Windows 和 Linux 中 Free Pascal 2.0 和 Lazarus 0.9.10 通过测试。
400488
401-(~~而不是创建一个新的X会话,可以使用[Xnest](http://en.wikipedia.org/wiki/Xnest)。Xnest是X会话窗口,它使用X服务器不锁定调试线程,及更容易调试并改变终端。~~)
489+* * *
402490
403-运行 Xnest 命令
491+不新开 X 会话的话,还可以使用 [Xnest](<http://en.wikipedia.org/wiki/Xnest>)。Xnest 是运行于窗口上的 X 会话。调试线程时使用了 Xnest,X 服务就不会锁住,而且不用来回切换终端,调试起来更加容易。
404492
405-```text
406- Xnest :1 -ac
493+运行 Xnest 的命令行:
407494```
408-
409-创建一个X会话:1,并禁用访问控制。
410-
411-## Lazarus 部件工具箱接口
495+Xnest :1 -ac
496+```
412497
413-The win32, the gtk and the carbon interfaces support multi-threading. This means, TThread, critical sections and Synchronize work. But they are not thread safe. This means only one thread at a time can access the LCL. And since the main thread should never wait for another thread, it means only the main thread is allowed to access the LCL, which means anything that has to do with TControl, Application and LCL widget handles. There are some thread safe functions in the LCL. For example most of the functions in the FileUtil unit are thread safe.
498+以上将在:1创建一个 X 会话,并禁用访问控制。
414499
415-(~~在Win32 中,gtk 和carbon接口支持多线程。这意味着,TThread、关键区域和同步工作,但它们不是线程安全的。也就是说只有一个线程在同一时间可以访问LCL。由于主线程不应该等待另一个线程,这使得只有主线程访问LCL,这意味着任何TControl,应用程序和LCL控件句柄。LCL中有一些线程安全函数。例如大部分的 FileUtil 单元中的函数是[线程安全](http://zh.wikipedia.org/wiki/%E7%BA%BF%E7%A8%8B%E5%AE%89%E5%85%A8)的。~~)
500+## Lazarus 界面组件的接口
416501
417-### 使用SendMessage/PostMessage进行线程间通信
502+Win32、gtk 和 carbon 接口都支持多线程,就是说 TThread、临界区和 Synchronize 都能用。但这些接口并不是线程安全的,就是说一次只能有一个线程访问 LCL。并且由于主线程永远不允许等待其他线程,就是说只有主线程才能访问 LCL,包括所有与 TControl、Application 和 LCL 控件句柄相关的操作。LCL 中有一些函数是线程安全的,比如 FileUtil 单元中的大多数函数。
418503
419-在应用程序中只有一个线程可以调用LCL API,通常是主线程。其他线程可以通过一些间接的方法调用LCL,使用SendMessage、PostMessage是不错的选择。LCLIntf.SendMessage 和 LCLIntf.PostMessage将发送一条消息到应用程序的消息队列中。
504+### 利用 SendMessage/PostMessage 进行线程间通信
420505
421-参看这些例程文档
506+一个应用应该只有一个线程(通常是主线程)会去调用 LCL API。其他线程可以通过多种间接方法使用 LCL,其中一种不错的做法就是利用 SendMessage 或 PostMessage。LCLIntf.SendMessage 和 LCLIntf.PostMessage 会一条带有窗口指向的消息送入应用的消息池。
422507
423-- [[doc:lcl/lclintf/sendmessage.html|SendMessage]]
424-- [[doc:lcl/lclintf/postmessage.html|PostMessage]]
508+关于这两个函数,请参看以下文档:
425509
426-The difference between SendMessage and PostMessage is the way that they return control to the calling thread. With SendMessage control is not returned until the window that the message was sent to has completed processing the sent message, however with PostMessage control is returned immediately.
510+ * [SendMessage](<http://lazarus-ccr.sourceforge.net/docs/lcl/lclintf/sendmessage.html> "doc:lcl/lclintf/sendmessage.html")
511+ * [PostMessage](<http://lazarus-ccr.sourceforge.net/docs/lcl/lclintf/postmessage.html> "doc:lcl/lclintf/postmessage.html")
427512
428-(~~SendMessage 和 PostMessage区别在于处理调用线程的方式。SendMessage 在接收到返回值后才继续执行,而PostMessage则不会等待。~~)
513+SendMessage 和 PostMessage 的区别在于,将控制权交回调用线程的方式。与 Synchronize 类似,SendMessage 会阻塞调用线程,直到目标窗口完成消息处理后才返回控制权;但在某些情况下,SendMessage 可能需要待在调用线程的上下文中进行优化操作。而 PostMessage 则会立即返回控制权,只要排队的消息数量不超过系统定义的最大值,并且堆上仍有填加数据的空间。
429514
430-Here is an example of how a secondary thread could send text to be displayed in an LCL control to the main thread:
515+无论采用哪种发送方式,在消息处理函数中(见下文)都应避免调用 application.ProcessMessages,因为可能会导致再发送一次消息,消息将递归处理。如果无法避免,那么最好采用其他机制在线程之间传递串行事件。
431516
432-``` pascal
517+以下是一个示例,展示了辅助线程如何将文本发给主线程,显示于 LCL 控件中:
518+```
433519const
434- WM_GOT_ERROR = LM_USER + 2004;
435- WM_VERBOSE = LM_USER + 2005;
436-
437-procedure VerboseLog(Msg: string);
438-var
439- PError: PChar;
440-begin
441- if MessageHandler = 0 then Exit;
442- PError := StrAlloc(Length(Msg)+1);
443- StrCopy(PError, PChar(Msg));
444- PostMessage(formConsole.Handle, WM_VERBOSE, Integer(PError), 0);
445-end;
520+ WM_GOT_ERROR = LM_USER + 2004;
521+ WM_VERBOSE = LM_USER + 2005;
522+
523+ procedure VerboseLog(Msg: string);
524+ var
525+ PError: PChar;
526+ begin
527+ if MessageHandler = 0 then Exit;
528+ PError := StrAlloc(Length(Msg)+1);
529+ StrCopy(PError, PChar(Msg));
530+ PostMessage(formConsole.Handle, WM_VERBOSE, Integer(PError), 0);
531+ end;
446532```
447533
448-及如何从窗口中处理这个消息:
449-
450-``` pascal
534+下面是处理窗口消息的示例:
535+```
451536const
452- WM_GOT_ERROR = LM_USER + 2004;
453- WM_VERBOSE = LM_USER + 2005;
454-
455-type
456- { TformConsole }
457-
458- TformConsole = class(TForm)
459- DebugList: TListView;
460- // ...
461- private
462- procedure HandleDebug(var Msg: TLMessage); message WM_VERBOSE;
463- end;
464-
465-var
466- formConsole: TformConsole;
467-
468-implementation
469-
470-....
471-
472-{ TformConsole }
473-
474-procedure TformConsole.HandleDebug(var Msg: TLMessage);
475-var
476- Item: TListItem;
477- MsgStr: PChar;
478- MsgPasStr: string;
479-begin
480- MsgStr := PChar(Msg.wparam);
481- MsgPasStr := StrPas(MsgStr);
482- Item := DebugList.Items.Add;
483- Item.Caption := TimeToStr(SysUtils.Now);
484- Item.SubItems.Add(MsgPasStr);
485- Item.MakeVisible(False);
486- //f/TrayControl.SetError(MsgPasStr);
487-end;
488-
489-end.
537+ WM_GOT_ERROR = LM_USER + 2004;
538+ WM_VERBOSE = LM_USER + 2005;
539+
540+ type
541+ { TformConsole }
542+
543+ TformConsole = class(TForm)
544+ DebugList: TListView;
545+ // ...
546+ private
547+ procedure HandleDebug(var Msg: TLMessage); message WM_VERBOSE;
548+ end;
549+
550+ var
551+ formConsole: TformConsole;
552+
553+ implementation
554+
555+ ....
556+
557+ { TformConsole }
558+
559+ procedure TformConsole.HandleDebug(var Msg: TLMessage);
560+ var
561+ Item: TListItem;
562+ MsgStr: PChar;
563+ MsgPasStr: string;
564+ begin
565+ MsgStr := PChar(Msg.wparam);
566+ MsgPasStr := StrPas(MsgStr);
567+ Item := DebugList.Items.Add;
568+ Item.Caption := TimeToStr(SysUtils.Now);
569+ Item.SubItems.Add(MsgPasStr);
570+ Item.MakeVisible(False);
571+
572+ // 下面可干点事情,比如:
573+
574+ TrayControl.SetError(MsgPasStr);
575+ StrDispose(MsgStr)
576+ end;
577+
578+ end.
490579```
491580
492-## 临界区
493-
494-A *critical section* is an object used to make sure, that some part of the code is executed only by one thread at a time. A critical section needs to be created/initialized before it can be used and be freed when it is not needed anymore.
581+如果在 Linux x64 机器上遇到错误:“Project XY raised exception class 'External: SIGSEGV'”时,就得将“VerboseLog”中的“Integer(PError)”修改为“PtrInt(PError)”。修改后的这行代码应如下所示:
582+```
583+PostMessage(formConsole.Handle, WM_VERBOSE, PtrInt(PError), 0);
584+```
495585
496-(~~*[临界区](http://zh.wikipedia.org/wiki/%E4%B8%B4%E7%95%8C%E5%8C%BA)*用来确保代码的某些部分同一时间只能由一个线程执行。临界区需要被创建/初始化后才能使用,不需要时释放它。~~)
586+## 临界区(critical section)
497587
498-临界区通常使用这种方式:
588+_临界区_ 是一个对象,用于确保某部分代码在任何时候只能由一个线程执行。临界区在使用前需要创建/初始化,在不用时需释放。
499589
500-声明 (全局范围内所有线程可以访问):
590+临界区有两种使用方式,RTL 或 LCL。以下给出 RTL 的用法,平替的 LCL 方式则以注释的形式给出,唯一区别就是方法名不同。
501591
502-```text
503- MyCriticalSection: TRTLCriticalSection;
592+使用临界区时通常如下引入:
504593```
594+// uses LCLIntf, LCLType;
595+```
505596
506-初始化临界区:
597+所需的 RTL 单元几乎都可涵盖。
507598
508-```text
509- InitializeCriticalSection(MyCriticalSection);
599+声明(对所有要访问临界区的线程而言,是全局变量):
510600```
601+MyCriticalSection: TRTLCriticalSection;
602+ // MyCriticalSection : TCriticalSection;
603+```
511604
512-运行一些线程,只做
605+创建:
606+```
607+InitCriticalSection(MyCriticalSection);
608+ //InitializeCriticalSection(MyCriticalSection);
609+```
513610
514-``` pascal
611+运行一些线程。独占地执行某些操作:
612+```
515613EnterCriticalSection(MyCriticalSection);
516-try
517- // 访问变量、写入文件、发送网络数据包等等
518-finally
519- LeaveCriticalSection(MyCriticalSection);
520-end;
614+ try
615+ // 访问变量、写入文件、发送网络包等
616+ finally
617+ LeaveCriticalSection(MyCriticalSection);
618+ end;
619+ // RTL 和 LCL 的语法相同,不错吧。
521620```
522621
523-所有线程结束后,释放它:
524-
525-```text
526- DeleteCriticalSection(MyCriticalSection);
622+所有线程结束后,释放临界区:
527623```
528-
529-As an alternative, you can use a TCriticalSection object. The creation does the initialization, the Enter method does the EnterCriticalSection, the Leave method does the LeaveCriticalSection and the destruction of the object does the deletion.
624+DoneCriticalSection(MyCriticalSection);
625+ // DeleteCriticalSection(MyCriticalSection);
626+```
530627
531-(~~作为代替者,你可以使用TCriticalSection对象。创建即初始化临界区,进入临界区使用 EnterCriticalSection,离开时使用 LeaveCriticalSection,对象销毁时删除临界区。~~)
628+另一种方案是使用 TCriticalSection 对象。对象创建即初始化,Enter 方法执行 EnterCriticalSection 操作,Leave 方法执行 LeaveCriticalSection 操作,而对象销毁则执行删除操作。
532629
533-例如:5个线程递增计数器。 查看 lazarus/examples/multithreading/criticalsectionexample1.lpi
630+请注意,临界区无法防止同一线程多次进入同一块代码,而只能防止不同线程同时进入。因此,临界区不能用于防止消息处理函数的重入(请参阅前文)。
534631
535-**注意**: There are two sets of the above 4 functions. The RTL and the LCL ones. The LCL ones are defined in the unit LCLIntf and LCLType. Both work pretty much the same. You can use both at the same time in your application, but you should not use a RTL function with an LCL Critical Section and vice versus.
632+示例:5个线程同时递增1个计数器。 请参阅 lazarus/examples/multithreading/criticalsectionexample1.lpi。
536633
537-### 共享变量
634+[![Warning-icon.png](/wiki-images/b/b2/Warning-icon.png)](</File:Warning-icon.png>)
538635
539-如果一些线程共享变量,它是只读的,那么就没有什么好担心的,直接读取就可以了。
636+**Warning:** 上述4个函数分成了两组,分别由 RTL 和 LCL 提供。LCL 的函数在 LCLIntf 和 LCLType 单元中定义。这两组函数的工作方式大致相同,应用程序中可以同时使用,但不得在 LCL 临界区内使用 RTL 函数,反之亦然。
540637
541-但是如果一个或多个线程想改变变量,那么你必须确保,同一时间只有一个线程访问该变量。
638+### 共享变量
542639
543-示例:5线程递增计数器。 查看 lazarus/examples/multithreading/criticalsectionexample1.lpi
640+如果有多个线程共享一个只读变量,那没什么可担心的。直接读就是了。 但如果有一个或多个线程要修改变量值,那就必须确保每次只有一个线程能够访问。
544641
545-## 等待另一个线程
642+示例:5个线程递增1个计数器。 参见 lazarus/examples/multithreading/criticalsectionexample1.lpi
546643
547-如果一个线程A需要线程B的结果,那么它必须等待,直到B完成。
644+## 等待其他线程
548645
549-**重要:**主线程不应该等待另一个线程,不是使用Synchronize(见上文)。
646+如果线程A需要用到线程B的运行结果,那就必须等待至线程B完成。
550647
551-查看示例: lazarus/examples/multithreading/waitforexample1.lpi
648+**重要:** 主线程绝不能等待其他线程,而应使用 Synchronize 方法(参见前文)。
552649
553-``` pascal
650+示例参见:lazarus/examples/multithreading/waitforexample1.lpi
651+```
554652{ TThreadA }
555-
556-procedure TThreadA.Execute;
557-begin
558- Form1.ThreadB:=TThreadB.Create(false);
559- // create event
560- WaitForB:=RTLEventCreate;
561- while not Application.Terminated do begin
562- // wait infinitely (until B wakes A)
563- RtlEventWaitFor(WaitForB);
564- writeln('A: ThreadB.Counter='+IntToStr(Form1.ThreadB.Counter));
565- end;
566-end;
567-
568-{ TThreadB }
569-
570-procedure TThreadB.Execute;
571-var
572- i: Integer;
573-begin
574- Counter:=0;
575- while not Application.Terminated do begin
576- // B: Working ...
577- Sleep(1500);
578- inc(Counter);
579- // wake A
580- RtlEventSetEvent(Form1.ThreadA.WaitForB);
581- end;
582-end;
653+
654+ procedure TThreadA.Execute;
655+ begin
656+ Form1.ThreadB:=TThreadB.Create(false);
657+ // 创建事件
658+ WaitForB:=RTLEventCreate;
659+ while not Application.Terminated do begin
660+ // 一直等待,直至线程B唤醒A
661+ RtlEventWaitFor(WaitForB);
662+ writeln('A: ThreadB.Counter='+IntToStr(Form1.ThreadB.Counter));
663+ end;
664+ end;
665+
666+ { TThreadB }
667+
668+ procedure TThreadB.Execute;
669+ var
670+ i: Integer;
671+ begin
672+ Counter:=0;
673+ while not Application.Terminated do begin
674+ // 线程 B 执行任务
675+ Sleep(1500);
676+ inc(Counter);
677+ // 唤醒线程 A
678+ RtlEventSetEvent(Form1.ThreadA.WaitForB);
679+ end;
680+ end;
583681```
584682
585-> **Note:** RtlEventSetEvent can be called before RtlEventWaitFor. Then RtlEventWaitFor will return immediately. Use RTLeventResetEvent to clear a flag.
586-
587-> **Note:** ~~RtlEventSetEvent可以在RtlEventWaitFor之前被调用。之后RtlEventWaitFor将立即返回。使用RTLeventResetEvent清除标记。~~
683+![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Note:** RtlEventSetEvent可在 RtlEventWaitFor 之前调用。RtlEventWaitFor 将立即返回。可用 RTLeventResetEvent 清除标志。
588684
589685## Fork
590686
591-When forking in a multi-threaded application, be aware that any threads created and running BEFORE the fork (or fpFork) call, will NOT be running in the child process. As stated on the fork() man page, any threads that were running before the fork call, their state will be undefined.
687+多线程应用在创建子进程时,请注意在 fork(或 fpFork)调用**之前** 创建并运行的所有线程均不会在子进程中运行。正如 fork() 手册所述,任何在 fork 调用之前运行的线程,状态将是未定义。
592688
593-So be aware of any threads initializing before the call (including on the initialization section). They will NOT work.
689+因此,请注意在 fork 调用之前初始化的任何线程(包括 initialization 部分中的线程)都**不会** 工作。
594690
595-## 并行程序/循环
691+## 并行过程/循环
596692
597-多线程的一个特殊情况是并行运行一个程序。参见[[Parallel procedures|并行程序]]。
693+多线程的一个特例是并行运行单个过程。请参见[[Parallel procedures|并行过程]]。
598694
599695## 分布式计算
600696
601-The next higher steps after multi threading is running the threads on multiple machines.
697+多线程的更高境界是在多台机器上运行这些线程。
602698
603-- 可以使用TCP组件像synapse、lnet 或 indy通信。这给你最大的灵活性和主要用于松散连接的客户端/服务器应用程序。
604-- 你可以使用消息传递库,像[[MPICH]],用于HPC(高性能计算)集群上。
699+ * 可以使用 synapse、lnet、indy 之类的 TCP 组件进行通信,以提供最大的灵活性,通常用于松散连接的客户端/服务器应用。
700+ * 可以使用 [[MPICH]] 这种消息传递库,用于在服务器集群上实现 HPC(高性能计算)。
605701
606702## 外部线程
607703
608-To make Free Pascal's threading system work properly, each newly created FPC thread needs to be initialized (more exactly, the exception, I/O system and threadvar system per thread needs to be initialized so threadvars and heap are working). That is fully automatically done for you if you use BeginThread (or indirectly by using the TThread class). However, if you use threads that were created without BeginThread (i.e. external threads), additional work (currently) might be required. External threads also include those that were created in external C libraries (.DLL/.so).
609-
610-Things to consider when using external threads (might not be needed in all or future compiler versions):
704+为了让 Free Pascal 的线程系统能够正常运转,新建 FPC 线程都需要进行初始化(更准确地说,每个线程的异常、I/O系统和 threadvar 系统都需要初始化,以确保本地变量和内存堆能正常工作)。如果使用了 BeginThread(或通过 TThread 类间接使用了),那么这些初始化工作都会自动完成。但如果用到的线程不是由 BeginThread 创建的(即外部线程),则(目前)可能需要多做一些初始化的工作。外部线程还包括在外部 C 语言库(.DLL/.so)中创建的线程。
611705
612-- Do not use external threads at all - use FPC threads. If can you can get control over how the thread is created, create the thread by yourself by using BeginThread.
706+以下是使用外部线程时需要考虑的事项(可能并非所有版本编译器都需要考虑):
613707
614-If the calling convention doesn't fit (e.g. if your original thread function needs cdecl calling convention but BeginThread needs pascal convention, create a record, store the original required thread function in it, and call that function in your pascal thread function:
708+ * 完全不使用外部线程,而应该采用 FPC 线程。如果能控制线程的创建方式,请通过 BeginThread 自行创建线程。
615709
616-``` pascal
710+如果调用约定不合适(比如原线程函数遵守 cdecl 调用方式,而 BeginThread 是 pascal 调用方式),则可以创建一个记录,存入需调用的原线程函数,并在 pascal 线程函数中调用,如下所示:
711+```
617712type
618- TCdeclThreadFunc = function (user_data:Pointer):Pointer;cdecl;
713+ TCdeclThreadFunc = function (user_data:Pointer):Pointer;cdecl;
714+
715+ PCdeclThreadFuncData = ^TCdeclThreadFuncData;
716+ TCdeclThreadFuncData = record
717+ Func: TCdeclThreadFunc; //cdecl 函数
718+ Data: Pointer; //原数据
719+ end;
720+
721+ // Pascal 线程调用 cdecl 函数
722+ function C2P_Translator(FuncData: pointer) : ptrint;
723+ var
724+ ThreadData: TCdeclThreadFuncData;
725+ begin
726+ ThreadData := PCdeclThreadFuncData(FuncData)^;
727+ Result := ptrint(ThreadData.Func(ThreadData.Data));
728+ end;
729+
730+ procedure CreatePascalThread;
731+ var
732+ ThreadData: PCdeclThreadFuncData;
733+ begin
734+ New(ThreadData);
735+ // 下面是需调用的 cdecl 线程函数
736+ ThreadData^.Func := func;
737+ ThreadData^.Data := user_data;
738+ // 创建 Pascal 线程
739+ BeginThread(@C2P_Translator, ThreadData );
740+ end;
741+```
619742
620- PCdeclThreadFuncData = ^TCdeclThreadFuncData;
621- TCdeclThreadFuncData = record
622- Func: TCdeclThreadFunc; //cdecl function
623- Data: Pointer; //original data
624- end;
743+
625744
626-// The Pascal thread calls the cdecl function
627-function C2P_Translator(FuncData: pointer) : ptrint;
628-var
629- ThreadData: TCdeclThreadFuncData;
630-begin
631- ThreadData := PCdeclThreadFuncData(FuncData)^;
632- Result := ptrint(ThreadData.Func(ThreadData.Data));
633-end;
745+ * 通过创建一个虚拟线程来初始化 FPC 的线程系统。如果应用中未创建任何 Pascal 线程,那么线程系统将不会初始化(因此,本地变量和内存堆都不会正常工作)。
634746
635-procedure CreatePascalThread;
636-var
637- ThreadData: PCdeclThreadFuncData;
638-begin
639- New(ThreadData);
640- // this is the desired cdecl thread function
641- ThreadData^.Func := func;
642- ThreadData^.Data := user_data;
643- // this creates the Pascal thread
644- BeginThread(@C2P_Translator, ThreadData );
645-end;
646747```
647-
648-- Initialize the FPC's threading system by creating a dummy thread. If you don't create any Pascal thread in your app, the thread system won't be initialized (and thus threadvars won't work and thus heap will not work correctly).
649-
650-``` pascal
651748type
652- tc = class(tthread)
653- procedure execute;override;
654- end;
655-
656- procedure tc.execute;
657- begin
658- end;
659-
660-{ main program }
661-begin
662- { initialise threading system }
663- with tc.create(false) do
664- begin
665- waitfor;
666- free;
667- end;
668- { ... your code follows }
669-end.
749+ tc = class(tthread)
750+ procedure execute;override;
751+ end;
752+
753+ procedure tc.execute;
754+ begin
755+ end;
756+
757+ { main program }
758+ begin
759+ { initialise threading system }
760+ with tc.create(false) do
761+ begin
762+ waitfor;
763+ free;
764+ end;
765+ { ... 下面是自己的代码 }
766+ end.
670767```
671768
672-(After the threading system is initialized, the runtime may set the system variable "IsMultiThread" to true which is used by FPC routines to perform locks here and there. You should not set this variable manually.)
769+(线程系统初始化后,运行时可能会将系统变量“IsMultiThread”置为 true,FPC 函数利用此变量执行各种加解锁操作。此变量不得自行改动。)
673770
674-- If for some reason this doesn't work for you, try this code in your external thread function:
771+ * 如果上述方法无效,请在外部线程函数中尝试加入以下代码:
675772
676-``` pascal
773+```
677774function ExternalThread(param: Pointer): LongInt; stdcall;
678-var
679- tm: TThreadManager;
680-begin
681- GetThreadManager(tm);
682- tm.AllocateThreadVars;
683- InitThread(1000000); // adjust inital stack size here
684-
685- { do something threaded here ... }
686-
687- Result:=0;
688-end;
775+ var
776+ tm: TThreadManager;
777+ begin
778+ GetThreadManager(tm);
779+ tm.AllocateThreadVars;
780+ InitThread(1000000); // 在此调整初始栈的大小
781+
782+ { 线程工作代码 ... }
783+
784+ Result:=0;
785+ end;
689786```
690787
691-### 识别外部线程
788+
692789
693-有时你甚至不知道是否要处理外部线程 (如对C 库进行回调)。这个可以帮助你来分析:
790+### 识别外部线程
694791
695-1\. 询问操作系统当前应用程序线程的ID
792+有时甚至不知道是否要处理外部线程(如某些 C 语言库带了[[callback|回调函数]])。以下步骤有助于开展分析:
696793
697-``` pascal
794+1\. 应用启动后,向操作系统查询当前线程的ID。
795+```
698796GetCurrentThreadID() // Windows;
699-GetThreadID() // Darwin/OSX;
700-TThreadID(pthread_self) // Linux;
797+ GetThreadID() // Darwin (macOS); FreeBSD;
798+ TThreadID(pthread_self) // Linux;
701799```
702800
703-2\. 再次询问线程内部的当前线程的ID和步骤1结果对比
801+2\. 在线程函数内部再次查询当前线程的 ID,与第1步的查询结果进行比较。
704802
705-### 放弃时间片
803+### 放弃一些时间片
706804
707-ThreadSwitch()
805+[ThreadSwitch](<https://www.freepascal.org/docs-html/rtl/system/threadswitch.html>) \- 注:可忽略。
708806
709-> **Note:** 不要使用Windows的 *Sleep(0)*,因为它不会在所有平台上工作。
807+![Light bulb](https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png) **Note:** 不要使用 Windows 特有的技巧 [_Sleep(0)_](<https://www.freepascal.org/docs-html/rtl/sysutils/sleep.html>),因为不适用于全部平台。
710808
711-## 参见
809+## 参阅
712810
713-- [[Streaming components|流媒体组件]]
714-- [[Manager Worker Threads System|管理工作线程系统]]
715-- [[Example of multi-threaded application: array of threads|多线程应用示例:数组线程]]
716-- [[Parallel procedures|并行程序]]
717-- [[Main Loop Hooks|主循环钩子]]
718-- [[Asynchronous Calls|异步调用]]
811+ * [[Streaming components|流组件]]
812+ * [[Manager Worker Threads System|工作线程系统的管理]]
813+ * [[Example of multi-threaded application: array of threads|多线程应用示例:线程数组]]
814+ * [[Parallel procedures|并行程序]]
815+ * [[Main Loop Hooks|主循环钩子]]
816+ * [[Asynchronous Calls|异步调用]]
817+ * [某个论坛贴子](<https://forum.lazarus.freepascal.org/index.php/topic,55164.0.html>) \- 有用的背景知识:为什么几乎绝不能在线程内访问 LCL 组件,以及可安全访问的部分。
818+ * [多线程 - Delphi 的实现方式](<http://nickhodges.com/MultiThreadingInDelphi/ToC.html>)
819+ * [在 Delphi 应用中进行线程和 GUI 同步](<https://www.thoughtco.com/synchronizing-threads-and-gui-delphi-application-1058159>)
820+ * [介绍 Lazarus 中的线程编程](<https://www.freepascal.org/~michael/articles/lazthread/lazthread.pdf>) \- Michael Van Canneyt 的讲义
719821
720822---
721-*From the Free Pascal wiki, page "Multithreaded Application Tutorial/zh CN", as it stood on 2020-02-20 after a change by Trev, out of the wiki's dump of 2024-05-26. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*
823+*From the Free Pascal wiki, page "Multithreaded Application Tutorial/zh CN", as the Internet Archive kept it on 2025-02-19, last changed on 2024-12-17. Copyright stays with the author who wrote it, according to the old wiki's [[Licensing]] page. If you have concerns about this material, [message the admin](/wiki-contact).*

Back to history