Асинхронный запрос ado как узнать ошибку

CREATE TABLE ADOTestTable (NumberField int, DateField date, StringField varchar(36))
DECLARE @Counter int
SET @Counter = 0
WHILE @Counter < 1000000
BEGIN
 INSERT INTO ADOTestTable VALUES (RAND() * 2147483647, DATEADD("day", - RAND() * 365 * 15, GETDATE()), CONVERT(varchar(36), NEWID()))
 SET @Counter += 1
END

Provider=SQLOLEDB.1;Data Source=(local);Initial Catalog=test;Persist Security Info=True;User ID=sa;Password=123

SELECT TOP 10000000 * FROM ADOTestTable t1 JOIN ADOTestTable t2 ON t1.DateField = t2.DateField AND t1.StringField <> t2.StringField

procedure TForm1.ButtonLoadClick(Sender: TObject);
var
    startTime: TDateTime;
begin
    //Засекам время.
    startTime := Now;
    //Выполняем запрос.
    ADOQuery1.Open;
    //Отображаем количество загруженных записей и время загрузки.
    Label1.Caption := 'Загружено: ' + IntToStr(ADOQuery1.RecordCount)
        + '; Время выполнения: ' + FormatDateTime('hh:nn:ss', Now - startTime);
end;

unit Unit1;
 
interface
 
uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB,
    Vcl.StdCtrls, Vcl.Grids, Vcl.DBGrids, Vcl.ComCtrls, Data.Win.ADODB;
 
type
    TForm1 = class(TForm)
        DBGrid1: TDBGrid;
        ButtonLoad: TButton;
        ButtonCancel: TButton;
        DataSource1: TDataSource;
        ADOQuery1: TADOQuery;
        ADOConnection1: TADOConnection;
        ProgressBar1: TProgressBar;
        Label1: TLabel;
        procedure ButtonLoadClick(Sender: TObject);
        procedure ADOQuery1AfterOpen(DataSet: TDataSet);
        procedure ButtonCancelClick(Sender: TObject);
        procedure ADOConnection1ExecuteComplete(Connection: TADOConnection;
            RecordsAffected: Integer; const Error: Error;
            var EventStatus: TEventStatus; const Command: _Command;
            const Recordset: _Recordset);
    private
        { Private declarations }
        startTime: TDateTime;
        procedure ShowProgress(fShow: boolean);
    public
        { Public declarations }
    end;
 
var
    Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses Winapi.ADOInt;
 
procedure TForm1.ShowProgress(fShow: boolean);
begin
    //Пока идёт загрузка, кнопка загрузки неактивна.
    ButtonLoad.Enabled := not fShow;
    //Пока идёт загрузка, кнопка отмены активна.
    ButtonCancel.Enabled := fShow;
    //Пока идёт загрузка, показываем прогресс-бар.
    ProgressBar1.Visible := fShow;
end;
 
procedure TForm1.ADOConnection1ExecuteComplete(Connection: TADOConnection;
    RecordsAffected: Integer; const Error: Error; var EventStatus: TEventStatus;
    const Command: _Command; const Recordset: _Recordset);
begin
    //Если произошла ошибка, то нужно её показать.
    if EventStatus = TEventStatus.esErrorsOccured then
    begin
        //Показываем, что процесс загрузки завершён.
        ShowProgress(false);
        //Запрашиваем здесь состояние, но ошибку не показываем, если она происходит.
        //Если здесь не запросить состояние, то будут ошибки при закрытии формы.
        try
            ADOQuery1.RecordsetState;
        except
            //
        end;
        //Если ошибка - это не отмена, то показываем ошибку.
        if Error.Number <> adErrOperationCancelled then
            Application.MessageBox(PWideChar(Error.Description),
                PWideChar(Application.Title), MB_ICONERROR);
    end;
end;
 
procedure TForm1.ADOQuery1AfterOpen(DataSet: TDataSet);
begin
    //Отображаем количество загруженных записей и время загрузки.
    Label1.Caption := 'Загружено: ' + IntToStr(ADOQuery1.RecordCount)
        + '; Время выполнения: ' + FormatDateTime('hh:nn:ss', Now - startTime);
    //Показываем, что процесс загрузки завершён.
    ShowProgress(false);
    //Заново устанавливаем свойство DataSet, чтобы обновить таблицу.
    DataSource1.DataSet := ADOQuery1;
end;
 
procedure TForm1.ButtonCancelClick(Sender: TObject);
begin
    //Отмена запроса не работает или работает некорректно.
    ADOQuery1.Recordset.Cancel;
    //Показываем, что процесс загрузки завершён.
    ShowProgress(false);
end;
 
procedure TForm1.ButtonLoadClick(Sender: TObject);
begin
    //Закрываем запрос, если он был открыт ранее.
    ADOQuery1.Close;
    //Пока идёт загрузка, количество загруженных записей не показываем.
    Label1.Caption := 'Загружено: ...';
    //Засекам время.
    startTime := Now;
    //Выполняем запрос.
    ADOQuery1.Open;
    //Показываем процесс загрузки.
    ShowProgress(true);
end;
 
end.

unit Unit1;
 
interface
 
uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB,
    Vcl.StdCtrls, Vcl.Grids, Vcl.DBGrids, Vcl.ComCtrls, Data.Win.ADODB,
    System.Threading, Datasnap.DBClient;
 
type
    TForm1 = class(TForm)
        DBGrid1: TDBGrid;
        ButtonLoad: TButton;
        ButtonCancel: TButton;
        DataSource1: TDataSource;
        ProgressBar1: TProgressBar;
        Label1: TLabel;
        procedure ButtonLoadClick(Sender: TObject);
        procedure ButtonCancelClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
    private
        { Private declarations }
        _canceled: boolean;
        error: string;
        syncWindowHandle: HWND;
        task: ITask;
        query: TADOQuery;
        connection: TADOConnection;
        clientDataSet: TClientDataSet;
        startTime, copyingStartTime: TDateTime;
        procedure WndMethod(var Message: TMessage);
        function GetCanceled: boolean;
        procedure SetCanceled(value: boolean);
        procedure FreeInstances;
        procedure ShowProgress(fShow: boolean);
        procedure ExecuteComplete(Connection: TADOConnection;
            RecordsAffected: Integer; const Error: Error;
            var EventStatus: TEventStatus; const Command: _Command;
            const Recordset: _Recordset);
        procedure AfterOpen(DataSet: TDataSet);
        property Canceled: boolean read GetCanceled write SetCanceled;
    public
        { Public declarations }
    end;
 
var
    Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses Winapi.ADOInt;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
    query := nil;
    connection := nil;
    clientDataSet := nil;
    _canceled := false;
    //Создаём окно для синхронизации.
    syncWindowHandle := AllocateHWnd(self.WndMethod);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
    //Удаляем окно синхронизации.
    DeallocateHWnd(syncWindowHandle);
    //Удаляем созданные объекты.
    FreeInstances;
end;
 
procedure TForm1.FreeInstances;
begin
    //Остановка и удаление задания на копирование данных.
    if assigned(task) then
    begin
        if task.Status = TTaskStatus.Running then
        begin
            //Останавливаем копирование данных.
            Canceled := true;
            //Ждём, пока копирование остановится.
            task.Wait;
        end;
        task := nil;
        _canceled := false;
    end;
    //Отмена и удаление запроса.
    if assigned(query) then
    begin
        if assigned(query.Recordset)
                and ((query.Recordset.State and adStateExecuting) <> 0) then
            //Отменяем выполнение запроса.
            query.Recordset.Cancel;
        FreeAndNil(query);
    end;
    //Удаление соединения.
    if assigned(connection) then
        FreeAndNil(connection);
    //Удаление сохранённых в памяти данных.
    if assigned(clientDataSet) then
    begin
        DataSource1.DataSet := nil;
        FreeAndNil(clientDataSet);
    end;
end;
 
function TForm1.GetCanceled: boolean;
begin
    //Чтение свойства Canceled.
    System.TMonitor.Enter(self);
    try
        Result := _canceled;
    finally
        System.TMonitor.Exit(self);
    end;
end;
 
procedure TForm1.SetCanceled(value: boolean);
begin
    //Установка свойства Canceled.
    System.TMonitor.Enter(self);
    try
        _canceled := value;
    finally
        System.TMonitor.Exit(self);
    end;
end;
 
procedure TForm1.ShowProgress(fShow: boolean);
begin
    //Пока идёт загрузка, кнопка загрузки неактивна.
    ButtonLoad.Enabled := not fShow;
    //Пока идёт загрузка, кнопка отмены активна.
    ButtonCancel.Enabled := fShow;
    //Пока идёт загрузка, показываем прогресс-бар.
    ProgressBar1.Visible := fShow;
end;
 
procedure TForm1.ExecuteComplete(Connection: TADOConnection;
    RecordsAffected: Integer; const Error: Error; var EventStatus: TEventStatus;
    const Command: _Command; const Recordset: _Recordset);
begin
    //Если произошла ошибка, то нужно её показать.
    if EventStatus = TEventStatus.esErrorsOccured then
    begin
        //Показываем, что процесс загрузки завершён.
        ShowProgress(false);
        //Запрашиваем здесь состояние, но ошибку не показываем, если она происходит.
        //Если здесь не запросить состояние, то будут ошибки при закрытии формы.
        try
            query.RecordsetState;
        except
            //
        end;
        //Если ошибка - это не отмена, то показываем ошибку.
        if Error.Number <> adErrOperationCancelled then
            Application.MessageBox(PWideChar(Error.Description),
                PWideChar(Application.Title), MB_ICONERROR);
    end;
end;
 
procedure TForm1.AfterOpen(DataSet: TDataSet);
begin
    error := '';
    //Создаём задание для копирования данных.
    task := TTask.Create(procedure
        var
            i: integer;
        begin
            try
                i := 0;
                //Запоминаем время начала копирования.
                copyingStartTime := Now;
                //Создаём компонент TClientDataSet для хранения данных в памяти.
                clientDataSet := TClientDataSet.Create(nil);
                //Копируем структуру.
                clientDataSet.FieldDefs.Assign(query.FieldDefs);
                clientDataSet.CreateDataSet;
                //Копируем данные.
                query.First;
                while not query.Eof do
                begin
                    Inc(i);
                    clientDataSet.Append;
                    clientDataSet.CopyFields(query);
                    clientDataSet.Post;
                    //Если копирование отменено, то выходим из цикла.
                    if Canceled then
                        break;
                    query.Next;
                end;
            except
                on e: Exception do
                begin
                    //Если произошла ошибка, то сохраняем сообщение.
                    if i > 0 then
                        error := 'При копировании записи ' + IntToStr(i) + ' произошла ошибка '
                            + '(время копирования: ' + FormatDateTime('hh:nn:ss', Now - copyingStartTime) + '). ';
                    error := error + e.Message;
                end;
            end;
            //Отправляем самим себе сообщение, что загрузка завершена.
            SendMessage(syncWindowHandle, WM_USER + 1, 0, 0);
        end
    );
    //Запускаем копирование.
    task.Start;
end;
 
procedure TForm1.WndMethod(var Message: TMessage);
var
    defProc: boolean;
begin
    defProc := false;
    try
        case Message.Msg of
        //Получено сообщение, что загрузка завершена.
        WM_USER + 1:
        begin
            //Показываем, что процесс загрузки завершён.
            ShowProgress(false);
            if not Canceled then
            begin
                //Если была ошибка, то показываем её.
                if not error.IsEmpty then
                    Application.MessageBox(PWideChar(error),
                        PWideChar(Application.Title), MB_ICONERROR)
                else
                begin
                    //Отображаем количество загруженных записей и время загрузки.
                    Label1.Caption := 'Загружено: ' + IntToStr(clientDataSet.RecordCount)
                        + '; Время выполнения: ' + FormatDateTime('hh:nn:ss', Now - startTime)
                        + '; Время копирования: ' + FormatDateTime('hh:nn:ss', Now - copyingStartTime);
                    //Заново устанавливаем свойство DataSet, чтобы обновить таблицу.
                    DataSource1.DataSet := clientDataSet;
                end;
            end;
        end
        else
            defProc := true;
        end;
    except
        Application.HandleException(Self);
    end;
    if defProc then
        Message.Result := DefWindowProc(syncWindowHandle, Message.Msg, Message.wParam, Message.lParam);
end;
 
procedure TForm1.ButtonCancelClick(Sender: TObject);
begin
    if (query.Recordset.State and adStateExecuting) <> 0 then
        //Отмена запроса.
        query.Recordset.Cancel
    else if assigned(task) and (task.Status = TTaskStatus.Running) then
        //Отмена копирования данных в память.
        Canceled := true;
end;
 
procedure TForm1.ButtonLoadClick(Sender: TObject);
begin
    //Удаляем созданные объекты.
    FreeInstances;
    //Создаём компоненты.
    connection := TADOConnection.Create(nil);
    query := TADOQuery.Create(nil);
    //Настраиваем соединение.
    connection.ConnectionString := 'Provider=SQLOLEDB.1;Data Source=(local);Initial Catalog=test;Persist Security Info=True;User ID=sa;Password=123';
    connection.ConnectOptions := coAsyncConnect;
    connection.LoginPrompt := false;
    connection.OnExecuteComplete := ExecuteComplete;
    //Настраиваем запрос.
    query.Connection := connection;
    query.CursorLocation := clUseServer;
    query.ExecuteOptions := [eoAsyncExecute];
    query.CursorType := TCursorType.ctOpenForwardOnly;
    query.AfterOpen := AfterOpen;
    //10000000 записей - это слишком много для сохранения в памяти, поэтому лучше это число уменьшить.
    query.SQL.Text := 'SELECT TOP 10000000 * FROM ADOTestTable t1 JOIN ADOTestTable t2 ON t1.DateField = t2.DateField AND t1.StringField <> t2.StringField';
    //Пока идёт загрузка, количество загруженных записей не показываем.
    Label1.Caption := 'Загружено: ...';
    //Засекам время.
    startTime := Now;
    //Выполняем запрос.
    query.Open;
    //Показываем процесс загрузки.
    ShowProgress(true);
end;
 
end.

procedure TForm1.AfterOpen(DataSet: TDataSet);
begin
    error := '';
    //Запоминаем время начала копирования.
    copyingStartTime := Now;
    //Создаём компонент TClientDataSet для хранения данных в памяти.
    clientDataSet := TClientDataSet.Create(nil);
    //Копируем структуру.
    clientDataSet.FieldDefs.Assign(query.FieldDefs);
    clientDataSet.CreateDataSet;
    //Заранее устанавливаем свойство DataSet.
    DataSource1.DataSet := clientDataSet;
    //Создаём задание для копирования данных.
    task := TTask.Create(procedure
        var
            i: integer;
        begin
            try
                i := 0;
                //Копируем данные.
                query.First;
                while not query.Eof do
                begin
                    Inc(i);
                    //Если копирование отменено, то выходим из цикла.
                    if Canceled then
                        break;
                    SendMessage(syncWindowHandle, WM_USER + 2, 0, 0);
                    query.Next;
                end;
            except
                on e: Exception do
                begin
                    //Если произошла ошибка, то сохраняем сообщение.
                    if i > 0 then
                        error := 'При копировании записи ' + IntToStr(i) + ' произошла ошибка '
                            + '(время копирования: ' + FormatDateTime('hh:nn:ss', Now - copyingStartTime) + '). ';
                    error := error + e.Message;
                end;
            end;
            //Отправляем самим себе сообщение, что загрузка завершена.
            SendMessage(syncWindowHandle, WM_USER + 1, 0, 0);
        end
    );
    //Запускаем копирование.
    task.Start;
end;
 
procedure TForm1.WndMethod(var Message: TMessage);
var
    defProc: boolean;
    bookmark: TBookmark;
begin
    defProc := false;
    try
        case Message.Msg of
        //Получено сообщение, что загрузка завершена.
        WM_USER + 1:
        begin
            //Показываем, что процесс загрузки завершён.
            ShowProgress(false);
            //Если была ошибка, то показываем её.
            if not error.IsEmpty then
                Application.MessageBox(PWideChar(error),
                    PWideChar(Application.Title), MB_ICONERROR)
            else
                //Отображаем количество загруженных записей и время загрузки.
                Label1.Caption := 'Загружено: ' + IntToStr(clientDataSet.RecordCount)
                    + '; Время выполнения: ' + FormatDateTime('hh:nn:ss', Now - startTime)
                    + '; Время копирования: ' + FormatDateTime('hh:nn:ss', Now - copyingStartTime);
            if Canceled then
                Label1.Caption := 'Загрузка отменена! ' + Label1.Caption;
        end;
        WM_USER + 2:
        begin
            //Копируем запись.
            clientDataSet.DisableControls;
            try
                bookmark := clientDataSet.GetBookmark;
                try
                    clientDataSet.Append;
                    clientDataSet.CopyFields(query);
                    clientDataSet.Post;
                finally
                    clientDataSet.GotoBookmark(bookmark);
                end;
            finally
                clientDataSet.EnableControls;
            end;
            //Правая полоса прокрутки не появляется при повторной загрузке таблицы,
            //поэтому показываем её принудительно.
            if clientDataSet.RecordCount < 2 then
                ShowScrollBar(DBGrid1.Handle, SB_VERT, true);
            //Отображаем количество загруженных записей.
            Label1.Caption := 'Загружено: ' + IntToStr(clientDataSet.RecordCount)
        end;
        else
            defProc := true;
        end;
    except
        Application.HandleException(Self);
    end;
    if defProc then
        Message.Result := DefWindowProc(syncWindowHandle, Message.Msg, Message.wParam, Message.lParam);
end;

unit Unit1;
 
interface
 
uses
    Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
    System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Data.DB,
    Vcl.StdCtrls, Vcl.Grids, Vcl.DBGrids, Vcl.ComCtrls, Data.Win.ADODB,
    System.Threading, Datasnap.DBClient;
 
type
    TForm1 = class(TForm)
        DBGrid1: TDBGrid;
        ButtonLoad: TButton;
        ButtonCancel: TButton;
        DataSource1: TDataSource;
        ProgressBar1: TProgressBar;
        Label1: TLabel;
        procedure ButtonLoadClick(Sender: TObject);
        procedure ButtonCancelClick(Sender: TObject);
        procedure FormCreate(Sender: TObject);
        procedure FormDestroy(Sender: TObject);
    private
        { Private declarations }
        error: string;
        syncWindowHandle: HWND;
        query: TADOQuery;
        connection: TADOConnection;
        clientDataSet: TClientDataSet;
        startTime: TDateTime;
        recordsetBookmark: Variant;
        procedure FetchProgress(DataSet: TCustomADODataSet;
            Progress, MaxProgress: Integer; var EventStatus: TEventStatus);
        procedure FetchComplete(DataSet: TCustomADODataSet;
            const Error: Error; var EventStatus: TEventStatus);
        procedure WndMethod(var Message: TMessage);
        procedure FreeInstances;
        procedure ShowProgress(fShow: boolean);
        procedure ExecuteComplete(Connection: TADOConnection;
            RecordsAffected: Integer; const Error: Error;
            var EventStatus: TEventStatus; const Command: _Command;
            const Recordset: _Recordset);
    public
        { Public declarations }
    end;
 
var
    Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
uses Winapi.ADOInt;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
    query := nil;
    connection := nil;
    clientDataSet := nil;
    //Создаём окно для синхронизации.
    syncWindowHandle := AllocateHWnd(self.WndMethod);
end;
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
    //Удаляем окно синхронизации.
    DeallocateHWnd(syncWindowHandle);
    //Удаляем созданные объекты.
    FreeInstances;
end;
 
procedure TForm1.FreeInstances;
begin
    //Отмена и удаление запроса.
    if assigned(query) then
    begin
        if assigned(query.Recordset)
                and ((query.Recordset.State and adStateExecuting) <> 0) then
            //Отменяем выполнение запроса.
            query.Recordset.Cancel;
        FreeAndNil(query);
    end;
    //Удаление соединения.
    if assigned(connection) then
        FreeAndNil(connection);
    //Удаление сохранённых в памяти данных.
    if assigned(clientDataSet) then
    begin
        DataSource1.DataSet := nil;
        FreeAndNil(clientDataSet);
    end;
    error := '';
end;
 
procedure TForm1.ShowProgress(fShow: boolean);
begin
    //Пока идёт загрузка, кнопка загрузки неактивна.
    ButtonLoad.Enabled := not fShow;
    //Пока идёт загрузка, кнопка отмены активна.
    ButtonCancel.Enabled := fShow;
    //Пока идёт загрузка, показываем прогресс-бар.
    ProgressBar1.Visible := fShow;
end;
 
procedure TForm1.ExecuteComplete(Connection: TADOConnection;
    RecordsAffected: Integer; const Error: Error; var EventStatus: TEventStatus;
    const Command: _Command; const Recordset: _Recordset);
begin
    //Если произошла ошибка, то нужно её показать.
    if EventStatus = TEventStatus.esErrorsOccured then
    begin
        //Показываем, что процесс загрузки завершён.
        ShowProgress(false);
        //Запрашиваем здесь состояние, но ошибку не показываем, если она происходит.
        //Если здесь не запросить состояние, то будут ошибки при закрытии формы.
        try
            query.RecordsetState;
        except
            //
        end;
        //Если ошибка - это не отмена, то показываем ошибку.
        if Error.Number <> adErrOperationCancelled then
            Application.MessageBox(PWideChar(Error.Description),
                PWideChar(Application.Title), MB_ICONERROR);
    end;
end;
 
procedure TForm1.WndMethod(var Message: TMessage);
var
    defProc: boolean;
    bookmark: TBookmark;
    i, j: integer;
    goToFirst: boolean;
    fields, rows: Variant;
begin
    defProc := false;
    try
        case Message.Msg of
        //Получено сообщение, что подгружена часть данных.
        WM_USER + 1:
        begin
            try
                if (error = '') and assigned(query) then
                begin
                    goToFirst := false;
                    if not assigned(clientDataSet) then
                    begin
                        //Создаём компонент TClientDataSet для хранения данных в памяти.
                        clientDataSet := TClientDataSet.Create(nil);
                        //Копируем структуру.
                        clientDataSet.FieldDefs.Assign(query.FieldDefs);
                        clientDataSet.CreateDataSet;
                        //Заранее устанавливаем свойство DataSet.
                        DataSource1.DataSet := clientDataSet;
                        //После начала загрузки будем двигаться на первую запись.
                        goToFirst := true;
                    end
                    else if query.Recordset.RecordCount > clientDataSet.RecordCount then
                    begin
                        //Сдвигаемся на одну запись, после текущей.
                        query.Recordset.Move(1, recordsetBookmark);
                        //Сохраняем закладку для текущей записи.
                        recordsetBookmark := query.Recordset.Bookmark;
                    end;
                    if query.Recordset.RecordCount > clientDataSet.RecordCount then
                    begin
                        //Создаём массив со списком индексов полей.
                        fields := VarArrayCreate([0, clientDataSet.FieldCount - 1], varVariant);
                        for i := 0 to clientDataSet.FieldCount - 1 do
                            fields[i] := i;
                        //Выгружаем значения полей для всех появившихся записей в массив.
                        rows := query.Recordset.GetRows(query.Recordset.RecordCount - clientDataSet.RecordCount,
                            recordsetBookmark, fields);
                        //Идём на последнюю запись и сохраняем для неё закладку.
                        query.Recordset.MoveLast;
                        recordsetBookmark := query.Recordset.Bookmark;
                        //Копируем пришедшие данные.
                        clientDataSet.DisableControls;
                        try
                            bookmark := clientDataSet.GetBookmark;
                            for i := VarArrayLowBound(rows, 2) to VarArrayHighBound(rows, 2) do
                            begin
                                clientDataSet.Append;
                                for j := 0 to clientDataSet.FieldCount - 1 do
                                    clientDataSet.Fields[j].Value := rows[j, i];
                                clientDataSet.Post;
                                //Правая полоса прокрутки не появляется при повторной загрузке таблицы,
                                //поэтому показываем её принудительно.
                                if clientDataSet.RecordCount < 2 then
                                    ShowScrollBar(DBGrid1.Handle, SB_VERT, true);
                            end;
                            if goToFirst then
                                clientDataSet.First
                            else
                                clientDataSet.GotoBookmark(bookmark);
                        finally
                            clientDataSet.EnableControls;
                        end;
                    end;
                    //Отображаем количество загруженных записей.
                    Label1.Caption := 'Загружено: ' + IntToStr(clientDataSet.RecordCount);
                end;
            except
                on e: Exception do
                begin
                    //Если во время копирования происходит ошибка, то сохраняем текст ошибки...
                    error := e.Message;
                    //... и отправляем самим себе сообщение, что загрузка завершена.
                    PostMessage(syncWindowHandle, WM_USER + 2, 0, 0);
                end;
            end;
        end;
        WM_USER + 2:
        begin
            //Показываем, что процесс загрузки завершён.
            ShowProgress(false);
            //Если была ошибка, то показываем её.
            if not error.IsEmpty then
            begin
                //Если выборка данных продолжает происходить, то удаляем объекты TADOQuery и TADOConnection.
                if assigned(query) and ((query.Recordset.State and adStateFetching) <> 0) then
                    try
                        FreeAndNil(query);
                    finally
                        try
                            FreeAndNil(connection);
                        finally
                            Application.MessageBox(PWideChar(error),
                                PWideChar(Application.Title), MB_ICONERROR)
                        end;
                    end;
            end
            else
                //Отображаем количество загруженных записей и время загрузки.
                Label1.Caption := 'Загружено: ' + IntToStr(clientDataSet.RecordCount)
                    + '; Время выполнения: ' + FormatDateTime('hh:nn:ss', Now - startTime);
        end;
        else
            defProc := true;
        end;
    except
        Application.HandleException(Self);
    end;
    if defProc then
        Message.Result := DefWindowProc(syncWindowHandle, Message.Msg, Message.wParam, Message.lParam);
end;
 
procedure TForm1.FetchComplete(
    DataSet: TCustomADODataSet; const Error: Error;
    var EventStatus: TEventStatus);
begin
    //Отправляем самим себе сообщение, что загружена часть данных.
    SendMessage(syncWindowHandle, WM_USER + 1, 0, 0);
    //Отправляем самим себе сообщение, что загрузка завершена.
    SendMessage(syncWindowHandle, WM_USER + 2, 0, 0);
end;
 
procedure TForm1.FetchProgress(
    DataSet: TCustomADODataSet; Progress, MaxProgress: Integer;
    var EventStatus: TEventStatus);
begin
    //Отправляем самим себе сообщение, что загружена часть данных.
    SendMessage(syncWindowHandle, WM_USER + 1, 0, 0);
end;
 
procedure TForm1.ButtonCancelClick(Sender: TObject);
begin
    if (query.Recordset.State and adStateExecuting) <> 0 then
        //Отмена запроса.
        query.Recordset.Cancel
    else
    begin
        //Для отмены загрузки просто удаляем объекты TADOQuery и TADOConnection.
        try
            FreeAndNil(query);
        finally
            try
                FreeAndNil(connection);
            finally
                //Показываем, что процесс загрузки завершён.
                ShowProgress(false);
                Label1.Caption := 'Загрузка отменена! ' + Label1.Caption;
            end;
        end;
    end;
end;
 
procedure TForm1.ButtonLoadClick(Sender: TObject);
begin
    //Удаляем созданные объекты.
    FreeInstances;
    //Создаём компоненты.
    connection := TADOConnection.Create(nil);
    query := TADOQuery.Create(nil);
    //Настраиваем соединение.
    connection.ConnectionString := 'Provider=SQLOLEDB.1;Data Source=(local);Initial Catalog=test;Persist Security Info=True;User ID=sa;Password=123';
    connection.ConnectOptions := coAsyncConnect;
    connection.LoginPrompt := false;
    connection.OnExecuteComplete := ExecuteComplete;
    //Настраиваем запрос.
    query.Connection := connection;
    query.ExecuteOptions := [eoAsyncExecute, eoAsyncFetchNonBlocking];
    query.OnFetchProgress := FetchProgress;
    query.OnFetchComplete := FetchComplete;
    query.CursorType := TCursorType.ctOpenForwardOnly;
    //10000000 записей - это слишком много для сохранения в памяти, поэтому лучше это число уменьшить.
    query.SQL.Text := 'SELECT TOP 10000000 * FROM ADOTestTable t1 JOIN ADOTestTable t2 ON t1.DateField = t2.DateField AND t1.StringField <> t2.StringField';
    //Пока идёт загрузка, количество загруженных записей не показываем.
    Label1.Caption := 'Загружено: ...';
    //Засекам время.
    startTime := Now;
    //Устанавливаем закладку в начало.
    recordsetBookmark := 1;
    //Выполняем запрос.
    query.Open;
    //Показываем процесс загрузки.
    ShowProgress(true);
end;
 
end.