Add support for domain character sets. Show collation and character set in domain GUI. Don't abort debug builds if senddebug fails (e.g. due to server not running).

TurboBird.lpi

@@ -440,7 +440,7 @@
     </Other>
   </CompilerOptions>
   <Debugging>
-    <Exceptions Count="3">
+    <Exceptions Count="4">
       <Item1>
         <Name Value="EAbort"/>
       </Item1>
@@ -450,6 +450,9 @@
       <Item3>
         <Name Value="EFOpenError"/>
       </Item3>
+      <Item4>
+        <Name Value="EProcess"/>
+      </Item4>
     </Exceptions>
   </Debugging>
 </CONFIG>

comparison.pas

@@ -309,6 +309,7 @@ var
   ModuleName, EntryPoint, Params: string;
   Line: string;
   CheckConstraint: string; //for domain check constraints
+  CharacterSet: string;
   Collation: string;
   DomainType, DefaultValue: string;
   DomainSize: Integer;
@@ -438,7 +439,7 @@ begin
       if (x = 8) and cxDomains.Checked then // Domains
       for i:= 0 to dbObjectsList[x].Count - 1 do
       begin
-        dmSysTables.GetDomainInfo(fdbIndex, dbObjectsList[x].Strings[i], DomainType, DomainSize, DefaultValue, CheckConstraint, Collation);
+        dmSysTables.GetDomainInfo(fdbIndex, dbObjectsList[x].Strings[i], DomainType, DomainSize, DefaultValue, CheckConstraint, CharacterSet, Collation);
 
         Line:= 'Create Domain ' + dbObjectsList[x].Strings[i] + ' as ' + DomainType;
         // String size
@@ -451,6 +452,9 @@ begin
         // Check constraint, if any:
         if CheckConstraint <> '' then
           Line:= Line + ' ' + CheckConstraint;
+        // Character set for text types, if any:
+        if CharacterSet <> '' then
+          Line:= Line + ' CHARACTER SET ' +  CharacterSet;
         // Collation for text types, if any:
         if Collation <> '' then
           Line:= Line + ' COLLATE ' +  Collation;
@@ -989,10 +993,10 @@ end;
 procedure TfmComparison.CheckModifiedDomains;
 var
   i: Integer;
-  CheckConstraint, Collation: string;
+  CheckConstraint, CharacterSet, Collation: string;
   DomainName: string;
   DomainType, DefaultValue: string;
-  CCheckConstraint, CCollation: string;
+  CCheckConstraint, CCharacterSet, CCollation: string;
   CDomainType, CDefaultValue: string;
   DomainSize, CDomainSize: Integer;
 begin
@@ -1010,14 +1014,15 @@ begin
     DomainName:= dbExistingObjectsList[8][i];
 
     // Read all domain properties
-    dmSysTables.GetDomainInfo(fdbIndex, DomainName, DomainType, DomainSize, DefaultValue, CheckConstraint, Collation);
-    dmSysTables.GetDomainInfo(cbComparedDatabase.ItemIndex, DomainName, CDomainType, CDomainSize, CDefaultValue, CCheckConstraint, CCollation);
+    dmSysTables.GetDomainInfo(fdbIndex, DomainName, DomainType, DomainSize, DefaultValue, CheckConstraint, CharacterSet, Collation);
+    dmSysTables.GetDomainInfo(cbComparedDatabase.ItemIndex, DomainName, CDomainType, CDomainSize, CDefaultValue, CCheckConstraint, CCharacterSet, CCollation);
 
     // Compare
     if (DomainType <> CDomainType) or
        (DomainSize <> CDomainSize) or
        (DefaultValue <> CDefaultValue) or
        (CheckConstraint <> CCheckConstraint) or
+       (CharacterSet <> CCharacterSet) or
        (Collation <> CCollation) then
     begin
       meLog.Lines.Add(' ' + DomainName);
@@ -1524,7 +1529,7 @@ end;
 procedure TfmComparison.ScriptModifiedDomains;
 var
   i: Integer;
-  CheckConstraint, Collation: string;
+  CheckConstraint, CharacterSet, Collation: string;
   DomainName: string;
   DomainType, DefaultValue: string;
   DomainSize: Integer;
@@ -1540,7 +1545,7 @@ begin
   for i:= 0 to ModifiedDomainsList.Count - 1 do
   begin
     DomainName:= ModifiedDomainsList[i];
-    dmSysTables.GetDomainInfo(fdbIndex, DomainName, DomainType, domainSize, DefaultValue, CheckConstraint, Collation);
+    dmSysTables.GetDomainInfo(fdbIndex, DomainName, DomainType, DomainSize, DefaultValue, CheckConstraint, CharacterSet, Collation);
     fQueryWindow.meQuery.Lines.Add('');
     Line:= 'Alter DOMAIN ' + DomainName + ' type ' + DomainType;
     if Pos('char', LowerCase(DomainType)) > 0 then
@@ -1549,11 +1554,15 @@ begin
 
     // todo: verify if this check constraint clause works correctly
     if Trim(CheckConstraint) <> '' then
-      FQueryWindow.meQuery.Lines.Add(Trim(CheckConstraint));
+      FQueryWindow.meQuery.Lines.Add(CheckConstraint);
+
+    // todo: verify if this character set clause works correctly
+    if Trim(CharacterSet) <> '' then
+      FQueryWindow.meQuery.Lines.Add('characterset '+CharacterSet);
 
     // todo: verify if this collation clause works correctly
     if Trim(Collation) <> '' then
-      FQueryWindow.meQuery.Lines.Add('collation '+Trim(Collation));
+      FQueryWindow.meQuery.Lines.Add('collation '+Collation);
 
     if Trim(DefaultValue) <> '' then
     begin

main.pas

@@ -1418,7 +1418,11 @@ begin
     detRollBack: Source:='Rollback: ';
     else Source:='Unknown event. Please fix program code.';
   end;
-  SendDebug(Source + Msg);
+  try
+    SendDebug(Source + Msg);
+  except
+    // Ignore errors (e.g. debug server not active)
+  end;
 end;
 
 
@@ -2408,6 +2412,7 @@ var
   SelNode: TTreeNode;
   ADomainName: string;
   CheckConstraint: string;
+  CharacterSet: string;
   Collation: string;
   DomainType: string;
   DomainSize: Integer;
@@ -2440,7 +2445,7 @@ begin
     PageControl1.ActivePage:= ATab;
 
     dbIndex:= SelNode.Parent.Parent.OverlayIndex;
-    dmSysTables.GetDomainInfo(dbIndex, ADomainName, DomainType, DomainSize, DefaultValue, CheckConstraint, Collation);
+    dmSysTables.GetDomainInfo(dbIndex, ADomainName, DomainType, DomainSize, DefaultValue, CheckConstraint, CharacterSet, Collation);
     ATab.Tag:= dbIndex;
     if Pos('default', LowerCase(DefaultValue)) = 1 then
       DefaultValue:= Trim(Copy(DefaultValue, 8, Length(DefaultValue)));
@@ -2457,8 +2462,9 @@ begin
       laType.Caption:= DomainType;
       laSize.Caption:= IntToStr(DomainSize);
       laDefault.Caption:= DefaultValue;
-      //todo: add caption with check constraint
-      //todo: add caption with character set/collation
+      laCheckConstraint.Caption:= CheckConstraint;
+      laCharacterSet.Caption:= CharacterSet;
+      laCollation.Caption:= Collation;
     end;
     ADomainForm.Show;
   end;

querywindow.pas

@@ -659,8 +659,8 @@ begin
     end;
 
     if (Pos('select', MassagedSQL) = 1) then
-      // todo: low priority misses insert...returning,
-      // update...returning, merge.. returning...
+      { todo: low priority misses insert...returning,
+       update...returning, merge.. returning...}
       Result:= qtSelectable
     else
     begin
@@ -1459,7 +1459,6 @@ begin
       ATab.ImageIndex:= 2;
       SQLScript.Script.Text:= Script;
       {$IFDEF DEBUG}
-      //todo: debug
       SendDebug('going to run script: '+SQLScript.Script.Text);
       {$Endif}
       SQLScript.ExecuteScript;

scriptdb.pas

@@ -166,6 +166,7 @@ function ScriptAllDomains(dbIndex: Integer; var List: TStringList): Boolean;
 var
   Count: Integer;
   i: Integer;
+  CharacterSet: string;
   Collation: string;
   DomainType: string;
   DomainSize: Integer;
@@ -178,7 +179,7 @@ begin
   dmSysTables.SortDependencies(List);
   for i:= 0 to List.Count - 1 do
   begin
-    dmSysTables.GetDomainInfo(dbIndex, List[i], DomainType, DomainSize, DefaultValue, CheckConstraint, Collation);
+    dmSysTables.GetDomainInfo(dbIndex, List[i], DomainType, DomainSize, DefaultValue, CheckConstraint, CharacterSet, Collation);
 
     List[i]:= 'Create Domain ' + List[i] + ' as ' + DomainType;
     if (Pos('CHAR', DomainType) > 0) or (Pos('CSTRING', DomainType) > 0) then
@@ -187,6 +188,9 @@ begin
     // Check constraint, if any:
     if CheckConstraint <> '' then
       List[i]:= List[i] + ' ' + CheckConstraint;
+    // Character set for text types, if any
+    if CharacterSet <> '' then
+      List[i]:= List[i] + ' CHARACTER SET ' + CharacterSet;
     // Collation for text types, if any:
     if Collation <> '' then
       List[i]:= List[i] + ' COLLATE ' +  Collation;

systables.pas

@@ -6,7 +6,7 @@ interface
 
 uses
   Classes, SysUtils, sqldb, IBConnection, FileUtil, LResources, Forms, Controls,
-  Dialogs;
+  Dialogs, dbugintf;
 
 type
 
@@ -66,7 +66,7 @@ type
     function GetExceptionInfo(ExceptionName: string; var Msg, Description, SqlQuery: string): Boolean;
     // Gets information about domain
     procedure GetDomainInfo(dbIndex: Integer; DomainName: string; var DomainType: string;
-      var DomainSize: Integer; var DefaultValue: string; var CheckConstraint: string; var Collation: string);
+      var DomainSize: Integer; var DefaultValue: string; var CheckConstraint: string; var CharacterSet: string; var Collation: string);
     function GetConstraintForeignKeyFields(AIndexName: string; SqlQuery: TSQLQuery): string;
 
     function GetDBUsers(dbIndex: Integer; ObjectName: string = ''): string;
@@ -178,7 +178,7 @@ begin
     sqQuery.SQL.Text:= 'SELECT RDB$RELATION_NAME FROM RDB$RELATIONS where RDB$SYSTEM_FLAG=1 ' +
       'order by RDB$RELATION_NAME'
   else
-  if TVIndex = 8 then // Domains
+  if TVIndex = 8 then // Domains, excluding system-defined domains
     sqQuery.SQL.Text:= 'select RDB$FIELD_NAME from RDB$FIELDS where RDB$Field_Name not like ''RDB$%''  order by rdb$Field_Name'
   else
   if TVIndex = 9 then // Roles
@@ -635,16 +635,19 @@ end;
 (************  View Domain info  ***************)
 
 procedure TdmSysTables.GetDomainInfo(dbIndex: Integer; DomainName: string; var DomainType: string;
-  var DomainSize: Integer; var DefaultValue: string; var CheckConstraint: string; var Collation: string);
+  var DomainSize: Integer; var DefaultValue: string; var CheckConstraint: string; var CharacterSet: string; var Collation: string);
 const
   // Select domain and associated collation (if text type domain)
   // note weird double join fields required...
   QueryTemplate= 'select f.*, '+
-    'c.rdb$collation_name '+
+    'coll.rdb$collation_name, '+
+    'cs.rdb$character_set_name '+
     'from rdb$fields as f '+
-    'left join rdb$collations as c on '+
-    'f.rdb$collation_id=c.rdb$collation_id and '+
-    'f.rdb$character_set_id=c.rdb$character_set_id '+
+    'left join rdb$collations as coll on '+
+    'f.rdb$collation_id=coll.rdb$collation_id and '+
+    'f.rdb$character_set_id=coll.rdb$character_set_id '+
+    'inner join rdb$character_sets as cs on '+
+    'coll.rdb$character_set_id=cs.rdb$character_set_id '+
     'where f.rdb$field_name=''%s'' ';
 begin
   Init(dbIndex);
@@ -662,6 +665,7 @@ begin
     DomainSize:= sqQuery.FieldByName('RDB$FIELD_LENGTH').AsInteger;
     DefaultValue:= trim(sqQuery.FieldByName('RDB$DEFAULT_SOURCE').AsString);
     CheckConstraint:= trim(sqQuery.FieldByName('RDB$VALIDATION_SOURCE').AsString); //e.g. CHECK (VALUE > 10000 AND VALUE <= 2000000)
+    CharacterSet:= trim(sqQuery.FieldByName('rdb$character_set_name').AsString);
     Collation:= trim(sqQuery.FieldByName('rdb$collation_name').AsString);
   end
   else
@@ -873,9 +877,9 @@ end;
 
 function TdmSysTables.GetDomainTypeSize(dbIndex: Integer; DomainTypeName: string): Integer;
 var
-  DomainType, DefaultValue, CheckConstraint, Collation: string;
+  DomainType, DefaultValue, CheckConstraint, CharacterSet, Collation: string;
 begin
-  GetDomainInfo(dbIndex, DomainTypeName, DomainType, Result, DefaultValue, CheckConstraint, Collation);
+  GetDomainInfo(dbIndex, DomainTypeName, DomainType, Result, DefaultValue, CheckConstraint, CharacterSet, Collation);
 end;
 
 

viewdomain.lfm

@@ -1,16 +1,16 @@
 object fmViewDomain: TfmViewDomain
   Left = 330
-  Height = 164
+  Height = 264
   Top = 216
   Width = 617
   Caption = 'fmViewDomain'
-  ClientHeight = 164
+  ClientHeight = 264
   ClientWidth = 617
   KeyPreview = True
   OnClose = FormClose
   OnKeyDown = FormKeyDown
   Position = poScreenCenter
-  LCLVersion = '1.2.0.3'
+  LCLVersion = '1.2.2.0'
   object Label1: TLabel
     Left = 11
     Height = 13
@@ -50,8 +50,8 @@ object fmViewDomain: TfmViewDomain
     Left = 120
     Height = 18
     Top = 80
-    Width = 54
-    Caption = 'laName'
+    Width = 43
+    Caption = 'laSize'
     Font.Color = 10234153
     Font.Name = 'courier 10 pitch [bitstream]'
     ParentColor = False
@@ -69,8 +69,8 @@ object fmViewDomain: TfmViewDomain
     Left = 120
     Height = 18
     Top = 112
-    Width = 54
-    Caption = 'laName'
+    Width = 61
+    Caption = 'laDefault'
     Font.Color = 10234153
     Font.Name = 'courier 10 pitch [bitstream]'
     ParentColor = False
@@ -102,4 +102,61 @@ object fmViewDomain: TfmViewDomain
     ParentFont = False
     TabOrder = 1
   end
+  object Label6: TLabel
+    Left = 11
+    Height = 13
+    Top = 140
+    Width = 80
+    Caption = 'Check constraint'
+    ParentColor = False
+  end
+  object laCheckConstraint: TLabel
+    Left = 120
+    Height = 18
+    Top = 140
+    Width = 128
+    Caption = 'laCheckConstraint'
+    Font.Color = 10234153
+    Font.Name = 'courier 10 pitch [bitstream]'
+    ParentColor = False
+    ParentFont = False
+  end
+  object Label7: TLabel
+    Left = 11
+    Height = 13
+    Top = 176
+    Width = 66
+    Caption = 'Character set'
+    ParentColor = False
+  end
+  object laCharacterSet: TLabel
+    Left = 120
+    Height = 18
+    Top = 176
+    Width = 105
+    Caption = 'laCharacterSet'
+    Font.Color = 10234153
+    Font.Name = 'courier 10 pitch [bitstream]'
+    ParentColor = False
+    ParentFont = False
+  end
+  object laCollation: TLabel
+    Left = 120
+    Height = 18
+    Top = 216
+    Width = 73
+    Caption = 'laCollation'
+    Font.Color = 10234153
+    Font.Name = 'courier 10 pitch [bitstream]'
+    ParentColor = False
+    ParentFont = False
+  end
+  object Label8: TLabel
+    Left = 11
+    Height = 13
+    Top = 216
+    Width = 41
+    Caption = 'Collation'
+    ParentColor = False
+  end
 end

viewdomain.lrs

@@ -1,11 +1,11 @@
 { This is an automatically generated lazarus resource file }
 
 LazarusResources.Add('TfmViewDomain','FORMDATA',[
-  'TPF0'#13'TfmViewDomain'#12'fmViewDomain'#4'Left'#3'J'#1#6'Height'#3#164#0#3
-  +'Top'#3#216#0#5'Width'#3'i'#2#7'Caption'#6#12'fmViewDomain'#12'ClientHeight'
-  +#3#164#0#11'ClientWidth'#3'i'#2#10'KeyPreview'#9#7'OnClose'#7#9'FormClose'#9
-  +'OnKeyDown'#7#11'FormKeyDown'#8'Position'#7#14'poScreenCenter'#10'LCLVersion'
-  +#6#7'1.2.0.3'#0#6'TLabel'#6'Label1'#4'Left'#2#11#6'Height'#2#13#3'Top'#2#15#5
+  'TPF0'#13'TfmViewDomain'#12'fmViewDomain'#4'Left'#3'J'#1#6'Height'#3#8#1#3'To'
+  +'p'#3#216#0#5'Width'#3'i'#2#7'Caption'#6#12'fmViewDomain'#12'ClientHeight'#3
+  +#8#1#11'ClientWidth'#3'i'#2#10'KeyPreview'#9#7'OnClose'#7#9'FormClose'#9'OnK'
+  +'eyDown'#7#11'FormKeyDown'#8'Position'#7#14'poScreenCenter'#10'LCLVersion'#6
+  +#7'1.2.2.0'#0#6'TLabel'#6'Label1'#4'Left'#2#11#6'Height'#2#13#3'Top'#2#15#5
   +'Width'#2'@'#7'Caption'#6#11'Domain name'#11'ParentColor'#8#0#0#6'TLabel'#6
   +'Label3'#4'Left'#2#11#6'Height'#2#13#3'Top'#2'0'#5'Width'#2'0'#7'Caption'#6#9
   +'Data type'#11'ParentColor'#8#0#0#6'TLabel'#6'laType'#4'Left'#2'x'#6'Height'
@@ -13,18 +13,32 @@ LazarusResources.Add('TfmViewDomain','FORMDATA',[
   +#156#0#9'Font.Name'#6#28'courier 10 pitch [bitstream]'#11'ParentColor'#8#10
   +'ParentFont'#8#0#0#6'TLabel'#6'Label4'#4'Left'#2#11#6'Height'#2#13#3'Top'#2
   +'P'#5'Width'#2#19#7'Caption'#6#4'Size'#11'ParentColor'#8#0#0#6'TLabel'#6'laS'
-  +'ize'#4'Left'#2'x'#6'Height'#2#18#3'Top'#2'P'#5'Width'#2'6'#7'Caption'#6#6'l'
-  +'aName'#10'Font.Color'#4'))'#156#0#9'Font.Name'#6#28'courier 10 pitch [bitst'
+  +'ize'#4'Left'#2'x'#6'Height'#2#18#3'Top'#2'P'#5'Width'#2'+'#7'Caption'#6#6'l'
+  +'aSize'#10'Font.Color'#4'))'#156#0#9'Font.Name'#6#28'courier 10 pitch [bitst'
   +'ream]'#11'ParentColor'#8#10'ParentFont'#8#0#0#6'TLabel'#6'Label5'#4'Left'#2
   +#11#6'Height'#2#13#3'Top'#2'p'#5'Width'#2'@'#7'Caption'#6#13'Default Value'
   +#11'ParentColor'#8#0#0#6'TLabel'#9'laDefault'#4'Left'#2'x'#6'Height'#2#18#3
-  +'Top'#2'p'#5'Width'#2'6'#7'Caption'#6#6'laName'#10'Font.Color'#4'))'#156#0#9
+  +'Top'#2'p'#5'Width'#2'='#7'Caption'#6#9'laDefault'#10'Font.Color'#4'))'#156#0
+  +#9'Font.Name'#6#28'courier 10 pitch [bitstream]'#11'ParentColor'#8#10'Parent'
+  +'Font'#8#0#0#5'TEdit'#6'edName'#4'Left'#2'x'#6'Height'#2#13#3'Top'#2#16#5'Wi'
+  +'dth'#3'2'#1#10'AutoSelect'#8#11'BorderStyle'#7#6'bsNone'#10'Font.Color'#7#6
+  +'clNavy'#10'ParentFont'#8#8'ReadOnly'#9#8'TabOrder'#2#0#4'Text'#6#9'edGenNam'
+  +'e'#0#0#7'TBitBtn'#7'bbClose'#4'Left'#3'N'#2#6'Height'#2#24#3'Top'#2#0#5'Wid'
+  +'th'#2#27#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#4' X  '#5'Color'#4
+  +#219#242#247#0#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7#12'bbCloseClick'#10
+  +'ParentFont'#8#8'TabOrder'#2#1#0#0#6'TLabel'#6'Label6'#4'Left'#2#11#6'Height'
+  +#2#13#3'Top'#3#140#0#5'Width'#2'P'#7'Caption'#6#16'Check constraint'#11'Pare'
+  +'ntColor'#8#0#0#6'TLabel'#17'laCheckConstraint'#4'Left'#2'x'#6'Height'#2#18#3
+  +'Top'#3#140#0#5'Width'#3#128#0#7'Caption'#6#17'laCheckConstraint'#10'Font.Co'
+  +'lor'#4'))'#156#0#9'Font.Name'#6#28'courier 10 pitch [bitstream]'#11'ParentC'
+  +'olor'#8#10'ParentFont'#8#0#0#6'TLabel'#6'Label7'#4'Left'#2#11#6'Height'#2#13
+  +#3'Top'#3#176#0#5'Width'#2'B'#7'Caption'#6#13'Character set'#11'ParentColor'
+  +#8#0#0#6'TLabel'#14'laCharacterSet'#4'Left'#2'x'#6'Height'#2#18#3'Top'#3#176
+  +#0#5'Width'#2'i'#7'Caption'#6#14'laCharacterSet'#10'Font.Color'#4'))'#156#0#9
   +'Font.Name'#6#28'courier 10 pitch [bitstream]'#11'ParentColor'#8#10'ParentFo'
-  +'nt'#8#0#0#5'TEdit'#6'edName'#4'Left'#2'x'#6'Height'#2#13#3'Top'#2#16#5'Widt'
-  +'h'#3'2'#1#10'AutoSelect'#8#11'BorderStyle'#7#6'bsNone'#10'Font.Color'#7#6'c'
-  +'lNavy'#10'ParentFont'#8#8'ReadOnly'#9#8'TabOrder'#2#0#4'Text'#6#9'edGenName'
-  +#0#0#7'TBitBtn'#7'bbClose'#4'Left'#3'N'#2#6'Height'#2#24#3'Top'#2#0#5'Width'
-  +#2#27#7'Anchors'#11#5'akTop'#7'akRight'#0#7'Caption'#6#4' X  '#5'Color'#4#219
-  +#242#247#0#10'Font.Style'#11#6'fsBold'#0#7'OnClick'#7#12'bbCloseClick'#10'Pa'
-  +'rentFont'#8#8'TabOrder'#2#1#0#0#0
+  +'nt'#8#0#0#6'TLabel'#11'laCollation'#4'Left'#2'x'#6'Height'#2#18#3'Top'#3#216
+  +#0#5'Width'#2'I'#7'Caption'#6#11'laCollation'#10'Font.Color'#4'))'#156#0#9'F'
+  +'ont.Name'#6#28'courier 10 pitch [bitstream]'#11'ParentColor'#8#10'ParentFon'
+  +'t'#8#0#0#6'TLabel'#6'Label8'#4'Left'#2#11#6'Height'#2#13#3'Top'#3#216#0#5'W'
+  +'idth'#2')'#7'Caption'#6#9'Collation'#11'ParentColor'#8#0#0#0
 ]);

viewdomain.pas

@@ -19,7 +19,13 @@ type
     Label3: TLabel;
     Label4: TLabel;
     Label5: TLabel;
+    Label6: TLabel;
+    Label7: TLabel;
+    Label8: TLabel;
     laDefault: TLabel;
+    laCheckConstraint: TLabel;
+    laCharacterSet: TLabel;
+    laCollation: TLabel;
     laType: TLabel;
     laSize: TLabel;
     procedure bbCloseClick(Sender: TObject);