如何让Delphi7线程在Windows关机/重启/注销前执行？

阿华AIGC实验室

2026-5-20

问题分析与解决方案

这个场景我之前也遇到过，核心原因很明确：Windows发送WM_QUERYENDSESSION消息后，留给程序的收尾时间非常有限——你的新线程刚创建启动，还没来得及调度执行，系统就已经继续关机流程、终止程序了。而直接调用AddToLog是同步执行，会立即完成，所以能正常写入日志。

下面给你两种可行的解决思路，根据你的实际操作耗时选择：

方案一：同步执行收尾操作（优先推荐，适用于快速操作）

如果你的SQLite保存操作本身很轻量化（比如只是写入少量数据），最直接的办法就是取消线程，在WM_QUERYENDSESSION里同步执行保存逻辑。这样能确保操作在系统终止程序前完成：

procedure TfrmMain.WMQueryEndSession(var AMsg: TMessage);
begin
  inherited;
  // 直接同步执行保存，避免线程异步的延迟
  AddToLog('Windows is about to shutdown/reboot/logoff!');
  // 这里可以添加你的SQLite保存代码
  AMsg.Result := 1;
end;

方案二：阻止关机直到线程完成（适用于耗时操作）

如果你的保存操作确实需要线程处理（比如数据量较大、耗时较长），可以通过Windows API告诉系统“我还在收尾，请等我一下”。具体步骤如下：

1. 声明所需的Windows API函数

Delphi 7的默认Windows单元没有包含这些函数，需要手动声明：

interface

// ...

function ShutdownBlockReasonCreate(hWnd: HWND; pwszReason: LPCWSTR): BOOL; stdcall; external 'user32.dll';
function ShutdownBlockReasonDestroy(hWnd: HWND): BOOL; stdcall; external 'user32.dll';

type
  TfrmMain = class(TForm)
    // ...
  private
    FSaveThread: TSaveText;
    procedure WMQueryEndSession(var AMsg: TMessage); message WM_QUERYENDSESSION;
    procedure WMEndSession(var AMsg: TMessage); message WM_ENDSESSION;
    procedure SaveThreadTerminated(Sender: TObject);
    // ...
  end;

2. 修改消息处理逻辑

procedure TfrmMain.WMQueryEndSession(var AMsg: TMessage);
begin
  inherited;
  // 告诉Windows我们需要延迟关机，同时显示提示给用户
  ShutdownBlockReasonCreate(Handle, '正在保存数据，请稍候...');

  // 创建线程，禁用FreeOnTerminate，以便我们手动管理和等待
  FSaveThread := TSaveText.Create(True);
  FSaveThread.FText := 'Windows is about to shutdown/reboot/logoff!';
  FSaveThread.OnTerminate := SaveThreadTerminated;
  FSaveThread.Resume;

  // 返回0，通知系统暂时不允许关机
  AMsg.Result := 0;
end;

procedure TfrmMain.SaveThreadTerminated(Sender: TObject);
begin
  try
    // 线程执行完成，取消关机阻止
    ShutdownBlockReasonDestroy(Handle);
    // 通知系统可以继续关机流程
    SendMessage(Handle, WM_QUERYENDSESSION, 1, 0);
  finally
    FSaveThread.Free;
    FSaveThread := nil;
  end;
end;

procedure TfrmMain.WMEndSession(var AMsg: TMessage);
begin
  inherited;
  // 兜底：如果系统强制终止前线程还在运行，等待它完成
  if Assigned(FSaveThread) then
  begin
    FSaveThread.WaitFor;
    FSaveThread.Free;
    FSaveThread := nil;
  end;
end;