将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 Thread。
如果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
答案 0 :(得分：3)
根据我的经验，更简单的方法是使用：
这不是错误或至少不是VCL错误。此行为由提供程序处理，我们不能说它不遵循specification，因为没有关于如何管理这些事件的异步的规范。所有规范都说如下：
<强>那么adAsyncFetchNonBlocking
表示主线程在检索时永远不会阻塞。如果尚未检索到请求的行，则当前行会自动移动到文件末尾。
这是代码警告主线程执行完成的示例：
ini_set('memory_limit', '2048M');#Set the memory limit
$new_dbName="au_site";
$patern[0]="/di_site/";
$replace[0]=$new_dbName;
#xdebug_break();
$dirBase=dirname(__FILE__);
$dir2 = new DirectoryIterator(dirname(__FILE__));
#xdebug_break();
foreach ($dir2 as $fileinfo) {
if (!$fileinfo->isDot() && $fileinfo->isFile()) {
$str = $fileinfo->getFilename();
if (preg_match("/\.sql/i", $str)) {
#xdebug_break();
$i=1;
if(!($handle= fopen("$str", "r"))){
die("Cannot open the file");
}
else{
while (!feof($handle)) {
#xdebug_break();
$line=trim(fgets($handle), "\t\n\r\0\x0B");
$firstChar = substr($line, 0,1) ;
$ord = ord($firstChar);
if(ord($firstChar)<>45){
if (preg_match("/di_site/", $line)) {
xdebug_break();
$chn=preg_replace($patern, $replace, $line);
$line=$chn;
}
#echo $line."<br>";
$sql.=$line."\n";
}
}
xdebug_break();
$newDBsql=$dirBase."/".$new_dbName.".sql";
if(!$handle = fopen($newDBsql,"w")){
die("Can not open the file");
}
else{
fwrite($handle, $sql);
fclose($handle);
}
}
}
}
}
<强>更新
我证实了这一点。它适用于版本6,7，XE4和XE7（我在这里没有其他版本）。使用procedure TForm1.ADOQuery1FetchComplete(DataSet: TCustomADODataSet;
const Error: Error; var EventStatus: TEventStatus);
begin
TThread.Synchronize(nil,
procedure
begin
ShowMessage('FetchData Completed');
end
);
end;
注入代码以执行主线程上下文没有任何问题。另外，我想让你注意DataSet只是你的ADOQuery对象的一个指针（实际上是一个引用）的事实，所以你不必在你的匿名方法上引用它，这是一个重要的事实。旧版本，如6或7，因为匿名方法不存在。