* Examples: database\sqlite_mushrooms: added Firebird embedded support

git-svn-id: trunk@46033 -

.gitattributes

@@ -4570,6 +4570,8 @@ examples/database/sqlite_mushrooms/images/Small-Conocybe_rugosa.jpg -text svneol
 examples/database/sqlite_mushrooms/images/Small-Destroying_Angel_02.jpg -text svneol=unset#image/jpeg
 examples/database/sqlite_mushrooms/images/Small-FalseMorel.JPG -text svneol=unset#image/jpeg
 examples/database/sqlite_mushrooms/images/Small-Galerina.jpg -text svneol=unset#image/jpeg
+examples/database/sqlite_mushrooms/imagetest.fbk -text
+examples/database/sqlite_mushrooms/mushrooms_firebird.sql svneol=native#text/plain
 examples/database/sqlite_mushrooms/project1.ico -text svneol=unset#image/ico
 examples/database/sqlite_mushrooms/project1.lpi svneol=native#text/plain
 examples/database/sqlite_mushrooms/project1.lpr svneol=native#text/pascal

examples/database/sqlite_mushrooms/Readme.txt

@@ -1,17 +1,32 @@
-MushRoomsDatabase by Jurassic Pork  - January 2014
+MushRoomsDatabase by Jurassic Pork using SQLite - January 2014
+Updated for Firebird Embedded - August 2014
+
 Features:
 - Use SqlDb and lazreport components.
-- Sqlite3 database DeadlyMushrooms with 5 mushrooms.
+- Sqlite3 or Firebird embedded database DeadlyMushrooms with 5 mushrooms.
+  Sqlite3 will be tried first; if no Sqlite library is available, Firebird 
+	embedded will be tried.
+- It demonstrates:
+  - creating a new SQLite3 database with table if the db does not exist
+  - use of TSQLScript to run multiple SQL statements
+  - use of FBAdmin to restore Firebird backup (smaller than the live .fdb file) 
+    on first run, useful for keeping your setup file small and compatible with
+    older Firebird versions
 - The images are stored in blob field without extension at the beginning.
-  With this you can view blob images with database browser editor (ex sqlite2009pro).
+  With this you can view blob images with database browser editor 
+  (e.g. sqlite2009pro).
 - In the database there is also a field with images links (filenames).
-- You can see the linked images in a Timage.
 - The linked images are stored in the folder images of the project.
-- You can change the images in the database :
+- You can see the linked images in a Timage.
-  - for Tdbimage double click on the component and choose your image.
+- You can change the images in the database:
-  - for Timage click on the button near the image filename.(you must be in edit mode )
+  - for Tdbimage (image in db): double click on the component and choose your 
-- Transaction commit when you click on Tdbnavigator refresh button or on close form.
+    image.
-- Small pictures of the mushrooms are in the sqlite3Database. Largest images are in files in the folder images.
+  - for Timage (linked image): click on the button near the image filename 
+    (you must be in edit mode).
+- Transaction commits when you click on Tdbnavigator refresh button or on close 
+  form.
+- Small pictures of the mushrooms are in the sqlite3Database. Largest images are
+  in files in the folder images.
 - Print button to print all the mushrooms (lazreport).
   On each page you have:
    - a title. 
@@ -20,4 +35,4 @@ Features:
    - the field picture of the mushroom database (picture picture1).
    - the picture of the field image_link (picture picture2).
 
-The report  name is Mushroom_Report.lrf
+The report name is Mushroom_Report.lrf

examples/database/sqlite_mushrooms/mushrooms_firebird.sql

@@ -0,0 +1,52 @@
+
+CREATE GENERATOR GEN_DEADLYMUSHROOMS_ID;
+
+CREATE TABLE DEADLYMUSHROOMS
+(
+  ID INTEGER NOT NULL,
+  SCIENTIFIC_NAME VARCHAR(200) NOT NULL,
+  COMMON_NAME VARCHAR(200),
+  "Order" VARCHAR(200),
+  GENUS VARCHAR(200),
+  NOTES BLOB SUB_TYPE 1,
+  PICTURE BLOB SUB_TYPE 0,
+  IMAGE_LINK VARCHAR(1000),
+  CONSTRAINT CPKDM_1 PRIMARY KEY (ID)
+);
+
+SET TERM ^ ;
+CREATE TRIGGER DEADLYMUSHROOMS_BI FOR DEADLYMUSHROOMS ACTIVE
+BEFORE INSERT POSITION 0
+AS
+DECLARE VARIABLE tmp DECIMAL(18,0);
+BEGIN
+  IF (NEW.ID IS NULL) THEN
+    NEW.ID = GEN_ID(GEN_DEADLYMUSHROOMS_ID, 1);
+  ELSE
+  BEGIN
+    tmp = GEN_ID(GEN_DEADLYMUSHROOMS_ID, 0);
+    if (tmp < new.ID) then
+      tmp = GEN_ID(GEN_DEADLYMUSHROOMS_ID, new.ID-tmp);
+  END
+END^
+SET TERM ; ^
+
+UPDATE RDB$GENERATORS set
+  RDB$DESCRIPTION = 'Generator (sequence) that gives a new unique ID. The trigger for the mushrooms table uses this.'
+  where RDB$GENERATOR_NAME = 'GEN_DEADLYMUSHROOMS_ID';
+UPDATE RDB$RELATION_FIELDS set RDB$DESCRIPTION = 'Unique ID; primary key'  where RDB$FIELD_NAME = 'ID' and RDB$RELATION_NAME = 'DEADLYMUSHROOMS';
+UPDATE RDB$RELATION_FIELDS set RDB$DESCRIPTION = 'Scientific name (often Latin) of the mushroom'  where RDB$FIELD_NAME = 'SCIENTIFIC_NAME' and RDB$RELATION_NAME = 'DEADLYMUSHROOMS';
+UPDATE RDB$RELATION_FIELDS set RDB$DESCRIPTION = 'Common or garden name for the mushroom'  where RDB$FIELD_NAME = 'COMMON_NAME' and RDB$RELATION_NAME = 'DEADLYMUSHROOMS';
+UPDATE RDB$RELATION_FIELDS set RDB$DESCRIPTION = 'Free-form notes about the mushroom'  where RDB$FIELD_NAME = 'NOTES' and RDB$RELATION_NAME = 'DEADLYMUSHROOMS';
+UPDATE RDB$RELATION_FIELDS set RDB$DESCRIPTION = 'BLOB containing picture data'  where RDB$FIELD_NAME = 'PICTURE' and RDB$RELATION_NAME = 'DEADLYMUSHROOMS';
+UPDATE RDB$RELATION_FIELDS set RDB$DESCRIPTION = 'Location of image in file system'  where RDB$FIELD_NAME = 'IMAGE_LINK' and RDB$RELATION_NAME = 'DEADLYMUSHROOMS';
+UPDATE RDB$RELATIONS set
+RDB$DESCRIPTION = 'Table of mushroom names and images'
+where RDB$RELATION_NAME = 'DEADLYMUSHROOMS';
+UPDATE RDB$TRIGGERS set
+  RDB$DESCRIPTION = 'Trigger that gives a new unique ID on each insert in the mushroom table if an ID hasn''t been provided in the SQL. Emulates the autonumber/autoincrement functionality of other databases but is more powerful.'
+  where RDB$TRIGGER_NAME = 'DEADLYMUSHROOMS_BI';
+GRANT DELETE, INSERT, REFERENCES, SELECT, UPDATE
+ ON DEADLYMUSHROOMS TO  SYSDBA WITH GRANT OPTION;
+GRANT DELETE, INSERT, REFERENCES, SELECT, UPDATE
+ ON DEADLYMUSHROOMS TO  PUBLIC;

examples/database/sqlite_mushrooms/project1.lpi

@@ -48,7 +48,6 @@
       <Unit0>
         <Filename Value="project1.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="project1"/>
       </Unit0>
       <Unit1>
         <Filename Value="unit1.pas"/>
@@ -82,12 +81,6 @@
         </Win32>
       </Options>
     </Linking>
-    <Other>
-      <CompilerMessages>
-        <MsgFileName Value=""/>
-      </CompilerMessages>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="3">

examples/database/sqlite_mushrooms/unit1.lfm

@@ -206,7 +206,7 @@ object Form1: TForm1
   end
   object DBEdit1: TDBEdit
     Left = 128
-    Height = 23
+    Height = 21
     Top = 408
     Width = 166
     DataField = 'Image_Link'
@@ -235,32 +235,32 @@ object Form1: TForm1
     Columns = <    
       item
         Title.Caption = 'Common Name'
-        Width = 108
+        Width = 86
         FieldName = 'Common_Name'
       end    
       item
         Title.Caption = 'Scientific Name'
-        Width = 110
+        Width = 87
         FieldName = 'Scientific_Name'
       end    
       item
         Title.Caption = 'Order'
-        Width = 49
+        Width = 43
         FieldName = 'Order'
       end    
       item
         Title.Caption = 'Genus'
-        Width = 53
+        Width = 45
         FieldName = 'Genus'
       end    
       item
         Title.Caption = 'ID'
-        Width = 28
+        Width = 26
         FieldName = 'ID'
       end    
       item
         Title.Caption = 'Notes'
-        Width = 49
+        Width = 43
         FieldName = 'Notes'
       end>
     DataSource = Datasource1
@@ -277,8 +277,8 @@ object Form1: TForm1
     BevelOuter = bvNone
     BorderWidth = 2
     BorderStyle = bsSingle
-    ClientHeight = 326
+    ClientHeight = 324
-    ClientWidth = 320
+    ClientWidth = 318
     ParentColor = False
     TabOrder = 6
     object Image1: TImage
@@ -303,8 +303,8 @@ object Form1: TForm1
     BevelOuter = bvNone
     BorderWidth = 2
     BorderStyle = bsSingle
-    ClientHeight = 326
+    ClientHeight = 324
-    ClientWidth = 160
+    ClientWidth = 158
     ParentColor = False
     TabOrder = 7
     object DBImage1: TDBImage
@@ -325,17 +325,17 @@ object Form1: TForm1
   end
   object Label1: TLabel
     Left = 8
-    Height = 15
+    Height = 13
     Top = 55
-    Width = 25
+    Width = 18
     Caption = 'Link'
     ParentColor = False
   end
   object Label2: TLabel
     Left = 360
-    Height = 15
+    Height = 13
     Top = 55
-    Width = 26
+    Width = 20
     Caption = 'Blob'
     ParentColor = False
   end
@@ -350,16 +350,16 @@ object Form1: TForm1
   end
   object Label3: TLabel
     Left = 8
-    Height = 15
+    Height = 13
     Top = 424
-    Width = 36
+    Width = 30
     Caption = 'Note :'
     ParentColor = False
   end
   object Datasource1: TDataSource
     DataSet = SQLQuery1
     OnDataChange = Datasource1DataChange
-    left = 216
+    left = 232
     top = 192
   end
   object OpenDialog1: TOpenDialog
@@ -381,7 +381,7 @@ object Form1: TForm1
     Active = False
     Action = caCommitRetaining
     Database = SQLite3Connection1
-    left = 208
+    left = 232
     top = 120
   end
   object SQLite3Connection1: TSQLite3Connection
@@ -411,4 +411,11 @@ object Form1: TForm1
     left = 464
     top = 344
   end
+  object IBConnection1: TIBConnection
+    Connected = False
+    LoginPrompt = False
+    KeepConnection = False
+    left = 152
+    top = 120
+  end
 end

examples/database/sqlite_mushrooms/unit1.pas

@@ -1,5 +1,6 @@
 unit Unit1;
-// J.P  August 2013
+// J.P. August 2013
+// Firebird embedded support added 2014
 {$mode objfpc}{$H+}
 
 interface
@@ -7,7 +8,7 @@ interface
 uses
   Classes, SysUtils, FileUtil, LR_Class, LR_DBSet, Forms, Controls, Graphics,
   Dialogs, DbCtrls, Buttons, ExtCtrls, StdCtrls, DBGrids,
-  db, sqldb, sqlite3conn, Grids;
+  db, sqldb, sqlite3conn, ibconnection, fbadmin, Grids;
 
 type
 
@@ -26,6 +27,7 @@ type
     DBText1: TDBText;
     frDBDataSet1: TfrDBDataSet;
     frReport1: TfrReport;
+    IBConnection1: TIBConnection;
     Image1: TImage;
     Label1: TLabel;
     Label2: TLabel;
@@ -49,9 +51,16 @@ type
     procedure frReport1EnterRect(Memo: TStringList; View: TfrView);
   private
     { private declarations }
+    FUsingFirebird: boolean; //indicates whether we're using Firebird (true) or SQLite3 (false)
+    // Updates linked image field with image named in DBEdit1.Text
+    // Shows image to user
     procedure UpdateImageLink;
+    // Lets user change image stored in database blob field
     procedure ChangeImage;
+    // Load image from file into database blob
     procedure LoadDbImage(aFileName: string);
+    // Recreates mushroom database
+    // for either SQLite3 (empty) or Firebird (filled)
     function RecreateDB: boolean;
   public
     { public declarations }
@@ -64,6 +73,11 @@ implementation
 
 {$R *.lfm}
 
+const
+  FirebirdDB='ImageTest.fdb'; //database file for Firebird
+  SQLiteDB='ImageTest.db3'; //database file for SQLite3
+
+
 { TForm1 }
 
 procedure TForm1.Button1Click(Sender: TObject);
@@ -106,8 +120,8 @@ procedure TForm1.DBNavigator1BeforeAction(Sender: TObject;
 begin
   if Button = nbRefresh then
   begin
-   SQLQuery1.ApplyUpdates;
+    SQLQuery1.ApplyUpdates;
-   SQLTransaction1.CommitRetaining;
+    SQLTransaction1.CommitRetaining;
   end;
 end;
 
@@ -120,36 +134,113 @@ end;
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   SQLQuery1.Close;
-  SQLite3Connection1.DatabaseName:= ExtractFilePath(ParamStr(0)) + 'ImageTest.db3';
+
-  try
+  // First try SQLite3 database in application directory
-    SQLQuery1.Active := true;
+  // If no sqlite3 driver is found, try Firebird
-  except
+  FUsingFirebird := false; //try sqlite first
-    on E:Exception do begin
+  if not(FUsingFirebird) then
-      //WriteLn(E.ClassName,': '+E.Message);
+  begin
-      if RecreateDb then begin
+    SQLite3Connection1.DatabaseName:=ExtractFilePath(ParamStr(0)) + SQLiteDB;
-        SQLQuery1.Active := true;
+    try
-        ShowMessage('The database has been recreated');
+      SQLQuery1.Active := true;
+    except
+      on E:Exception do
+      begin
+        //ShowMessage('Exception: '+E.ClassName+': '+E.Message);
+        if E.ClassNameIs('EInOutError') then
+        // Assume 'Can not load SQLite client library "sqlite3.dll". Check your installation.' => but this text may change
+        begin
+          FUsingFirebird:=true;
+        end
+        else
+        begin
+          if RecreateDb then
+          begin
+            SQLQuery1.Active := true;
+            ShowMessage('The SQLite3 database has been recreated');
+          end
+          else
+          begin
+            ShowMessage('Failure to create SQLite3 databse. Aborting');
+            Application.Terminate;
+          end;
+        end;
       end;
     end;
+    Caption := Caption + ' (SQLite3)';
+  end;
+
+  if FUsingFirebird then
+  begin
+    // Try Firebird. We'll need to reconnect some components as they were
+    // set up for sqlite
+    // Hostname was already empty in Object Inspector so we use embedded
+    //IBConnection1.HostName:='';
+    IBConnection1.UserName:='SYSDBA'; //for embedded, this should be an existing name
+    IBConnection1.CharSet:='UTF8';
+    IBConnection1.Params.Add('PAGE_SIZE=16384'); //enough space for indexes etc
+    IBConnection1.DatabaseName:=ExtractFilePath(ParamStr(0)) + FirebirdDB;
+    IBConnection1.Transaction:=SQLTransaction1;
+    SQLTransaction1.Database:=IBConnection1;
+    SQLQuery1.DataBase:=IBConnection1;
+    try
+      SQLQuery1.Active:=true;
+    except
+      on I: EIBDatabaseError do
+      begin
+        // Check for database file not found error message
+        if (I.GDSErrorcode=335544344) and (pos('I/O error',i.message)>0) then
+        begin
+          if RecreateDb then
+          begin
+            SQLQuery1.Active := true;
+            ShowMessage('The Firebird database has been recreated');
+          end
+          else
+          begin
+            ShowMessage('Failure to create Firebird databse. Aborting');
+            Application.Terminate;
+          end;
+        end
+        else
+        begin
+          ShowMessage('Have tried SQLite3 and Firebird dbs without success. '+LineEnding+
+            'Exception: '+I.ClassName+': '+I.Message+LineEnding+
+            '(Firebird GDS Eror code: '+inttostr(I.GDSErrorCode)+')'+LineEnding+
+            'Aborting.');
+          Application.Terminate;
+        end;
+      end;
+      on E: Exception do
+      begin
+        ShowMessage('Have tried SQLite3 and Firebird dbs without success. '+LineEnding+
+          'Exception: '+E.ClassName+': '+E.Message+LineEnding+
+          'Aborting.');
+        Application.Terminate;
+      end;
+    end;
+    Caption := Caption + ' (Firebird embedded)';
   end;
 end;
 
 procedure TForm1.frReport1EnterRect(Memo: TStringList; View: TfrView);
 begin
-   if  (View.Name = 'Picture2') AND
+   if (View.Name = 'Picture2') AND
    (frDBDataSet1.DataSet.FieldByName('Image_Link').AsString <> '') then
-    TFrPictureView(View).Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) +
+     TFrPictureView(View).Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) +
-  'images' +  DirectorySeparator +  frDBDataSet1.DataSet.FieldByName('Image_Link').AsString);
+    'images' + DirectorySeparator + frDBDataSet1.DataSet.FieldByName('Image_Link').AsString);
 end;
 
 procedure TForm1.UpdateImageLink;
 var
   s: String;
 begin
-  if   DBEdit1.Text <> '' then begin
+  if DBEdit1.Text <> '' then
-    s := ExtractFilePath(ParamStr(0)) + 'images' +  DirectorySeparator +  DBEdit1.Text;
+  begin
+    s := ExtractFilePath(ParamStr(0)) + 'images' + DirectorySeparator + DBEdit1.Text;
     Image1.Picture.LoadFromFile(s);
-  end else
+  end
+  else
     Image1.Picture.Clear;
 end;
 
@@ -157,15 +248,18 @@ procedure TForm1.ChangeImage;
 var
   WasEditing: Boolean;
 begin
-  if SQLQuery1.Active then begin
+  if SQLQuery1.Active then
+  begin
     OpenDialog1.Filter :=
     'All image files (*.bmp,*.jpg,*.png,*.gif)|*.bmp;*.jpg;*.png;*.gif|' +
     'BMP files (*.bmp)|*.bmp|' +
     'JPEG files (*.jpg)|*.jpg|' +
     'PNG files (*.png)|*.png|' +
-    'GIF files (*.gif)|*.gif';
+    'GIF files (*.gif)|*.gif' +
+    'TIFF files (*.tiff)|*.tiff;*.tif';
     OpenDialog1.InitialDir := ExtractFilePath(ParamStr(0)) + 'images';
-    if OpenDialog1.Execute then begin
+    if OpenDialog1.Execute then
+    begin
       WasEditing := (SQLQuery1.State = dsEdit);
       if not WasEditing then
         SQLQuery1.Edit;
@@ -179,27 +273,109 @@ end;
 
 procedure TForm1.LoadDbImage(aFileName: string);
 begin
+  // Disabling writeheader means the image is compatible with Delphi TDBImage applications
+  // and other applications that only expect raw jpg data in the database blob.
+  // However, it makes it a bit more difficult to mix various kinds of image types
+  // e.g. jpg and tiff in the same database fields.
+  // Fortunately, Lazarus can deal with that for us.
   DbImage1.WriteHeader:=false;
   DbImage1.Picture.LoadFromFile(aFileName);
 end;
 
 function TForm1.RecreateDB: boolean;
+var
+  BackupFile: string;
+  DBFile: string;
+  FBAdmin: TFBAdmin;
+  SQLInstructions: string; //file with sql instructions to create tables etc
+  Scripter: TSQLScript;
 begin
-  try
+  result:=false;
-    SQLite3Connection1.ExecuteDirect(
+  if not(FUsingFirebird) then //not using Firebird, so using SQLite3
-    'CREATE TABLE DeadlyMushrooms '+LineEnding+
+  begin
-    '-- This table created by Jurassic Pork '+LineEnding+
+    try
-    '-- for Free Pascal Lazarus '+LineEnding+
+      SQLite3Connection1.ExecuteDirect(
-    '-- Create date:2013-08-05 23:55:09 '+LineEnding+
+      'CREATE TABLE DeadlyMushrooms '+LineEnding+
-    '( '+LineEnding+
+      '-- This table created by Jurassic Pork '+LineEnding+
-    '       ID INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, '+LineEnding+
+      '-- for Free Pascal Lazarus '+LineEnding+
-    '       Scientific_Name VARCHAR NOT NULL, '+LineEnding+
+      '-- Create date:2013-08-05 23:55:09 '+LineEnding+
-    '       Common_Name VARCHAR, '+LineEnding+
+      '( '+LineEnding+
-    '       `Order`  VARCHAR, `Genus`  VARCHAR, `Notes`  TEXT, `Picture`  BLOB, `Image_Link`  VARCHAR)'
+      '       ID INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, '+LineEnding+
-    );
+      '       Scientific_Name VARCHAR NOT NULL, '+LineEnding+
-    result := true;
+      '       Common_Name VARCHAR, '+LineEnding+
-  except
+      '       `Order`  VARCHAR, `Genus`  VARCHAR, `Notes`  TEXT, `Picture`  BLOB, `Image_Link`  VARCHAR)'
-    result := false;
+      );
+      result := true;
+    except
+      result := false;
+    end;
+  end
+  else
+  begin //Using Firebird
+    try
+      DBFile:=ExtractFilePath(ParamStr(0)) + FirebirdDB;
+      BackupFile:=ChangeFileExt(DBFile,'.fbk');
+      // First try restoring backup file with full content
+      if fileexists(BackupFile) then
+      begin
+        FBAdmin:=TFBAdmin.Create(nil);
+        try
+          try
+            FBAdmin.UseExceptions:=true;
+            FBAdmin.Host:=''; //embedded
+            FBAdmin.Protocol:=IBSPLOCAL;
+            FBAdmin.User:='SYSDBA';
+            FBAdmin.Password:=''; //embedded: doesn't matter which password is used
+            FBAdmin.Connect;
+            // Now run the restore. It will not overwrite an existing file but will
+            // create a new db
+            if FBAdmin.Restore(DBFile,BackupFile,[IBResCreate]) then
+            begin
+              sleep(200); //at least needed on Windows: give the filesystem time to update so we don't get failures connecting
+              exit(true) //we're done; exit the function
+            end
+            else
+              result := false;
+          finally
+            FBAdmin.Free;
+          end;
+        except
+          result := false; //we can continue with the next fallback step
+        end;
+      end;
+
+      // If no backup was found or restore failed,
+      // create an empty .fdb file
+      if (FileExists(DBFile))=false then
+      begin
+        IBConnection1.CreateDB;
+      end;
+      if (FileExists(DBFile)=false) then
+        raise Exception.CreateFmt('Firebird error: failure to create database %s',[DBFile]);
+      // Now create needed tables etc:
+      if not(IBConnection1.Connected) then IBConnection1.Connected := true;
+      Scripter:=TSQLScript.Create(nil);
+      try
+        SQLInstructions := ExtractFilePath(ParamStr(0)) + 'mushrooms_firebird.sql';
+        if not fileexists(SQLInstructions) then
+          raise Exception.CreateFmt('Error creating db: could not load SQL definition file %s',[SQLInstructions]);
+        Scripter.Script.LoadFromFile(SQLInstructions);
+        Scripter.DataBase := IBConnection1;
+        Scripter.Transaction := SQLTransaction1;
+        Scripter.CommentsInSQL := false; //needed to circumvent bugs in TSQLScript
+        Scripter.UseSetTerm := true; //needed because we have SET TERM statements in the SQL file
+        // Now everything is loaded in, run all commands at once:
+        Scripter.Execute;
+        //... and then commit to make them stick and show them to the SQL that comes
+        // after the commit
+        SQLTransaction1.Commit;
+        result := true;
+      finally
+        Scripter.Free;
+      end;
+    except
+      result := false;
+    end;
   end;
 end;