From 4c179addecc31446afe676d259732c5e075e505f Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sat, 7 Feb 2026 13:47:59 +0100 Subject: [PATCH 001/170] fix: crash in OpenTextFile, for a 0-bytes file - override the encoding to one without BOM Closes #1448 --- source/apphelpers.pas | 3 +++ 1 file changed, 3 insertions(+) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 3021c8535..c7a4d61f3 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -1331,6 +1331,9 @@ procedure OpenTextFile(const Filename: String; out Stream: TFileStream; var Enco Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone); if Encoding = nil then Encoding := DetectEncoding(Stream); + // For a 0-bytes file, override the encoding to one without BOM + if _GetFileSize(Filename) < Length(Encoding.GetPreamble) then + Encoding := UTF8NoBOMEncoding; // If the file contains a BOM, advance the stream's position BomLen := 0; if Length(Encoding.GetPreamble) > 0 then begin From 1f69da5f650e1808e70519ec3e0104c0997d93c2 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sat, 7 Feb 2026 16:08:24 +0100 Subject: [PATCH 002/170] feat: prefer KILL QUERY over KILL on MySQL and MariaDB, when using the "Kill process" menu item in Host > processlist Refs #1567 --- source/main.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/main.pas b/source/main.pas index d75eeab36..89737d9c7 100644 --- a/source/main.pas +++ b/source/main.pas @@ -6735,7 +6735,7 @@ procedure TMainForm.KillProcess(Sender: TObject); if pid = Conn.ThreadId then LogSQL(f_('Ignoring own process id #%d when trying to kill it.', [pid])) else try - Conn.Query(Conn.GetSQLSpecifity(spKillProcess, [pid])); + Conn.Query(Conn.GetSQLSpecifity(spKillQuery, [pid])); except on E:EDbError do begin if Conn.LastErrorCode <> ER_NO_SUCH_THREAD then From 52648ceebdbcfcbb765c1fce843b53790cedcf6d Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 9 Feb 2026 09:35:43 +0100 Subject: [PATCH 003/170] feat: add security policy for supported versions and reporting Refs #1591 --- SECURITY.md | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) create mode 100644 SECURITY.md diff --git a/SECURITY.md b/SECURITY.md new file mode 100644 index 000000000..2f52e4bc7 --- /dev/null +++ b/SECURITY.md @@ -0,0 +1,19 @@ +# Security Policy + +## Supported Versions + +Currently supported releases with security updates: + +| Version | Supported | +| ------- | ------------------ | +| 12.x | :white_check_mark: | +| < 12.x | :x: | + +## Reporting a Vulnerability + +When reporting a vulnerability, please file a ticket here. You may also send an +email to security@heidisql.com . + +It is important that the report is _valid_, and I am able to _understand_ the vulnerability impact. +If so, you may expect an update within weeks, probably quicker. I'll do my best to keep the +software and the user systems intact. From 0e198af78f73fc975d2f493e5af3e02d5b4f4624 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 9 Feb 2026 11:02:55 +0100 Subject: [PATCH 004/170] fix: wrong captions on quick filter actions shown in preferences > shortcuts Closes #1646 --- source/main.dfm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/source/main.dfm b/source/main.dfm index e963f11e4..6b063f13b 100644 --- a/source/main.dfm +++ b/source/main.dfm @@ -3172,35 +3172,35 @@ object MainForm: TMainForm end object actQuickFilterFocused3: TAction Category = 'Data' - Caption = 'Quick filter: Column > Focused' + Caption = 'Quick filter: Column LIKE Focused%' ImageIndex = 61 ImageName = 'icons8-sort-right' OnExecute = QuickFilterClick end object actQuickFilterFocused4: TAction Category = 'Data' - Caption = 'Quick filter: Column < Focused' + Caption = 'Quick filter: Column LIKE %Focused' ImageIndex = 61 ImageName = 'icons8-sort-right' OnExecute = QuickFilterClick end object actQuickFilterFocused5: TAction Category = 'Data' - Caption = 'Quick filter: Column LIKE Focused%' + Caption = 'Quick filter: Column LIKE %Focused%' ImageIndex = 61 ImageName = 'icons8-sort-right' OnExecute = QuickFilterClick end object actQuickFilterFocused6: TAction Category = 'Data' - Caption = 'Quick filter: Column LIKE %Focused' + Caption = 'Quick filter: Column > Focused' ImageIndex = 61 ImageName = 'icons8-sort-right' OnExecute = QuickFilterClick end object actQuickFilterFocused7: TAction Category = 'Data' - Caption = 'Quick filter: Column LIKE %Focused%' + Caption = 'Quick filter: Column < Focused' ImageIndex = 61 ImageName = 'icons8-sort-right' OnExecute = QuickFilterClick From 3fb41ee1f4d491155b051e85bf587a8b59fde3e3 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 9 Feb 2026 13:43:22 +0100 Subject: [PATCH 005/170] fix: load any foreign keys, anyway if the user owns them, on PostgreSQL Refs #1653 --- source/dbconnection.pas | 81 +++++++++++++++++++++++++---------------- 1 file changed, 50 insertions(+), 31 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index cb1883991..775422319 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -6714,37 +6714,56 @@ function TPgConnection.GetTableForeignKeys(Table: TDBObject): TForeignKeyList; // see #158 Result := TForeignKeyList.Create(True); try - ForeignQuery := GetResults('SELECT'+ - ' refc.constraint_name,'+ - ' refc.update_rule,'+ - ' refc.delete_rule,'+ - ' kcu.table_name,'+ - ' STRING_AGG(distinct kcu.column_name, '','') AS columns,'+ - ' ccu.table_schema AS ref_schema,'+ - ' ccu.table_name AS ref_table,'+ - ' STRING_AGG(distinct ccu.column_name, '','') AS ref_columns,'+ - ' STRING_AGG(distinct kcu.ordinal_position::text, '','') AS ord_position'+ - ' FROM'+ - ' '+InfSch+'.referential_constraints AS refc,'+ - ' '+InfSch+'.key_column_usage AS kcu,'+ - ' '+InfSch+'.constraint_column_usage AS ccu'+ - ' WHERE'+ - ' refc.constraint_schema = '+EscapeString(Table.Schema)+ - ' AND kcu.table_name = '+EscapeString(Table.Name)+ - ' AND kcu.constraint_name = refc.constraint_name'+ - ' AND kcu.table_schema = refc.constraint_schema'+ - ' AND ccu.constraint_name = refc.constraint_name'+ - ' AND ccu.constraint_schema = refc.constraint_schema'+ - ' GROUP BY'+ - ' refc.constraint_name,'+ - ' refc.update_rule,'+ - ' refc.delete_rule,'+ - ' kcu.table_name,'+ - ' ccu.table_schema,'+ - ' ccu.table_name'+ - ' ORDER BY'+ - ' ord_position' - ); + ForeignQuery := GetResults( + 'SELECT ' + + ' con.conname AS constraint_name, ' + + ' CASE con.confupdtype ' + + ' WHEN ''a'' THEN ''NO ACTION'' ' + + ' WHEN ''r'' THEN ''RESTRICT'' ' + + ' WHEN ''c'' THEN ''CASCADE'' ' + + ' WHEN ''n'' THEN ''SET NULL'' ' + + ' WHEN ''d'' THEN ''SET DEFAULT'' ' + + ' END AS update_rule, ' + + ' CASE con.confdeltype ' + + ' WHEN ''a'' THEN ''NO ACTION'' ' + + ' WHEN ''r'' THEN ''RESTRICT'' ' + + ' WHEN ''c'' THEN ''CASCADE'' ' + + ' WHEN ''n'' THEN ''SET NULL'' ' + + ' WHEN ''d'' THEN ''SET DEFAULT'' ' + + ' END AS delete_rule, ' + + ' src_ns.nspname AS table_schema, ' + + ' src_tbl.relname AS table_name, ' + + ' string_agg(src_col.attname, '','' ORDER BY ord.pos) AS columns, ' + + ' ref_ns.nspname AS ref_schema, ' + + ' ref_tbl.relname AS ref_table, ' + + ' string_agg(ref_col.attname, '','' ORDER BY ord.pos) AS ref_columns, ' + + ' string_agg(ord.pos::text, '','' ORDER BY ord.pos) AS ord_position ' + + 'FROM pg_constraint con ' + + 'JOIN pg_class src_tbl ON src_tbl.oid = con.conrelid ' + + 'JOIN pg_namespace src_ns ON src_ns.oid = src_tbl.relnamespace ' + + 'JOIN LATERAL unnest(con.conkey) WITH ORDINALITY AS ord(attnum, pos) ON TRUE ' + + 'JOIN pg_attribute src_col ON src_col.attrelid = src_tbl.oid AND src_col.attnum = ord.attnum ' + + 'JOIN pg_class ref_tbl ON ref_tbl.oid = con.confrelid ' + + 'JOIN pg_namespace ref_ns ON ref_ns.oid = ref_tbl.relnamespace ' + + 'JOIN LATERAL unnest(con.confkey) WITH ORDINALITY AS ref_ord(attnum, pos) ' + + ' ON ref_ord.pos = ord.pos ' + + 'JOIN pg_attribute ref_col ON ref_col.attrelid = ref_tbl.oid AND ref_col.attnum = ref_ord.attnum ' + + 'WHERE ' + + ' con.contype = ''f'' ' + + ' AND src_ns.nspname = '+EscapeString(Table.Schema) + + ' AND src_tbl.relname = '+EscapeString(Table.Name) + + 'GROUP BY ' + + ' con.conname, ' + + ' con.confupdtype, ' + + ' con.confdeltype, ' + + ' src_ns.nspname, ' + + ' src_tbl.relname, ' + + ' ref_ns.nspname, ' + + ' ref_tbl.relname ' + + 'ORDER BY ' + + ' MIN(ord.pos)' + ); + while not ForeignQuery.Eof do begin ForeignKey := TForeignKey.Create(Self); Result.Add(ForeignKey); From b78b4feb8e581b3d22c3f970cbca70cbc13630ef Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Tue, 10 Feb 2026 16:37:25 +0100 Subject: [PATCH 006/170] feat: recreate previous state of trigger after realizing the user edited code has errors Refs #2348 and #1788 --- source/trigger_editor.pas | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/source/trigger_editor.pas b/source/trigger_editor.pas index f86292b9b..6724e1fd8 100644 --- a/source/trigger_editor.pas +++ b/source/trigger_editor.pas @@ -226,6 +226,8 @@ procedure TfrmTriggerEditor.comboDefinerDropDown(Sender: TObject); function TfrmTriggerEditor.ApplyModifications: TModalResult; +var + OldCreateCode: String; begin // Edit mode means we drop the trigger and recreate it, as there is no ALTER TRIGGER. Result := mrOk; @@ -235,7 +237,9 @@ function TfrmTriggerEditor.ApplyModifications: TModalResult; // So, we take the risk of loosing the trigger for cases in which the user has SQL errors in // his statement. The user must fix such errors and re-press "Save" while we have them in memory, // otherwise the trigger attributes are lost forever. + OldCreateCode := ''; if ObjectExists then try + OldCreateCode := DBObject.CreateCode; DBObject.Connection.Query('DROP TRIGGER '+DBObject.Connection.QuoteIdent(DBObject.Name)); except end; @@ -251,6 +255,8 @@ function TfrmTriggerEditor.ApplyModifications: TModalResult; on E:EDbError do begin ErrorDialog(E.Message); Result := mrAbort; + if not OldCreateCode.IsEmpty then + DBObject.Connection.Query(OldCreateCode); end; end; end; From 1913f1d1935db0334d8e229111d95f2c3170e4d9 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Tue, 10 Feb 2026 18:48:22 +0100 Subject: [PATCH 007/170] fix: crash when moving added column to very bottom Closes #2400 --- source/table_editor.pas | 2 ++ 1 file changed, 2 insertions(+) diff --git a/source/table_editor.pas b/source/table_editor.pas index 94d845eb4..5781bdbd3 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -1215,6 +1215,8 @@ procedure TfrmTableEditor.listColumnsDragDrop(Sender: TBaseVirtualTree; NewIndex := FColumns.IndexOf(ToCol^); if Mode = dmBelow then Inc(NewIndex); + // Fix crash when moving to very bottom + NewIndex := Min(NewIndex, FColumns.Count-1); FColumns.Move(FColumns.IndexOf(FocusedCol^), NewIndex); FocusedCol.Status := esModified; Modification(Sender); From ab72520ab46d7ffca015c1c6e0b28ef4aeb87c7b Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 11 Feb 2026 13:59:48 +0100 Subject: [PATCH 008/170] feat: support full table status option in SQLite, showing "Rows" from COUNT(*) for each table closes #1803 --- source/connections.pas | 2 +- source/dbconnection.pas | 29 +++++++++++++++++++++++++++++ 2 files changed, 30 insertions(+), 1 deletion(-) diff --git a/source/connections.pas b/source/connections.pas index f6eac8c45..3f8e95af2 100644 --- a/source/connections.pas +++ b/source/connections.pas @@ -1630,7 +1630,7 @@ procedure Tconnform.ValidateControls; editQueryTimeout.Enabled := lblQueryTimeout.Enabled; updownQueryTimeout.Enabled := lblQueryTimeout.Enabled; chkLocalTimeZone.Enabled := Params.NetTypeGroup = ngMySQL; - chkFullTableStatus.Enabled := (Params.NetTypeGroup in [ngMySQL, ngPgSQL]) and (Params.NetType <> ntMySQL_ProxySQLAdmin); + chkFullTableStatus.Enabled := (Params.NetTypeGroup in [ngMySQL, ngPgSQL, ngSQLite]) and (Params.NetType <> ntMySQL_ProxySQLAdmin); chkCleartextPluginEnabled.Enabled := Params.NetTypeGroup = ngMySQL; editLogFilePath.Enabled := Params.LogFileDdl or Params.LogFileDml; diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 775422319..2299383af 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -7730,6 +7730,7 @@ procedure TSQLiteConnection.FetchDbObjects(db: String; var Cache: TDBObjectList) obj: TDBObject; Results: TDBQuery; TypeS: String; + UnionRowCount: TStringList; begin // Tables, views and procedures Results := nil; @@ -7760,6 +7761,34 @@ procedure TSQLiteConnection.FetchDbObjects(db: String; var Cache: TDBObjectList) Results.Next; end; FreeAndNil(Results); + + if FParameters.FullTableStatus then begin + UnionRowCount := TStringList.Create; + for obj in Cache do begin + if obj.NodeType <> lntTable then + Continue; + UnionRowCount.Add('SELECT '+EscapeString(obj.Name)+', COUNT(*) FROM '+QuoteIdent(obj.Database)+'.'+QuoteIdent(obj.Name)); + end; + if UnionRowCount.Count > 0 then + try + Results := GetResults(Implode(' UNION ', UnionRowCount)); + while not Results.Eof do begin + for obj in Cache do begin + if (obj.NodeType = lntTable) and (obj.Name = Results.Col(0)) then begin + obj.Rows := StrToInt64Def(Results.Col(1), -1); + obj.RowsAreExact := True; + break; + end; + end; + Results.Next; + end; + FreeAndNil(Results); + except + on E:EDbError do + Log(lcError, 'Full table status with row count not available in this database'); + end; + UnionRowCount.Free; + end; end; end; From 211c5e2af7327f6f9bdc3b20dd6efde098528f29 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 11 Feb 2026 14:52:26 +0100 Subject: [PATCH 009/170] fix: BIT values in MS SQL grid queries prefixed with MySQL b'' style Closes #264 --- source/dbconnection.pas | 27 ++++++++++++++------------- source/exportgrid.pas | 2 +- source/tabletools.pas | 6 ------ 3 files changed, 15 insertions(+), 20 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 2299383af..cf6389746 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -5329,11 +5329,13 @@ function TDBConnection.EscapeString(Text: String; ProcessJokerChars: Boolean=fal function TDBConnection.EscapeString(Text: String; Datatype: TDBDatatype): String; var DoQuote: Boolean; + ValuePrefix: String; const CategoriesNeedQuote = [dtcText, dtcBinary, dtcTemporal, dtcSpatial, dtcOther]; begin // Quote text based on the passed datatype DoQuote := Datatype.Category in CategoriesNeedQuote; + ValuePrefix := ''; case Datatype.Category of // Some special cases dtcBinary: begin @@ -5343,11 +5345,13 @@ function TDBConnection.EscapeString(Text: String; Datatype: TDBDatatype): String dtcInteger, dtcReal: begin if (not IsNumeric(Text)) and (not IsHex(Text)) then DoQuote := True; - if Datatype.Index = dbdtBit then + if (Datatype.Index = dbdtBit) and FParameters.IsAnyMySQL then begin DoQuote := True; + ValuePrefix := 'b'; + end; end; end; - Result := EscapeString(Text, False, DoQuote); + Result := ValuePrefix + EscapeString(Text, False, DoQuote); end; @@ -9303,13 +9307,13 @@ function TAdoDBQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; except Result := String(FCurrentResults.Fields[Column].AsAnsiString); end; - if Datatype(Column).Index = dbdtBit then begin - if UpperCase(Result) = 'TRUE' then - Result := '1' - else - Result := '0'; - end end; + if Datatype(Column).Index = dbdtBit then begin + if (UpperCase(Result) = 'TRUE') or (Result = '1') then + Result := '1' + else + Result := '0'; + end end else if not IgnoreErrors then Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); end; @@ -10006,11 +10010,8 @@ function TDBQuery.SaveModifications: Boolean; else if Cell.NewIsFunction then Val := Cell.NewText else case Datatype(i).Category of - dtcInteger, dtcReal: begin + dtcInteger, dtcReal: Val := Connection.EscapeString(Cell.NewText, Datatype(i)); - if (Datatype(i).Index = dbdtBit) and FConnection.Parameters.IsAnyMySQL then - Val := 'b' + Val; - end; dtcBinary, dtcSpatial: Val := FConnection.EscapeBin(Cell.NewText); dtcTemporal: @@ -10388,7 +10389,7 @@ function TDBQuery.GetWhereClause: String; case DataType(j).Category of dtcInteger, dtcReal: begin if DataType(j).Index = dbdtBit then - Result := Result + '=b' + Connection.EscapeString(ColVal) + Result := Result + '=' + Connection.EscapeString(ColVal, DataType(j)) else begin // Guess (!) the default value silently inserted by the server. This is likely // to be incomplete in cases where a UNIQUE key allows NULL here diff --git a/source/exportgrid.pas b/source/exportgrid.pas index 2f5c1e47b..a540b389b 100644 --- a/source/exportgrid.pas +++ b/source/exportgrid.pas @@ -1055,7 +1055,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); else if GridData.IsNull(ResultCol) then Data := 'NULL' else if (GridData.DataType(ResultCol).Index = dbdtBit) and GridData.Connection.Parameters.IsAnyMySQL then - Data := 'b' + GridData.Connection.EscapeString(Data) + Data := GridData.Connection.EscapeString(Data, GridData.DataType(ResultCol)) else if (GridData.DataType(ResultCol).Category in [dtcText, dtcTemporal, dtcOther]) or ((GridData.DataType(ResultCol).Category in [dtcBinary, dtcSpatial]) and Mainform.actBlobAsText.Checked) then diff --git a/source/tabletools.pas b/source/tabletools.pas index b7559ada2..a750d6950 100644 --- a/source/tabletools.pas +++ b/source/tabletools.pas @@ -2107,12 +2107,6 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); if Data.IsNull(i) then Row := Row + 'NULL' else case Data.DataType(i).Category of - dtcInteger, dtcReal: begin - if Data.DataType(i).Index = dbdtBit then - Row := Row + 'b' + Quoter.EscapeString(Data.Col(i)) - else - Row := Row + Data.Col(i); - end; dtcBinary, dtcSpatial: begin BinContent := Data.HexValue(i); if Length(BinContent) > 0 then From b6aee36c8a4f58ffb6a9c6ac791a9947c3bc7465 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 11 Feb 2026 16:10:02 +0100 Subject: [PATCH 010/170] fix: wrong schema queries in SQLite, always shows columns and indexes of first database file Closes #1823 --- source/dbconnection.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index cf6389746..3eeacda8e 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -6269,7 +6269,7 @@ function TSQLiteConnection.GetTableColumns(Table: TDBObject): TTableColumnList; // Todo: include database name // Todo: default values Result := TTableColumnList.Create(True); - ColQuery := GetResults('SELECT * FROM '+QuoteIdent(Table.Database)+'.pragma_table_xinfo('+EscapeString(Table.Name)+')'); + ColQuery := GetResults('SELECT * FROM pragma_table_xinfo('+EscapeString(Table.Name)+', '+EscapeString(Table.Database)+')'); while not ColQuery.Eof do begin Col := TTableColumn.Create(Self); Result.Add(Col); @@ -6556,7 +6556,7 @@ function TSQLiteConnection.GetTableKeys(Table: TDBObject): TTableKeyList; begin Result := TTableKeyList.Create(True); ColQuery := GetResults('SELECT * '+ - 'FROM '+QuoteIdent(Table.Database)+'.pragma_table_xinfo('+EscapeString(Table.Name)+') '+ + 'FROM pragma_table_xinfo('+EscapeString(Table.Name)+', '+EscapeString(Table.Database)+') '+ 'WHERE pk!=0 ORDER BY pk'); NewKey := nil; while not ColQuery.Eof do begin @@ -6576,7 +6576,7 @@ function TSQLiteConnection.GetTableKeys(Table: TDBObject): TTableKeyList; ColQuery.Free; KeyQuery := GetResults('SELECT * '+ - 'FROM '+QuoteIdent(Table.Database)+'.pragma_index_list('+EscapeString(Table.Name)+') '+ + 'FROM pragma_index_list('+EscapeString(Table.Name)+', '+EscapeString(Table.Database)+') '+ 'WHERE origin!='+EscapeString('pk')); while not KeyQuery.Eof do begin NewKey := TTableKey.Create(Self); @@ -6586,7 +6586,7 @@ function TSQLiteConnection.GetTableKeys(Table: TDBObject): TTableKeyList; NewKey.IndexType := IfThen(KeyQuery.Col('unique')='0', TTableKey.KEY, TTableKey.UNIQUE); NewKey.OldIndexType := NewKey.IndexType; ColQuery := GetResults('SELECT * '+ - 'FROM '+QuoteIdent(Table.Database)+'.pragma_index_info('+EscapeString(NewKey.Name)+')'); + 'FROM pragma_index_info('+EscapeString(NewKey.Name)+', '+EscapeString(Table.Database)+')'); while not ColQuery.Eof do begin NewKey.Columns.Add(ColQuery.Col('name')); NewKey.SubParts.Add(''); @@ -6801,7 +6801,7 @@ function TSQLiteConnection.GetTableForeignKeys(Table: TDBObject): TForeignKeyLis // SQLite: query PRAGMA foreign_key_list Result := TForeignKeyList.Create(True); ForeignQuery := GetResults('SELECT * '+ - 'FROM '+QuoteIdent(Table.Database)+'.pragma_foreign_key_list('+EscapeString(Table.Name)+')'); + 'FROM pragma_foreign_key_list('+EscapeString(Table.Name)+', '+EscapeString(Table.Database)+')'); ForeignKey := nil; while not ForeignQuery.Eof do begin if (not Assigned(ForeignKey)) or (ForeignKey.KeyName <> ForeignQuery.Col('id')) then begin From a12f21b2758125ae01d8357aa227855702d52366 Mon Sep 17 00:00:00 2001 From: Jochen Neubeck Date: Mon, 26 Feb 2024 09:17:04 +0100 Subject: [PATCH 011/170] Fix #1835 - Initial FK names assigned in TfrmTableEditor.listForeignKeysNewText() were lacking the referencing table's table name in case the referencing table was not created yet --- source/table_editor.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/source/table_editor.pas b/source/table_editor.pas index 5781bdbd3..cc5f71ede 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -2996,7 +2996,7 @@ procedure TfrmTableEditor.listForeignKeysNewText(Sender: TBaseVirtualTree; 2: begin Key.ReferenceTable := NewText; if not Key.KeyNameWasCustomized then begin - Key.KeyName := 'FK_'+DBObject.Name+'_'+Key.ReferenceTable; + Key.KeyName := 'FK_'+editName.Text+'_'+Key.ReferenceTable; i := 1; NameInUse := True; while NameInUse do begin @@ -3006,7 +3006,7 @@ procedure TfrmTableEditor.listForeignKeysNewText(Sender: TBaseVirtualTree; end; if NameInUse then begin Inc(i); - Key.KeyName := 'FK_'+DBObject.Name+'_'+Key.ReferenceTable+'_'+IntToStr(i); + Key.KeyName := 'FK_'+editName.Text+'_'+Key.ReferenceTable+'_'+IntToStr(i); end; end; From fcce4a396b50d392bf91443320c0d99582f7fb0c Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 11 Feb 2026 17:08:05 +0100 Subject: [PATCH 012/170] feat: display approximate row count of tables in database tab on MS SQL closes #1877 --- source/dbconnection.pas | 25 +++++++++++++++++-------- 1 file changed, 17 insertions(+), 8 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 3eeacda8e..e3bb4b1ff 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -6991,7 +6991,7 @@ function TDBConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): I Rows: String; begin // Get row number from a table - Rows := GetVar('SELECT COUNT(*) FROM '+QuoteIdent(Obj.Database)+'.'+QuoteIdent(Obj.Name), 0); + Rows := GetVar('SELECT COUNT(*) FROM '+QuotedDbAndTableName(Obj.Database, Obj.Name), 0); Result := MakeInt(Rows); end; @@ -7016,15 +7016,16 @@ function TAdoDBConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False) Rows: String; begin // Get row number from a mssql table - if ServerVersionInt >= 900 then begin + if (ServerVersionInt < 900) or ForceExact then begin + Result := inherited + end + else begin Rows := GetVar('SELECT SUM('+QuoteIdent('rows')+') FROM '+QuoteIdent('sys')+'.'+QuoteIdent('partitions')+ ' WHERE '+QuoteIdent('index_id')+' IN (0, 1)'+ ' AND '+QuoteIdent('object_id')+' = object_id('+EscapeString(Obj.Database+'.'+Obj.Schema+'.'+Obj.Name)+')' ); - end else begin - Rows := GetVar('SELECT COUNT(*) FROM '+Obj.QuotedDbAndTableName); + Result := MakeInt(Rows); end; - Result := MakeInt(Rows); end; @@ -7591,13 +7592,19 @@ procedure TAdoDBConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); // Tables, views and procedures Results := nil; // Schema support introduced in MSSQL 2005 (9.0). See issue #3212. + // RowsInTable added in 12.16 SchemaSelect := EscapeString(''); if ServerVersionInt >= 900 then SchemaSelect := 'SCHEMA_NAME('+QuoteIdent('schema_id')+')'; try - Results := GetResults('SELECT *, '+SchemaSelect+' AS '+EscapeString('schema')+ - ' FROM '+QuoteIdent(db)+GetSQLSpecifity(spDbObjectsTable)+ - ' WHERE '+QuoteIdent('type')+' IN ('+EscapeString('P')+', '+EscapeString('U')+', '+EscapeString('V')+', '+EscapeString('TR')+', '+EscapeString('FN')+', '+EscapeString('TF')+', '+EscapeString('IF')+')'); + Results := GetResults('SELECT o.*, '+SchemaSelect+' AS '+EscapeString('schema')+', rc.RowsInTable'+ + ' FROM '+QuoteIdent(db)+GetSQLSpecifity(spDbObjectsTable)+ ' AS o'+ + ' LEFT JOIN ('+ + ' SELECT object_id, SUM(rows) AS RowsInTable FROM '+QuoteIdent(db)+'.sys.partitions'+ + ' WHERE index_id IN (0,1)'+ // -- heap or clustered index + ' GROUP BY object_id'+ + ' ) AS rc ON rc.object_id = o.object_id'+ + ' WHERE o.'+QuoteIdent('type')+' IN ('+EscapeString('P')+', '+EscapeString('U')+', '+EscapeString('V')+', '+EscapeString('TR')+', '+EscapeString('FN')+', '+EscapeString('TF')+', '+EscapeString('IF')+')'); except on E:EDbError do; end; @@ -7621,6 +7628,8 @@ procedure TAdoDBConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); obj.NodeType := lntTrigger else if (tp = 'FN') or (tp = 'TF') or (tp = 'IF') then obj.NodeType := lntFunction; + obj.Rows := StrToInt64Def(Results.Col('RowsInTable'), -1); + obj.RowsAreExact := False; // approximate, not guaranteed exact. // Set reasonable default value for calculation of export chunks. See #343 // OFFSET..FETCH supported from v11.0/2012 // Disabled, leave at -1 and prefer a generic calculation in TfrmTableTools.DoExport From c843b196b5692472e933013b6ee3f480216dbd23 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Thu, 12 Feb 2026 18:06:59 +0100 Subject: [PATCH 013/170] feat: create SQL export option for wrapping DML commands in a BEGIN/COMMIT transaction This also * removes the MyISAM-only ALTER TABLE .. DISABLE/ENABLE KEYS command, which in mid size tables costs more than it helps. * shows the number of checked export options on the button caption * saves settings when the user just closes the dialog, without having exported Closes #1262 --- source/apphelpers.pas | 3 ++- source/tabletools.dfm | 8 ++++++++ source/tabletools.pas | 35 ++++++++++++++++++++++++++--------- 3 files changed, 36 insertions(+), 10 deletions(-) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index c7a4d61f3..312a00cfc 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -193,7 +193,7 @@ TWinControlHelper = class helper for TWinControl asSSLCert, asSSLCA, asSSLCipher, asSSLVerification, asSSLWarnUnused, asNetType, asCompressed, asLocalTimeZone, asQueryTimeout, asKeepAlive, asStartupScriptFilename, asDatabases, asComment, asDatabaseFilter, asTableFilter, asFilterVT, asExportSQLCreateDatabases, asExportSQLCreateTables, asExportSQLDataHow, asExportSQLDataInsertSize, asExportSQLFilenames, asExportZIPFilenames, asExportSQLDirectories, - asExportSQLDatabase, asExportSQLServerDatabase, asExportSQLOutput, asExportSQLAddComments, asExportSQLRemoveAutoIncrement, asExportSQLRemoveDefiner, + asExportSQLDatabase, asExportSQLServerDatabase, asExportSQLOutput, asExportSQLAddComments, asExportSQLTransactions, asExportSQLRemoveAutoIncrement, asExportSQLRemoveDefiner, asGridExportWindowWidth, asGridExportWindowHeight, asGridExportOutputCopy, asGridExportOutputFile, asGridExportFilename, asGridExportRecentFiles, asGridExportEncoding, asGridExportFormat, asGridExportSelection, asGridExportColumnNames, asGridExportIncludeAutoInc, asGridExportIncludeQuery, asGridExportRemoveLinebreaks, asGridExportOpenFile, @@ -3953,6 +3953,7 @@ constructor TAppSettings.Create; InitSetting(asExportSQLServerDatabase, 'ExportSQL_ServerDatabase', 0, False, ''); InitSetting(asExportSQLOutput, 'ExportSQL_Output', 0); InitSetting(asExportSQLAddComments, 'ExportSQLAddComments', 0, True); + InitSetting(asExportSQLTransactions, 'ExportSQLTransactions', 0, False); InitSetting(asExportSQLRemoveAutoIncrement, 'ExportSQLRemoveAutoIncrement', 0, False); InitSetting(asExportSQLRemoveDefiner, 'ExportSQLRemoveDefiner', 0, True); InitSetting(asGridExportWindowWidth, 'GridExportWindowWidth', 400); diff --git a/source/tabletools.dfm b/source/tabletools.dfm index 8f249cc33..fbace92eb 100644 --- a/source/tabletools.dfm +++ b/source/tabletools.dfm @@ -814,14 +814,22 @@ object frmTableTools: TfrmTableTools object menuExportAddComments: TMenuItem AutoCheck = True Caption = 'Add comments' + OnClick = menuExportOptionClick + end + object menuExportTransactions: TMenuItem + AutoCheck = True + Caption = 'Wrap data DML in transactions' + OnClick = menuExportOptionClick end object menuExportRemoveAutoIncrement: TMenuItem AutoCheck = True Caption = 'Remove AUTO_INCREMENT clauses' + OnClick = menuExportOptionClick end object menuExportRemoveDefiner: TMenuItem AutoCheck = True Caption = 'Remove DEFINER clauses' + OnClick = menuExportOptionClick end object menuCopyMysqldumpCommand: TMenuItem Caption = 'Copy mysqldump command' diff --git a/source/tabletools.pas b/source/tabletools.pas index a750d6950..2a841a4c9 100644 --- a/source/tabletools.pas +++ b/source/tabletools.pas @@ -103,6 +103,7 @@ TfrmTableTools = class(TExtForm) editGenerateDataNullAmount: TEdit; updownGenerateDataNullAmount: TUpDown; menuInvertCheck: TMenuItem; + menuExportTransactions: TMenuItem; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure btnHelpMaintenanceClick(Sender: TObject); @@ -128,7 +129,7 @@ TfrmTableTools = class(TExtForm) procedure ResultGridPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure ValidateControls(Sender: TObject); - procedure SaveSettings(Sender: TObject); + procedure SaveSettings; procedure chkExportOptionClick(Sender: TObject); procedure btnExportOutputTargetSelectClick(Sender: TObject); procedure comboExportOutputTargetChange(Sender: TObject); @@ -159,6 +160,7 @@ TfrmTableTools = class(TExtForm) Index: Integer; Rect: TRect; State: TOwnerDrawState); procedure comboExportOutputTypeMeasureItem(Control: TWinControl; Index: Integer; var Height: Integer); + procedure menuExportOptionClick(Sender: TObject); const StatusMsg = '%s %s ...'; private @@ -295,6 +297,7 @@ procedure TfrmTableTools.FormCreate(Sender: TObject); comboExportData.ItemIndex := AppSettings.ReadInt(asExportSQLDataHow); updownInsertSize.Position := AppSettings.ReadInt(asExportSQLDataInsertSize); menuExportAddComments.Checked := AppSettings.ReadBool(asExportSQLAddComments); + menuExportTransactions.Checked := AppSettings.ReadBool(asExportSQLTransactions); menuExportRemoveAutoIncrement.Checked := AppSettings.ReadBool(asExportSQLRemoveAutoIncrement); menuExportRemoveDefiner.Checked := AppSettings.ReadBool(asExportSQLRemoveDefiner); // Add hardcoded output options and session names from registry @@ -539,11 +542,26 @@ procedure TfrmTableTools.menuCopyMysqldumpCommandClick(Sender: TObject); end; +procedure TfrmTableTools.menuExportOptionClick(Sender: TObject); +var + i: Integer; + MenuItem: TMenuItem; +begin + // Display number of checked options in button caption + i := 0; + for MenuItem in popupExportOptions.Items do begin + if MenuItem.Checked then + Inc(i); + end; + btnExportOptions.Caption := _('Options') + ' (' + i.ToString + ')'; +end; + procedure TfrmTableTools.FormClose(Sender: TObject; var Action: TCloseAction); begin // Auto close temorary connection if Assigned(FTargetConnection) then FreeAndNil(FTargetConnection); + SaveSettings; // Save GUI setup AppSettings.WriteIntDpiAware(asTableToolsWindowWidth, Self, Width); AppSettings.WriteIntDpiAware(asTableToolsWindowHeight, Self, Height); @@ -551,7 +569,7 @@ procedure TfrmTableTools.FormClose(Sender: TObject; var Action: TCloseAction); end; -procedure TfrmTableTools.SaveSettings(Sender: TObject); +procedure TfrmTableTools.SaveSettings; var i: Integer; Items: TStringList; @@ -573,6 +591,7 @@ procedure TfrmTableTools.SaveSettings(Sender: TObject); if comboExportData.ItemIndex > 0 then AppSettings.WriteInt(asExportSQLDataInsertSize, updownInsertSize.Position); AppSettings.WriteBool(asExportSQLAddComments, menuExportAddComments.Checked); + AppSettings.WriteBool(asExportSQLTransactions, menuExportTransactions.Checked); AppSettings.WriteBool(asExportSQLRemoveAutoIncrement, menuExportRemoveAutoIncrement.Checked); AppSettings.WriteBool(asExportSQLRemoveDefiner, menuExportRemoveDefiner.Checked); @@ -629,6 +648,7 @@ procedure TfrmTableTools.ValidateControls(Sender: TObject); TExtForm.PageControlTabHighlight(tabsTools); btnSeeResults.Visible := tabsTools.ActivePage = tabFind; lblCheckedSize.Caption := f_('Selected objects size: %s', [FormatByteNumber(FObjectSizes)]); + menuExportOptionClick(Sender); if tabsTools.ActivePage = tabMaintenance then begin btnExecute.Caption := _('Execute'); btnExecute.Enabled := (Pos(_(SUnsupported), comboOperation.Text) = 0) and SomeChecked; @@ -1025,7 +1045,6 @@ procedure TfrmTableTools.Execute(Sender: TObject); tabsTools.Enabled := True; treeObjects.Enabled := True; ValidateControls(Sender); - SaveSettings(Sender); Screen.Cursor := crDefault; end; @@ -2042,6 +2061,8 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); tmp := '~'+tmp+' ('+_('approximately')+')'; if menuExportAddComments.Checked then Output('-- '+f_('Dumping data for table %s.%s: %s', [DBObj.Database, DBObj.Name, tmp])+CRLF, False, True, True, False, False); + if menuExportTransactions.Checked then + Output('BEGIN', True, True, True, True, True); TargetDbAndObject := Quoter.QuoteIdent(DBObj.Name); if ToDb then TargetDbAndObject := Quoter.QuoteIdent(FinalDbName) + '.' + TargetDbAndObject; @@ -2064,9 +2085,6 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); Limit := Round(100 * SIZE_MB / IfThen(DBObj.AvgRowLen>0, DBObj.AvgRowLen, AssumedAvgRowLen)); if comboExportData.Text = DATA_REPLACE then Output('DELETE FROM '+TargetDbAndObject, True, True, True, True, True); - if DBObj.Engine.ToLowerInvariant <> 'innodb' then begin - Output('/*!40000 ALTER TABLE '+TargetDbAndObject+' DISABLE KEYS */', True, True, True, True, True); - end; while true do begin Data := DBObj.Connection.GetResults( DBObj.Connection.ApplyLimitClause( @@ -2144,9 +2162,8 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); break; end; - if DBObj.Engine.ToLowerInvariant <> 'innodb' then begin - Output('/*!40000 ALTER TABLE '+TargetDbAndObject+' ENABLE KEYS */', True, True, True, True, True); - end; + if menuExportTransactions.Checked then + Output('COMMIT', True, True, True, True, True); Output(CRLF, False, True, True, True, True); // Cosmetic fix for estimated InnoDB row count DBObj.Rows := RowCount; From 99b14b0c285f7d29975df3303be515dfff27fffe Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Thu, 12 Feb 2026 21:10:54 +0100 Subject: [PATCH 014/170] feat: refactor SQL query in TPGConnection.FetchDbObjects, now including materialized views for which we have no editor yet Refs #1880 --- source/dbconnection.pas | 99 +++++++++++++++++++---------------------- 1 file changed, 47 insertions(+), 52 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index e3bb4b1ff..e5be2a910 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -7646,35 +7646,53 @@ procedure TPGConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); var obj: TDBObject; Results: TDBQuery; - tp, SchemaTable: String; - DataLenClause, IndexLenClause: String; + tp: String; + DataLenClause, IndexLenClause, ProKindClause: String; begin // Tables, views and procedures Results := nil; try - // See http://www.heidisql.com/forum.php?t=16429 - if ServerVersionInt >= 70300 then - SchemaTable := 'QUOTE_IDENT(t.TABLE_SCHEMA) || '+EscapeString('.')+' || QUOTE_IDENT(t.TABLE_NAME)' - else - SchemaTable := EscapeString(FQuoteChar)+' || t.TABLE_SCHEMA || '+EscapeString(FQuoteChar+'.'+FQuoteChar)+' || t.TABLE_NAME || '+EscapeString(FQuoteChar); // See http://www.heidisql.com/forum.php?t=16996 if Parameters.FullTableStatus and (ServerVersionInt >= 90000) then - DataLenClause := 'pg_table_size('+SchemaTable+')::bigint' + DataLenClause := 'pg_table_size(format(''%I.%I'', n.nspname, c.relname))::bigint' else DataLenClause := 'NULL'; // See https://www.heidisql.com/forum.php?t=34635 if Parameters.FullTableStatus and (ServerVersionInt >= 80100) then - IndexLenClause := 'pg_relation_size('+SchemaTable+')::bigint' + IndexLenClause := 'pg_relation_size(format(''%I.%I'', n.nspname, c.relname))::bigint' else IndexLenClause := 'relpages::bigint * '+SIZE_KB.ToString; - Results := GetResults('SELECT *,'+ - ' '+DataLenClause+' AS data_length,'+ - ' '+IndexLenClause+' AS index_length,'+ - ' c.reltuples, obj_description(c.oid) AS comment'+ - ' FROM '+QuoteIdent(InfSch)+'.'+QuoteIdent('tables')+' AS t'+ - ' LEFT JOIN '+QuoteIdent('pg_namespace')+' n ON t.table_schema = n.nspname'+ - ' LEFT JOIN '+QuoteIdent('pg_class')+' c ON n.oid = c.relnamespace AND c.relname=t.table_name'+ - ' WHERE t.'+QuoteIdent('table_schema')+'='+EscapeString(db) // Use table_schema when using schemata + if ServerVersionInt >= 110000 then + ProKindClause := 'p.prokind' + else + ProKindClause := EscapeString('p'); + Results := GetResults('SELECT '+ + ' n.nspname AS schema_name, '+ + ' c.relname AS object_name, '+ + ' c.relkind AS object_kind, '+ + ' '+DataLenClause+' AS data_length, '+ + ' '+IndexLenClause+' AS index_length, '+ + ' c.reltuples, '+ + ' obj_description(c.oid) AS comment, '+ + ' NULL AS proargtypes '+ + 'FROM pg_class c '+ + 'JOIN pg_namespace n ON n.oid = c.relnamespace '+ + 'WHERE n.nspname = '+EscapeString(db)+' '+ + ' AND c.relkind IN (''r'',''v'',''m'') '+ + 'UNION ALL '+ + 'SELECT '+ + ' n.nspname AS schema_name, '+ + ' p.proname AS object_name, '+ + ' '+ProKindClause+' AS object_kind, '+ + ' NULL::bigint AS data_length, '+ + ' NULL::bigint AS index_length, '+ + ' NULL::real AS reltuples, '+ + ' obj_description(p.oid) AS comment, '+ + ' p.proargtypes '+ + 'FROM pg_proc p '+ + 'JOIN pg_namespace n ON n.oid = p.pronamespace '+ + 'WHERE n.nspname = '+EscapeString(db)+' '+ + ' AND p.prokind IN (''f'',''p'') ' ); except on E:EDbError do; @@ -7683,11 +7701,11 @@ procedure TPGConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); while not Results.Eof do begin obj := TDBObject.Create(Self); Cache.Add(obj); - obj.Name := Results.Col('table_name'); + obj.Name := Results.Col('object_name'); obj.Created := 0; obj.Updated := 0; obj.Database := db; - obj.Schema := Results.Col('table_schema'); // Remove when using schemata + obj.Schema := Results.Col('schema_name'); // Remove when using schemata obj.Comment := Results.Col('comment'); obj.Rows := StrToInt64Def(Results.Col('reltuples'), obj.Rows); obj.DataLen := StrToInt64Def(Results.Col('data_length'), obj.DataLen); @@ -7695,41 +7713,18 @@ procedure TPGConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); obj.Size := obj.DataLen + obj.IndexLen; Inc(Cache.FDataSize, Obj.Size); Cache.FLargestObjectSize := Max(Cache.FLargestObjectSize, Obj.Size); - tp := Results.Col('table_type', True); - if tp = 'VIEW' then + tp := Results.Col('object_kind', True); + if tp = 'r' then + obj.NodeType := lntTable + else if tp = 'v' then obj.NodeType := lntView - else - obj.NodeType := lntTable; - Results.Next; - end; - FreeAndNil(Results); - end; - - // Stored functions and procedures in PostgreSQL. - // See http://dba.stackexchange.com/questions/2357/what-are-the-differences-between-stored-procedures-and-stored-functions - try - Results := GetResults('SELECT '+ - QuoteIdent('p')+'.'+QuoteIdent('proname')+', '+ - QuoteIdent('p')+'.'+QuoteIdent('proargtypes')+', '+ - QuoteIdent('p')+'.'+QuoteIdent('prokind')+' '+ - 'FROM '+QuoteIdent('pg_catalog')+'.'+QuoteIdent('pg_namespace')+' AS '+QuoteIdent('n')+' '+ - 'JOIN '+QuoteIdent('pg_catalog')+'.'+QuoteIdent('pg_proc')+' AS '+QuoteIdent('p')+' ON '+QuoteIdent('p')+'.'+QuoteIdent('pronamespace')+' = '+QuoteIdent('n')+'.'+QuoteIdent('oid')+' '+ - 'WHERE '+QuoteIdent('n')+'.'+QuoteIdent('nspname')+'='+EscapeString(db) - ); - except - on E:EDbError do; - end; - if Assigned(Results) then begin - while not Results.Eof do begin - obj := TDBObject.Create(Self); - Cache.Add(obj); - obj.Name := Results.Col('proname'); + else if tp = 'm' then + obj.NodeType := lntView + else if tp = 'f' then + obj.NodeType := lntFunction + else if tp = 'p' then + obj.NodeType := lntProcedure; obj.ArgTypes := Results.Col('proargtypes'); - obj.Database := db; - if Results.Col('prokind') = 'p' then - obj.NodeType := lntProcedure - else - obj.NodeType := lntFunction; Results.Next; end; FreeAndNil(Results); From a4456aa205aa530f34117e533f560877ab271b45 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 13 Feb 2026 07:13:25 +0100 Subject: [PATCH 015/170] enhance: re-enable tree option asDoubleClickInsertsNodeText by default closes #2406 --- source/apphelpers.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 312a00cfc..74944e2f3 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -4128,7 +4128,7 @@ constructor TAppSettings.Create; InitSetting(asDateTimeEditorCursorPos, 'DateTimeEditor_CursorPos_Type%s', 0); InitSetting(asAppLanguage, 'Language', 0, False, ''); InitSetting(asAutoExpand, 'AutoExpand', 0, False); - InitSetting(asDoubleClickInsertsNodeText, 'DoubleClickInsertsNodeText', 0, False); + InitSetting(asDoubleClickInsertsNodeText, 'DoubleClickInsertsNodeText', 0, True); InitSetting(asForeignDropDown, 'ForeignDropDown', 0, True); InitSetting(asIncrementalSearch, 'IncrementalSearch', 0, True); InitSetting(asQueryHistoryEnabled, 'QueryHistory', 0, True); From 3b3c941169ddcbe9b282b1de07911f6e77571c7c Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 13 Feb 2026 18:55:22 +0100 Subject: [PATCH 016/170] feat: support PG materialized views in GetCreateCode() and GetTableColumns() Refs #1880 --- source/dbconnection.pas | 186 +++++++++++++++++++++++++++++----------- 1 file changed, 138 insertions(+), 48 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index e5be2a910..c6d711e6b 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -181,7 +181,7 @@ TDBObject = class(TPersistent) Rows, Size, Version, AvgRowLen, MaxDataLen, IndexLen, DataLen, DataFree, AutoInc, CheckSum: Int64; // Routine options: Body, Definer, Returns, DataAccess, Security, ArgTypes: String; - Deterministic, RowsAreExact: Boolean; + Deterministic, RowsAreExact, IsMaterialized: Boolean; NodeType, GroupType: TListNodeType; constructor Create(OwnerConnection: TDBConnection); @@ -757,7 +757,6 @@ TPgConnection = class(TDBConnection) function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; property LastRawResults: TPGRawResults read FLastRawResults; property RegClasses: TOidStringPairs read FRegClasses; - function GetTableColumns(Table: TDBObject): TTableColumnList; override; function GetTableKeys(Table: TDBObject): TTableKeyList; override; function GetTableForeignKeys(Table: TDBObject): TForeignKeyList; override; end; @@ -4220,11 +4219,22 @@ function TPgConnection.GetCreateCode(Obj: TDBObject): String; case Obj.NodeType of lntView: begin // Prefer pg_catalog tables. See http://www.heidisql.com/forum.php?t=16213#p16685 - Result := 'CREATE VIEW ' + QuoteIdent(Obj.Name) + ' AS ' + GetVar('SELECT '+QuoteIdent('definition')+ - ' FROM '+QuoteIdent('pg_views')+ - ' WHERE '+QuoteIdent('viewname')+'='+EscapeString(Obj.Name)+ - ' AND '+QuoteIdent('schemaname')+'='+EscapeString(Obj.Schema) - ); + Result := 'CREATE VIEW ' + QuoteIdent(Obj.Name) + ' AS '; + if not Obj.IsMaterialized then begin // normal view + Result := Result + GetVar('SELECT '+QuoteIdent('definition')+ + ' FROM '+QuoteIdent('pg_views')+ + ' WHERE '+QuoteIdent('viewname')+'='+EscapeString(Obj.Name)+ + ' AND '+QuoteIdent('schemaname')+'='+EscapeString(Obj.Schema) + ); + end + else begin // materialized view + Result := Result + GetVar('SELECT '+QuoteIdent('definition')+ + ' FROM '+QuoteIdent('pg_matviews')+ + ' WHERE '+QuoteIdent('matviewname')+'='+EscapeString(Obj.Name)+ + ' AND '+QuoteIdent('schemaname')+'='+EscapeString(Obj.Schema) + ); + end; + end; lntFunction, lntProcedure: begin Result := 'CREATE '+Obj.GetObjType.ToUpper+' '+QuoteIdent(Obj.Name); @@ -5991,19 +6001,120 @@ function TDBConnection.GetTableColumns(Table: TDBObject): TTableColumnList; TableIdx: Integer; ColQuery: TDBQuery; Col: TTableColumn; - dt, DefText, ExtraText, MaxLen: String; + dt, DefText, ExtraText, MaxLen, ColSQL: String; begin // Generic: query table columns from IS.COLUMNS Log(lcDebug, 'Getting fresh columns for '+Table.QuotedDbAndTableName); Result := TTableColumnList.Create(True); - TableIdx := InformationSchemaObjects.IndexOf('columns'); - if TableIdx = -1 then begin - // No is.columns table available - Exit; + + if (FParameters.IsAnyPostgreSQL) and (ServerVersionInt >= 120000) then begin + // This uses pg_attribute.attgenerated, which only exists starting in PostgreSQL 12 + // Todo: outsource such bigger SQL chunks into dbstructures units, together with the FSQLSpecifities array + ColSQL := + 'SELECT ' + + ' n.nspname AS table_schema, ' + + ' c.relname AS table_name, ' + + ' a.attname AS column_name, ' + + ' a.attnum AS ordinal_position, ' + + ' pg_catalog.format_type(a.atttypid, a.atttypmod) AS data_type, ' + + // YES/NO like information_schema.is_nullable + ' CASE ' + + ' WHEN a.attnotnull THEN ''NO'' ' + + ' ELSE ''YES'' ' + + ' END AS is_nullable, ' + + // Character maximum length (in characters) + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' AND a.atttypmod <> -1 ' + + ' THEN a.atttypmod - 4 ' + + ' ELSE NULL ' + + ' END AS character_maximum_length, ' + + // Numeric precision / scale (NULL for non-numeric) + ' CASE ' + + ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.atttypmod = -1 THEN NULL ' + + ' ELSE ((a.atttypmod - 4) >> 16)::integer ' + + ' END ' + + ' END AS numeric_precision, ' + + ' CASE ' + + ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.atttypmod = -1 THEN NULL ' + + ' ELSE ((a.atttypmod - 4) & 65535)::integer ' + + ' END ' + + ' END AS numeric_scale, ' + + // Datetime precision (for time/timestamp/interval) + ' CASE ' + + ' WHEN (bt.typcategory = ''D'' OR (bt.oid IS NULL AND t.typcategory = ''D'')) ' + + ' AND a.atttypmod <> -1 ' + + ' THEN a.atttypmod ' + + ' ELSE NULL ' + + ' END AS datetime_precision, ' + + // Character set name: PostgreSQL has one per DB; mimic information_schema + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' THEN current_database() ' + + ' ELSE NULL ' + + ' END AS character_set_name, ' + + // Collation name for collatable columns + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.attcollation <> t.typcollation ' + + ' THEN coll.collname ' + + ' ELSE NULL ' + + ' END ' + + ' ELSE NULL ' + + ' END AS collation_name, ' + + // Default expression for non-generated columns + ' CASE ' + + ' WHEN a.attgenerated = '''' AND a.atthasdef ' + + ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + + ' ELSE NULL ' + + ' END AS column_default, ' + + // Generation expression for generated columns + ' CASE ' + + ' WHEN a.attgenerated <> '''' AND a.atthasdef ' + + ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + + ' ELSE NULL ' + + ' END AS generation_expression, ' + + ' d.description AS column_comment ' + + 'FROM pg_catalog.pg_class AS c ' + + 'JOIN pg_catalog.pg_namespace AS n ON n.oid = c.relnamespace ' + + 'JOIN pg_catalog.pg_attribute AS a ON a.attrelid = c.oid ' + + 'JOIN pg_catalog.pg_type AS t ON t.oid = a.atttypid ' + + 'LEFT JOIN pg_catalog.pg_type AS bt ON bt.oid = t.typbasetype ' + + 'LEFT JOIN pg_catalog.pg_attrdef AS ad ' + + ' ON ad.adrelid = a.attrelid ' + + ' AND ad.adnum = a.attnum ' + + 'LEFT JOIN pg_catalog.pg_description AS d ' + + ' ON d.objoid = a.attrelid ' + + ' AND d.objsubid = a.attnum ' + + 'LEFT JOIN pg_catalog.pg_collation AS coll ' + + ' ON coll.oid = a.attcollation ' + + 'WHERE n.nspname = ' + EscapeString(Table.Schema) + ' ' + + ' AND a.attnum > 0 ' + + ' AND NOT a.attisdropped ' + + ' AND c.relname = ' + EscapeString(Table.Name) + ' ' + + 'ORDER BY ordinal_position'; + end + + else begin + TableIdx := InformationSchemaObjects.IndexOf('columns'); + if TableIdx = -1 then begin + // No is.columns table available + Exit; + end; + ColSQL := 'SELECT * FROM '+QuoteIdent(InfSch)+'.'+QuoteIdent(InformationSchemaObjects[TableIdx])+ + ' WHERE '+Table.SchemaClauseIS('TABLE')+' AND TABLE_NAME='+EscapeString(Table.Name)+ + ' ORDER BY ORDINAL_POSITION'; end; - ColQuery := GetResults('SELECT * FROM '+QuoteIdent(InfSch)+'.'+QuoteIdent(InformationSchemaObjects[TableIdx])+ - ' WHERE '+Table.SchemaClauseIS('TABLE')+' AND TABLE_NAME='+EscapeString(Table.Name)+ - ' ORDER BY ORDINAL_POSITION'); + ColQuery := GetResults(ColSQL); + while not ColQuery.Eof do begin Col := TTableColumn.Create(Self); Result.Add(Col); @@ -6232,34 +6343,6 @@ function TAdoDBConnection.GetTableColumns(Table: TDBObject): TTableColumnList; end; -function TPgConnection.GetTableColumns(Table: TDBObject): TTableColumnList; -var - Comments: TDBQuery; - TableCol: TTableColumn; -begin - Result := inherited; - // Column comments in Postgre. See issue #859 - // Todo: add current schema to WHERE clause? - Comments := GetResults('SELECT a.attname AS column, des.description AS comment'+ - ' FROM pg_attribute AS a, pg_description AS des, pg_class AS pgc'+ - ' WHERE'+ - ' pgc.oid = a.attrelid'+ - ' AND des.objoid = pgc.oid'+ - ' AND pg_table_is_visible(pgc.oid)'+ - ' AND pgc.relname = '+EscapeString(Table.Name)+ - ' AND a.attnum = des.objsubid' - ); - while not Comments.Eof do begin - for TableCol in Result do begin - if TableCol.Name = Comments.Col('column') then begin - TableCol.Comment := Comments.Col('comment'); - Break; - end; - end; - Comments.Next; - end; -end; - function TSQLiteConnection.GetTableColumns(Table: TDBObject): TTableColumnList; var ColQuery: TDBQuery; @@ -7692,7 +7775,7 @@ procedure TPGConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); 'FROM pg_proc p '+ 'JOIN pg_namespace n ON n.oid = p.pronamespace '+ 'WHERE n.nspname = '+EscapeString(db)+' '+ - ' AND p.prokind IN (''f'',''p'') ' + ' AND '+ProKindClause+' IN (''f'',''p'') ' ); except on E:EDbError do; @@ -7716,10 +7799,14 @@ procedure TPGConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); tp := Results.Col('object_kind', True); if tp = 'r' then obj.NodeType := lntTable - else if tp = 'v' then - obj.NodeType := lntView - else if tp = 'm' then - obj.NodeType := lntView + else if tp = 'v' then begin + obj.NodeType := lntView; + obj.IsMaterialized := False; + end + else if tp = 'm' then begin + obj.NodeType := lntView; + obj.IsMaterialized := True; + end else if tp = 'f' then obj.NodeType := lntFunction else if tp = 'p' then @@ -10492,6 +10579,7 @@ function TDBObjectDropComparer.Compare(const Left, Right: TDBObject): Integer; constructor TDBObject.Create(OwnerConnection: TDBConnection); begin + // Take care, when adding properties here, add them in Assign() below as well Name := ''; Schema := ''; Database := ''; @@ -10522,6 +10610,7 @@ constructor TDBObject.Create(OwnerConnection: TDBConnection); ArgTypes := ''; Deterministic := False; RowsAreExact := False; + IsMaterialized := False; NodeType := lntNone; GroupType := lntNone; FCreateCode := ''; @@ -10567,6 +10656,7 @@ procedure TDBObject.Assign(Source: TPersistent); ArgTypes := s.ArgTypes; Deterministic := s.Deterministic; RowsAreExact := s.RowsAreExact; + IsMaterialized := s.IsMaterialized; NodeType := s.NodeType; GroupType := s.GroupType; FCreateCode := s.FCreateCode; From c450f516b7b824d4a4ec0ce2adb2f3bf96807698 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 15 Feb 2026 15:04:22 +0100 Subject: [PATCH 017/170] refactor: replace FSQLSpecifities with a TSqlProvider, and outsource many hardcoded SQL queries to the dbstructures.* units Refs #667 and #1880 --- source/apphelpers.pas | 4 +- source/connections.pas | 2 +- source/dbconnection.pas | 468 ++++++++--------------------- source/dbstructures.interbase.pas | 46 ++- source/dbstructures.mssql.pas | 70 ++++- source/dbstructures.mysql.pas | 24 +- source/dbstructures.pas | 137 ++++++++- source/dbstructures.postgresql.pas | 40 +++ source/dbstructures.sqlite.pas | 40 +++ source/main.pas | 50 +-- source/table_editor.pas | 16 +- source/tabletools.pas | 6 +- 12 files changed, 519 insertions(+), 384 deletions(-) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 74944e2f3..de1e85586 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -1889,9 +1889,9 @@ function TSortItems.ComposeOrderClause(Connection: TDBConnection): String; if Result <> '' then Result := Result + ', '; if SortItem.Order = sioAscending then - SortOrder := Connection.GetSQLSpecifity(spOrderAsc) + SortOrder := Connection.SqlProvider.GetSql(qOrderAsc) else - SortOrder := Connection.GetSQLSpecifity(spOrderDesc); + SortOrder := Connection.SqlProvider.GetSql(qOrderDesc); Result := Result + Connection.QuoteIdent(SortItem.Column) + ' ' + SortOrder; end; end; diff --git a/source/connections.pas b/source/connections.pas index 3f8e95af2..462e2d4ca 100644 --- a/source/connections.pas +++ b/source/connections.pas @@ -13,7 +13,7 @@ interface VirtualTrees, Vcl.Menus, Vcl.Graphics, System.Generics.Collections, Winapi.ActiveX, extra_controls, Winapi.Messages, dbconnection, gnugettext, SynRegExpr, System.Types, Vcl.GraphUtil, Data.Win.ADODB, System.StrUtils, System.Math, System.Actions, System.IOUtils, Vcl.ActnList, Vcl.StdActns, VirtualTrees.BaseTree, VirtualTrees.Types, VirtualTrees.EditLink, - VirtualTrees.BaseAncestorVCL, VirtualTrees.AncestorVCL; + VirtualTrees.BaseAncestorVCL, VirtualTrees.AncestorVCL, dbstructures; type Tconnform = class(TExtForm) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index c6d711e6b..1c9bc2a6d 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -295,29 +295,6 @@ TSQLFunctionList = class(TObjectList) { TConnectionParameters and friends } - TNetType = ( - ntMySQL_TCPIP, - ntMySQL_NamedPipe, - ntMySQL_SSHtunnel, - ntMSSQL_NamedPipe, - ntMSSQL_TCPIP, - ntMSSQL_SPX, - ntMSSQL_VINES, - ntMSSQL_RPC, - ntPgSQL_TCPIP, - ntPgSQL_SSHtunnel, - ntSQLite, - ntMySQL_ProxySQLAdmin, - ntInterbase_TCPIP, - ntInterbase_Local, - ntFirebird_TCPIP, - ntFirebird_Local, - ntMySQL_RDS, - ntSQLiteEncrypted - ); - TNetTypeGroup = (ngMySQL, ngMSSQL, ngPgSQL, ngSQLite, ngInterbase); - TNetTypeLibs = TDictionary; - TConnectionParameters = class(TObject) strict private FDeleteAfterUse: Boolean; @@ -440,17 +417,6 @@ TDBLogItem = class(TObject) TDBLogEvent = procedure(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil) of object; TDBEvent = procedure(Connection: TDBConnection; Database: String) of object; TDBDataTypeArray = Array of TDBDataType; - TSQLSpecifityId = (spDatabaseTable, spDatabaseTableId, spDatabaseDrop, - spDbObjectsTable, spDbObjectsCreateCol, spDbObjectsUpdateCol, spDbObjectsTypeCol, - spEmptyTable, spRenameTable, spRenameView, spCurrentUserHost, spLikeCompare, - spAddColumn, spChangeColumn, spRenameColumn, spForeignKeyEventAction, - spGlobalStatus, spCommandsCounters, spSessionVariables, spGlobalVariables, - spISSchemaCol, - spUSEQuery, spKillQuery, spKillProcess, - spFuncLength, spFuncCeil, spFuncLeft, spFuncNow, spFuncLastAutoIncNumber, - spLockedTables, spDisableForeignKeyChecks, spEnableForeignKeyChecks, - spOrderAsc, spOrderDesc, - spForeignKeyDrop); TFeatureOrRequirement = (frSrid, frTimezoneVar, frTemporalTypesFraction, frKillQuery, frLockedTables, frShowCreateTrigger, frShowWarnings, frShowCollation, frShowCollationExtended, frShowCharset, frIntegerDisplayWidth, frShowFunctionStatus, frShowProcedureStatus, @@ -502,7 +468,7 @@ TDBConnection = class(TComponent) FQuoteChars: String; FDatatypes: TDBDataTypeArray; FThreadID: Int64; - FSQLSpecifities: Array[TSQLSpecifityId] of String; + FSqlProvider: TSqlProvider; FKeepAliveTimer: TTimer; FFavorites: TStringList; FPrefetchResults: TDBQueryList; @@ -579,8 +545,6 @@ TDBConnection = class(TComponent) function GetSessionVariables(Refresh: Boolean): TDBQuery; function GetSessionVariable(VarName: String; DefaultValue: String=''; Refresh: Boolean=False): String; function MaxAllowedPacket: Int64; virtual; - function GetSQLSpecifity(Specifity: TSQLSpecifityId): String; overload; - function GetSQLSpecifity(Specifity: TSQLSpecifityId; const Args: array of const): String; overload; function GetDateTimeValue(Input: String; Datatype: TDBDatatypeIndex): String; procedure ClearDbObjects(db: String); procedure ClearAllDbObjects; @@ -646,6 +610,7 @@ TDBConnection = class(TComponent) function IsNumeric(Text: String): Boolean; function IsHex(Text: String): Boolean; function Has(Item: TFeatureOrRequirement): Boolean; + property SqlProvider: TSqlProvider read FSqlProvider; published property Active: Boolean read FActive write SetActive default False; property Database: String read FDatabase write SetDatabase; @@ -2684,7 +2649,7 @@ procedure TMySQLConnection.SetActive( Value: Boolean ); Log(lcInfo, _('Characterset')+': '+CharacterSet); FConnectionStarted := GetTickCount div 1000; FServerUptime := -1; - Status := GetResults(GetSQLSpecifity(spGlobalStatus)); + Status := GetResults(FSqlProvider.GetSql(qGlobalStatus)); while not Status.Eof do begin StatusName := LowerCase(Status.Col(0)); if (StatusName = 'uptime') or (StatusName = 'proxysql_uptime') then @@ -2693,7 +2658,7 @@ procedure TMySQLConnection.SetActive( Value: Boolean ); FIsSSL := Status.Col(1) <> ''; Status.Next; end; - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); FServerOS := GetSessionVariable('version_compile_os'); FRealHostname := GetSessionVariable('hostname'); FCaseSensitivity := MakeInt(GetSessionVariable('lower_case_table_names', IntToStr(FCaseSensitivity))); @@ -2821,7 +2786,7 @@ procedure TAdoDBConnection.SetActive(Value: Boolean); except FServerUptime := -1; end; - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); // Microsoft SQL Server 2008 R2 (RTM) - 10.50.1600.1 (Intel X86) // Apr 2 2010 15:53:02 // Copyright (c) Microsoft Corporation @@ -2971,7 +2936,7 @@ procedure TPgConnection.SetActive(Value: Boolean); raise EDbError.Create(Error, LastErrorCode, ErrorHint); end; FActive := True; - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); FServerVersionUntouched := GetVar('SELECT VERSION()'); FConnectionStarted := GetTickCount div 1000; Query('SET statement_timeout TO '+IntToStr(Parameters.QueryTimeout*1000)); @@ -3098,7 +3063,7 @@ procedure TSQLiteConnection.SetActive(Value: Boolean); Log(lcError, 'Could not enable load_extension()'); end; - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); FServerVersionUntouched := GetVar('SELECT sqlite_version()'); FConnectionStarted := GetTickCount div 1000; FServerUptime := -1; @@ -3205,7 +3170,7 @@ procedure TInterbaseConnection.SetActive(Value: Boolean); FActive := True; //! Query('PRAGMA busy_timeout='+(Parameters.QueryTimeout*1000).ToString); - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); if Parameters.IsInterbase then FServerVersionUntouched := '' @@ -3300,160 +3265,20 @@ procedure TDBConnection.DoBeforeConnect; end; end; - FSQLSpecifities[spOrderAsc] := 'ASC'; - FSQLSpecifities[spOrderDesc] := 'DESC'; - FSQLSpecifities[spForeignKeyEventAction] := 'RESTRICT,CASCADE,SET NULL,NO ACTION'; - - case Parameters.NetTypeGroup of - ngMySQL: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP DATABASE %s'; - FSQLSpecifities[spEmptyTable] := 'TRUNCATE '; - FSQLSpecifities[spRenameTable] := 'RENAME TABLE %s TO %s'; - FSQLSpecifities[spRenameView] := FSQLSpecifities[spRenameTable]; - FSQLSpecifities[spCurrentUserHost] := 'SELECT CURRENT_USER()'; - FSQLSpecifities[spLikeCompare] := '%s LIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD COLUMN %s'; - FSQLSpecifities[spChangeColumn] := 'CHANGE COLUMN %s %s'; - FSQLSpecifities[spGlobalStatus] := IfThen( - Parameters.IsProxySQLAdmin, - 'SELECT * FROM stats_mysql_global', - 'SHOW /*!50002 GLOBAL */ STATUS' - ); - FSQLSpecifities[spCommandsCounters] := IfThen( - Parameters.IsProxySQLAdmin, - 'SELECT * FROM stats_mysql_commands_counters', - 'SHOW /*!50002 GLOBAL */ STATUS LIKE ''Com\_%''' - ); - FSQLSpecifities[spSessionVariables] := 'SHOW VARIABLES'; - FSQLSpecifities[spGlobalVariables] := 'SHOW GLOBAL VARIABLES'; - FSQLSpecifities[spISSchemaCol] := '%s_SCHEMA'; - FSQLSpecifities[spUSEQuery] := 'USE %s'; - if Parameters.NetType = ntMySQL_RDS then begin - FSQLSpecifities[spKillQuery] := 'CALL mysql.rds_kill_query(%d)'; - FSQLSpecifities[spKillProcess] := 'CALL mysql.rds_kill(%d)' - end - else begin - FSQLSpecifities[spKillQuery] := 'KILL %d'; // may be overwritten in DoAfterConnect - FSQLSpecifities[spKillProcess] := 'KILL %d'; - end; - FSQLSpecifities[spFuncLength] := 'LENGTH'; - FSQLSpecifities[spFuncCeil] := 'CEIL'; - FSQLSpecifities[spFuncLeft] := IfThen(Parameters.IsProxySQLAdmin, 'SUBSTR(%s, 1, %d)', 'LEFT(%s, %d)'); - FSQLSpecifities[spFuncNow] := IfThen(Parameters.IsProxySQLAdmin, 'CURRENT_TIMESTAMP', 'NOW()'); - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LAST_INSERT_ID()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := 'SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0'; - FSQLSpecifities[spEnableForeignKeyChecks] := 'SET FOREIGN_KEY_CHECKS=IFNULL(@OLD_FOREIGN_KEY_CHECKS, 1)'; - FSQLSpecifities[spForeignKeyDrop] := 'DROP FOREIGN KEY %s'; - end; - ngMSSQL: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP DATABASE %s'; - FSQLSpecifities[spEmptyTable] := 'DELETE FROM '; - FSQLSpecifities[spRenameTable] := 'EXEC sp_rename %s, %s'; - FSQLSpecifities[spRenameView] := FSQLSpecifities[spRenameTable]; - FSQLSpecifities[spCurrentUserHost] := 'SELECT SYSTEM_USER'; - FSQLSpecifities[spLikeCompare] := '%s LIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD %s'; - FSQLSpecifities[spChangeColumn] := 'ALTER COLUMN %s %s'; - FSQLSpecifities[spSessionVariables] := 'SELECT '+QuoteIdent('comment')+', '+QuoteIdent('value')+' FROM '+QuoteIdent('master')+'.'+QuoteIdent('dbo')+'.'+QuoteIdent('syscurconfigs')+' ORDER BY '+QuoteIdent('comment'); - FSQLSpecifities[spGlobalVariables] := FSQLSpecifities[spSessionVariables]; - FSQLSpecifities[spISSchemaCol] := '%s_CATALOG'; - FSQLSpecifities[spUSEQuery] := 'USE %s'; - FSQLSpecifities[spKillQuery] := 'KILL %d'; - FSQLSpecifities[spKillProcess] := 'KILL %d'; - FSQLSpecifities[spFuncLength] := 'LEN'; - FSQLSpecifities[spFuncCeil] := 'CEILING'; - FSQLSpecifities[spFuncLeft] := 'LEFT(%s, %d)'; - FSQLSpecifities[spFuncNow] := 'GETDATE()'; - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LAST_INSERT_ID()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := ''; - FSQLSpecifities[spEnableForeignKeyChecks] := ''; - FSQLSpecifities[spForeignKeyDrop] := 'DROP FOREIGN KEY %s'; - end; - ngPgSQL: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP SCHEMA %s'; - FSQLSpecifities[spEmptyTable] := 'DELETE FROM '; - FSQLSpecifities[spRenameTable] := 'ALTER TABLE %s RENAME TO %s'; - FSQLSpecifities[spRenameView] := 'ALTER VIEW %s RENAME TO %s'; - FSQLSpecifities[spCurrentUserHost] := 'SELECT CURRENT_USER'; - FSQLSpecifities[spLikeCompare] := '%s ILIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD %s'; - FSQLSpecifities[spChangeColumn] := 'ALTER COLUMN %s %s'; - FSQLSpecifities[spRenameColumn] := 'RENAME COLUMN %s TO %s'; - FSQLSpecifities[spForeignKeyEventAction] := 'RESTRICT,CASCADE,SET NULL,NO ACTION,SET DEFAULT'; - FSQLSpecifities[spSessionVariables] := 'SHOW ALL'; - FSQLSpecifities[spGlobalVariables] := FSQLSpecifities[spSessionVariables]; - FSQLSpecifities[spISSchemaCol] := '%s_schema'; - FSQLSpecifities[spUSEQuery] := 'SET search_path TO %s'; - FSQLSpecifities[spKillQuery] := 'SELECT pg_cancel_backend(%d)'; - FSQLSpecifities[spKillProcess] := 'SELECT pg_cancel_backend(%d)'; - FSQLSpecifities[spFuncLength] := 'LENGTH'; - FSQLSpecifities[spFuncCeil] := 'CEIL'; - FSQLSpecifities[spFuncLeft] := 'SUBSTRING(%s, 1, %d)'; - FSQLSpecifities[spFuncNow] := 'NOW()'; - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LASTVAL()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := ''; - FSQLSpecifities[spEnableForeignKeyChecks] := ''; - FSQLSpecifities[spForeignKeyDrop] := 'DROP CONSTRAINT %s'; - end; - ngSQLite: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP DATABASE %s'; - FSQLSpecifities[spEmptyTable] := 'DELETE FROM '; - FSQLSpecifities[spRenameTable] := 'ALTER TABLE %s RENAME TO %s'; - FSQLSpecifities[spRenameView] := FSQLSpecifities[spRenameTable]; - FSQLSpecifities[spCurrentUserHost] := ''; // unsupported - FSQLSpecifities[spLikeCompare] := '%s LIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD COLUMN %s'; - FSQLSpecifities[spChangeColumn] := ''; // SQLite only supports renaming - FSQLSpecifities[spRenameColumn] := 'RENAME COLUMN %s TO %s'; - FSQLSpecifities[spSessionVariables] := 'SELECT null, null'; // Todo: combine "PRAGMA pragma_list" + "PRAGMA a; PRAGMY b; ..."? - FSQLSpecifities[spGlobalVariables] := 'SHOW GLOBAL VARIABLES'; - FSQLSpecifities[spISSchemaCol] := '%s_SCHEMA'; - FSQLSpecifities[spUSEQuery] := ''; - FSQLSpecifities[spKillQuery] := 'KILL %d'; - FSQLSpecifities[spKillProcess] := 'KILL %d'; - FSQLSpecifities[spFuncLength] := 'LENGTH'; - FSQLSpecifities[spFuncCeil] := 'CEIL'; - FSQLSpecifities[spFuncLeft] := 'SUBSTR(%s, 1, %d)'; - FSQLSpecifities[spFuncNow] := 'DATETIME()'; - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LAST_INSERT_ID()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := ''; - FSQLSpecifities[spEnableForeignKeyChecks] := ''; - FSQLSpecifities[spForeignKeyDrop] := 'DROP FOREIGN KEY %s'; - end; - ngInterbase: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP DATABASE %s'; - FSQLSpecifities[spEmptyTable] := 'TRUNCATE '; - FSQLSpecifities[spRenameTable] := 'RENAME TABLE %s TO %s'; - FSQLSpecifities[spRenameView] := FSQLSpecifities[spRenameTable]; - if Self.Parameters.LibraryOrProvider = 'IB' then - FSQLSpecifities[spCurrentUserHost] := 'select user from rdb$database' - else - FSQLSpecifities[spCurrentUserHost] := 'select current_user || ''@'' || mon$attachments.mon$remote_host from mon$attachments where mon$attachments.mon$attachment_id = current_connection'; - FSQLSpecifities[spLikeCompare] := '%s LIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD COLUMN %s'; - FSQLSpecifities[spChangeColumn] := 'CHANGE COLUMN %s %s'; - FSQLSpecifities[spRenameColumn] := ''; - FSQLSpecifities[spSessionVariables] := 'SHOW VARIABLES'; - FSQLSpecifities[spGlobalVariables] := 'SHOW GLOBAL VARIABLES'; - FSQLSpecifities[spISSchemaCol] := '%s_SCHEMA'; - FSQLSpecifities[spUSEQuery] := ''; - FSQLSpecifities[spKillQuery] := 'KILL %d'; - FSQLSpecifities[spKillProcess] := 'KILL %d'; - FSQLSpecifities[spFuncLength] := 'LENGTH'; - FSQLSpecifities[spFuncCeil] := 'CEIL'; - FSQLSpecifities[spFuncLeft] := 'SUBSTR(%s, 1, %d)'; - FSQLSpecifities[spFuncNow] := ' cast(''now'' as timestamp) from rdb$database'; - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LAST_INSERT_ID()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := ''; - FSQLSpecifities[spEnableForeignKeyChecks] := ''; - FSQLSpecifities[spForeignKeyDrop] := 'DROP FOREIGN KEY %s'; - end; - + // Create SQL provider + case FParameters.NetTypeGroup of + ngMySQL: + FSqlProvider := TMySqlProvider.Create(FParameters.NetType); + ngMSSQL: + FSqlProvider := TMsSqlProvider.Create(FParameters.NetType); + ngPgSQL: + FSqlProvider := TPostgreSQLProvider.Create(FParameters.NetType); + ngSQLite: + FSqlProvider := TSQLiteProvider.Create(FParameters.NetType); + ngInterbase: + FSqlProvider := TInterbaseProvider.Create(FParameters.NetType); + else + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(FParameters.NetType)]); end; end; @@ -3555,6 +3380,7 @@ procedure TDBConnection.DoAfterConnect; SQLFunctionsFileOrder: String; MajorMinorVer, MajorVer: String; begin + FSqlProvider.ServerVersion := ServerVersionInt; AppSettings.SessionPath := FParameters.SessionPath; AppSettings.WriteString(asServerVersionFull, FServerVersionUntouched); FParameters.ServerVersion := FServerVersionUntouched; @@ -3625,10 +3451,6 @@ procedure TMySQLConnection.DoAfterConnect; end; end; - if Has(frKillQuery) then begin - FSQLSpecifities[spKillQuery] := 'KILL QUERY %d'; - end; - // List of IS tables try ObjNames := GetCol('SHOW TABLES FROM '+QuoteIdent(FInfSch)); @@ -3636,34 +3458,12 @@ procedure TMySQLConnection.DoAfterConnect; ObjNames.Free; except // silently fail if IS does not exist, on super old servers end; - - if Has(frLockedTables) then - FSQLSpecifities[spLockedTables] := 'SHOW OPEN TABLES FROM %s WHERE '+QuoteIdent('in_use')+'!=0'; end; procedure TAdoDBConnection.DoAfterConnect; begin inherited; - // See http://sqlserverbuilds.blogspot.de/ - case ServerVersionInt of - 0..899: begin - FSQLSpecifities[spDatabaseTable] := QuoteIdent('master')+'..'+QuoteIdent('sysdatabases'); - FSQLSpecifities[spDatabaseTableId] := QuoteIdent('dbid'); - FSQLSpecifities[spDbObjectsTable] := '..'+QuoteIdent('sysobjects'); - FSQLSpecifities[spDbObjectsCreateCol] := 'crdate'; - FSQLSpecifities[spDbObjectsUpdateCol] := ''; - FSQLSpecifities[spDbObjectsTypeCol] := 'xtype'; - end; - else begin - FSQLSpecifities[spDatabaseTable] := QuoteIdent('sys')+'.'+QuoteIdent('databases'); - FSQLSpecifities[spDatabaseTableId] := QuoteIdent('database_id'); - FSQLSpecifities[spDbObjectsTable] := '.'+QuoteIdent('sys')+'.'+QuoteIdent('objects'); - FSQLSpecifities[spDbObjectsCreateCol] := 'create_date'; - FSQLSpecifities[spDbObjectsUpdateCol] := 'modify_date'; - FSQLSpecifities[spDbObjectsTypeCol] := 'type'; - end; - end; // List of known IS tables FInformationSchemaObjects.CommaText := 'CHECK_CONSTRAINTS,'+ 'COLUMN_DOMAIN_USAGE,'+ @@ -4570,9 +4370,9 @@ procedure TDBConnection.SetDatabase(Value: String); s := s + ', ' + EscapeString('public'); end else s := QuoteIdent(Value); - UseQuery := GetSQLSpecifity(spUSEQuery); + UseQuery := FSqlProvider.GetSql(qUSEQuery); if not UseQuery.IsEmpty then begin - Query(GetSQLSpecifity(spUSEQuery, [s]), False); + Query(FSqlProvider.GetSql(qUSEQuery, [s]), False); end; FDatabase := DeQuoteIdent(Value); if Assigned(FOnDatabaseChanged) then @@ -4603,7 +4403,7 @@ procedure TDBConnection.DetectUSEQuery(SQL: String); // Detect query for switching current working database or schema rx := TRegExpr.Create; rx.ModifierI := True; - rx.Expression := '^'+GetSQLSpecifity(spUSEQuery); + rx.Expression := '^'+FSqlProvider.GetSql(qUSEQuery); Quotes := QuoteRegExprMetaChars(FQuoteChars+''';'); rx.Expression := StringReplace(rx.Expression, ' ', '\s+', [rfReplaceAll]); rx.Expression := StringReplace(rx.Expression, '%s', '['+Quotes+']?([^'+Quotes+']+)['+Quotes+']*', [rfReplaceAll]); @@ -5011,7 +4811,7 @@ function TAdoDBConnection.GetAllDatabases: TStringList; Result := inherited; if not Assigned(Result) then begin try - FAllDatabases := GetCol('SELECT '+QuoteIdent('name')+' FROM '+GetSQLSpecifity(spDatabaseTable)+' ORDER BY '+QuoteIdent('name')); + FAllDatabases := GetCol('SELECT '+QuoteIdent('name')+' FROM '+FSqlProvider.GetSql(qDatabaseTable)+' ORDER BY '+QuoteIdent('name')); except on E:EDbError do FAllDatabases := TStringList.Create; end; @@ -5879,7 +5679,7 @@ function TDBConnection.GetSessionVariables(Refresh: Boolean): TDBQuery; if (not Assigned(FSessionVariables)) or Refresh then begin if Assigned(FSessionVariables) then FreeAndNil(FSessionVariables); - FSessionVariables := GetResults(GetSQLSpecifity(spSessionVariables)); + FSessionVariables := GetResults(FSqlProvider.GetSql(qSessionVariables)); end; FSessionVariables.First; Result := FSessionVariables; @@ -5934,7 +5734,7 @@ function TDBConnection.GetLockedTableCount(db: String): Integer; begin // Find tables which are currently locked. // Used to prevent waiting time in GetDBObjects. - sql := GetSQLSpecifity(spLockedTables); + sql := FSqlProvider.GetSql(qLockedTables); Result := 0; if not sql.IsEmpty then try LockedTables := GetCol(Format(sql, [QuoteIdent(db,False)])); @@ -6011,96 +5811,96 @@ function TDBConnection.GetTableColumns(Table: TDBObject): TTableColumnList; // This uses pg_attribute.attgenerated, which only exists starting in PostgreSQL 12 // Todo: outsource such bigger SQL chunks into dbstructures units, together with the FSQLSpecifities array ColSQL := - 'SELECT ' + - ' n.nspname AS table_schema, ' + - ' c.relname AS table_name, ' + - ' a.attname AS column_name, ' + - ' a.attnum AS ordinal_position, ' + - ' pg_catalog.format_type(a.atttypid, a.atttypmod) AS data_type, ' + - // YES/NO like information_schema.is_nullable - ' CASE ' + - ' WHEN a.attnotnull THEN ''NO'' ' + - ' ELSE ''YES'' ' + - ' END AS is_nullable, ' + - // Character maximum length (in characters) - ' CASE ' + - ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + - ' AND a.atttypmod <> -1 ' + - ' THEN a.atttypmod - 4 ' + - ' ELSE NULL ' + - ' END AS character_maximum_length, ' + - // Numeric precision / scale (NULL for non-numeric) - ' CASE ' + - ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + - ' THEN ' + - ' CASE ' + - ' WHEN a.atttypmod = -1 THEN NULL ' + - ' ELSE ((a.atttypmod - 4) >> 16)::integer ' + - ' END ' + - ' END AS numeric_precision, ' + - ' CASE ' + - ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + - ' THEN ' + - ' CASE ' + - ' WHEN a.atttypmod = -1 THEN NULL ' + - ' ELSE ((a.atttypmod - 4) & 65535)::integer ' + - ' END ' + - ' END AS numeric_scale, ' + - // Datetime precision (for time/timestamp/interval) - ' CASE ' + - ' WHEN (bt.typcategory = ''D'' OR (bt.oid IS NULL AND t.typcategory = ''D'')) ' + - ' AND a.atttypmod <> -1 ' + - ' THEN a.atttypmod ' + - ' ELSE NULL ' + - ' END AS datetime_precision, ' + - // Character set name: PostgreSQL has one per DB; mimic information_schema - ' CASE ' + - ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + - ' THEN current_database() ' + - ' ELSE NULL ' + - ' END AS character_set_name, ' + - // Collation name for collatable columns - ' CASE ' + - ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + - ' THEN ' + - ' CASE ' + - ' WHEN a.attcollation <> t.typcollation ' + - ' THEN coll.collname ' + - ' ELSE NULL ' + - ' END ' + - ' ELSE NULL ' + - ' END AS collation_name, ' + - // Default expression for non-generated columns - ' CASE ' + - ' WHEN a.attgenerated = '''' AND a.atthasdef ' + - ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + - ' ELSE NULL ' + - ' END AS column_default, ' + - // Generation expression for generated columns - ' CASE ' + - ' WHEN a.attgenerated <> '''' AND a.atthasdef ' + - ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + - ' ELSE NULL ' + - ' END AS generation_expression, ' + - ' d.description AS column_comment ' + - 'FROM pg_catalog.pg_class AS c ' + - 'JOIN pg_catalog.pg_namespace AS n ON n.oid = c.relnamespace ' + - 'JOIN pg_catalog.pg_attribute AS a ON a.attrelid = c.oid ' + - 'JOIN pg_catalog.pg_type AS t ON t.oid = a.atttypid ' + - 'LEFT JOIN pg_catalog.pg_type AS bt ON bt.oid = t.typbasetype ' + - 'LEFT JOIN pg_catalog.pg_attrdef AS ad ' + - ' ON ad.adrelid = a.attrelid ' + - ' AND ad.adnum = a.attnum ' + - 'LEFT JOIN pg_catalog.pg_description AS d ' + - ' ON d.objoid = a.attrelid ' + - ' AND d.objsubid = a.attnum ' + - 'LEFT JOIN pg_catalog.pg_collation AS coll ' + - ' ON coll.oid = a.attcollation ' + - 'WHERE n.nspname = ' + EscapeString(Table.Schema) + ' ' + - ' AND a.attnum > 0 ' + - ' AND NOT a.attisdropped ' + - ' AND c.relname = ' + EscapeString(Table.Name) + ' ' + - 'ORDER BY ordinal_position'; + 'SELECT ' + + ' n.nspname AS table_schema, ' + + ' c.relname AS table_name, ' + + ' a.attname AS column_name, ' + + ' a.attnum AS ordinal_position, ' + + ' pg_catalog.format_type(a.atttypid, a.atttypmod) AS data_type, ' + + // YES/NO like information_schema.is_nullable + ' CASE ' + + ' WHEN a.attnotnull THEN ''NO'' ' + + ' ELSE ''YES'' ' + + ' END AS is_nullable, ' + + // Character maximum length (in characters) + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' AND a.atttypmod <> -1 ' + + ' THEN a.atttypmod - 4 ' + + ' ELSE NULL ' + + ' END AS character_maximum_length, ' + + // Numeric precision / scale (NULL for non-numeric) + ' CASE ' + + ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.atttypmod = -1 THEN NULL ' + + ' ELSE ((a.atttypmod - 4) >> 16)::integer ' + + ' END ' + + ' END AS numeric_precision, ' + + ' CASE ' + + ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.atttypmod = -1 THEN NULL ' + + ' ELSE ((a.atttypmod - 4) & 65535)::integer ' + + ' END ' + + ' END AS numeric_scale, ' + + // Datetime precision (for time/timestamp/interval) + ' CASE ' + + ' WHEN (bt.typcategory = ''D'' OR (bt.oid IS NULL AND t.typcategory = ''D'')) ' + + ' AND a.atttypmod <> -1 ' + + ' THEN a.atttypmod ' + + ' ELSE NULL ' + + ' END AS datetime_precision, ' + + // Character set name: PostgreSQL has one per DB; mimic information_schema + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' THEN current_database() ' + + ' ELSE NULL ' + + ' END AS character_set_name, ' + + // Collation name for collatable columns + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.attcollation <> t.typcollation ' + + ' THEN coll.collname ' + + ' ELSE NULL ' + + ' END ' + + ' ELSE NULL ' + + ' END AS collation_name, ' + + // Default expression for non-generated columns + ' CASE ' + + ' WHEN a.attgenerated = '''' AND a.atthasdef ' + + ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + + ' ELSE NULL ' + + ' END AS column_default, ' + + // Generation expression for generated columns + ' CASE ' + + ' WHEN a.attgenerated <> '''' AND a.atthasdef ' + + ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + + ' ELSE NULL ' + + ' END AS generation_expression, ' + + ' d.description AS column_comment ' + + 'FROM pg_catalog.pg_class AS c ' + + 'JOIN pg_catalog.pg_namespace AS n ON n.oid = c.relnamespace ' + + 'JOIN pg_catalog.pg_attribute AS a ON a.attrelid = c.oid ' + + 'JOIN pg_catalog.pg_type AS t ON t.oid = a.atttypid ' + + 'LEFT JOIN pg_catalog.pg_type AS bt ON bt.oid = t.typbasetype ' + + 'LEFT JOIN pg_catalog.pg_attrdef AS ad ' + + ' ON ad.adrelid = a.attrelid ' + + ' AND ad.adnum = a.attnum ' + + 'LEFT JOIN pg_catalog.pg_description AS d ' + + ' ON d.objoid = a.attrelid ' + + ' AND d.objsubid = a.attnum ' + + 'LEFT JOIN pg_catalog.pg_collation AS coll ' + + ' ON coll.oid = a.attcollation ' + + 'WHERE n.nspname = ' + EscapeString(Table.Schema) + ' ' + + ' AND a.attnum > 0 ' + + ' AND NOT a.attisdropped ' + + ' AND c.relname = ' + EscapeString(Table.Name) + ' ' + + 'ORDER BY ordinal_position'; end else begin @@ -7161,20 +6961,6 @@ procedure TPgConnection.Drop(Obj: TDBObject); end; -function TDBConnection.GetSQLSpecifity(Specifity: TSQLSpecifityId): String; -begin - // Return some version specific SQL clause or snippet - Result := FSQLSpecifities[Specifity]; -end; - - -function TDBConnection.GetSQLSpecifity(Specifity: TSQLSpecifityId; const Args: array of const): String; -begin - Result := GetSQLSpecifity(Specifity); - Result := Format(Result, Args); -end; - - function TDBConnection.ResultCount; begin case Parameters.NetTypeGroup of @@ -7232,8 +7018,8 @@ function TDBConnection.GetCurrentUserHostCombination: String; // Return current user@host combination, used by various object editors for DEFINER clauses Log(lcDebug, 'Fetching user@host ...'); Ping(True); - if FCurrentUserHostCombination.IsEmpty and (not GetSQLSpecifity(spCurrentUserHost).IsEmpty) then - FCurrentUserHostCombination := GetVar(GetSQLSpecifity(spCurrentUserHost)) + if FCurrentUserHostCombination.IsEmpty and (not FSqlProvider.GetSql(qCurrentUserHost).IsEmpty) then + FCurrentUserHostCombination := GetVar(FSqlProvider.GetSql(qCurrentUserHost)) else FCurrentUserHostCombination := ''; Result := FCurrentUserHostCombination; @@ -7681,7 +7467,7 @@ procedure TAdoDBConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); SchemaSelect := 'SCHEMA_NAME('+QuoteIdent('schema_id')+')'; try Results := GetResults('SELECT o.*, '+SchemaSelect+' AS '+EscapeString('schema')+', rc.RowsInTable'+ - ' FROM '+QuoteIdent(db)+GetSQLSpecifity(spDbObjectsTable)+ ' AS o'+ + ' FROM '+QuoteIdent(db)+FSqlProvider.GetSql(qDbObjectsTable)+ ' AS o'+ ' LEFT JOIN ('+ ' SELECT object_id, SUM(rows) AS RowsInTable FROM '+QuoteIdent(db)+'.sys.partitions'+ ' WHERE index_id IN (0,1)'+ // -- heap or clustered index @@ -7696,11 +7482,11 @@ procedure TAdoDBConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); obj := TDBObject.Create(Self); Cache.Add(obj); obj.Name := Results.Col('name'); - obj.Created := ParseDateTime(Results.Col(GetSQLSpecifity(spDbObjectsCreateCol), True)); - obj.Updated := ParseDateTime(Results.Col(GetSQLSpecifity(spDbObjectsUpdateCol), True)); + obj.Created := ParseDateTime(Results.Col(FSqlProvider.GetSql(qDbObjectsCreateCol), True)); + obj.Updated := ParseDateTime(Results.Col(FSqlProvider.GetSql(qDbObjectsUpdateCol), True)); obj.Schema := Results.Col('schema'); obj.Database := db; - tp := Trim(Results.Col(GetSQLSpecifity(spDbObjectsTypeCol), True)); + tp := Trim(Results.Col(FSqlProvider.GetSql(qDbObjectsTypeCol), True)); if tp = 'U' then obj.NodeType := lntTable else if tp = 'P' then @@ -10125,7 +9911,7 @@ function TDBQuery.SaveModifications: Boolean; if Assigned(ColAttr) and (ColAttr.DefaultType = cdtAutoInc) then begin Row[i].NewText := UnformatNumber(Row[i].NewText); if Row[i].NewText = '0' then - Row[i].NewText := Connection.GetVar('SELECT ' + Connection.GetSQLSpecifity(spFuncLastAutoIncNumber)); + Row[i].NewText := Connection.GetVar('SELECT ' + Connection.SqlProvider.GetSql(qFuncLastAutoIncNumber)); Row[i].NewIsNull := False; break; end; @@ -10896,7 +10682,7 @@ function TDBObject.SchemaClauseIS(Prefix: String): String; if Schema <> '' then Result := Prefix+'_SCHEMA' + '=' + Connection.EscapeString(Schema) else - Result := Connection.GetSQLSpecifity(spISSchemaCol, [Prefix]) + '=' + Connection.EscapeString(Database); + Result := Connection.SqlProvider.GetSql(qISSchemaCol, [Prefix]) + '=' + Connection.EscapeString(Database); end; function TDBObject.RowCount(Reload: Boolean; ForceExact: Boolean=False): Int64; diff --git a/source/dbstructures.interbase.pas b/source/dbstructures.interbase.pas index ad466f929..2a0b8e630 100644 --- a/source/dbstructures.interbase.pas +++ b/source/dbstructures.interbase.pas @@ -4,7 +4,13 @@ interface uses - dbstructures; + dbstructures, StrUtils; + +type + TInterbaseProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; var @@ -171,4 +177,42 @@ interface implementation + +{ TInterbaseProvider } + +function TInterbaseProvider.GetSql(AId: TQueryId): string; +begin + case AId of + qDatabaseDrop: Result := 'DROP DATABASE %s'; + qEmptyTable: Result := 'TRUNCATE '; + qRenameTable: Result := 'RENAME TABLE %s TO %s'; + qRenameView: Result := 'RENAME TABLE %s TO %s'; + qCurrentUserHost: Result := IfThen( + FNetType in [ntInterbase_TCPIP, ntInterbase_Local], + 'select user from rdb$database', + 'select current_user || ''@'' || mon$attachments.mon$remote_host from mon$attachments where mon$attachments.mon$attachment_id = current_connection' + ); + qLikeCompare: Result := '%s LIKE %s'; + qAddColumn: Result := 'ADD COLUMN %s'; + qChangeColumn: Result := 'CHANGE COLUMN %s %s'; + qRenameColumn: Result := ''; + qSessionVariables: Result := 'SHOW VARIABLES'; + qGlobalVariables: Result := 'SHOW GLOBAL VARIABLES'; + qISSchemaCol: Result := '%s_SCHEMA'; + qUSEQuery: Result := ''; + qKillQuery: Result := 'KILL %d'; + qKillProcess: Result := 'KILL %d'; + qFuncLength: Result := 'LENGTH'; + qFuncCeil: Result := 'CEIL'; + qFuncLeft: Result := 'SUBSTR(%s, 1, %d)'; + qFuncNow: Result := ' cast(''now'' as timestamp) from rdb$database'; + qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; + qLockedTables: Result := ''; + qDisableForeignKeyChecks: Result := ''; + qEnableForeignKeyChecks: Result := ''; + qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + end; +end; + + end. \ No newline at end of file diff --git a/source/dbstructures.mssql.pas b/source/dbstructures.mssql.pas index 2072334ba..1389995fa 100644 --- a/source/dbstructures.mssql.pas +++ b/source/dbstructures.mssql.pas @@ -3,7 +3,13 @@ interface uses - dbstructures; + dbstructures, StrUtils; + +type + TMsSqlProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; var @@ -407,4 +413,66 @@ interface implementation + +function TMsSqlProvider.GetSql(AId: TQueryId): string; +begin + case AId of + qDatabaseTable: Result := IfThen( + ServerVersion<=899, + 'master..sysdatabases', + 'sys.databases' + ); + qDatabaseTableId: Result := IfThen( + ServerVersion<=899, + 'dbid', + 'database_id' + ); + qDatabaseDrop: Result := 'DROP DATABASE %s'; + qDbObjectsTable: Result := IfThen( + ServerVersion<=899, + '..sysobjects', + '.sys.objects' + ); + qDbObjectsCreateCol: Result := IfThen( + ServerVersion<=899, + 'crdate', + 'create_date' + ); + qDbObjectsUpdateCol: Result := IfThen( + ServerVersion<=899, + '', + 'modify_date' + ); + qDbObjectsTypeCol: Result := IfThen( + ServerVersion<=899, + 'xtype', + 'type' + ); + qEmptyTable: Result := 'DELETE FROM '; + qRenameTable: Result := 'EXEC sp_rename %s, %s'; + qRenameView: Result := 'EXEC sp_rename %s, %s'; + qCurrentUserHost: Result := 'SELECT SYSTEM_USER'; + qLikeCompare: Result := '%s LIKE %s'; + qAddColumn: Result := 'ADD %s'; + qChangeColumn: Result := 'ALTER COLUMN %s %s'; + qSessionVariables: Result := 'SELECT comment, value FROM master.dbo.syscurconfigs ORDER BY comment'; + qGlobalVariables: Result := 'SELECT comment, value FROM master.dbo.syscurconfigs ORDER BY comment'; + qISSchemaCol: Result := '%s_CATALOG'; + qUSEQuery: Result := 'USE %s'; + qKillQuery: Result := 'KILL %d'; + qKillProcess: Result := 'KILL %d'; + qFuncLength: Result := 'LEN'; + qFuncCeil: Result := 'CEILING'; + qFuncLeft: Result := 'LEFT(%s, %d)'; + qFuncNow: Result := 'GETDATE()'; + qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; + qLockedTables: Result := ''; + qDisableForeignKeyChecks: Result := ''; + qEnableForeignKeyChecks: Result := ''; + qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + else Result := inherited; + end; +end; + + end. diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index 84cb90677..f8bc81783 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -4,7 +4,7 @@ interface uses - System.Classes, System.SysUtils, dbstructures; + System.Classes, System.SysUtils, dbstructures, StrUtils; const @@ -318,6 +318,13 @@ TMySQLLib = class(TDbLib) constructor Create(DllFile, DefaultDll: String); override; function IsLibMariadb: Boolean; end; + + TMySqlProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; + + var MySQLKeywords: TStringList; MySQLErrorCodes: TStringList; @@ -3215,6 +3222,21 @@ procedure TMySQLLib.AssignProcedures; end; +{ TMySqlProvider } + +function TMySqlProvider.GetSql(AId: TQueryId): string; +begin + case AId of + qKillQuery: Result := IfThen( + (FNetType <> ntMySQL_RDS) and (FServerVersion >= 50000), + 'KILL QUERY %d', + inherited + ); + else Result := inherited; + end; +end; + + initialization // Keywords copied from SynHighligherSQL diff --git a/source/dbstructures.pas b/source/dbstructures.pas index b11070abb..c24778af5 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -6,11 +6,58 @@ interface uses - gnugettext, Vcl.Graphics, Winapi.Windows, System.SysUtils, System.Classes, System.IOUtils; + gnugettext, Vcl.Graphics, Winapi.Windows, System.SysUtils, System.Classes, System.IOUtils, + System.Generics.Collections, StrUtils; type + TNetType = ( + ntMySQL_TCPIP, + ntMySQL_NamedPipe, + ntMySQL_SSHtunnel, + ntMSSQL_NamedPipe, + ntMSSQL_TCPIP, + ntMSSQL_SPX, + ntMSSQL_VINES, + ntMSSQL_RPC, + ntPgSQL_TCPIP, + ntPgSQL_SSHtunnel, + ntSQLite, + ntMySQL_ProxySQLAdmin, + ntInterbase_TCPIP, + ntInterbase_Local, + ntFirebird_TCPIP, + ntFirebird_Local, + ntMySQL_RDS, + ntSQLiteEncrypted + ); + TNetTypeGroup = (ngMySQL, ngMSSQL, ngPgSQL, ngSQLite, ngInterbase); + TNetTypeLibs = TDictionary; + + // SQL query ids and provider + TQueryId = (qDatabaseTable, qDatabaseTableId, qDatabaseDrop, + qDbObjectsTable, qDbObjectsCreateCol, qDbObjectsUpdateCol, qDbObjectsTypeCol, + qEmptyTable, qRenameTable, qRenameView, qCurrentUserHost, qLikeCompare, + qAddColumn, qChangeColumn, qRenameColumn, qForeignKeyEventAction, + qGlobalStatus, qCommandsCounters, qSessionVariables, qGlobalVariables, + qISSchemaCol, + qUSEQuery, qKillQuery, qKillProcess, + qFuncLength, qFuncCeil, qFuncLeft, qFuncNow, qFuncLastAutoIncNumber, + qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks, + qOrderAsc, qOrderDesc, + qForeignKeyDrop); + TSqlProvider = class + strict protected + FNetType: TNetType; + FServerVersion: Integer; + public + constructor Create(ANetType: TNetType); + function GetSql(AId: TQueryId): string; overload; virtual; + function GetSql(AId: TQueryId; const Args: array of const): string; overload; + property ServerVersion: Integer read FServerVersion write FServerVersion; + end; + // Column types TDBDatatypeIndex = (dbdtTinyint, dbdtSmallint, dbdtMediumint, dbdtInt, dbdtUint, dbdtBigint, dbdtSerial, dbdtBigSerial, dbdtFloat, dbdtDouble, dbdtDecimal, dbdtNumeric, dbdtReal, dbdtDoublePrecision, dbdtMoney, dbdtSmallmoney, @@ -135,6 +182,94 @@ implementation uses apphelpers; +{ TSqlProvider } + +constructor TSqlProvider.Create(ANetType: TNetType); +begin + FNetType := ANetType; + FServerVersion := 0; +end; + +function TSqlProvider.GetSql(AId: TQueryId): string; +begin + // This provides default values for queries, basically MySQL syntax + case AId of + // qDatabaseTable: MSSQL only + // qDatabaseTableId: MSSQL only + qDatabaseDrop: Result := 'DROP DATABASE %s'; + // qDbObjectsTable: MSSQL only + // qDbObjectsCreateCol: MSSQL only + // qDbObjectsUpdateCol: MSSQL only + // qDbObjectsTypeCol: MSSQL only + qEmptyTable: Result := 'TRUNCATE '; + qRenameTable: Result := 'RENAME TABLE %s TO %s'; + qRenameView: Result := 'RENAME TABLE %s TO %s'; + qCurrentUserHost: Result := 'SELECT CURRENT_USER()'; + qLikeCompare: Result := '%s LIKE %s'; + qAddColumn: Result := 'ADD COLUMN %s'; + qChangeColumn: Result := 'CHANGE COLUMN %s %s'; + // qRenameColumn: PostgreSQL only + qForeignKeyEventAction: Result := 'RESTRICT,CASCADE,SET NULL,NO ACTION'; + qGlobalStatus: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'SELECT * FROM stats_mysql_global', + 'SHOW /*!50002 GLOBAL */ STATUS' + ); + qCommandsCounters: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'SELECT * FROM stats_mysql_commands_counters', + 'SHOW /*!50002 GLOBAL */ STATUS LIKE ''Com\_%''' + ); + qSessionVariables: Result := 'SHOW VARIABLES'; + qGlobalVariables: Result := 'SHOW GLOBAL VARIABLES'; + qISSchemaCol: Result := '%s_SCHEMA'; + qUSEQuery: Result := 'USE %s'; + qKillQuery: Result := IfThen( + FNetType = ntMySQL_RDS, + 'CALL mysql.rds_kill_query(%d)', + 'KILL %d' + ); + qKillProcess: Result := IfThen( + FNetType = ntMySQL_RDS, + 'CALL mysql.rds_kill(%d)', + 'KILL %d' + ); + qFuncLength: Result := 'LENGTH'; + qFuncCeil: Result := 'CEIL'; + qFuncLeft: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'SUBSTR(%s, 1, %d)', + 'LEFT(%s, %d)' + ); + qFuncNow: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'CURRENT_TIMESTAMP', + 'NOW()' + ); + qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; + qLockedTables: Result := IfThen( + (FNetType <> ntMySQL_ProxySQLAdmin) and (FServerVersion >= 50124), + 'SHOW OPEN TABLES FROM %s WHERE in_use!=0', + '' + ); + qDisableForeignKeyChecks: Result := 'SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0'; + qEnableForeignKeyChecks: Result := 'SET FOREIGN_KEY_CHECKS=IFNULL(@OLD_FOREIGN_KEY_CHECKS, 1)'; + qOrderAsc: Result := 'ASC'; + qOrderDesc: Result := 'DESC'; + qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + else Result := ''; + end; +end; + +function TSqlProvider.GetSql(AId: TQueryId; const Args: array of const): string; +begin + Result := GetSql(AId); + if not Result.IsEmpty then + Result := Format(Result, Args); +end; + + + { EDbError } diff --git a/source/dbstructures.postgresql.pas b/source/dbstructures.postgresql.pas index 251c1a578..9afe0ee94 100644 --- a/source/dbstructures.postgresql.pas +++ b/source/dbstructures.postgresql.pas @@ -36,6 +36,11 @@ TPostgreSQLLib = class(TDbLib) procedure AssignProcedures; override; end; + TPostgreSQLProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; + const InvalidOid: POid = 0; var @@ -573,4 +578,39 @@ procedure TPostgreSQLLib.AssignProcedures; end; +{ TPostgreSQLProvider } + +function TPostgreSQLProvider.GetSql(AId: TQueryId): string; +begin + case AId of + qDatabaseDrop: Result := 'DROP SCHEMA %s'; + qEmptyTable: Result := 'DELETE FROM '; + qRenameTable: Result := 'ALTER TABLE %s RENAME TO %s'; + qRenameView: Result := 'ALTER VIEW %s RENAME TO %s'; + qCurrentUserHost: Result := 'SELECT CURRENT_USER'; + qLikeCompare: Result := '%s ILIKE %s'; + qAddColumn: Result := 'ADD %s'; + qChangeColumn: Result := 'ALTER COLUMN %s %s'; + qRenameColumn: Result := 'RENAME COLUMN %s TO %s'; + qForeignKeyEventAction: Result := 'RESTRICT,CASCADE,SET NULL,NO ACTION,SET DEFAULT'; + qSessionVariables: Result := 'SHOW ALL'; + qGlobalVariables: Result := 'SHOW ALL'; + qISSchemaCol: Result := '%s_schema'; + qUSEQuery: Result := 'SET search_path TO %s'; + qKillQuery: Result := 'SELECT pg_cancel_backend(%d)'; + qKillProcess: Result := 'SELECT pg_cancel_backend(%d)'; + qFuncLength: Result := 'LENGTH'; + qFuncCeil: Result := 'CEIL'; + qFuncLeft: Result := 'SUBSTRING(%s, 1, %d)'; + qFuncNow: Result := 'NOW()'; + qFuncLastAutoIncNumber: Result := 'LASTVAL()'; + qLockedTables: Result := ''; + qDisableForeignKeyChecks: Result := ''; + qEnableForeignKeyChecks: Result := ''; + qForeignKeyDrop: Result := 'DROP CONSTRAINT %s'; + else Result := inherited; + end; +end; + + end. diff --git a/source/dbstructures.sqlite.pas b/source/dbstructures.sqlite.pas index f9d2be952..787525ca5 100644 --- a/source/dbstructures.sqlite.pas +++ b/source/dbstructures.sqlite.pas @@ -152,6 +152,11 @@ TSQLiteLib = class(TDbLib) constructor CreateWithMultipleCipherFunctions(DllFile, DefaultDll: String); end; + TSQLiteProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; + var SQLiteDatatypes: Array[0..15] of TDBDatatype = @@ -387,4 +392,39 @@ procedure TSQLiteLib.AssignProcedures; end; end; + +{ TSQLiteProvider } + +function TSQLiteProvider.GetSql(AId: TQueryId): string; +begin + case AId of + qDatabaseDrop: Result := 'DROP DATABASE %s'; + qEmptyTable: Result := 'DELETE FROM '; + qRenameTable: Result := 'ALTER TABLE %s RENAME TO %s'; + qRenameView: Result := 'ALTER TABLE %s RENAME TO %s'; + qCurrentUserHost: Result := ''; // unsupported + qLikeCompare: Result := '%s LIKE %s'; + qAddColumn: Result := 'ADD COLUMN %s'; + qChangeColumn: Result := ''; // SQLite only supports renaming + qRenameColumn: Result := 'RENAME COLUMN %s TO %s'; + qSessionVariables: Result := 'SELECT null, null'; // Todo: combine "PRAGMA pragma_list" + "PRAGMA a; PRAGMY b; ..."? + qGlobalVariables: Result := 'SHOW GLOBAL VARIABLES'; + qISSchemaCol: Result := '%s_SCHEMA'; + qUSEQuery: Result := ''; + qKillQuery: Result := 'KILL %d'; + qKillProcess: Result := 'KILL %d'; + qFuncLength: Result := 'LENGTH'; + qFuncCeil: Result := 'CEIL'; + qFuncLeft: Result := 'SUBSTR(%s, 1, %d)'; + qFuncNow: Result := 'DATETIME()'; + qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; + qLockedTables: Result := ''; + qDisableForeignKeyChecks: Result := ''; + qEnableForeignKeyChecks: Result := ''; + qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + else Result := inherited; + end; +end; + + end. \ No newline at end of file diff --git a/source/main.pas b/source/main.pas index 89737d9c7..5f2eebbde 100644 --- a/source/main.pas +++ b/source/main.pas @@ -3857,7 +3857,7 @@ procedure TMainForm.actDropObjectsExecute(Sender: TObject); db := DBObject.Database; Node := FindDBNode(DBtree, Conn, db); SetActiveDatabase('', Conn); - Conn.Query(Conn.GetSQLSpecifity(spDatabaseDrop, [Conn.QuoteIdent(db)])); + Conn.Query(Conn.SqlProvider.GetSql(qDatabaseDrop, [Conn.QuoteIdent(db)])); DBtree.DeleteNode(Node); Conn.ClearDbObjects(db); Conn.RefreshAllDatabases; @@ -4537,8 +4537,8 @@ procedure TMainForm.actEmptyTablesExecute(Sender: TObject); ErrorDialog(_('No table(s) selected.')) else begin Conn := ActiveConnection; - QueryDisableChecks := Conn.GetSQLSpecifity(spDisableForeignKeyChecks); - QueryEnableChecks := Conn.GetSQLSpecifity(spEnableForeignKeyChecks); + QueryDisableChecks := Conn.SqlProvider.GetSql(qDisableForeignKeyChecks); + QueryEnableChecks := Conn.SqlProvider.GetSql(qEnableForeignKeyChecks); if (Win32MajorVersion >= 6) and StyleServices.Enabled then begin Dialog := TTaskDialog.Create(Self); Dialog.Text := f_('Empty %d table(s) and/or view(s)?', [Objects.count]); @@ -4563,7 +4563,7 @@ procedure TMainForm.actEmptyTablesExecute(Sender: TObject); Conn.Query(QueryDisableChecks); try for TableOrView in Objects do begin - Conn.Query(Conn.GetSQLSpecifity(spEmptyTable) + TableOrView.QuotedName); + Conn.Query(Conn.SqlProvider.GetSql(qEmptyTable) + TableOrView.QuotedName); ProgressStep; end; actRefresh.Execute; @@ -6022,7 +6022,7 @@ procedure TMainForm.DataGridBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: and (not IsKeyColumn) // We need full length of any key column, so DataGridLoadFullRow() has the chance to fetch the right row and ((ColMaxLen > GRIDMAXDATA) or (ColMaxLen = 0)) // No need to blow SQL with LEFT() if column is shorter anyway then begin - Select := Select + DBObj.Connection.GetSQLSpecifity(spFuncLeft, [c.CastAsText, GRIDMAXDATA]) + ', '; + Select := Select + DBObj.Connection.SqlProvider.GetSql(qFuncLeft, [c.CastAsText, GRIDMAXDATA]) + ', '; end else if DBObj.Connection.Parameters.IsAnyMSSQL and (c.DataType.Index=dbdtTimestamp) then begin Select := Select + ' CAST(' + DBObj.Connection.QuoteIdent(c.Name) + ' AS INT), '; end else if DBObj.Connection.Parameters.IsAnyMSSQL and (c.DataType.Index=dbdtHierarchyid) then begin @@ -6735,7 +6735,7 @@ procedure TMainForm.KillProcess(Sender: TObject); if pid = Conn.ThreadId then LogSQL(f_('Ignoring own process id #%d when trying to kill it.', [pid])) else try - Conn.Query(Conn.GetSQLSpecifity(spKillQuery, [pid])); + Conn.Query(Conn.SqlProvider.GetSql(qKillQuery, [pid])); except on E:EDbError do begin if Conn.LastErrorCode <> ER_NO_SUCH_THREAD then @@ -7401,9 +7401,9 @@ procedure TMainForm.ListTablesNewText(Sender: TBaseVirtualTree; Node: // rename table case Obj.NodeType of lntTable: - sql := Obj.Connection.GetSQLSpecifity(spRenameTable); + sql := Obj.Connection.SqlProvider.GetSql(qRenameTable); lntView: - sql := Obj.Connection.GetSQLSpecifity(spRenameView); + sql := Obj.Connection.SqlProvider.GetSql(qRenameView); else raise EDbError.Create('Cannot rename '+Obj.ObjType); end; @@ -7499,7 +7499,7 @@ procedure TMainForm.QuickFilterClick(Sender: TObject); else if Act = actQuickFilterPrompt4 then Filter := Col + ' < ' + Conn.EscapeString(Val, TableCol.DataType) else if Act = actQuickFilterPrompt5 then - Filter := Conn.GetSQLSpecifity(spLikeCompare, [Col, Conn.EscapeString('%'+Val+'%', TableCol.DataType)]); + Filter := Conn.SqlProvider.GetSql(qLikeCompare, [Col, Conn.EscapeString('%'+Val+'%', TableCol.DataType)]); end; end else begin @@ -8189,13 +8189,13 @@ procedure TMainForm.popupDataGridPopup(Sender: TObject); actQuickFilterFocused1.Hint := actQuickFilterFocused1.Hint + Results.Connection.EscapeString(Value, Datatype) + ', '; actQuickFilterFocused2.Hint := actQuickFilterFocused2.Hint + Results.Connection.EscapeString(Value, Datatype) + ', '; actQuickFilterFocused3.Hint := actQuickFilterFocused3.Hint + - Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''' + Results.Connection.EscapeString(Value, True, False) + '%''']) + + Results.Connection.SqlProvider.GetSql(qLikeCompare, [Col, '''' + Results.Connection.EscapeString(Value, True, False) + '%''']) + ' OR '; actQuickFilterFocused4.Hint := actQuickFilterFocused4.Hint + - Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '''']) + + Results.Connection.SqlProvider.GetSql(qLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '''']) + ' OR '; actQuickFilterFocused5.Hint := actQuickFilterFocused5.Hint + - Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '%''']) + + Results.Connection.SqlProvider.GetSql(qLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '%''']) + ' OR '; actQuickFilterFocused6.Hint := actQuickFilterFocused6.Hint + Col + ' > ' + Results.Connection.EscapeString(Value, Datatype) + ' OR '; actQuickFilterFocused7.Hint := actQuickFilterFocused7.Hint + Col + ' < ' + Results.Connection.EscapeString(Value, Datatype) + ' OR '; @@ -8248,7 +8248,7 @@ procedure TMainForm.popupDataGridPopup(Sender: TObject); actQuickFilterPrompt2.Hint := Col + ' != "..."'; actQuickFilterPrompt3.Hint := Col + ' > "..."'; actQuickFilterPrompt4.Hint := Col + ' < "..."'; - actQuickFilterPrompt5.Hint := Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '"%...%"']); + actQuickFilterPrompt5.Hint := Results.Connection.SqlProvider.GetSql(qLikeCompare, [Col, '"%...%"']); actQuickFilterNull.Hint := Col + ' IS NULL'; actQuickFilterNotNull.Hint := Col + ' IS NOT NULL'; @@ -8264,7 +8264,7 @@ procedure TMainForm.popupDataGridPopup(Sender: TObject); actQuickFilterClipboard4.Enabled := true; actQuickFilterClipboard4.Hint := Col + ' < ' + Results.Connection.EscapeString(Value, Datatype); actQuickFilterClipboard5.Enabled := true; - actQuickFilterClipboard5.Hint := Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '%''']); + actQuickFilterClipboard5.Hint := Results.Connection.SqlProvider.GetSql(qLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '%''']); actQuickFilterClipboard6.Enabled := true; actQuickFilterClipboard6.Hint := Col + ' IN (' + Value + ')'; end else begin @@ -8277,7 +8277,7 @@ procedure TMainForm.popupDataGridPopup(Sender: TObject); actQuickFilterClipboard4.Enabled := false; actQuickFilterClipboard4.Hint := Col + ' < ' + CLPBRD; actQuickFilterClipboard5.Enabled := false; - actQuickFilterClipboard5.Hint := Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '%' + CLPBRD + '%']); + actQuickFilterClipboard5.Hint := Results.Connection.SqlProvider.GetSql(qLikeCompare, [Col, '%' + CLPBRD + '%']); actQuickFilterClipboard6.Enabled := false; actQuickFilterClipboard6.Hint := Col + ' IN (' + CLPBRD + ')'; end; @@ -8426,7 +8426,7 @@ procedure TMainForm.DataInsertValueClick(Sender: TObject); begin // Local and UTC date/time menu items Conn := ActiveConnection; - DateTimeSQL := 'SELECT ' + Conn.GetSQLSpecifity(spFuncNow); + DateTimeSQL := 'SELECT ' + Conn.SqlProvider.GetSql(qFuncNow); LocalTime := Conn.ParseDateTime(Conn.GetVar(DateTimeSQL)); DecodeDateTime(LocalTime, y, m, d, h, i, s, ms); DataDateTime.Caption := Format(FrmDateTime, [_('Date and time'), y,m,d,h,i,s]); @@ -10379,7 +10379,7 @@ procedure TMainForm.editFilterSearchChange(Sender: TObject); for i:=0 to SelectedTableColumns.Count-1 do begin // The normal case: do a LIKE comparison Condition := '''%' + Conn.EscapeString(ed.Text, True, False)+'%'''; - Condition := Conn.GetSQLSpecifity(spLikeCompare, [SelectedTableColumns[i].CastAsText, Condition]); + Condition := Conn.SqlProvider.GetSql(qLikeCompare, [SelectedTableColumns[i].CastAsText, Condition]); if not SelectedTableColumns[i].DataType.ValueMustMatch.IsEmpty then begin // Use an exact comparison for some PostgreSQL data types to overcome SQL errors, e.g. UUID, INT etc. // Also, prevent other errors by matching the value against a certain regular expression. @@ -11002,7 +11002,7 @@ procedure TMainForm.AnyGridCreateEditor(Sender: TBaseVirtualTree; Node: KeyCol := Conn.QuoteIdent(ForeignKey.ForeignColumns[idx]); if TextCol <> '' then begin - SQL := KeyCol+', ' + Conn.GetSQLSpecifity(spFuncLeft, [Conn.QuoteIdent(TextCol), 256])+ + SQL := KeyCol+', ' + Conn.SqlProvider.GetSql(qFuncLeft, [Conn.QuoteIdent(TextCol), 256])+ ' FROM ' + RefObj.QuotedDbAndTableName + ' GROUP BY '+KeyCol+', '+Conn.QuoteIdent(TextCol)+ // MSSQL complains if the text columns is not grouped ' ORDER BY '+Conn.QuoteIdent(TextCol); @@ -11666,14 +11666,14 @@ procedure TMainForm.HostListBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: FVariableNames.Sorted := True; FSessionVars := TStringList.Create; FGlobalVars := TStringList.Create; - Variables := Conn.GetResults(Conn.GetSQLSpecifity(spSessionVariables)); + Variables := Conn.GetResults(Conn.SqlProvider.GetSql(qSessionVariables)); while not Variables.Eof do begin FVariableNames.Add(Variables.Col(0)); FSessionVars.Values[Variables.Col(0)] := IfThen(Variables.IsNull(1), TEXT_NULL, Variables.Col(1)); Variables.Next; end; Variables.Free; - Variables := Conn.GetResults(Conn.GetSQLSpecifity(spGlobalVariables)); + Variables := Conn.GetResults(Conn.SqlProvider.GetSql(qGlobalVariables)); while not Variables.Eof do begin FVariableNames.Add(Variables.Col(0)); FGlobalVars.Values[Variables.Col(0)] := Variables.Col(1); @@ -11683,7 +11683,7 @@ procedure TMainForm.HostListBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: Variables.Free; vt.RootNodeCount := FVariableNames.Count; end else if vt = ListStatus then begin - Results := Conn.GetResults(Conn.GetSQLSpecifity(spGlobalStatus)); + Results := Conn.GetResults(Conn.SqlProvider.GetSql(qGlobalStatus)); FStatusServerUptime := Conn.ServerUptime; end else if vt = ListProcesses then begin case Conn.Parameters.NetTypeGroup of @@ -11737,8 +11737,8 @@ procedure TMainForm.HostListBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: ', RTRIM('+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('status')+'), '+ 'NULL AS '+Conn.QuoteIdent('Info')+' '+ 'FROM '+Conn.QuoteIdent('sys')+'.'+Conn.QuoteIdent('sysprocesses')+' AS '+Conn.QuoteIdent('p')+ - ', '+Conn.GetSQLSpecifity(spDatabaseTable)+' AS '+Conn.QuoteIdent('d')+ - ' WHERE '+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('dbid')+'='+Conn.QuoteIdent('d')+'.'+Conn.GetSQLSpecifity(spDatabaseTableId) + ', '+Conn.SqlProvider.GetSql(qDatabaseTable)+' AS '+Conn.QuoteIdent('d')+ + ' WHERE '+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('dbid')+'='+Conn.QuoteIdent('d')+'.'+Conn.SqlProvider.GetSql(qDatabaseTableId) ); end; ngPgSQL: begin @@ -11764,7 +11764,7 @@ procedure TMainForm.HostListBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: Results.Next; end; end else if vt = ListCommandStats then begin - Results := Conn.GetResults(Conn.GetSQLSpecifity(spCommandsCounters)); + Results := Conn.GetResults(Conn.SqlProvider.GetSql(qCommandsCounters)); FCommandStatsServerUptime := Conn.ServerUptime; FCommandStatsQueryCount := 0; while not Results.Eof do begin @@ -13955,7 +13955,7 @@ procedure TMainForm.actCancelOperationExecute(Sender: TObject); Killer.OnLog := LogSQL; try Killer.Active := True; - KillCommand := Killer.GetSQLSpecifity(spKillQuery, [ActiveConnection.ThreadId]); + KillCommand := Killer.SqlProvider.GetSql(qKillQuery, [ActiveConnection.ThreadId]); Killer.Query(KillCommand); except on E:EDbError do begin diff --git a/source/table_editor.pas b/source/table_editor.pas index cc5f71ede..a11e09242 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -523,7 +523,7 @@ function TfrmTableEditor.ApplyModifications: TModalResult; end; // Rename table if ObjectExists and (editName.Text <> DBObject.Name) then begin - Rename := DBObject.Connection.GetSQLSpecifity(spRenameTable, [DBObject.QuotedName, DBObject.Connection.QuoteIdent(editName.Text)]); + Rename := DBObject.Connection.SqlProvider.GetSql(qRenameTable, [DBObject.QuotedName, DBObject.Connection.QuoteIdent(editName.Text)]); DBObject.Connection.Query(Rename); DBObject.Connection.ShowWarnings; end; @@ -653,7 +653,7 @@ function TfrmTableEditor.ComposeAlterStatement: TSQLBatch; // ALTER TABLE statement. Separate statements are required." for i:=0 to FForeignKeys.Count-1 do begin if FForeignKeys[i].Modified and (not FForeignKeys[i].Added) then - Specs.Add(Conn.GetSQLSpecifity(spForeignKeyDrop, [Conn.QuoteIdent(FForeignKeys[i].OldKeyName)])); + Specs.Add(Conn.SqlProvider.GetSql(qForeignKeyDrop, [Conn.QuoteIdent(FForeignKeys[i].OldKeyName)])); end; FinishSpecs; @@ -720,8 +720,8 @@ function TfrmTableEditor.ComposeAlterStatement: TSQLBatch; for Col in FColumns do begin if Col.Status <> esUntouched then begin OverrideCollation := IfThen(chkCharsetConvert.Checked, comboCollation.Text); - AlterColBase := Conn.GetSQLSpecifity(spChangeColumn); - AddColBase := Conn.GetSQLSpecifity(spAddColumn); + AlterColBase := Conn.SqlProvider.GetSql(qChangeColumn); + AddColBase := Conn.SqlProvider.GetSql(qAddColumn); case Conn.Parameters.NetTypeGroup of @@ -772,7 +772,7 @@ function TfrmTableEditor.ComposeAlterStatement: TSQLBatch; if Col.Name <> Col.OldName then begin FinishSpecs; Specs.Add( - Conn.GetSQLSpecifity(spRenameColumn, [Conn.QuoteIdent(Col.OldName), Conn.QuoteIdent(Col.Name)]) + Conn.SqlProvider.GetSql(qRenameColumn, [Conn.QuoteIdent(Col.OldName), Conn.QuoteIdent(Col.Name)]) ); FinishSpecs; end; @@ -808,7 +808,7 @@ function TfrmTableEditor.ComposeAlterStatement: TSQLBatch; // Rename if Col.Name <> Col.OldName then begin Specs.Add( - Conn.GetSQLSpecifity(spRenameColumn, [Conn.QuoteIdent(Col.OldName), Conn.QuoteIdent(Col.Name)]) + Conn.SqlProvider.GetSql(qRenameColumn, [Conn.QuoteIdent(Col.OldName), Conn.QuoteIdent(Col.Name)]) ); end; end; @@ -878,7 +878,7 @@ function TfrmTableEditor.ComposeAlterStatement: TSQLBatch; end; for i:=0 to FDeletedForeignKeys.Count-1 do begin - Specs.Add(Conn.GetSQLSpecifity(spForeignKeyDrop, [Conn.QuoteIdent(FDeletedForeignKeys[i])])); + Specs.Add(Conn.SqlProvider.GetSql(qForeignKeyDrop, [Conn.QuoteIdent(FDeletedForeignKeys[i])])); end; for i:=0 to FForeignKeys.Count-1 do begin if FForeignKeys[i].Added or FForeignKeys[i].Modified then @@ -2919,7 +2919,7 @@ procedure TfrmTableEditor.listForeignKeysCreateEditor( end; 4, 5: begin EnumEditor := TEnumEditorLink.Create(VT, True, nil); - EnumEditor.ValueList := Explode(',', DBObject.Connection.GetSQLSpecifity(spForeignKeyEventAction)); + EnumEditor.ValueList := Explode(',', DBObject.Connection.SqlProvider.GetSql(qForeignKeyEventAction)); EditLink := EnumEditor; end; end; diff --git a/source/tabletools.pas b/source/tabletools.pas index 2a841a4c9..8ddd58b50 100644 --- a/source/tabletools.pas +++ b/source/tabletools.pas @@ -1296,7 +1296,7 @@ procedure TfrmTableTools.DoFind(DBObj: TDBObject); SQL := 'SELECT '+ esc(DBObj.Database)+' AS '+DBObj.Connection.QuoteIdent('Database')+', '+ esc(DBObj.Name)+' AS '+DBObj.Connection.QuoteIdent('Table')+', '+ - DBObj.Connection.GetSQLSpecifity(spFuncCeil)+'(('+DBObj.Connection.GetSQLSpecifity(spFuncLength)+'('+RoutineDefinitionColumn+') - '+DBObj.Connection.GetSQLSpecifity(spFuncLength)+'(REPLACE('+RoutineDefinitionColumn+', '+esc(FindText)+', '+esc('')+'))) / '+DBObj.Connection.GetSQLSpecifity(spFuncLength)+'('+esc(FindText)+')) AS '+DBObj.Connection.QuoteIdent('Found rows')+', '+ + DBObj.Connection.SqlProvider.GetSql(qFuncCeil)+'(('+DBObj.Connection.SqlProvider.GetSql(qFuncLength)+'('+RoutineDefinitionColumn+') - '+DBObj.Connection.SqlProvider.GetSql(qFuncLength)+'(REPLACE('+RoutineDefinitionColumn+', '+esc(FindText)+', '+esc('')+'))) / '+DBObj.Connection.SqlProvider.GetSql(qFuncLength)+'('+esc(FindText)+')) AS '+DBObj.Connection.QuoteIdent('Found rows')+', '+ '0 AS '+DBObj.Connection.QuoteIdent('Relevance')+ 'FROM '+DBObj.Connection.QuoteIdent(DBObj.Connection.InfSch)+'.'+DBObj.Connection.QuoteIdent('routines')+' '+ 'WHERE '+DBObj.Connection.QuoteIdent(RoutineSchemaColumn)+'='+esc(DBObj.Database)+' AND '+DBObj.Connection.QuoteIdent('routine_name')+'='+esc(DBObj.Name); @@ -1928,13 +1928,13 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); end else Struc := 'CREATE DATABASE IF NOT EXISTS '+Quoter.QuoteIdent(FinalDbName); Output(Struc, True, NeedsDBStructure, False, False, NeedsDBStructure); - Output(Quoter.GetSQLSpecifity(spUSEQuery, [Quoter.QuoteIdent(FinalDbName)]), True, NeedsDBStructure, False, False, NeedsDBStructure); + Output(Quoter.SqlProvider.GetSql(qUSEQuery, [Quoter.QuoteIdent(FinalDbName)]), True, NeedsDBStructure, False, False, NeedsDBStructure); Output(CRLF, False, NeedsDBStructure, False, False, NeedsDBStructure); end; end; if ToServer and (not chkExportDatabasesCreate.Checked) then begin // Export to server without "CREATE/USE dbname" and "Same dbs as on source server" - needs a "USE dbname" - Output(Quoter.GetSQLSpecifity(spUSEQuery, [Quoter.QuoteIdent(FinalDbName)]), True, False, False, False, NeedsDBStructure); + Output(Quoter.SqlProvider.GetSql(qUSEQuery, [Quoter.QuoteIdent(FinalDbName)]), True, False, False, False, NeedsDBStructure); end; // Table structure From fecd011d86f64594dfccdb40f7566fabe432ffbe Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 15 Feb 2026 18:41:37 +0100 Subject: [PATCH 018/170] refactor: outsource 3 large queries from GetTableColumns into TSqlProvider Refs #1880 --- source/dbconnection.pas | 120 ++--------------------------- source/dbstructures.interbase.pas | 18 +++++ source/dbstructures.pas | 9 ++- source/dbstructures.postgresql.pas | 99 +++++++++++++++++++++++- source/dbstructures.sqlite.pas | 1 + 5 files changed, 130 insertions(+), 117 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 1c9bc2a6d..0ec395a51 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -5803,106 +5803,13 @@ function TDBConnection.GetTableColumns(Table: TDBObject): TTableColumnList; Col: TTableColumn; dt, DefText, ExtraText, MaxLen, ColSQL: String; begin - // Generic: query table columns from IS.COLUMNS + // Generic: query table columns from IS.COLUMNS or query from provider Log(lcDebug, 'Getting fresh columns for '+Table.QuotedDbAndTableName); Result := TTableColumnList.Create(True); - if (FParameters.IsAnyPostgreSQL) and (ServerVersionInt >= 120000) then begin - // This uses pg_attribute.attgenerated, which only exists starting in PostgreSQL 12 - // Todo: outsource such bigger SQL chunks into dbstructures units, together with the FSQLSpecifities array - ColSQL := - 'SELECT ' + - ' n.nspname AS table_schema, ' + - ' c.relname AS table_name, ' + - ' a.attname AS column_name, ' + - ' a.attnum AS ordinal_position, ' + - ' pg_catalog.format_type(a.atttypid, a.atttypmod) AS data_type, ' + - // YES/NO like information_schema.is_nullable - ' CASE ' + - ' WHEN a.attnotnull THEN ''NO'' ' + - ' ELSE ''YES'' ' + - ' END AS is_nullable, ' + - // Character maximum length (in characters) - ' CASE ' + - ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + - ' AND a.atttypmod <> -1 ' + - ' THEN a.atttypmod - 4 ' + - ' ELSE NULL ' + - ' END AS character_maximum_length, ' + - // Numeric precision / scale (NULL for non-numeric) - ' CASE ' + - ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + - ' THEN ' + - ' CASE ' + - ' WHEN a.atttypmod = -1 THEN NULL ' + - ' ELSE ((a.atttypmod - 4) >> 16)::integer ' + - ' END ' + - ' END AS numeric_precision, ' + - ' CASE ' + - ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + - ' THEN ' + - ' CASE ' + - ' WHEN a.atttypmod = -1 THEN NULL ' + - ' ELSE ((a.atttypmod - 4) & 65535)::integer ' + - ' END ' + - ' END AS numeric_scale, ' + - // Datetime precision (for time/timestamp/interval) - ' CASE ' + - ' WHEN (bt.typcategory = ''D'' OR (bt.oid IS NULL AND t.typcategory = ''D'')) ' + - ' AND a.atttypmod <> -1 ' + - ' THEN a.atttypmod ' + - ' ELSE NULL ' + - ' END AS datetime_precision, ' + - // Character set name: PostgreSQL has one per DB; mimic information_schema - ' CASE ' + - ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + - ' THEN current_database() ' + - ' ELSE NULL ' + - ' END AS character_set_name, ' + - // Collation name for collatable columns - ' CASE ' + - ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + - ' THEN ' + - ' CASE ' + - ' WHEN a.attcollation <> t.typcollation ' + - ' THEN coll.collname ' + - ' ELSE NULL ' + - ' END ' + - ' ELSE NULL ' + - ' END AS collation_name, ' + - // Default expression for non-generated columns - ' CASE ' + - ' WHEN a.attgenerated = '''' AND a.atthasdef ' + - ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + - ' ELSE NULL ' + - ' END AS column_default, ' + - // Generation expression for generated columns - ' CASE ' + - ' WHEN a.attgenerated <> '''' AND a.atthasdef ' + - ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + - ' ELSE NULL ' + - ' END AS generation_expression, ' + - ' d.description AS column_comment ' + - 'FROM pg_catalog.pg_class AS c ' + - 'JOIN pg_catalog.pg_namespace AS n ON n.oid = c.relnamespace ' + - 'JOIN pg_catalog.pg_attribute AS a ON a.attrelid = c.oid ' + - 'JOIN pg_catalog.pg_type AS t ON t.oid = a.atttypid ' + - 'LEFT JOIN pg_catalog.pg_type AS bt ON bt.oid = t.typbasetype ' + - 'LEFT JOIN pg_catalog.pg_attrdef AS ad ' + - ' ON ad.adrelid = a.attrelid ' + - ' AND ad.adnum = a.attnum ' + - 'LEFT JOIN pg_catalog.pg_description AS d ' + - ' ON d.objoid = a.attrelid ' + - ' AND d.objsubid = a.attnum ' + - 'LEFT JOIN pg_catalog.pg_collation AS coll ' + - ' ON coll.oid = a.attcollation ' + - 'WHERE n.nspname = ' + EscapeString(Table.Schema) + ' ' + - ' AND a.attnum > 0 ' + - ' AND NOT a.attisdropped ' + - ' AND c.relname = ' + EscapeString(Table.Name) + ' ' + - 'ORDER BY ordinal_position'; + if FSqlProvider.Has(qGetTableColumns) then begin + ColSQL := FSqlProvider.GetSql(qGetTableColumns, [EscapeString(Table.Schema), EscapeString(Table.Name)]); end - else begin TableIdx := InformationSchemaObjects.IndexOf('columns'); if TableIdx = -1 then begin @@ -6152,7 +6059,7 @@ function TSQLiteConnection.GetTableColumns(Table: TDBObject): TTableColumnList; // Todo: include database name // Todo: default values Result := TTableColumnList.Create(True); - ColQuery := GetResults('SELECT * FROM pragma_table_xinfo('+EscapeString(Table.Name)+', '+EscapeString(Table.Database)+')'); + ColQuery := GetResults(FSqlProvider.GetSql(qGetTableColumns, [EscapeString(Table.Name), EscapeString(Table.Database)])); while not ColQuery.Eof do begin Col := TTableColumn.Create(Self); Result.Add(Col); @@ -6182,24 +6089,7 @@ function TInterbaseConnection.GetTableColumns(Table: TDBObject): TTableColumnLis begin // Todo Result := TTableColumnList.Create(True); - ColQuery := GetResults('SELECT r.RDB$FIELD_NAME AS field_name,'+ - ' r.RDB$DESCRIPTION AS field_description,'+ - ' r.RDB$DEFAULT_VALUE AS field_default_value,'+ - ' r.RDB$NULL_FLAG AS null_flag,'+ - ' f.RDB$FIELD_LENGTH AS field_length,'+ - ' f.RDB$FIELD_PRECISION AS field_precision,'+ - ' f.RDB$FIELD_SCALE AS field_scale,'+ - ' f.RDB$FIELD_TYPE AS field_type,'+ - ' f.RDB$FIELD_SUB_TYPE AS field_subtype,'+ - ' coll.RDB$COLLATION_NAME AS field_collation,'+ - ' cset.RDB$CHARACTER_SET_NAME AS field_charset'+ - ' FROM RDB$RELATION_FIELDS r'+ - ' LEFT JOIN RDB$FIELDS f ON r.RDB$FIELD_SOURCE = f.RDB$FIELD_NAME'+ - ' LEFT JOIN RDB$CHARACTER_SETS cset ON f.RDB$CHARACTER_SET_ID = cset.RDB$CHARACTER_SET_ID'+ - ' LEFT JOIN RDB$COLLATIONS coll ON f.RDB$COLLATION_ID = coll.RDB$COLLATION_ID'+ - ' AND F.RDB$CHARACTER_SET_ID = COLL.RDB$CHARACTER_SET_ID'+ - ' WHERE r.RDB$RELATION_NAME='+EscapeString(Table.Name)+ - ' ORDER BY r.RDB$FIELD_POSITION'); + ColQuery := GetResults(FSqlProvider.GetSql(qGetTableColumns, [EscapeString(Table.Name)])); while not ColQuery.Eof do begin Col := TTableColumn.Create(Self); Result.Add(Col); diff --git a/source/dbstructures.interbase.pas b/source/dbstructures.interbase.pas index 2a0b8e630..843f8a5ea 100644 --- a/source/dbstructures.interbase.pas +++ b/source/dbstructures.interbase.pas @@ -211,6 +211,24 @@ function TInterbaseProvider.GetSql(AId: TQueryId): string; qDisableForeignKeyChecks: Result := ''; qEnableForeignKeyChecks: Result := ''; qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + qGetTableColumns: Result := 'SELECT r.RDB$FIELD_NAME AS field_name,'+ + ' r.RDB$DESCRIPTION AS field_description,'+ + ' r.RDB$DEFAULT_VALUE AS field_default_value,'+ + ' r.RDB$NULL_FLAG AS null_flag,'+ + ' f.RDB$FIELD_LENGTH AS field_length,'+ + ' f.RDB$FIELD_PRECISION AS field_precision,'+ + ' f.RDB$FIELD_SCALE AS field_scale,'+ + ' f.RDB$FIELD_TYPE AS field_type,'+ + ' f.RDB$FIELD_SUB_TYPE AS field_subtype,'+ + ' coll.RDB$COLLATION_NAME AS field_collation,'+ + ' cset.RDB$CHARACTER_SET_NAME AS field_charset'+ + ' FROM RDB$RELATION_FIELDS r'+ + ' LEFT JOIN RDB$FIELDS f ON r.RDB$FIELD_SOURCE = f.RDB$FIELD_NAME'+ + ' LEFT JOIN RDB$CHARACTER_SETS cset ON f.RDB$CHARACTER_SET_ID = cset.RDB$CHARACTER_SET_ID'+ + ' LEFT JOIN RDB$COLLATIONS coll ON f.RDB$COLLATION_ID = coll.RDB$COLLATION_ID'+ + ' AND F.RDB$CHARACTER_SET_ID = COLL.RDB$CHARACTER_SET_ID'+ + ' WHERE r.RDB$RELATION_NAME=%s'+ + ' ORDER BY r.RDB$FIELD_POSITION'; end; end; diff --git a/source/dbstructures.pas b/source/dbstructures.pas index c24778af5..b83f6778d 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -46,13 +46,14 @@ interface qFuncLength, qFuncCeil, qFuncLeft, qFuncNow, qFuncLastAutoIncNumber, qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks, qOrderAsc, qOrderDesc, - qForeignKeyDrop); + qForeignKeyDrop, qGetTableColumns); TSqlProvider = class strict protected FNetType: TNetType; FServerVersion: Integer; public constructor Create(ANetType: TNetType); + function Has(AId: TQueryId): Boolean; function GetSql(AId: TQueryId): string; overload; virtual; function GetSql(AId: TQueryId; const Args: array of const): string; overload; property ServerVersion: Integer read FServerVersion write FServerVersion; @@ -190,6 +191,11 @@ constructor TSqlProvider.Create(ANetType: TNetType); FServerVersion := 0; end; +function TSqlProvider.Has(AId: TQueryId): Boolean; +begin + Result := not GetSql(AId).IsEmpty; +end; + function TSqlProvider.GetSql(AId: TQueryId): string; begin // This provides default values for queries, basically MySQL syntax @@ -257,6 +263,7 @@ function TSqlProvider.GetSql(AId: TQueryId): string; qOrderAsc: Result := 'ASC'; qOrderDesc: Result := 'DESC'; qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + qGetTableColumns: Result := ''; else Result := ''; end; end; diff --git a/source/dbstructures.postgresql.pas b/source/dbstructures.postgresql.pas index 9afe0ee94..5d0e43092 100644 --- a/source/dbstructures.postgresql.pas +++ b/source/dbstructures.postgresql.pas @@ -3,7 +3,7 @@ interface uses - dbstructures; + dbstructures, StrUtils; type // PostgreSQL structures @@ -608,6 +608,103 @@ function TPostgreSQLProvider.GetSql(AId: TQueryId): string; qDisableForeignKeyChecks: Result := ''; qEnableForeignKeyChecks: Result := ''; qForeignKeyDrop: Result := 'DROP CONSTRAINT %s'; + + // This uses pg_attribute.attgenerated, which only exists starting in PostgreSQL 12 + qGetTableColumns: Result := IfThen( + FServerVersion >= 120000, + 'SELECT ' + + ' n.nspname AS table_schema, ' + + ' c.relname AS table_name, ' + + ' a.attname AS column_name, ' + + ' a.attnum AS ordinal_position, ' + + ' pg_catalog.format_type(a.atttypid, a.atttypmod) AS data_type, ' + + // YES/NO like information_schema.is_nullable + ' CASE ' + + ' WHEN a.attnotnull THEN ''NO'' ' + + ' ELSE ''YES'' ' + + ' END AS is_nullable, ' + + // Character maximum length (in characters) + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' AND a.atttypmod <> -1 ' + + ' THEN a.atttypmod - 4 ' + + ' ELSE NULL ' + + ' END AS character_maximum_length, ' + + // Numeric precision / scale (NULL for non-numeric) + ' CASE ' + + ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.atttypmod = -1 THEN NULL ' + + ' ELSE ((a.atttypmod - 4) >> 16)::integer ' + + ' END ' + + ' END AS numeric_precision, ' + + ' CASE ' + + ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.atttypmod = -1 THEN NULL ' + + ' ELSE ((a.atttypmod - 4) & 65535)::integer ' + + ' END ' + + ' END AS numeric_scale, ' + + // Datetime precision (for time/timestamp/interval) + ' CASE ' + + ' WHEN (bt.typcategory = ''D'' OR (bt.oid IS NULL AND t.typcategory = ''D'')) ' + + ' AND a.atttypmod <> -1 ' + + ' THEN a.atttypmod ' + + ' ELSE NULL ' + + ' END AS datetime_precision, ' + + // Character set name: PostgreSQL has one per DB; mimic information_schema + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' THEN current_database() ' + + ' ELSE NULL ' + + ' END AS character_set_name, ' + + // Collation name for collatable columns + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.attcollation <> t.typcollation ' + + ' THEN coll.collname ' + + ' ELSE NULL ' + + ' END ' + + ' ELSE NULL ' + + ' END AS collation_name, ' + + // Default expression for non-generated columns + ' CASE ' + + ' WHEN a.attgenerated = '''' AND a.atthasdef ' + + ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + + ' ELSE NULL ' + + ' END AS column_default, ' + + // Generation expression for generated columns + ' CASE ' + + ' WHEN a.attgenerated <> '''' AND a.atthasdef ' + + ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + + ' ELSE NULL ' + + ' END AS generation_expression, ' + + ' d.description AS column_comment ' + + 'FROM pg_catalog.pg_class AS c ' + + 'JOIN pg_catalog.pg_namespace AS n ON n.oid = c.relnamespace ' + + 'JOIN pg_catalog.pg_attribute AS a ON a.attrelid = c.oid ' + + 'JOIN pg_catalog.pg_type AS t ON t.oid = a.atttypid ' + + 'LEFT JOIN pg_catalog.pg_type AS bt ON bt.oid = t.typbasetype ' + + 'LEFT JOIN pg_catalog.pg_attrdef AS ad ' + + ' ON ad.adrelid = a.attrelid ' + + ' AND ad.adnum = a.attnum ' + + 'LEFT JOIN pg_catalog.pg_description AS d ' + + ' ON d.objoid = a.attrelid ' + + ' AND d.objsubid = a.attnum ' + + 'LEFT JOIN pg_catalog.pg_collation AS coll ' + + ' ON coll.oid = a.attcollation ' + + 'WHERE n.nspname = %s ' + + ' AND a.attnum > 0 ' + + ' AND NOT a.attisdropped ' + + ' AND c.relname = %s ' + + 'ORDER BY ordinal_position', + '' // ServerVersion < 12 + ); + else Result := inherited; end; end; diff --git a/source/dbstructures.sqlite.pas b/source/dbstructures.sqlite.pas index 787525ca5..4eff40125 100644 --- a/source/dbstructures.sqlite.pas +++ b/source/dbstructures.sqlite.pas @@ -422,6 +422,7 @@ function TSQLiteProvider.GetSql(AId: TQueryId): string; qDisableForeignKeyChecks: Result := ''; qEnableForeignKeyChecks: Result := ''; qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + qGetTableColumns: Result := 'SELECT * FROM pragma_table_xinfo(%s, %s)'; else Result := inherited; end; end; From f8f980572da5a632c7903ee60a984c25eb70bc8a Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 15 Feb 2026 19:00:29 +0100 Subject: [PATCH 019/170] refactor: retrieve query for disabling and enabling foreign key checks from TSqlProvider --- source/dbconnection.pas | 3 +-- source/dbstructures.pas | 12 ++++++++++-- source/main.pas | 8 ++++---- source/tabletools.pas | 8 ++++---- 4 files changed, 19 insertions(+), 12 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 0ec395a51..5974a38e0 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -420,7 +420,7 @@ TDBLogItem = class(TObject) TFeatureOrRequirement = (frSrid, frTimezoneVar, frTemporalTypesFraction, frKillQuery, frLockedTables, frShowCreateTrigger, frShowWarnings, frShowCollation, frShowCollationExtended, frShowCharset, frIntegerDisplayWidth, frShowFunctionStatus, frShowProcedureStatus, - frShowTriggers, frShowEvents, frColumnDefaultParentheses, frForeignKeyChecksVar, + frShowTriggers, frShowEvents, frColumnDefaultParentheses, frHelpKeyword, frEditVariables, frCreateView, frCreateProcedure, frCreateFunction, frCreateTrigger, frCreateEvent, frInvisibleColumns, frCompressedColumns); @@ -6742,7 +6742,6 @@ function TDBConnection.Has(Item: TFeatureOrRequirement): Boolean; frShowTriggers: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 50010); frShowEvents: Result := (not Parameters.IsProxySQLAdmin) and (ServerVersionInt >= 50100); frColumnDefaultParentheses: Result := FParameters.IsMySQL(True) and (ServerVersionInt >= 80013); - frForeignKeyChecksVar: Result := ServerVersionInt >= 40014; frHelpKeyword: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 40100); frEditVariables: Result := ServerVersionInt >= 40003; frCreateView: Result := ServerVersionInt >= 50001; diff --git a/source/dbstructures.pas b/source/dbstructures.pas index b83f6778d..47d51e5fe 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -258,8 +258,16 @@ function TSqlProvider.GetSql(AId: TQueryId): string; 'SHOW OPEN TABLES FROM %s WHERE in_use!=0', '' ); - qDisableForeignKeyChecks: Result := 'SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0'; - qEnableForeignKeyChecks: Result := 'SET FOREIGN_KEY_CHECKS=IFNULL(@OLD_FOREIGN_KEY_CHECKS, 1)'; + qDisableForeignKeyChecks: Result := IfThen( + FServerVersion >= 40014, + 'SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0', + '' + ); + qEnableForeignKeyChecks: Result := IfThen( + FServerVersion >= 40014, + 'SET FOREIGN_KEY_CHECKS=IFNULL(@OLD_FOREIGN_KEY_CHECKS, 1)', + '' + ); qOrderAsc: Result := 'ASC'; qOrderDesc: Result := 'DESC'; qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; diff --git a/source/main.pas b/source/main.pas index 5f2eebbde..33ec65d93 100644 --- a/source/main.pas +++ b/source/main.pas @@ -3896,8 +3896,8 @@ procedure TMainForm.actDropObjectsExecute(Sender: TObject); if MessageDialog(f_('Drop %d object(s) in database "%s"?', [ObjectList.Count, Conn.Database]), msg, mtCriticalConfirmation, [mbok,mbcancel]) = mrOk then begin try // Disable foreign key checks to avoid SQL errors - if Conn.Has(frForeignKeyChecksVar) then - Conn.Query('SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0'); + if Conn.SqlProvider.Has(qDisableForeignKeyChecks) then + Conn.Query(Conn.SqlProvider.GetSql(qDisableForeignKeyChecks)); // Compose and run DROP [TABLE|VIEW|...] queries Editor := ActiveObjectEditor; for DBObject in ObjectList do begin @@ -3905,8 +3905,8 @@ procedure TMainForm.actDropObjectsExecute(Sender: TObject); if Assigned(Editor) and Editor.Modified and Editor.DBObject.IsSameAs(DBObject) then Editor.Modified := False; end; - if Conn.Has(frForeignKeyChecksVar) then - Conn.Query('SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS'); + if Conn.SqlProvider.Has(qEnableForeignKeyChecks) then + Conn.Query(Conn.SqlProvider.GetSql(qEnableForeignKeyChecks)); // Refresh ListTables + dbtree so the dropped tables are gone: Conn.ClearDbObjects(ActiveDatabase); RefreshTree; diff --git a/source/tabletools.pas b/source/tabletools.pas index 8ddd58b50..388d5b59d 100644 --- a/source/tabletools.pas +++ b/source/tabletools.pas @@ -2277,8 +2277,8 @@ procedure TfrmTableTools.DoBeforeGenerateData(Sender: TObject); if ToolMode <> tmGenerateData then Exit; Conn := MainForm.ActiveConnection; - if Conn.Has(frForeignKeyChecksVar) then - Conn.Query('SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0'); + if Conn.SqlProvider.Has(qDisableForeignKeyChecks) then + Conn.Query(Conn.SqlProvider.GetSql(qDisableForeignKeyChecks)); end; @@ -2290,8 +2290,8 @@ procedure TfrmTableTools.DoAfterGenerateData(Sender: TObject); if ToolMode <> tmGenerateData then Exit; Conn := MainForm.ActiveConnection; - if Conn.Has(frForeignKeyChecksVar) then - Conn.Query('SET FOREIGN_KEY_CHECKS=IFNULL(@OLD_FOREIGN_KEY_CHECKS, 1)'); + if Conn.SqlProvider.Has(qEnableForeignKeyChecks) then + Conn.Query(Conn.SqlProvider.GetSql(qEnableForeignKeyChecks)); end; From 4912dd8233fc8d9e1c0fc5649948597901f4f637 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 15 Feb 2026 19:41:14 +0100 Subject: [PATCH 020/170] refactor: move mysql specific SQL snippets to its own TSqlProvider, don't use as default for all others --- source/dbstructures.mssql.pas | 1 + source/dbstructures.mysql.pas | 67 +++++++++++++++++++++++++++++++-- source/dbstructures.pas | 71 +---------------------------------- 3 files changed, 66 insertions(+), 73 deletions(-) diff --git a/source/dbstructures.mssql.pas b/source/dbstructures.mssql.pas index 1389995fa..7e5ac2ac6 100644 --- a/source/dbstructures.mssql.pas +++ b/source/dbstructures.mssql.pas @@ -470,6 +470,7 @@ function TMsSqlProvider.GetSql(AId: TQueryId): string; qDisableForeignKeyChecks: Result := ''; qEnableForeignKeyChecks: Result := ''; qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + qGetTableColumns: Result := ''; else Result := inherited; end; end; diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index f8bc81783..2ca0e21a7 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -3227,11 +3227,72 @@ procedure TMySQLLib.AssignProcedures; function TMySqlProvider.GetSql(AId: TQueryId): string; begin case AId of + qDatabaseDrop: Result := 'DROP DATABASE %s'; + qEmptyTable: Result := 'TRUNCATE '; + qRenameTable: Result := 'RENAME TABLE %s TO %s'; + qRenameView: Result := 'RENAME TABLE %s TO %s'; + qCurrentUserHost: Result := 'SELECT CURRENT_USER()'; + qLikeCompare: Result := '%s LIKE %s'; + qAddColumn: Result := 'ADD COLUMN %s'; + qChangeColumn: Result := 'CHANGE COLUMN %s %s'; + qGlobalStatus: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'SELECT * FROM stats_mysql_global', + 'SHOW /*!50002 GLOBAL */ STATUS' + ); + qCommandsCounters: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'SELECT * FROM stats_mysql_commands_counters', + 'SHOW /*!50002 GLOBAL */ STATUS LIKE ''Com\_%''' + ); + qSessionVariables: Result := 'SHOW VARIABLES'; + qGlobalVariables: Result := 'SHOW GLOBAL VARIABLES'; + qISSchemaCol: Result := '%s_SCHEMA'; + qUSEQuery: Result := 'USE %s'; qKillQuery: Result := IfThen( - (FNetType <> ntMySQL_RDS) and (FServerVersion >= 50000), - 'KILL QUERY %d', - inherited + FNetType = ntMySQL_RDS, + 'CALL mysql.rds_kill_query(%d)', + IfThen( + FServerVersion >= 50000, + 'KILL QUERY %d', + 'KILL %d' + ) + ); + qKillProcess: Result := IfThen( + FNetType = ntMySQL_RDS, + 'CALL mysql.rds_kill(%d)', + 'KILL %d' + ); + qFuncLength: Result := 'LENGTH'; + qFuncCeil: Result := 'CEIL'; + qFuncLeft: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'SUBSTR(%s, 1, %d)', + 'LEFT(%s, %d)' + ); + qFuncNow: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'CURRENT_TIMESTAMP', + 'NOW()' + ); + qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; + qLockedTables: Result := IfThen( + (FNetType <> ntMySQL_ProxySQLAdmin) and (FServerVersion >= 50124), + 'SHOW OPEN TABLES FROM %s WHERE in_use!=0', + '' + ); + qDisableForeignKeyChecks: Result := IfThen( + FServerVersion >= 40014, + 'SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0', + '' + ); + qEnableForeignKeyChecks: Result := IfThen( + FServerVersion >= 40014, + 'SET FOREIGN_KEY_CHECKS=IFNULL(@OLD_FOREIGN_KEY_CHECKS, 1)', + '' ); + qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + qGetTableColumns: Result := ''; else Result := inherited; end; end; diff --git a/source/dbstructures.pas b/source/dbstructures.pas index 47d51e5fe..5986cd5d3 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -198,80 +198,11 @@ function TSqlProvider.Has(AId: TQueryId): Boolean; function TSqlProvider.GetSql(AId: TQueryId): string; begin - // This provides default values for queries, basically MySQL syntax + // Basic default SQL snippets compatible to all or most servers case AId of - // qDatabaseTable: MSSQL only - // qDatabaseTableId: MSSQL only - qDatabaseDrop: Result := 'DROP DATABASE %s'; - // qDbObjectsTable: MSSQL only - // qDbObjectsCreateCol: MSSQL only - // qDbObjectsUpdateCol: MSSQL only - // qDbObjectsTypeCol: MSSQL only - qEmptyTable: Result := 'TRUNCATE '; - qRenameTable: Result := 'RENAME TABLE %s TO %s'; - qRenameView: Result := 'RENAME TABLE %s TO %s'; - qCurrentUserHost: Result := 'SELECT CURRENT_USER()'; - qLikeCompare: Result := '%s LIKE %s'; - qAddColumn: Result := 'ADD COLUMN %s'; - qChangeColumn: Result := 'CHANGE COLUMN %s %s'; - // qRenameColumn: PostgreSQL only qForeignKeyEventAction: Result := 'RESTRICT,CASCADE,SET NULL,NO ACTION'; - qGlobalStatus: Result := IfThen( - FNetType = ntMySQL_ProxySQLAdmin, - 'SELECT * FROM stats_mysql_global', - 'SHOW /*!50002 GLOBAL */ STATUS' - ); - qCommandsCounters: Result := IfThen( - FNetType = ntMySQL_ProxySQLAdmin, - 'SELECT * FROM stats_mysql_commands_counters', - 'SHOW /*!50002 GLOBAL */ STATUS LIKE ''Com\_%''' - ); - qSessionVariables: Result := 'SHOW VARIABLES'; - qGlobalVariables: Result := 'SHOW GLOBAL VARIABLES'; - qISSchemaCol: Result := '%s_SCHEMA'; - qUSEQuery: Result := 'USE %s'; - qKillQuery: Result := IfThen( - FNetType = ntMySQL_RDS, - 'CALL mysql.rds_kill_query(%d)', - 'KILL %d' - ); - qKillProcess: Result := IfThen( - FNetType = ntMySQL_RDS, - 'CALL mysql.rds_kill(%d)', - 'KILL %d' - ); - qFuncLength: Result := 'LENGTH'; - qFuncCeil: Result := 'CEIL'; - qFuncLeft: Result := IfThen( - FNetType = ntMySQL_ProxySQLAdmin, - 'SUBSTR(%s, 1, %d)', - 'LEFT(%s, %d)' - ); - qFuncNow: Result := IfThen( - FNetType = ntMySQL_ProxySQLAdmin, - 'CURRENT_TIMESTAMP', - 'NOW()' - ); - qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; - qLockedTables: Result := IfThen( - (FNetType <> ntMySQL_ProxySQLAdmin) and (FServerVersion >= 50124), - 'SHOW OPEN TABLES FROM %s WHERE in_use!=0', - '' - ); - qDisableForeignKeyChecks: Result := IfThen( - FServerVersion >= 40014, - 'SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0', - '' - ); - qEnableForeignKeyChecks: Result := IfThen( - FServerVersion >= 40014, - 'SET FOREIGN_KEY_CHECKS=IFNULL(@OLD_FOREIGN_KEY_CHECKS, 1)', - '' - ); qOrderAsc: Result := 'ASC'; qOrderDesc: Result := 'DESC'; - qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; - qGetTableColumns: Result := ''; else Result := ''; end; end; From a3374f3eb90e885963c7fe4b86db8965ac39af67 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 16 Feb 2026 13:45:19 +0100 Subject: [PATCH 021/170] refactor: outsource queries from GetCollationTable into TSqlProvider --- source/dbconnection.pas | 57 +++---------------------------- source/dbstructures.interbase.pas | 4 +++ source/dbstructures.mssql.pas | 4 +++ source/dbstructures.mysql.pas | 18 ++++++++++ source/dbstructures.pas | 2 +- 5 files changed, 32 insertions(+), 53 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 5974a38e0..4742b0ac8 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -418,7 +418,7 @@ TDBLogItem = class(TObject) TDBEvent = procedure(Connection: TDBConnection; Database: String) of object; TDBDataTypeArray = Array of TDBDataType; TFeatureOrRequirement = (frSrid, frTimezoneVar, frTemporalTypesFraction, frKillQuery, - frLockedTables, frShowCreateTrigger, frShowWarnings, frShowCollation, frShowCollationExtended, + frLockedTables, frShowCreateTrigger, frShowWarnings, frShowCharset, frIntegerDisplayWidth, frShowFunctionStatus, frShowProcedureStatus, frShowTriggers, frShowEvents, frColumnDefaultParentheses, frHelpKeyword, frEditVariables, frCreateView, frCreateProcedure, frCreateFunction, @@ -643,7 +643,6 @@ TMySQLConnection = class(TDBConnection) function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; function GetTableEngines: TStringList; override; - function GetCollationTable: TDBQuery; override; function GetCharsetTable: TDBQuery; override; function GetCreateViewCode(Database, Name: String): String; function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; @@ -676,7 +675,6 @@ TAdoDBConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCollationTable: TDBQuery; override; function GetCharsetTable: TDBQuery; override; function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; @@ -782,7 +780,6 @@ TInterbaseConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCollationTable: TDBQuery; override; function GetCharsetTable: TDBQuery; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public @@ -5519,56 +5516,14 @@ function TDBConnection.GetCollationTable: TDBQuery; begin Log(lcDebug, 'Fetching list of collations ...'); Ping(True); - Result := FCollationTable; -end; - - -function TMySQLConnection.GetCollationTable: TDBQuery; -begin - inherited; - if (not Assigned(FCollationTable)) and Has(frShowCollation) then begin - if Has(frShowCollationExtended) then try - // Issue #1917: MariaDB 10.10.1+ versions have additional collations in IS.COLLATION_CHARACTER_SET_APPLICABILITY - FCollationTable := GetResults('SELECT'+ - ' FULL_COLLATION_NAME AS '+QuoteIdent('Collation')+ - ', CHARACTER_SET_NAME AS '+QuoteIdent('Charset')+ - ', ID AS '+QuoteIdent('Id')+ - ', IS_DEFAULT AS '+QuoteIdent('Default')+ - ', 0 AS '+QuoteIdent('Sortlen')+ - ' FROM '+QuoteIdent(InfSch)+'.COLLATION_CHARACTER_SET_APPLICABILITY'+ - ' ORDER BY '+QuoteIdent('Collation') - ); + if (not Assigned(FCollationTable)) and FSqlProvider.Has(qGetCollations) then begin + if FSqlProvider.Has(qGetCollationsExtended) then try + FCollationTable := GetResults(FSqlProvider.GetSql(qGetCollationsExtended)); except on E:EDbError do; end; if not Assigned(FCollationTable) then - FCollationTable := GetResults('SHOW COLLATION'); - end; - if Assigned(FCollationTable) then - FCollationTable.First; - Result := FCollationTable; -end; - - -function TAdoDBConnection.GetCollationTable: TDBQuery; -begin - inherited; - if (not Assigned(FCollationTable)) then - FCollationTable := GetResults('SELECT '+EscapeString('')+' AS '+QuoteIdent('Collation')+', '+ - EscapeString('')+' AS '+QuoteIdent('Charset')+', 0 AS '+QuoteIdent('Id')+', '+ - EscapeString('')+' AS '+QuoteIdent('Default')+', '+EscapeString('')+' AS '+QuoteIdent('Compiled')+', '+ - '1 AS '+QuoteIdent('Sortlen')); - if Assigned(FCollationTable) then - FCollationTable.First; - Result := FCollationTable; -end; - - -function TInterbaseConnection.GetCollationTable: TDBQuery; -begin - inherited; - if not Assigned(FCollationTable) then begin - FCollationTable := GetResults('SELECT RDB$COLLATION_NAME AS '+QuoteIdent('Collation')+', RDB$COLLATION_ID AS '+QuoteIdent('Id')+', RDB$CHARACTER_SET_ID FROM RDB$COLLATIONS'); + FCollationTable := GetResults(FSqlProvider.GetSql(qGetCollations)); end; if Assigned(FCollationTable) then FCollationTable.First; @@ -6732,8 +6687,6 @@ function TDBConnection.Has(Item: TFeatureOrRequirement): Boolean; frLockedTables: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 50124); frShowCreateTrigger: Result := ServerVersionInt >= 50121; frShowWarnings: Result := ServerVersionInt >= 40100; - frShowCollation: Result := ServerVersionInt >= 40100; - frShowCollationExtended: Result := FParameters.IsMariaDB and (ServerVersionInt >= 101001); frShowCharset: Result := ServerVersionInt >= 40100; frIntegerDisplayWidth: Result := (FParameters.IsMySQL(True) and (ServerVersionInt < 80017)) or (not FParameters.IsMySQL(True)); diff --git a/source/dbstructures.interbase.pas b/source/dbstructures.interbase.pas index 843f8a5ea..7c5bb7b1b 100644 --- a/source/dbstructures.interbase.pas +++ b/source/dbstructures.interbase.pas @@ -229,6 +229,10 @@ function TInterbaseProvider.GetSql(AId: TQueryId): string; ' AND F.RDB$CHARACTER_SET_ID = COLL.RDB$CHARACTER_SET_ID'+ ' WHERE r.RDB$RELATION_NAME=%s'+ ' ORDER BY r.RDB$FIELD_POSITION'; + qGetCollations: Result := 'SELECT RDB$COLLATION_NAME AS "Collation",'+ + ' RDB$COLLATION_ID AS "Id",'+ + ' RDB$CHARACTER_SET_ID'+ + ' FROM RDB$COLLATIONS'; end; end; diff --git a/source/dbstructures.mssql.pas b/source/dbstructures.mssql.pas index 7e5ac2ac6..36e9f7603 100644 --- a/source/dbstructures.mssql.pas +++ b/source/dbstructures.mssql.pas @@ -471,6 +471,10 @@ function TMsSqlProvider.GetSql(AId: TQueryId): string; qEnableForeignKeyChecks: Result := ''; qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; qGetTableColumns: Result := ''; + qGetCollations: Result := 'SELECT '''' AS "Collation", '+ + ''''' AS "Charset", 0 AS "Id", '+ + ''''' AS "Default", '''' AS "Compiled", '+ + '1 AS "Sortlen"'; else Result := inherited; end; end; diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index 2ca0e21a7..e7a0a8d3c 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -3293,6 +3293,24 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; ); qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; qGetTableColumns: Result := ''; + qGetCollations: Result := IfThen( + FServerVersion >= 40100, + 'SHOW COLLATION', + '' + ); + // Issue #1917: MariaDB 10.10.1+ versions have additional collations in IS.COLLATION_CHARACTER_SET_APPLICABILITY + qGetCollationsExtended: Result := IfThen( + FServerVersion >= 101001, + 'SELECT'+ + ' FULL_COLLATION_NAME AS `Collation`'+ + ', CHARACTER_SET_NAME AS `Charset`'+ + ', ID AS `Id`'+ + ', IS_DEFAULT AS `Default`'+ + ', 0 AS `Sortlen`'+ + ' FROM information_schema.COLLATION_CHARACTER_SET_APPLICABILITY'+ + ' ORDER BY `Collation`', + '' + ); else Result := inherited; end; end; diff --git a/source/dbstructures.pas b/source/dbstructures.pas index 5986cd5d3..9d0b13fe2 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -46,7 +46,7 @@ interface qFuncLength, qFuncCeil, qFuncLeft, qFuncNow, qFuncLastAutoIncNumber, qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks, qOrderAsc, qOrderDesc, - qForeignKeyDrop, qGetTableColumns); + qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended); TSqlProvider = class strict protected FNetType: TNetType; From 10fecd61b00c4bdb44a65b981531cc0c1c38ffd0 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 16 Feb 2026 14:17:47 +0100 Subject: [PATCH 022/170] refactor: get SQLite collations from pragma collation_list --- source/dbconnection.pas | 9 --------- source/dbstructures.sqlite.pas | 2 ++ 2 files changed, 2 insertions(+), 9 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 4742b0ac8..d035f951b 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -746,7 +746,6 @@ TSQLiteConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCollationList: TStringList; override; function GetCharsetTable: TDBQuery; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public @@ -5544,14 +5543,6 @@ function TDBConnection.GetCollationList: TStringList; end; -function TSQLiteConnection.GetCollationList: TStringList; -begin - // See https://www.sqlite.org/datatype3.html#collation_sequence_examples - Result := TStringList.Create; - Result.CommaText := 'nocase,binary,rtrim'; -end; - - function TDBConnection.GetCharsetTable: TDBQuery; begin Log(lcDebug, 'Fetching charset list ...'); diff --git a/source/dbstructures.sqlite.pas b/source/dbstructures.sqlite.pas index 4eff40125..66efbfcb2 100644 --- a/source/dbstructures.sqlite.pas +++ b/source/dbstructures.sqlite.pas @@ -423,6 +423,8 @@ function TSQLiteProvider.GetSql(AId: TQueryId): string; qEnableForeignKeyChecks: Result := ''; qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; qGetTableColumns: Result := 'SELECT * FROM pragma_table_xinfo(%s, %s)'; + // See https://www.sqlite.org/datatype3.html#collation_sequence_examples + qGetCollations: Result := 'SELECT name AS "Collation", '''' AS "Charset", '''' AS "Id", '''' AS "Default", '''' AS "Compiled", ''1'' AS Sortlen from pragma_collation_list'; else Result := inherited; end; end; From 277c0a969ac4cdf07cdd5454a886967128285748 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 16 Feb 2026 15:28:02 +0100 Subject: [PATCH 023/170] refactor: outsource queries from GetCharsetTable into TSqlProvider --- source/dbconnection.pas | 59 ++---------------------------- source/dbstructures.interbase.pas | 1 + source/dbstructures.mssql.pas | 1 + source/dbstructures.mysql.pas | 5 +++ source/dbstructures.pas | 2 +- source/dbstructures.postgresql.pas | 4 ++ source/dbstructures.sqlite.pas | 3 ++ 7 files changed, 18 insertions(+), 57 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index d035f951b..727312022 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -643,7 +643,6 @@ TMySQLConnection = class(TDBConnection) function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; function GetTableEngines: TStringList; override; - function GetCharsetTable: TDBQuery; override; function GetCreateViewCode(Database, Name: String): String; function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; @@ -675,7 +674,6 @@ TAdoDBConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCharsetTable: TDBQuery; override; function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public @@ -706,7 +704,6 @@ TPgConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCharsetTable: TDBQuery; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; procedure Drop(Obj: TDBObject); override; public @@ -746,7 +743,6 @@ TSQLiteConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCharsetTable: TDBQuery; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public constructor Create(AOwner: TComponent); override; @@ -779,7 +775,6 @@ TInterbaseConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCharsetTable: TDBQuery; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public constructor Create(AOwner: TComponent); override; @@ -2135,6 +2130,7 @@ constructor TDBConnection.Create(AOwner: TComponent); FCaseSensitivity := 0; FStringQuoteChar := ''''; FCollationTable := nil; + FCharsetTable := nil; end; @@ -5547,57 +5543,8 @@ function TDBConnection.GetCharsetTable: TDBQuery; begin Log(lcDebug, 'Fetching charset list ...'); Ping(True); - Result := nil; -end; - - -function TMySQLConnection.GetCharsetTable: TDBQuery; -begin - inherited; - if (not Assigned(FCharsetTable)) and Has(frShowCharset) then - FCharsetTable := GetResults('SHOW CHARSET'); - Result := FCharsetTable; -end; - - -function TAdoDBConnection.GetCharsetTable: TDBQuery; -begin - inherited; - if not Assigned(FCharsetTable) then - FCharsetTable := GetResults('SELECT '+QuoteIdent('name')+' AS '+QuoteIdent('Charset')+', '+QuoteIdent('description')+' AS '+QuoteIdent('Description')+ - ' FROM '+QuotedDbAndTableName('master', 'syscharsets') - ); - Result := FCharsetTable; -end; - - -function TPgConnection.GetCharsetTable: TDBQuery; -begin - inherited; - if not Assigned(FCharsetTable) then - FCharsetTable := GetResults('SELECT PG_ENCODING_TO_CHAR('+QuoteIdent('encid')+') AS '+QuoteIdent('Charset')+', '+EscapeString('')+' AS '+QuoteIdent('Description')+' FROM ('+ - 'SELECT '+QuoteIdent('conforencoding')+' AS '+QuoteIdent('encid')+' FROM '+QuoteIdent('pg_conversion')+', '+QuoteIdent('pg_database')+' '+ - 'WHERE '+QuoteIdent('contoencoding')+'='+QuoteIdent('encoding')+' AND '+QuoteIdent('datname')+'=CURRENT_DATABASE()) AS '+QuoteIdent('e') - ); - Result := FCharsetTable; -end; - - -function TSQLiteConnection.GetCharsetTable; -begin - inherited; - if not Assigned(FCharsetTable) then begin - //FCharsetTable := // Todo! - end; - Result := FCharsetTable; -end; - - -function TInterbaseConnection.GetCharsetTable: TDBQuery; -begin - inherited; - if not Assigned(FCharsetTable) then - FCharsetTable := GetResults('SELECT RDB$CHARACTER_SET_NAME AS '+QuoteIdent('Charset')+', RDB$CHARACTER_SET_NAME AS '+QuoteIdent('Description')+' FROM RDB$CHARACTER_SETS'); + if (not Assigned(FCharsetTable)) and FSqlProvider.Has(qGetCharsets) then + FCharsetTable := GetResults(FSqlProvider.GetSql(qGetCharsets)); Result := FCharsetTable; end; diff --git a/source/dbstructures.interbase.pas b/source/dbstructures.interbase.pas index 7c5bb7b1b..ca9711ccd 100644 --- a/source/dbstructures.interbase.pas +++ b/source/dbstructures.interbase.pas @@ -233,6 +233,7 @@ function TInterbaseProvider.GetSql(AId: TQueryId): string; ' RDB$COLLATION_ID AS "Id",'+ ' RDB$CHARACTER_SET_ID'+ ' FROM RDB$COLLATIONS'; + qGetCharsets: Result := 'SELECT RDB$CHARACTER_SET_NAME AS "Charset", RDB$CHARACTER_SET_NAME AS "Description" FROM RDB$CHARACTER_SETS'; end; end; diff --git a/source/dbstructures.mssql.pas b/source/dbstructures.mssql.pas index 36e9f7603..370cc9fb2 100644 --- a/source/dbstructures.mssql.pas +++ b/source/dbstructures.mssql.pas @@ -475,6 +475,7 @@ function TMsSqlProvider.GetSql(AId: TQueryId): string; ''''' AS "Charset", 0 AS "Id", '+ ''''' AS "Default", '''' AS "Compiled", '+ '1 AS "Sortlen"'; + qGetCharsets: Result := 'SELECT name AS Charset, description AS Description FROM master.sys.syscharsets'; else Result := inherited; end; end; diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index e7a0a8d3c..c7f0eef25 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -3311,6 +3311,11 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; ' ORDER BY `Collation`', '' ); + qGetCharsets: Result := IfThen( + FServerVersion >= 40100, + 'SHOW CHARSET', + '' + ); else Result := inherited; end; end; diff --git a/source/dbstructures.pas b/source/dbstructures.pas index 9d0b13fe2..0bb59292e 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -46,7 +46,7 @@ interface qFuncLength, qFuncCeil, qFuncLeft, qFuncNow, qFuncLastAutoIncNumber, qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks, qOrderAsc, qOrderDesc, - qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended); + qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets); TSqlProvider = class strict protected FNetType: TNetType; diff --git a/source/dbstructures.postgresql.pas b/source/dbstructures.postgresql.pas index 5d0e43092..31cc1abe2 100644 --- a/source/dbstructures.postgresql.pas +++ b/source/dbstructures.postgresql.pas @@ -705,6 +705,10 @@ function TPostgreSQLProvider.GetSql(AId: TQueryId): string; '' // ServerVersion < 12 ); + qGetCharsets: Result := 'SELECT DISTINCT pg_encoding_to_char(enc) AS "Charset" FROM '+ + '(SELECT conforencoding AS enc FROM pg_catalog.pg_conversion '+ + ' UNION '+ + ' SELECT contoencoding AS enc FROM pg_catalog.pg_conversion) AS x'; else Result := inherited; end; end; diff --git a/source/dbstructures.sqlite.pas b/source/dbstructures.sqlite.pas index 66efbfcb2..60e85cc06 100644 --- a/source/dbstructures.sqlite.pas +++ b/source/dbstructures.sqlite.pas @@ -425,6 +425,9 @@ function TSQLiteProvider.GetSql(AId: TQueryId): string; qGetTableColumns: Result := 'SELECT * FROM pragma_table_xinfo(%s, %s)'; // See https://www.sqlite.org/datatype3.html#collation_sequence_examples qGetCollations: Result := 'SELECT name AS "Collation", '''' AS "Charset", '''' AS "Id", '''' AS "Default", '''' AS "Compiled", ''1'' AS Sortlen from pragma_collation_list'; + qGetCharsets: Result := 'SELECT ''UTF-8'' AS "Charset", ''UTF-8'' AS "Description" '+ + 'UNION SELECT ''UTF-16le'', ''UTF-16 Little Endian'' '+ + 'UNION SELECT ''UTF-16be'', ''UTF-16 Big Endian'''; else Result := inherited; end; end; From 14f5468af21530689802c4a3f73d9d669ffd10c7 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 16 Feb 2026 20:45:23 +0100 Subject: [PATCH 024/170] refactor: outsource queries from GetRowCount into TSqlProvider This required to introduce a third version of TSqlProvider.GetSql which works with named parameters packed into a TStringMap --- source/dbconnection.pas | 93 ++++++++++++------------------ source/dbstructures.mssql.pas | 5 ++ source/dbstructures.mysql.pas | 5 ++ source/dbstructures.pas | 24 +++++++- source/dbstructures.postgresql.pas | 5 ++ 5 files changed, 72 insertions(+), 60 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 727312022..fa456df1c 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -166,6 +166,7 @@ TDBObject = class(TPersistent) FCreateCodeLoaded: Boolean; FWasSelected: Boolean; FConnection: TDBConnection; + FMap: TStringMap; function GetObjType: String; function GetImageIndex: Integer; function GetOverlayImageIndex: Integer; @@ -185,6 +186,7 @@ TDBObject = class(TPersistent) NodeType, GroupType: TListNodeType; constructor Create(OwnerConnection: TDBConnection); + destructor Destroy; procedure Assign(Source: TPersistent); override; procedure UnloadDetails; procedure Drop; @@ -197,6 +199,7 @@ TDBObject = class(TPersistent) function RowCount(Reload: Boolean; ForceExact: Boolean=False): Int64; function GetCreateCode: String; overload; function GetCreateCode(RemoveAutoInc, RemoveDefiner: Boolean): String; overload; + function AsStringMap: TStringMap; property ObjType: String read GetObjType; property ImageIndex: Integer read GetImageIndex; property OverlayImageIndex: Integer read GetOverlayImageIndex; @@ -417,9 +420,9 @@ TDBLogItem = class(TObject) TDBLogEvent = procedure(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil) of object; TDBEvent = procedure(Connection: TDBConnection; Database: String) of object; TDBDataTypeArray = Array of TDBDataType; - TFeatureOrRequirement = (frSrid, frTimezoneVar, frTemporalTypesFraction, frKillQuery, - frLockedTables, frShowCreateTrigger, frShowWarnings, - frShowCharset, frIntegerDisplayWidth, frShowFunctionStatus, frShowProcedureStatus, + TFeatureOrRequirement = (frSrid, frTimezoneVar, frTemporalTypesFraction, + frShowCreateTrigger, frShowWarnings, + frIntegerDisplayWidth, frShowFunctionStatus, frShowProcedureStatus, frShowTriggers, frShowEvents, frColumnDefaultParentheses, frHelpKeyword, frEditVariables, frCreateView, frCreateProcedure, frCreateFunction, frCreateTrigger, frCreateEvent, frInvisibleColumns, frCompressedColumns); @@ -644,7 +647,6 @@ TMySQLConnection = class(TDBConnection) function GetAllDatabases: TStringList; override; function GetTableEngines: TStringList; override; function GetCreateViewCode(Database, Name: String): String; - function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public constructor Create(AOwner: TComponent); override; @@ -674,7 +676,6 @@ TAdoDBConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public constructor Create(AOwner: TComponent); override; @@ -714,7 +715,6 @@ TPgConnection = class(TDBConnection) function Ping(Reconnect: Boolean): Boolean; override; function GetCreateCode(Obj: TDBObject): String; override; function ConnectionInfo: TStringList; override; - function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; property LastRawResults: TPGRawResults read FLastRawResults; property RegClasses: TOidStringPairs read FRegClasses; function GetTableKeys(Table: TDBObject): TTableKeyList; override; @@ -6621,11 +6621,8 @@ function TDBConnection.Has(Item: TFeatureOrRequirement): Boolean; frTimezoneVar: Result := ServerVersionInt >= 40103; frTemporalTypesFraction: Result := (FParameters.IsMariaDB and (ServerVersionInt >= 50300)) or (FParameters.IsMySQL(True) and (ServerVersionInt >= 50604)); - frKillQuery: Result := (not FParameters.IsMySQLonRDS) and (ServerVersionInt >= 50000); - frLockedTables: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 50124); frShowCreateTrigger: Result := ServerVersionInt >= 50121; frShowWarnings: Result := ServerVersionInt >= 40100; - frShowCharset: Result := ServerVersionInt >= 40100; frIntegerDisplayWidth: Result := (FParameters.IsMySQL(True) and (ServerVersionInt < 80017)) or (not FParameters.IsMySQL(True)); frShowFunctionStatus: Result := (not Parameters.IsProxySQLAdmin) and (ServerVersionInt >= 50000); @@ -6651,59 +6648,20 @@ function TDBConnection.Has(Item: TFeatureOrRequirement): Boolean; function TDBConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; var - Rows: String; + Rows, QueryApprox, QueryExact: String; + RowsColumn: Integer; begin // Get row number from a table - Rows := GetVar('SELECT COUNT(*) FROM '+QuotedDbAndTableName(Obj.Database, Obj.Name), 0); - Result := MakeInt(Rows); -end; - - -function TMySQLConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; -var - Rows: String; -begin - // Get row number from a mysql table - if Parameters.IsProxySQLAdmin or ForceExact then begin - Result := inherited + QueryApprox := FSqlProvider.GetSql(qGetRowCountApprox, Obj.AsStringMap); + if QueryApprox.IsEmpty or ForceExact then begin + QueryExact := FSqlProvider.GetSql(qGetRowCountExact, Obj.AsStringMap); + Rows := GetVar(QueryExact); end else begin - Rows := GetVar('SHOW TABLE STATUS LIKE '+EscapeString(Obj.Name), 'Rows'); - Result := MakeInt(Rows); - end; -end; - - -function TAdoDBConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; -var - Rows: String; -begin - // Get row number from a mssql table - if (ServerVersionInt < 900) or ForceExact then begin - Result := inherited - end - else begin - Rows := GetVar('SELECT SUM('+QuoteIdent('rows')+') FROM '+QuoteIdent('sys')+'.'+QuoteIdent('partitions')+ - ' WHERE '+QuoteIdent('index_id')+' IN (0, 1)'+ - ' AND '+QuoteIdent('object_id')+' = object_id('+EscapeString(Obj.Database+'.'+Obj.Schema+'.'+Obj.Name)+')' - ); - Result := MakeInt(Rows); + // This is ugly: in MySQL 4.x we only have SHOW TABLE STATUS, which cannot be limited to the "Rows" column + RowsColumn := IfThen(QueryApprox.StartsWith('SHOW ', True), 4, 0); + Rows := GetVar(QueryApprox, RowsColumn); end; -end; - - -function TPgConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; -var - Rows: String; -begin - // Get row number from a postgres table - Rows := GetVar('SELECT '+QuoteIdent('reltuples')+'::bigint FROM '+QuoteIdent('pg_class')+ - ' LEFT JOIN '+QuoteIdent('pg_namespace')+ - ' ON ('+QuoteIdent('pg_namespace')+'.'+QuoteIdent('oid')+' = '+QuoteIdent('pg_class')+'.'+QuoteIdent('relnamespace')+')'+ - ' WHERE '+QuoteIdent('pg_class')+'.'+QuoteIdent('relkind')+'='+EscapeString('r')+ - ' AND '+QuoteIdent('pg_namespace')+'.'+QuoteIdent('nspname')+'='+EscapeString(Obj.Database)+ - ' AND '+QuoteIdent('pg_class')+'.'+QuoteIdent('relname')+'='+EscapeString(Obj.Name) - ); Result := MakeInt(Rows); end; @@ -10183,6 +10141,13 @@ constructor TDBObject.Create(OwnerConnection: TDBConnection); FCreateCodeLoaded := False; FWasSelected := False; FConnection := OwnerConnection; + FMap := TStringMap.Create; +end; + +destructor TDBObject.Destroy; +begin + FMap.Free; + inherited; end; @@ -10532,6 +10497,20 @@ function TDBObject.GetTableCheckConstraints: TCheckConstraintList; Result.Assign(CheckConstraintsInCache); end; +function TDBObject.AsStringMap: TStringMap; +begin + FMap.Clear; + FMap.Add('EscapedName', FConnection.EscapeString(Name)); + FMap.Add('EscapedSchema', FConnection.EscapeString(Schema)); + FMap.Add('EscapedDatabase', FConnection.EscapeString(Database)); + FMap.Add('EscapedDbSchemaName', FConnection.EscapeString(Database+'.'+Schema+'.'+Name)); + FMap.Add('QuotedDatabase', QuotedDatabase); + FMap.Add('QuotedName', QuotedName); + FMap.Add('QuotedDbAndTableName', QuotedDbAndTableName); + Result := FMap; +end; + + { *** TTableColumn } diff --git a/source/dbstructures.mssql.pas b/source/dbstructures.mssql.pas index 370cc9fb2..41d033ebb 100644 --- a/source/dbstructures.mssql.pas +++ b/source/dbstructures.mssql.pas @@ -476,6 +476,11 @@ function TMsSqlProvider.GetSql(AId: TQueryId): string; ''''' AS "Default", '''' AS "Compiled", '+ '1 AS "Sortlen"'; qGetCharsets: Result := 'SELECT name AS Charset, description AS Description FROM master.sys.syscharsets'; + qGetRowCountApprox: Result := IfThen( + FServerVersion >= 900, + 'SELECT SUM("rows") FROM "sys"."partitions" WHERE "index_id" IN (0, 1) AND "object_id" = object_id(:EscapedDbSchemaName)', + '' + ); else Result := inherited; end; end; diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index c7f0eef25..4158097bf 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -3316,6 +3316,11 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; 'SHOW CHARSET', '' ); + qGetRowCountApprox: Result := IfThen( + FNetType <> ntMySQL_ProxySQLAdmin, + 'SHOW TABLE STATUS LIKE :EscapedName', + '' + ); else Result := inherited; end; end; diff --git a/source/dbstructures.pas b/source/dbstructures.pas index 0bb59292e..2c5630bc6 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -36,6 +36,7 @@ interface TNetTypeLibs = TDictionary; // SQL query ids and provider + TStringMap = TDictionary; TQueryId = (qDatabaseTable, qDatabaseTableId, qDatabaseDrop, qDbObjectsTable, qDbObjectsCreateCol, qDbObjectsUpdateCol, qDbObjectsTypeCol, qEmptyTable, qRenameTable, qRenameView, qCurrentUserHost, qLikeCompare, @@ -45,7 +46,7 @@ interface qUSEQuery, qKillQuery, qKillProcess, qFuncLength, qFuncCeil, qFuncLeft, qFuncNow, qFuncLastAutoIncNumber, qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks, - qOrderAsc, qOrderDesc, + qOrderAsc, qOrderDesc, qGetRowCountExact, qGetRowCountApprox, qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets); TSqlProvider = class strict protected @@ -54,8 +55,12 @@ TSqlProvider = class public constructor Create(ANetType: TNetType); function Has(AId: TQueryId): Boolean; + // Base version, just returns the original SQL string function GetSql(AId: TQueryId): string; overload; virtual; + // Version for simple strings passed to Format() function GetSql(AId: TQueryId; const Args: array of const): string; overload; + // Version for named parameters + function GetSql(AId: TQueryId; NamedParameters: TStringMap): string; overload; property ServerVersion: Integer read FServerVersion write FServerVersion; end; @@ -203,6 +208,7 @@ function TSqlProvider.GetSql(AId: TQueryId): string; qForeignKeyEventAction: Result := 'RESTRICT,CASCADE,SET NULL,NO ACTION'; qOrderAsc: Result := 'ASC'; qOrderDesc: Result := 'DESC'; + qGetRowCountExact: Result := 'SELECT COUNT(*) FROM :QuotedDbAndTableName'; else Result := ''; end; end; @@ -210,10 +216,22 @@ function TSqlProvider.GetSql(AId: TQueryId): string; function TSqlProvider.GetSql(AId: TQueryId; const Args: array of const): string; begin Result := GetSql(AId); - if not Result.IsEmpty then - Result := Format(Result, Args); + if Result.IsEmpty then + Exit; + Result := Format(Result, Args); end; +function TSqlProvider.GetSql(AId: TQueryId; NamedParameters: TStringMap): string; +var + Key: String; +begin + Result := GetSql(AId); + if Result.IsEmpty then + Exit; + for Key in NamedParameters.Keys do begin + Result := StringReplace(Result, ':'+Key, NamedParameters[Key], [rfReplaceAll]); + end; +end; diff --git a/source/dbstructures.postgresql.pas b/source/dbstructures.postgresql.pas index 31cc1abe2..cb71fca6c 100644 --- a/source/dbstructures.postgresql.pas +++ b/source/dbstructures.postgresql.pas @@ -709,6 +709,11 @@ function TPostgreSQLProvider.GetSql(AId: TQueryId): string; '(SELECT conforencoding AS enc FROM pg_catalog.pg_conversion '+ ' UNION '+ ' SELECT contoencoding AS enc FROM pg_catalog.pg_conversion) AS x'; + qGetRowCountApprox: Result := 'SELECT reltuples::bigint FROM pg_class'+ + ' LEFT JOIN pg_namespace ON pg_namespace.oid = pg_class.relnamespace'+ + ' WHERE pg_class.relkind=''r'''+ + ' AND pg_namespace.nspname=:EscapedDatabase'+ + ' AND pg_class.relname=:EscapedName'; else Result := inherited; end; end; From dcebcc64171304ff06ba0334de1164f9c6514485 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Thu, 19 Feb 2026 15:48:29 +0100 Subject: [PATCH 025/170] enhance: export tables which are hidden through the table filter Closes #1983 --- source/tabletools.pas | 25 ++++++++++++++----------- 1 file changed, 14 insertions(+), 11 deletions(-) diff --git a/source/tabletools.pas b/source/tabletools.pas index 388d5b59d..29c175167 100644 --- a/source/tabletools.pas +++ b/source/tabletools.pas @@ -179,7 +179,7 @@ TfrmTableTools = class(TExtForm) FHeaderCreated: Boolean; FFindSeeResultSQL: TStringList; ToFile, ToDir, ToClipboard, ToDb, ToServer: Boolean; - FObjectSizes, FObjectSizesDone, FObjectSizesDoneExact: Int64; + FObjectCount, FObjectSizes, FObjectSizesDone, FObjectSizesDoneExact: Int64; FStartTimeAll: Cardinal; procedure WMNCLBUTTONDOWN(var Msg: TWMNCLButtonDown) ; message WM_NCLBUTTONDOWN; procedure WMNCLBUTTONUP(var Msg: TWMNCLButtonUp) ; message WM_NCLBUTTONUP; @@ -404,6 +404,7 @@ procedure TfrmTableTools.FormShow(Sender: TObject); TreeObjects.RootNodeCount := Mainform.DBtree.RootNodeCount; FObjectSizes := 0; + FObjectCount := 0; // Init all objects in active database, so the tree does not just check the db node // if we want the first child only. See issue #2267. @@ -647,7 +648,7 @@ procedure TfrmTableTools.ValidateControls(Sender: TObject); SomeChecked := TreeObjects.CheckedCount > 0; TExtForm.PageControlTabHighlight(tabsTools); btnSeeResults.Visible := tabsTools.ActivePage = tabFind; - lblCheckedSize.Caption := f_('Selected objects size: %s', [FormatByteNumber(FObjectSizes)]); + lblCheckedSize.Caption := f_('%s selected objects, size: %s', [FObjectCount.ToString, FormatByteNumber(FObjectSizes)]); menuExportOptionClick(Sender); if tabsTools.ActivePage = tabMaintenance then begin btnExecute.Caption := _('Execute'); @@ -831,7 +832,7 @@ function TfrmTableTools.GetCheckedObjects(DBNode: PVirtualNode): TDBObjectList; // Return list with checked objects from database node // The caller doesn't need to care whether type grouping in tree is activated Result := TDBObjectList.Create(False); - Child := TreeObjects.GetFirstVisibleChild(DBNode); + Child := TreeObjects.GetFirstChild(DBNode); while Assigned(Child) do begin if Child.CheckState in CheckedStates then begin ChildObj := TreeObjects.GetNodeData(Child); @@ -839,13 +840,13 @@ function TfrmTableTools.GetCheckedObjects(DBNode: PVirtualNode): TDBObjectList; case ChildObj.NodeType of lntGroup: begin - GrandChild := TreeObjects.GetFirstVisibleChild(Child); + GrandChild := TreeObjects.GetFirstChild(Child); while Assigned(GrandChild) do begin if GrandChild.CheckState in CheckedStates then begin GrandChildObj := TreeObjects.GetNodeData(GrandChild); Result.Add(GrandChildObj^); end; - GrandChild := TreeObjects.GetNextVisibleSibling(GrandChild); + GrandChild := TreeObjects.GetNextSibling(GrandChild); end; end @@ -855,7 +856,7 @@ function TfrmTableTools.GetCheckedObjects(DBNode: PVirtualNode): TDBObjectList; end; end; - Child := TreeObjects.GetNextVisibleSibling(Child); + Child := TreeObjects.GetNextSibling(Child); end; end; @@ -942,7 +943,7 @@ procedure TfrmTableTools.Execute(Sender: TObject); SessionNode := TreeObjects.GetFirstChild(nil); while Assigned(SessionNode) do begin - DBNode := TreeObjects.GetFirstVisibleChild(SessionNode); + DBNode := TreeObjects.GetFirstChild(SessionNode); while Assigned(DBNode) do begin if not (DBNode.CheckState in [csUncheckedNormal, csUncheckedPressed]) then begin Triggers.Clear; @@ -979,7 +980,7 @@ procedure TfrmTableTools.Execute(Sender: TObject); end; if FCancelled then Break; - DBNode := TreeObjects.GetNextVisibleSibling(DBNode); + DBNode := TreeObjects.GetNextSibling(DBNode); end; // End of db item loop if FCancelled then Break; SessionNode := TreeObjects.GetNextSibling(SessionNode); @@ -1444,18 +1445,20 @@ procedure TfrmTableTools.timerCalcSizeTimer(Sender: TObject); timerCalcSize.Enabled := False; SessionNode := TreeObjects.GetFirstChild(nil); FObjectSizes := 0; + FObjectCount := 0; while Assigned(SessionNode) do begin - DBNode := TreeObjects.GetFirstVisibleChild(SessionNode); + DBNode := TreeObjects.GetFirstChild(SessionNode); while Assigned(DBNode) do begin if not (DBNode.CheckState in [csUncheckedNormal, csUncheckedPressed]) then begin CheckedObjects := GetCheckedObjects(DBNode); for DBObj in CheckedObjects do begin Inc(FObjectSizes, DBObj.Size); + Inc(FObjectCount); end; end; - DBNode := TreeObjects.GetNextVisibleSibling(DBNode); + DBNode := TreeObjects.GetNextSibling(DBNode); end; - SessionNode := TreeObjects.GetNextVisibleSibling(SessionNode); + SessionNode := TreeObjects.GetNextSibling(SessionNode); end; ValidateControls(Sender); end; From 84b12add156eeeba22843d6dadcad0b0d47e9e16 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Thu, 19 Feb 2026 15:56:21 +0100 Subject: [PATCH 026/170] fix: out-of-memory error in call to sqlite3_open() on a non-existent SQLite database file Closes #1367 --- source/dbconnection.pas | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index fa456df1c..fc84ac311 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -2980,6 +2980,10 @@ procedure TSQLiteConnection.SetActive(Value: Boolean); MainFile := IfThen(FileNames.Count>=1, FileNames[0], ''); if Value then begin + // Fixes "out of memory" crash in sqlite3_open, see issue #1367 + if not FileExists(MainFile) then + raise EDbError.Create(f_('File does not exist: %s', [MainFile])); + DoBeforeConnect; ConnectResult := FLib.sqlite3_open( From 86d956fad13b197ad171be4eb851ba5a80631aea Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Thu, 19 Feb 2026 16:06:14 +0100 Subject: [PATCH 027/170] feat: support BOOLEAN column type in MySQL Closes #1541 --- source/dbstructures.mysql.pas | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index 4158097bf..d03109998 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -331,7 +331,7 @@ TMySqlProvider = class(TSqlProvider) // MySQL Data Type List and Properties - MySQLDatatypes: array [0..41] of TDBDatatype = + MySQLDatatypes: array [0..42] of TDBDatatype = ( ( Index: dbdtUnknown; @@ -360,6 +360,19 @@ TMySqlProvider = class(TSqlProvider) LoadPart: False; Category: dtcInteger; ), + ( + Index: dbdtBool; + NativeType: 1; + Name: 'BOOLEAN'; + Description: 'Synonym of TINYINT(1)'; + HasLength: False; + RequiresLength: False; + MaxSize: 127; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), ( Index: dbdtSmallint; NativeType: 2; From 626288048641004876708e23da2b1112dc51f5bb Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Thu, 19 Feb 2026 16:47:19 +0100 Subject: [PATCH 028/170] fix: repaint columns list after move up/down a column Was reported in the forum: https://www.heidisql.com/forum.php?t=44760 --- source/table_editor.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/source/table_editor.pas b/source/table_editor.pas index a11e09242..480861a59 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -1369,6 +1369,7 @@ procedure TfrmTableEditor.ValidateColumnControls; menuRemoveColumn.Enabled := btnRemoveColumn.Enabled; menuMoveUpColumn.Enabled := btnMoveUpColumn.Enabled; menuMoveDownColumn.Enabled := btnMoveDownColumn.Enabled; + listColumns.Invalidate; end; From 7d207a412e10500a23e4c6646b85d0fc7f294293 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 20 Feb 2026 14:55:01 +0100 Subject: [PATCH 029/170] fix: high CPU load and unresponsiveness through SynEdit highlighter when starting to edit large text in popup editor Refs #2388 --- source/grideditlinks.pas | 2 +- source/texteditor.pas | 10 ++++++++-- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/source/grideditlinks.pas b/source/grideditlinks.pas index 1ca872961..4a1a6ce07 100644 --- a/source/grideditlinks.pas +++ b/source/grideditlinks.pas @@ -1189,7 +1189,7 @@ function TInplaceEditorLink.BeginEdit: Boolean; if Result then begin FButton.Visible := ButtonVisible; SetBounds(Rect(0, 0, 0, 0)); - if (Length(FEdit.Text) > SIZE_KB) or (ScanLineBreaks(FEdit.Text) <> lbsNone) then + if (Length(FEdit.Text) >= GRIDMAXDATA) or (ScanLineBreaks(FEdit.Text) <> lbsNone) then ButtonClick(FTree) else begin FPanel.Show; diff --git a/source/texteditor.pas b/source/texteditor.pas index bee02835f..8f7798382 100644 --- a/source/texteditor.pas +++ b/source/texteditor.pas @@ -142,11 +142,15 @@ procedure TfrmTextEditor.SetText(text: String); end; if Assigned(Detected) then SelectLineBreaks(Detected); - if (Length(text) > SIZE_MB) then begin - MainForm.LogSQL(_('Auto-disabling wordwrap for large text')); + if (Length(text) > SIZE_KB*10) then begin + MainForm.LogSQL(_('Auto-disabling wordwrap and syntax highlighter for large text')); btnWrap.Enabled := False; + comboHighlighter.Enabled := False; + btnCustomizeHighlighter.Enabled := False; end else begin btnWrap.Enabled := True; + comboHighlighter.Enabled := True; + btnCustomizeHighlighter.Enabled := True; end; MemoText.Text := text; @@ -380,6 +384,8 @@ procedure TfrmTextEditor.comboHighlighterSelect(Sender: TObject); SelStart, SelLength: Integer; begin // Code highlighter selected + if not comboHighlighter.Enabled then + Exit; SelStart := MemoText.SelStart; SelLength := MemoText.SelLength; MemoText.Highlighter := nil; From 85dd9847f8b4698a7a3292266f21a74c3e216795 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 22 Feb 2026 14:50:32 +0100 Subject: [PATCH 030/170] fix: non stored global setting for "sort alphabetically" checkbox in column selection --- source/column_selection.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/source/column_selection.pas b/source/column_selection.pas index 087e7bb4e..4dfaddbe4 100644 --- a/source/column_selection.pas +++ b/source/column_selection.pas @@ -89,6 +89,7 @@ procedure TfrmColumnSelection.btnOKClick(Sender: TObject); i: Integer; Col: String; begin + AppSettings.WriteBool(asDisplayedColumnsSorted, chkSort.Checked); AppSettings.WriteBool(asShowRowId, chkShowRowId.Checked); // Prepare string for storing in registry. // Use quote-character as separator to ensure columnnames can From 44ce3527f06d368e57ee4e7adf99318db9eb4351 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 22 Feb 2026 16:15:27 +0100 Subject: [PATCH 031/170] feat: add "Display" main menu, move some spread items there, and add two items for toggling log panel and tree filters Refs #1891 --- source/apphelpers.pas | 4 ++- source/main.dfm | 53 +++++++++++++++++++++++++++----- source/main.pas | 71 ++++++++++++++++++++++++++++++++----------- 3 files changed, 102 insertions(+), 26 deletions(-) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index de1e85586..54cf019f1 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -236,7 +236,7 @@ TWinControlHelper = class helper for TWinControl asCreateDbCollation, asRealTrailingZeros, asSequalSuggestWindowWidth, asSequalSuggestWindowHeight, asSequalSuggestPrompt, asSequalSuggestRecentPrompts, asReformatter, asReformatterNoDialog, asAlwaysGenerateFilter, - asGenerateDataNumRows, asGenerateDataNullAmount, asWebOnceAction, + asGenerateDataNumRows, asGenerateDataNullAmount, asWebOnceAction, asDisplayLogPanel, asDisplayTreeFilters, asUnused); TAppSetting = record Name: String; @@ -4112,6 +4112,8 @@ constructor TAppSettings.Create; InitSetting(asRowBackgroundOdd, 'RowBackgroundOdd', clNone); InitSetting(asGroupTreeObjects, 'GroupTreeObjects', 0, False); InitSetting(asDisplayObjectSizeColumn, 'DisplayObjectSizeColumn', 0, True); + InitSetting(asDisplayLogPanel, 'DisplayLogPanel', 0, True); + InitSetting(asDisplayTreeFilters, 'DisplayTreeFilters', 0, True); InitSetting(asActionShortcut1, 'Shortcut1_%s', 0); InitSetting(asActionShortcut2, 'Shortcut2_%s', 0); InitSetting(asHighlighterForeground, 'SQL Attr %s Foreground', 0); diff --git a/source/main.dfm b/source/main.dfm index 6b063f13b..cf589bdbf 100644 --- a/source/main.dfm +++ b/source/main.dfm @@ -1886,10 +1886,35 @@ object MainForm: TMainForm object Inverseselection1: TMenuItem Action = actSelectInverse end - object actFindInVT1: TMenuItem + end + object MainMenuDisplay: TMenuItem + Caption = 'Display' + object menuDisplaysizeofobjects1: TMenuItem + Action = actDisplayObjectSize + AutoCheck = True + end + object menuShowonlyfavorites1: TMenuItem + Action = actFavoriteObjectsOnly + AutoCheck = True + end + object menuFilterpanel1: TMenuItem Action = actFilterPanel AutoCheck = True end + object menuDisplayLogPanel1: TMenuItem + Action = actDisplayLogPanel + AutoCheck = True + end + object menuTreefilters1: TMenuItem + Action = actDisplayTreeFilters + AutoCheck = True + end + object N27: TMenuItem + Caption = '-' + end + object menuResetpaneldimensions1: TMenuItem + Action = actResetPanelDimensions + end end object MainMenuSearch: TMenuItem Caption = 'Search' @@ -2056,9 +2081,6 @@ object MainForm: TMainForm object N4: TMenuItem Caption = '-' end - object Resetpaneldimensions1: TMenuItem - Action = actResetPanelDimensions - end object MenuPreferences: TMenuItem Action = actPreferences end @@ -2831,7 +2853,6 @@ object MainForm: TMainForm AutoCheck = True Caption = 'Filter panel' Hint = 'Activates the filter panel' - ImageIndex = 30 ImageName = 'icons8-find' ShortCut = 49222 OnExecute = actFilterPanelExecute @@ -3386,6 +3407,24 @@ object MainForm: TMainForm ImageIndex = 57 OnExecute = actQueryTableExecute end + object actDisplayObjectSize: TAction + Category = 'Various' + AutoCheck = True + Caption = 'Display size of objects' + OnExecute = actDisplayObjectSizeExecute + end + object actDisplayLogPanel: TAction + Category = 'Various' + AutoCheck = True + Caption = 'Log panel' + OnExecute = actDisplayLogPanelExecute + end + object actDisplayTreeFilters: TAction + Category = 'Various' + AutoCheck = True + Caption = 'Tree filters' + OnExecute = actDisplayTreeFiltersExecute + end end object menuConnections: TPopupMenu AutoHotkeys = maManual @@ -3499,8 +3538,8 @@ object MainForm: TMainForm AutoCheck = True end object menuShowSizeColumn: TMenuItem - Caption = 'Display size of objects' - OnClick = menuShowSizeColumnClick + Action = actDisplayObjectSize + AutoCheck = True end object menuAutoExpand: TMenuItem Caption = 'Auto expand on click' diff --git a/source/main.pas b/source/main.pas index 33ec65d93..af0cfb4dd 100644 --- a/source/main.pas +++ b/source/main.pas @@ -503,7 +503,6 @@ TMainForm = class(TExtForm) pnlRight: TPanel; btnCloseFilterPanel: TSpeedButton; actFilterPanel: TAction; - actFindInVT1: TMenuItem; TimerFilterVT: TTimer; actFindTextOnServer: TAction; actFindTextOnServer1: TMenuItem; @@ -789,7 +788,6 @@ TMainForm = class(TExtForm) ToolBarDonate: TToolBar; btnDonate: TToolButton; actResetPanelDimensions: TAction; - Resetpaneldimensions1: TMenuItem; popupApplyFilter: TPopupMenu; menuAlwaysGenerateFilter: TMenuItem; actGenerateData: TAction; @@ -799,6 +797,17 @@ TMainForm = class(TExtForm) actCopyGridNodes1: TMenuItem; actQueryTable: TAction; Selecttop1000rows1: TMenuItem; + MainMenuDisplay: TMenuItem; + actDisplayObjectSize: TAction; + menuDisplaysizeofobjects1: TMenuItem; + menuShowonlyfavorites1: TMenuItem; + menuFilterpanel1: TMenuItem; + menuResetpaneldimensions1: TMenuItem; + actDisplayLogPanel: TAction; + actDisplayTreeFilters: TAction; + menuDisplayLogPanel1: TMenuItem; + menuTreefilters1: TMenuItem; + N27: TMenuItem; procedure actCreateDBObjectExecute(Sender: TObject); procedure menuConnectionsPopup(Sender: TObject); procedure actExitApplicationExecute(Sender: TObject); @@ -957,7 +966,7 @@ TMainForm = class(TExtForm) procedure AnyGridAfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); - procedure menuShowSizeColumnClick(Sender: TObject); + procedure actDisplayObjectSizeExecute(Sender: TObject); procedure AnyGridBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); @@ -1202,6 +1211,8 @@ TMainForm = class(TExtForm) var HintText: string); procedure actCopyGridNodesExecute(Sender: TObject); procedure actQueryTableExecute(Sender: TObject); + procedure actDisplayLogPanelExecute(Sender: TObject); + procedure actDisplayTreeFiltersExecute(Sender: TObject); private // Executable file details FAppVerMajor, FAppVerMinor, FAppVerRelease, FAppVerRevision: Word; @@ -2073,10 +2084,14 @@ procedure TMainForm.FormCreate(Sender: TObject); DataGridTable := nil; FActiveDbObj := nil; - // Database tree options + // Display options, and database tree options actGroupObjects.Checked := AppSettings.ReadBool(asGroupTreeObjects); - if AppSettings.ReadBool(asDisplayObjectSizeColumn) then - menuShowSizeColumn.Click; + actDisplayObjectSize.Checked := AppSettings.ReadBool(asDisplayObjectSizeColumn); + actDisplayObjectSizeExecute(nil); + actDisplayLogPanel.Checked := AppSettings.ReadBool(asDisplayLogPanel); + actDisplayLogPanelExecute(nil); + actDisplayTreeFilters.Checked := AppSettings.ReadBool(asDisplayTreeFilters); + actDisplayTreeFiltersExecute(nil); if AppSettings.ReadBool(asAutoExpand) then menuAutoExpand.Click; if AppSettings.ReadBool(asDoubleClickInsertsNodeText) then @@ -11114,20 +11129,43 @@ procedure TMainForm.AnyGridCreateEditor(Sender: TBaseVirtualTree; Node: end; -procedure TMainForm.menuShowSizeColumnClick(Sender: TObject); +procedure TMainForm.actDisplayLogPanelExecute(Sender: TObject); +begin + if actDisplayLogPanel.Checked then begin + SynMemoSQLLog.Visible := True; + spltTopBottom.Visible := True; + // ensure z-order: top panel, splitter, memo + spltTopBottom.BringToFront; + SynMemoSQLLog.BringToFront; + end + else begin + spltTopBottom.Visible := False; + SynMemoSQLLog.Visible := False; + end; + AppSettings.ResetPath; + AppSettings.WriteBool(asDisplayLogPanel, actDisplayLogPanel.Checked); +end; + +procedure TMainForm.actDisplayObjectSizeExecute(Sender: TObject); var - Item: TMenuItem; + ColOptions: TVTColumnOptions; begin - if coVisible in DBtree.Header.Columns[1].Options then - DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options - [coVisible] + ColOptions := DBtree.Header.Columns[1].Options; + if actDisplayObjectSize.Checked then + ColOptions := ColOptions + [coVisible] else - DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options + [coVisible]; - Item := Sender as TMenuItem; - Item.Checked := coVisible in DBtree.Header.Columns[1].Options; + ColOptions := ColOptions - [coVisible]; + DBtree.Header.Columns[1].Options := ColOptions; AppSettings.ResetPath; - AppSettings.WriteBool(asDisplayObjectSizeColumn, Item.Checked); + AppSettings.WriteBool(asDisplayObjectSizeColumn, actDisplayObjectSize.Checked); end; +procedure TMainForm.actDisplayTreeFiltersExecute(Sender: TObject); +begin + ToolBarTree.Visible := actDisplayTreeFilters.Checked; + AppSettings.ResetPath; + AppSettings.WriteBool(asDisplayTreeFilters, actDisplayTreeFilters.Checked); +end; procedure TMainForm.menuAlwaysGenerateFilterClick(Sender: TObject); begin @@ -12768,10 +12806,7 @@ procedure TMainForm.actFavoriteObjectsOnlyExecute(Sender: TObject); begin // Click on "tree favorites" main button editDatabaseTableFilterChange(Sender); - if actFavoriteObjectsOnly.Checked then - actFavoriteObjectsOnly.ImageIndex := 112 - else - actFavoriteObjectsOnly.ImageIndex := 113; + actFavoriteObjectsOnly.ImageIndex := IfThen(actFavoriteObjectsOnly.Checked, 112, 113); end; From fee5807426342eb22861ffd6fc1194e6da4b1918 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 22 Feb 2026 19:16:48 +0100 Subject: [PATCH 032/170] enhance: more exact hint for issue field --- .github/ISSUE_TEMPLATE/bug_report.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/ISSUE_TEMPLATE/bug_report.yml b/.github/ISSUE_TEMPLATE/bug_report.yml index 716732d1b..386650a72 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.yml +++ b/.github/ISSUE_TEMPLATE/bug_report.yml @@ -11,8 +11,8 @@ body: - type: input id: heidisql_version attributes: - label: HeidiSQL version - placeholder: "Example: 12.8.0.6908" + label: HeidiSQL version and OS + placeholder: "Example: 12.15 Linux GTK2" validations: required: true - type: input From af9a73c13e0f8e2fc99a661b8dc1fdb62222571a Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 22 Feb 2026 20:06:08 +0100 Subject: [PATCH 033/170] fix: wrong tree filter box widths after hide > resize > show Refs #1891 --- source/main.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/source/main.pas b/source/main.pas index af0cfb4dd..40c60044f 100644 --- a/source/main.pas +++ b/source/main.pas @@ -11163,6 +11163,7 @@ procedure TMainForm.actDisplayObjectSizeExecute(Sender: TObject); procedure TMainForm.actDisplayTreeFiltersExecute(Sender: TObject); begin ToolBarTree.Visible := actDisplayTreeFilters.Checked; + pnlLeftResize(Sender); // Updates width of filter boxes AppSettings.ResetPath; AppSettings.WriteBool(asDisplayTreeFilters, actDisplayTreeFilters.Checked); end; From 05886c43dafe1013c5edfdd428b90be9ba8095c0 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 22 Feb 2026 20:18:07 +0100 Subject: [PATCH 034/170] enhance: add note about deprecated Wine usage and native builds in update check dialog --- source/updatecheck.pas | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/source/updatecheck.pas b/source/updatecheck.pas index 7ad250f03..8da84a78d 100644 --- a/source/updatecheck.pas +++ b/source/updatecheck.pas @@ -165,7 +165,10 @@ procedure TfrmUpdateCheck.ReadCheckFile; ReleasePackage := IfThen(AppSettings.PortableMode, 'portable', 'installer'); memoRelease.Lines.Add(f_('Version %s (yours: %s)', [ReleaseVersion, Mainform.AppVersion])); memoRelease.Lines.Add(f_('Released: %s', [Ini.ReadString(INISECT_RELEASE, 'Date', '')])); - Note := Ini.ReadString(INISECT_RELEASE, 'Note', ''); + if IsWine then + Note := _('Wine support is deprecated. Future versions will not work reliably. Use the native Linux or macOS releases instead.') + else + Note := Ini.ReadString(INISECT_RELEASE, 'Note', ''); if Note <> '' then memoRelease.Lines.Add(_('Notes') + ': ' + Note); From 4837405f195eb23c8ddbf26665dd88fa3da96bed Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 23 Feb 2026 13:33:28 +0100 Subject: [PATCH 035/170] fix: several crash causes Host subtabs when connection is lost externally This also changes the dodgy default text "Node" in any VirtualTree's cell to "-" Refs #1875 --- source/apphelpers.pas | 1 + source/main.pas | 14 ++++++++++---- 2 files changed, 11 insertions(+), 4 deletions(-) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 54cf019f1..9653d3e30 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -1532,6 +1532,7 @@ procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1); VT.EndUpdate; VT.TextMargin := 6; VT.Margin := 2; + VT.DefaultText := '-'; // "Node" by default // Disable hottracking in non-Vista mode, looks ugly in XP, but nice in Vista if (toUseExplorerTheme in VT.TreeOptions.PaintOptions) and (Win32MajorVersion >= 6) then VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions + [toHotTrack] diff --git a/source/main.pas b/source/main.pas index 40c60044f..8cf3e2da3 100644 --- a/source/main.pas +++ b/source/main.pas @@ -9456,6 +9456,8 @@ procedure TMainForm.HostListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtu if Sender = ListProcesses then begin Idx := Sender.GetNodeData(Node); Results := GridResult(Sender); + if not Results.Connection.Active then + Exit; Results.RecNo := Idx^; case Kind of ikNormal, ikSelected: begin @@ -9500,11 +9502,15 @@ procedure TMainForm.HostListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode begin Idx := Sender.GetNodeData(Node); Results := GridResult(Sender); - // See issue #3416 - if (Results = nil) and (Sender <> ListVariables) then - Exit; - if Results <> nil then + + // See issue #3416. Note: ListVariables does not depend on a live result, but on a StringList. + if Sender <> ListVariables then begin + // See issue #1875 + if (Results = nil) or (not Results.Connection.Active) then + Exit; Results.RecNo := Idx^; + end; + if (Sender = ListStatus) and (Column in [1,2,3]) then begin CellText := Results.Col(1); From eb5a3a551b6fee369fd98c0436877583c497888a Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 23 Feb 2026 14:05:34 +0100 Subject: [PATCH 036/170] feat: run user startup script in DoAfterConnect call, which includes reconnects Refs #1896 --- source/dbconnection.pas | 21 +++++++++++++++++++++ source/main.pas | 22 +--------------------- 2 files changed, 22 insertions(+), 21 deletions(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index fc84ac311..f10d58af8 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -3375,6 +3375,9 @@ procedure TDBConnection.DoAfterConnect; var SQLFunctionsFileOrder: String; MajorMinorVer, MajorVer: String; + StartupScript: String; + StartupBatch: TSQLBatch; + SqlQuery: TSQLSentence; begin FSqlProvider.ServerVersion := ServerVersionInt; AppSettings.SessionPath := FParameters.SessionPath; @@ -3408,6 +3411,24 @@ procedure TDBConnection.DoAfterConnect; else SQLFunctionsFileOrder := ''; FSQLFunctions := TSQLFunctionList.Create(Self, SQLFunctionsFileOrder); + + // Process startup script + StartupScript := Trim(FParameters.StartupScriptFilename); + if StartupScript <> '' then begin + StartupScript := ExpandFileName(StartupScript); + if not FileExists(StartupScript) then + Log(lcError, f_('Startup script file not found: %s', [StartupScript])) + else begin + StartupBatch := TSQLBatch.Create(FParameters.NetTypeGroup); + StartupBatch.SQL := ReadTextfile(StartupScript, nil); + for SqlQuery in StartupBatch do try + Query(SqlQuery.SQL); + except + // Suppress popup, errors get logged into SQL log + end; + StartupBatch.Free; + end; + end; end; diff --git a/source/main.pas b/source/main.pas index 8cf3e2da3..117db9a1c 100644 --- a/source/main.pas +++ b/source/main.pas @@ -4336,9 +4336,7 @@ procedure TMainForm.SessionConnect(Sender: TObject); function TMainform.InitConnection(Params: TConnectionParameters; ActivateMe: Boolean; var Connection: TDBConnection): Boolean; var RestoreLastActiveDatabase: Boolean; - StartupScript, LastActiveDatabase: String; - StartupBatch: TSQLBatch; - Query: TSQLSentence; + LastActiveDatabase: String; SessionNode, DBNode: PVirtualNode; begin Connection := Params.CreateConnection(Self); @@ -4381,24 +4379,6 @@ function TMainform.InitConnection(Params: TConnectionParameters; ActivateMe: Boo end; end; - // Process startup script - StartupScript := Trim(Connection.Parameters.StartupScriptFilename); - if StartupScript <> '' then begin - StartupScript := ExpandFileName(StartupScript); - if not FileExists(StartupScript) then - ErrorDialog(f_('Startup script file not found: %s', [StartupScript])) - else begin - StartupBatch := TSQLBatch.Create(Connection.Parameters.NetTypeGroup); - StartupBatch.SQL := ReadTextfile(StartupScript, nil); - for Query in StartupBatch do try - Connection.Query(Query.SQL); - except - // Suppress popup, errors get logged into SQL log - end; - StartupBatch.Free; - end; - end; - if Params.WantSSL and not Connection.IsSSL then begin MessageDialog(_('SSL not used.'), _('Your SSL settings were not accepted by the server, or the server does not support any SSL configuration.'), From 401674177f2e64ebe6b244cc65d3897e21322ee4 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 23 Feb 2026 17:33:51 +0100 Subject: [PATCH 037/170] feat: inject app name and version into potentially long during SQL queries for the SQL export Refs #1988 --- source/tabletools.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/tabletools.pas b/source/tabletools.pas index 29c175167..1980778d9 100644 --- a/source/tabletools.pas +++ b/source/tabletools.pas @@ -2092,7 +2092,7 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); Data := DBObj.Connection.GetResults( DBObj.Connection.ApplyLimitClause( 'SELECT', - '* FROM '+DBObj.QuotedDbAndTableName + OrderBy, + '/* '+APPNAME+' '+MainForm.AppVersion+' */ * FROM '+DBObj.QuotedDbAndTableName + OrderBy, Limit, Offset) ); From 9fb90d1fcbdcf5587234fb7155c5ad7efb4fb03a Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 25 Feb 2026 19:44:33 +0100 Subject: [PATCH 038/170] feat: prevent loading an SQL file multiple times into an editor Shows an information dialog when a loaded file is being selected again through the various load-file mechanism: load-file dialog, recent files menu, dropping on editor, passing on command line Refs #1403 --- source/main.pas | 93 +++++++++++++++++++++++++++---------------------- 1 file changed, 52 insertions(+), 41 deletions(-) diff --git a/source/main.pas b/source/main.pas index 117db9a1c..03adf0940 100644 --- a/source/main.pas +++ b/source/main.pas @@ -1309,6 +1309,7 @@ TMainForm = class(TExtForm) procedure SetSnippetFilenames; function TreeClickHistoryPrevious(MayBeNil: Boolean=False): PVirtualNode; procedure OperationRunning(Runs: Boolean); + procedure OpenQueryFiles(Filenames: TStrings; Encoding: TEncoding; ForceRun: Boolean); function RunQueryFiles(Filenames: TStrings; Encoding: TEncoding; ForceRun: Boolean): Boolean; function RunQueryFile(Filename: String; Encoding: TEncoding; Conn: TDBConnection; ProgressDialog: IProgressDialog; FilesizeSum: Int64; var CurrentPosition: Int64): Boolean; @@ -2215,7 +2216,6 @@ procedure TMainForm.AfterFormCreate; StatsCall: THttpDownload; SessionPaths: TStringlist; DlgResult: TModalResult; - Tab: TQueryTab; SessionManager: TConnForm; begin if AppSettings.ReadBool(asUpdatecheck) then begin @@ -2350,14 +2350,7 @@ procedure TMainForm.AfterFormCreate; end; // Load SQL file(s) by command line - if not RunQueryFiles(FileNames, nil, false) then begin - for i:=0 to FileNames.Count-1 do begin - Tab := GetOrCreateEmptyQueryTab(False); - Tab.LoadContents(FileNames[i], True, nil); - if i = FileNames.Count-1 then - SetMainTab(Tab.TabSheet); - end; - end; + OpenQueryFiles(FileNames, nil, False); MainFormAfterCreateDone := True; end; @@ -3980,10 +3973,9 @@ procedure TMainForm.actLaunchCommandlineExecute(Sender: TObject); // Load SQL-file, make sure that SheetQuery is activated procedure TMainForm.actLoadSQLExecute(Sender: TObject); var - i, ProceedResult: Integer; + ProceedResult: Integer; Dialog: TExtFileOpenDialog; Encoding: TEncoding; - Tab: TQueryTab; begin AppSettings.ResetPath; Dialog := TExtFileOpenDialog.Create(Self); @@ -4005,14 +3997,7 @@ procedure TMainForm.actLoadSQLExecute(Sender: TObject); end; if ProceedResult = mrYes then begin - if not RunQueryFiles(Dialog.Files, Encoding, Sender=actRunSQL) then begin - for i:=0 to Dialog.Files.Count-1 do begin - Tab := GetOrCreateEmptyQueryTab(False); - Tab.LoadContents(Dialog.Files[i], True, Encoding); - if i = Dialog.Files.Count-1 then - SetMainTab(Tab.TabSheet); - end; - end; + OpenQueryFiles(Dialog.Files, Encoding, Sender=actRunSQL); end; AppSettings.WriteInt(asFileDialogEncoding, Dialog.EncodingIndex, Self.Name); end; @@ -4020,6 +4005,51 @@ procedure TMainForm.actLoadSQLExecute(Sender: TObject); end; +procedure TMainForm.OpenQueryFiles(Filenames: TStrings; Encoding: TEncoding; ForceRun: Boolean); +var + Tab, FileInTab: TQueryTab; + FileHints: TStringList; + i: Integer; +begin + // Decides whether to run or load files, prevents duplicates etc. + if RunQueryFiles(Filenames, Encoding, ForceRun) then + Exit; + + FileHints := TStringList.Create; + + for i:=0 to Filenames.Count-1 do begin + + FileInTab := nil; + for Tab in QueryTabs do begin + if Tab.MemoFilename = Filenames[i] then begin + FileInTab := Tab; + FileHints.Add(f_('This file is already open in query tab #%d.', [FileInTab.Number]) + ' ' + ExtractFileName(Filenames[i])); + if i = Filenames.Count-1 then + SetMainTab(FileInTab.TabSheet); + Break; + end; + end; + + if not Assigned(FileInTab) then begin + Tab := GetOrCreateEmptyQueryTab(False); + Tab.LoadContents(Filenames[i], True, Encoding); + if i = Filenames.Count-1 then + SetMainTab(Tab.TabSheet); + end; + end; + + if not FileHints.IsEmpty then begin + if MainFormAfterCreateDone then + MessageDialog(FileHints.Text, mtInformation, [mbOK]) + else begin + for i:=0 to FileHints.Count-1 do + LogSQL(FileHints[i]); + end; + end; + FileHints.Free; +end; + + function TMainForm.RunQueryFiles(Filenames: TStrings; Encoding: TEncoding; ForceRun: Boolean): Boolean; var i, FilesProcessed: Integer; @@ -5245,7 +5275,6 @@ procedure TMainform.popupQueryLoadClick(Sender: TObject); Filename: String; FileList: TStringList; p: Integer; - Tab: TQueryTab; begin // Click on the popupQueryLoad Filename := (Sender as TMenuItem).Caption; @@ -5258,10 +5287,7 @@ procedure TMainform.popupQueryLoadClick(Sender: TObject); end; FileList := TStringList.Create; FileList.Add(Filename); - if not RunQueryFiles(FileList, nil, false) then begin - Tab := GetOrCreateEmptyQueryTab(True); - Tab.LoadContents(Filename, True, nil); - end; + OpenQueryFiles(FileList, nil, False); FileList.Free; end; @@ -7698,18 +7724,10 @@ procedure TMainForm.SynMemoQueryDragDrop(Sender, Source: TObject; X, procedure TMainForm.SynMemoQueryDropFiles(Sender: TObject; X, Y: Integer; AFiles: TUnicodeStrings); -var - i: Integer; - Tab: TQueryTab; begin // One or more files from explorer or somewhere else was dropped onto the // query-memo - load their contents into seperate tabs - if not RunQueryFiles(AFiles, nil, False) then begin - for i:=0 to AFiles.Count-1 do begin - Tab := GetOrCreateEmptyQueryTab(True); - Tab.LoadContents(AFiles[i], False, nil); - end; - end; + OpenQueryFiles(AFiles, nil, False); end; @@ -13822,9 +13840,7 @@ procedure TMainForm.actDataResetSortingExecute(Sender: TObject); procedure TMainForm.WMCopyData(var Msg: TWMCopyData); var - i: Integer; Connection: TDBConnection; - Tab: TQueryTab; ConnectionParams: TConnectionParameters; FileNames: TStringList; RunFrom: String; @@ -13834,12 +13850,7 @@ procedure TMainForm.WMCopyData(var Msg: TWMCopyData); LogSQL(f_('Preventing second application instance - disabled in %s > %s > %s.', [_('Tools'), _('Preferences'), _('General')]), lcInfo); ConnectionParams := nil; ParseCommandLine(ParamBlobToStr(Msg.CopyDataStruct.lpData), ConnectionParams, FileNames, RunFrom); - if not RunQueryFiles(FileNames, nil, False) then begin - for i:=0 to FileNames.Count-1 do begin - Tab := GetOrCreateEmptyQueryTab(True); - Tab.LoadContents(FileNames[i], True, nil); - end; - end; + OpenQueryFiles(FileNames, nil, False); if ConnectionParams <> nil then InitConnection(ConnectionParams, True, Connection); end else From 7d828d26b24927a1d457873e50cb984725dbeea5 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Thu, 26 Feb 2026 18:56:44 +0100 Subject: [PATCH 039/170] fix: crash when holding shift + arrow down then arrow up in last row of data grid Closes #1451 --- source/main.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/source/main.pas b/source/main.pas index 03adf0940..271196067 100644 --- a/source/main.pas +++ b/source/main.pas @@ -10921,9 +10921,9 @@ procedure TMainForm.AnyGridKeyDown(Sender: TObject; var Key: Word; Shift: TShift Key := 0; end; end; - VK_RETURN: if Assigned(g.FocusedNode) then g.EditNode(g.FocusedNode, g.FocusedColumn); - VK_DOWN: if g.FocusedNode = g.GetLast then actDataInsertExecute(actDataInsert); - VK_NEXT: if (g = DataGrid) and (g.FocusedNode = g.GetLast) then actDataShowNext.Execute; + VK_RETURN: if Assigned(g.FocusedNode) and (Shift=[]) then g.EditNode(g.FocusedNode, g.FocusedColumn); + VK_DOWN: if (g.FocusedNode = g.GetLast) and (Shift=[]) then actDataInsertExecute(actDataInsert); + VK_NEXT: if (g = DataGrid) and (g.FocusedNode = g.GetLast) and (Shift=[]) then actDataShowNext.Execute; end; end; From dbce6b5a0f022dbcf495f757bac2ad763ae136df Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 27 Feb 2026 15:17:13 +0100 Subject: [PATCH 040/170] fix: wrong SQL on MS SQL when renaming table per table editor Refs #1997 --- source/table_editor.pas | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/source/table_editor.pas b/source/table_editor.pas index 480861a59..d594347d8 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -523,7 +523,10 @@ function TfrmTableEditor.ApplyModifications: TModalResult; end; // Rename table if ObjectExists and (editName.Text <> DBObject.Name) then begin - Rename := DBObject.Connection.SqlProvider.GetSql(qRenameTable, [DBObject.QuotedName, DBObject.Connection.QuoteIdent(editName.Text)]); + Rename := DBObject.Connection.SqlProvider.GetSql(qRenameTable, [ + DBObject.QuotedName(True, False), + DBObject.Connection.QuoteIdent(editName.Text) + ]); DBObject.Connection.Query(Rename); DBObject.Connection.ShowWarnings; end; From b1ae97a843c92d892fc4548209cb3d37211fbd8f Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 27 Feb 2026 16:21:27 +0100 Subject: [PATCH 041/170] feat: add menu item Edit > Copy column names Refs #2055 --- source/main.dfm | 14 +++++++++---- source/main.pas | 56 ++++++++++++++++++++++++++++++++++++++++++++++++- 2 files changed, 65 insertions(+), 5 deletions(-) diff --git a/source/main.dfm b/source/main.dfm index cf589bdbf..b705afd8b 100644 --- a/source/main.dfm +++ b/source/main.dfm @@ -1859,6 +1859,9 @@ object MainForm: TMainForm object CopyItem: TMenuItem Action = actCopy end + object Copycolumnnames1: TMenuItem + Action = actCopyColumnNames + end object Copywithtabstospaces1: TMenuItem Action = actCopyTabsToSpaces end @@ -3425,6 +3428,12 @@ object MainForm: TMainForm Caption = 'Tree filters' OnExecute = actDisplayTreeFiltersExecute end + object actCopyColumnNames: TAction + Category = 'Various' + Caption = 'Copy column names' + ImageIndex = 3 + OnExecute = menuCopyColumnNamesClick + end end object menuConnections: TPopupMenu AutoHotkeys = maManual @@ -3960,12 +3969,9 @@ object MainForm: TMainForm end object popupListHeader: TVTHeaderPopupMenu Images = VirtualImageListMain + OnPopup = popupListHeaderPopup Left = 424 Top = 208 - object menuToggleAll: TMenuItem - Caption = 'Toggle visibility of all columns' - OnClick = menuToggleAllClick - end end object SynCompletionProposal: TSynCompletionProposal Options = [scoLimitToMatchedText, scoUseInsertList, scoUsePrettyText, scoUseBuiltInTimer, scoEndCharCompletion, scoCompleteWithTab, scoCompleteWithEnter] diff --git a/source/main.pas b/source/main.pas index 271196067..6f2566a2d 100644 --- a/source/main.pas +++ b/source/main.pas @@ -774,7 +774,6 @@ TMainForm = class(TExtForm) Copywithtabstospaces1: TMenuItem; Movelinedown1: TMenuItem; Movelineup1: TMenuItem; - menuToggleAll: TMenuItem; menuCloseTabOnDblClick: TMenuItem; Undo1: TMenuItem; actSequalSuggest: TAction; @@ -808,6 +807,8 @@ TMainForm = class(TExtForm) menuDisplayLogPanel1: TMenuItem; menuTreefilters1: TMenuItem; N27: TMenuItem; + actCopyColumnNames: TAction; + Copycolumnnames1: TMenuItem; procedure actCreateDBObjectExecute(Sender: TObject); procedure menuConnectionsPopup(Sender: TObject); procedure actExitApplicationExecute(Sender: TObject); @@ -827,6 +828,7 @@ TMainForm = class(TExtForm) procedure actTableToolsExecute(Sender: TObject); procedure actPrintListExecute(Sender: TObject); procedure actCopyTableExecute(Sender: TObject); + procedure popupListHeaderPopup(Sender: TObject); procedure ShowStatusMsg(Msg: String=''; PanelNr: Integer=6); procedure actExecuteQueryExecute(Sender: TObject); procedure actCreateDatabaseExecute(Sender: TObject); @@ -1190,6 +1192,7 @@ TMainForm = class(TExtForm) procedure FormBeforeMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer); procedure menuToggleAllClick(Sender: TObject); + procedure menuCopyColumnNamesClick(Sender: TObject); procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, NewDPI: Integer); procedure menuCloseTabOnDblClickClick(Sender: TObject); @@ -10364,6 +10367,29 @@ procedure TMainForm.menuToggleAllClick(Sender: TObject); end; +procedure TMainForm.menuCopyColumnNamesClick(Sender: TObject); +var + Grid: TVirtualStringTree; + Col: TColumnIndex; + List: TStringList; +begin + if Sender is TMenuItem then + Grid := PopupComponent(Sender) as TVirtualStringTree + else if Screen.ActiveControl is TVirtualStringTree then + Grid := Screen.ActiveControl as TVirtualStringTree + else + Exit; + + List := TStringList.Create; + Col := Grid.Header.Columns.GetFirstVisibleColumn(True); + while Col > NoColumn do begin + List.Add(Grid.Header.Columns[Col].Text); + Col := Grid.Header.Columns.GetNextVisibleColumn(Col); + end; + Clipboard.TryAsText := List.Text; + List.Free; +end; + procedure TMainForm.menuTreeCollapseAllClick(Sender: TObject); var n: PVirtualNode; @@ -13025,6 +13051,34 @@ procedure TMainForm.CloseButtonOnMouseUp(Sender: TObject; Button: TMouseButton; TimerCloseTabByButton.Enabled := True; end; +procedure TMainForm.popupListHeaderPopup(Sender: TObject); +var + Item: TMenuItem; + i: Integer; +const + CustomItemTag = 123; +begin + // Add a few items to the top of the grid's header context menu + for i:=popupListHeader.Items.Count-1 downto 0 do begin + Item := popupListHeader.Items[i]; + if Item.Tag = CustomItemTag then + Item.Free; + end; + + Item := TMenuItem.Create(popupListHeader); + Item.Tag := CustomItemTag; + Item.Caption := _('Toggle visibility of all columns'); + Item.OnClick := menuToggleAllClick; + popupListHeader.Items.Insert(0, Item); + + Item := TMenuItem.Create(popupListHeader); + Item.Tag := CustomItemTag; + Item.Caption := _('Copy column names'); + Item.OnClick := menuCopyColumnNamesClick; + Item.ImageIndex := actCopy.ImageIndex; + popupListHeader.Items.Insert(1, Item); +end; + procedure TMainForm.TimerCloseTabByButtonTimer(Sender: TObject); var From 0c900b415c0a8d9c442714a3ad1c01c478db0505 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 27 Feb 2026 16:38:29 +0100 Subject: [PATCH 042/170] fix: crash on right-click in empty area of query result grid Closes #2056 --- source/main.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/main.pas b/source/main.pas index 6f2566a2d..8962e8ff6 100644 --- a/source/main.pas +++ b/source/main.pas @@ -3666,7 +3666,7 @@ procedure TMainForm.actDataPreviewUpdate(Sender: TObject); // Enable or disable ImageView action Grid := ActiveGrid; (Sender as TAction).Enabled := (Grid <> nil) - and (Grid.FocusedColumn-1 <> NoColumn) + and (Grid.FocusedColumn > 0) // may be NoColumn/-1 or InvalidColumn/-2 and (GridResult(Grid).DataType(Grid.FocusedColumn-1).Category = dtcBinary) end; From d6742913d4c6ebabcc193f7a0e0549d4e0004d64 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sat, 28 Feb 2026 11:19:19 +0100 Subject: [PATCH 043/170] docs(ui): mark VCL styles as deprecated --- source/preferences.pas | 1 + 1 file changed, 1 insertion(+) diff --git a/source/preferences.pas b/source/preferences.pas index 6d89c46ff..292add865 100644 --- a/source/preferences.pas +++ b/source/preferences.pas @@ -541,6 +541,7 @@ procedure TfrmPreferences.FormCreate(Sender: TObject); comboTheme.Items.Add(Styles[i]); end; comboTheme.ItemIndex := comboTheme.Items.IndexOf(AppSettings.GetDefaultString(asTheme)); + lblTheme.Caption := lblTheme.Caption + ' ('+UpperCase(_('deprecated'))+')'; // Populate icon pack dropdown from image collections on main form comboIconPack.Items.Clear; From 844d9c36404a604e7b7efa73446cd396db004636 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sat, 28 Feb 2026 15:47:50 +0100 Subject: [PATCH 044/170] feat: reverse foreign keys on "Foreign keys" tab in table editor, including an option to toggle the new listing Refs #1825 --- source/apphelpers.pas | 3 +- source/dbstructures.mysql.pas | 6 ++ source/dbstructures.pas | 3 +- source/table_editor.dfm | 106 ++++++++++++++++++++++++---------- source/table_editor.pas | 86 ++++++++++++++++++++++++++- 5 files changed, 169 insertions(+), 35 deletions(-) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 9653d3e30..0480ecbd1 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -235,7 +235,7 @@ TWinControlHelper = class helper for TWinControl asThemePreviewWidth, asThemePreviewHeight, asThemePreviewTop, asThemePreviewLeft, asCreateDbCollation, asRealTrailingZeros, asSequalSuggestWindowWidth, asSequalSuggestWindowHeight, asSequalSuggestPrompt, asSequalSuggestRecentPrompts, - asReformatter, asReformatterNoDialog, asAlwaysGenerateFilter, + asReformatter, asReformatterNoDialog, asAlwaysGenerateFilter, asDisplayReverseForeignKeys, asGenerateDataNumRows, asGenerateDataNullAmount, asWebOnceAction, asDisplayLogPanel, asDisplayTreeFilters, asUnused); TAppSetting = record @@ -4053,6 +4053,7 @@ constructor TAppSettings.Create; InitSetting(asReformatter, 'Reformatter', 0); InitSetting(asReformatterNoDialog, 'ReformatterNoDialog', 0); InitSetting(asAlwaysGenerateFilter, 'AlwaysGenerateFilter', 0, False); + InitSetting(asDisplayReverseForeignKeys, 'DisplayReverseForeignKeys', 0, False); InitSetting(asGenerateDataNumRows, 'GenerateDataNumRows', 1000); InitSetting(asGenerateDataNullAmount, 'GenerateDataNullAmount', 10); diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index d03109998..5f8aa41d6 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -3334,6 +3334,12 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; 'SHOW TABLE STATUS LIKE :EscapedName', '' ); + qGetReverseForeignKeys: Result := 'SELECT DISTINCT'+ + ' k.TABLE_SCHEMA, k.TABLE_NAME'+ + ' FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE k'+ + ' WHERE'+ + ' REFERENCED_TABLE_SCHEMA = :EscapedDatabase AND'+ + ' REFERENCED_TABLE_NAME = :EscapedName'; else Result := inherited; end; end; diff --git a/source/dbstructures.pas b/source/dbstructures.pas index 2c5630bc6..6a58b5030 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -47,7 +47,8 @@ interface qFuncLength, qFuncCeil, qFuncLeft, qFuncNow, qFuncLastAutoIncNumber, qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks, qOrderAsc, qOrderDesc, qGetRowCountExact, qGetRowCountApprox, - qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets); + qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets, + qGetReverseForeignKeys); TSqlProvider = class strict protected FNetType: TNetType; diff --git a/source/table_editor.dfm b/source/table_editor.dfm index 16613b171..75cbbf6cf 100644 --- a/source/table_editor.dfm +++ b/source/table_editor.dfm @@ -37,7 +37,7 @@ object frmTableEditor: TfrmTableEditor ImageName = 'icons8-data-sheet-100' DesignSize = ( 686 - 121) + 120) object lblName: TLabel Left = 4 Top = 6 @@ -235,10 +235,10 @@ object frmTableEditor: TfrmTableEditor ImageName = 'icons8-lightning-bolt-100' object treeIndexes: TVirtualStringTree AlignWithMargins = True - Left = 69 + Left = 73 Top = 0 - Width = 614 - Height = 121 + Width = 610 + Height = 120 Margins.Top = 0 Margins.Bottom = 0 Align = alClient @@ -275,7 +275,7 @@ object frmTableEditor: TfrmTableEditor Options = [coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] Position = 0 Text = 'Name' - Width = 214 + Width = 226 end item Options = [coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] @@ -302,11 +302,11 @@ object frmTableEditor: TfrmTableEditor object tlbIndexes: TToolBar Left = 0 Top = 0 - Width = 66 - Height = 121 + Width = 70 + Height = 120 Align = alLeft AutoSize = True - ButtonWidth = 66 + ButtonWidth = 70 Caption = 'tlbIndexes' Images = MainForm.VirtualImageListMain List = True @@ -367,14 +367,23 @@ object frmTableEditor: TfrmTableEditor Caption = 'Foreign keys' ImageIndex = 136 ImageName = 'icons8-data-grid-relation' + object spltForeignKeyListings: TSplitter + Left = 573 + Top = 0 + Height = 120 + Align = alRight + Visible = False + ExplicitLeft = 494 + ExplicitTop = -3 + end object tlbForeignKeys: TToolBar Left = 0 Top = 0 - Width = 66 - Height = 121 + Width = 70 + Height = 120 Align = alLeft AutoSize = True - ButtonWidth = 66 + ButtonWidth = 70 Caption = 'tlbForeignKeys' Images = MainForm.VirtualImageListMain List = True @@ -406,14 +415,24 @@ object frmTableEditor: TfrmTableEditor Enabled = False ImageIndex = 26 ImageName = 'icons8-close-button' + Wrap = True OnClick = btnClearForeignKeysClick end + object btnShowReverseForeignKeys: TToolButton + Left = 0 + Top = 66 + Hint = 'Show reverse foreign keys' + Caption = 'Reverse' + ImageIndex = 40 + Style = tbsCheck + OnClick = btnShowReverseForeignKeysClick + end end object listForeignKeys: TVirtualStringTree - Left = 66 + Left = 70 Top = 0 - Width = 620 - Height = 121 + Width = 503 + Height = 120 Margins.Top = 0 Margins.Bottom = 0 Align = alClient @@ -474,8 +493,31 @@ object frmTableEditor: TfrmTableEditor Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] Position = 5 Text = 'On DELETE' - Width = 80 + Width = 10 + end> + end + object ListViewReverseForeignKeys: TListView + Left = 576 + Top = 0 + Width = 110 + Height = 120 + Align = alRight + Columns = < + item + AutoSize = True + Caption = 'Database' + end + item + AutoSize = True + Caption = 'Table' end> + ColumnClick = False + ReadOnly = True + RowSelect = True + TabOrder = 2 + ViewStyle = vsReport + Visible = False + OnDblClick = ListViewReverseForeignKeysDblClick end end object tabCheckConstraints: TTabSheet @@ -484,11 +526,11 @@ object frmTableEditor: TfrmTableEditor object tlbCheckConstraints: TToolBar Left = 0 Top = 0 - Width = 66 - Height = 121 + Width = 70 + Height = 120 Align = alLeft AutoSize = True - ButtonWidth = 66 + ButtonWidth = 70 Caption = 'tlbCheckConstraints' Images = MainForm.VirtualImageListMain List = True @@ -521,10 +563,10 @@ object frmTableEditor: TfrmTableEditor end end object listCheckConstraints: TVirtualStringTree - Left = 66 + Left = 70 Top = 0 - Width = 620 - Height = 121 + Width = 616 + Height = 120 Align = alClient DefaultNodeHeight = 19 EditDelay = 0 @@ -558,7 +600,7 @@ object frmTableEditor: TfrmTableEditor Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus, coEditable, coStyleColor] Position = 1 Text = 'Check clause' - Width = 416 + Width = 412 end> end end @@ -569,8 +611,8 @@ object frmTableEditor: TfrmTableEditor object SynMemoPartitions: TSynMemo Left = 0 Top = 0 - Width = 593 - Height = 121 + Width = 686 + Height = 120 SingleLineMode = False Align = alClient Font.Charset = DEFAULT_CHARSET @@ -611,8 +653,8 @@ object frmTableEditor: TfrmTableEditor object SynMemoCREATEcode: TSynMemo Left = 0 Top = 0 - Width = 593 - Height = 121 + Width = 686 + Height = 120 SingleLineMode = False Align = alClient Font.Charset = DEFAULT_CHARSET @@ -653,8 +695,8 @@ object frmTableEditor: TfrmTableEditor object SynMemoALTERcode: TSynMemo Left = 0 Top = 0 - Width = 593 - Height = 121 + Width = 686 + Height = 120 SingleLineMode = False Align = alClient Font.Charset = DEFAULT_CHARSET @@ -714,7 +756,7 @@ object frmTableEditor: TfrmTableEditor Margins.Bottom = 0 Align = alClient AutoSize = True - ButtonWidth = 66 + ButtonWidth = 70 Caption = 'Columns:' Images = MainForm.VirtualImageListMain List = True @@ -730,7 +772,7 @@ object frmTableEditor: TfrmTableEditor OnClick = btnAddColumnClick end object btnRemoveColumn: TToolButton - Left = 66 + Left = 70 Top = 0 Hint = 'Remove column' Caption = 'Remove' @@ -739,7 +781,7 @@ object frmTableEditor: TfrmTableEditor OnClick = btnRemoveColumnClick end object btnMoveUpColumn: TToolButton - Left = 132 + Left = 140 Top = 0 Hint = 'Move up' Caption = 'Up' @@ -748,7 +790,7 @@ object frmTableEditor: TfrmTableEditor OnClick = btnMoveUpColumnClick end object btnMoveDownColumn: TToolButton - Left = 198 + Left = 210 Top = 0 Hint = 'Move down' Caption = 'Down' diff --git a/source/table_editor.pas b/source/table_editor.pas index d594347d8..e2036110d 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -16,7 +16,9 @@ TfrmTableEditor = class(TFrame) btnDiscard: TButton; btnHelp: TButton; listColumns: TVirtualStringTree; + ListViewReverseForeignKeys: TListView; PageControlMain: TPageControl; + spltForeignKeyListings: TSplitter; tabBasic: TTabSheet; tabIndexes: TTabSheet; tabOptions: TTabSheet; @@ -41,6 +43,7 @@ TfrmTableEditor = class(TFrame) comboCollation: TComboBox; lblEngine: TLabel; comboEngine: TComboBox; + btnShowReverseForeignKeys: TToolButton; treeIndexes: TVirtualStringTree; tlbIndexes: TToolBar; btnAddIndex: TToolButton; @@ -94,6 +97,8 @@ TfrmTableEditor = class(TFrame) btnClearCheckConstraints: TToolButton; listCheckConstraints: TVirtualStringTree; Copy1: TMenuItem; + procedure btnShowReverseForeignKeysClick(Sender: TObject); + procedure ListViewReverseForeignKeysDblClick(Sender: TObject); procedure Modification(Sender: TObject); procedure btnAddColumnClick(Sender: TObject); procedure btnRemoveColumnClick(Sender: TObject); @@ -207,6 +212,7 @@ TfrmTableEditor = class(TFrame) { Private declarations } FLoaded: Boolean; CreateCodeValid, AlterCodeValid: Boolean; + FReverseForeignKeysLoaded: Boolean; FColumns: TTableColumnList; FKeys, FDeletedKeys: TTableKeyList; FForeignKeys: TForeignKeyList; @@ -242,6 +248,7 @@ TfrmTableEditor = class(TFrame) procedure CalcMinColWidth; procedure UpdateTabCaptions; function MoveNodeAllowed(Sender: TVirtualStringTree): Boolean; + procedure LoadReverseForeignKeys(Sender: TObject); public { Public declarations } constructor Create(AOwner: TComponent); override; @@ -284,6 +291,7 @@ constructor TfrmTableEditor.Create(AOwner: TComponent); for i in ColNumsCheckboxes do begin listColumns.Header.Columns[i].Alignment := taCenter; end; + btnShowReverseForeignKeys.Down := AppSettings.ReadBool(asDisplayReverseForeignKeys); FixVT(listColumns); FixVT(treeIndexes); FixVT(listForeignKeys); @@ -442,6 +450,8 @@ procedure TfrmTableEditor.Init(Obj: TDBObject); ResetModificationFlags; CreateCodeValid := False; AlterCodeValid := False; + FReverseForeignKeysLoaded := False; + btnShowReverseForeignKeysClick(Self); PageControlMainChange(Self); // Foreign key editor needs a hit // Buttons are randomly moved, since VirtualTree update, see #440 btnSave.Top := Height - btnSave.Height - 3; @@ -1042,6 +1052,43 @@ procedure TfrmTableEditor.Modification(Sender: TObject); end; end; +procedure TfrmTableEditor.ListViewReverseForeignKeysDblClick(Sender: TObject); +var + ClickItem: TListItem; + Obj: TDBObject; +begin + // Create virtual object and let mainform search for it in the tree + ClickItem := ListViewReverseForeignKeys.Selected; + if not Assigned(ClickItem) then + Exit; + Obj := TDBObject.Create(DBObject.Connection); + Obj.NodeType := lntTable; + Obj.Database := ClickItem.Caption; + Obj.Name := ClickItem.SubItems[0]; + MainForm.ActiveDbObj := Obj; +end; + +procedure TfrmTableEditor.btnShowReverseForeignKeysClick(Sender: TObject); +var + DoShow: Boolean; +begin + DoShow := btnShowReverseForeignKeys.Down; + if DoShow then begin + spltForeignKeyListings.Visible := True; + ListViewReverseForeignKeys.Visible := True; + spltForeignKeyListings.BringToFront; + spltForeignKeyListings.Left := ListViewReverseForeignKeys.Left - spltForeignKeyListings.Width; + ListViewReverseForeignKeys.BringToFront; + LoadReverseForeignKeys(Sender); + end + else begin + ListViewReverseForeignKeys.Visible := False; + spltForeignKeyListings.Visible := False; + listForeignKeys.Width := listForeignKeys.Parent.Width - tlbForeignKeys.Width; + end; + AppSettings.WriteBool(asDisplayReverseForeignKeys, DoShow); +end; + procedure TfrmTableEditor.btnAddColumnClick(Sender: TObject); var @@ -2554,7 +2601,10 @@ procedure TfrmTableEditor.PageControlMainChange(Sender: TObject); listForeignKeys.EndEditNode; listCheckConstraints.EndEditNode; // Ensure SynMemo's have focus, otherwise Select-All and Copy actions may fail - if PageControlMain.ActivePage = tabCREATEcode then begin + if PageControlMain.ActivePage = tabForeignKeys then begin + LoadReverseForeignKeys(Sender); + end + else if PageControlMain.ActivePage = tabCREATEcode then begin SynMemoCreateCode.TrySetFocus; end else if PageControlMain.ActivePage = tabALTERcode then begin @@ -3068,6 +3118,40 @@ procedure TfrmTableEditor.listForeignKeysNewText(Sender: TBaseVirtualTree; end; end; +procedure TfrmTableEditor.LoadReverseForeignKeys(Sender: TObject); +var + SqlGet: String; + Results: TDBQuery; + ListItem: TListItem; +begin + if FReverseForeignKeysLoaded then + Exit; + if not ListViewReverseForeignKeys.Visible then + Exit; + if not ObjectExists then // Jump out early when creating a new table + Exit; + SqlGet := DBObject.Connection.SqlProvider.GetSql(qGetReverseForeignKeys, DBObject.AsStringMap); + if SqlGet.IsEmpty then begin + MainForm.LogSQL(_('Database does not provide reverse foreign key listing')); + Exit; + end; + ListViewReverseForeignKeys.Items.BeginUpdate; + ListViewReverseForeignKeys.Clear; + try + Results := DBObject.Connection.GetResults(SqlGet); + while not Results.Eof do begin + ListItem := ListViewReverseForeignKeys.Items.Add; + ListItem.ImageIndex := ICONINDEX_TABLE; + ListItem.Caption := Results.Col(0); + ListItem.SubItems.Add(Results.Col(1)); + Results.Next; + end; + except + on EDbError do; + end; + ListViewReverseForeignKeys.Items.EndUpdate; + FReverseForeignKeysLoaded := True; +end; procedure TfrmTableEditor.btnHelpClick(Sender: TObject); begin From 2dc6619b59933fe598075ca92393660c057a9bfe Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Sun, 1 Mar 2026 17:15:07 +0100 Subject: [PATCH 045/170] fix: remove default keystrokes from query editor: 2x ecRedo and 1x ecDeleteLine There may be more where users create a conflict when assigning a custom shortcut, but this particular one (Ctrl+Y) is one of the most popular. Refs #733 --- source/main.dfm | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/source/main.dfm b/source/main.dfm index b705afd8b..92a8a7c4a 100644 --- a/source/main.dfm +++ b/source/main.dfm @@ -1362,9 +1362,21 @@ object MainForm: TMainForm OnScanForFoldRanges = SynMemoQueryScanForFoldRanges FontSmoothing = fsmNone RemovedKeystrokes = < + item + Command = ecRedo + ShortCut = 40968 + end item Command = ecDeleteWord ShortCut = 16468 + end + item + Command = ecDeleteLine + ShortCut = 16473 + end + item + Command = ecRedo + ShortCut = 24666 end> AddedKeystrokes = < item From a777202b988dfe3dd7a15b3d317dbaa2fa6491fa Mon Sep 17 00:00:00 2001 From: He Yunxia Date: Fri, 20 Nov 2020 11:42:22 +0800 Subject: [PATCH 046/170] add some build step add install madExcept & compile *.rc files --- readme.md | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/readme.md b/readme.md index 81d18a9c6..e996fd965 100644 --- a/readme.md +++ b/readme.md @@ -16,7 +16,22 @@ Delphi 12.1 is required for building HeidiSQL for Windows. Older Delphi versions of the other free compilers cannot currently compile HeidiSQL. Once Delphi is installed, you need to load the SynEdit project from the components folder. Build both run-time and design-time packages. Install the -design-time package. Do the same for the VirtualTree component project, and install madExcept. +design-time package. Do the same for the VirtualTree component project. + +Second you need install [madExcept](http://madshi.net/madCollection.exe). + +Third compile *.rc files: + +| folder | file | command | +| ------ | ------ | ------ | +|HeidiSQL/source/vcl-styles-utils |AwesomeFont.RC| brcc32 AwesomeFont.RC| +|HeidiSQL/res| icon.rc | cgrc icon.rc | +|HeidiSQL/res| icon-question.rc | brcc32 icon-question.rc | +|HeidiSQL/res| version.rc | brcc32 version.rc | +|HeidiSQL/res| manifest.rc | manifest.rc | +|HeidiSQL/res| styles.rc | brcc32 styles.rc | +|HeidiSQL/res| updater.rc | brcc32 updater.rc | +> if updater.rc and updater.exe are not exists. you can copy them from updater64.rc and updater64.exe. Afterwards, load the HeidiSQL project from the packages folder. From 87e3c081d0ae9ce41bb75b3d598c05f8bf8b2fa3 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 2 Mar 2026 20:25:35 +0100 Subject: [PATCH 047/170] feat: select just created table copy Refs #131 --- source/copytable.pas | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/source/copytable.pas b/source/copytable.pas index 9f70e3e01..fa377e233 100644 --- a/source/copytable.pas +++ b/source/copytable.pas @@ -358,6 +358,7 @@ procedure TCopyTableForm.btnOKClick(Sender: TObject); Key: TTableKey; ForeignKey: TForeignKey; ClausePattern: String; + NewObj: TDBObject; begin // Compose and run CREATE query @@ -487,7 +488,13 @@ procedure TCopyTableForm.btnOKClick(Sender: TObject); end; // actRefresh takes care of whether the table editor is open // See also issue #1597 - MainForm.actRefresh.Execute + MainForm.actRefresh.Execute; + // Select it in tree + NewObj := TDBObject.Create(FDBObj.Connection); + NewObj.NodeType := lntTable; + NewObj.Database := comboDatabase.Text; + NewObj.Name := editNewTablename.Text; + MainForm.ActiveDbObj := NewObj; except on E:EDbError do begin Screen.Cursor := crDefault; From f8916cc2de57868f92ee683c63449605b9b4a286 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 4 Mar 2026 09:32:02 +0100 Subject: [PATCH 048/170] fix: various crash causes, reported in uploaded bug reports --- source/apphelpers.pas | 3 +-- source/const.inc | 2 +- source/dbconnection.pas | 34 ++++++++++++++++++++-------------- source/main.pas | 8 ++++++-- 4 files changed, 28 insertions(+), 19 deletions(-) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 0480ecbd1..4b15efbe4 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -3766,8 +3766,7 @@ procedure TWinControlHelper.TrySetFocus; and CanFocus then SetFocus; except - on E:EInvalidOperation do - MessageBeep(MB_ICONWARNING); + MessageBeep(MB_ICONWARNING); end; end; diff --git a/source/const.inc b/source/const.inc index 9b4c32190..75fe8ba49 100644 --- a/source/const.inc +++ b/source/const.inc @@ -96,7 +96,7 @@ const MsgUnhandledNetType: String = 'Unhandled connection type (%d)'; MsgUnhandledControl: String = 'Unhandled control in %s'; MsgDisconnect: String = 'Connection to %s closed at %s'; - MsgInvalidColumn: String = 'Column #%d not available. Query returned %d columns and %d rows.'; + TextInvalidColumn: String = '?'; FILEFILTER_SQLITEDB = '*.sqlite3;*.sqlite;*.db;*.s3db'; FILEEXT_SQLITEDB = 'sqlite3'; PROPOSAL_ITEM_HEIGHT = 18; diff --git a/source/dbconnection.pas b/source/dbconnection.pas index f10d58af8..0de5d7979 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -8924,8 +8924,9 @@ function TMySQLQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; end; end; - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + end + else + Result := TextInvalidColumn; end; @@ -8954,8 +8955,9 @@ function TAdoDBQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; else Result := '0'; end - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + end + else + Result := TextInvalidColumn; end; @@ -8975,8 +8977,9 @@ function TPGQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; else Result := Connection.DecodeAPIString(AnsiStr); end; - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + end + else + Result := TextInvalidColumn; end; @@ -8988,8 +8991,9 @@ function TSQLiteQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; end else begin Result := FCurrentResults[FRecNoLocal][Column].OldText; end; - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + end + else + Result := TextInvalidColumn; end; @@ -9001,8 +9005,9 @@ function TInterbaseQuery.Col(Column: Integer; IgnoreErrors: Boolean): String; end else begin Result := FCurrentResults.Fields[Column].AsString; end; - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + end + else + Result := TextInvalidColumn; end; @@ -9015,8 +9020,8 @@ function TDBQuery.Col(ColumnName: String; IgnoreErrors: Boolean=False): String; idx := ColumnNames.IndexOf(ColumnName); if idx > -1 then Result := Col(idx) - else if not IgnoreErrors then - Raise EDbError.CreateFmt(_('Column "%s" not available.'), [ColumnName]); + else + Result := TextInvalidColumn; end; @@ -9105,8 +9110,9 @@ function TDBQuery.ColAttributes(Column: Integer): TTableColumn; i: Integer; begin Result := nil; - if (Column < 0) or (Column >= FColumnOrgNames.Count) then - raise EDbError.CreateFmt(_('Column #%s not available.'), [IntToStr(Column)]); + if (Column < 0) or (Column >= FColumnOrgNames.Count) then begin + // Just return nil + end; if FColumns <> nil then begin for i:=0 to FColumns.Count-1 do begin if FColumns[i].Name = FColumnOrgNames[Column] then begin diff --git a/source/main.pas b/source/main.pas index 8962e8ff6..5e0621e06 100644 --- a/source/main.pas +++ b/source/main.pas @@ -1511,8 +1511,10 @@ procedure TMainForm.StatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPane 2: ImageIndex := 149; 3: begin Conn := ActiveConnection; - if Conn <> nil then + if Conn <> nil then try ImageIndex := Conn.Parameters.ImageIndex; + except + end; end; 5: ImageIndex := 190; 6: begin @@ -4333,7 +4335,7 @@ procedure TMainForm.SessionConnect(Sender: TObject); for i:=High(FTreeClickHistory) downto Low(FTreeClickHistory) do begin if FTreeClickHistory[i] <> nil then begin DBObj := DBtree.GetNodeData(FTreeClickHistory[i]); - if DBObj = nil then // Session disconnected + if (DBObj = nil) or (DBObj.Connection = nil) or (not DBObj.Connection.Active) then // Session disconnected Break; if DBObj.Connection.Parameters.SessionPath = SessionPath then begin Node := FTreeClickHistory[i]; @@ -9714,6 +9716,8 @@ procedure TMainForm.DBtreeGetImageIndex(Sender: TBaseVirtualTree; Node: if Column > 0 then Exit; DBObj := Sender.GetNodeData(Node); + if not Assigned(DBObj) then + Exit; case Kind of ikNormal, ikSelected: begin ImageIndex := DBObj.ImageIndex; From e89d97353161576ca111817aff93299d10d73290 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 4 Mar 2026 13:01:39 +0100 Subject: [PATCH 049/170] fix: crash reported in uploaded bug reports EGGComponentError: Property cannot be translated. Add TP_GlobalIgnoreClassProperty(TComboBoxEx,'Text') to your source code ... --- packages/Delphi12.3/heidisql.dpr | 2 ++ 1 file changed, 2 insertions(+) diff --git a/packages/Delphi12.3/heidisql.dpr b/packages/Delphi12.3/heidisql.dpr index b9d721e61..f25ac703e 100644 --- a/packages/Delphi12.3/heidisql.dpr +++ b/packages/Delphi12.3/heidisql.dpr @@ -6,6 +6,7 @@ uses System.SysUtils, Vcl.Dialogs, Vcl.Controls, + Vcl.ComCtrls, Winapi.Windows, main in '..\..\source\main.pas' {MainForm}, about in '..\..\source\about.pas' {AboutBox}, @@ -96,6 +97,7 @@ begin // First time translation via dxgettext. // Issue #3064: Ignore TFont, so "Default" on mainform for WinXP users does not get broken. gnugettext.TP_GlobalIgnoreClass(TFont); + gnugettext.TP_GlobalIgnoreClass(TComboBoxEx); // Enable padding in customized tooltips HintWindowClass := TExtHintWindow; From cb699c9536de5956f626c0b8b7eed1705c79141c Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 6 Mar 2026 10:27:31 +0100 Subject: [PATCH 050/170] fix: wrong use of Copy(), which is one-based not zero-based, and remove translated appendix to snipped log message which may use critical chars and confuse SynEdit Refs #48 --- source/main.pas | 6 ++---- source/sqlhelp.pas | 2 +- source/texteditor.pas | 2 +- 3 files changed, 4 insertions(+), 6 deletions(-) diff --git a/source/main.pas b/source/main.pas index 5e0621e06..b4d900a58 100644 --- a/source/main.pas +++ b/source/main.pas @@ -5618,9 +5618,7 @@ procedure TMainForm.LogSQL(Msg: String; Category: TDBLogCategory=lcInfo; Connect snip := (MaxLineWidth > 0) and (Len > MaxLineWidth); IsSQL := LogItem.Category in [lcSQL, lcUserFiredSQL]; if snip then begin - Msg := - Copy(Msg, 0, MaxLineWidth) + - '/* '+f_('large SQL query (%s), snipped at %s characters', [FormatByteNumber(Len), FormatNumber(MaxLineWidth)]) + ' */'; + Msg := Copy(Msg, 1, MaxLineWidth) + '...'; end else if (not snip) and IsSQL then Msg := Msg + Delimiter; if not IsSQL then @@ -6917,7 +6915,7 @@ procedure TMainForm.SynCompletionProposalExecute(Kind: SynCompletionType; dbname := ''; tblname := LeftToken; if Pos('.', tblname) > -1 then begin - dbname := Copy(tblname, 0, Pos('.', tblname)-1); + dbname := Copy(tblname, 1, Pos('.', tblname)-1); tblname := Copy(tblname, Pos('.', tblname)+1, Length(tblname)); end; // db and table name may already be quoted diff --git a/source/sqlhelp.pas b/source/sqlhelp.pas index 7cde97231..94b4fb384 100644 --- a/source/sqlhelp.pas +++ b/source/sqlhelp.pas @@ -124,7 +124,7 @@ procedure TfrmSQLhelp.treeTopicsFocusChanged(Sender: TBaseVirtualTree; Node: PVi if VT.HasChildren[VT.FocusedNode] then Exit; FKeyword := VT.Text[VT.FocusedNode, VT.FocusedColumn]; - lblKeyword.Caption := Copy(FKeyword, 0, 100); + lblKeyword.Caption := Copy(FKeyword, 1, 100); MemoDescription.Lines.Clear; MemoExample.Lines.Clear; Caption := DEFAULT_WINDOW_CAPTION; diff --git a/source/texteditor.pas b/source/texteditor.pas index 8f7798382..6f06f4fa1 100644 --- a/source/texteditor.pas +++ b/source/texteditor.pas @@ -432,7 +432,7 @@ procedure TfrmTextEditor.btnLoadTextClick(Sender: TObject); Screen.Cursor := crHourglass; MemoText.Text := ReadTextFile(d.FileName, MainForm.GetEncodingByName(d.Encodings[d.EncodingIndex])); if (FMaxLength > 0) and (Length(MemoText.Text) > FMaxLength) then - MemoText.Text := copy(MemoText.Text, 0, FMaxLength); + MemoText.Text := Copy(MemoText.Text, 1, FMaxLength); AppSettings.WriteInt(asFileDialogEncoding, d.EncodingIndex, Self.Name); finally Screen.Cursor := crDefault; From 7f05a812814a9e167dc14186c5165c7440bdbb5b Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 6 Mar 2026 11:55:41 +0100 Subject: [PATCH 051/170] fix: sporadic "no database selected" when updating grid header with row details --- source/dbstructures.mysql.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index 5f8aa41d6..68b0e4c93 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -3331,7 +3331,7 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; ); qGetRowCountApprox: Result := IfThen( FNetType <> ntMySQL_ProxySQLAdmin, - 'SHOW TABLE STATUS LIKE :EscapedName', + 'SHOW TABLE STATUS FROM :QuotedDatabase LIKE :EscapedName', '' ); qGetReverseForeignKeys: Result := 'SELECT DISTINCT'+ From 8d356941ff20777865a6cd8d8f9f1697905ab787 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Fri, 6 Mar 2026 13:02:40 +0100 Subject: [PATCH 052/170] fix: two more exception causes found in uploaded reports --- source/exportgrid.pas | 4 ++++ source/main.pas | 38 ++++++++++++++++++++------------------ 2 files changed, 24 insertions(+), 18 deletions(-) diff --git a/source/exportgrid.pas b/source/exportgrid.pas index a540b389b..fce4d6283 100644 --- a/source/exportgrid.pas +++ b/source/exportgrid.pas @@ -483,6 +483,10 @@ procedure TfrmExportGrid.CalcSize(Sender: TObject); CalculatedCount, SelectedCount, AllCount: Int64; begin GridData := Mainform.GridResult(Grid); + if not Assigned(GridData) then begin + MainForm.LogSQL('Failed to get current results'); + Exit; + end; AllSize := 0; SelectedSize := 0; chkIncludeAutoIncrement.Enabled := GridData.AutoIncrementColumn > -1; diff --git a/source/main.pas b/source/main.pas index b4d900a58..f524adb6e 100644 --- a/source/main.pas +++ b/source/main.pas @@ -7506,24 +7506,26 @@ procedure TMainForm.QuickFilterClick(Sender: TObject); if ExecRegExpr('Prompt\d+$', Act.Name) then begin // Item needs prompt TableCol := SelectedTableFocusedColumn; - Col := Conn.QuoteIdent(TableCol.Name, False); - - if (TableCol.DataType.Index = dbdtJson) - and (Conn.Parameters.NetTypeGroup = ngPgSQL) then begin - Col := Col + '::text'; - end; - Val := DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn]; - if InputQuery(_('Specify filter-value...'), Act.Caption, Val) then begin - if Act = actQuickFilterPrompt1 then - Filter := Col + ' = ' + Conn.EscapeString(Val, TableCol.DataType) - else if Act = actQuickFilterPrompt2 then - Filter := Col + ' != ' + Conn.EscapeString(Val, TableCol.DataType) - else if Act = actQuickFilterPrompt3 then - Filter := Col + ' > ' + Conn.EscapeString(Val, TableCol.DataType) - else if Act = actQuickFilterPrompt4 then - Filter := Col + ' < ' + Conn.EscapeString(Val, TableCol.DataType) - else if Act = actQuickFilterPrompt5 then - Filter := Conn.SqlProvider.GetSql(qLikeCompare, [Col, Conn.EscapeString('%'+Val+'%', TableCol.DataType)]); + if Assigned(TableCol) then begin + Col := Conn.QuoteIdent(TableCol.Name, False); + + if (TableCol.DataType.Index = dbdtJson) + and (Conn.Parameters.NetTypeGroup = ngPgSQL) then begin + Col := Col + '::text'; + end; + Val := DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn]; + if InputQuery(_('Specify filter-value...'), Act.Caption, Val) then begin + if Act = actQuickFilterPrompt1 then + Filter := Col + ' = ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt2 then + Filter := Col + ' != ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt3 then + Filter := Col + ' > ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt4 then + Filter := Col + ' < ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt5 then + Filter := Conn.SqlProvider.GetSql(qLikeCompare, [Col, Conn.EscapeString('%'+Val+'%', TableCol.DataType)]); + end; end; end else begin From 1fc1ca38f5d9657da16cc5a76933ed6f8a20c660 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 9 Mar 2026 16:11:41 +0100 Subject: [PATCH 053/170] fix: potential crash after user query, due to running Connection.ShowWarnings directly in the TQueryThread Refs #2425 --- source/apphelpers.pas | 1 - source/main.pas | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 4b15efbe4..34164b580 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -3353,7 +3353,6 @@ procedure TQueryThread.Execute; end; FConnection.SetLockedByThread(nil); Synchronize(procedure begin MainForm.AfterQueryExecution(Self); end); - FConnection.ShowWarnings; // Check if FAborted is set by the main thread, to avoid proceeding the loop in case // FStopOnErrors is set to false if FAborted or ErrorAborted then diff --git a/source/main.pas b/source/main.pas index f524adb6e..ec0255747 100644 --- a/source/main.pas +++ b/source/main.pas @@ -3438,6 +3438,7 @@ procedure TMainForm.AfterQueryExecution(Thread: TQueryThread); if Tab.tabsetQuery.TabIndex = -1 then Tab.tabsetQuery.TabIndex := 0; end; + Thread.Connection.ShowWarnings; ShowStatusMsg; end; From e5d762754a6dcc6705b133592b8ebd638072e12c Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Tue, 10 Mar 2026 17:32:42 +0100 Subject: [PATCH 054/170] ci: bump version for v12.16 release --- res/version.rc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/res/version.rc b/res/version.rc index 3ca9adb77..2c9cb94ed 100644 --- a/res/version.rc +++ b/res/version.rc @@ -1,5 +1,5 @@ 1 VERSIONINFO - FILEVERSION 12,15,0,0 + FILEVERSION 12,16,0,0 FILEOS VOS__WINDOWS32 FILETYPE VFT_APP BEGIN From 9419d123d6193899c75bb706ebdbf75d06cad239 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 11 Mar 2026 08:53:03 +0100 Subject: [PATCH 055/170] fix: crash after canceling query Refs #2426 --- source/dbconnection.pas | 6 +++++- source/main.pas | 1 + 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 0de5d7979..de6eba32d 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -434,6 +434,7 @@ TDBConnection = class(TComponent) FServerUptime: Integer; FServerDateTimeOnStartup: String; FParameters: TConnectionParameters; + FOwnsParameters: Boolean; FSecureShellCmd: TSecureShellCmd; FDatabase: String; FAllDatabases: TStringList; @@ -560,6 +561,7 @@ TDBConnection = class(TComponent) function ApplyLimitClause(QueryType, QueryBody: String; Limit, Offset: Int64): String; function LikeClauseTail: String; property Parameters: TConnectionParameters read FParameters write FParameters; + property OwnsParameters: Boolean read FOwnsParameters write FOwnsParameters; property ThreadId: Int64 read GetThreadId; property ConnectionUptime: Integer read GetConnectionUptime; property ServerUptime: Integer read GetServerUptime; @@ -2099,6 +2101,7 @@ constructor TDBConnection.Create(AOwner: TComponent); begin inherited; FParameters := TConnectionParameters.Create; + FOwnsParameters := True; FRowsFound := 0; FRowsAffected := 0; FWarningCount := 0; @@ -2218,7 +2221,8 @@ destructor TDBConnection.Destroy; FKeepAliveTimer.Free; FFavorites.Free; FInformationSchemaObjects.Free; - FParameters.Free; + if FOwnsParameters then + FParameters.Free; inherited; end; diff --git a/source/main.pas b/source/main.pas index ec0255747..cbd8500aa 100644 --- a/source/main.pas +++ b/source/main.pas @@ -14043,6 +14043,7 @@ procedure TMainForm.actCancelOperationExecute(Sender: TObject); Tab.ExecutionThread.Aborted := True; Killer := ActiveConnection.Parameters.CreateConnection(Self); Killer.Parameters := ActiveConnection.Parameters; + Killer.OwnsParameters := False; Killer.LogPrefix := _('Helper connection'); Killer.OnLog := LogSQL; try From ea4013b070c4589f27b510f4cfb6441131e7da77 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 11 Mar 2026 11:45:37 +0100 Subject: [PATCH 056/170] feat: allow setting database to in PostgreSQL connections, and show and in the pulldown selector Refs #2424 --- source/connections.pas | 40 ++++++++++++++++++++++++++++++++-------- source/dbconnection.pas | 10 ++++++++-- 2 files changed, 40 insertions(+), 10 deletions(-) diff --git a/source/connections.pas b/source/connections.pas index 462e2d4ca..355646fef 100644 --- a/source/connections.pas +++ b/source/connections.pas @@ -1296,7 +1296,7 @@ procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject); // Try to connect and lookup database names Params := CurrentParams; Connection := Params.CreateConnection(Self); - Connection.Parameters.AllDatabasesStr := ''; + Connection.Parameters.AllDatabasesStr := TPgConnection.DBNAME_EMPTY; Connection.LogPrefix := SelectedSessionPath; Connection.OnLog := Mainform.LogSQL; FPopupDatabases := TPopupMenu.Create(Self); @@ -1304,16 +1304,29 @@ procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject); Screen.Cursor := crHourglass; try Connection.Active := True; - if Params.NetTypeGroup = ngPgSQL then - Databases := Connection.GetCol('SELECT datname FROM pg_database WHERE datistemplate=FALSE') - else + if Params.IsAnyPostgreSQL then begin + Databases := Connection.GetCol('SELECT datname FROM pg_database WHERE datistemplate=FALSE'); + Item := TMenuItem.Create(FPopupDatabases); + Item.Caption := TPgConnection.DBNAME_EMPTY + ' (' + _('No database') + ')'; + Item.Tag := TPgConnection.DBTAG_EMPTY; + Item.OnClick := MenuDatabasesClick; + Item.AutoCheck := True; + Item.RadioItem := True; + FPopupDatabases.Items.Add(Item); + end + else begin Databases := Connection.AllDatabases; + end; for DB in Databases do begin Item := TMenuItem.Create(FPopupDatabases); Item.Caption := DB; + if Params.IsAnyPostgreSQL and (DB = TPgConnection.DBNAME_DEFAULT) then begin + Item.Caption := Item.Caption + ' (' + _('Default') + ')'; + Item.Tag := TPgConnection.DBTAG_DEFAULT; + end; Item.OnClick := MenuDatabasesClick; Item.AutoCheck := True; - Item.RadioItem := Params.NetTypeGroup = ngPgSQL; + Item.RadioItem := Params.IsAnyPostgreSQL; FPopupDatabases.Items.Add(Item); end; Databases.Free; @@ -1326,7 +1339,14 @@ procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject); // Check/uncheck items, based on semicolon list Databases := Explode(';', editDatabases.Text); for Item in FPopupDatabases.Items do begin - Item.Checked := Databases.IndexOf(Item.Caption) > -1; + case Item.Tag of + TPgConnection.DBTAG_EMPTY: + Item.Checked := Databases.Contains(TPgConnection.DBNAME_EMPTY); + TPgConnection.DBTAG_DEFAULT: + Item.Checked := Databases.Contains(TPgConnection.DBNAME_DEFAULT) or Databases.IsEmpty; + else + Item.Checked := Databases.IndexOf(Item.Caption) > -1; + end; end; Databases.Free; @@ -1344,8 +1364,12 @@ procedure Tconnform.MenuDatabasesClick(Sender: TObject); begin Databases := TStringList.Create; for Item in FPopupDatabases.Items do begin - if Item.Checked then - Databases.Add(Item.Caption); + if Item.Checked then begin + if Item.Tag in [TPgConnection.DBTAG_EMPTY, TPgConnection.DBTAG_DEFAULT] then // Remove hint + Databases.Add(ReplaceRegExpr('\s\(.+$', Item.Caption, '')) + else + Databases.Add(Item.Caption); + end; end; SelStart := editDatabases.SelStart; editDatabases.Text := Implode(';', Databases); diff --git a/source/dbconnection.pas b/source/dbconnection.pas index de6eba32d..a261223fe 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -694,6 +694,11 @@ TAdoDBConnection = class(TDBConnection) TPGRawResults = Array of PPGresult; TPQerrorfields = (PG_DIAG_SEVERITY, PG_DIAG_SQLSTATE, PG_DIAG_MESSAGE_PRIMARY, PG_DIAG_MESSAGE_DETAIL, PG_DIAG_MESSAGE_HINT, PG_DIAG_STATEMENT_POSITION, PG_DIAG_INTERNAL_POSITION, PG_DIAG_INTERNAL_QUERY, PG_DIAG_CONTEXT, PG_DIAG_SOURCE_FILE, PG_DIAG_SOURCE_LINE, PG_DIAG_SOURCE_FUNCTION); TPgConnection = class(TDBConnection) + const + DBNAME_DEFAULT = 'postgres'; + DBNAME_EMPTY = '!'; + DBTAG_EMPTY = 1; + DBTAG_DEFAULT = 2; private FHandle: PPGconn; FLib: TPostgreSQLLib; @@ -2865,7 +2870,7 @@ procedure TPgConnection.SetActive(Value: Boolean); // "You should connect as "postgres" database by default, with an option to change. Don't use template1" dbname := FParameters.AllDatabasesStr; if dbname = '' then - dbname := 'postgres'; + dbname := DBNAME_DEFAULT; // Prepare special stuff for SSH tunnel FinalHost := FParameters.Hostname; @@ -2881,9 +2886,10 @@ procedure TPgConnection.SetActive(Value: Boolean); .AddPair('port', IntToStr(FinalPort)) .AddPair('user', FParameters.Username) .AddPair('password', FParameters.Password) - .AddPair('dbname', dbname) .AddPair('application_name', APPNAME) .AddPair('sslmode', 'disable'); + if dbname <> DBNAME_EMPTY then + ConnectOptions.AddPair('dbname', dbname); if FParameters.WantSSL then begin // Be aware .AddPair would add duplicates case FParameters.SSLVerification of From 7ef9f45a157e3a02d5c3969cdb53c30dde146230 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Wed, 11 Mar 2026 15:11:11 +0100 Subject: [PATCH 057/170] feat: make HTML export dark/light mode aware Refs #2418 --- source/exportgrid.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/source/exportgrid.pas b/source/exportgrid.pas index fce4d6283..a0200388e 100644 --- a/source/exportgrid.pas +++ b/source/exportgrid.pas @@ -735,15 +735,15 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); CodeIndent(2) + '' + TableName + '' + sLineBreak + CodeIndent(2) + '' + sLineBreak + CodeIndent(2) + '' + sLineBreak + + CodeIndent(2) + '' + sLineBreak + CodeIndent(2) + '