Delphi 2007：如何用TIdHTTPServer从数据模块同步更新控制台程序？

原代码问题分析 #

• TIdNotify依赖VCL主线程的消息循环才能触发DoNotify，但控制台程序默认没有启动这个循环，所以你的writeln根本不会执行。
• 内存泄漏：原代码里创建的TLog对象只在异常时才释放，正常执行时会一直留在内存里。
• 线程安全隐患：Indy的HTTP请求事件是在工作线程里触发的，直接调用writeln会导致多线程抢控制台输出，出现内容错乱。

解决方案1：用临界区实现线程安全输出（无依赖轻量化方案） #

这种方式不需要VCL消息循环，适合纯控制台程序，通过临界区保证同一时间只有一个线程写控制台。

完整可运行代码：

program IndyConsoleLogDemo;

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes, IdContext, IdHTTPServer, IdCustomHTTPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPServer;

type
  THTTPServer = class(TDataModule)
    IdHTTPServer1: TIdHTTPServer;
    procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  private
  public
  end;

var
  HTTPServer: THTTPServer;
  LogCriticalSection: TRTLCriticalSection;

// 线程安全的日志输出方法
procedure LogMsg(const AMsg: string);
begin
  EnterCriticalSection(LogCriticalSection);
  try
    Writeln(Format('[%s] %s', [DateTimeToStr(Now), AMsg]));
  finally
    LeaveCriticalSection(LogCriticalSection);
  end;
end;

{ THTTPServer }

procedure THTTPServer.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  LogMsg('收到请求：' + ARequestInfo.Document);
  AResponseInfo.ResponseNo := 200;
  AResponseInfo.ContentText := '请求已处理';
end;

begin
  try
    InitializeCriticalSection(LogCriticalSection);
    try
      HTTPServer := THTTPServer.Create(nil);
      try
        // 配置并启动HTTP服务器
        HTTPServer.IdHTTPServer1.DefaultPort := 8080;
        HTTPServer.IdHTTPServer1.Active := True;
        LogMsg('HTTP服务器已启动，监听端口8080...');
        LogMsg('按Enter键退出程序');
        // 等待用户输入，维持程序运行
        Readln;
      finally
        HTTPServer.Free;
      end;
    finally
      DeleteCriticalSection(LogCriticalSection);
    end;
  except
    on E: Exception do
    begin
      EnterCriticalSection(LogCriticalSection);
      try
        Writeln('错误：' + E.Message);
      finally
        LeaveCriticalSection(LogCriticalSection);
      end;
      Readln;
    end;
  end;
end.

代码说明 #

• 临界区TRTLCriticalSection：把控制台输出操作锁起来，避免多线程同时写导致的内容混乱。
• 日志方法LogMsg：封装了线程安全的输出逻辑，加了时间戳方便排查问题。
• 资源清理：程序退出时会正确释放临界区和数据模块，避免内存泄漏。

解决方案2：用TIdNotify（需添加VCL消息循环） #

如果一定要用TIdNotify，必须给控制台程序加VCL消息循环，因为它的Notify方法是把DoNotify的调用投递到主线程消息队列的。

完整可运行代码：

program IndyConsoleNotifyDemo;

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes, IdContext, IdHTTPServer, IdCustomHTTPServer, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPServer,
  IdSync, Forms; // 引入Forms模块启用VCL消息循环

type
  THTTPServer = class(TDataModule)
    IdHTTPServer1: TIdHTTPServer;
    procedure IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
  private
  public
  end;

  TLog = class(TIdNotify)
  protected
    FMsg: string;
    procedure DoNotify; override;
  public
    class procedure LogMsg(const AMsg: string);
  end;

var
  HTTPServer: THTTPServer;
  TerminateEvent: TEvent;

{ TLog }

procedure TLog.DoNotify;
begin
  // 这里在主线程执行，可安全调用Writeln
  Writeln(Format('[%s] %s', [DateTimeToStr(Now), FMsg]));
end;

class procedure TLog.LogMsg(const AMsg: string);
var
  LNotify: TLog;
begin
  LNotify := TLog.Create;
  try
    LNotify.FMsg := AMsg;
    LNotify.Notify; // 把DoNotify调用投递到主线程消息队列
  except
    LNotify.Free;
    raise;
  end;
  // TIdNotify会在DoNotify执行完自动释放，正常情况不用手动Free
end;

{ THTTPServer }

procedure THTTPServer.IdHTTPServer1CommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
begin
  TLog.LogMsg('收到请求：' + ARequestInfo.Document);
  AResponseInfo.ResponseNo := 200;
  AResponseInfo.ContentText := '请求已处理';
end;

// 手动实现主线程消息循环
procedure MainThreadMessageLoop;
var
  Msg: TMsg;
begin
  while WaitForSingleObject(TerminateEvent.Handle, 0) = WAIT_TIMEOUT do
  begin
    if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
    begin
      TranslateMessage(Msg);
      DispatchMessage(Msg);
    end
    else
      Sleep(10); // 降低CPU占用
  end;
end;

begin
  try
    TerminateEvent := TEvent.Create(nil, True, False, '');
    try
      Application.Initialize; // 初始化VCL环境
      HTTPServer := THTTPServer.Create(nil);
      try
        HTTPServer.IdHTTPServer1.DefaultPort := 8080;
        HTTPServer.IdHTTPServer1.Active := True;
        TLog.LogMsg('HTTP服务器已启动，监听端口8080...');
        TLog.LogMsg('按Enter键退出程序');

        // 开个线程等用户输入，避免阻塞消息循环
        TThread.CreateAnonymousThread(
          procedure
          begin
            Readln;
            TerminateEvent.SetEvent; // 触发退出信号
          end
        ).Start;

        MainThreadMessageLoop; // 运行消息循环
      finally
        HTTPServer.Free;
      end;
    finally
      TerminateEvent.Free;
    end;
  except
    on E: Exception do
    begin
      Writeln('错误：' + E.Message);
      Readln;
    end;
  end;
end.

代码说明 #

• VCL消息循环：引入Forms模块并手动实现消息循环，让TIdNotify的DoNotify能被主线程执行。
• 修复内存泄漏：TIdNotify正常执行后会自动释放，只有异常时才手动释放。
• 优雅退出：用TEvent实现退出信号，用户按Enter后终止消息循环，关闭程序。

注意事项 #

• Delphi 2007默认Indy版本是10.2.3，确保组件已正确安装。
• 优先选方案1，方案2因为引入VCL会增加程序体积，适合必须用TIdNotify的场景。
• 所有控制台输出操作都要做同步处理，否则多线程下必然出现输出错乱。

内容的提问来源于stack exchange，提问作者The Pudding Race