异步 TADOQuery 的 OnFetchComplete 未同步到主线程答案

【问题标题】：Asynchronous TADOQuery's OnFetchComplete not synchronized to main thread异步 TADOQuery 的 OnFetchComplete 未同步到主线程
【发布时间】：2015-09-03 05:28:51
【问题描述】：

当使用TADOQuery 和[eoAsyncFetchNonBlocking] 并附加到OnFetchComplete 事件时，我发现OnFetchComplete 没有在主线程中执行（在XE4 和XE8 中测试）。我认为这是一个错误*，因为我们大多数人都会在 UI 中处理这些类型的事件。我认为这是大型项目中一些问题的根源，我需要一种解决方法。

[编辑] *阅读 ADO 文档后，我承认这可能不是错误，但多线程问题仍然存在。

有没有一种优雅的方法可以强制让这个处理程序中的代码在主线程上执行？我不想使用计时器（但如果这是我会接受的唯一解决方案）。或者，是否有一个我可以在这里等待的 ADO 同步对象或向 ADO 提供者发送某种其他形式的信号？

这里有一个简化的示例来说明问题所在。我的项目更复杂，工厂创建和填充这些数据集，但这里类似于将数据集附加到 ADOQuery1FetchComplete 内的网格。

unit Unit4;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB, Data.Win.ADODB, Vcl.StdCtrls;

type
  TForm4 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    ADOQuery1: TADOQuery;
    ADOConnection1: TADOConnection;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ADOQuery1FetchComplete(DataSet: TCustomADODataSet;
      const Error: Error; var EventStatus: TEventStatus);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    FMainThreadID : DWORD;
  public
    { Public declarations }
  end;

var
  Form4: TForm4;

implementation

{$R *.dfm}

procedure TForm4.ADOQuery1FetchComplete(DataSet: TCustomADODataSet;
  const Error: Error; var EventStatus: TEventStatus);
begin
  Assert(FMainThreadID = GetCurrentThreadId); //this assertion fails!
  // I need UI code here to run  FMainThreadID
end;

procedure TForm4.Button1Click(Sender: TObject);
begin
   ADOQuery1.Open;
end;


procedure TForm4.FormCreate(Sender: TObject);
begin
    FMainThreadID := GetCurrentThreadId;
end;

end.

dfm 只需处理带有ExecuteOptions = [eoAsyncFetchNonBlocking] 和OnFetchComplete 的查询集。

object Form4: TForm4
  Left = 0
  Top = 0
  Caption = 'Form4'
  ClientHeight = 186
  ClientWidth = 258
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 24
    Top = 88
    Width = 75
    Height = 25
    Caption = 'Button1'
    TabOrder = 0
    OnClick = Button1Click
  end
  object ADOQuery1: TADOQuery
    Connection = ADOConnection1
    ExecuteOptions = [eoAsyncFetchNonBlocking]
    OnFetchComplete = ADOQuery1FetchComplete
    Parameters = <>
    SQL.Strings = (
      'SELECT * FROM TABLENAME')
    Left = 144
    Top = 16
  end
  object ADOConnection1: TADOConnection
    Connected = True
    ConnectionString = 
      'Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security In' +
      'fo=False;Initial Catalog=DBNAME;Data Source=.\INSTANCENAME'
    LoginPrompt = False
    Provider = 'SQLOLEDB.1'
    Left = 40
    Top = 16
  end
end

[编辑] 有人建议使用TThread.Sychronize，但这不是 Delphi 线程。

如果GetCurrentThreadId 不足以证明处理程序是从另一个线程调用的，那么这里是主线程和有问题线程的调用堆栈（我在主线程中添加了一个睡眠以进行良好测量）

主线程休眠

:77d0c7bc ntdll.ZwDelayExecution + 0xc
:7745104f KERNELBASE.Sleep + 0xf
Unit6.TForm6.btnQueryClick($32BC00)
Vcl.Controls.TControl.Click
Vcl.StdCtrls.TCustomButton.Click
Vcl.StdCtrls.TCustomButton.CNCommand(???)
Vcl.Controls.TControl.WndProc((48401, 1344, 7275840, 0, 1344, 0, (), 1344, 111, (), 0, 0, ()))
Vcl.Controls.TWinControl.WndProc((48401, 1344, 7275840, 0, 1344, 0, (), 1344, 111, (), 0, 0, ()))
Vcl.StdCtrls.TButtonControl.WndProc((48401, 1344, 7275840, 0, 1344, 0, (), 1344, 111, (), 0, 0, ()))
Vcl.Controls.TControl.Perform(???,???,7275840)
Vcl.Controls.DoControlMsg(???,(no value))
Vcl.Controls.TWinControl.WMCommand((273, (), 1344, 0, (), 7275840, 0))
Vcl.Forms.TCustomForm.WMCommand((273, (), 1344, 0, (), 7275840, 0))
Vcl.Controls.TControl.WndProc((273, 1344, 7275840, 0, 1344, 0, (), 1344, 111, (), 0, 0, ()))
Vcl.Controls.TWinControl.WndProc((273, 1344, 7275840, 0, 1344, 0, (), 1344, 111, (), 0, 0, ()))
Vcl.Forms.TCustomForm.WndProc((273, 1344, 7275840, 0, 1344, 0, (), 1344, 111, (), 0, 0, ()))
Vcl.Controls.TWinControl.MainWndProc(???)
System.Classes.StdWndProc(2829362,273,1344,7275840)
:759b8e71 user32.CallNextHookEx + 0xb1
:759b90d1 ; C:\windows\SysWOW64\user32.dll
:759b932c ; C:\windows\SysWOW64\user32.dll
:759b9529 ; C:\windows\SysWOW64\user32.dll
:77d107d6 ntdll.KiUserCallbackDispatcher + 0x36
:759be4a9 ; C:\windows\SysWOW64\user32.dll
:711f19e4 ; C:\windows\WinSxS\x86_microsoft.windows.common-controls_6595b64144ccf1df_6.0.9600.17810_none_a9edf09f013934e0\comctl32.dll
:711f1a7b ; C:\windows\WinSxS\x86_microsoft.windows.common-controls_6595b64144ccf1df_6.0.9600.17810_none_a9edf09f013934e0\comctl32.dll
:759b8e71 user32.CallNextHookEx + 0xb1
:759b90d1 ; C:\windows\SysWOW64\user32.dll
:759bddd5 user32.CallWindowProcW + 0x95
Vcl.Controls.TWinControl.DefaultHandler(???)
:00532947 TWinControl.DefaultHandler + $EB
:00532836 TWinControl.WndProc + $5CA
:00544cdd TButtonControl.WndProc + $71
:004c9162 StdWndProc + $16
:759b8e71 user32.CallNextHookEx + 0xb1
:759b90d1 ; C:\windows\SysWOW64\user32.dll
:759ba66f ; C:\windows\SysWOW64\user32.dll
:759ba6e0 user32.DispatchMessageW + 0x10
:005bb158 TApplication.ProcessMessage + $F8
:00040000

调用处理程序的其他线程

Unit6.TForm6.QueryFetchComplete($288B3E0,nil,esOK)
Data.Win.ADODB.TCustomADODataSet.FetchComplete(nil,89849068,Pointer($3299D8) as _Recordset)
:6b7ab81d ; C:\Program Files (x86)\Common Files\System\ado\msado15.dll
:6b7ab4b6 ; C:\Program Files (x86)\Common Files\System\ado\msado15.dll
:6b7a17c8 ; C:\Program Files (x86)\Common Files\System\ado\msado15.dll
:6b7b616f ; C:\Program Files (x86)\Common Files\System\ado\msado15.dll
:69038991 ; C:\Program Files (x86)\Common Files\System\msadc\msadce.dll
:69038bd6 ; C:\Program Files (x86)\Common Files\System\msadc\msadce.dll
:69038d54 ; C:\Program Files (x86)\Common Files\System\msadc\msadce.dll
:69037a02 ; C:\Program Files (x86)\Common Files\System\msadc\msadce.dll
:69021205 ; C:\Program Files (x86)\Common Files\System\msadc\msadce.dll
:69038034 ; C:\Program Files (x86)\Common Files\System\msadc\msadce.dll
:77a07c04 KERNEL32.BaseThreadInitThunk + 0x24
:77d2ad1f ntdll.RtlInitializeExceptionChain + 0x8f
:77d2acea ntdll.RtlInitializeExceptionChain + 0x5a

【问题讨论】：

GetCurrentThreadId 标识调用线程。如果 ID 不匹配，则必须是单独的线程。
您可以在OnFetchComplete 事件处理程序中使用表单的窗口句柄（或分配一个）到PostMessage 和您自己的用户消息，实际上它在主线程的上下文之外运行。
这个事件确实在另一个线程中运行，就像 Kobik 说的，你最好的选择是使用PostMessage，你可以找到一个示例here。
@whosrdaddy 这实际上是一个合理的解决方案。请发布它作为答案。我还考虑在处理程序中设置一个 TEvent 并有一个辅助 TThread 等待此事件并与主线程同步以调用正确的操作，但您的解决方案是更少的代码。我是新手，我可以将我的解决方案发布为自我回答吗？至于和别人争最优雅
当然你可以回答你自己的问题...

标签： delphi asynchronous delphi-xe4 delphi-xe8 tadoquery

【解决方案1】：

根据我的经验，更简单的方法是使用以下任一方法：

Synchronize 或 TThread.Queue

这不是错误或至少不是 VCL 错误。此行为由提供者处理，我们不能说它不遵循specification，因为没有关于如何管理这些事件的异步的规范。规范中的所有内容如下：

adAsyncFetchNonBlocking

表示主线程在检索时从不阻塞。如果请求的行没有被检索到，当前行会自动移动到文件的末尾。

这是一个警告主线程执行已完成的代码示例：

procedure TForm1.ADOQuery1FetchComplete(DataSet: TCustomADODataSet;
  const Error: Error; var EventStatus: TEventStatus);
begin
  TThread.Synchronize(nil,
    procedure
    begin
      ShowMessage('FetchData Completed');
    end
    );
end;

更新：

我确认了这一点。它适用于版本 6、7、XE4 和 XE7（我这里没有其他版本）。使用Synchronize 注入代码以便在主线程上下文中执行没有任何问题。另外，我想让您注意 DataSet 只是指向您的 ADOQuery 对象的指针（实际上是引用），因此您不必在匿名方法中引用它，这对于旧版本来说是一个重要事实像 6 或 7，因为匿名方法不存在。

BONUS READING: EVENTS

【讨论】：

OnFetchProgress 和 OnFetchComplete 是仅有的两个表现出这种行为的事件。问题是我不知道在这种情况下如何同步。这至少似乎不是源自 Delphi TThread，而是源自 OLEDB 提供者。如果是 Delphi TThread，我可以使用 TThread.Synchronize，但这里没有流控制。
线程不是源自 Delphi，正如我所说。使用 Synchronize 或 TThread.Queue 没有任何问题，因为提供者线程是在您的进程地址空间中创建的，您仍然可以访问主窗体控件
你需要什么样的额外流量控制？
我无法使用该事件处理程序中的数据集，我需要找到一种安全的方法或指向使用它。阅读规范（尤其是事件）我承认它可能不是一个错误，但它仍然是一个多线程问题。在此处访问事件处理程序中的数据集 - 即使在 OnFetchComplete 中 - 也会导致意外结果。与主线程同步的计时器解决了这些问题，但它非常粗糙
然后同步是方式，代码将被注入在主线程的上下文中运行，虽然我不明白你的意思。同步将保证在代码运行时原始线程仍然处于活动状态，因为它会阻塞调用者线程，直到代码执行完成。