Рейтинг@Mail.ru

Асинхронная загрузка данных с помощью ADO в Delphi

Автор: Alex. Опубликовано в Программирование . просмотров: 5494

Рейтинг:  5 / 5

Звезда активнаЗвезда активнаЗвезда активнаЗвезда активнаЗвезда активна
 

В некоторых случаях нам приходится делать асинхронную загрузку данных из базы. Ведь так пользователь может почти сразу увидеть первые фрагменты данных по мере их загрузки, не дожидаясь, пока будет загружено всё полностью. Ещё пользователь получит возможность отменить загрузку в любой момент, пока она происходит. Ну и конечно, асинхронная загрузка позволяет сделать, например, многозакладочный пользовательский интерфейс, на каждой закладке которого можно будет параллельно загружать разные данные. В этой статье я приведу решение, которое позволит сделать асинхронную пошаговую загрузку данных в таблицу в Delphi с помощью ADO.

Создание проекта

На самом деле, в ADO уже всё готово для асинхронной загрузки данных, нужно лишь выставить определённые опции и обработать необходимые события. Но в Delphi всё оказалось не настолько просто. Для отображения данных в Delphi используется таблица TDBGrid унаследованная от TCustomDBGrid (или многочисленные сторонние разработки, тоже унаследованные от TCustomDBGrid), ссылающаяся на объект TDataSource, который, в свою очередь, ссылается на TDataSet. И в случае работы с ADO вы должны использовать обёртки TADOStoredProc, TADOQuery, TADOTable и TADODataSet, которые унаследованы от объекта TDataSet. Как раз эти обёртки и не дают в полную силу пользоваться асинхронной загрузкой данных. Чтобы понять, что работает и что не работает при использовании этих обёрток, сделаем простой пример с их использованием.

Все эксперименты в статье я буду делать, используя локальную СУБД MSSQL 2008 и Delphi 10 Seattle. Для экспериментов я создал простую таблицу и заполнил её случайным набором данных. Вот скрипт, который я использовал:

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

Теперь в Delphi сделаем новый проект с VCL-формой (пункт меню File -> New -> VCL Forms Application - Delphi), на форму положим таблицу TDBGrid и две кнопки TButton. Одна кнопка будет для начала загрузки, а вторая для отмены загрузки. Имена кнопкам я дам соответствующие – ButtonLoad и ButtonCancel. Все остальные имена оставлю без изменений. Кнопку отмены по умолчанию сделаем неактивной, Enabled выставим в False. Зададим, также, заголовок формы и текст на кнопках. Ещё я добавлю компонент TProgressBar, который будет нам показывать идёт ли процесс загрузки или нет и компонент TLabel для отображения количества загруженных записей. Свойство Style прогресс-бара выставим в pbstMarquee, а Visible – в False.

После того как с визуальной частью формы закончено, положим на форму компоненты TDataSource, TADOQuery и TADOConnection. Теперь нужно связать таблицу TDBGrid (у нас она получила имя DBGrid1) с источником данных TDataSource (у нас он с именем DataSource1), источник данных – с запросом TADOQuery (у нас он с именем ADOQuery1), а запрос – с соединением TADOConnection (у нас оно с именем ADOConnection1). Т.е. получается вот такая связь: DBGrid1 -> DataSource1 -> ADOQuery1 -> ADOConnection1. Для этого устанавливаем у таблицы свойство DataSource равным DataSource1, свойство источника данных DataSet равным ADOQuery1, а свойство запроса Connection равным ADOConnection1.

Пример формы Delphi для тестирования ADO

Теперь нужно задать свойства соединения в свойстве ConnectionString объекта ADOConnection1. У меня это будет следующая строка:

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

Здесь я сразу указал имя пользователя и пароль, поэтому можно отключить стандартное окно запроса имени пользователя и пароля выставив свойству LoginPrompt компонента ADOConnection1 значение False.

Теперь придумаем такой запрос, который будет долго выполняться, и запишем его в свойство SQL компонента ADOQuery1. Заодно будем засекать, сколько будут загружаться данные для каждого из вариантов загрузки. Я сделал вот такой запрос:

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

У меня этот запрос в SQL Management Stodio выполнился за 1 минуту и 9 секунд.

Простой синхронный запрос данных в Delphi с помощью ADO

Для начала сделаем простой синхронный запрос данных. Выполнять запрос будем по событию OnClick кнопки ButtonLoad. Вот такой будет код для выполнения запроса:

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;

Запустите приложение, нажмите на кнопку «Загрузить». Записи открылись даже быстрее, чем в SQL Server Management Studio, всего за 26 секунд, но при просмотре происходят подтормаживания, причём, чем ближе к концу таблицы, тем они больше. Интересный результат.

Синхронная загрузка данных в Delphi с помощью ADO

Простой асинхронный запрос данных в Delphi с помощью ADO

Теперь попробуем выполнить этот запрос асинхронно. Для этого установите у свойства ExecuteOptions компонента ADOQuery1 флажок eoAcyncExecute в True. А чтобы соединение с СУБД тоже происходило асинхронно, установите свойству ConnecOptions значение coAsyncConnect. Количество записей теперь нужно будет показывать только после того как запрос выполнится. Об этом можно узнать по событию AfterOpen компонента ADOQuery1. Ошибки можно отловить по событию OnExecuteComplete компонента ADOConnection1. Пока запрос обрабатывается, будем показывать прогресс-бар, делать активной кнопку «Отмена», а кнопку «Загрузка» - неактивной. Отменять выполняющийся запрос будем как положено в ADO – вызовом функции Cancel. Вот как будет выглядеть код:

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.

Запустите форму и нажмите на кнопку «Загрузить». После этого кнопки «Загрузка» и «Отмена» поменяют активность, появится прогресс-баз и начнётся загрузка, см. картинку ниже. Данные отобразятся в таблице только после загрузки. Время загрузки здесь получилось такое же – 26 секунд, и так же при просмотре происходят подтормаживания.

Процесс асинхронной загрузки данных в Delphi с помощью ADO

Отмена простого асинхронного запроса данных в Delphi с помощью ADO

Загрузка из примера выше работает прекрасно, пока вы не нажмёте на кнопку «Отмена». Здесь есть 2 проблемы:

    1. Когда данные уже начали загружаться на клиента, отмена не срабатывает. Вместо отмены программа зависает на строчке «ADOQuery1.Recordset.Cancel;», пока все данные полностью не загрузятся.
    2. После вызова функции «ADOQuery1.Recordset.Cancel;» (если конечно запрос реально отменился, см. п. 1), повторно выполнить запрос не получится, т.к. вызов метода «ADOQuery1.Open;» не произведёт никаких действий. Это происходит из-за того, что компонент ADOQuery1 остаётся закрытым (Active = False), но в то же время его статус показывает, что запрос открывается (State = dsOpening). Это наглядно показывает на то, что обёртки VCL над ADO не поддерживают отмену.

Первую проблему можно попробовать обойти одним из трёх способов:

    1. Поменять драйвер, если другой драйвер у вас есть. Но, может случиться так, что нужного вам драйвера не существует или БД не поддерживает отмену запросов.
    2. Использовать серверный курсор (для этого нужно выставить у компонента ADOQuery1 свойство CursorLocation в clUseServer). Но с серверным курсором вы не сможете узнать количество записей и для отображения данных нужно постоянное подключение к СУБД. Поэтому, чтобы работать с данными на клиенте, вам придётся скопировать их в оперативную память (например, в компонент TClientDataSet) или в локальную базу данных, если объём данных очень большой. А чтение всех данных из серверного курсора происходит медленно.
    3. Сделать фиктивную остановку загрузки. Т.е. показывать пользователю, что запрос отменён, а на самом деле давать запросу выполниться до конца и только после этого его удалять. Можно, конечно удалять компоненты TADOQuery во время загрузки (это возможно, если выставить флаг eoAsyncFetchNonBlocking в True), но загрузка данных объектами ADO при этом не остановится, она будет продолжаться. Это видно даже в диспетчере задач. К тому же при удалении компонентов TADOQuery во время загрузки периодически происходит ошибка «access violation at 0x1cbaf811: read of address 0x00000000» где-то в недрах ADO.

Вторую проблему никак не обойти. Здесь есть только одно решение – после каждой отмены (или вообще каждый раз), для каждого нового запроса создавать новый компонент TADOQuery, а существующий компонент удалять сразу или позже при завершении работы приложения.

Учитывая возникшие с отменой проблемы, код формы сильно поменяется. Я уберу с формы компоненты ADOQuery1 и ADOConnection1 и буду создавать их при каждой загрузке данных. Ниже я приведу два примера и опишу их минусы.

Вот первый пример. Здесь я использую серверный курсор для получения данных. Для отображения я копирую данные в компонент TClientDataSet. Отмена загрузки здесь работает превосходно. Но есть другие проблемы, о которых будет написано ниже.

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.

В этом примере копирование работает крайне медленно. Судите сами: примерно половина запрошенных данных копировалась аж 23 минуты и 17 секунд. Замеры с помощью профайлера показали, что очень медленно работает перемещение по данным с помощью серверного курсора (строка кода «query.Next;») - 20 минут и 19 секунд. На втором месте оказалось копирование полей (строка кода «clientDataSet.CopyFields(query);») – 2 минуты и 9 секунд. В довершение ко всему, примерно посередине загрузки произошла ошибка при копировании 5218000-ой записи: «Exception class EDBClient with message 'Insufficient memory for this operation.'.». Так что, в компонент TClientDataSet у вас никак не удастся записать 10000000 записей.

Ошибка при добавлении большого количества данных в TClientDataSet

Поэтому, если вам нужно загрузить на компьютер пользователя большой объём данных, нужно искать другой способ. Приведённый пример загрузки и хранения данных в оперативной памяти подойдёт только для небольших объёмов.

Асинхронная пошаговая загрузка данных в Delphi с помощью ADO

Смысл пошаговой загрузки заключается в том, что пользователю не нужно ждать до конца выполнения запроса, чтобы увидеть данные. Как только первая порция данных загружена, её уже можно отобразить в таблице. После этого по мере подгрузки всё новых и новых данных их тоже нужно отображать в таблице. Таким образом, пользователь может начать просматривать таблицу почти сразу после начала загрузки и будет видеть динамику загрузки.

Есть два варианта, как это можно сделать. Первый вариант – это небольшое изменение предыдущего примера, где загрузка происходит из серверного курсора. Смысл изменения состоит в том, что мы должны сразу привязать таблицу к компоненту TClientDataSet и по мере наполнения компонента TClientDataSet, таблица сразу будет отображать новые записи. Здесь поменяются только методы AfterOpen и WndMethod:

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;

Второй вариант – это установка флага eoAsyncFetchNonBlocking в True у компонента TADOQuery и постепенная загрузка данных в событии OnFetchProgress. Этот способ работает в 10 раз быстрее, чем предыдущий. Правда, здесь я столкнулся с одной проблемой: при выборке данных по событию OnFetchProgress невозможно установить курсор на первую запись (вызовы методов First или Prior не помогают) и, в результате, у нас происходит загрузка всех записей, кроме первой. Чтобы это избежать, будем загружать данные напрямую с помощью ADO. Пример поменяется сильно, поэтому я приведу здесь полный текст:

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.

Асинхронная пошаговая загрузка нескольких наборов данных в Delphi с помощью ADO

Если вам требуется асинхронно загрузить несколько наборов данных, так же как это сделано в предыдущем примере, то вы можете даже не пытаться это делать. Дело в том, что когда вы будете переходить к следующему набору данных с помощью «query.Recordset := query.NextRecordset(recordsAffected);», в этот момент компонент TADOQuery закрывает курсор и больше вы ничего не получите. Да, это прекрасно работает при синхронных запросах, но только не по событию OnFetchProgress. Пример с чтением из серверного курсора тоже работать не будет.

Но если вы всё-таки захотите асинхронно пошагово загружать данные с несколькими наборами, то используйте ADO напрямую. Кода, конечно, будет намного больше, но в этом случае всё будет работать. В статье я не буду приводить таких примеров, т.к. это будет довольно объёмный код. Но если вы заинтересованы, пишите об этом в комментариях.

Tags: ADO Учебники по программированию Delphi

Комментарии   

Артем
0 #1 Артем 11.02.2016 07:40
В последнем примере, все проходит плавно без зависания VCL формы?

И что будет есть во время выполнения этого запроса, запустить открытия кверика на другой форме?))
Цитировать
Alex
0 #2 Alex 11.02.2016 15:51
Цитирую Артем:
В последнем примере, все проходит плавно без зависания VCL формы?

И что будет есть во время выполнения этого запроса, запустить открытия кверика на другой форме?))

Форма не зависает, но лёгкие подтормаживания, конечно, есть, когда происходит копирование в TClientDataSet, т.к. это происходит в основном потоке. К сожалению, TClientDataSet не получится заполнять по другому. Вы можете немного минимизировать подтормаживания, если будете делать в потоке всё по максимуму, оставив в основном потоке только цикл копирования записей. А чтобы убрать подтормаживания полностью нужно переписывать TClientDataSet.

На другой форме можете делать всё, что угодно. Но будут так же чувствоваться подтормаживания.
Цитировать

Добавить комментарий


Защитный код
Обновить