Продолжаю практиковаться с потоками в FireDAC. Расширим немного, приложение описанное ранее. Теперь приложение будет уметь не только записывать в базу, но и выводить датасеты в отдельных потоках.
В данной статье подробно опишу вывод датасетов в отдельных потоках на главную форму. В документации сказано, что работа с потоками безопасна, если внутри каждого потока создавать, например, FDConnection, FDQuery, DataSource и синхронизировать вывод на главную форму, например в DBGrid. Что же, проделаем это. Результат получится примерно таким.
По нажатию копки будет создаваться поток, внутри которого будут создаваться FDConnection, FDQuery, DataSource и данные будут выводиться на главную форму с синхронизацией с главным потоком.
Начнем!
Структура приложения будет примерно следующей
Создадим VCL приложение
Здесь у нас панели, на которых кнопки и DBGrid, снизу StatusBar, есть также TopPanel, на которой кнопка вставки записей по технологии ArrayDML.
Создадим также DataModule и добавим на него следующие компоненты
Файл FDDrivers.ini
По традиции положим его рядом с EXE и пропишем в нём следующее
Код MainUnit
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 |
unit MainUnit; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls,ArrayDMLThreadUnit, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Param, FireDAC.Stan.Error, FireDAC.DatS, FireDAC.Phys.Intf, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, Vcl.ExtCtrls, Vcl.ComCtrls, Vcl.Grids, Vcl.DBGrids, NamesThread, FireDAC.UI.Intf, FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Phys, FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef, FireDAC.VCLUI.Wait,FamiliesThread; type TForm1 = class(TForm) TopPanel: TPanel; AddRecords: TButton; StatusBar1: TStatusBar; NamePanel: TPanel; bOpenNames: TButton; DBGridNames: TDBGrid; FamilyPanel: TPanel; bOpenFamilies: TButton; DBGridFamilies: TDBGrid; bTerminate: TButton; procedure AddRecordsClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure bOpenNamesClick(Sender: TObject); procedure bOpenFamiliesClick(Sender: TObject); procedure bTerminateClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; ArrayDMLThread:TArrayDMLThread; NamesThread:TNamesThread; FamiliesThread:TFamiliesThread; implementation {$R *.dfm} procedure TForm1.AddRecordsClick(Sender: TObject); var s:string; begin try StatusBar1.Panels[0].Text:=''; InputQuery('Сколько записей добавить?','Число записей',s); ArrayDMLThreadUnit.ArraySize:=s.ToInteger(); except end; // if not Assigned(ArrayDMLThread) then if Assigned(ArrayDMLThread) and not (ArrayDMLThread.CheckTerminated) then begin ArrayDMLThread.Terminate; ArrayDMLThread.Free; end; ArrayDMLThread:=TArrayDMLThread.Create(false); ArrayDMLThread.FreeOnTerminate:=false; end; procedure TForm1.bOpenFamiliesClick(Sender: TObject); begin if Assigned(FamiliesThread) and not ( FamiliesThread.CheckTerminated) then begin FamiliesThread.Terminate; FamiliesThread.Free; end; //Запускаем новый экземпляр FamiliesThread:=TFamiliesThread.Create(false); FamiliesThread.FreeOnTerminate:=false; end; procedure TForm1.bOpenNamesClick(Sender: TObject); begin //Освобождаем память от предыдущего экземпляра потока if Assigned(NamesThread) and not (NamesThread.CheckTerminated) then begin NamesThread.Terminate; NamesThread.Free; end; //Запускаем новый экземпляр NamesThread:=TNamesThread.Create(false); NamesThread.FreeOnTerminate:=false; end; procedure TForm1.bTerminateClick(Sender: TObject); begin NamesThread.Terminate; //if NamesThread.Finished then showmessage('Terminated'); NamesThread.Free; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin //if Assigned(ArayDMLThread) then ArayDMLThread.Terminate; Application.Terminate; end; end. |
Код юнита DataModule
Здесь в OnCreate мы создаем Private определение соединения, которыми будут пользоваться различные FDConnections в потоках. Также, есть дополнительные функции.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 |
unit DataModule; interface uses System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Phys, FireDAC.Comp.Client, FireDAC.Phys.MySQLDef, FireDAC.Phys.MySQL, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet; type TDataModule1 = class(TDataModule) FDManager1: TFDManager; FDPhysMySQLDriverLink1: TFDPhysMySQLDriverLink; function IsConnectionDef(AName:string):boolean; procedure CreateMyConnDefName(Sender: TObject); procedure DataModuleCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var DataModule1: TDataModule1; implementation {%CLASSGROUP 'Vcl.Controls.TControl'} {$R *.dfm} { TDataModule1 } procedure TDataModule1.CreateMyConnDefName(Sender: TObject); var oParams:TStrings; DriverID:string; begin // Если уже создано - выходим if IsConnectionDef('MyConnDefName')=true then exit; // Определяем название драйвера DriverID:='MySQL23'; //Создание переменной oParams := TStringList.Create; oParams.Add('DriverID='+DriverID); oParams.Add('DataBase=aphina_db'); oParams.Add('Password=masterkey'); oParams.Add('User_Name=root'); oParams.Add('Port=3306'); oParams.Add('Server=localhost'); // Cоздание и добавление нового ConnectionDef FDManager1.AddConnectionDef('MyConnDefName',DriverID , oParams); //Освобождение переменной oParams.Free; end; procedure TDataModule1.DataModuleCreate(Sender: TObject); begin Self.CreateMyConnDefName(Self); FDManager1.Active:=true; end; function TDataModule1.IsConnectionDef(AName: string): boolean; //Вспомогательная функция определения существования ConnectionDef var i:integer; SL:TStringlist; begin SL:=TStringList.Create; //Загоняем все имена Connection Defs в SL for i := 0 to FDManager1.ConnectionDefs.Count-1 do SL.Add(FDManager1.ConnectionDefs.Items[i].Name); //Ищем AName в SL, проверем существование if Sl.IndexOf(AName)<>-1 then result:=true // Найдено else Result:=false; // Не найдено SL.Free; end; end. |
Код юнита потока NamesThread
Этот поток будет отвечать за получение следующего датасета
|
1 |
SELECT idUsers,name FROM aphina_db.users; |
Собственно создание юнита
File > New > Others > Thread Object
Код юнита
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 |
unit NamesThread; interface uses System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Phys, FireDAC.Comp.Client, FireDAC.Phys.MySQLDef, FireDAC.Phys.MySQL, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet,vcl.dialogs; type TNamesThread = class(TThread) FDConnectionNames:TFDConnection; FDQueryNames:TFDQuery; DataSourceNames:TDataSource; private FTerminated:Boolean; procedure showConnected; procedure showNamesOnMainForm; public function CheckTerminated:boolean; destructor Destroy;override; protected procedure Execute; override; end; implementation { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure TNamesThread.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; or Synchronize( procedure begin Form1.Caption := 'Updated in thread via an anonymous method' end ) ); where an anonymous method is passed. Similarly, the developer can call the Queue method with similar parameters as above, instead passing another TThread class as the first parameter, putting the calling thread in a queue with the other thread. } uses MainUnit; { TNamesThread } { constructor TNamesThread.Create; begin inherited Create(Self); showmessage('Поток запущен'); end;} function TNamesThread.CheckTerminated: boolean; begin if Self.Terminated then Result:=true else Result:=false; end; destructor TNamesThread.Destroy; begin FDConnectionNames.Free; FDQueryNames.Free; DataSourceNames.Free; inherited; end; procedure TNamesThread.Execute; begin NameThreadForDebugging('MyNamesThread'); { Place thread code here } //Создаем соединение FDConnectionNames:=TFDConnection.Create(nil); FDConnectionNames.ConnectionDefName:='MyConnDefName'; FDConnectionNames.Connected:=true; if FDConnectionNames.Connected then Synchronize(showConnected); //Создаем FDQuery FDQueryNames:=TFDQuery.Create(nil); FDQueryNames.Connection:=FDConnectionNames; //Делаем запрос FDQueryNames.SQL.Clear; FDQueryNames.SQL.Text:='SELECT idUsers,name FROM aphina_db.users;'; FDQueryNames.Open; //Создаем DataSource DataSourceNames:=TDataSource.Create(nil); DataSourceNames.DataSet:=FDQueryNames; DataSourceNames.Enabled:=true; //Отображаем на главной форме Synchronize(showNamesOnMainForm); if Self.Terminated then MainUnit.form1.StatusBar1.Panels[0].Text:=('Terminated') else MainUnit.form1.StatusBar1.Panels[0].Text:=(' Not Terminated'); end; procedure TNamesThread.showConnected; begin MainUnit.Form1.StatusBar1.Panels[0].Text:='FDConnectionNames Connected'; end; procedure TNamesThread.showNamesOnMainForm; begin MainUnit.Form1.DBGridNames.DataSource:=DataSourceNames; MainUnit.Form1.DBGridNames.Columns[0].FieldName:='idUsers'; MainUnit.Form1.DBGridNames.Columns[0].Width:=50; MainUnit.Form1.DBGridNames.Columns[1].FieldName:='name'; MainUnit.Form1.DBGridNames.Columns[1].Width:=80; end; end. |
Код юнита потока FamiliesThread
Здесь всё по аналогии, выводим фамилии
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 |
unit FamiliesThread; interface uses System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Phys, FireDAC.Comp.Client, FireDAC.Phys.MySQLDef, FireDAC.Phys.MySQL, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet; type TFamiliesThread = class(TThread) FDConnectionFamilies:TFDConnection; FDQueryFamilies:TFDQuery; DataSourceFamilies:TDataSource; public function CheckTerminated:boolean; procedure showConnected; procedure showFamiliesOnMainForm; protected procedure Execute; override; end; implementation { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure TNamesThread.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; or Synchronize( procedure begin Form1.Caption := 'Updated in thread via an anonymous method' end ) ); where an anonymous method is passed. Similarly, the developer can call the Queue method with similar parameters as above, instead passing another TThread class as the first parameter, putting the calling thread in a queue with the other thread. } uses MainUnit; { TNamesThread } function TFamiliesThread.CheckTerminated: boolean; begin if Self.Terminated then Result:=true else Result:=false; end; procedure TFamiliesThread.Execute; begin { Place thread code here } //Создаем соединение FDConnectionFamilies:=TFDConnection.Create(nil); FDConnectionFamilies.ConnectionDefName:='MyConnDefName'; FDConnectionFamilies.Connected:=true; if FDConnectionFamilies.Connected then Synchronize(showConnected); //Создаем FDQuery FDQueryFamilies:=TFDQuery.Create(nil); FDQueryFamilies.Connection:=FDConnectionFamilies; //Делаем запрос FDQueryFamilies.SQL.Clear; FDQueryFamilies.SQL.Text:='SELECT idUsers,Family FROM aphina_db.users;'; FDQueryFamilies.Open; //Создаем DataSource DataSourceFamilies:=TDataSource.Create(nil); DataSourceFamilies.DataSet:=FDQueryFamilies; DataSourceFamilies.Enabled:=true; //Отображаем на главной форме Synchronize(showFamiliesOnMainForm); end; procedure TFamiliesThread.showConnected; begin MainUnit.Form1.StatusBar1.Panels[0].Text:='FDConnectionFamilies Connected'; end; procedure TFamiliesThread.showFamiliesOnMainForm; begin MainUnit.Form1.DBGridFamilies.DataSource:=DataSourceFamilies; MainUnit.Form1.DBGridFamilies.Columns[0].FieldName:='idUsers'; MainUnit.Form1.DBGridFamilies.Columns[0].Width:=50; MainUnit.Form1.DBGridFamilies.Columns[1].FieldName:='Family'; MainUnit.Form1.DBGridFamilies.Columns[1].Width:=80; end; end. |
Код ArrayDMLThreadUnit
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 |
unit ArrayDMLThreadUnit; interface uses System.SysUtils, System.Classes, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def, FireDAC.Phys, FireDAC.Comp.Client, FireDAC.Phys.MySQLDef, FireDAC.Phys.MySQL, FireDAC.Stan.Param, FireDAC.DatS, FireDAC.DApt.Intf, FireDAC.Stan.Async, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet,vcl.dialogs; type TArrayDMLThread = class(TThread) FDConnectionDML:TFDConnection; FDQueryDML:TFDQuery; procedure UpdateLabel; private { Private declarations } protected procedure Execute; override; end; Var ArraySize:Integer; implementation { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure TArrayDML.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; or Synchronize( procedure begin Form1.Caption := 'Updated in thread via an anonymous method' end ) ); where an anonymous method is passed. Similarly, the developer can call the Queue method with similar parameters as above, instead passing another TThread class as the first parameter, putting the calling thread in a queue with the other thread. } uses DataModule, MainUnit; { TArrayDML } procedure TArrayDMLThread.Execute; var i:integer; begin //Создаем соединение FDConnectionDML:=TFDConnection.Create(nil); FDConnectionDML.ConnectionDefName:='MyConnDefName'; FDConnectionDML.Connected:=true; //if FDConnectionDML.Connected then showmessage('Connected'); //Создаем FDQuery FDQueryDML:=TFDQuery.Create(nil); FDQueryDML.Connection:=FDConnectionDML; //Чистим базу FDQueryDML.SQL.Clear; FDQueryDML.SQL.Add('delete from users'); FDQueryDML.ExecSQL; //Чистим параметры FDQueryDML.Params.Clear; //Заполняем FDQueryDML.SQL.Text:=( 'INSERT INTO `aphina_db`.`users` (`idUsers`,`Name`, `Family`, `Role`, `Login`, `Password`, `E-mail`, `Balance`)'+ 'VALUES (:idUsers,:name, :family, :role, :login, :password, :email, :balance);' ); FDQueryDML.Params.ArraySize:=ArraySize; for i := 0 to ArraySize-1 do begin //Так FDQueryDML.ParamByName('idUsers').AsIntegers[i]:=i+1; FDQueryDML.ParamByName('name').AsStrings[i]:='SomeName'; FDQueryDML.ParamByName('family').AsStrings[i]:='SomeFamily'; FDQueryDML.ParamByName('role').AsStrings[i]:='SomeRole'; FDQueryDML.ParamByName('login').AsStrings[i]:='SomeLogin'; FDQueryDML.ParamByName('password').AsStrings[i]:='SomePassword'; FDQueryDML.ParamByName('email').AsStrings[i]:='SomeEmail'; FDQueryDML.ParamByName('balance').AsFloats[i]:=2000.12; { //Либо так... FDQueryDML.Params[0].AsIntegers[i]:=i+1; FDQueryDML.Params[1].AsStrings[i]:='someName'; FDQueryDML.Params[2].AsStrings[i]:='someFamily'; FDQueryDML.Params[3].AsStrings[i]:='someRole'; FDQueryDML.Params[4].AsStrings[i]:='someLogin'; FDQueryDML.Params[5].AsStrings[i]:='somePassword'; FDQueryDML.Params[6].AsStrings[i]:='someE-mail'; FDQueryDML.Params[7].AsFloats[i]:=10.12; } end; FDQueryDML.ResourceOptions.ArrayDMLSize:=2147483647; FDQueryDML.Execute(ArraySize,0); FDQueryDML.Free; FDConnectionDML.Free; Synchronize(UpdateLabel); { Place thread code here } end; { TMyClass } procedure TArrayDMLThread.UpdateLabel; begin MainUnit.Form1.StatusBar1.Panels[0].Text:='Записи успешно добавлены в таблицу'; end; end. |
Тестируем приложение
Жмем на OpenNames и на OpenFamilies и получаем наши датасеты.
Всё работает корректно! Тема для меня показалась не самой простой, особенно сложным был момент с созданием кода для уничтожения старого экземпляра потока, и созданием нового, на примере NamesThread, на кнопке OpenNames это выглядит так…
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 |
procedure TForm1.bOpenNamesClick(Sender: TObject); begin //Освобождаем память от предыдущего экземпляра потока if Assigned(NamesThread) and not (NamesThread.CheckTerminated) then begin NamesThread.Terminate; NamesThread.Free; end; //Запускаем новый экземпляр NamesThread:=TNamesThread.Create(false); NamesThread.FreeOnTerminate:=false; end; |
При этом функции или свойства Terminated для потока извне нет, поэтому для удобства я её дописал. У меня получилось так. Я объявил её в секции public
|
1 2 3 4 5 |
function TNamesThread.CheckTerminated: boolean; begin if Self.Terminated then Result:=true else Result:=false; end; |
Но наверное для новых неизученных тем это нормально – сначала что-то кажется трудным, потом же как будто всю жизнь знал))
Второй момент. Переписывание деструкторов. Поскольку компоненты у нас создаются с владельцем nil, то пришлось самому дописывать деструкторы на уничтожение потоков, для NamesThread, например это выглядит так…
|
1 2 3 4 5 6 7 8 9 10 11 |
destructor TNamesThread.Destroy; begin FDConnectionNames.Free; FDQueryNames.Free; DataSourceNames.Free; inherited; end; |
Исходники
На всякий случай прикладываю исходник.
Там 2 проекта в ProjectGroup
Тот, который я описал в данной статье называется ProjectDynamicDataSets2
Дамп базы MySQL для тестов