Delphi7 MDI应用线程问题：执行线程时UI无法操作

我维护一款基于Delphi7开发的数据库MDI应用已有15年，日常增删查改数据均正常。近日需开发一个计算数据相关性的报表，因计算逻辑密集会阻塞UI，故采用独立线程执行计算，线程完成后通过消息通知主程序打开子窗口展示结果，未使用Synchronize方法。

但线程执行期间，若尝试打开其他窗体，整个应用会挂起且无法恢复，失去了使用线程的意义。线程内已创建独立数据库连接，排除此问题。

线程调用代码：

DoCorrelThread (id1, id2, fdt, caption + ' ' + cbFromDate.text + ' Scale A = ' +
                            cbA.text + ', Scale B = ' + cbB.text, HandleTerminate);

HandleTerminate为调用窗体的公共过程，目前仅用于阻止窗体关闭，未解决根本问题。

以下是复现问题的线程代码（已移除计算逻辑）：

unit correlthread;
interface

uses Windows, classes, DB, FMTBcd, SqlExpr, dbclient, messages, 
 sysutils, IBDatabase, IBCustomDataSet, IBQuery, Registry;

Procedure DoCorrelThread (ascale1, ascale2: longint; adt: tdatetime;
                      const atitle: string; proc: TMyProc);

implementation
type
 TCorrelThread = class (TThread)
 private
  scale1, scale2: longint;
  fdt: tdatetime;
  title: string;
  procedure Execute; override;
 public
  constructor Create (ascale1, ascale2: longint; adt: tdatetime;
                      const atitle: string; proc: TMyProc); reintroduce;
end;

constructor TCorrelThread.Create (ascale1, ascale2: longint; adt: tdatetime;
                              const atitle: string; proc: TMyProc);
begin
 inherited Create (true);
 FreeOnTerminate:= True;
 OnTerminate:= proc;
 scale1:= ascale1;
 scale2:= ascale2;
 fdt:= adt;
 title:= atitle;
 resume;
end;

procedure TCorrelThread.Execute;
var
 i, j, instance: integer;
 qTemp, qNewInstance: TIBQuery;
 ibdb: TIBDatabase;
 trans: TIBTransaction;

begin
 ibdb:= TIBDatabase.Create (nil);
 with TRegIniFile.create ('\software\nbn') do
  begin
   ibdb.databasename:= ReadString ('firebird', 'q4admin', '');
   free
  end;

 with ibdb do
  begin
   loginprompt:= false;
   params.add ('password=masterkey');
   params.add ('user_name=sysdba');
   sqldialect:= 1;
   connected:= true;
  end;

 trans:= TIBTransaction.create (nil);
 trans.defaultdatabase:= ibdb;
 qNewInstance:= TIBQuery.create (nil);
 qNewInstance.database:= ibdb;
 qNewInstance.Transaction:= trans;
 qNewInstance.sql.add ('select max (instance) from temp');

 qTemp:= TIBQuery.create (nil);
 qTemp.database:= ibdb;
 qTemp.transaction:= trans;
 qTemp.SQL.add ('insert into temp (instance, id, payload)');
 qTemp.sql.add ('values (:p1, :p2, :p3)');

 for i:= 1 to 100 do  // do something that takes some time
  begin
   qNewInstance.Open;
   instance:= qNewInstance.Fields[0].asinteger + 1;
   qNewInstance.Close;
   trans.active:= false;

   for j:= 1 to 100 do
    begin
     trans.StartTransaction;
     qTemp.Params[0].asinteger:= instance;
     qTemp.params[1].asinteger:= j;
     qTemp.params[2].asinteger:= i;
     qTemp.ExecSQL;
     trans.Commit;
     trans.active:= false;
    end;
  end;

 trans.free;
 ibdb.free;
 sendmessage (mainhandle, WM_ShowCorrel, instance, 0);
end;
Procedure DoCorrelThread (ascale1, ascale2: longint; adt: tdatetime;
                          const atitle: string; proc: TMyProc);
begin
 TCorrelThread.Create (ascale1, ascale2, adt, atitle, proc);
end;

end.

代码功能正常，但线程执行时整个应用UI无法操作，请问问题出在哪里？

核心问题集中在IBX组件的线程特性、消息发送方式和事务操作逻辑三个方面：

1. SendMessage同步消息导致死锁 #

你在线程末尾使用的SendMessage是同步消息机制，它会等待主线程处理完这条消息后才会返回。如果主线程此时因等待子线程的资源锁（比如IBX组件内部的全局锁）无法响应消息，就会触发双向死锁，直接导致整个应用挂起。

修复：把SendMessage替换为异步的PostMessage，它不会等待主线程响应，直接把消息放入消息队列后就返回：

PostMessage(mainhandle, WM_ShowCorrel, instance, 0);

2. Delphi7 IBX组件的线程安全缺陷 #

Delphi7自带的IBX（InterBase eXpress）组件并非完全线程安全，即使你创建了独立的数据库连接，组件内部仍可能存在全局初始化逻辑、资源锁等依赖主线程的操作。当子线程频繁调用IBX组件时，容易和主线程的VCL消息循环产生锁竞争，导致UI阻塞。

修复：

• 确保所有IBX组件（TIBDatabase、TIBTransaction、TIBQuery）的创建、使用、销毁完全在子线程内完成，绝对不要和主线程的IBX组件共享任何资源；
• 避免在子线程中触发IBX组件的任何VCL相关事件（比如AfterOpen这类可能回调主线程的事件）。

3. 高频事务操作加剧锁竞争 #

你在循环里每次都单独开启、提交事务，100次外层循环+100次内层循环，总共会执行10000次事务开关操作。这种高频的数据库交互会让IBX组件频繁触发内部同步逻辑，进一步加剧和主线程的锁竞争。

修复：合并内层循环的事务，把100条插入操作放到同一个事务中提交，大幅减少事务操作次数：

for i:= 1 to 100 do
begin
  qNewInstance.Open;
  instance:= qNewInstance.Fields[0].asinteger + 1;
  qNewInstance.Close;
  trans.active:= false;

  trans.StartTransaction; // 单次开启事务
  for j:= 1 to 100 do
  begin
    qTemp.Params[0].asinteger:= instance;
    qTemp.params[1].asinteger:= j;
    qTemp.params[2].asinteger:= i;
    qTemp.ExecSQL;
  end;
  trans.Commit; // 单次提交100条数据
  trans.active:= false;
end;

4. 线程启动方式的小细节 #

虽然TThread.Create(true)+Resume本身没问题，但结合IBX组件的初始化逻辑，可能在启动瞬间就触发了主线程的同步操作。可以直接用Create(false)创建并启动线程，避免额外的挂起/恢复步骤：

constructor TCorrelThread.Create (ascale1, ascale2: longint; adt: tdatetime;
                              const atitle: string; proc: TMyProc);
begin
 inherited Create (false); // 直接启动线程
 FreeOnTerminate:= True;
 OnTerminate:= proc;
 scale1:= ascale1;
 scale2:= ascale2;
 fdt:= adt;
 title:= atitle;
end;

内容的提问来源于stack exchange，提问作者No'am Newman