维基副本镜像

这是 pascal.chat 维基的镜像。编辑、历史记录和登录都在那里。

Multithreaded Application Tutorial/zh CN

Deutsch · English · Español · Français · Polski · Português · Slovenčina · Русский · 中文（中国） · 日本語

概述

本文力图说清楚如何用 Free Pascal 和 Lazarus 编写和调试多线程应用。多线程应用会创建两个以上同时运行的线程。如果对多线程还不熟悉，请阅读“是否需要多线程”一节，以确定是否真的需要；这可能会避免很多麻烦。

多线程应用只有一个主线程，也即应用启动时由操作系统创建的那个线程。更新用户界面组件的只能 是主线程，否则应用可能会被挂起。

多线程的主要思路是：应用可在第二个线程中后台处理一些任务，而用户可以继续使用主线程工作。

线程的另一个用途是让应用具备更好的响应能力。假设用户按下某个按钮后，应用开始处理一项大型任务……在处理过程中屏幕就会停止响应，用户会以为应用停滞不动了，用户体验就不大好，或引起误导。如果大型任务运行于另一个线程中，则应用几乎就能像空闲时一样保持响应。这时在启动大型任务的工作线程之前，最好是禁用窗体上的按钮，以免用户为同一任务启动多个线程。

多线程的另一个用途，可能就是服务器应用，以便能同时响应多个客户端的请求。

是否需要多线程？

如果对多线程编程不太熟悉，并且只是希望应用在执行稍长任务时能提升响应速度，那么可能并不一定需要用到多线程。多线程应用肯定更难调试，且往往更加复杂；很多情况下并不需要用到多线程。单线程就足以应付了。如果能将耗时任务拆分为多个部分，则应使用 Application.ProcessMessages 方法。此方法允许 LCL 处理所有等待的消息并返回。主要的思路是在执行长时间任务的过程中定期调用 Application.ProcessMessages，检测用户的点击，或者重绘进度条等。

例如：读取大文件并进行处理。参见示例文件 examples/multithreading/singlethreadingexample1.lpi。

多线程仅适用于：

若要通过多线程同时使用多个处理器以提高速度，请先检查程序目前是否已经跑满了单核 CPU 的资源（例如，程序可能是在做大量输入输出操作，比如写入文件，这很耗时但并不占用大量 CPU 资源；这种情况下，即便用了多线程也不会更快）。另外，请检查优化级别是否已设为最高（3级）。将优化级别从1级升至3级，程序运行速度可能会提升5倍左右。

多线程应用所需单元

Windows 系统下实现多线程应用，不需要用到什么特别的单元。但是在 Linux、macOS 和 FreeBSD 系统中，需要用到 cthreads 单元，还必须是项目第一个引用的单元（程序源代码通常是 .lpr 文件）！有时 cthreads、cmem 和 cwstrings 等多个单元都要放在前面时，由于各单元之间的依赖关系，合理的顺序是cmem、cthreads、cwstrings。

所以 Lazarus 应用的源代码应如下所示：

pascal
program MyMultiThreadedProgram;
    {$mode objfpc}{$H+}
    uses
    {$ifdef unix}
      cthreads,
      cmem, // 在某些系统中，多线程时 c 语言的内存管理速度会快很多
    {$endif}
      Interfaces, // 引入 LCL 可视化组件
      Forms
      { 在此加入其它单元 },

如果忘记了 TThread 引用顺序，在应用启动时会显示如下错误：

pascal
This binary has no thread support compiled in.
     Recompile the application with a thread-driver in the program uses clause before other units using thread.

https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png Note: 如果链接时报错找不到“mcount”，可能是因为引用了包含多线程代码的某个单元，此时需添加 cthreads 单元或启用智能链接功能。

https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png Note: 如果报错“Project raised exception class 'RunError(232)' in procedure SYSTEM_NOTHREADERROR”，说明代码用到了线程，需添加 cthreads 单元的引用。

纯用 FPC 实现的代码示例

以下是非常简单的示例。在 Win7 及 FPC 3.0.4 中调试通过。

pascal
Program ThreadTest;
    {test multi threading capability }
    {
          OUTPUT
    thread 1 started
    thread 1 thri 0 Len(S)= 1
    thread 1 thri 1 Len(S)= 2
    thread 1 thri 2 Len(S)= 3
    thread 1 thri 3 Len(S)= 4
    thread 1 thri 4 Len(S)= 5
    thread 1 thri 5 Len(S)= 6
    thread 1 thri 6 Len(S)= 7
    thread 1 thri 7 Len(S)= 8
    thread 1 thri 8 Len(S)= 9
    thread 1 thri 9 Len(S)= 10
    thread 1 thri 10 Len(S)= 11
    thread 1 thri 11 Len(S)= 12
    thread 1 thri 12 Len(S)= 13
    thread 1 thri 13 Len(S)= 14
    thread 1 thri 14 Len(S)= 15
    thread 2 started
    thread 3 started
    thread 1 thri 15 Len(S)= 16
    thread 2 thri 0 Len(S)= 1
    thread 3 thri 0 Len(S)= 1
    thread 1 thri 16 Len(S)= 17
    ...
    ...
    thread 5 thri 997 Len(S)= 998
    thread 5 thri 998 Len(S)= 999
    thread 5 thri 999 Len(S)= 1000
    thread 5 finished
    thread 10 thri 828 Len(S)= 829
    thread 9 thri 675 Len(S)= 676
    thread 4 thri 656 Len(S)= 657
    thread 10 thri 829 Len(S)= 830
    thread 9 thri 676 Len(S)= 677
    thread 9 thri 677 Len(S)= 678
    thread 10 thri 830 Len(S)= 831
    thread 10 thri 831 Len(S)= 832
    thread 10 thri 832 Len(S)= 833
    thread 10 thri 833 Len(S)= 834
    thread 10 thri 834 Len(S)= 835
    thread 10 thri 835 Len(S)= 836
    thread 10 thri 836 Len(S)= 837
    thread 10 thri 837 Len(S)= 838
    thread 10 thri 838 Len(S)= 839
    thread 10 thri 839 Len(S)= 840
    thread 9 thri 678 Len(S)= 679
    ...
    ...
    thread 4 thri 994 Len(S)= 995
    thread 4 thri 995 Len(S)= 996
    thread 4 thri 996 Len(S)= 997
    thread 4 thri 997 Len(S)= 998
    thread 4 thri 998 Len(S)= 999
    thread 4 thri 999 Len(S)= 1000
    thread 4 finished
    10
          
    }
    
    uses
      {$ifdef unix}cthreads, {$endif} sysutils;
    
    const
      threadcount = 10;
      stringlen = 1000;
    
    var
       finished : longint;
    
    threadvar
       thri : ptrint;
    
    function f(p : pointer) : ptrint;
    var
      s : ansistring;
    begin
      Writeln('thread ',longint(p),' started');
      thri:=0;
      while (thri<stringlen) do begin
        s:=s+'1'; { create a delay }
        writeln('thread ',longint(p),' thri ',thri,' Len(S)= ',length(s));
        inc(thri);
      end;
      Writeln('thread ',longint(p),' finished');
      InterLockedIncrement(finished);
      f:=0;
    end;
    
    
    var
       i : longint;
    
    Begin
       finished:=0;
       for i:=1 to threadcount do
         BeginThread(@f,pointer(i));
       while finished<threadcount do ;
       Writeln(finished);
    End.

TThread 类

以下例子位于 examples/multithreading/ 目录中。

创建多线程应用最简单的方法就是用 TThread 类，能以简单的方式创建一个额外的线程（与主线程并行）。通常仅需重写两个方法：构造函数 Create 和 Execute 方法。

构造函数中需要进行线程运行的准备工作，设置变量或属性的初始值。TThread 的原始构造函数需一个 Suspended 参数。正如其名， Suspended 设为 True 会阻止线程创建后自动启动。如果 Suspended 设为 False，线程在创建后将立即开始运行。如果线程是以挂起状态创建的，则只会在调用 Start 方法后运行。

https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png Note: Resume 方法自FPC 2.4.4 后已弃用，已由 Start 替代。

自 FPC 2.0.1 以后，TThread.Create 还有一个隐式的栈大小参数。可以按需修改所创建线程的默认栈大小。线程中的函数深度递归调用，就是需要扩大栈的很好例子。如未指定栈大小参数，则会采用操作系统的默认大小。

要在线程中执行的代码，通过重写 Execute 方法来完成。

TThread 类有一个重要属性：Terminated : boolean;

如果线程中包含循环（很常见），那么当 Terminated 为 true 时（默认为 false）应退出循环。每次迭代均须检查 Terminated 值，为 true 则应在完成必要的清理工作后尽快退出循环。请记住，Terminate 方法默认不执行任何操作：必须在 Execute 方法中明确实现线程退出工作的机制。 Terminate 方法的工作只是将 Terminated 属性设为 True。

如前所述，线程不应与可视化组件发生交互。对可视化组件的更新必须在主线程中进行。

为实现与主线程的协作，TThread 类提供了 Synchronize 方法。Synchronize 需要一个不带参数的线程内部方法作为参数。以 Synchronize(@MyMethod) 的方式调用 MyMethod 时，线程将暂停运行，MyMethod 的代码将在主线程中调用，然后线程继续运行。

Synchronize 的准确实现方式依不同平台而定，但基本任务是：

TThread 还有一个重要的属性：FreeOnTerminate。如果 FreeOnTerminate 为 true，那么线程停止执行（Execute 方法）后，线程对象会自动释放。否则，应用需手动释放线程。

示例：

pascal
Type
        TMyThread = class(TThread)
        private
          fStatusText : string;
          procedure ShowStatus;
        protected
          procedure Execute; override;
        public
          Constructor Create(CreateSuspended : boolean);
        end;
      constructor TMyThread.Create(CreateSuspended : boolean);
      begin
        inherited Create(CreateSuspended);
        FreeOnTerminate := True;
      end;
    
      procedure TMyThread.ShowStatus;
      // 本方法由主线程执行，因此可以访问所有 GUI 元素。
      begin
        Form1.Caption := fStatusText;
      end;
     
      procedure TMyThread.Execute;
      var
        newStatus : string;
      begin
        fStatusText := 'TMyThread Starting...';
        Synchronize(@Showstatus);
        fStatusText := 'TMyThread Running...';
        while (not Terminated) and ([????????????]) do
          begin
            ...
            [here goes the code of the main thread loop]
            ...
            if NewStatus <> fStatusText then
              begin
                fStatusText := newStatus;
                Synchronize(@Showstatus);
              end;
          end;
      end;

在应用程序中，

pascal
var
        MyThread : TMyThread;
      begin
        MyThread := TMyThread.Create(True); // 这样线程就不会自动启动
        ...
        [???????????????????????????????????????????????????]
        ...
        MyThread.Start;
      end;

若要应用更加灵活，可为线程创建一个事件；这样同步方法就不会与哪个窗体或类绑在一起：可在线程事件上绑定监听器。下面给出一个示例：

pascal
Type
        TShowStatusEvent = procedure(Status: String) of Object;
    
        TMyThread = class(TThread)
        private
          fStatusText : string;
          FOnShowStatus: TShowStatusEvent;
          procedure ShowStatus;
        protected
          procedure Execute; override;
        public
          Constructor Create(CreateSuspended : boolean);
          property OnShowStatus: TShowStatusEvent read FOnShowStatus write FOnShowStatus;
        end;
    
      constructor TMyThread.Create(CreateSuspended : boolean);
      begin
        inherited Create(CreateSuspended);
        FreeOnTerminate := True;
      end;
    
      procedure TMyThread.ShowStatus;
      // 本方法由主线程执行，因此可以访问所有 GUI 元素。
      begin
        if Assigned(FOnShowStatus) then
        begin
          FOnShowStatus(fStatusText);
        end;
      end;
    
      procedure TMyThread.Execute;
      var
        newStatus : string;
      begin
        fStatusText := 'TMyThread Starting...';
        Synchronize(@Showstatus);
        fStatusText := 'TMyThread Running...';
        while (not Terminated) and ([any condition required]) do
          begin
            ...
            [here goes the code of the main thread loop]
            ...
            if NewStatus <> fStatusText then
              begin
                fStatusText := newStatus;
                Synchronize(@Showstatus);
              end;
          end;
      end;

应用程序中的代码：

pascal
Type
        TForm1 = class(TForm)
          Button1: TButton;
          Label1: TLabel;
          procedure FormCreate(Sender: TObject);
          procedure FormDestroy(Sender: TObject);
        private
          { private declarations }
          MyThread: TMyThread; 
          procedure ShowStatus(Status: string);
        public
          { public declarations }
        end;
    
      procedure TForm1.FormCreate(Sender: TObject);
      begin
        inherited;
        MyThread := TMyThread.Create(true);
        MyThread.OnShowStatus := @ShowStatus;
      end;
    
      procedure TForm1.FormDestroy(Sender: TObject);
      begin
        MyThread.Terminate;
    
        // FreeOnTerminate 为 true，因此不应再放置释放代码：
        // MyThread.Free;
        inherited;
      end;
    
      procedure TForm1.Button1Click(Sender: TObject);
      begin
       MyThread.Start;
      end;
    
      procedure TForm1.ShowStatus(Status: string);
      begin
        Label1.Caption := Status;
      end;

特别注意事项

Windows 栈检查

在 Windows 中使用线程时，如果启用了 -Ct（栈检查）开关，可能会遇到一个令人头疼的问题。原因尚不明，如果用了默认堆栈大小，那么在每次调用 TThread.Create 时都会“触发”栈检查。目前唯一的变通办法就是不启用 -Ct 开关。请注意，异常不是在主线程中触发，而是在新建的线程中。于是会造成线程就像是未曾启动。

以下是一段良好的代码，用于检查这种情况以及线程创建过程中可能发生的其他异常：

pascal
MyThread := TThread.Create(False);
    
    if Assigned(MyThread.FatalException) then
      raise MyThread.FatalException;

上述代码确保线程创建过程中的所有异常都会在主线程中触发。

Windows 的 GetDC 函数

GetDC（及 GetDCEx）函数用于检索指定窗口区域或整个屏幕的设备上下文（DC）句柄。比如可用于屏幕截图。但请注意，GetDC 不是线程安全函数：根据文档说明，设备上下文句柄任何时候只能由一个线程使用。

多线程软件包

用到多线程的软件包，应在自定义选项中添加 -dUseCThreads 标志。打开包编辑器，然后选择“选项>用法（Usage）>自定义”，加入 -dUseCThreads。这样将为使用此软件包的所有项目和包（包括 IDE）定义此标志。IDE 及其创建的所有新应用已在 .lpr 文件中包含了以下代码：

pascal
uses
      {$IFDEF UNIX}{$IFDEF UseCThreads}
      cthreads,
      cmem, // the c memory manager is on some systems much faster for multi-threading
      {$ENDIF}{$ENDIF}

Heaptrc

在用到 cmem 单元时不能启用 -gh 开关。-gh 开关会用到 heaptrc 单元，而 heaptrc 单元对堆管理器的代码做了扩充。因此，在引用 cmem 单元时，heaptrc 单元必须加在后面 。

pascal
uses
      {$IFDEF UNIX}{$IFDEF UseCThreads}
      cthreads,
      cmem, // the c memory manager is on some systems much faster for multi-threading
      {$ENDIF}{$ENDIF}
      heaptrc,

线程的初始化和终止

若要对线程对象本身进行初始化，可以用挂起状态启动并设置属性，也可以新建一个构造函数并调用继承的构造函数。

注意 ：如 CreateSuspended=false，则使用 AfterConstruction 是很危险的，因为线程已经启动了。

析构函数则可用于释放对象所占资源。

pascal
type
      TMyThread = class(TThread)
      private
        fRTLEvent: PRTLEvent;
      public
        constructor Create(SomeData: TSomeObject;  CreateSuspended: boolean);
        destructor Destroy; override;
      end;
    
    constructor TMyThread.Create(SomeData: TSomeObject; CreateSuspended: boolean);
    begin
      // 示例：设置事件、临界区、其他文件或数据库连接之类的资源
      RTLEventCreate(fRTLEvent);
      inherited Create(CreateSuspended);
    end;
    
    destructor TMyThread.Destroy;
    begin
      RTLeventDestroy(fRTLEvent);
      inherited Destroy;
    end;

非 LCL 程序

TThread.Synchronize 需要主线程定期调用 CheckSynchronize。LCL 会在事件循环中进行调用。如果不使用 LCL 的事件循环，那就必须自行完成调用。

SMP支持

好消息是，如果你的应用程序在多线程上工作正常，看来SMP已经启用。

Lazarus 调试多线程应用

Lazarus 的调试需要 GDB，并且其功能正在迅速变得更加全面和稳定。但仍有一些 Linux 版本存在问题。

调试时的输出

在单线程应用中，写入控制台/终端/其他输出设备都很简单，并且输出顺序与写入顺序相同。但多线程应用中的情况要复杂得多。如果两个线程同时写入，比如线程A先写一行，线程B再写一行，这两行不一定会按这个顺序写入。甚至可能一个线程在输出时，另一个线程也在写入。在 Linux 下，DebugLn() 输出（可能）会得到正确顺序 。但在 Win32 下，由于是在主线程之外使用 DebugLn()，可能会引发异常（可能是 DiskFull）。因此，为了避免麻烦，请使用以下 DebugLnThreadLog()。

LCLProc 单元中有几个函数，可供每个线程写入自己的日志文件：

pascal
procedure DbgOutThreadLog(const Msg: string); overload;
      procedure DebuglnThreadLog(const Msg: string); overload;
      procedure DebuglnThreadLog(Args: array of const); overload;
      procedure DebuglnThreadLog; overload;

比如，不用 writeln('Some text ',123); 而是用

pascal
DebuglnThreadLog(['Some text ',123]);

这样就会在 Log <PID>.txt 文件中追加一行 'Some text 123'，其中 <PID> 是当前线程的进程 ID。

在每次运行线程前删除日志文件，是个好办法：

pascal
rm -f Log* && ./project1

Linux

若要在 Linux 中调试多线程应用，会碰到一个大问题：X Windows 的桌面管理器可能会挂起 。比如应用捕获了鼠标/键盘并被 gdb 暂停时就会发生这种情况，此时 X 系统会等待应用响应。这时只要从另一台计算机登录并杀掉 gdb 即可，或者按 CTRL+ALT+F3 退出会话并杀掉 gdb。另外也可以重启窗口管理器：输入 sudo /etc/init.d/gdm restart，会重新回到桌面。

gdb 停止应用程序的时机不一定每次都一样，因此有些技巧还是有用的：Ubuntu x64 系统下可设置一下项目的选项，以便获得调试所需的额外信息文件……

pascal
????????????->???????????????->????????????????????????????????????????????????(-Xg)??????

另一种做法是再开一个X桌面，一个桌面运行 IDE/gdb，另一个桌面运行应用程序，这样只会挂起调试的桌面。用以下命令新建 X 实例：

pascal
X :1 &

这样就会新开一个桌面，切换到另一个桌面（比如按 CTRL+ALT+F7）时，就能按 CTRL+ALT+F8 返回新开的桌面（如果组合键不起作用，尝试按CTRL+ALT+F2 …… 在 Slackware 中是有效的）。

然后即可创建桌面会话如下：

pascal
gnome-session --display=:1 &

然后，在 Lazarus 中，在项目的“运行参数”对话框中，勾选“使用显示”并输入 :1。

应用将运行于第二个 X 服务上，且可在第一个 X 服务上进行调试。

已在 Windows 和 Linux 中 Free Pascal 2.0 和 Lazarus 0.9.10 通过测试。

不新开 X 会话的话，还可以使用 Xnest。Xnest 是运行于窗口上的 X 会话。调试线程时使用了 Xnest，X 服务就不会锁住，而且不用来回切换终端，调试起来更加容易。

运行 Xnest 的命令行：

pascal
Xnest :1 -ac

以上将在:1创建一个 X 会话，并禁用访问控制。

Lazarus 界面组件的接口

Win32、gtk 和 carbon 接口都支持多线程，就是说 TThread、临界区和 Synchronize 都能用。但这些接口并不是线程安全的，就是说一次只能有一个线程访问 LCL。并且由于主线程永远不允许等待其他线程，就是说只有主线程才能访问 LCL，包括所有与 TControl、Application 和 LCL 控件句柄相关的操作。LCL 中有一些函数是线程安全的，比如 FileUtil 单元中的大多数函数。

利用 SendMessage/PostMessage 进行线程间通信

一个应用应该只有一个线程（通常是主线程）会去调用 LCL API。其他线程可以通过多种间接方法使用 LCL，其中一种不错的做法就是利用 SendMessage 或 PostMessage。LCLIntf.SendMessage 和 LCLIntf.PostMessage 会一条带有窗口指向的消息送入应用的消息池。

关于这两个函数，请参看以下文档：

SendMessage 和 PostMessage 的区别在于，将控制权交回调用线程的方式。与 Synchronize 类似，SendMessage 会阻塞调用线程，直到目标窗口完成消息处理后才返回控制权；但在某些情况下，SendMessage 可能需要待在调用线程的上下文中进行优化操作。而 PostMessage 则会立即返回控制权，只要排队的消息数量不超过系统定义的最大值，并且堆上仍有填加数据的空间。

无论采用哪种发送方式，在消息处理函数中（见下文）都应避免调用 application.ProcessMessages，因为可能会导致再发送一次消息，消息将递归处理。如果无法避免，那么最好采用其他机制在线程之间传递串行事件。

以下是一个示例，展示了辅助线程如何将文本发给主线程，显示于 LCL 控件中：

pascal
const
      WM_GOT_ERROR           = LM_USER + 2004;
      WM_VERBOSE             = LM_USER + 2005;
    
    procedure VerboseLog(Msg: string);
    var
      PError: PChar;
    begin
      if MessageHandler = 0 then Exit;
      PError := StrAlloc(Length(Msg)+1);
      StrCopy(PError, PChar(Msg));
      PostMessage(formConsole.Handle, WM_VERBOSE, Integer(PError), 0);
    end;

下面是处理窗口消息的示例：

pascal
const
      WM_GOT_ERROR           = LM_USER + 2004;
      WM_VERBOSE             = LM_USER + 2005;
    
    type
      { TformConsole }
    
      TformConsole = class(TForm)
        DebugList: TListView;
        // ...
      private
        procedure HandleDebug(var Msg: TLMessage); message WM_VERBOSE;
      end;
    
    var
      formConsole: TformConsole;
    
    implementation
    
    ....
    
    { TformConsole }
    
    procedure TformConsole.HandleDebug(var Msg: TLMessage);
    var
      Item: TListItem;
      MsgStr: PChar;
      MsgPasStr: string;
    begin
      MsgStr := PChar(Msg.wparam);
      MsgPasStr := StrPas(MsgStr);
      Item := DebugList.Items.Add;
      Item.Caption := TimeToStr(SysUtils.Now);
      Item.SubItems.Add(MsgPasStr);
      Item.MakeVisible(False);
    
    // 下面可干点事情，比如：
    
      TrayControl.SetError(MsgPasStr);
      StrDispose(MsgStr)
    end;
    
    end.

如果在 Linux x64 机器上遇到错误：“Project XY raised exception class 'External: SIGSEGV'”时，就得将“VerboseLog”中的“Integer(PError)”修改为“PtrInt(PError)”。修改后的这行代码应如下所示：

pascal
PostMessage(formConsole.Handle, WM_VERBOSE, PtrInt(PError), 0);

临界区（critical section）

临界区 是一个对象，用于确保某部分代码在任何时候只能由一个线程执行。临界区在使用前需要创建/初始化，在不用时需释放。

临界区有两种使用方式，RTL 或 LCL。以下给出 RTL 的用法，平替的 LCL 方式则以注释的形式给出，唯一区别就是方法名不同。

使用临界区时通常如下引入：

pascal
// uses LCLIntf, LCLType;

所需的 RTL 单元几乎都可涵盖。

声明（对所有要访问临界区的线程而言，是全局变量）：

pascal
MyCriticalSection: TRTLCriticalSection;   
    // MyCriticalSection : TCriticalSection;

创建：

pascal
InitCriticalSection(MyCriticalSection);
    //InitializeCriticalSection(MyCriticalSection);

运行一些线程。独占地执行某些操作：

pascal
EnterCriticalSection(MyCriticalSection);
    try
      // 访问变量、写入文件、发送网络包等
    finally
      LeaveCriticalSection(MyCriticalSection);
    end;
    // RTL 和 LCL 的语法相同，不错吧。

所有线程结束后，释放临界区：

pascal
DoneCriticalSection(MyCriticalSection); 
    // DeleteCriticalSection(MyCriticalSection);

另一种方案是使用 TCriticalSection 对象。对象创建即初始化，Enter 方法执行 EnterCriticalSection 操作，Leave 方法执行 LeaveCriticalSection 操作，而对象销毁则执行删除操作。

请注意，临界区无法防止同一线程多次进入同一块代码，而只能防止不同线程同时进入。因此，临界区不能用于防止消息处理函数的重入（请参阅前文）。

示例：5个线程同时递增1个计数器。 请参阅 lazarus/examples/multithreading/criticalsectionexample1.lpi。

Warning-icon.png

Warning: 上述4个函数分成了两组，分别由 RTL 和 LCL 提供。LCL 的函数在 LCLIntf 和 LCLType 单元中定义。这两组函数的工作方式大致相同，应用程序中可以同时使用，但不得在 LCL 临界区内使用 RTL 函数，反之亦然。

共享变量

如果有多个线程共享一个只读变量，那没什么可担心的。直接读就是了。 但如果有一个或多个线程要修改变量值，那就必须确保每次只有一个线程能够访问。

示例：5个线程递增1个计数器。 参见 lazarus/examples/multithreading/criticalsectionexample1.lpi

等待其他线程

如果线程A需要用到线程B的运行结果，那就必须等待至线程B完成。

重要： 主线程绝不能等待其他线程，而应使用 Synchronize 方法（参见前文）。

示例参见：lazarus/examples/multithreading/waitforexample1.lpi

pascal
{ TThreadA }
    
    procedure TThreadA.Execute;
    begin
      Form1.ThreadB:=TThreadB.Create(false);
      // 创建事件
      WaitForB:=RTLEventCreate;
      while not Application.Terminated do begin
        // 一直等待，直至线程B唤醒A
        RtlEventWaitFor(WaitForB);
        writeln('A: ThreadB.Counter='+IntToStr(Form1.ThreadB.Counter));
      end;
    end;
    
    { TThreadB }
    
    procedure TThreadB.Execute;
    var
      i: Integer;
    begin
      Counter:=0;
      while not Application.Terminated do begin
        // 线程 B 执行任务
        Sleep(1500);
        inc(Counter);
        // 唤醒线程 A
        RtlEventSetEvent(Form1.ThreadA.WaitForB);
      end;
    end;

https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png Note: RtlEventSetEvent可在 RtlEventWaitFor 之前调用。RtlEventWaitFor 将立即返回。可用 RTLeventResetEvent 清除标志。

Fork

多线程应用在创建子进程时，请注意在 fork（或 fpFork）调用之前 创建并运行的所有线程均不会在子进程中运行。正如 fork() 手册所述，任何在 fork 调用之前运行的线程，状态将是未定义。

因此，请注意在 fork 调用之前初始化的任何线程（包括 initialization 部分中的线程）都不会 工作。

并行过程/循环

多线程的一个特例是并行运行单个过程。请参见并行过程。

分布式计算

多线程的更高境界是在多台机器上运行这些线程。

外部线程

为了让 Free Pascal 的线程系统能够正常运转，新建 FPC 线程都需要进行初始化（更准确地说，每个线程的异常、I/O系统和 threadvar 系统都需要初始化，以确保本地变量和内存堆能正常工作）。如果使用了 BeginThread（或通过 TThread 类间接使用了），那么这些初始化工作都会自动完成。但如果用到的线程不是由 BeginThread 创建的（即外部线程），则（目前）可能需要多做一些初始化的工作。外部线程还包括在外部 C 语言库（.DLL/.so）中创建的线程。

以下是使用外部线程时需要考虑的事项（可能并非所有版本编译器都需要考虑）：

如果调用约定不合适（比如原线程函数遵守 cdecl 调用方式，而 BeginThread 是 pascal 调用方式），则可以创建一个记录，存入需调用的原线程函数，并在 pascal 线程函数中调用，如下所示：

pascal
type
     TCdeclThreadFunc = function (user_data:Pointer):Pointer;cdecl;
    
     PCdeclThreadFuncData = ^TCdeclThreadFuncData;
     TCdeclThreadFuncData = record
       Func: TCdeclThreadFunc;  //cdecl 函数
       Data: Pointer;           //原数据
     end;
    
    // Pascal 线程调用 cdecl 函数
    function C2P_Translator(FuncData: pointer) : ptrint;
    var
      ThreadData: TCdeclThreadFuncData;
    begin
      ThreadData := PCdeclThreadFuncData(FuncData)^;
      Result := ptrint(ThreadData.Func(ThreadData.Data));
    end;
    
    procedure CreatePascalThread;
    var
      ThreadData: PCdeclThreadFuncData;
    begin
      New(ThreadData);
      // 下面是需调用的 cdecl 线程函数
      ThreadData^.Func := func;
      ThreadData^.Data := user_data;
      // 创建 Pascal 线程
      BeginThread(@C2P_Translator, ThreadData );
    end;
pascal
type
       tc = class(tthread)
         procedure execute;override;
       end;
    
       procedure tc.execute;
       begin
       end;
    
    { main program } 
    begin
      { initialise threading system }
       with tc.create(false) do
       begin
         waitfor;
         free;
       end;
       { ... 下面是自己的代码 } 
    end.

（线程系统初始化后，运行时可能会将系统变量“IsMultiThread”置为 true，FPC 函数利用此变量执行各种加解锁操作。此变量不得自行改动。）

pascal
function ExternalThread(param: Pointer): LongInt; stdcall;
    var
      tm: TThreadManager;
    begin
      GetThreadManager(tm);
      tm.AllocateThreadVars;
      InitThread(1000000); // 在此调整初始栈的大小
      
      { 线程工作代码 ... }
        
      Result:=0;
    end;

识别外部线程

有时甚至不知道是否要处理外部线程（如某些 C 语言库带了回调函数）。以下步骤有助于开展分析：

1. 应用启动后，向操作系统查询当前线程的ID。

pascal
GetCurrentThreadID() // Windows;
    GetThreadID() // Darwin (macOS); FreeBSD;  
    TThreadID(pthread_self) // Linux;

2. 在线程函数内部再次查询当前线程的 ID，与第1步的查询结果进行比较。

放弃一些时间片

ThreadSwitch - 注：可忽略。

https://upload.wikimedia.org/wikipedia/commons/d/d8/Nuvola_apps_ktip.png Note: 不要使用 Windows 特有的技巧 Sleep(0)，因为不适用于全部平台。

参阅

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.

版本4，最后由WikiArchive于修改。