关于多线程：在Delphi中检测辅助线程上下文


Detecting secondary thread context in Delphi

在 Delphi 2009 和 Windows API 中，有没有办法检测特定代码段是否在辅助线程的上下文中运行？在伪代码中，我想说：

1
2
3
4
5
6
7
procedure DoSomething;
begin
  if InvokedBySecondaryThread then
    DoIt_ThreadSafeWay
  else
    DoIt_RegularWay;
end;

这是一个我编写并使用多年的日志库，现在我正在尝试适应可以从多个线程调用一个过程的情况。我的"常规方式"不是线程安全的。我知道如何使它成为线程安全的，但我只想在实际需要时才使用线程安全方法。

解释(非必读：-)

它归结为使用 SendMessage 和 PostMessage 将记录的消息发送到多个接收器之间的选择，例如日志文件、控制台或 VCL 控件。使用 PostMessage 意味着在长时间的阻塞操作正在进行时将不会收到消息，这在一定程度上违背了记录的目的，尤其是。用于指示进度时。我想我可以用一个关键部分来保护 SendMessage 调用，但我更愿意只在真正需要时才这样做。

我知道 system.pas 中的全局变量 IsMultiThread，但这只会告诉我应用程序已启动辅助线程。这些可能是由 3rd 方库创建的线程，因此它们永远不会访问"我的"代码，因此它们的存在不会影响我的日志记录逻辑。

我真的希望我可以使用相同的低级库代码，无论它是从一个线程还是多个线程调用。例如，从辅助线程内部调用修改后的线程安全日志记录过程会很容易，但这会重复很多代码，而且我仍然必须记住始终做正确的事情。

@Lieven：目前，日志记录逻辑是这样的，有点简化

我希望日志记录尽可能轻松，只需最少的设置代码并且不用担心管理对象的生命周期，因此该库只公开了一些重载的帮助程序，例如

1
2
3
procedure Log( const msgText : string; level : TLogLevel = lvNotice ); overload;
procedure Log( const msgText : string; Args : array of const; level : TLogLevel = lvNotice ); overload;
etc, including specialized routines that log a StringList, a boolean, an Exception and so on

几乎所有其他事情都发生在单元的实现中。所有的辅助例程最终都会调用

1
procedure _LogPostMessage( const msgText : string; level : TLogLevel );

which (a) 检查单例调度程序对象是否已初始化； (b) 创建 TLogMessagePacket 对象的实例(消息文本、时间戳等的容器)，最后 (c) 执行 SendMessage 或 PostMessage 以将"数据包"发送到调度程序(它有一个窗口句柄收到)。

然后是一组从抽象 TLogReceiver 类派生的类。一个这样的类接收记录的消息并将它们写入文件，另一个更新 TMemo 等。我实例化我想在项目中使用的具体接收器，并将它们注册到调度程序，调度程序从那时起拥有它们。

当调度程序收到消息"数据包"时，它会依次将它交给每个接收者，然后释放它。

所以我可能固定在上述思维方式中，这就是为什么当你说将调度程序对象交给日志库的代码应该根据线程上下文选择一个时，我不太明白你的想法。调度器确实是库的主要引擎，一次只存在一个。

相关讨论

1
2
3
4
5
6
  if GetCurrentThreadID = MainThreadID then begin
// in main thread
  end
  else begin
// in secondary thread
  end;
相关讨论

应您的要求，我添加了一些示例代码来说明我的意思。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
interface
  procedure Log( const msgText : string; level : TLogLevel = lvNotice; dispatcher: IDispatcher = nil); overload;
...

implementation    

  procedure Log( const msgText : string; level : TLogLevel = lvNotice; dispatcher: IDispatcher = nil); overload;
  var
    dp: IDispatcher;
  begin
    if dispatcher = nil then dp := CreateDefaultDispatcher
    else dp := dispatcher;

    dp.msgText := msgText;
    dp.level := level;
    ...
  end;

procedure _LogPostMessage( dispatcher: IDispatcher );
begin
  dispatcher.LogPostMessage            
end;

现在这给你带来了什么？

除了已经指出的增加了复杂性之外，并没有太多，但它使_LogPostMessage 的测试更容易。

这样看：你将如何编写单元测试来验证消息确实被发布了？