在Delphi中检测第二个线程上下文

Question

在Delphi 2009和Windows API中，有没有一种方法可以检测特定代码是否在辅助线程的上下文中运行？以伪代码表示，我希望能够说：

procedure DoSomething;
begin
  if InvokedBySecondaryThread then
    DoIt_ThreadSafeWay
  else
    DoIt_RegularWay;
end;

这是我写的一个日志库，我已经使用了多年，并且现在正在尝试将其适应于可以从多个线程调用的情况。我的“常规方式”不是线程安全的。我知道如何使其线程安全，但我只想在真正需要时才使用线程安全的方法。

解释（非必读）：

这归结为使用SendMessage和PostMessage之间的选择来将记录的消息分派给多个接收器，例如日志文件、控制台或VCL控件。使用PostMessage意味着当长时间阻塞操作正在进行时，消息将不会被接收，这在某种程度上破坏了日志记录的目的，特别是在用于指示进度时。我认为我可以使用关键部分保护SendMessage调用，但是我仍然希望只在真正需要时才这样做。

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

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

@Lieven：目前，日志记录逻辑如下，有些简化：

我希望日志记录尽可能轻松，最小化设置代码，无需担心管理对象生命周期，因此库只公开了一些重载的辅助过程，例如

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

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

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

这段代码包含以下步骤：(a) 检查单例调度器对象是否已初始化；(b) 创建一个TLogMessagePacket对象实例（用于存储消息文本、时间戳等信息）；最后(c) 发送“packet”到调度器（该调度器具备窗口句柄以接收消息），采用SendMessage或者PostMessage方法发送。

此外，还有一组继承自抽象类TLogReceiver的子类。其中一个类接收日志信息并将其写入文件，另一个更新TMemo等。在项目中，我使用具体的接收器并向调度器注册它们，从那时起调度器就拥有了它们。

当调度器接收到“packet”消息后，依次将其传递给每个接收器，然后释放它。

因此，我可能被上述思路所限制，这就是为什么当您说要根据线程上下文选择将调度器对象传递给日志库的代码时，我没有完全理解您的想法。调度器实际上是库的主要引擎，并且每次只存在一个。

- Marek Jedliński

---

我认为你没有理解重点。如果在多线程应用程序的主线程中调用你的例程，并且你选择运行不支持多线程的代码，那么它有可能会产生冲突（因为它不支持多线程）。我想你想知道的是调用该例程的应用程序是否是多线程的。 - jachguate

Answer 1

  if GetCurrentThreadID = MainThreadID then begin
// in main thread
  end
  else begin
// in secondary thread
  end; 

- kludg

---

+1 但是 OP 应该考虑在日志库中避免使用这种结构。在我看来，应该给库一个分发消息的对象。将 分发器对象 传递给日志库的代码应该根据线程上下文选择一个。 - Lieven Keersmaekers

@Lieven：我不确定我是否正确地理解了你的建议，但我对更好的解决方案感兴趣。我将在 OP 中添加有关我的当前日志记录流程的简要说明。 - Marek Jedliński

在进行TDD时，我可能会有过分关注“我将如何测试这个”，而忘记了KISS的倾向。你的编辑清楚地表明，使用两个单独的对象来执行实际的Post/SendMessage并没有多大的价值。 - Lieven Keersmaekers

Answer 2

根据您的要求，我添加了一些示例代码以展示我的意思。

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更容易。

从这个角度来看：你将如何编写单元测试来验证确实发布了一条消息？

- Lieven Keersmaekers