В некоторых случаях нам приходится делать асинхронную загрузку данных из базы. Ведь так пользователь может почти сразу увидеть первые фрагменты данных по мере их загрузки, не дожидаясь, пока будет загружено всё полностью. Ещё пользователь получит возможность отменить загрузку в любой момент, пока она происходит. Ну и конечно, асинхронная загрузка позволяет сделать, например, многозакладочный пользовательский интерфейс, на каждой закладке которого можно будет параллельно загружать разные данные. В этой статье я приведу решение, которое позволит сделать асинхронную пошаговую загрузку данных в таблицу в 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.
Теперь нужно задать свойства соединения в свойстве 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
Теперь попробуем выполнить этот запрос асинхронно. Для этого установите у свойства 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
Загрузка из примера выше работает прекрасно, пока вы не нажмёте на кнопку «Отмена». Здесь есть 2 проблемы:
- Когда данные уже начали загружаться на клиента, отмена не срабатывает. Вместо отмены программа зависает на строчке «ADOQuery1.Recordset.Cancel;», пока все данные полностью не загрузятся.
- После вызова функции «ADOQuery1.Recordset.Cancel;» (если конечно запрос реально отменился, см. п. 1), повторно выполнить запрос не получится, т.к. вызов метода «ADOQuery1.Open;» не произведёт никаких действий. Это происходит из-за того, что компонент ADOQuery1 остаётся закрытым (Active = False), но в то же время его статус показывает, что запрос открывается (State = dsOpening). Это наглядно показывает на то, что обёртки VCL над ADO не поддерживают отмену.
Первую проблему можно попробовать обойти одним из трёх способов:
- Поменять драйвер, если другой драйвер у вас есть. Но, может случиться так, что нужного вам драйвера не существует или БД не поддерживает отмену запросов.
- Использовать серверный курсор (для этого нужно выставить у компонента ADOQuery1 свойство CursorLocation в clUseServer). Но с серверным курсором вы не сможете узнать количество записей и для отображения данных нужно постоянное подключение к СУБД. Поэтому, чтобы работать с данными на клиенте, вам придётся скопировать их в оперативную память (например, в компонент TClientDataSet) или в локальную базу данных, если объём данных очень большой. А чтение всех данных из серверного курсора происходит медленно.
- Сделать фиктивную остановку загрузки. Т.е. показывать пользователю, что запрос отменён, а на самом деле давать запросу выполниться до конца и только после этого его удалять. Можно, конечно удалять компоненты 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 записей.
Поэтому, если вам нужно загрузить на компьютер пользователя большой объём данных, нужно искать другой способ. Приведённый пример загрузки и хранения данных в оперативной памяти подойдёт только для небольших объёмов.
Асинхронная пошаговая загрузка данных в 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 напрямую. Кода, конечно, будет намного больше, но в этом случае всё будет работать. В статье я не буду приводить таких примеров, т.к. это будет довольно объёмный код. Но если вы заинтересованы, пишите об этом в комментариях.
Комментарии
И что будет есть во время выполнения этого запроса, запустить открытия кверика на другой форме?))
Форма не зависает, но лёгкие подтормаживания, конечно, есть, когда происходит копирование в TClientDataSet, т.к. это происходит в основном потоке. К сожалению, TClientDataSet не получится заполнять по другому. Вы можете немного минимизировать подтормаживания, если будете делать в потоке всё по максимуму, оставив в основном потоке только цикл копирования записей. А чтобы убрать подтормаживания полностью нужно переписывать TClientDataSet.
На другой форме можете делать всё, что угодно. Но будут так же чувствоваться подтормаживания.
RSS лента комментариев этой записи