Execute Multiple SQL Script with FireDac (TFDScript)



MySQL Data Schema
  table students(
  id int,
  fname varchar(50),
  created datetime);


-----unit Unit1.pas----
unit Unit1;
{
  ///////////////////////////////////////
  MySql Data Schema.

  table students(
  id int,
  fname varchar(50),
  created datetime);
  ///////////////////////////////////////
}

interface

uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants,
  System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, FireDAC.Stan.Intf,
  FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf,
  FireDAC.Stan.Def, FireDAC.Stan.Pool, FireDAC.Stan.Async, FireDAC.Phys,
  FireDAC.Phys.MySQL, FireDAC.Phys.MySQLDef, FireDAC.VCLUI.Wait,
  FireDAC.Comp.ScriptCommands, FireDAC.Stan.Util, Vcl.StdCtrls,
  FireDAC.Comp.Script, FireDAC.Comp.Client, Data.DB;

type
  TForm1 = class(TForm)
    Test_dbmsConnection: TFDConnection;
    FDTransaction1: TFDTransaction;
    Button1: TButton;
    FDScript1: TFDScript;
    FDPhysMySQLDriverLink1: TFDPhysMySQLDriverLink;
    Cbx_ForuceError: TCheckBox;
    Memo1: TMemo;
    Cbx_BreakWhenError: TCheckBox;
    procedure Button1Click(Sender: TObject);
  private
    procedure LogSQL(const msg: TStrings);
    procedure Log(const msg: string);

    procedure myFDScriptError(ASender, AInitiator: TObject;
      var AException: Exception);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i: byte;
begin
  FDScript1.ScriptOptions.BreakOnError := Cbx_BreakWhenError.Checked;
  case Cbx_BreakWhenError.Checked of
    true:
      FDScript1.OnError := nil;
    false:
      FDScript1.OnError := myFDScriptError;
  end;

  FDScript1.SQLScripts.Clear;

  FDScript1.SQLScripts.Add;
  FDScript1.SQLScripts[0].SQL.Add('DELETE FROM STUDENTS;');
  for i := 1 to 5 do
  begin
    with FDScript1.SQLScripts[0].SQL do
    begin
      Add(format
        ('INSERT INTO STUDENTS(ID, FNAME, CREATED) VALUES(%d, %s, NOW());',
        [i, QuotedStr('Jane Smith')]));
    end;
  end;

  if Cbx_ForuceError.Checked then // force a bug with Primay key ID = 1
  begin
    for i := 1 to 2 do
    begin
      FDScript1.SQLScripts[0].SQL.Add
        (format('INSERT INTO STUDENTS(ID, FNAME, CREATED) VALUES(%d, %s, NOW());',
        [i, QuotedStr('John Smith')]));
    end;
  end;

  LogSQL(FDScript1.SQLScripts[0].SQL);
  try
    try
      FDTransaction1.StartTransaction;
      FDScript1.ValidateAll;
      FDScript1.ExecuteAll;
    except
      on e: EFDDBEngineException do
      begin
        Log('');
        Log(format('%s **' + e.Message,
          [formatdatetime('dd/mm/yyyy hh:mm:ss', now)]));
      end;
    end;
  finally
    if FDScript1.TotalErrors = 0 then
    begin
      try
        FDTransaction1.commit;
        Log('');
        Log('Commit scripts complete...');
      except
        FDTransaction1.Rollback;
        Log('');
        Log('Found error when commit.');
      end;
    end
    else
    begin
      Log('');
      Log('Error scripts ' + inttostr(FDScript1.TotalErrors));
      FDTransaction1.Rollback;
    end;
  end;
end;

procedure TForm1.Log(const msg: string);
begin
  Memo1.Lines.Add(msg);
end;

procedure TForm1.LogSQL(const msg: TStrings);
begin
  with Memo1.Lines do
  begin
    BeginUpdate;
    try
      Clear;
      AddStrings(msg);
      Add('');
    finally
      EndUpdate;
    end;
  end;
end;

procedure TForm1.myFDScriptError(ASender, AInitiator: TObject;
  var AException: Exception);
begin
  Log(format('%s ' + AException.Message,
    [formatdatetime('dd/mm/yyyy hh:mm:ss', now)]));
end;

end.


-----unit Unit1.dfm----

object Form1: TForm1
  Left = 0
  Top = 0
  Caption = 'MySQL Demo (Work with TFDScript. (03/08/2016)'
  ClientHeight = 242
  ClientWidth = 817
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  DesignSize = (
    817
    242)
  PixelsPerInch = 96
  TextHeight = 13
  object Button1: TButton
    Left = 8
    Top = 79
    Width = 130
    Height = 31
    Caption = 'EXECUTE SQL'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Cbx_ForuceError: TCheckBox
    Left = 8
    Top = 8
    Width = 137
    Height = 17
    Caption = 'Fource error. (Testing).'
    TabOrder = 1
  end
  object Memo1: TMemo
    Left = 168
    Top = 8
    Width = 641
    Height = 226
    Anchors = [akLeft, akTop, akRight, akBottom]
    Lines.Strings = (
      'Log SQL Scripts.')
    ScrollBars = ssBoth
    TabOrder = 2
  end
  object Cbx_BreakWhenError: TCheckBox
    Left = 8
    Top = 31
    Width = 137
    Height = 17
    Caption = 'Break when error'
    TabOrder = 3
  end
  object Test_dbmsConnection: TFDConnection
    Params.Strings = (
      'ConnectionDef=test_dbms')
    LoginPrompt = False
    Left = 364
    Top = 82
  end
  object FDTransaction1: TFDTransaction
    Options.AutoStart = False
    Options.AutoStop = False
    Connection = Test_dbmsConnection
    Left = 320
  end
  object FDScript1: TFDScript
    SQLScripts = <>
    Connection = Test_dbmsConnection
    Transaction = FDTransaction1
    Params = <>
    Macros = <>
    Left = 256
    Top = 128
  end
  object FDPhysMySQLDriverLink1: TFDPhysMySQLDriverLink
    Left = 376
    Top = 152
  end
end

Comments

  1. กลับมาอ่าน Blog ตัวเองเพื่อทำงานบางอย่าง

    ReplyDelete

Post a Comment