Add support for scripting check constraints for tables (part of issue #16). To do: check constraints for domains; comparison functions for check constraints.

TurboBird.lpr

@@ -107,5 +107,4 @@ begin
   InitialiseIBase60;
   Application.Run;
   ReleaseIBase60;
-
 end.

comparison.pas

@@ -1,5 +1,5 @@
 unit Comparison;
-
+//todo: add support for check constraints
 {$mode objfpc}{$H+}
 
 interface

main.pas

@@ -1872,6 +1872,12 @@ begin
         ScriptAllConstraints(dbIndex, List);
         Lines.AddStrings(List);
 
+        Lines.Add('');
+        Lines.Add('--      Check constraints');
+        Lines.Add('');
+        ScriptAllCheckConstraints(dbIndex, List);
+        Lines.AddStrings(List);
+
         Lines.Add('');
         Lines.Add('--      Permissions');
         Lines.Add('');

scriptdb.pas

@@ -13,7 +13,7 @@ function ScriptAllRoles(dbIndex: Integer; var List: TStringList): Boolean;
 function ScriptAllFunctions(dbIndex: Integer; var List: TStringList): Boolean;
 // Scripts all domains in a database
 function ScriptAllDomains(dbIndex: Integer; var List: TStringList): Boolean;
-// Scripts all defined exceptions in a database
+// Scripts all exceptions defined in a database
 function ScriptAllExceptions(dbIndex: Integer; var List: TStringList): Boolean;
 // Scripts all sequences (old name: generators) in a database
 function ScriptAllGenerators(dbIndex: Integer; var List: TStringList): Boolean;
@@ -28,8 +28,18 @@ function ScriptAllViews(dbIndex: Integer; var List: TStringList): Boolean;
 function ScriptAllTriggers(dbIndex: Integer; var List: TStringList): Boolean;
 // Scripts all non-primary key indexes for a database
 function ScriptAllSecIndices(dbIndex: Integer; var List: TStringList): Boolean;
+
+// Scripts check constraints for all tables
+function ScriptAllCheckConstraints(dbIndex: Integer; var List: TStringList): Boolean;
 // Scripts all constraints (e.g. foreign key constraints) for tables in a database
-// For now, seems to only cover foreign keys. Todo: verify/confirm
+{ For now, seems to only cover foreign keys. Todo: verify/confirm
+There are 5 kind of constraints:
+    NOT NULL
+    PRIMARY KEY
+    UNIQUE
+    FOREIGN KEY
+    CHECK
+}
 function ScriptAllConstraints(dbIndex: Integer; var List: TStringList): Boolean;
 function ScriptObjectPermission(dbIndex: Integer; ObjName, UserName: string; var ObjType: Integer;
    List: TStrings; NewUser: string = ''): Boolean;
@@ -474,6 +484,15 @@ begin
 end;
 
 
+(********************  Script Check Constraints   ***********************)
+
+function ScriptAllCheckConstraints(dbIndex: Integer; var List: TStringList
+  ): Boolean;
+  //todo: get check constraints for domains
+begin
+  dmSysTables.ScriptCheckConstraints(dbIndex,List);
+end;
+
 (********************  Script Constraints   ***********************)
 
 function ScriptAllConstraints(dbIndex: Integer; var List: TStringList): Boolean;

systables.pas

@@ -42,6 +42,9 @@ type
     function GetTriggerInfo(DatabaseIndex: Integer; ATriggername: string;
       var AfterBefor, OnTable, Event, Body: string; var TriggerEnabled: Boolean;
       var TriggerPosition: Integer): Boolean;
+    // Scripts all check constraints for a database's tables as alter table
+    // statement, adding the SQL to List
+    function ScriptCheckConstraints(dbIndex: Integer; List: TStrings): boolean;
     function ScriptTrigger(dbIndex: Integer; ATriggerName: string; List: TStrings;
       AsCreate: Boolean = False): Boolean;
     // Used e.g. in scripting foreign keys
@@ -297,13 +300,51 @@ begin
     end;
     sqQuery.Close;
     Result:= True;
-
   except
-  on e: exception do
-  begin
-    MessageDlg('Error: ' + e.Message, mtError, [mbOk], 0);
-    Result:= False;
+    on e: exception do
+    begin
+      MessageDlg('Error: ' + e.Message, mtError, [mbOk], 0);
+      Result:= False;
+    end;
   end;
+end;
+
+function TdmSysTables.ScriptCheckConstraints(dbIndex: Integer; List: TStrings
+  ): boolean;
+const
+  Template='select '+
+    'rc.rdb$relation_name, t.rdb$trigger_source '+
+    'from rdb$check_constraints cc '+
+    'inner join rdb$relation_constraints rc '+
+    'on cc.rdb$constraint_name=rc.rdb$constraint_name '+
+    'inner join rdb$triggers t '+
+    'on cc.rdb$trigger_name=t.rdb$trigger_name '+
+    'where rc.rdb$constraint_type=''CHECK'' and '+
+    't.rdb$trigger_inactive<>1 and '+
+    't.rdb$trigger_type=1' {type=1:before insert probably};
+begin
+  Result:= false;
+  List.Clear;
+  try
+    Init(dbIndex);
+    sqQuery.Close;
+    sqQuery.SQL.Text:= Template;
+    sqQuery.Open;
+    while not sqQuery.EOF do
+    begin
+      List.Add(Format('ALTER TABLE %s ADD ',
+        [trim(sqQuery.FieldByName('rdb$relation_name').AsString)]));
+      // Field starts with CHECK
+      List.Add(trim(sqQuery.FieldByName('rdb$trigger_source').AsString)+';');
+      sqQuery.Next;
+    end;
+    sqQuery.Close;
+    Result:= True;
+  except
+    on e: exception do
+    begin
+      MessageDlg('Error: ' + e.Message, mtError, [mbOk], 0);
+    end;
   end;
 end;
 
@@ -338,7 +379,6 @@ begin
     List.Text:= List.Text + Body + ' ^';
     List.Add('SET TERM ; ^');
   end;
-
 end;
 
 (**********  Get Table Constraints Info  ********************)

tablemanage.pas

@@ -255,15 +255,12 @@ begin
       if cxUnique.Checked then
         FirstLine:= FirstLine + 'unique ';
       FirstLine:= FirstLine + cbSortType.Text + ' index ' + edIndexName.Text;
-
-
       QWindow.meQuery.Lines.Text:= FirstLine + LineEnding + 'on ' + fTableName + LineEnding + Fields;
     end;
-    QWindow.OnCommit:= bbRefreshIndices.OnClick;
 
+    QWindow.OnCommit:= bbRefreshIndices.OnClick;
     QWindow.Show;
   end;
-
 end;
 
 procedure TfmTableManage.bbAddUserClick(Sender: TObject);