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
กลับมาอ่าน Blog ตัวเองเพื่อทำงานบางอย่าง
ReplyDelete