FireDAC. Добавление 1000 записей в отдельном потоке

В данной статье попрактикуемся работать c потоками в технологии FireDAC. В переводе документации мы уже познакомились с теорией, здесь же будет небольшой практический пример. Используем также, технику ArrayDML, позволяющую создать большое число записей с минимальными затратами, описанную ранее. Вот что у нас получится.

Если кратко, в документации советуется создавать FDConnection и, например FDQuery или любой другой компонент, внутри потока для каждого Dataset или для каждой отдельной операции с данными, насколько я понял – вставки, запросов, обновления и так далее.

В данном примере будем создавать в отдельном потоке FDConnection и FDQuery для вставки 1000 записей. Цель – научиться и закрепить навыки.

Начали!

Создадим VCL приложение и добавим 1 кнопку и 1 Label

Создадим отдельный DataModule и добавим на него следующие компоненты.

Создадим модуль с потоком File > New > Other >

При создании модуля потока Delphi запросила у меня название класса, я ввел TArrayDMLThread

Сохраним все наши файлы и проект в любой удобной папке.

Файл FDDrivers.ini

Скомпилируем и запустим нашу программу, чтобы получить EXE. Далее, как и всегда – положим FDDrivers.ini с EXE файлом нашей программы.

В нём пропишем следующее

DataModule

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 }

// Процедура создания ConnectionDef
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;

//DataModuleCreate
procedure TDataModule1.DataModuleCreate(Sender: TObject);
begin

   Self.CreateMyConnDefName(Self); //<<Создаем ConnectionDef
   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.

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 }

// Процедура создания ConnectionDef

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;

//DataModuleCreate

procedure TDataModule1.DataModuleCreate(Sender: TObject);

begin

Self.CreateMyConnDefName(Self); //<<Создаем ConnectionDef

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.

ArrayDMLThreadUnit

Здесь и будет самая основная магия – всё будет создаваться динамически, внутри потока! Единственное, что выходит за пределы потока – это отображение на Label главной формы записи о том, что результат успешный.

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 NamePar:TFdParam; 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]:='name';
      FDQueryDML.ParamByName('family').AsStrings[i]:='family';
      FDQueryDML.ParamByName('role').AsStrings[i]:='role';
      FDQueryDML.ParamByName('login').AsStrings[i]:='login';
      FDQueryDML.ParamByName('password').AsStrings[i]:='password';
      FDQueryDML.ParamByName('email').AsStrings[i]:='email';
      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.Execute(ArraySize,0);

FDQueryDML.Free;
FDConnectionDML.Free;

Synchronize(UpdateLabel);
  { Place thread code here }
end;

{ TMyClass }


procedure TArrayDMLThread.UpdateLabel;
begin
MainUnit.Form1.myLabel.Caption:='Записи успешно добавлены в таблицу';;
end;

end.

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

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;

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 NamePar:TFdParam; 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]:='name';

FDQueryDML.ParamByName('family').AsStrings[i]:='family';

FDQueryDML.ParamByName('role').AsStrings[i]:='role';

FDQueryDML.ParamByName('login').AsStrings[i]:='login';

FDQueryDML.ParamByName('password').AsStrings[i]:='password';

FDQueryDML.ParamByName('email').AsStrings[i]:='email';

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.Execute(ArraySize,0);

FDQueryDML.Free;

FDConnectionDML.Free;

Synchronize(UpdateLabel);

{ Place thread code here }

end;

{ TMyClass }

procedure TArrayDMLThread.UpdateLabel;

begin

MainUnit.Form1.myLabel.Caption:='Записи успешно добавлены в таблицу';;

end;

end.

MainUnit

Здесь всего одна самая интересная процедура – запуск потока по клику!!!

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;

type
  TForm1 = class(TForm)
    AddRecords: TButton;
    myLabel: TLabel;
    procedure AddRecordsClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  ArayDMLThread:TArrayDMLThread;

implementation

{$R *.dfm}



procedure TForm1.AddRecordsClick(Sender: TObject);
var s:string;
begin

 InputQuery('Сколько записей добавить?','Число записей',s);
 ArrayDMLThreadUnit.ArraySize:=s.ToInteger();

 ArayDMLThread:=TArrayDMLThread.Create(false);
 ArayDMLThread.FreeOnTerminate:=true;

 end;

end.

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;

type

TForm1 = class(TForm)

AddRecords: TButton;

myLabel: TLabel;

procedure AddRecordsClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

ArayDMLThread:TArrayDMLThread;

implementation

{$R *.dfm}

procedure TForm1.AddRecordsClick(Sender: TObject);

var s:string;

begin

InputQuery('Сколько записей добавить?','Число записей',s);

ArrayDMLThreadUnit.ArraySize:=s.ToInteger();

ArayDMLThread:=TArrayDMLThread.Create(false);

ArayDMLThread.FreeOnTerminate:=true;

end;

end.

Тестируем!

Для теста можно взять и побольше записей, скажем 100 000, посмотрим как отработает программа и проверим как добавились записи с помощью другого инструмента, например WorkBench!

Пока добавлялись записи я двигал мышкой окно, сворачивал, разворачивал его – всё работало как будто бы потока по добавлению записей и не было, но вот если посмотреть в WorkBench!

То процесс в самом разгаре!!!

FireDAC. Добавление 1000 записей в отдельном потоке

Начали!

Файл FDDrivers.ini

DataModule

ArrayDMLThreadUnit

MainUnit

Тестируем!

MY PROJECTS

Recent Posts

Categories