diff --git a/.tx/config b/.tx/config index 4d840dd17..6e2802e7a 100644 --- a/.tx/config +++ b/.tx/config @@ -1,5 +1,5 @@ [main] -host = https://www.transifex.com +host = https://app.transifex.com [o:heidisql:p:heidisql:r:ui] file_filter = out/locale//LC_MESSAGES/default.po diff --git a/components/synedit/Source/SynCompletionProposal.pas b/components/synedit/Source/SynCompletionProposal.pas index 1fa39cd58..9c5b7da39 100644 --- a/components/synedit/Source/SynCompletionProposal.pas +++ b/components/synedit/Source/SynCompletionProposal.pas @@ -2722,9 +2722,14 @@ function TSynBaseCompletionProposal.GetDefaultKind: SynCompletionType; procedure TSynBaseCompletionProposal.SetDefaultKind(const Value: SynCompletionType); begin - Form.DefaultType := Value; - Form.DisplayType := Value; - Form.RecreateWnd; + if Form.DefaultType <> Value then begin + Form.DefaultType := Value; + Form.DisplayType := Value; + if Form.HandleAllocated then + Form.RecreateWnd; + end + else + Form.DisplayType := Value; end; procedure TSynBaseCompletionProposal.SetEndOfTokenChar( diff --git a/out/libcrypto-3-x64.dll b/out/libcrypto-3-x64.dll index a818e68d5..bc5570fc6 100644 Binary files a/out/libcrypto-3-x64.dll and b/out/libcrypto-3-x64.dll differ diff --git a/out/libmariadb-64.dll b/out/libmariadb-64.dll index 6efb2852a..2f686799c 100644 Binary files a/out/libmariadb-64.dll and b/out/libmariadb-64.dll differ diff --git a/out/libssl-3-x64.dll b/out/libssl-3-x64.dll index e25fed2e1..eabd8d649 100644 Binary files a/out/libssl-3-x64.dll and b/out/libssl-3-x64.dll differ diff --git a/out/license.txt b/out/license.txt index 66d8d2ba1..dd76f4598 100644 --- a/out/license.txt +++ b/out/license.txt @@ -1,4 +1,4 @@ -Copyright (C)2000 - 2025 - Ansgar Becker +Copyright (C)2000 - 2026 - Ansgar Becker HeidiSQL is free. You don't have to pay for it, and you can use it any way you want. It is developed as an Open Source project under the GNU diff --git a/out/plugins64/auth_gssapi_client.dll b/out/plugins64/auth_gssapi_client.dll index e09ff0aa6..e88d25738 100644 Binary files a/out/plugins64/auth_gssapi_client.dll and b/out/plugins64/auth_gssapi_client.dll differ diff --git a/out/plugins64/caching_sha2_password.dll b/out/plugins64/caching_sha2_password.dll index 2d8accce6..6c03b4008 100644 Binary files a/out/plugins64/caching_sha2_password.dll and b/out/plugins64/caching_sha2_password.dll differ diff --git a/out/plugins64/client_ed25519.dll b/out/plugins64/client_ed25519.dll index f224a30d9..a8980b868 100644 Binary files a/out/plugins64/client_ed25519.dll and b/out/plugins64/client_ed25519.dll differ diff --git a/out/plugins64/dialog.dll b/out/plugins64/dialog.dll index 467d4eb65..c214e2fdb 100644 Binary files a/out/plugins64/dialog.dll and b/out/plugins64/dialog.dll differ diff --git a/out/plugins64/mysql_clear_password.dll b/out/plugins64/mysql_clear_password.dll index 9f7fe5d25..4eac16d3c 100644 Binary files a/out/plugins64/mysql_clear_password.dll and b/out/plugins64/mysql_clear_password.dll differ diff --git a/out/plugins64/parsec.dll b/out/plugins64/parsec.dll index 14b086980..b8e25c946 100644 Binary files a/out/plugins64/parsec.dll and b/out/plugins64/parsec.dll differ diff --git a/out/plugins64/pvio_shmem.dll b/out/plugins64/pvio_shmem.dll index ec3c0a81a..c07c10127 100644 Binary files a/out/plugins64/pvio_shmem.dll and b/out/plugins64/pvio_shmem.dll differ diff --git a/out/plugins64/sha256_password.dll b/out/plugins64/sha256_password.dll index afc5548f7..0e5c85f25 100644 Binary files a/out/plugins64/sha256_password.dll and b/out/plugins64/sha256_password.dll differ diff --git a/out/sqlite3-64.dll b/out/sqlite3-64.dll index 753630dd6..cb279efd6 100644 Binary files a/out/sqlite3-64.dll and b/out/sqlite3-64.dll differ diff --git a/out/sqlite3mc-64.dll b/out/sqlite3mc-64.dll index 3b11541a0..d21fd0bdc 100644 Binary files a/out/sqlite3mc-64.dll and b/out/sqlite3mc-64.dll differ diff --git a/packages/Delphi12.3/heidisql.groupproj b/packages/Delphi12.3/heidisql.groupproj index c86a77c88..ef3f2fbb5 100644 --- a/packages/Delphi12.3/heidisql.groupproj +++ b/packages/Delphi12.3/heidisql.groupproj @@ -9,10 +9,10 @@ - + - + @@ -48,22 +48,22 @@ - + - + - + - + - + - + diff --git a/res/icons/table_column.png b/res/icons/table_column.png new file mode 100644 index 000000000..b2d11546a Binary files /dev/null and b/res/icons/table_column.png differ diff --git a/res/icons/table_column_add.png b/res/icons/table_column_add.png new file mode 100644 index 000000000..480ecd13c Binary files /dev/null and b/res/icons/table_column_add.png differ diff --git a/res/icons/table_column_delete.png b/res/icons/table_column_delete.png new file mode 100644 index 000000000..730ef89ee Binary files /dev/null and b/res/icons/table_column_delete.png differ diff --git a/res/version.rc b/res/version.rc index 2c9cb94ed..5a537ff9f 100644 --- a/res/version.rc +++ b/res/version.rc @@ -1,5 +1,5 @@ 1 VERSIONINFO - FILEVERSION 12,16,0,0 + FILEVERSION 12,21,0,0 FILEOS VOS__WINDOWS32 FILETYPE VFT_APP BEGIN diff --git a/source/apphelpers.pas b/source/apphelpers.pas index 1aa298429..02fb5e160 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -188,7 +188,7 @@ TWinControlHelper = class helper for TWinControl asWrapLongLines, asCodeFolding, asDisplayBLOBsAsText, asSingleQueries, asMemoEditorWidth, asMemoEditorHeight, asMemoEditorMaximized, asMemoEditorWrap, asMemoEditorHighlighter, asMemoEditorAlwaysFormatCode, asDelimiter, asSQLHelpWindowLeft, asSQLHelpWindowTop, asSQLHelpWindowWidth, asSQLHelpWindowHeight, asSQLHelpPnlLeftWidth, asSQLHelpPnlRightTopHeight, asHost, - asUser, asPassword, asCleartextPluginEnabled, asWindowsAuth, asLoginPrompt, asPort, asLibrary, asAllProviders, + asUser, asPassword, asCleartextPluginEnabled, asForceUnicode, asWindowsAuth, asLoginPrompt, asPort, asLibrary, asAllProviders, asSSHtunnelActive, asPlinkExecutable, asSshExecutable, asSSHtunnelHost, asSSHtunnelHostPort, asSSHtunnelPort, asSSHtunnelUser, asSSHtunnelPassword, asSSHtunnelTimeout, asSSHtunnelPrivateKey, asSSLActive, asSSLKey, asSSLCert, asSSLCA, asSSLCipher, asSSLVerification, asSSLWarnUnused, asNetType, asCompressed, asLocalTimeZone, asQueryTimeout, asKeepAlive, @@ -197,7 +197,7 @@ TWinControlHelper = class helper for TWinControl asExportSQLDatabase, asExportSQLServerDatabase, asExportSQLOutput, asExportSQLAddComments, asExportSQLTransactions, asExportSQLRemoveAutoIncrement, asExportSQLRemoveDefiner, asGridExportWindowWidth, asGridExportWindowHeight, asGridExportOutputCopy, asGridExportOutputFile, asGridExportFilename, asGridExportRecentFiles, asGridExportEncoding, asGridExportFormat, asGridExportSelection, - asGridExportColumnNames, asGridExportIncludeAutoInc, asGridExportIncludeQuery, asGridExportRemoveLinebreaks, asGridExportOpenFile, + asGridExportColumnNames, asGridExportIncludeAutoInc, asGridExportFocusedColumnOnly, asGridExportIncludeQuery, asGridExportRemoveLinebreaks, asGridExportOpenFile, asGridExportSeparator, asGridExportEncloser, asGridExportTerminator, asGridExportNull, asGridExportClpColumnNames, asGridExportClpIncludeAutoInc, asGridExportClpRemoveLinebreaks, @@ -225,7 +225,7 @@ TWinControlHelper = class helper for TWinControl asLogUserSQL, asLogSQL, asLogInfos, asLogDebug, asLogScript, asLogTimestamp, asFieldColorNumeric, asFieldColorReal, asFieldColorText, asFieldColorBinary, asFieldColorDatetime, asFieldColorSpatial, asFieldColorOther, asFieldEditorBinary, asFieldEditorDatetime, asFieldEditorDatetimePrefill, asFieldEditorEnum, - asFieldEditorSet, asFieldNullBackground, asRowBackgroundEven, asRowBackgroundOdd, asGroupTreeObjects, asDisplayObjectSizeColumn, asSQLfile, + asFieldEditorSet, asFieldNullBackground, asRowBackgroundEven, asRowBackgroundOdd, asGroupTreeObjects, asTreeShowColumns, asDisplayObjectSizeColumn, asSQLfile, asActionShortcut1, asActionShortcut2, asHighlighterForeground, asHighlighterBackground, asHighlighterStyle, asListColWidths, asListColsVisible, asListColPositions, asListColSort, asSessionFolder, asRecentFilter, asTimestampColumns, asDateTimeEditorCursorPos, asAppLanguage, asAutoExpand, asDoubleClickInsertsNodeText, asForeignDropDown, @@ -360,7 +360,12 @@ TAppSettings = class(TObject) function FormatByteNumber( Bytes: String; Decimals: Byte = 1 ): String; Overload; function FormatTimeNumber(Seconds: Double; DisplaySeconds: Boolean; MilliSecondsPrecision: Integer=1): String; function GetTempDir: String; + // Return directory of running executable, including a trailing path delimiter function GetAppDir: String; + // Return directory with dlls or dylibs, or empty string for auto-detection + function GetLibDir: String; + // Return directory with MySQL plugin files. Empty on Linux inidicating auto-detection. + function GetPluginDir: String; procedure SaveUnicodeFile(Filename: String; Text: String; Encoding: TEncoding); procedure OpenTextFile(const Filename: String; out Stream: TFileStream; var Encoding: TEncoding); function DetectEncoding(Stream: TStream): TEncoding; @@ -1310,6 +1315,17 @@ function GetAppDir: String; Result := ExtractFilePath(Application.ExeName); end; +function GetLibDir: String; +begin + Result := GetAppDir; +end; + +function GetPluginDir: String; +begin + Result := GetLibDir; + Result := Result + 'plugins' + PathDelim; +end; + {** Save a textfile with unicode } @@ -2512,7 +2528,7 @@ function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: end; if Title <> Dialog.Caption then Dialog.Title := Title; - if Assigned(MainForm) and (MainForm.ActiveConnection <> nil) then + if Assigned(MainForm) and (MainForm.ActiveConnection <> nil) and (MainForm.ActiveConnection.Parameters <> nil) then Dialog.Caption := MainForm.ActiveConnection.Parameters.SessionName + ': ' + Dialog.Caption; rx := TRegExpr.Create; rx.Expression := 'https?://[^\s"]+'; @@ -3555,13 +3571,11 @@ class function TSQLBatch.GetSQLWithoutComments(FullSQL: String): String; Result := ''; InLineComment := False; InMultiLineComment := False; - Prev1 := #0; - Prev2 := #0; for i:=1 to Length(FullSQL) do begin Cur := FullSQL[i]; AddCur := True; - if i > 1 then Prev1 := FullSQL[i-1]; - if i > 2 then Prev2 := FullSQL[i-2]; + if i > 1 then Prev1 := FullSQL[i-1] else Prev1 := #0; + if i > 2 then Prev2 := FullSQL[i-2] else Prev2 := #0; if (Cur = '*') and (Prev1 = '/') then begin InMultiLineComment := True; @@ -3580,7 +3594,7 @@ class function TSQLBatch.GetSQLWithoutComments(FullSQL: String): String; else if Cur = '#' then begin InLineComment := True; end - else if (Cur = ' ') and (Prev1 = '-') and (Prev2 = '-') then begin + else if (not InLineComment) and (Cur = ' ') and (Prev1 = '-') and (Prev2 = '-') then begin InLineComment := True; System.Delete(Result, Length(Result)-1, 2); // Delete comment chars end; @@ -3782,7 +3796,6 @@ constructor TAppSettings.Create; var rx: TRegExpr; i: Integer; - DefaultSnippetsDirectory: String; PortableLockFile: String; NewFileHandle: THandle; begin @@ -3848,7 +3861,7 @@ constructor TAppSettings.Create; InitSetting(asIgnoreDatabasePattern, 'IgnoreDatabasePattern', 0, False, '', True); InitSetting(asLogFileDdl, 'LogFileDdl', 0, False, '', True); InitSetting(asLogFileDml, 'LogFileDml', 0, False, '', True); - InitSetting(asLogFilePath, 'LogFilePath', 0, False, DirnameUserAppData + 'Logs\%session\%db\%y%m%d.sql', True); + InitSetting(asLogFilePath, 'LogFilePath', 0, False, DirnameUserAppData + 'Logs'+PathDelim+'%session'+PathDelim+'%db'+PathDelim+'%y%m%d.sql', True); if Screen.Fonts.IndexOf('Consolas') > -1 then InitSetting(asFontName, 'FontName', 0, False, 'Consolas') else @@ -3864,7 +3877,7 @@ constructor TAppSettings.Create; InitSetting(asHightlightSameTextBackground, 'HightlightSameTextBackground', GetThemeColor(clInfoBk)); InitSetting(asLogsqlnum, 'logsqlnum', 300); InitSetting(asLogsqlwidth, 'logsqlwidth', 2000); - InitSetting(asSessionLogsDirectory, 'SessionLogsDirectory', 0, False, DirnameUserAppData + 'Sessionlogs\'); + InitSetting(asSessionLogsDirectory, 'SessionLogsDirectory', 0, False, DirnameUserAppData + 'Sessionlogs' + PathDelim); InitSetting(asLogHorizontalScrollbar, 'LogHorizontalScrollbar', 0, False); InitSetting(asSQLColActiveLine, 'SQLColActiveLine', 0, False, 'clNone'); InitSetting(asSQLColMatchingBraceForeground, 'SQLColMatchingBraceForeground', 0, False, 'clBlack'); @@ -3914,6 +3927,7 @@ constructor TAppSettings.Create; InitSetting(asUser, 'User', 0, False, '', True); InitSetting(asPassword, 'Password', 0, False, '', True); InitSetting(asCleartextPluginEnabled, 'CleartextPluginEnabled', 0, False, '', True); + InitSetting(asForceUnicode, 'ForceUnicode', 0, True, '', True); InitSetting(asWindowsAuth, 'WindowsAuth', 0, False, '', True); InitSetting(asLoginPrompt, 'LoginPrompt', 0, False, '', True); InitSetting(asPort, 'Port', 0, False, '', True); @@ -3972,6 +3986,7 @@ constructor TAppSettings.Create; InitSetting(asGridExportSelection, 'GridExportSelection', 1); InitSetting(asGridExportColumnNames, 'GridExportColumnNames', 0, True); InitSetting(asGridExportIncludeAutoInc, 'GridExportAutoInc', 0, True); + InitSetting(asGridExportFocusedColumnOnly, 'GridExportFocusedColumnOnly', 0, False); InitSetting(asGridExportIncludeQuery, 'GridExportIncludeQuery', 0, False); InitSetting(asGridExportRemoveLinebreaks, 'GridExportRemoveLinebreaks', 0, False); InitSetting(asGridExportOpenFile, 'GridExportOpenFile', 0, False); @@ -4060,14 +4075,7 @@ constructor TAppSettings.Create; InitSetting(asDisplayReverseForeignKeys, 'DisplayReverseForeignKeys', 0, False); InitSetting(asGenerateDataNumRows, 'GenerateDataNumRows', 1000); InitSetting(asGenerateDataNullAmount, 'GenerateDataNullAmount', 10); - - // Default folder for snippets - if FPortableMode then - DefaultSnippetsDirectory := GetAppDir - else - DefaultSnippetsDirectory := DirnameUserDocuments; - DefaultSnippetsDirectory := DefaultSnippetsDirectory + 'Snippets\'; - InitSetting(asCustomSnippetsDirectory, 'CustomSnippetsDirectory', 0, False, DefaultSnippetsDirectory); + InitSetting(asCustomSnippetsDirectory, 'CustomSnippetsDirectory', 0, False, DirnameUserDocuments + 'Snippets' + PathDelim); InitSetting(asPromptSaveFileOnTabClose, 'PromptSaveFileOnTabClose', 0, True); // Restore tabs feature crashes often on old XP systems, see https://www.heidisql.com/forum.php?t=34044 InitSetting(asRestoreTabs, 'RestoreTabs', 0, Win32MajorVersion >= 6); @@ -4117,6 +4125,7 @@ constructor TAppSettings.Create; InitSetting(asRowBackgroundEven, 'RowBackgroundEven', clNone); InitSetting(asRowBackgroundOdd, 'RowBackgroundOdd', clNone); InitSetting(asGroupTreeObjects, 'GroupTreeObjects', 0, False); + InitSetting(asTreeShowColumns, 'TreeShowColumns', 0, False); InitSetting(asDisplayObjectSizeColumn, 'DisplayObjectSizeColumn', 0, True); InitSetting(asDisplayLogPanel, 'DisplayLogPanel', 0, True); InitSetting(asDisplayTreeFilters, 'DisplayTreeFilters', 0, True); @@ -4725,19 +4734,29 @@ function TAppSettings.ExportSettings: Boolean; function TAppSettings.DirnameUserAppData: String; begin - // User folder for HeidiSQL's data (\Application Data) - Result := GetShellFolder(FOLDERID_RoamingAppData) + '\' + APPNAME + '\'; - if not DirectoryExists(Result) then begin - ForceDirectories(Result); + // C:\Users\mike\AppData\Roaming\HeidiSQL\ + if PortableMode then begin + Result := GetAppDir; + end + else begin + Result := GetShellFolder(FOLDERID_RoamingAppData) + '\' + APPNAME + '\'; + if not DirectoryExists(Result) then begin + ForceDirectories(Result); + end; end; end; function TAppSettings.DirnameUserDocuments: String; begin - // "HeidiSQL" folder under user's documents folder, e.g. c:\Users\Mike\Documents\HeidiSQL\ - Result := GetShellFolder(FOLDERID_Documents) + '\' + APPNAME + '\'; - // Do not auto-create it, as we only use it for snippets which can also have a custom path. + // C:\Users\mike\Documents\HeidiSQL\ + if PortableMode then begin + Result := GetAppDir; + end + else begin + Result := GetShellFolder(FOLDERID_Documents) + '\' + APPNAME + '\'; + // Do not auto-create it, as we only use it for snippets which can also have a custom path. + end; end; @@ -4757,11 +4776,7 @@ function TAppSettings.DirnameSnippets: String; function TAppSettings.DirnameBackups: String; begin // Create backup folder if it does not exist and return it - if PortableMode then begin - Result := GetAppDir + 'Backups\' - end else begin - Result := DirnameUserAppData + 'Backups\'; - end; + Result := DirnameUserAppData + 'Backups' + PathDelim; if not DirectoryExists(Result) then begin ForceDirectories(Result); end; @@ -4770,11 +4785,7 @@ function TAppSettings.DirnameBackups: String; function TAppSettings.DirnameHighlighters: string; begin - if PortableMode then begin - Result := GetAppDir + 'Highlighters\' - end else begin - Result := DirnameUserAppData + 'Highlighters\'; - end; + Result := DirnameUserAppData + 'Highlighters' + PathDelim; if not DirectoryExists(Result) then begin ForceDirectories(Result); end; diff --git a/source/column_selection.pas b/source/column_selection.pas index 4dfaddbe4..2c5994ad8 100644 --- a/source/column_selection.pas +++ b/source/column_selection.pas @@ -113,16 +113,16 @@ procedure TfrmColumnSelection.chkSelectAllClick(Sender: TObject); cb: TCheckBox; i: Integer; begin - // Avoid executing when checkbox was toggled by code (see proc below) + // Avoid executing when Checked or State property was modified by code. Happens in OnClickCheck handler of TCheckListBox. cb := Sender as TCheckBox; - if cb.Focused then begin - chklistColumns.CheckAll(cb.State); - for i:=0 to chklistColumns.Items.Count-1 do begin - if (FCheckedColumns.IndexOf(chklistColumns.Items[i]) = -1) and (cb.State = cbChecked) then - FCheckedColumns.Add(chklistColumns.Items[i]); - if (FCheckedColumns.IndexOf(chklistColumns.Items[i]) > -1) and (cb.State = cbUnchecked) then - FCheckedColumns.Delete(FCheckedColumns.IndexOf(chklistColumns.Items[i])); - end; + if cb.Tag = SUSPEND_ONCLICK then + Exit; + chklistColumns.CheckAll(cb.State); + for i:=0 to chklistColumns.Items.Count-1 do begin + if (FCheckedColumns.IndexOf(chklistColumns.Items[i]) = -1) and (cb.State = cbChecked) then + FCheckedColumns.Add(chklistColumns.Items[i]); + if (FCheckedColumns.IndexOf(chklistColumns.Items[i]) > -1) and (cb.State = cbUnchecked) then + FCheckedColumns.Delete(FCheckedColumns.IndexOf(chklistColumns.Items[i])); end; end; @@ -170,12 +170,14 @@ procedure TfrmColumnSelection.chklistColumnsClickCheck(Sender: TObject); else AllSelected := False; end; + chkSelectAll.Tag := SUSPEND_ONCLICK; if NoneSelected then chkSelectAll.State := cbUnchecked else if AllSelected then chkSelectAll.State := cbChecked else chkSelectAll.State := cbGrayed; + chkSelectAll.Tag := 0; end; diff --git a/source/connections.dfm b/source/connections.dfm index 9dd6b2079..c458dd6b1 100644 --- a/source/connections.dfm +++ b/source/connections.dfm @@ -140,11 +140,9 @@ object connform: Tconnform Top = 184 Width = 493 Height = 25 + Action = MainForm.actImportSettings Anchors = [akLeft, akTop, akRight] - Caption = 'Import settings ...' - ImageIndex = 101 TabOrder = 0 - OnClick = btnImportSettingsClick end end object tabSettings: TTabSheet @@ -345,6 +343,7 @@ object connform: Tconnform Top = 36 Width = 316 Height = 22 + AutoDropDownWidth = True Style = csDropDownList Anchors = [akLeft, akTop, akRight] TabOrder = 1 @@ -558,21 +557,21 @@ object connform: Tconnform end object lblBackgroundColor: TLabel Left = 3 - Top = 162 + Top = 185 Width = 98 Height = 14 Caption = 'Background color:' end object lblIgnoreDatabasePattern: TLabel Left = 3 - Top = 190 + Top = 213 Width = 126 Height = 14 Caption = 'Hide database pattern:' end object lblLogFile: TLabel Left = 3 - Top = 229 + Top = 252 Width = 102 Height = 14 Caption = 'Log queries to file:' @@ -669,7 +668,7 @@ object connform: Tconnform end object ColorBoxBackgroundColor: TColorBox Left = 190 - Top = 159 + Top = 182 Width = 320 Height = 22 NoneColorColor = clNone @@ -683,7 +682,7 @@ object connform: Tconnform end object editIgnoreDatabasePattern: TEdit Left = 190 - Top = 187 + Top = 210 Width = 320 Height = 22 Anchors = [akLeft, akTop, akRight] @@ -693,7 +692,7 @@ object connform: Tconnform end object chkLogFileDdl: TCheckBox Left = 190 - Top = 253 + Top = 276 Width = 320 Height = 17 Anchors = [akLeft, akTop, akRight] @@ -703,7 +702,7 @@ object connform: Tconnform end object editLogFilePath: TButtonedEdit Left = 190 - Top = 226 + Top = 249 Width = 320 Height = 22 Anchors = [akLeft, akTop, akRight] @@ -717,7 +716,7 @@ object connform: Tconnform end object chkLogFileDml: TCheckBox Left = 190 - Top = 276 + Top = 299 Width = 320 Height = 17 Anchors = [akLeft, akTop, akRight] @@ -725,6 +724,16 @@ object connform: Tconnform TabOrder = 12 OnClick = Modification end + object chkForceUnicode: TCheckBox + Left = 190 + Top = 159 + Width = 320 + Height = 17 + Anchors = [akLeft, akTop, akRight] + Caption = 'Force Unicode (disable on old servers only)' + TabOrder = 13 + OnClick = Modification + end end object tabSSL: TTabSheet Caption = 'SSL' @@ -766,7 +775,7 @@ object connform: Tconnform object lblSSLVerification: TLabel Left = 3 Top = 148 - Width = 131 + Width = 121 Height = 14 Caption = 'Certificate verification:' end @@ -992,29 +1001,35 @@ object connform: Tconnform Text = 'Host' end item - Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus] + Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] Position = 2 - Text = 'User' + Text = 'Port' + Width = 10 end item Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus] Position = 3 + Text = 'User' + end + item + Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus] + Position = 4 Text = 'Version' end item Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 4 + Position = 5 Text = 'Last connect' end item Alignment = taRightJustify Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coAllowFocus] - Position = 5 + Position = 6 Text = 'Counter' end item Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] - Position = 6 + Position = 7 Text = 'Comment' Width = 10 end> diff --git a/source/connections.pas b/source/connections.pas index 355646fef..8914ff9c7 100644 --- a/source/connections.pas +++ b/source/connections.pas @@ -22,6 +22,7 @@ Tconnform = class(TExtForm) btnSave: TButton; btnNew: TButton; btnDelete: TButton; + chkForceUnicode: TCheckBox; popupSessions: TPopupMenu; menuSave: TMenuItem; menuDelete: TMenuItem; @@ -174,7 +175,6 @@ Tconnform = class(TExtForm) var NodeDataSize: Integer); procedure comboNetTypeChange(Sender: TObject); procedure splitterMainMoved(Sender: TObject); - procedure btnImportSettingsClick(Sender: TObject); procedure timerSettingsImportTimer(Sender: TObject); procedure ListSessionsStructureChange(Sender: TBaseVirtualTree; Node: PVirtualNode; Reason: TChangeReason); @@ -237,6 +237,8 @@ Tconnform = class(TExtForm) { Public declarations } end; +var + connform: Tconnform; implementation @@ -295,6 +297,7 @@ procedure Tconnform.FormCreate(Sender: TObject); btnImportSettings.Caption := MainForm.actImportSettings.Caption; FLoaded := False; menuFoldersAtTop.Checked := AppSettings.ReadBool(asSessionManagerListFoldersAtTop); + FSettingsImportWaitTime := 0; comboNetType.Clear; Params := TConnectionParameters.Create; @@ -496,6 +499,7 @@ procedure Tconnform.btnSaveClick(Sender: TObject); Sess.LoginPrompt := chkLoginPrompt.Checked; Sess.WindowsAuth := chkWindowsAuth.Checked; Sess.CleartextPluginEnabled := chkCleartextPluginEnabled.Checked; + Sess.ForceUnicode := chkForceUnicode.Checked; Sess.Port := updownPort.Position; Sess.NetType := SelectedNetType; Sess.Compressed := chkCompressed.Checked; @@ -586,22 +590,17 @@ procedure Tconnform.btnSaveAsClick(Sender: TObject); end; -procedure Tconnform.btnImportSettingsClick(Sender: TObject); -begin - MainForm.actImportSettings.Execute; - FSettingsImportWaitTime := 0; - timerSettingsImport.Enabled := MainForm.ImportSettingsDone; -end; - - procedure Tconnform.timerSettingsImportTimer(Sender: TObject); begin Inc(FSettingsImportWaitTime, timerSettingsImport.Interval); RefreshSessions(nil); - if ListSessions.RootNodeCount > 0 then + if ListSessions.RootNodeCount > 0 then begin timerSettingsImport.Enabled := False; + FSettingsImportWaitTime := 0; + end; if FSettingsImportWaitTime >= 10000 then begin timerSettingsImport.Enabled := False; + FSettingsImportWaitTime := 0; MessageDialog(f_('Imported sessions could not be detected. Restarting %s may solve that.', [APPNAME]), mtWarning, [mbOK]); end; end; @@ -725,6 +724,7 @@ function Tconnform.CurrentParams: TConnectionParameters; Result.LoginPrompt := chkLoginPrompt.Checked; Result.WindowsAuth := chkWindowsAuth.Checked; Result.CleartextPluginEnabled := chkCleartextPluginEnabled.Checked; + Result.ForceUnicode := chkForceUnicode.Checked; if updownPort.Enabled then Result.Port := updownPort.Position else @@ -813,14 +813,15 @@ procedure Tconnform.ListSessionsGetText(Sender: TBaseVirtualTree; CellText := CellText + ' *'; end; 1: CellText := Sess.Hostname; - 2: CellText := Sess.Username; - 3: CellText := Sess.ServerVersion; - 4: if Sess.LastConnect>0 then + 2: CellText := Sess.Port.ToString; + 3: CellText := Sess.Username; + 4: CellText := Sess.ServerVersion; + 5: if Sess.LastConnect>0 then CellText := DateTimeToStr(Sess.LastConnect) else CellText := ''; - 5: CellText := FormatNumber(Sess.Counter); - 6: CellText := Sess.Comment; + 6: CellText := FormatNumber(Sess.Counter); + 7: CellText := Sess.Comment; end; end; end; @@ -1035,6 +1036,7 @@ procedure Tconnform.ListSessionsFocusChanged(Sender: TBaseVirtualTree; chkLoginPrompt.Checked := Sess.LoginPrompt; chkWindowsAuth.Checked := Sess.WindowsAuth; chkCleartextPluginEnabled.Checked := Sess.CleartextPluginEnabled; + chkForceUnicode.Checked := Sess.ForceUnicode; updownPort.Position := Sess.Port; chkCompressed.Checked := Sess.Compressed; updownQueryTimeout.Position := Sess.QueryTimeout; @@ -1296,7 +1298,7 @@ procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject); // Try to connect and lookup database names Params := CurrentParams; Connection := Params.CreateConnection(Self); - Connection.Parameters.AllDatabasesStr := TPgConnection.DBNAME_EMPTY; + Connection.Parameters.AllDatabasesStr := ''; Connection.LogPrefix := SelectedSessionPath; Connection.OnLog := Mainform.LogSQL; FPopupDatabases := TPopupMenu.Create(Self); @@ -1304,26 +1306,13 @@ procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject); Screen.Cursor := crHourglass; try Connection.Active := True; - 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 + if Params.NetTypeGroup = ngPgSQL then + Databases := Connection.GetCol('SELECT datname FROM pg_database WHERE datistemplate=FALSE') + else 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.IsAnyPostgreSQL; @@ -1339,14 +1328,7 @@ procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject); // Check/uncheck items, based on semicolon list Databases := Explode(';', editDatabases.Text); for Item in FPopupDatabases.Items do begin - 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; + Item.Checked := Databases.IndexOf(Item.Caption) > -1; end; Databases.Free; @@ -1364,12 +1346,8 @@ procedure Tconnform.MenuDatabasesClick(Sender: TObject); begin Databases := TStringList.Create; for Item in FPopupDatabases.Items do begin - 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; + if Item.Checked then + Databases.Add(Item.Caption); end; SelStart := editDatabases.SelStart; editDatabases.Text := Implode(';', Databases); @@ -1485,6 +1463,7 @@ procedure Tconnform.Modification(Sender: TObject); or (Sess.LoginPrompt <> chkLoginPrompt.Checked) or (Sess.WindowsAuth <> chkWindowsAuth.Checked) or (Sess.CleartextPluginEnabled <> chkCleartextPluginEnabled.Checked) + or (Sess.ForceUnicode <> chkForceUnicode.Checked) or (Sess.Port <> updownPort.Position) or (Sess.Compressed <> chkCompressed.Checked) or (Sess.QueryTimeout <> updownQueryTimeout.Position) @@ -1522,7 +1501,8 @@ procedure Tconnform.Modification(Sender: TObject); FSessionModified := FSessionModified or PasswordModified; if (Sender=editHost) or (Sender=editUsername) or (Sender=editPassword) or (Sender=comboNetType) or (Sender=chkWindowsAuth) or (Sender=editPort) or - (Sender=chkCleartextPluginEnabled) then begin + (Sender=chkCleartextPluginEnabled) or (Sender=chkForceUnicode) + then begin // Be sure to use the modified connection params next time the user clicks the "Databases" pulldown FreeAndNil(FPopupDatabases); end; @@ -1639,6 +1619,15 @@ procedure Tconnform.ValidateControls; lblSSHLocalPort.Enabled := Params.SSHActive; editSSHlocalport.Enabled := Params.SSHActive; // Advanced tab: + lblQueryTimeout.Enabled := True; + editQueryTimeout.Enabled := lblQueryTimeout.Enabled; + updownQueryTimeout.Enabled := lblQueryTimeout.Enabled; + chkLocalTimeZone.Enabled := Params.NetTypeGroup = ngMySQL; + chkFullTableStatus.Enabled := (Params.NetTypeGroup in [ngMySQL, ngPgSQL, ngSQLite]) and (Params.NetType <> ntMySQL_ProxySQLAdmin); + chkCleartextPluginEnabled.Enabled := Params.NetTypeGroup = ngMySQL; + chkForceUnicode.Enabled := Params.NetTypeGroup = ngMySQL; + editLogFilePath.Enabled := Params.LogFileDdl or Params.LogFileDml; + // SSL tab: chkWantSSL.Enabled := Params.NetType in [ntMySQL_TCPIP, ntMySQL_SSHtunnel, ntMySQL_ProxySQLAdmin, ntMySQL_RDS, ntPgSQL_TCPIP, ntPgSQL_SSHtunnel]; lblSSLPrivateKey.Enabled := Params.WantSSL; editSSLPrivateKey.Enabled := Params.WantSSL; @@ -1650,13 +1639,6 @@ procedure Tconnform.ValidateControls; editSSLcipher.Enabled := Params.WantSSL; lblSSLVerification.Enabled := Params.WantSSL; comboSSLVerification.Enabled := Params.WantSSL; - lblQueryTimeout.Enabled := True; - editQueryTimeout.Enabled := lblQueryTimeout.Enabled; - updownQueryTimeout.Enabled := lblQueryTimeout.Enabled; - chkLocalTimeZone.Enabled := Params.NetTypeGroup = ngMySQL; - 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; Params.Free; end; diff --git a/source/const.inc b/source/const.inc index 75fe8ba49..9cf9371d0 100644 --- a/source/const.inc +++ b/source/const.inc @@ -46,6 +46,8 @@ const ICONINDEX_FUNCTION = 13; ICONINDEX_EVENT = 80; ICONINDEX_KEYWORD = 25; + ICONINDEX_USER = 43; + ICONINDEX_ROLE = 95; // Size of byte units {Kibibyte} SIZE_KB = Int64(1024); @@ -84,6 +86,8 @@ const // Modification indicator for TControl.Tag MODIFIEDFLAG = 10; + // Suspend click event handling tag for checkboxes + SUSPEND_ONCLICK = 20; SUnhandledNodeIndex = 'Unhandled tree node index'; MSG_NOGRIDEDITING = 'Selected columns don''t contain a sufficient set of key columns to allow editing. Please select primary or unique key columns, or just all columns.'; @@ -96,9 +100,11 @@ const MsgUnhandledNetType: String = 'Unhandled connection type (%d)'; MsgUnhandledControl: String = 'Unhandled control in %s'; MsgDisconnect: String = 'Connection to %s closed at %s'; - TextInvalidColumn: String = '?'; + // This must be an empty string, otherwise TTableColumn's get GenerationExpression=XYZ on old servers + TextInvalidColumn: String = ''; FILEFILTER_SQLITEDB = '*.sqlite3;*.sqlite;*.db;*.s3db'; FILEEXT_SQLITEDB = 'sqlite3'; + FILEEXT_SNIPPET = '.sql'; PROPOSAL_ITEM_HEIGHT = 18; // Note the following should be in sync to what MySQL returns from SHOW WARNINGS SLogPrefixWarning = 'Warning'; diff --git a/source/copytable.pas b/source/copytable.pas index fa377e233..af3e8aee8 100644 --- a/source/copytable.pas +++ b/source/copytable.pas @@ -416,7 +416,7 @@ procedure TCopyTableForm.btnOKClick(Sender: TObject); for Column in SelectedColumns do begin AutoIncGetsKey := False; AutoIncRemoved := False; - AutoIncName := Column.AutoIncName; + AutoIncName := FConnection.SqlProvider.GetSql(qAutoInc); if Column.DefaultType = cdtAutoInc then begin for Key in SelectedKeys do begin // Don't check index type, MySQL allows auto-increment columns on nearly all indexes diff --git a/source/createdatabase.dfm b/source/createdatabase.dfm index 2899ccc2f..aac4de882 100644 --- a/source/createdatabase.dfm +++ b/source/createdatabase.dfm @@ -87,6 +87,7 @@ object CreateDatabaseForm: TCreateDatabaseForm Top = 42 Width = 213 Height = 21 + AutoDropDownWidth = True Style = csDropDownList DropDownCount = 16 Sorted = True diff --git a/source/customize_highlighter.dfm b/source/customize_highlighter.dfm index aab3f60a5..7eb0af56a 100644 --- a/source/customize_highlighter.dfm +++ b/source/customize_highlighter.dfm @@ -45,6 +45,7 @@ object frmCustomizeHighlighter: TfrmCustomizeHighlighter Top = 8 Width = 145 Height = 23 + AutoDropDownWidth = True Style = csDropDownList Sorted = True TabOrder = 0 diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 8772e7026..4cfc0436a 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -62,7 +62,6 @@ TTableColumn = class(TPersistent) function CastAsText: String; property Status: TEditingStatus read FStatus write SetStatus; property Connection: TDBConnection read FConnection; - function AutoIncName: String; function FullDataType: String; end; PTableColumn = ^TTableColumn; @@ -70,6 +69,8 @@ TTableColumnList = class(TObjectList) public procedure Assign(Source: TTableColumnList); function FindByName(const Value: String): TTableColumn; + function HasInvisibleColumns: Boolean; + function QuoteIdents: String; end; TColumnCache = TDictionary; @@ -88,8 +89,9 @@ TTableKey = class(TPersistent) public Name, OldName: String; IndexType, OldIndexType, Algorithm, Comment: String; + Size: Int64; Columns, SubParts, Collations: TStringList; - Modified, Added: Boolean; + Modified, Added, Visible: Boolean; constructor Create(AOwner: TDBConnection); destructor Destroy; override; procedure Assign(Source: TPersistent); override; @@ -109,6 +111,9 @@ TTableKey = class(TPersistent) TTableKeyList = class(TObjectList) public procedure Assign(Source: TTableKeyList); + function MaxSize: Int64; + // Retrieve key icon index for a column, or the normal field icon if it has no key + function ImageIndex(ColumnName: String): Integer; end; TKeyCache = TDictionary; @@ -309,7 +314,7 @@ TConnectionParameters = class(TObject) FIgnoreDatabasePattern: String; FPort, FSSHPort, FSSHLocalPort, FSSHTimeout, FCounter, FQueryTimeout, FKeepAlive, FSSLVerification: Integer; FSSHActive, FLoginPrompt, FCompressed, FLocalTimeZone, FFullTableStatus, - FWindowsAuth, FWantSSL, FIsFolder, FCleartextPluginEnabled: Boolean; + FWindowsAuth, FWantSSL, FIsFolder, FCleartextPluginEnabled, FForceUnicode: Boolean; FSessionColor: TColor; FLastConnect: TDateTime; FLogFileDdl: Boolean; @@ -374,6 +379,7 @@ TConnectionParameters = class(TObject) property LoginPrompt: Boolean read FLoginPrompt write FLoginPrompt; property WindowsAuth: Boolean read FWindowsAuth write FWindowsAuth; property CleartextPluginEnabled: Boolean read FCleartextPluginEnabled write FCleartextPluginEnabled; + property ForceUnicode: Boolean read FForceUnicode write FForceUnicode; property AllDatabasesStr: String read FAllDatabases write FAllDatabases; property AllDatabasesList: TStringList read GetAllDatabasesList; property LibraryOrProvider: String read FLibraryOrProvider write FLibraryOrProvider; @@ -544,7 +550,8 @@ TDBConnection = class(TComponent) function UnescapeString(Text: String): String; function ExtractLiteral(var SQL: String; Prefix: String): String; function GetResults(SQL: String): TDBQuery; - function GetCol(SQL: String; Column: Integer=0): TStringList; + // Query one column and return as StringList. Creates Name/Value pairs if NameColumn is 0 or greater. + function GetCol(SQL: String; ValueColumn: Integer=0; NameColumn: Integer=-1): TStringList; function GetVar(SQL: String; Column: Integer=0): String; overload; function GetVar(SQL: String; Column: String): String; overload; function Ping(Reconnect: Boolean): Boolean; virtual; abstract; @@ -586,6 +593,7 @@ TDBConnection = class(TComponent) property KeyCache: TKeyCache read FKeyCache; property ForeignKeyCache: TForeignKeyCache read FForeignKeyCache; property CheckConstraintCache: TCheckConstraintCache read FCheckConstraintCache; + property StringQuoteChar: Char read FStringQuoteChar; property QuoteChar: Char read FQuoteChar; property QuoteChars: String read FQuoteChars; function ServerVersionStr: String; @@ -628,6 +636,7 @@ TDBConnection = class(TComponent) function Has(Item: TFeatureOrRequirement): Boolean; property SqlProvider: TSqlProvider read FSqlProvider; property NamedEnums: TStringList read FNamedEnums; + procedure GetColumnDefaultExpressions(Items: TStrings); virtual; published property Active: Boolean read FActive write SetActive default False; property Database: String read FDatabase write SetDatabase; @@ -706,11 +715,6 @@ 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; @@ -774,6 +778,7 @@ TSQLiteConnection = class(TDBConnection) function GetTableColumns(Table: TDBObject): TTableColumnList; override; function GetTableKeys(Table: TDBObject): TTableKeyList; override; function GetTableForeignKeys(Table: TDBObject): TForeignKeyList; override; + procedure GetColumnDefaultExpressions(Items: TStrings); override; end; TInterbaseRawResults = Array of TFDQuery; @@ -1019,6 +1024,8 @@ function mysql_authentication_dialog_ask( exports mysql_authentication_dialog_ask; +var + WarningShownOldOleProvider: Boolean = False; {$I const.inc} @@ -1406,6 +1413,7 @@ constructor TConnectionParameters.Create; FLoginPrompt := AppSettings.GetDefaultBool(asLoginPrompt); FWindowsAuth := AppSettings.GetDefaultBool(asWindowsAuth); FCleartextPluginEnabled := AppSettings.GetDefaultBool(asCleartextPluginEnabled); + FForceUnicode := AppSettings.GetDefaultBool(asForceUnicode); FUsername := DefaultUsername; FPassword := AppSettings.GetDefaultString(asPassword); FPort := DefaultPort; @@ -1480,10 +1488,13 @@ constructor TConnectionParameters.Create(SessionRegPath: String); FLoginPrompt := AppSettings.ReadBool(asLoginPrompt); FWindowsAuth := AppSettings.ReadBool(asWindowsAuth); FCleartextPluginEnabled := AppSettings.ReadBool(asCleartextPluginEnabled); + FForceUnicode := AppSettings.ReadBool(asForceUnicode); FPort := MakeInt(AppSettings.ReadString(asPort)); FCompressed := AppSettings.ReadBool(asCompressed); FAllDatabases := AppSettings.ReadString(asDatabases); - FLibraryOrProvider := AppSettings.ReadString(asLibrary, '', DefaultLibrary); + FLibraryOrProvider := AppSettings.ReadString(asLibrary); + if not FileExists(GetLibDir + FLibraryOrProvider) then + FLibraryOrProvider := DefaultLibrary; // Catches empty string and any non-existant file FComment := AppSettings.ReadString(asComment); // Auto-activate SSH for sessions created before asSSHtunnelActive was introduced @@ -1556,6 +1567,7 @@ procedure TConnectionParameters.SaveToRegistry; AppSettings.WriteString(asHost, FHostname); AppSettings.WriteBool(asWindowsAuth, FWindowsAuth); AppSettings.WriteBool(asCleartextPluginEnabled, FCleartextPluginEnabled); + AppSettings.WriteBool(asForceUnicode, FForceUnicode); AppSettings.WriteString(asUser, FUsername); AppSettings.WriteString(asPassword, encrypt(FPassword)); AppSettings.WriteBool(asLoginPrompt, FLoginPrompt); @@ -2044,7 +2056,7 @@ function TConnectionParameters.GetLibraries: TStringList; end; case NetTypeGroup of ngMySQL, ngPgSQL, ngSQLite, ngInterbase: begin - Dlls := TDirectory.GetFiles(GetAppDir, '*.dll'); + Dlls := TDirectory.GetFiles(GetLibDir, '*.dll'); for DllPath in Dlls do begin DllFile := ExtractFileName(DllPath); if rx.Exec(DllFile) then begin @@ -2236,7 +2248,7 @@ destructor TDBConnection.Destroy; FInformationSchemaObjects.Free; FNamedEnums.Free; if FOwnsParameters then - FParameters.Free; + FreeAndNil(FParameters); inherited; end; @@ -2299,6 +2311,8 @@ function TDBConnection.GetDatatypeByName(var DataType: String; DeleteFromSource: rx := TRegExpr.Create; rx.ModifierI := True; MatchLen := 0; + // Remove quotes around PG enums: "UserStatus" + DataType := DeQuoteIdent(DataType); for i:=0 to High(FDatatypes) do begin Types := FDatatypes[i].Name; if FDatatypes[i].Names <> '' then begin @@ -2310,7 +2324,7 @@ function TDBConnection.GetDatatypeByName(var DataType: String; DeleteFromSource: TypesSorted.Free; end; - rx.Expression := '\b('+Types+')\b(\[\])?'; + rx.Expression := '^('+Types+')\b(\[\])?'; Match := rx.Exec(DataType); // Prefer a later match which is longer than the one found before. // See http://www.heidisql.com/forum.php?t=17061 @@ -2533,9 +2547,11 @@ procedure TMySQLConnection.SetActive( Value: Boolean ); if Parameters.WantSSL and (not FLib.IsLibMariadb) then ClientFlags := ClientFlags or CLIENT_SSL; - // Point libmysql to the folder with client plugins - PluginDir := AnsiString(GetAppDir+'plugins'); - SetOption(FLib.MYSQL_PLUGIN_DIR, PAnsiChar(PluginDir)); + if not GetPluginDir.IsEmpty then begin + // Point libmysql to the folder with client plugins + PluginDir := AnsiString(GetPluginDir); + SetOption(FLib.MYSQL_PLUGIN_DIR, PAnsiChar(PluginDir)); + end; // Enable cleartext plugin if Parameters.CleartextPluginEnabled then @@ -2716,13 +2732,14 @@ procedure TAdoDBConnection.SetActive(Value: Boolean); end; IsOldProvider := Parameters.LibraryOrProvider = 'SQLOLEDB'; - if IsOldProvider then begin + if IsOldProvider and (not WarningShownOldOleProvider) then begin MessageDialog( f_('Security issue: Using %s %s with insecure %s.', [Parameters.LibraryOrProvider, 'ADO provider', 'TLS 1.0']) + f_('You should install %s from %s', ['Microsoft OLE DB Driver', 'https://www.microsoft.com/en-us/download/confirmation.aspx?id=56730']), mtWarning, [mbOK]); + WarningShownOldOleProvider := True; end; NetLib := ''; @@ -2859,18 +2876,13 @@ procedure TAdoDBConnection.SetActive(Value: Boolean); procedure TPgConnection.SetActive(Value: Boolean); var - dbname, ConnectionString, OptionValue, Error: String; + ConnectionString, OptionValue, Error: String; ConnectOptions: TStringList; FinalHost, ErrorHint: String; FinalPort, i: Integer; begin if Value then begin DoBeforeConnect; - // Simon Riggs: - // "You should connect as "postgres" database by default, with an option to change. Don't use template1" - dbname := FParameters.AllDatabasesStr; - if dbname = '' then - dbname := DBNAME_DEFAULT; // Prepare special stuff for SSH tunnel FinalHost := FParameters.Hostname; @@ -2888,8 +2900,8 @@ procedure TPgConnection.SetActive(Value: Boolean); .AddPair('password', FParameters.Password) .AddPair('application_name', APPNAME) .AddPair('sslmode', 'disable'); - if dbname <> DBNAME_EMPTY then - ConnectOptions.AddPair('dbname', dbname); + if not FParameters.AllDatabasesStr.IsEmpty then + ConnectOptions.AddPair('dbname', FParameters.AllDatabasesStr); if FParameters.WantSSL then begin // Be aware .AddPair would add duplicates case FParameters.SSLVerification of @@ -2938,6 +2950,7 @@ procedure TPgConnection.SetActive(Value: Boolean); raise EDbError.Create(Error, LastErrorCode, ErrorHint); end; FActive := True; + CharacterSet := 'UTF8'; FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); FServerVersionUntouched := GetVar('SELECT VERSION()'); FConnectionStarted := GetTickCount div 1000; @@ -2981,6 +2994,7 @@ procedure TSQLiteConnection.SetActive(Value: Boolean); ErrorHint: String; FileNames, EncryptionParams: TStringList; MainFile, DbAlias, Param, ParamName: String; + MainFileDir: String; i, SplitPos, ParamValue: Integer; CipherIndex, ConfigResult: Integer; ParamWasSet: Boolean; @@ -2991,8 +3005,12 @@ procedure TSQLiteConnection.SetActive(Value: Boolean); if Value then begin // Fixes "out of memory" crash in sqlite3_open, see issue #1367 + MainFileDir := ExtractFilePath(MainFile); + MainFileDir := IncludeTrailingPathDelimiter(MainFileDir); + if not DirectoryExists(MainFileDir) then + raise EDbError.Create(f_('Folder in path does not exist: %s', [MainFile])); if not FileExists(MainFile) then - raise EDbError.Create(f_('File does not exist: %s', [MainFile])); + Log(lcInfo, f_('File does not yet exist, will be created now: %s', [MainFile])); DoBeforeConnect; @@ -3300,7 +3318,7 @@ procedure TMySQLConnection.DoBeforeConnect; LibraryPath: String; begin // Init libmysql before actually connecting. - LibraryPath := GetAppDir + Parameters.LibraryOrProvider; + LibraryPath := GetLibDir + Parameters.LibraryOrProvider; Log(lcDebug, f_('Loading library file %s ...', [LibraryPath])); // Throws EDbError on any failure: FLib := TMySQLLib.Create(LibraryPath, Parameters.DefaultLibrary); @@ -3315,7 +3333,7 @@ procedure TPgConnection.DoBeforeConnect; msg: String; begin // Init lib before actually connecting. - LibraryPath := GetAppDir + Parameters.LibraryOrProvider; + LibraryPath := GetLibDir + Parameters.LibraryOrProvider; Log(lcDebug, f_('Loading library file %s ...', [LibraryPath])); try FLib := TPostgreSQLLib.Create(LibraryPath, Parameters.DefaultLibrary); @@ -3346,7 +3364,7 @@ procedure TSQLiteConnection.DoBeforeConnect; LibraryPath: String; begin // Init lib before actually connecting. - LibraryPath := GetAppDir + Parameters.LibraryOrProvider; + LibraryPath := GetLibDir + Parameters.LibraryOrProvider; Log(lcDebug, f_('Loading library file %s ...', [LibraryPath])); // Throws EDbError on any failure: if Parameters.NetType = ntSQLite then @@ -3490,7 +3508,7 @@ procedure TDBConnection.DoAfterConnect; else Offset := '-'; Offset := Offset + Format('%.2d:%.2d', [Abs(Hours), Abs(Minutes)]); - Query(FSqlProvider.GetSql(qSetTimezone, [EscapeString(Offset)])); + Query(qSetTimezone, [EscapeString(Offset)]); end; // Process startup script @@ -3617,6 +3635,11 @@ function TAdoDBConnection.Ping(Reconnect: Boolean): Boolean; if Reconnect then Active := True; end; + end + else begin + // Not active currently, reconnect + if Reconnect then + Active := True; end; Result := FActive; // Restart keep-alive timer @@ -3688,6 +3711,11 @@ function TInterbaseConnection.Ping(Reconnect: Boolean): Boolean; Log(lcDebug, 'Ping server ...'); if FActive then begin FFDHandle.Ping; + end + else begin + // Not active currently, reconnect + if Reconnect then + Active := True; end; Result := FActive; // Restart keep-alive timer @@ -4438,7 +4466,6 @@ procedure TDBConnection.PrefetchCreateCode(Objects: TDBObjectList); procedure TDBConnection.SetDatabase(Value: String); var s: String; - UseQuery: String; begin Log(lcDebug, 'SetDatabase('+Value+'), FDatabase: '+FDatabase); if Value <> FDatabase then begin @@ -4458,9 +4485,8 @@ procedure TDBConnection.SetDatabase(Value: String); s := s + ', ' + EscapeString('public'); end else s := QuoteIdent(Value); - UseQuery := FSqlProvider.GetSql(qUSEQuery); - if not UseQuery.IsEmpty then begin - Query(FSqlProvider.GetSql(qUSEQuery, [s]), False); + if FSqlProvider.Has(qUSEQuery) then begin + Query(qUSEQuery, [s]); end; FDatabase := DeQuoteIdent(Value); if Assigned(FOnDatabaseChanged) then @@ -4600,17 +4626,21 @@ procedure TMySQLConnection.SetCharacterSet(CharsetName: String); FStatementNum := 0; Log(lcInfo, 'Changing character set from '+CharacterSet+' to '+CharsetName); Return := FLib.mysql_set_character_set(FHandle, PAnsiChar(Utf8Encode(CharsetName))); + // Return value never seems to be <> 0, not even on v3.23 servers, we check it anyway: if Return <> 0 then - raise EDbError.Create(LastErrorMsg) - else - FIsUnicode := CharsetName.StartsWith('utf', True); + raise EDbError.Create(LastErrorMsg); + // Check opt-out setting: if disabled, align the internal IsUnicode flag to the connection charset + if not FParameters.ForceUnicode then begin + FIsUnicode := CharacterSet.StartsWith('utf', True); + Log(lcInfo, 'ForceUnicode disabled in settings. Internal IsUnicode flag is now: ' + FIsUnicode.ToInteger.ToString) + end; end; procedure TPGConnection.SetCharacterSet(CharsetName: String); begin // See issue #22 - Query('SET CLIENT_ENCODING TO ' + EscapeString('UTF8')); + Query('SET CLIENT_ENCODING TO ' + EscapeString(CharsetName)); end; @@ -5484,12 +5514,14 @@ function TDBConnection.FindObject(DB, Obj: String): TDBObject; var Objects: TDBObjectList; o: TDBObject; + fqname: String; begin // Find TDBObject by db and table string Objects := GetDBObjects(DB); Result := nil; for o in Objects do begin - if o.Name = Obj then begin + fqname := o.Schema + '.' + o.Name; // includes "dbo." schema + if (o.Name = Obj) or (fqname = Obj) then begin Result := o; Break; end; @@ -5500,16 +5532,20 @@ function TDBConnection.FindObject(DB, Obj: String): TDBObject; end; -function TDBConnection.GetCol(SQL: String; Column: Integer=0): TStringList; +function TDBConnection.GetCol(SQL: String; ValueColumn: Integer=0; NameColumn: Integer=-1): TStringList; var Results: TDBQuery; begin Results := GetResults(SQL); Result := TStringList.Create; - if Results.RecordCount > 0 then while not Results.Eof do begin - Result.Add(Results.Col(Column)); - Results.Next; - end; + if Results.RecordCount > 0 then + while not Results.Eof do begin + if NameColumn < 0 then + Result.Add(Results.Col(ValueColumn)) + else + Result.AddPair(Results.Col(NameColumn), Results.Col(ValueColumn)); + Results.Next; + end; FreeResults(Results); end; @@ -5887,7 +5923,7 @@ function TDBConnection.GetTableColumns(Table: TDBObject): TTableColumnList; else if ExecRegExpr('\bauto_increment\b', ExtraText.ToLowerInvariant) then begin // MySQL auto increment Col.DefaultType := cdtAutoInc; - Col.DefaultText := Col.AutoIncName; + Col.DefaultText := FSqlProvider.GetSql(qAutoInc); end else if DefText.ToLowerInvariant = 'null' then begin Col.DefaultType := cdtNull; @@ -5975,7 +6011,7 @@ function TMySQLConnection.GetTableColumns(Table: TDBObject): TTableColumnList; Col.OnUpdateType := cdtNothing; if ExecRegExpr('^auto_increment$', ExtraText.ToLowerInvariant) then begin Col.DefaultType := cdtAutoInc; - Col.DefaultText := Col.AutoIncName; + Col.DefaultText := FSqlProvider.GetSql(qAutoInc); end else if ColQuery.IsNull('Default') then begin Col.DefaultType := cdtNothing; end else if IsTextDefault(DefText, Col.DataType) then begin @@ -6058,6 +6094,10 @@ function TSQLiteConnection.GetTableColumns(Table: TDBObject): TTableColumnList; Col.AllowNull := ColQuery.Col('notnull') <> '1'; Col.DefaultType := cdtNothing; Col.DefaultText := ''; + if not ColQuery.Col('dflt_value').IsEmpty then begin + Col.DefaultType := cdtText; + Col.DefaultText := ColQuery.Col('dflt_value').DeQuotedString(FStringQuoteChar); + end; Col.OnUpdateType := cdtNothing; Col.OnUpdateText := ''; case StrToIntDef(ColQuery.Col('hidden'), 0) of @@ -6145,6 +6185,8 @@ function TMySQLConnection.GetTableKeys(Table: TDBObject): TTableKeyList; var KeyQuery, ColQuery: TDBQuery; NewKey: TTableKey; + SizeQuery: String; + SizeByIndex: TStringList; begin Result := TTableKeyList.Create(True); @@ -6195,7 +6237,13 @@ function TMySQLConnection.GetTableKeys(Table: TDBObject): TTableKeyList; end else begin - KeyQuery := GetResults('SHOW INDEXES FROM '+QuoteIdent(Table.Name)+' FROM '+QuoteIdent(Table.Database)); + KeyQuery := GetResults('SHOW KEYS FROM '+QuoteIdent(Table.Name)+' FROM '+QuoteIdent(Table.Database)); + SizeByIndex := nil; + if FSqlProvider.Has(qIndexSize) then try + SizeQuery := FSqlProvider.GetSql(qIndexSize, [EscapeString(Table.Database), EscapeString(Table.Name)]); + SizeByIndex := GetCol(SizeQuery, 1, 0); + except + end; NewKey := nil; while not KeyQuery.Eof do begin if (not Assigned(NewKey)) or (NewKey.Name <> KeyQuery.Col('Key_name')) then begin @@ -6219,7 +6267,16 @@ function TMySQLConnection.GetTableKeys(Table: TDBObject): TTableKeyList; if ExecRegExpr('(BTREE|HASH)', KeyQuery.Col('Index_type')) then NewKey.Algorithm := KeyQuery.Col('Index_type'); NewKey.Comment := KeyQuery.Col('Index_comment', True); + if KeyQuery.ColumnExists('Visible') then // mysql 8 + NewKey.Visible := SameText(KeyQuery.Col('Visible'), 'yes') + else if KeyQuery.ColumnExists('Ignored') then // mariadb 10.6 + NewKey.Visible := SameText(KeyQuery.Col('Ignored'), 'NO'); + + if Assigned(SizeByIndex) then + NewKey.Size := StrToInt64Def(SizeByIndex.Values[NewKey.Name], NewKey.Size); + end; + if KeyQuery.ColumnExists('Expression') and (not KeyQuery.IsNull('Expression')) then begin // Functional key part: enclose expression within parentheses to distinguish them from columns (issue #1777) NewKey.Columns.Add('('+KeyQuery.Col('Expression')+')'); @@ -6444,14 +6501,17 @@ function TAdoDbConnection.GetTableForeignKeys(Table: TDBObject): TForeignKeyList ForeignQuery := GetResults('SELECT'+ ' f.name AS foreign_key_name,'+ ' COL_NAME(fc.parent_object_id, fc.parent_column_id) AS constraint_column_name,'+ - ' OBJECT_NAME (f.referenced_object_id) AS referenced_object,'+ + ' SCHEMA_NAME(ro.schema_id) AS referenced_schema,'+ + ' OBJECT_NAME(f.referenced_object_id) AS referenced_object,'+ ' COL_NAME(fc.referenced_object_id, fc.referenced_column_id) AS referenced_column_name,'+ ' update_referential_action_desc,'+ ' delete_referential_action_desc'+ ' FROM sys.foreign_keys AS f'+ ' INNER JOIN sys.foreign_key_columns AS fc'+ ' ON f.object_id = fc.constraint_object_id'+ - ' WHERE f.parent_object_id = OBJECT_ID('+EscapeString(Table.Name)+')' + ' INNER JOIN sys.objects AS ro'+ + ' ON ro.object_id = f.referenced_object_id'+ + ' WHERE f.parent_object_id = OBJECT_ID('+EscapeString(Table.QuotedDbAndTableName)+')' ); ForeignKey := nil; while not ForeignQuery.Eof do begin @@ -6460,7 +6520,8 @@ function TAdoDbConnection.GetTableForeignKeys(Table: TDBObject): TForeignKeyList Result.Add(ForeignKey); ForeignKey.KeyName := ForeignQuery.Col('foreign_key_name'); ForeignKey.OldKeyName := ForeignKey.KeyName; - ForeignKey.ReferenceTable := ForeignQuery.Col('referenced_object'); + ForeignKey.ReferenceTable := + ForeignQuery.Col('referenced_schema') + '.' + ForeignQuery.Col('referenced_object'); ForeignKey.OnUpdate := ForeignQuery.Col('update_referential_action_desc'); ForeignKey.OnDelete := ForeignQuery.Col('delete_referential_action_desc'); end; @@ -6624,6 +6685,14 @@ function TInterbaseConnection.GetTableForeignKeys(Table: TDBObject): TForeignKey ForeignQuery.Free; end; +procedure TSQLiteConnection.GetColumnDefaultExpressions(Items: TStrings); +begin + // Add some extra default values allowed for SQLite + inherited; + Items.Add('CURRENT_TIME'); + Items.Add('CURRENT_DATE'); + Items.Add('CURRENT_TIMESTAMP'); +end; function TDBConnection.GetTableCheckConstraints(Table: TDBObject): TCheckConstraintList; var @@ -6728,12 +6797,23 @@ function TDBConnection.Has(Item: TFeatureOrRequirement): Boolean; frInvisibleColumns: Result := (FParameters.IsMariaDB and (ServerVersionInt >= 100303)) or (FParameters.IsMySQL(True) and (ServerVersionInt >= 80023)); frCompressedColumns: Result := (FParameters.IsMariaDB and (ServerVersionInt >= 100301)); + else Result := False; end; else Result := False; end; end; +procedure TDBConnection.GetColumnDefaultExpressions(Items: TStrings); +var + SQLFunc: TSQLFunction; +begin + for SQLFunc in SQLFunctions do begin + Items.Add(SQLFunc.Name + SQLFunc.Declaration); + end; +end; + + function TDBConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; var Rows, QueryApprox, QueryExact: String; @@ -7795,7 +7875,7 @@ procedure TDBConnection.ParseViewStructure(CreateCode: String; DBObj: TDBObject; CheckOption := Trim(rx.Match[11]); SelectCode := rx.Match[9]; end else - raise Exception.CreateFmt(_('Regular expression did not match the VIEW code in %s: %s'), ['ParseViewStructure()', CRLF+CRLF+CreateCode]); + Log(lcError, f_('Regular expression did not match the VIEW code in %s: %s', ['ParseViewStructure()', CRLF+CRLF+CreateCode])); rx.Free; end; @@ -8322,6 +8402,8 @@ procedure TAdoDBQuery.Execute(AddResult: Boolean=False; UseRawResult: Integer=-1 TypeIndex := dbdtDateTime; //ftTimeStampOffset: // this is NOT data type DATETIMEOFFSET // TypeIndex := dbdtDatetime; + ftCurrency: + TypeIndex := dbdtMoney; else raise EDbError.CreateFmt(_('Unknown data type for column #%d - %s: %d'), [i, FColumnNames[i], Integer(LastResult.Fields[i].DataType)]); end; @@ -9034,8 +9116,8 @@ function TPGQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; SetString(AnsiStr, FConnection.Lib.PQgetvalue(FCurrentResults, FRecNoLocal, Column), FColumnLengths[Column]); if Datatype(Column).Category in [dtcBinary, dtcSpatial] then Result := String(AnsiStr) - else if Datatype(Column).Index = dbdtBool then - if AnsiStr='t' then Result := 'true' else Result := 'false' + else if (Datatype(Column).Index = dbdtBool) and (Length(AnsiStr) > 0) then + Result := IfThen(AnsiStr='t', 'true', 'false') else Result := Connection.DecodeAPIString(AnsiStr); end; @@ -9503,7 +9585,7 @@ procedure TDBQuery.DeleteRow; TempRowsAffected := Connection.RowsAffected; Connection.ShowWarnings; if TempRowsAffected = 0 then - raise EDbError.Create(FormatNumber(TempRowsAffected)+' rows deleted when that should have been 1.'); + raise EDbError.Create(f_('The DELETE affected %s rows, but 1 was expected. On tables without a primary or unique key, HeidiSQL must match on all columns, so edits may not reliably target the intended row.', [FormatNumber(TempRowsAffected)])); end; if Assigned(FCurrentUpdateRow) then begin FUpdateData.Remove(FCurrentUpdateRow); @@ -9768,7 +9850,7 @@ function TDBQuery.SaveModifications: Boolean; TempRowsAffected := Connection.RowsAffected; Connection.ShowWarnings; if TempRowsAffected = 0 then begin - raise EDbError.Create(FormatNumber(TempRowsAffected)+' rows updated when that should have been 1.'); + raise EDbError.Create(f_('The UPDATE affected %s rows, but 1 was expected. On tables without a primary or unique key, HeidiSQL must match on all columns, so edits may not reliably target the intended row.', [FormatNumber(TempRowsAffected)])); Result := False; end; end; @@ -10808,8 +10890,9 @@ function TTableColumn.SQLCode(OverrideCollation: String=''; Parts: TColumnParts= Result := Result + ' ZEROFILL'; if Compressed and FConnection.Parameters.IsMariaDB then Result := Result + ' /*!100301 COMPRESSED*/'; - Result := Result + ' '; // Add space after each part end; + + Result := Result + ' '; // Add space after each part end; if InParts(cpAllowNull) and (not IsVirtual) and (not FConnection.Parameters.IsAnyMSSQL) then begin @@ -10834,7 +10917,7 @@ function TTableColumn.SQLCode(OverrideCollation: String=''; Parts: TColumnParts= cdtAutoInc: begin case FConnection.Parameters.NetTypeGroup of ngPgSQL:; - else Result := Result + AutoIncName; + else Result := Result + FConnection.SqlProvider.GetSql(qAutoInc); end; end; cdtExpression: begin @@ -10933,34 +11016,28 @@ procedure TTableColumn.ParseDatatype(Source: String); function TTableColumn.CastAsText: String; +var + ColTypeAllowsCast: Boolean; begin // Cast data types which are incompatible to string functions to text columns Result := FConnection.QuoteIdent(Name); + ColTypeAllowsCast := True; case FConnection.Parameters.NetTypeGroup of ngMySQL, ngSQLite: begin - if DataType.Index in [dbdtUnknown, dbdtDate, dbdtDatetime, dbdtTime, dbdtTimestamp, dbdtJson, dbdtJsonB] then - Result := 'CAST('+Result+' AS CHAR)'; + ColTypeAllowsCast := DataType.Index in [dbdtUnknown, dbdtDate, dbdtDatetime, dbdtTime, dbdtTimestamp, dbdtJson, dbdtJsonB]; end; ngMSSQL: begin // Be sure LEFT() and "col LIKE xyz" work with MSSQL // Also, prevent exceeding size limit of 8000 for NVARCHAR - if DataType.Index in [dbdtUnknown, dbdtNtext, dbdtText] then - Result := 'CAST('+Result+' AS NVARCHAR('+IntToStr(GRIDMAXDATA)+'))'; + ColTypeAllowsCast := DataType.Index in [dbdtUnknown, dbdtNtext, dbdtText]; end; ngPgSQL: begin - if (DataType.Index in [dbdtUnknown, dbdtJson]) or (DataType.Category = dtcBinary) then - Result := Result + '::text'; + // Cast most datatypes, including VARCHAR and TEXT, which may have an [] array attribute + ColTypeAllowsCast := not (DataType.Category in [dtcInteger, dtcReal]); end; end; -end; - - -function TTableColumn.AutoIncName: String; -begin - case FConnection.Parameters.NetTypeGroup of - ngPgSQL: Result := 'SERIAL'; - else Result := 'AUTO_INCREMENT'; - end; + if ColTypeAllowsCast and FConnection.SqlProvider.Has(qCastAsText) then + Result := FConnection.SqlProvider.GetSql(qCastAsText, [Result]); end; @@ -11001,6 +11078,31 @@ function TTableColumnList.FindByName(const Value: String): TTableColumn; end; end; +function TTableColumnList.HasInvisibleColumns: Boolean; +var + Col: TTableColumn; +begin + Result := False; + for Col in Self do begin + if Col.Invisible then begin + Result := True; + Break; + end; + end; +end; + +function TTableColumnList.QuoteIdents: String; +var + Col: TTableColumn; + QuotedNames: TStringList; +begin + QuotedNames := TStringList.Create; + for Col in Self do begin + QuotedNames.Add(Col.Connection.QuoteIdent(Col.Name)); + end; + Result := Implode(', ', QuotedNames); + QuotedNames.Free; +end; { *** TTableKey } @@ -11015,6 +11117,8 @@ constructor TTableKey.Create(AOwner: TDBConnection); Columns.OnChange := Modification; Subparts.OnChange := Modification; Collations.OnChange := Modification; + Visible := True; + Size := -1 end; destructor TTableKey.Destroy; @@ -11037,6 +11141,8 @@ procedure TTableKey.Assign(Source: TPersistent); OldIndexType := s.OldIndexType; Algorithm := s.Algorithm; Comment := s.Comment; + Visible := s.Visible; + Size := s.Size; Columns.Assign(s.Columns); SubParts.Assign(s.SubParts); Collations.Assign(s.Collations); @@ -11154,6 +11260,7 @@ function TTableKey.SQLCode(TableName: String=''): String; if not Comment.IsEmpty then Result := Result + ' COMMENT ' + FConnection.EscapeString(Comment); + end else begin // SQLite syntax: @@ -11185,7 +11292,28 @@ procedure TTableKeyList.Assign(Source: TTableKeyList); end; end; +function TTableKeyList.MaxSize: Int64; +var + Item: TTableKey; +begin + Result := -1; + for Item in Self do begin + Result := Max(Result, Item.Size); + end; +end; +function TTableKeyList.ImageIndex(ColumnName: String): Integer; +var + Key: TTableKey; +begin + Result := ICONINDEX_FIELD; + for Key in Self do begin + if Key.Columns.Contains(ColumnName) then begin + Result := Key.ImageIndex; + Break; + end; + end; +end; { *** TForeignKey } diff --git a/source/dbstructures.interbase.pas b/source/dbstructures.interbase.pas index ca9711ccd..cadd7e8b2 100644 --- a/source/dbstructures.interbase.pas +++ b/source/dbstructures.interbase.pas @@ -184,7 +184,7 @@ function TInterbaseProvider.GetSql(AId: TQueryId): string; begin case AId of qDatabaseDrop: Result := 'DROP DATABASE %s'; - qEmptyTable: Result := 'TRUNCATE '; + qEmptyTable: Result := 'TRUNCATE %s'; qRenameTable: Result := 'RENAME TABLE %s TO %s'; qRenameView: Result := 'RENAME TABLE %s TO %s'; qCurrentUserHost: Result := IfThen( @@ -234,6 +234,7 @@ function TInterbaseProvider.GetSql(AId: TQueryId): string; ' 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'; + else Result := inherited; end; end; diff --git a/source/dbstructures.mssql.pas b/source/dbstructures.mssql.pas index 41d033ebb..750e02b43 100644 --- a/source/dbstructures.mssql.pas +++ b/source/dbstructures.mssql.pas @@ -3,7 +3,7 @@ interface uses - dbstructures, StrUtils; + dbstructures, StrUtils, SysUtils; type TMsSqlProvider = class(TSqlProvider) @@ -413,6 +413,7 @@ TMsSqlProvider = class(TSqlProvider) implementation +{$I const.inc} function TMsSqlProvider.GetSql(AId: TQueryId): string; begin @@ -448,13 +449,37 @@ function TMsSqlProvider.GetSql(AId: TQueryId): string; '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'; + qSetColumnComment: Result := 'IF NOT EXISTS (' + sLineBreak + + ' SELECT 1' + sLineBreak + + ' FROM fn_listextendedproperty (' + sLineBreak + + ' N''MS_Description'',' + sLineBreak + + ' N''SCHEMA'', :EscapedSchema,' + sLineBreak + + ' N''TABLE'', :EscapedName,' + sLineBreak + + ' N''COLUMN'', :TargetColumn' + sLineBreak + + ' )' + sLineBreak + + ')' + sLineBreak + + 'BEGIN' + sLineBreak + + ' EXEC sys.sp_addextendedproperty' + sLineBreak + + ' @name = N''MS_Description'',' + sLineBreak + + ' @value = :NewComment,' + sLineBreak + + ' @level0type = N''SCHEMA'', @level0name = :EscapedSchema,' + sLineBreak + + ' @level1type = N''TABLE'', @level1name = :EscapedName,' + sLineBreak + + ' @level2type = N''COLUMN'', @level2name = :TargetColumn' + sLineBreak + + 'END' + sLineBreak + + 'ELSE BEGIN' + sLineBreak + + ' EXEC sys.sp_updateextendedproperty' + sLineBreak + + ' @name = N''MS_Description'',' + sLineBreak + + ' @value = :NewComment,' + sLineBreak + + ' @level0type = N''SCHEMA'', @level0name = :EscapedSchema,' + sLineBreak + + ' @level1type = N''TABLE'', @level1name = :EscapedName,' + sLineBreak + + ' @level2type = N''COLUMN'', @level2name = :TargetColumn' + sLineBreak + + 'END'; 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'; @@ -481,6 +506,7 @@ function TMsSqlProvider.GetSql(AId: TQueryId): string; 'SELECT SUM("rows") FROM "sys"."partitions" WHERE "index_id" IN (0, 1) AND "object_id" = object_id(:EscapedDbSchemaName)', '' ); + qCastAsText: Result := 'CAST(%s AS NVARCHAR('+IntToStr(GRIDMAXDATA)+'))'; else Result := inherited; end; end; diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index b49a31f35..c872f0833 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -3238,10 +3238,14 @@ procedure TMySQLLib.AssignProcedures; { TMySqlProvider } function TMySqlProvider.GetSql(AId: TQueryId): string; +var + IsMariaDB, IsMySQL: Boolean; begin + IsMariaDB := ServerVersion >= 100000; + IsMySQL := not IsMariaDB; case AId of qDatabaseDrop: Result := 'DROP DATABASE %s'; - qEmptyTable: Result := 'TRUNCATE '; + qEmptyTable: Result := 'TRUNCATE %s'; qRenameTable: Result := 'RENAME TABLE %s TO %s'; qRenameView: Result := 'RENAME TABLE %s TO %s'; qCurrentUserHost: Result := 'SELECT CURRENT_USER()'; @@ -3259,7 +3263,11 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; 'SHOW /*!50002 GLOBAL */ STATUS LIKE ''Com\_%''' ); qSessionVariables: Result := 'SHOW VARIABLES'; - qGlobalVariables: Result := 'SHOW GLOBAL VARIABLES'; + qGlobalVariables: Result := IfThen( + FServerVersion >= 40000, + 'SHOW GLOBAL VARIABLES', + '' + ); qISSchemaCol: Result := '%s_SCHEMA'; qUSEQuery: Result := 'USE %s'; qKillQuery: Result := IfThen( @@ -3352,12 +3360,12 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; ); qShowFunctionStatus: Result := IfThen( (FServerVersion >= 50000) and (FNetType <> ntMySQL_ProxySQLAdmin), - 'SHOW FUNCTION STATUS WHERE Db = %s', + 'SHOW FUNCTION STATUS WHERE LOWER(Db) = LOWER(%s)', '' ); qShowProcedureStatus: Result := IfThen( (FServerVersion >= 50000) and (FNetType <> ntMySQL_ProxySQLAdmin), - 'SHOW PROCEDURE STATUS WHERE Db = %s', + 'SHOW PROCEDURE STATUS WHERE LOWER(Db) = LOWER(%s)', '' ); qShowTriggers: Result := IfThen( @@ -3393,6 +3401,40 @@ function TMySqlProvider.GetSql(AId: TQueryId): string; qCreateRole: Result := 'CREATE ROLE %s'; qDropRole: Result := 'DROP ROLE %s'; qReloadPrivileges: Result := 'FLUSH PRIVILEGES'; + qGrantRole: Result := 'GRANT %s TO %s%s'; + qRevokeRole: Result := 'REVOKE %s FROM %s'; + qSetDefaultRole: Result := 'SET DEFAULT ROLE %s FOR %s'; + qIndexVisible: + if IsMariaDB and (FServerVersion >= 100600) then + Result := 'NOT IGNORED' + else if IsMySQL and (FServerVersion >= 80000) then + Result := 'VISIBLE' + else + Result := ''; + qIndexInvisible: + if IsMariaDB and (FServerVersion >= 100600) then + Result := 'IGNORED' + else if IsMySQL and (FServerVersion >= 80000) then + Result := 'INVISIBLE' + else + Result := ''; + qGetAuthPlugins: Result := IfThen( + (FServerVersion >= 50100) or IsMariaDB, // mysql 5.1+ and all mariadb versions + 'SELECT PLUGIN_NAME FROM INFORMATION_SCHEMA.PLUGINS WHERE PLUGIN_TYPE=''AUTHENTICATION'' AND PLUGIN_STATUS=''ACTIVE''', + '' + ); + qCastAsText: Result := IfThen( + FServerVersion >= 40002, + 'CAST(%s AS CHAR)', + '' + ); + qIndexSize: Result := IfThen( + (IsMySQL and (FServerVersion >= 50600)) or IsMariaDB, + 'SELECT index_name, stat_value * @@innodb_page_size AS bytes' + + ' FROM mysql.innodb_index_stats'+ + ' WHERE database_name=%s AND table_name=%s AND stat_name=''size''', + '' + ); else Result := inherited; end; end; diff --git a/source/dbstructures.pas b/source/dbstructures.pas index 11773efe4..8056bca0c 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -40,7 +40,7 @@ interface TQueryId = (qDatabaseTable, qDatabaseTableId, qDatabaseDrop, qDbObjectsTable, qDbObjectsCreateCol, qDbObjectsUpdateCol, qDbObjectsTypeCol, qEmptyTable, qRenameTable, qRenameView, qCurrentUserHost, qLikeCompare, - qAddColumn, qChangeColumn, qRenameColumn, qForeignKeyEventAction, + qAddColumn, qChangeColumn, qRenameColumn, qSetColumnComment, qForeignKeyEventAction, qGlobalStatus, qCommandsCounters, qSessionVariables, qGlobalVariables, qISSchemaCol, qUSEQuery, qKillQuery, qKillProcess, @@ -50,7 +50,9 @@ interface qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets, qGetReverseForeignKeys, qExplain, qSetTimezone, qShowFunctionStatus, qShowProcedureStatus, qShowTriggers, qShowEvents, qShowCreateTrigger, - qHelpKeyword, qShowWarnings, qGetEnumTypes, qDropUser, qCreateRole, qDropRole, qReloadPrivileges); + qHelpKeyword, qShowWarnings, qGetEnumTypes, + qDropUser, qCreateRole, qDropRole, qReloadPrivileges, qGrantRole, qRevokeRole, qSetDefaultRole, + qAutoInc, qIndexVisible, qIndexInvisible, qGetAuthPlugins, qCastAsText, qIndexSize); TSqlProvider = class strict protected FNetType: TNetType; @@ -208,10 +210,12 @@ function TSqlProvider.GetSql(AId: TQueryId): string; begin // Basic default SQL snippets compatible to all or most servers case AId of + qEmptyTable: Result := 'DELETE FROM %s'; qForeignKeyEventAction: Result := 'RESTRICT,CASCADE,SET NULL,NO ACTION'; qOrderAsc: Result := 'ASC'; qOrderDesc: Result := 'DESC'; qGetRowCountExact: Result := 'SELECT COUNT(*) FROM :QuotedDbAndTableName'; + qAutoInc: Result := 'AUTO_INCREMENT'; else Result := ''; end; end; diff --git a/source/dbstructures.postgresql.pas b/source/dbstructures.postgresql.pas index 5dd19a0a6..9489241ba 100644 --- a/source/dbstructures.postgresql.pas +++ b/source/dbstructures.postgresql.pas @@ -597,7 +597,6 @@ 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'; @@ -727,6 +726,7 @@ function TPostgreSQLProvider.GetSql(AId: TQueryId): string; ' WHERE pg_class.relkind=''r'''+ ' AND pg_namespace.nspname=:EscapedDatabase'+ ' AND pg_class.relname=:EscapedName'; + qExplain: Result := 'EXPLAIN %s'; qGetEnumTypes: Result := IfThen( FServerVersion >= 90000, 'SELECT ' + @@ -743,6 +743,8 @@ function TPostgreSQLProvider.GetSql(AId: TQueryId): string; 'ORDER BY UPPER(t.typname)', '' // ServerVersion < 9 ); + qAutoInc: Result := 'SERIAL'; + qCastAsText: Result := '%s::text'; else Result := inherited; end; end; diff --git a/source/dbstructures.sqlite.pas b/source/dbstructures.sqlite.pas index 60e85cc06..fb1cef0cc 100644 --- a/source/dbstructures.sqlite.pas +++ b/source/dbstructures.sqlite.pas @@ -399,7 +399,6 @@ 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 @@ -428,6 +427,8 @@ function TSQLiteProvider.GetSql(AId: TQueryId): string; 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'''; + qExplain: Result := 'EXPLAIN %s'; + qCastAsText: Result := 'CAST(%s AS CHAR)'; else Result := inherited; end; end; diff --git a/source/event_editor.dfm b/source/event_editor.dfm index 799821e49..1f8cf935e 100644 --- a/source/event_editor.dfm +++ b/source/event_editor.dfm @@ -171,6 +171,7 @@ object frmEventEditor: TfrmEventEditor Top = 3 Width = 194 Height = 21 + AutoDropDownWidth = True Anchors = [akLeft, akTop, akRight] TabOrder = 4 Text = 'comboDefiner' @@ -247,6 +248,7 @@ object frmEventEditor: TfrmEventEditor Top = 48 Width = 133 Height = 21 + AutoDropDownWidth = True Style = csDropDownList TabOrder = 6 OnChange = comboEveryIntervalChange diff --git a/source/exportgrid.dfm b/source/exportgrid.dfm index 470ebdbfa..efbaf7bcf 100644 --- a/source/exportgrid.dfm +++ b/source/exportgrid.dfm @@ -183,7 +183,7 @@ object frmExportGrid: TfrmExportGrid RightButton.DisabledImageIndex = 107 RightButton.ImageIndex = 108 RightButton.Visible = True - TabOrder = 5 + TabOrder = 6 Text = ';' OnChange = editCSVChange OnRightButtonClick = editCSVRightButtonClick @@ -198,7 +198,7 @@ object frmExportGrid: TfrmExportGrid RightButton.DisabledImageIndex = 107 RightButton.ImageIndex = 108 RightButton.Visible = True - TabOrder = 6 + TabOrder = 7 OnChange = editCSVChange OnRightButtonClick = editCSVRightButtonClick end @@ -212,7 +212,7 @@ object frmExportGrid: TfrmExportGrid RightButton.DisabledImageIndex = 107 RightButton.ImageIndex = 108 RightButton.Visible = True - TabOrder = 7 + TabOrder = 8 Text = '\r\n' OnChange = editCSVChange OnRightButtonClick = editCSVRightButtonClick @@ -227,11 +227,11 @@ object frmExportGrid: TfrmExportGrid end object chkIncludeQuery: TCheckBox Left = 8 - Top = 64 + Top = 87 Width = 257 Height = 17 Caption = 'Include SQL query' - TabOrder = 2 + TabOrder = 3 end object editNull: TButtonedEdit Left = 400 @@ -243,25 +243,33 @@ object frmExportGrid: TfrmExportGrid RightButton.DisabledImageIndex = 107 RightButton.ImageIndex = 108 RightButton.Visible = True - TabOrder = 8 + TabOrder = 9 OnChange = editCSVChange OnRightButtonClick = editCSVRightButtonClick end object chkRemoveLinebreaks: TCheckBox Left = 8 - Top = 87 + Top = 110 Width = 257 Height = 17 Caption = 'Remove linebreaks from contents' - TabOrder = 3 + TabOrder = 4 end object chkOpenFile: TCheckBox Left = 8 - Top = 110 + Top = 133 Width = 257 Height = 17 Caption = 'Open file after creation' - TabOrder = 4 + TabOrder = 5 + end + object chkFocusedColumnOnly: TCheckBox + Left = 8 + Top = 64 + Width = 265 + Height = 17 + Caption = 'Only focused column (%s)' + TabOrder = 2 end end object btnSetClipboardDefaults: TButton diff --git a/source/exportgrid.pas b/source/exportgrid.pas index a0200388e..7fed89244 100644 --- a/source/exportgrid.pas +++ b/source/exportgrid.pas @@ -30,6 +30,7 @@ interface TfrmExportGrid = class(TExtForm) btnOK: TButton; btnCancel: TButton; + chkFocusedColumnOnly: TCheckBox; grpSelection: TRadioGroup; grpOutput: TGroupBox; radioOutputCopyToClipboard: TRadioButton; @@ -201,6 +202,7 @@ procedure TfrmExportGrid.FormCreate(Sender: TObject); grpSelection.ItemIndex := 0; // Always use selected cells in copy mode chkIncludeColumnNames.Checked := AppSettings.ReadBool(asGridExportClpColumnNames); chkIncludeAutoIncrement.Checked := AppSettings.ReadBool(asGridExportClpIncludeAutoInc); + chkFocusedColumnOnly.Checked := False; chkIncludeQuery.Checked := False; // Always off in copy mode chkRemoveLinebreaks.Checked := AppSettings.ReadBool(asGridExportClpRemoveLinebreaks); chkOpenFile.Checked := False; // Always off in copy mode @@ -215,6 +217,7 @@ procedure TfrmExportGrid.FormCreate(Sender: TObject); grpSelection.ItemIndex := AppSettings.ReadInt(asGridExportSelection); chkIncludeColumnNames.Checked := AppSettings.ReadBool(asGridExportColumnNames); chkIncludeAutoIncrement.Checked := AppSettings.ReadBool(asGridExportIncludeAutoInc); + chkFocusedColumnOnly.Checked := AppSettings.ReadBool(asGridExportFocusedColumnOnly); chkIncludeQuery.Checked := AppSettings.ReadBool(asGridExportIncludeQuery); chkRemoveLinebreaks.Checked := AppSettings.ReadBool(asGridExportRemoveLinebreaks); chkOpenFile.Checked := AppSettings.ReadBool(asGridExportOpenFile); @@ -228,12 +231,22 @@ procedure TfrmExportGrid.FormCreate(Sender: TObject); procedure TfrmExportGrid.FormShow(Sender: TObject); +var + FocusedCol: String; begin // Show dialog. Expect "Grid" property to be set now by the caller. Width := AppSettings.ReadIntDpiAware(asGridExportWindowWidth, Self); Height := AppSettings.ReadIntDpiAware(asGridExportWindowHeight, Self); chkIncludeAutoIncrement.OnClick := CalcSize; + chkFocusedColumnOnly.OnClick := CalcSize; CalcSize(Sender); + // Show name of focused column + if Grid.FocusedColumn > -1 then + FocusedCol := Grid.Header.Columns[Grid.FocusedColumn].Text + else + FocusedCol := ''; + chkFocusedColumnOnly.Caption := f_('Only focused column (%s)', [FocusedCol]); + chkFocusedColumnOnly.Enabled := not FocusedCol.IsEmpty; end; @@ -252,6 +265,7 @@ procedure TfrmExportGrid.FormClose(Sender: TObject; var Action: TCloseAction); AppSettings.WriteInt(asGridExportSelection, grpSelection.ItemIndex); AppSettings.WriteBool(asGridExportColumnNames, chkIncludeColumnNames.Checked); AppSettings.WriteBool(asGridExportIncludeAutoInc, chkIncludeAutoIncrement.Checked); + AppSettings.WriteBool(asGridExportFocusedColumnOnly, chkFocusedColumnOnly.Checked); AppSettings.WriteBool(asGridExportIncludeQuery, chkIncludeQuery.Checked); AppSettings.WriteBool(asGridExportRemoveLinebreaks, chkRemoveLinebreaks.Checked); AppSettings.WriteBool(asGridExportOpenFile, chkOpenFile.Checked); @@ -476,11 +490,12 @@ procedure TfrmExportGrid.CalcSize(Sender: TObject); var GridData: TDBQuery; Node: PVirtualNode; - Col, ExcludeCol: TColumnIndex; + Col, ExcludeAutoIncCol, IncludeFocusedCol: TColumnIndex; ResultCol: Integer; RowNum: PInt64; SelectedSize, AllSize: Int64; CalculatedCount, SelectedCount, AllCount: Int64; + DoIncludeCol: Boolean; begin GridData := Mainform.GridResult(Grid); if not Assigned(GridData) then begin @@ -489,10 +504,13 @@ procedure TfrmExportGrid.CalcSize(Sender: TObject); end; AllSize := 0; SelectedSize := 0; - chkIncludeAutoIncrement.Enabled := GridData.AutoIncrementColumn > -1; - ExcludeCol := -1; + chkIncludeAutoIncrement.Enabled := (GridData.AutoIncrementColumn > -1) and (not chkFocusedColumnOnly.Checked); + ExcludeAutoIncCol := -1; if chkIncludeAutoIncrement.Enabled and (not chkIncludeAutoIncrement.Checked) then - ExcludeCol := GridData.AutoIncrementColumn; + ExcludeAutoIncCol := GridData.AutoIncrementColumn; + IncludeFocusedCol := -1; + if chkFocusedColumnOnly.Enabled and chkFocusedColumnOnly.Checked then + IncludeFocusedCol := Grid.FocusedColumn; Node := GetNextNode(Grid, nil, False); CalculatedCount := 0; @@ -510,7 +528,9 @@ procedure TfrmExportGrid.CalcSize(Sender: TObject); Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin ResultCol := Col - 1; - if Col <> ExcludeCol then begin + DoIncludeCol := (Col <> ExcludeAutoIncCol) and + ((IncludeFocusedCol < 0) or (Col = IncludeFocusedCol)); + if DoIncludeCol then begin Inc(AllSize, GridData.ColumnLengths(ResultCol)); if vsSelected in Node.States then Inc(SelectedSize, GridData.ColumnLengths(ResultCol)); @@ -651,7 +671,7 @@ function TfrmExportGrid.FormatLatex(Text: String): String; procedure TfrmExportGrid.btnOKClick(Sender: TObject); var - Col, ExcludeCol: TColumnIndex; + Col, ExcludeAutoIncCol, IncludeFocusedCol: TColumnIndex; ResultCol: Integer; Header, Data, tmp, Encloser, Separator, Terminator, TableName, Filename: String; Node: PVirtualNode; @@ -666,6 +686,12 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); Encoding: TEncoding; Bom: TBytes; CurrentExportFormat: TGridExportFormat; + + function DoIncludeCol: Boolean; + begin + Result := (Col <> ExcludeAutoIncCol) and + ((IncludeFocusedCol < 0) or (Col = IncludeFocusedCol)) + end; begin Filename := GetOutputFilename(editFilename.Text, MainForm.ActiveDbObj); @@ -694,9 +720,12 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); except TableName := _('UnknownTable'); end; - ExcludeCol := NoColumn; - if (not chkIncludeAutoIncrement.Checked) or (not chkIncludeAutoIncrement.Enabled) then - ExcludeCol := GridData.AutoIncrementColumn + 1; + ExcludeAutoIncCol := NoColumn; + if chkIncludeAutoIncrement.Enabled and (not chkIncludeAutoIncrement.Checked) then + ExcludeAutoIncCol := GridData.AutoIncrementColumn + 1; + IncludeFocusedCol := NoColumn; + if chkFocusedColumnOnly.Checked then + IncludeFocusedCol := Grid.FocusedColumn; // Calling (Get)ExportFormat is slow, so we store it in a local variable CurrentExportFormat := ExportFormat; @@ -759,7 +788,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); CodeIndent(4) + '' + sLineBreak; Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin - if Col <> ExcludeCol then + if DoIncludeCol then Header := Header + CodeIndent(5) + '' + Grid.Header.Columns[Col].Text + '' + sLineBreak; Col := Grid.Header.Columns.GetNextVisibleColumn(Col); end; @@ -779,7 +808,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); while Col > NoColumn do begin // Alter column name in header if data is not raw. ResultCol := Col - 1; - if Col <> ExcludeCol then begin + if DoIncludeCol then begin Data := Grid.Header.Columns[Col].Text; if (GridData.DataType(ResultCol).Category in [dtcBinary, dtcSpatial]) and (not Mainform.actBlobAsText.Checked) then Data := 'HEX(' + Data + ')'; @@ -811,7 +840,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); Header := Header + '{'; Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin - if Col <> ExcludeCol then + if DoIncludeCol then Header := Header + ' c '; Col := Grid.Header.Columns.GetNextVisibleColumn(Col); end; @@ -819,7 +848,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); if chkIncludeColumnNames.Checked then begin Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin - if Col <> ExcludeCol then + if DoIncludeCol then Header := Header + FormatLatex(Grid.Header.Columns[Col].Text) + Separator; Col := Grid.Header.Columns.GetNextVisibleColumn(Col); end; @@ -836,7 +865,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); Header := TrimLeft(Separator); Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin - if Col <> ExcludeCol then + if DoIncludeCol then Header := Header + Grid.Header.Columns[Col].Text + Separator; Col := Grid.Header.Columns.GetNextVisibleColumn(Col); end; @@ -864,7 +893,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); Header := Header + TrimLeft(Separator); Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin - if Col <> ExcludeCol then begin + if DoIncludeCol then begin if chkIncludeColumnNames.Checked then Header := Header + Grid.Header.Columns[Col].Text + Separator else @@ -878,7 +907,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin ResultCol := Col - 1; - if Col <> ExcludeCol then begin + if DoIncludeCol then begin Header := Header + '---'; if GridData.DataType(ResultCol).Category in [dtcInteger, dtcReal] then Header := Header + ':'; @@ -946,7 +975,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin ResultCol := Col - 1; - if (Col <> ExcludeCol) and (not GridData.ColIsVirtual(ResultCol)) then + if DoIncludeCol and (not GridData.ColIsVirtual(ResultCol)) then tmp := tmp + GridData.Connection.QuoteIdent(Grid.Header.Columns[Col].Text)+', '; Col := Grid.Header.Columns.GetNextVisibleColumn(Col); end; @@ -983,7 +1012,7 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); Col := Grid.Header.Columns.GetFirstVisibleColumn(True); while Col > NoColumn do begin ResultCol := Col - 1; - if Col <> ExcludeCol then begin + if DoIncludeCol then begin if (GridData.DataType(ResultCol).Category in [dtcBinary, dtcSpatial]) and (not Mainform.actBlobAsText.Checked) then begin Data := GridData.HexValue(ResultCol); diff --git a/source/extra_controls.pas b/source/extra_controls.pas index a7c0555d3..3ec77abc7 100644 --- a/source/extra_controls.pas +++ b/source/extra_controls.pas @@ -6,7 +6,7 @@ interface System.Classes, System.SysUtils, Vcl.Forms, Winapi.Windows, Winapi.Messages, System.Types, Vcl.StdCtrls, Vcl.Clipbrd, SizeGrip, apphelpers, Vcl.Graphics, Vcl.Dialogs, gnugettext, Vcl.ImgList, Vcl.VirtualImageList, Vcl.ComCtrls, Winapi.ShLwApi, Vcl.ExtCtrls, VirtualTrees, VirtualTrees.Types, SynRegExpr, Vcl.Controls, Winapi.ShlObj, - SynEditMiscClasses, SynUnicode, Vcl.Themes, Vcl.GraphUtil; + SynEditMiscClasses, SynUnicode, Vcl.Themes, Vcl.GraphUtil, Math; type // Form with a sizegrip in the lower right corner, without the need for a statusbar @@ -382,7 +382,7 @@ procedure TExtForm.FilterNodesByEdit(Edit: TButtonedEdit; Tree: TVirtualStringTr var rx: TRegExpr; Node: PVirtualNode; - i: Integer; + i, ColumnCount: Integer; match: Boolean; CellText: String; begin @@ -407,8 +407,10 @@ procedure TExtForm.FilterNodesByEdit(Edit: TButtonedEdit; Tree: TVirtualStringTr if not Tree.HasChildren[Node] then begin // Don't filter anything if the filter text is empty match := rx.Expression = ''; + // Suport trees with 0 defined columns, like the shortcut tree in preferences + ColumnCount := Max(Tree.Header.Columns.Count, 1); // Search for given text in node's captions - if not match then for i := 0 to Tree.Header.Columns.Count - 1 do begin + if not match then for i:=0 to ColumnCount - 1 do begin CellText := Tree.Text[Node, i]; match := rx.Exec(CellText); if match then diff --git a/source/grideditlinks.pas b/source/grideditlinks.pas index 4a1a6ce07..309302352 100644 --- a/source/grideditlinks.pas +++ b/source/grideditlinks.pas @@ -969,6 +969,7 @@ function TEnumEditorLink.PrepareEdit(Tree: TBaseVirtualTree; Node: PVirtualNode; FCombo.Items.AddStrings(DisplayList) else FCombo.Items.AddStrings(ValueList); + FCombo.AutoDropDownWidth := True; FCombo.ItemIndex := ValueList.IndexOf(FCellText); if AllowCustomText and FAllowEdit then begin FCombo.Style := csDropDown; @@ -1354,9 +1355,7 @@ constructor TColumnDefaultEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: FExpressionEdit.Width := FExpressionEdit.Parent.Width - 2*FExpressionEdit.Left; FExpressionEdit.OnChange := EditChange; FExpressionEdit.DropDownCount := 20; - for SQLFunc in FTableColumn.Connection.SQLFunctions do begin - FExpressionEdit.Items.Add(SQLFunc.Name + SQLFunc.Declaration); - end; + FTableColumn.Connection.GetColumnDefaultExpressions(FExpressionEdit.Items); FlblOnUpdate := TLabel.Create(FPanel); FlblOnUpdate.Parent := FPanel; @@ -1372,9 +1371,7 @@ constructor TColumnDefaultEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: FOnUpdateEdit.Width := FOnUpdateEdit.Parent.Width - 2*FOnUpdateEdit.Left; FOnUpdateEdit.OnChange := EditChange; FOnUpdateEdit.DropDownCount := 20; - for SQLFunc in FTableColumn.Connection.SQLFunctions do begin - FOnUpdateEdit.Items.Add(SQLFunc.Name + SQLFunc.Declaration); - end; + FTableColumn.Connection.GetColumnDefaultExpressions(FOnUpdateEdit.Items); FRadioAutoInc := TAllKeysRadioButton.Create(FPanel); FRadioAutoInc.Parent := FPanel; @@ -1383,7 +1380,7 @@ constructor TColumnDefaultEditorLink.Create(Tree: TVirtualStringTree; AllowEdit: FRadioAutoInc.Width := FRadioAutoInc.Parent.Width - 2 * FRadioAutoInc.Left; FRadioAutoInc.OnClick := RadioClick; FRadioAutoInc.OnKeyDown := DoKeyDown; - FRadioAutoInc.Caption := Col.AutoIncName; + FRadioAutoInc.Caption := FTableColumn.Connection.SqlProvider.GetSql(qAutoInc); FBtnOk := TButton.Create(FPanel); FBtnOk.Parent := FPanel; @@ -1547,7 +1544,7 @@ function TColumnDefaultEditorLink.EndEdit: Boolean; stdcall; cdtText: Col.DefaultText := FTextEdit.Text; cdtNull: Col.DefaultText := 'NULL'; cdtExpression: Col.DefaultText := FExpressionEdit.Text; - cdtAutoInc: Col.DefaultText := Col.AutoIncName; + cdtAutoInc: Col.DefaultText := Col.Connection.SqlProvider.GetSql(qAutoInc); end; if FOnUpdateEdit.Text <> '' then diff --git a/source/insertfiles.dfm b/source/insertfiles.dfm index c290655f8..d66aa8009 100644 --- a/source/insertfiles.dfm +++ b/source/insertfiles.dfm @@ -86,6 +86,7 @@ object frmInsertFiles: TfrmInsertFiles Top = 23 Width = 159 Height = 21 + AutoDropDownWidth = True Style = csDropDownList Anchors = [akLeft, akTop, akRight] TabOrder = 1 diff --git a/source/loaddata.pas b/source/loaddata.pas index 899dc80e3..ce2e1762f 100644 --- a/source/loaddata.pas +++ b/source/loaddata.pas @@ -229,23 +229,24 @@ procedure Tloaddataform.comboDatabaseChange(Sender: TObject); procedure Tloaddataform.comboTablePopulate(SelectTableName: String; RefreshDbObjects: Boolean); var - count, i: Integer; + i: Integer; DBObjects: TDBObjectList; - seldb, seltable: String; + FocusedTable: String; begin // read tables from db comboTable.Items.Clear; - seldb := Mainform.ActiveDatabase; - seltable := Mainform.ActiveDbObj.Name; + FocusedTable := Mainform.ActiveDbObj.Name; DBObjects := FConnection.GetDBObjects(comboDatabase.Text, RefreshDbObjects); for i:=0 to DBObjects.Count-1 do begin if DBObjects[i].NodeType in [lntTable, lntView] then comboTable.Items.Add(DBObjects[i].Name); - count := comboTable.Items.Count-1; - if SelectTableName.IsEmpty and (comboDatabase.Text = seldb) and (comboTable.Items[count] = seltable) then - comboTable.ItemIndex := count - else if (not SelectTableName.IsEmpty) and (SelectTableName = comboTable.Items[count]) then - comboTable.ItemIndex := count; + end; + + if comboDatabase.Text = Mainform.ActiveDatabase then begin + if not SelectTableName.IsEmpty then + comboTable.ItemIndex := comboTable.Items.IndexOf(SelectTableName) + else if not FocusedTable.IsEmpty then + comboTable.ItemIndex := comboTable.Items.IndexOf(FocusedTable); end; if (comboTable.ItemIndex = -1) and (comboTable.Items.Count >= 1) then comboTable.ItemIndex := 0; // First real table diff --git a/source/main.dfm b/source/main.dfm index f4a7d8e14..9950b7fa4 100644 --- a/source/main.dfm +++ b/source/main.dfm @@ -1871,12 +1871,15 @@ object MainForm: TMainForm object CopyItem: TMenuItem Action = actCopy end - object Copycolumnnames1: TMenuItem - Action = actCopyColumnNames + object Copyformattedtext1: TMenuItem + Action = actCopyFormatted end object Copywithtabstospaces1: TMenuItem Action = actCopyTabsToSpaces end + object Copycolumnnames1: TMenuItem + Action = actCopyColumnNames + end object actCopyGridNodes1: TMenuItem Action = actCopyGridNodes end @@ -1924,6 +1927,10 @@ object MainForm: TMainForm Action = actDisplayTreeFilters AutoCheck = True end + object menuTreeShowColumns1: TMenuItem + Action = actTreeShowColumns + AutoCheck = True + end object N27: TMenuItem Caption = '-' end @@ -3446,6 +3453,27 @@ object MainForm: TMainForm ImageIndex = 3 OnExecute = menuCopyColumnNamesClick end + object actCopyFormatted: TAction + Category = 'Various' + Caption = 'Copy formatted text' + Hint = + 'Copies selected text with formatting from current editor to clip' + + 'board' + ImageIndex = 3 + OnExecute = actCopyFormattedExecute + end + object actDataEditWithoutLookup: TAction + Category = 'Data' + Caption = 'Edit value without foreign key lookup' + ImageIndex = 58 + OnExecute = actDataEditWithoutLookupExecute + end + object actTreeShowColumns: TAction + Category = 'Various' + AutoCheck = True + Caption = 'Columns below tables in tree' + OnExecute = actTreeShowColumnsExecute + end end object menuConnections: TPopupMenu AutoHotkeys = maManual @@ -3574,6 +3602,10 @@ object MainForm: TMainForm Action = actFavoriteObjectsOnly AutoCheck = True end + object menuTreeShowColumns2: TMenuItem + Action = actTreeShowColumns + AutoCheck = True + end end object menuPrint: TMenuItem Action = actPrintList @@ -3691,6 +3723,9 @@ object MainForm: TMainForm ImageIndex = 28 OnClick = InsertValue end + object menuDataEditWithoutLookup: TMenuItem + Action = actDataEditWithoutLookup + end object N11: TMenuItem Caption = '-' end @@ -4126,6 +4161,12 @@ object MainForm: TMainForm ImageIndex = 52 OnClick = menuLoadSnippetClick end + object menuRenameSnippet: TMenuItem + Caption = 'Rename' + Enabled = False + ImageIndex = 58 + OnClick = menuRenameSnippetClick + end object menuDeleteSnippet: TMenuItem Caption = 'Delete ...' Enabled = False @@ -6445,23 +6486,24 @@ object MainForm: TMainForm SourceImages = < item Image.Data = { - 89504E470D0A1A0A0000000D494844520000005E0000005E040300000058FCBE - 5D00000015504C5445FFFFFF00000000ADC500ACC000ABC1009FBF00ACC122A0 - AABA0000000674524E53000016D5B70835C94844000000097048597300000EC4 - 00000EC401952B0E1B0000018B49444154588595985D4E84401006D113EC6CE2 - BBBA37D0C413A8EF267A020DF73F82C0C04C77CF3740F1682A55BB2B3FDD0C03 - 3CEE923C9EF59F2F1DFEFAFA84F8DBF842F8EBDBF82B031DFE368E3AA0F9493F - EA80E667BD0E487ED1EB80E4B35E0614BFEA6540F19B5E05045FF42A20F8AC7F - D78196CFFABF9F4F1968F9ACFF48DF32D0F0ABFE2B3DC840C36FFAA403912FFA - A40391AF7A1D08BCD1EB40E0AD5E063CEFF432E079AF5701C707BD0A383EEA45 - C0F28D5E042CDFEADB80E185BE0D185EE99B40E5A5BE09545EEB63A0F01D7D0C - 14BEA70F818DEFEA4360E3FB7A1F58F91DBD0FACFC9EDE0532BFAB7781CCEFEB - 6D60E10FF436B0F0477A1398F943BD09CCFCB1BE0626FE84BE0626FE8CBE042E - C3FD197D093C629E7E1EFC7DE9EF89FF5FF47CC0E71B3D9FF1F542AF477CBDD3 - FB09BE5FD1FB21BEDFD2FB397E5ED0E7117EDED1E7297E5ED37900CF1B749EC1 - F3129DC7F0BC47E7493CAFD27918CFDB749EC7FB02DD47F0BE43F729BCAFD17D - 10EF9B749FC5FB32DDC7F1BE4FDF27E0F715FDF721F0F807B76B509911661559 - 0000000049454E44AE426082} + 89504E470D0A1A0A0000000D4948445200000060000000600806000000E29877 + 38000000097048597300000B1300000B1301009A9C18000001E749444154789C + ED9D416E134114057B13CE42E0901C00E279811547010E0033CA0E73101216DD + 4A24A3B6B288085656498DA6ABA45EB754D5FEF6CABF14111111111111117941 + 76737B9BB94D59EA3E73FD93A51D9EF51CEFA8FB696EBBCB1FF54D199577FBC3 + AB696E9FA6A5DE3DBBF413E7FEEECBCF5787B3329AFCCCED1B25FE5188B97D1D + 2A427FF9B4F43C8E9032CACC27C74E4E9E7A3B7DAFE765EBF497C6CB6EA7CE45 + D93AD3D27EAD40F4E1FF63A8FE2C5B679AEB0D2D3AA7C7D075D93A4F49281BBF + 1F87161003180085161003180085161003180085161003180085161003180085 + 1610031800851610031800851610031800851610031800851610031800851610 + 0318008516100318008516100318008516100318008516100318008516100318 + 0085161003180085161003180085161003180085161003180085161003180085 + 1610031800851610031800851610031800851610031800851610031800851610 + 03180085161003180085161003180085161003D4EBA724043AD3527F97AD735C + D6B3D600F3107F5FDF76EB0DD0DE97ADD35747AD7585C9C7ABFABA8C405F1DB5 + C2D7BF2BA3D05746F5D551598BFCA57D196A8DD58308E91F7D72ECF4973F9CFC + 7FBF13B2B48BFE0BE425F6CBF43B8E772DEDC3106BAB44444444444444CA9AF8 + 0B3F293F102E7F2D520000000049454E44AE426082} end> end item @@ -8557,54 +8599,43 @@ object MainForm: TMainForm SourceImages = < item Image.Data = { - 89504E470D0A1A0A0000000D494844520000005E0000005E0806000000AAD2A3 - 6E000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000 - 00097048597300000EC300000EC301C76FA8640000001874455874536F667477 - 617265007061696E742E6E657420342E312E35644758520000055A4944415478 - 5EEDDBBFAB1C6514C6F1082982A455AE60A190BFC056095A69A17005C146B030 - 608A1469FC038414824510C12682815B88DCBD1BAD2C630A0D7ACB44025AC444 - C132DE545710C6F3CC7DCF6477E7CCEFF3CE7BCECE7CE191607667673EC4BD9B - DDF5549665F312ECE41F1E3BF8F1D97C0EF30B0FF0C50FBFE67388EF13BE40BF - 959DCC1FBE3FF812BA4F7C5FF095E83C3FF87EE01BD1793EF07DC0B746E7D9C7 - B70FDF199D671BDF367C6F749E5D7CBBF083D17936F16DC2ABA1F3ECE1DB8357 - 47E7D9C2B705DF157DFFD6F7F9A4DF136707DF0E7C1FF4AF6E9EC9E710DF067C - 5F74CE217E7AF8A1E89C33FCB4F05AE89C23FC74F0DAE89C13FC34F0B1D03907 - F8E3C3C746E78CE38F0B3F163A67187F3CF8B1D139A3F8E3C0A742E70CE2C787 - 4F8DCE19C38F0B6F059D33841F0FDE1A3A67043F0EBC5574CE00BE3EBC75742E - 31BE2EBC17742E21BE1EBC37742E11BE0EBC57742E01FE7078EFE8DCC8F8C3E0 - B7059D1B11BF3FFCB6A17323E1F783DF56746E04FCEEF0DB8ECE45C6EF063F15 - 742E227E7BF8A9A17391F0DBC14F159D8B80DF0C3F75744E19BF1E7E465F4F11 - BF1A7E469753C297E167F4FA14F0CBF0337ABB06E2AFC3CFE8DD1A80FF047E46 - EF574FFC197E6883E1D18CDFAD9EE8B8EB3A3C9AF1DB35001D95E1D18C5FDF40 - 7424C3A3195F4E011D55C3A3197F3D2574540F8F66FC9314D151333C9A3ABE32 - 3A6A078F2680FFE68DDD73B44BB47DDA1DDA235A86BDBE7C373BBFFC207B69F9 - 51F6C2C167D9D38BEFE4EB6E818EDAC3A32DC427D4D3B47768B719B9ED5E5E5E - CC9E5B5CCB9E5ADC0CD7DC0E1D7583475B844F78AFD2F0275B846D3BFC97F0CC - E2FA1F6DD1517778E41C9FB0CED0AEAEE2290DC76C759DFDE091537C82D9A175 - 7E5AE9301C7B273C5C65FDE191337C80D0EE05A098C363D4E20F83474EF00902 - 4F2F31FFA46F0E8F55799DC3E191037C42E8F49CFEF0F1C3ECE8DFA3D2FE393E - 126F5FB1CFC3C397D2814786F10900AF5E2498CAFDF9F82F622977FCDFB178FB - 9ABD114E632D3A94123C32884F178ED7E99D5F322AC2E3F9FE74389D223A9422 - 3C32864F178DBF1C4920B55384C7DE0BA753448752864786F0E9A27BFD405586 - BF1D4EA7880E15011E19C0A70BC67B2F1244E394E1B173E1B4F2E85091E05162 - 7CBA58BCE12521342E02FCA5705A7974A888F028213E5D2CDE659410F2BD75E3 - EDCAD5C14BB75F9DF458B4FD705A7974A8C8F028113E5D6CE5AB99AFEF7D9343 - 6AF7CBDF87E2E3D1EE84D3CAA39B8E008F12E0D3C516EFA76F2E01FCA3705A79 - 74D391E0D1C8F8C2C5174B00BF864C371D111E8D854FF7912E9E373D78141B1F - B7A5FBE0E33A09009BD653CD6AB1F0033AEE834F8604807CD3F9E12AA58DBF82 - 8EE183690120DF273F7F9A2D7FFBB672752F27A5DBF3AEDFDD131F8F96E0E564 - 5D5AF81BE8D88B07572580568BF017A8CBE14CF3E85089E1D1507C011DC35730 - 048056F3FD964197FAE257A0F35E597E2821344E19FE305C65111DCA083CEA83 - 5F838E3D7FF08504D13865F80BE10A8BE85086E05157FC86E1CB46AF2DDF9730 - 6AA708FF3BADF433890E650C1E29E3EF2CBE7CB081D13845F8DD70556BD1A10C - C223357C3A061D8B00AE6D80D44E097E2F5C4D293A9451783418FF041D872284 - B3B4D69FBD7EFCD395CA49B71786CF5ACFE6D721641B1EF5C67F82CE1104BED0 - 84E75C094A73F76991BFD034469DF1CBE81C406831BF4DD6F82D32E4031EB5C6 - AF46E708064F3B7B014A733866E5D3CB6A7EE051237E33FA6A84B44BD378EAC1 - 31C4572F55F9824795F8DDD03902C3FBF61768873409B56EB80FEEDBFCAEE946 - FEE05109BF1FFA660488AF835CA695FE579CF06BFC3BFC1E6EB3F6DE4BD77CC2 - A3025F077DECFCC223803B444705FCBCB1979DFA1FF0491B3AB771EE65000000 - 0049454E44AE426082} + 89504E470D0A1A0A0000000D4948445200000060000000600806000000E29877 + 38000000097048597300000B1300000B1301009A9C180000044D49444154789C + ED9DBF6B1C4714C71F4AE4C265922EC6BDE552C4C4D5C1CE79E64057A4F09118 + BB514C48913AC8A8D92E1206E94638413A0C9939146370FC4BC44E2115214514 + AD4863F9FC0758B15DF857E11FB06B1B363C490862E924DF9D76DF78E77D6040 + 7082D37D3FBB6F67679F6E001886611886611886611886C991C92839ACA3A4AE + 97E3968EE2177A3949331D6BEF11B7EA513239B5140F80AF84AD745F3D4ACED5 + 97E3379987DE666CBCF754E39FB41F7C0B5F47C90255F05B4444C9BC5712F0C8 + A70E5D6F95A0C1979A4F597674DB11BFAEFF1D1F82A283471A7DD849BB310145 + A7BE9CDC7120E874FB3214DF86A2538FE2E7D441EBF665E819149DDD428082BF + 3F39D4016816C00248A10E40B30016400A75009A05B00052A803D02C80059042 + 1D8066012C8014EA00340B6001A45007A059000B20853A00CD02580029D40168 + 16C00248A10E40B30016400A75009A05B00052A803D02C800590421D8066012C + 8014EA00340B6001A45007A059000B20853A00CD02580029D4016816C00248A1 + 0E40B30016400A75009A05B82FA076A9F68168AAA38155A38195578495778491 + 4F8555AFD606FE6C640B5FC3DF299BCAE76118F6C1FB80CB02C6FFBA9F0AA3C6 + 8591F784556947C3C87F03ABC64AB39503E0322E0A38BBF830FD7AAE9E969B43 + 9D85BECD088C4C8495D3A50BD54FC0455C13F0FDC27C5A993DDE73F05B45A8C7 + 8139F615B8862B0226A397E9F0F5893D0F7E9BD23433D81874E7BB885C1030B1 + F42C3D717934FBF03787BC596D54F7830B500B988C5EE61CFEE6B561A176A9B6 + 0F7C17309C47D9697F264C83CF028491273B0D6D373A96D0945F828F0244537C + 2C8C7C442D20B0EA09E914954A406055A39BB2B1E767C0FAF5E027F0494069B6 + 7260FD06C9190149B9593E08BE0810B8BCD0E585330B011BA5680C7C10108661 + 1FAED3B82600D79B70D10F8A2E4034D5D1AE43CA52C0DA59208F40D10504568D + BA2AA06CE41928FC1960E4D55E02EE959DCB90FA153C10D072554060E50A7850 + 829EB82A006F0CA1F002CCCEF37F4A01819531E40D0B509E09B05C82FE077E41 + F66E12F41E8E2F2E7E93BA2A80E8221CB7F21470EA4AE8AC00926928EE5E94A7 + 80EF7EFFA5A79BA59E02DE6504568EE42E00B78ECA730B93F0CF156705889F2B + 9F0105B875546E674114A743174E3A272030EA2E59371D6E19855B47E99C247C + 7BE3BC8302E40F24E1BF2541E3EE45590B185B7CD075D75B160270FE1FD8A14F + C105A696E201DCBD0837D0C9727F99D373DA1901C2A873E01BF2BCFCC88987F2 + 463D76B66F346BB057935E40A5063E238C9CE9F6C2D9FB903F82EFD4F09F2FAC + BA9677F88195374A7F943EA4FEFC4E506D54F763C36C6EE11BF59B33CDB9AE30 + D818ECC75ECD3CCA0E1FF93B80BD9ADDCC8EDEA1E43CF4FE82DB49DF28B60BE2 + 0DD21E041FE33C1FA7BDEFFC0730EBE0DD2976AC0556AD761EBC5AC5E50567EE + 70DF67C230ECC3A629ECDBC1357B7C70824FD6F0F1E6DAC0A76C46DEDA786D04 + 5735BB5D58FB0F47048A8EB21074F10000000049454E44AE426082} end> end item @@ -8612,61 +8643,47 @@ object MainForm: TMainForm SourceImages = < item Image.Data = { - 89504E470D0A1A0A0000000D494844520000005E0000005E0806000000AAD2A3 - 6E000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000 - 00097048597300000EC300000EC301C76FA8640000001874455874536F667477 - 617265007061696E742E6E657420342E312E3564475852000006454944415478 - 5EEDDB4F681C551C07F01E7A10CCD9530F3D1651F0505A94A8875653B1070F22 - 01EBADE2A5A0E2CDAB07855682B4504BC5852A064D6B625BDB189424B41E052F - 11156DE39F6A0441D4959AD96CC6DF77F6FDC6F9F3DEBEF9F366E6BDDDF9C2B7 - 4D67DFCCECFB106667DF6E77F8BEDFB6810EFE7031173EBF2BA88371171EE0E7 - 57D6823A88EF267C88BEEA0FEA1EBE7BF0297437F1DD8257A273DDC177075E8B - CE7503DF0DF8CCE85CFBF1ED87CF8DCEB51BDF6EF8C2E85C7BF1ED852F8DCEB5 - 13DF4E7863E85CFBF0ED83378ECEB50BDF2EF8BCE873AB5783CA1E93D61E7C7B - E08BA07796EF08EA20BE1DF045D1390EE2370F5F169DE3187EB3F0A6D0390EE1 - 37076F1A9DE3087E33F055A1731CC0AF1FBE6A748EE5F8F5C2D785CEB118BF3E - F8BAD13996E2D703DF143AC742FCEAE19B46E758865F2DBC2DE81C8BF0AB83B7 - 0D9D63097E35F0B6A2732CC0370F6F3B3AA7617CB3F0AEA0731AC43707EF1A3A - A7217C33F0AEA2731AC02F0FEF3A3AA766FC72F0A382CEA911BF38FCA8A1736A - C22F063FAAE89C1AF0F3C38F3A3AA762FC7CF0E382CEA9103F3BFCB8A1732AC2 - CF063FAEE89C0AF0F5F0E38ECE318C3F1CBE458FC720BE1ABE4597C710BE1CBE - 451F1E03F869F8163D5B4AE2C7E15BF47C2981FF3F7C8B5E2C05F15BF8B2290D - 8FB4F8F952101DBBC6E191163F5B4AA0236978A4C51F9E92E8881C1E69F1E531 - 808EA8E191163F1E43E8C87078A4C51FC4203AA28747C60CBF7B60DF04F53075 - 86BAFCD7817DEBF4B7CF5D7B62CABFF2CCB4FFDA8B2FF9874E9CF6EF9C5D4A18 - 0C4747B2C12363804FA8F750CF52FF66E42CDD989AF44F1D3BE6DF7DE67D9ABB - 1E1DC90E8F8C283EE1EDA276A83DC62CD23F0FEEDFDE3834394B3FEF12875626 - 1F3C3262F8847484FA07E3192A8E77449C429AFCF0C888E013CEF10856153D2E - 4E954A3178C4717C42C1B55C8665BAEF8853C6521C1E71149F30AAFE4D4F7646 - 9C3A4C3978C4317C42C0355D861374F3DC5BD2EDBA6EBEFBB6747BA4B16B7E79 - 78C4117C9A3CEE5E942FA44047FADF7F2B7D5C55EF93CBC17EBD954FA58F8BE2 - 1675B7782A86E01107F069E2B86594A184E89CFE8DEFFCEEC1FDD2B1D17A8B97 - C41E83F43E5B948E139D154FC5203C62313E4D1A6F8EA4F7E949744E7FFD86DF - 7DE4FED478AE7765418C8CC75BFA583A5EF43E3C1F1A66101EB1149F262CBD8B - F9F7D4EB01962AFD1FD7FDEED403A9FDBCCBF362843CDE47E753FB889EC5F3A1 - 2186E111CBF069B2587B512E03F4AEAF0458AAF47FFAC1EF3EF66038DEBB7841 - 3C22CFD6D75FC58E9F289EC7040DAB001EB1089F268A052F1942582DFEAD9FFD - EEE30FF9DEC29CD8228F069D7B988656048F58824F13C52AA30C20562DFEAFB7 - C44FF264444767687885F08805F834D1E5C4C495D5E1AB92031D5DA65D2A8647 - 1AC64FAEA7EBDABB0E97ECD9FA26173A7A9376AB011E690A9F8E2199B8B659F1 - 0BA007A5D4048FD48D8F7DE918B2896769FFB70D0029B3ED79F482FBB0745F5D - 2935C22375E10B741C4336715DBDC5C132802EFD8D5F0AE1536A8647AAC68FA0 - A3F88C54367955BDAB17019339B8DBC9895FE3353E99AAF013E8E8D2D34FC926 - 2FAD6A1940979CF8D7689786E011D3F81274F4C4F32FC8269FAA77E9C3005195 - ED7FBAE2277972E09FA4E10DC223A6F015E8E893AFBE219B7CACDA650071F7B2 - F5E517628B3C19F1A76968C3F04859FC21E828BEF7F2FBA3E9852EAEB7F04180 - A64AF296B124FE6D6A856B357953145F83CEED3CF7AC0CC1BFFDCACB01962AAA - FB741DFE900F458235791A62093C52043F033A7AEF9BEFC910826E76CE0458C9 - E8DE1CA9F0359F44EDC554699845F0485EFCCC5D59DB989A9C9740044DE2677D - 479AC4D7A0CF8B595A088F18C7A763D13169E2BBA9CA7579C6CF8ACE65FCDEAA - F633D73D628696C223C6F007E8E2A858A93C1AC14815F8B2EDBAE2AE48B63DD2 - A3E22904B1171E298D1F47E710C2E9044AD5ED885387B11B1E298C2F47470862 - 27752E025365719E9DE2D461EC874772E3ABD139C0A02ABFEE61A8387E0A1D71 - 031EC98CAF478F866070CD57BEE0162C8E17BBA627E30E3CA2C5CF87CE21A43D - 54E5AD66CEE238E1DD8B2A6EC1234AFC62E8D110D85E2AFE6301DED6CB5055C5 - 78EC17BC39CA12F7E091147E79F4680810DFC399A69EA45EA3DEA446A1F16F6C - C7E318372176CD1C37E19110DF2C7A5D71171E01B883E84808DFB6EEFA3BFE03 - 72F83711316020C90000000049454E44AE426082} + 89504E470D0A1A0A0000000D4948445200000060000000600806000000E29877 + 38000000097048597300000B1300000B1301009A9C18000004CE49444154789C + ED9DC16F1B4514874729EDA147E046C59D70DCCE10D4489666A212A49C90AC22 + F80F38F484D4924BA482DA72A01EA7ADE2A8558FBDA0C2A1E5420E2068703635 + 48802BCE343D54B441A4BB0EBB6069D0731A1192383B6BBCFBC6BBEF93468AEC + 58EBFCBEF59BD9D9898731822008822008822008822072E4921FBFAAFDB8A657 + A3B6F6A350AFC626D3D63B46D4AEF9F1A5FA4A34CECACA5CDB1CA9F9F1E5DA6A + D4CD3CF43EEDD9B1EB8B2D7398952D7CEDC74B58C1EF11E1C75F964A029CF9D8 + A1EBBD12342B4BCDC72C3BBA6F8BFEAE35A35758D181330D3FECB85FFB84159D + DA6A7CDF81A0CDFE6528FA99159D9A1F05D841EBFE65E8292B3A4921B0821F1F + 1DEC0034092001A86007A049000940053B004D0248002AD8016812400250C10E + 40930012800A76009A04900054B003D0248004A0821D802601240015EC003409 + 2001A86007A049000940053B004D0248002AD8016812400250C10E4093001280 + 0A76009A04900054B003D0248004A0821D802601240015EC0034092001A86007 + A049000940053B004D02DC1760AAD5439B8ABF1E4A311B4A712B54FC7EA8F8EF + 81127F41839F4325DABDE7A498ED4C890933C7C6D828E0B280EB4B6B2650E262 + A0F8C3500993A6058AAF05525CE854C431E6322E0A687CF5C8B43EF8C86C9C3C + 912AF47D454811074A2C3CAD782F3217714DC0ED6B77CCFACCD4FF0E7E4F93E2 + 49205F7B9BB9862B02E69B1DD33AFBE1F083DF5B9A1AC6F3DCF92E2217045C59 + DE30BFBC773AF3F07748F8C2CC7847990B600B986F76720D7F47495A32D5F123 + ACEC025A39949DFE9F04B1C0CA2C2050FC5DACF0FF9570FC142BA3800DC55F08 + 95786C1352746ED684D393F6C14E4F6EBDC6AA14F175D4212A968040F2459B80 + E2C5BA01BAF79A267CD342C21B274CF7BB6F7AAF896F346CFB83ABAC4C023A15 + 710C2E906CC3DF2651C28EF0B7B19100EF6573CA7B99954540A0C4C5B4E1274A + D827FC94122EB0320830736C0CE669926AFE4174FDE5FFF609D393BDC70E22A9 + 4F80F92698F4634517B009B39A29EA785F09DB9F8434BF9B70DC8EF4042BBA80 + 10A6946D3A469B605B2BA6BB727728E1F7DA143FCB8A2E2050E233AB302C250C + 2DFC5EE39FB2C27F029468DB0732B884F4E1F7AE097E62C52F417C3D55280348 + 1828FCADF69815BE04C9E4F17F5F09CD6F93C36FF983860F43D188E5CD6809B8 + 9B2CE07B127020548276015F909D24410FB1ADBD732AD3F047B0138EDA790A68 + 9F7E3FF3F0476A180ABB17E529E0EB8FAF1B672FC4243F93BB00D83A2ACF2D4C + 6EDEFAC1383B15A18E7386016C1D959780BAFFA779F4D68C716E324E8A5FD156 + D3C19651B07594CE49C2F2B9F9C4B3316E0C733A7A21F17881E4E751C2DF2541 + C3EE45590BB8B6F4D06AD5DB6E0983DD90B1095F441D39F1127381FA4A340EBB + 17C1063A59EE2F736FF6BC55C7B82D61B05B920BB6A39FCBAC6CFC7172E27937 + 6ECA8B27CEAE1BCD1A58AB691D6A462D90A2CACA4CA078034F00BFC2CA8EA956 + 0F058A7F9EFF99CFEF984AE539ECBFDF09CC8C771416CCE658766E3BB338D715 + 8CE71D86B59A79941D3AF30F00D66ADA8E8E5235297E2B7D879B6ADDA81457E1 + 026908E52682713E0C7BADDF00B1055C9DC28AB5408A070304FF00A6179CB9C2 + 1D65CC1C1B834553B06E07E6ECE1C609DC59EBFD031EDCE2ECDD65E33F3E7BEE + 0CCC6A0E3AB1F60FF28F22B0CFA5A93C0000000049454E44AE426082} end> end item @@ -8674,49 +8691,43 @@ object MainForm: TMainForm SourceImages = < item Image.Data = { - 89504E470D0A1A0A0000000D494844520000005E0000005E0806000000AAD2A3 - 6E000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000 - 00097048597300000EC300000EC301C76FA8640000001874455874536F667477 - 617265007061696E742E6E657420342E312E3564475852000004BD4944415478 - 5EEDD55D48547918C7F1D382BA156D41B0575D76157417050BB11544B5BD5D45 - 45DD14D4D245202A141574D56D50EC9ABD40F47257911569655AD32ADD2F745D - 641905A551A42933A7F33B33CFE4382F9E73FE6FCF3373BEF0A8E071063FFC50 - CFF7FDF41C5CFE83C46E0DFD1E9EC0E4C203FCE6D317E109C497095F44CFF8F9 - 93872F0FBE0C5D26BE2CF8AAE87472F0E5C0CF8A4E27035F067C64743AFEF8FC - E163A3D3F1C6E70D9F189D8E2F3E5F7865743A9EF83CE1B5A1D3F1C3E707AF1D - 9D8E173E2FF8B8E83732BDE155FA5EC5E383CF073E09FAE527BF8627109F077C - 52744A20BE7B7855744A18BE5B785DE894207C77F0BAD12921F86EE04DA15302 - F0EDC39B46A798E3DB85B7854E31C6B7076F1B9D628A6F07DE153AC510DF3CBC - 6B748A19BE59782EE814237C73F0DCD02926F866E0B9A2530CF0F5C37347A71C - E3EB8597824E39C4D7072F0D9D7284AF075E2A3AE5005F1D5E3A3A65195F0DBE - 5ED0298BF8C9E1EB0D9DB2849F0CBE5ED1290BF8F1E1EB1D9D328C1F0FBE51D0 - 2983F8D1E11B0D9D32841F0DBE51D12903F8B3C3373A3AA519BF367C8A5E9A46 - FCEAF0297AE534E157864FD16BA701BF1C3E458F96227E297C8A1E2F05FC9FF0 - 297AB212E2A7F0AA29C3A3143F5E09D1F1A3A5F028C58F96023A2A8747297EED - 14D151657894E2574E033AAA0E8F52FCD234A1A3DAF028C5CFA7111DCD0E8F1A - 1D5F333A8A068F1A155F017DA4A363E3DBF6F6E7C1E7BFFD93277F095FAF5074 - 78D468F80AE8C3EDED9BDEB6B58D07F0FE9BB6B6A9E0EBC3E16B168A078F1A05 - 5F01FDF6E3FFB63EB8FBF0DDCB63C7BF013EC40F6EB8A3A395961F1F1ED53BBE - 0A7AFFE05FDDFD43E3DD03437E80FFF9F59123E1EA69F901FE013C970C1ED52B - BE02FAC4A5459BFB7BAEBD073A5DEFBD87A33396FF0CCF268747F586AF803ED5 - E96DCA9EF3C6272FCC9D7CDC7BF5D374FCFCF28F8E078B1F1B696D5D81E7D5E0 - 51BDE02BA0E73ABD2D40F7BB02CAE0262E2E9CE8EFBD3E5A8AFFE055F00F775D - F85E41EAF0483ABE86A5133A1D961FFCD9F908F4DB038363DD03CF5685EF5548 - 0F3C928AAF71E9332FBFFC2BC3773243C5A553FAE091347C034B9F7ED94E6F6C - F2E26F2BC3F79A915E782405DFE0D271400F9E2B5B3AA51F1E71C7B7B0F4DC3F - 5EC9DFF4999981475CF11D2F9D32078FB8E133583A65161E71C167B274CA3C3C - 728DCF68E9941D78E40A9FD9D2297BF0C8363EC3A55376E1912D7CA64BA7ECC3 - 23D3F88C974EB98147A6F0992F9D72078F74E3ABA15B593AE5161EE9C257409F - FAD7DB6A6BE9947B78A48A2F68E9140F7894145FD8D2293EF028097ED2A5DF6F - 5A9EEBF23E57C2A633B1748A173C8A8B1FF97EA2A3EC939653D9FB4DA301FE64 - 5574034BA7F8C123EDF8A5E8C1AF3B279769F9DFCFB4F8B99EA68FB9F3DEF732 - 74434BA778C2236DF8A5E8A8E7CCD2255F1FCDFB0278DCF4E59B5E3AC5171E29 - E397A3A35DBBD66EDBBFEF4FFF6BDFFC10BEB8FC2EEF83E9A553BCE15162FCCA - E868DB8EF567576DD8EE1F3AB8DAFFD6377724FBB4B92F97693E91EB695E5678 - C478FCE1516CFCEAE868CFDE355777EE5E77FAD081D57F0C5E5ABC20F8EDE714 - BE652D19F028327E6D742EC98147B3E2CB4047B2E051557C39E8481E3C2AC397 - 858E64C2A322BE3C7424171E015C203A2AC2A767FB7CEF078A02E2CF49BDCE74 - 0000000049454E44AE426082} + 89504E470D0A1A0A0000000D4948445200000060000000600806000000E29877 + 38000000097048597300000B1300000B1301009A9C180000044149444154789C + ED9D3D6C13571CC09F91488804230B62E85ABE25062AB1D0562441B465020604 + 63983A70074C69918A701A09E297D03636998009061B230545102731892177E2 + 6388DB446A97AAF652D186004AEE09C31F9D892D27B1E324C6F77FF7DEFF27BD + F9F97EBF7BF735F83146100441100441100441108487705BEC08598273DB4973 + CB79C36D01751DF9399CF4C739C50EA62B17D2D010B29C5FB9E5BCABBBF40A23 + 643BB99025AEBABF85E9847BC0DC16092CF14B438841AD22E4CF7C09C4F38511 + 7A9836D77CDBC9610BE7652E475D96D8FEA98EF39F3367BECC1AC654D630FECF + 98663B30166032C06DD18D2D9B578A6089AE4F718CD9B3679BB3863197354D28 + 8C8C6986A58810B2C5EFF2067026EA215FAA0821CB798D2D9A571CCEAB5A8EED + EEE0E8A1C960C7D372F28B110CA31B35423509CCA7F3C786522DB1446AEE4E62 + 746632F8F3C4B2113057828A01E2C38F5AF3F28752901F3247502D407CB1FCD2 + 08973AD25522B433AF5129C0E3F8A583B1A194B3447E31C2D8CBA960C7722BE1 + 3FE635AA0480086B867060F6E1BDDE64C500555642C6342799D7A810005CF9BD + 6C0EC20CA037F07E2511A6829D0B2318C69CFBB2C6BCC6EF01A0547E61AC3042 + 71251886C818C6370C033F078072F25719E18F60E7B38C697ECBB0F06B00584E + FEFC78D7BBEEFD487F5F6A999BF26CEC7EB28561E2C700B002F9D556C2FCD3D2 + 61868DDF02C06AE45788208D7CBF0580B5C85F14412AF97E0A0061D6BA66F985 + 7B4278DDEC78FCE2574C26FC10006A39F38B2B8009F88DE13C6AFA3900A82C5F + F600D1443F282D5FE600D1443FE4221B4069F9B20688EA225FC600519DE4CB16 + 20AA9B7C99024475942F4B80A8AEF2650810D5593E760088B066ADE5630600D5 + DF70650E00241F2F00907CBC0040F2F102C058D316B81E785EA37C375E2B5309 + CF0224D79F8064E30CDC0CA4E9CCC70830D2D007C94658530455E57BBB021AFE + 9A0FB0BA082ACBF72A000C376D2D91BFE208B94803282DDFBB001B4E9609908F + F0E2D6F68AF2E30F6275FF14A24580AEF6DDE3D3031BCB0500F170332C8E5090 + EFC5B7282D027C77B4E5EDF1135FC38B7B9BAA4628954F01ECDA05FCF2C3AE7D + FB5A8E803BAA45F8F7F69E05F229805DBB809FCEEDBD5608502EC2F4E8E73031 + D606038F6F409FF5B7E79FC3950FF0FDE9FD7F96063872EC60AEE7C75DCF61A4 + B10D861B3FC3F8182815F51670EAD4816937C2C5F37B23DD17767EE1F5FCD283 + 2D8053000A800AB6004E0128002AD8023805A000A8600BE0148002A0822D8053 + 000A800AB6004E0128002AD8023805A000A8600BE0148002A0822D8053000A80 + 0AB6004E0128002AEE1F645793C09146C8766698EAA8FEF7F5D2C32D11927705 + 88CB4C75DC6D4264DDC2A47BDCD9C674C0DD3A4ABECB8FE04CAB3DC46C31882D + BD382CF120F204D6339D988FD0837B3972DEBA67BE76F297DC132CD1E53E8178 + B1BF8C3B873B17B7C5156DAEF904411004411004411004C164E1034F1C961B87 + 1CCC4A0000000049454E44AE426082} end> end item @@ -19689,14 +19700,24 @@ object MainForm: TMainForm item Image.Data = { 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF - 61000000D64944415478DA63FCFFFF3F03258091A606FCF9F387958585E53759 - 06FCFCF9936BF1E2C5535455558FD8DBDBCF23C90098E64F9F3EB97DFEFCF99B - 838343072E43300C8069FEF5EB97A70410000DF8FD000870198262004C331313 - 93A7828282C4F7EFDF19BE7DFBC60074C9EFC78F1F3F707474C430046E004C33 - 2727A7A79696960448E3D7AF5FE11864C88B172F1E383B3BA318023760CB962D - E577EEDC49F5F7F757FEF2E50B5813D0F9601780F8200C0A8FF7EFDFDFCBC8C8 - 88929595BD4C5D17501C06548905AAA403AAA44418A0282F100B00A40F11F06C - 75C2A50000000049454E44AE426082} + 610000000774494D4507D7091C0832217B3A19F6000000097048597300001EC1 + 00001EC101C36954530000000467414D410000B18F0BFC6105000001DF494441 + 5478DAA5534B4B1B5114FE924C8C8FBA5123F8A0208258A9AFA011410441A588 + 54C4552BAE4A97EEBB125DE8FF1091E0220BD1A5ABA828BEC08D0F14290815AD + 181F8831F7E5B977D2CC8C5DA8786072EEBD73BEEF7CE7BB13E09DE1D33F3389 + E49852F82994AC9452424880EB2CF45A8153761E01C1159DCBCDA9919AA8A509 + A452A343D1C292B7741E9F3B6ED0D910109B01CF9F4C53674E5D381865269893 + E9ECDFBB5FED93604C845C04CAB07EAFFBF1AAEEF72922E5020E811E9A22B672 + 61F2B7CDD9FF40B1D6E1ECFA6B4B11D26E029E2130E08E52608BBCEDE971D089 + 847D9E89CBDB94570123023212560088AF5D6028143220048380DF6F0AE73748 + 1DD50409F1A9221F69F66C04ED8215F061301A06F689A0ADCDA36020EA2838FE + 730BCEA55781A2BD45CD16B7FFA25F77DED9B1ABF59A22BE7E0E8B26D3B0BAF2 + 5C6AE8262036A5E5D1085F9A49C1EF7CA0B6D651B0B787DEC66214E699721C9E + DEA02064B94C94365BC0EFC3D2EE25BAF5E6E0C0066B0F1E1FB1BC9FCCF25587 + 73B2376713706E7B40B55DF5F44D9D920755551E0FFA22E1EC562B08D8DEBA3C + A0113E7FFC80B3AB0794452274C84C67933B3B0DC81D522AE9BA05B53A113B6A + 4A0B59A0EF573F827C61E6CFC33390A487E0FA2EB5F0AACFF6A578022F20FEE3 + 581645BC0000000049454E44AE426082} end> end item @@ -20959,20 +20980,25 @@ object MainForm: TMainForm item Image.Data = { 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF - 61000001974944415478DA63FCFFFF3F0336F0E7CF1F56161696DF0C04002336 - 037EFEFCC9B578F1E229AAAAAA47ECEDEDE79164004CF3A74F9FDC3E7FFEFCCD - C1C1A1039F212806C034FFFAF5CB5302088006FC7E0004F80C811B00D3CCC4C4 - E4A9A0A020F1FDFB77866FDFBE31005DF2FBF1E3C70F1C1D1DB11A023600A699 - 9393D3534B4B4B02A4F1EBD7AF700C32E4C58B170F9C9D9D310C011BB065CB96 - F23B77EEA4FAFBFB2B7FF9F205AC09E87CB00B407C100685C7FBF7EFEF656464 - 44C9CACA5EA6AE0B280E036262E1CAD39373EF7CB8C4F0E5C72786EFDFBFFDF7 - B208AD8B724E6F212A1D5C7E767CEE5B961B0CC65AA60CB242AA0CFBAEAC6738 - 7EE530838D5C682F512931BED3FD7F90B7270303331383BF661E43CF9E140666 - 062686759B77FD6024262F785719FCCF8ECE61F0D24E81CB6FBA3C95A1657A33 - 034E0390815DBEE27F5F6F07863F0CFF182ADD1632B4EF8C67E06066C7EF0264 - 905C17F2FF3DDF65066B3D1B0655492386DBCFCF311CBD7484C14131AA972803 - 4060CA86968EB58716647DFDF185979B83E773B05DC2B49C809A0A00938D5CC5 - DBE34CD90000000049454E44AE426082} + 610000000774494D4507D7091C082D1B706CCEDA000000097048597300001EC1 + 00001EC101C36954530000000467414D410000B18F0BFC610500000203494441 + 5478DAA5524D48545114FEDECC9B99D28450C7C4C44D1024953FC8234982C442 + C28C68653FAB7057482B2B488C30DA0AD1BE1286162E424117AEACA89416E142 + 44B345A060D19833A2BDFBD73957E7CDBCC145D1817BCFBDE79EF39DF39D7381 + FF1487B797D3E90163D0AB8CAED55A436940B2567C3690A4F34B414943763DFB + F8C651CF65006DCCED2B5E59E5BF641E7CB57492B50520341BFC7AF939659694 + 454290164AE435D9726F775B8720844A1400188B7AB5FEE65F65DFDC2650A990 + 0760D224A9B76B81534F5B15BA9E7660FCD654C8CED2DD520E7F1720C29BDC05 + C805B2B43F398DEAF243B8F8EC5C60CFAD2DBFA8024100D448B85160F4FD1A86 + 273A114BC4E00B0149CEA9B9EB28898F00E413A38863874BE8AD880277C18D3A + B8EC25E1AB499BE9CCA353987EF0C152B8E45505552EAD6C404A1DAEC0D0DD25 + 42E39FBEE3CE6A2B7AF0055248EBD4F7D543DCFD08977E0D87D5D7ECA3848500 + 8466B83CA2D0D994049669A40BA3E8BF76CF6A8790CF3754A06CBF75C7C2B75F + 284DB87900FE752CD18883A9CF3FA0B21259910D4A16691F6FE6D3C1FD48321E + 4C6E0740CA9D1E1085B3272A61660C32BF3742A3BBD09C0CCE5C413482A21E10 + 85E37507B0FA730B5A6864FC300007158AD646174CC1BC7B985A6CF4952EB5F3 + 750C51D80C05DC7F3117BAAF67B6C7583B7B7DD583C335A6D8B6DEB7B2A7EF1F + 2FC319C14F17DD760000000049454E44AE426082} end> end item @@ -20981,23 +21007,25 @@ object MainForm: TMainForm item Image.Data = { 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF - 61000001FA4944415478DA63FCFFFF3FC393274F645EBE7C29FEF7EF5F66063C - 404C4CEC959C9CDC232626A67F303146900167CF9E35D6D1D1D9CBCCCCCCCBC8 - C8C8844DF39F3F7F184E9D3A35495656B61FD910B0014009332323A3E33F7FFE - 64021A80A2E9DFBF7F0CBF7EFD621016166678FDFA35C3EDDBB7510C61042A60 - 3C7DFAB4A9B1B1F1C9DFBF7F330005C19A600600BD0536404848084C83E42E5C - B830495A5ABA5F4141E1018A0120C530005208721DC810A0CB1804050551BC04 - F4B6B9A9A9E9691403401A605E00B141068230C81090EB408682D8C0C0C46E00 - 7AC0211B02C32043F8F9F9893300D9109046100DE2737171116F007278C0C288 - 8D8D8D3403409A9F6E9CC6F07CF374862F8FEE30B08A4B323018F94DB32B999C - 83D30090261878B6693AC3C7E32B19541D0219D895B419BE5FDCC970F5F0DE7F - 624E6985040D00D1C71334184CA3B21838EFEE67607872948141809FE10D8B3C - C3B54B4FEF138C051038E0C6C9E0DCB39281D128082EF7A14E9CE1CC9177FF91 - 0D38014ADAD8C2E070B40283A9AB2B03F7C3AD0C3FBFBF62F80614FBFC8989E1 - FE47E9A7E0BC70E6CC19133D3DBD83C0CCC40194C3C84C8FD7F431BCDE338741 - 46F027030BD35386CFAFFF30DC7BCDFA4F29A2A1166CC0E3C78F6541D919E81A - AC39119C2F4EAC8DFF7A646920E39B9712FF04455E8BBA242C30CC6C2F070010 - 3977340F6827150000000049454E44AE426082} + 610000000774494D4507D7091C08311D7F7836B2000000097048597300001EC1 + 00001EC101C36954530000000467414D410000B18F0BFC610500000204494441 + 5478DAA592496854411086FFB748A26344328907B7A3605C0764440888108228 + B8A007357812B783DE849CC41CF4E245CFA210154603824BE2493CB8A3288807 + 09064184884934796326F3667A29ABFB396FC9258A05FDAAAA5FD757D5550DFC + A738E673E3C9E459221C55A4976BADA134208D56C62648D6C9525092785FBFB9 + 707855D137004D746A5FB1A5ED5F329FBB3DB2DE680B609A0DBEF7B99F334BCE + 2221580B2512CD7B8D7FBD5BCE4308D5940290A51EEA38F257D92B2143A54202 + 309766293D1BB3FAC0D045909070E6F971D0AD9D67627BD7A656D4D300F90760 + E460E712D0101B3DFB418D4E0FDCB5FB0D992887D90A0403B891F03DE0CECB31 + ECA9D64C597100B13FF89AABE333A6A8D5CB16A02E665DC164F33D077B8BED10 + 572B70C35A0CD0D315EC2E26158C8C9621A5CE5640ECFB2E30F8761C5DC1349C + 996A1CA0D8BFFFEA3B7C7E3526AC636933274C039846A63CBEC2F6423B2A4119 + 3E674D0065746FC8A3657ED4D4E1AF01724D91EDDA26EA88E6B90E1EBD9F40FD + CB2882ADDD10FD03561B79FA71120FDF8DDB959E5C340529A31E306EDBBA36FC + 78F13833F7B074133BF2F9D83715782E66F580AFB076E5427CFB5945736717BC + 4539046B5660F1F193D61EEEBB94816A4D3A35057ADE57FAB4B1AE74CECC571C + BB82CBD74E4085027AA6869EC269E0FA870C60EA57F860CE273B55D84C739DF9 + 0D524C1E9FA00879F60000000049454E44AE426082} end> end item @@ -21006,24 +21034,29 @@ object MainForm: TMainForm item Image.Data = { 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF - 61000002194944415478DA63FCFFFF3F0336F0E7CF1F56161696DF0C04002336 - 037EFEFCC9B578F1E229AAAAAA47ECEDEDE79164004CF3A74F9FDC3E7FFEFCCD - C1C1A1039F212806C034FFFAF5CB5302088006FC7E0004F80C811B00D3CCC4C4 - E4A9A0A020F1FDFB77866FDFBE31005DF2FBF1E3C70F1C1D1DB11A023600A699 - 9393D3534B4B4B02A4F1EBD7AF700C32E4C58B170FD2C27555BF5E58C3C0CCA3 - C7F0F5CD0106399B9C78B0015BB66C29BF73E74EAABFBFBFF2972F5FC09A80CE - 07BB00C4076133D50F0C920C6F193845ED18F8158D183EDC3FC670F7D09A9744 - B9404DEC29838AF437061E7E638677776E32F08B2833B0F18A31DC38B8EC07C1 - 3050167DC3A028FA84815FC993E1E7F3E50CDFDF3232BCBAF18DE11F03DB5B45 - DF3A2BBCB1A023FF8D4194FD0A03BF4A00C38FA7D31898D8FE30FCFE22CFF0E1 - F48D97221EDD1E9C622A1770A60313A5BF89127C7719C47482809AA73230B1FE - 61F8F55991E1F98133FFE58327987148689DC199124FED98F69F97F11E83BA9D - 1FC3AF970B1818997F31FCF828C3F0EAF07986837F1CDFA5E45608E34C89E777 - CDF9CFFEE72EC31F46710661E1230C82626C40CDB20CAF8E5D6638F6D7EE7552 - 4E8518DEA4BCAAD3E97F58D67C869BCB8B189E02A38A5D5E9FE1FB9BAFFFD88D - B216DA7A452611CC0BADE97ABF4B13D3581898FE325CD8BD9EE1C9D3675F82A6 - DDE2253A334539497ED797176231D55460E097573D661C3EC11E5F6E04006B58 - 55345F31ADC00000000049454E44AE426082} + 610000000467414D410000AFC837058AE90000001974455874536F6674776172 + 650041646F626520496D616765526561647971C9653C0000027A4944415438CB + A5935948D45118C57FFF65C6B2316B320DB3D2CA362B6D71205A5EA5852202C1 + 882022DF7C8F1E5A20417A0DEA415F8AC0160A2C1F2AA47526ADA85C28B73442 + CC6574D4B174FCFFEFD2C3D428415174E1F2C1BDDCF39D73BE730DAD35FFB36C + 806BCF474F6BCD09A95596520AA9402885940AA93442AA195B2285462AF5BAFC + 486EC006505A971D0AA4A4FD4BE7B3373E6E4C30904AA501D4745F4128819002 + 57095CE94E5729127727B795E3BA32690640DC87C3EB8EFF55F76F31812BE4B4 + 07522A00AA83837F7CE8778264F7DFC2F26DA0D4FB94E64BBD476D00F10300A0 + 64473A374303146FCF489CDD6E1860F7B29744DB5E317BC31152733631FA6935 + 6D0FAB2ED800AE5428ADB12DB85D3F886599DC6918C430C104FCCE2362239DF8 + 73B713E96AC56B38A4CC5D846FC1D2D484040DD896C1C1C0426A5E8539104807 + 2036F48C898156E6E51431D5771D6FB2C1E7C636A21326C6D450BEF993815660 + 9B50FB268C65C5EB93500D93FDF799B7620FB12F95189E113CBE1492E4305723 + 451496DDE988030885D61A8F05FBB62C64966DB035B99E3549F5A4AEDC4FACF7 + 32A6C7C5896633146CC62938C5576F161097885071132DD3A0AE6908D55747A4 + 27447ADE5E9CFE2A2CAF662ABA8C81E76FE9CCAB00FFAAC4E4E2531022EE8109 + 8BC7EB10BA05A132E96BB9C8FC742FB1C81246DFB4915D52496EEA62DA7BC6B0 + 4CA619B8322E61FD521F4DC12AD6ED2825A92748474D88C607113ED4BDC3293C + 4377D4477BCF18004A693523483A74AEBAB3C0916A4E665718E77D2D39F93B19 + 0B0FD3F5B693C759E719BE3B0EB424B2313A1EBB0760FCFA9D8B77F927372FCF + B0036B73D09EA9179383E163FB2A9ABB7F97CEEFD0DF4B18DDB42B4300000000 + 49454E44AE426082} end> end item diff --git a/source/main.pas b/source/main.pas index 7f59acb5f..0f3e8d921 100644 --- a/source/main.pas +++ b/source/main.pas @@ -197,11 +197,17 @@ TQueryHistoryItemComparer = class(TComparer) end; TMainForm = class(TExtForm) + actDataEditWithoutLookup: TAction; + actTreeShowColumns: TAction; MainMenu1: TMainMenu; MainMenuFile: TMenuItem; FileNewItem: TMenuItem; MainMenuHelp: TMenuItem; FollowForeignKey: TMenuItem; + menuDataEditWithoutLookup: TMenuItem; + menuTreeShowColumns2: TMenuItem; + menuTreeShowColumns1: TMenuItem; + menuRenameSnippet: TMenuItem; N1: TMenuItem; FileExitItem: TMenuItem; menuAbout: TMenuItem; @@ -809,7 +815,11 @@ TMainForm = class(TExtForm) N27: TMenuItem; actCopyColumnNames: TAction; Copycolumnnames1: TMenuItem; + actCopyFormatted: TAction; + Copyformattedtext1: TMenuItem; procedure actCreateDBObjectExecute(Sender: TObject); + procedure actDataEditWithoutLookupExecute(Sender: TObject); + procedure actTreeShowColumnsExecute(Sender: TObject); procedure menuConnectionsPopup(Sender: TObject); procedure actExitApplicationExecute(Sender: TObject); procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA; @@ -920,6 +930,7 @@ TMainForm = class(TExtForm) TColumnIndex; NewText: String); procedure AnyGridPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); + procedure menuRenameSnippetClick(Sender: TObject); procedure menuDeleteSnippetClick(Sender: TObject); procedure menuExploreClick(Sender: TObject); procedure menuInsertAtCursorClick(Sender: TObject); @@ -1008,8 +1019,7 @@ TMainForm = class(TExtForm) procedure actCloseQueryTabExecute(Sender: TObject); procedure menuCloseQueryTabClick(Sender: TObject); procedure CloseQueryTab(PageIndex: Integer); - procedure CloseButtonOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); - procedure CloseButtonOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + procedure CloseButtonOnClick(Sender: TObject); function GetMainTabAt(X, Y: Integer): Integer; procedure FixQueryTabCloseButtons; function GetOrCreateEmptyQueryTab(DoFocus: Boolean): TQueryTab; @@ -1216,6 +1226,7 @@ TMainForm = class(TExtForm) procedure actQueryTableExecute(Sender: TObject); procedure actDisplayLogPanelExecute(Sender: TObject); procedure actDisplayTreeFiltersExecute(Sender: TObject); + procedure actCopyFormattedExecute(Sender: TObject); private // Executable file details FAppVerMajor, FAppVerMinor, FAppVerRelease, FAppVerRevision: Word; @@ -1260,6 +1271,7 @@ TMainForm = class(TExtForm) FCreateDatabaseDialog: TCreateDatabaseForm; FTableToolsDialog: TfrmTableTools; FGridEditFunctionMode: Boolean; + FDataEditWithoutLookup: Boolean; FClipboardHasNull: Boolean; FTimeZoneOffset: Integer; FGridCopying: Boolean; @@ -1327,7 +1339,6 @@ TMainForm = class(TExtForm) QueryTabs: TQueryTabList; ActiveObjectEditor: TDBObjectEditor; FileEncodings: TStringList; - ImportSettingsDone: Boolean; // Data grid related stuff DataGridHiddenColumns: TStringList; @@ -1739,6 +1750,11 @@ procedure TMainForm.actGridEditFunctionExecute(Sender: TObject); ActiveGrid.EditNode(ActiveGrid.FocusedNode, ActiveGrid.FocusedColumn); end; +procedure TMainForm.actDataEditWithoutLookupExecute(Sender: TObject); +begin + FDataEditWithoutLookup := True; + DataGrid.EditNode(DataGrid.FocusedNode, DataGrid.FocusedColumn); +end; procedure TMainForm.StoreLastSessions; var @@ -1862,6 +1878,7 @@ procedure TMainForm.FormDestroy(Sender: TObject); AppSettings.WriteInt(asCompletionProposalNbLinesInWindow, SynCompletionProposal.NbLinesInWindow); AppSettings.WriteInt(asDbtreewidth, pnlLeft.width); AppSettings.WriteBool(asGroupTreeObjects, actGroupObjects.Checked); + AppSettings.WriteBool(asTreeShowColumns, actTreeShowColumns.Checked); AppSettings.WriteInt(asDataPreviewHeight, pnlPreview.Height); AppSettings.WriteBool(asDataPreviewEnabled, actDataPreview.Checked); AppSettings.WriteInt(asLogHeight, SynMemoSQLLog.Height); @@ -2092,6 +2109,7 @@ procedure TMainForm.FormCreate(Sender: TObject); // Display options, and database tree options actGroupObjects.Checked := AppSettings.ReadBool(asGroupTreeObjects); + actTreeShowColumns.Checked := AppSettings.ReadBool(asTreeShowColumns); actDisplayObjectSize.Checked := AppSettings.ReadBool(asDisplayObjectSizeColumn); actDisplayObjectSizeExecute(nil); actDisplayLogPanel.Checked := AppSettings.ReadBool(asDisplayLogPanel); @@ -2221,7 +2239,6 @@ procedure TMainForm.AfterFormCreate; StatsCall: THttpDownload; SessionPaths: TStringlist; DlgResult: TModalResult; - SessionManager: TConnForm; begin if AppSettings.ReadBool(asUpdatecheck) then begin // Do an updatecheck if checked in settings @@ -2334,11 +2351,11 @@ procedure TMainForm.AfterFormCreate; // Display session manager if Connections.Count = 0 then begin // Cannot be done in OnCreate because we need ready forms here: - SessionManager := TConnForm.Create(Self); + connform := TConnForm.Create(Self); DlgResult := mrCancel; try - DlgResult := SessionManager.ShowModal; - SessionManager.Free; + DlgResult := connform.ShowModal; + FreeAndNil(connform); except // Work around VCL bug: Suppress access violation in TCustomForm.IsFormSizeStored // when closing dialog via Alt+F4 @@ -2369,10 +2386,7 @@ function TMainForm.InitTabsIniFile: TIniFile; begin // Try to open tabs.ini for writing or reading // Taking multiple application instances into account - if AppSettings.PortableMode then - TabsIniFilename := GetAppDir + 'tabs.ini' - else - TabsIniFilename := AppSettings.DirnameUserAppData + 'tabs.ini'; + TabsIniFilename := AppSettings.DirnameUserAppData + 'tabs.ini'; WaitingSince := GetTickCount64; Attempts := 0; while not FileIsWritable(TabsIniFilename) do begin @@ -2627,12 +2641,10 @@ procedure TMainForm.TimerStoreTabsTimer(Sender: TObject); procedure TMainForm.actSessionManagerExecute(Sender: TObject); -var - Dialog: TConnForm; begin - Dialog := TConnForm.Create(Self); - Dialog.ShowModal; - Dialog.Free; + connform := TConnForm.Create(Self); + connform.ShowModal; + FreeAndNil(connform); end; @@ -2641,7 +2653,6 @@ procedure TMainForm.actDisconnectExecute(Sender: TObject); Connection: TDBConnection; Node: PVirtualNode; DlgResult: Integer; - Dialog: TConnForm; begin // Disconnect active connection. If it's the last, exit application Connection := ActiveConnection; @@ -2652,9 +2663,9 @@ procedure TMainForm.actDisconnectExecute(Sender: TObject); // TODO: focus last session? SelectNode(DBtree, GetNextNode(DBtree, nil)); if FConnections.Count = 0 then begin - Dialog := TConnForm.Create(Self); - DlgResult := Dialog.ShowModal; - Dialog.Free; + connform := TConnForm.Create(Self); + DlgResult := connform.ShowModal; + FreeAndNil(connform); if DlgResult = mrCancel then actExitApplication.Execute; end; @@ -3194,15 +3205,16 @@ procedure TMainForm.actImportSettingsExecute(Sender: TObject); Dialog := TOpenDialog.Create(Self); Dialog.Title := f_('Import %s settings from file ...', [APPNAME]); Dialog.Filter := _('Text files')+' (*.txt)|*.txt|'+_('Registry dump, deprecated')+' (*.reg)|*.reg|'+_('All files')+' (*.*)|*.*'; - ImportSettingsDone := False; if Dialog.Execute then try if LowerCase(ExtractFileExt(Dialog.FileName)) = 'reg' then ShellExec('regedit.exe', '', '"'+Dialog.FileName+'"') - else begin + else AppSettings.ImportSettings(Dialog.FileName); - MessageDialog(f_('Settings successfully restored from %s', [Dialog.FileName]), mtInformation, [mbOK]); + // Refresh in session manager per timer interval + if Assigned(connform) then begin + connform.timerSettingsImport.Enabled := True; end; - ImportSettingsDone := True; + MessageDialog(f_('Settings successfully restored from %s', [Dialog.FileName]), mtInformation, [mbOK]); except on E:Exception do ErrorDialog(E.Message); @@ -3851,7 +3863,7 @@ procedure TMainForm.actInsertFilesExecute(Sender: TObject); procedure TMainForm.actDropObjectsExecute(Sender: TObject); var msg, db: String; - Node: PVirtualNode; + Node, SiblingDB: PVirtualNode; Obj: PDBObject; DBObject: TDBObject; ObjectList: TDBObjectList; @@ -3872,7 +3884,15 @@ procedure TMainForm.actDropObjectsExecute(Sender: TObject); try db := DBObject.Database; Node := FindDBNode(DBtree, Conn, db); - SetActiveDatabase('', Conn); + // Set focus on previous or next database, to prevent "Cannot drop database xyz, because it is currently in use" + // MS SQL on top cannot "un-use" the current database + SiblingDB := DBtree.GetNextSibling(Node); + if not Assigned(SiblingDB) then + SiblingDB := DBtree.GetPreviousSibling(Node); + if Assigned(SiblingDB) then + SetActiveDatabase(DBtree.Text[SiblingDB, 0], Conn) + else + SetActiveDatabase('', Conn); // Fallback if there is no sibling. Works on MySQL only. Conn.Query(qDatabaseDrop, [Conn.QuoteIdent(db)]); DBtree.DeleteNode(Node); Conn.ClearDbObjects(db); @@ -4544,6 +4564,13 @@ procedure TMainForm.actCreateDBObjectExecute(Sender: TObject); end; +procedure TMainForm.actTreeShowColumnsExecute(Sender: TObject); +begin + // Show columns in table nodes on tree + RefreshTree(nil); +end; + + procedure TMainForm.actEmptyTablesExecute(Sender: TObject); var TableOrView: TDBObject; @@ -4596,7 +4623,7 @@ procedure TMainForm.actEmptyTablesExecute(Sender: TObject); Conn.Query(QueryDisableChecks); try for TableOrView in Objects do begin - Conn.Query(Conn.SqlProvider.GetSql(qEmptyTable) + TableOrView.QuotedName); + Conn.Query(qEmptyTable, [TableOrView.QuotedName]); ProgressStep; end; actRefresh.Execute; @@ -5120,6 +5147,7 @@ procedure TMainForm.actQueryTableExecute(Sender: TObject); for Obj in Objects do begin Tab := GetOrCreateEmptyQueryTab(True); Tab.Memo.Text := Conn.ApplyLimitClause('SELECT', '* FROM '+Obj.QuotedName, AppSettings.ReadInt(asDatagridRowsPerStep), 0); + SetTabCaption(Tab.TabSheet.TabIndex, Obj.Name); actExecuteQueryExecute(Sender); end; end; @@ -5287,8 +5315,8 @@ procedure TMainform.popupQueryLoadClick(Sender: TObject); // Click on the popupQueryLoad Filename := (Sender as TMenuItem).Caption; Filename := StripHotkey(Filename); - if Pos('\', Filename) = 0 then // assuming we load a snippet - Filename := AppSettings.DirnameSnippets + Filename + '.sql' + if Pos(PathDelim, Filename) = 0 then // assuming we load a snippet + Filename := AppSettings.DirnameSnippets + Filename + FILEEXT_SNIPPET else begin // assuming we load a file from the recent-list p := Pos(' ', Filename) + 1; filename := Copy(Filename, p, Length(Filename)); @@ -5970,7 +5998,7 @@ procedure TMainForm.DataGridBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: col := vt.Header.Columns.Add; col.Text := TblCol.Name; col.Hint := TblCol.Comment; - col.Options := col.Options + [coSmartResize]; + col.Options := col.Options + [coSmartResize, coEditable]; if DatagridHiddenColumns.IndexOf(TblCol.Name) > -1 then col.Options := col.Options - [coVisible]; // Column header icon @@ -6655,6 +6683,7 @@ procedure TMainForm.ValidateControls(Sender: TObject); actDataCancelChanges.Enabled := HasConnection and GridHasChanges; actDataSaveBlobToFile.Enabled := HasConnection and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); actGridEditFunction.Enabled := HasConnection and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actDataEditWithoutLookup.Enabled := HasConnection and inDataTab; actDataPreview.Enabled := HasConnection and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); actDataOpenUrl.Enabled := (Length(CellText) tabData) or (DataGrid.FocusedColumn = NoColumn) then @@ -7518,7 +7538,10 @@ procedure TMainForm.QuickFilterClick(Sender: TObject); and (Conn.Parameters.NetTypeGroup = ngPgSQL) then begin Col := Col + '::text'; end; + OldDataLocalNumberFormat := DataLocalNumberFormat; + DataLocalNumberFormat := False; Val := DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn]; + DataLocalNumberFormat := OldDataLocalNumberFormat; if InputQuery(_('Specify filter-value...'), Act.Caption, Val) then begin if Act = actQuickFilterPrompt1 then Filter := Col + ' = ' + Conn.EscapeString(Val, TableCol.DataType) @@ -7680,10 +7703,14 @@ procedure TMainForm.SynMemoQueryDragDrop(Sender, Source: TObject; X, // Insert table or database name. If a table is dropped and Shift is pressed, prepend the db name. case ActiveDbObj.NodeType of lntDb: Text := ActiveDbObj.QuotedDatabase(False); - lntTable..lntEvent: begin - if ShiftPressed then - Text := ActiveDbObj.QuotedDatabase(False) + '.'; - Text := Text + ActiveDbObj.Connection.QuoteIdent(ActiveDbObj.Name, False); + lntTable..lntEvent, lntColumn: begin + Text := ''; + if ShiftPressed then begin + Text := Text + ActiveDbObj.QuotedDatabase(False) + '.'; + if ActiveDbObj.NodeType = lntColumn then + Text := Text + ActiveDbObj.QuotedName(False) + '.'; + end; + Text := Text + ActiveDbObj.Connection.QuoteIdent(DBtree.Text[DBtree.FocusedNode, DBtree.FocusedColumn], False); end; end; end else if src = Tree then begin @@ -7691,7 +7718,7 @@ procedure TMainForm.SynMemoQueryDragDrop(Sender, Source: TObject; X, 1: case Tree.FocusedNode.Parent.Index of TQueryTab.HelperNodeSnippets: - Text := ReadTextFile(AppSettings.DirnameSnippets + Tree.Text[Tree.FocusedNode, 0] + '.sql', nil); + Text := ReadTextFile(AppSettings.DirnameSnippets + Tree.Text[Tree.FocusedNode, 0] + FILEEXT_SNIPPET, nil); TQueryTab.HelperNodeHistory: Text := ''; else begin @@ -8172,15 +8199,17 @@ procedure TMainForm.popupDataGridPopup(Sender: TObject); menuSQLHelpData.Enabled := InDataGrid; Refresh3.Enabled := InDataGrid; actGridEditFunction.Enabled := CellFocused; + actFollowForeignKey.Enabled := False; if not CellFocused then Exit; + if not InDataGrid then + Exit; Results := GridResult(Grid); Datatype := Results.DataType(Grid.FocusedColumn-1); Col := Results.Connection.QuoteIdent(Results.ColumnOrgNames[Grid.FocusedColumn-1], False); - if InDataGrid - and (Datatype.Index = dbdtJson) + if (Datatype.Index = dbdtJson) and Results.Connection.Parameters.IsAnyPostgreSQL then begin Col := Col + '::text'; end; @@ -8198,7 +8227,7 @@ procedure TMainForm.popupDataGridPopup(Sender: TObject); HasNotNullValue := False; OldDataLocalNumberFormat := DataLocalNumberFormat; DataLocalNumberFormat := False; - IncludedValues := TStringList.Create; + IncludedValues := TStringList.Create; // Used to skip duplicates while Assigned(Node) do begin AnyGridEnsureFullRow(Grid, Node); RowNumber := Grid.GetNodeData(Node); @@ -8226,7 +8255,7 @@ procedure TMainForm.popupDataGridPopup(Sender: TObject); end; end; Node := Grid.GetNextSelected(Node); - if Length(actQuickFilterFocused1.Hint) > SIZE_MB then + if Length(actQuickFilterFocused1.Hint) > SIZE_KB then Break; end; DataLocalNumberFormat := OldDataLocalNumberFormat; @@ -8313,20 +8342,17 @@ procedure TMainForm.popupDataGridPopup(Sender: TObject); // Stop here if Act = actRemoveFilter then Break; - if not Act.Hint.IsEmpty then + if not IsEmpty(Act.Hint) then Act.Caption := StrEllipsis(Act.Hint, 100); end; - actFollowForeignKey.Enabled := False; - if (InDataGrid) then begin - FocusedColumnName := Results.ColumnOrgNames[Grid.FocusedColumn-1]; - //find foreign key for current column - for ForeignKey in ActiveDBObj.TableForeignKeys do begin - i := ForeignKey.Columns.IndexOf(FocusedColumnName); - if i > -1 then begin - actFollowForeignKey.Enabled := True; - break; - end; + FocusedColumnName := Results.ColumnOrgNames[Grid.FocusedColumn-1]; + //find foreign key for current column + for ForeignKey in ActiveDBObj.TableForeignKeys do begin + i := ForeignKey.Columns.IndexOf(FocusedColumnName); + if i > -1 then begin + actFollowForeignKey.Enabled := True; + break; end; end; end; @@ -8362,7 +8388,7 @@ procedure TMainForm.QFvaluesClick(Sender: TObject); ShowStatusMsg(_('Fetching distinct values ...')); DbObj := ActiveDbObj; Conn := DbObj.Connection; - MaxSize := SIZE_GB; + MaxSize := SIZE_GB*2; ColumnHasIndex := DataGridResult.ColIsKeyPart(ResultCol) or DataGridResult.ColIsUniqueKeyPart(ResultCol) or DataGridResult.ColIsPrimaryKeyPart(ResultCol); @@ -8376,7 +8402,7 @@ procedure TMainForm.QFvaluesClick(Sender: TObject); if SynMemoFilter.Text <> '' then Query := Query + ' WHERE ' + SynMemoFilter.Text + CRLF; Query := Query + ' GROUP BY '+Conn.QuoteIdent(ColName)+' ORDER BY c DESC, '+Conn.QuoteIdent(ColName); - Data := Conn.GetResults(Conn.ApplyLimitClause('SELECT', Query, 30, 0)); + Data := Conn.GetResults(Conn.ApplyLimitClause('SELECT', Query, 50, 0)); for i:=0 to Data.RecordCount-1 do begin if QFvalues.Count > i then Item := QFvalues[i] @@ -8612,14 +8638,16 @@ function TMainForm.FindDBObjectNode(Tree: TBaseVirtualTree; Obj: TDBObject): PVi end; // Search in grouped table/view/... nodes - GroupedNode := Tree.GetFirstChild(ObjectNode); - while Assigned(GroupedNode) do begin - GroupedObj := Tree.GetNodeData(GroupedNode); - if GroupedObj.IsSameAs(Obj) then begin - Result := GroupedNode; - break; + if ObjectObj.NodeType = lntGroup then begin + GroupedNode := Tree.GetFirstChild(ObjectNode); + while Assigned(GroupedNode) do begin + GroupedObj := Tree.GetNodeData(GroupedNode); + if GroupedObj.IsSameAs(Obj) then begin + Result := GroupedNode; + break; + end; + GroupedNode := Tree.GetNextSibling(GroupedNode); end; - GroupedNode := Tree.GetNextSibling(GroupedNode); end; ObjectNode := Tree.GetNextSibling(ObjectNode); @@ -8754,27 +8782,59 @@ procedure TMainForm.insertFunction(Sender: TObject); end; +procedure TMainForm.menuRenameSnippetClick(Sender: TObject); +var + OldName, NewName: String; +begin + if not Assigned(QueryTabs.ActiveHelpersTree.FocusedNode) then + Exit; + + OldName := QueryTabs.ActiveHelpersTree.Text[QueryTabs.ActiveHelpersTree.FocusedNode, 0]; + NewName := OldName; + if InputQuery(_('Rename'), 'Rename snippet "'+OldName+'"', NewName) then + begin + Screen.Cursor := crHourGlass; + if NewName.IsEmpty then begin + Screen.Cursor := crDefault; + ErrorDialog(f_('Failed renaming %s', ['"' + OldName + '" => "' + NewName + '"'])); + end + else begin + OldName := ChangeFileExt(AppSettings.DirnameSnippets + OldName, FILEEXT_SNIPPET); + NewName := ChangeFileExt(AppSettings.DirnameSnippets + NewName, FILEEXT_SNIPPET); + LogSQL(Format('Rename snippet "%s" to "%s"', [OldName, NewName]), lcDebug); + if RenameFile(OldName, NewName) then begin + // Refresh list with snippets + SetSnippetFilenames; + end else begin + Screen.Cursor := crDefault; + ErrorDialog(f_('Failed renaming %s', ['"' + OldName + '" => "' + NewName + '"'])); + end; + end; + Screen.Cursor := crDefault; + end; +end; + {** Delete a snippet file } procedure TMainForm.menuDeleteSnippetClick(Sender: TObject); var - snippetfile : String; + SnippetFile : String; begin // Don't do anything if no item was selected if not Assigned(QueryTabs.ActiveHelpersTree.FocusedNode) then Exit; - snippetfile := AppSettings.DirnameSnippets + QueryTabs.ActiveHelpersTree.Text[QueryTabs.ActiveHelpersTree.FocusedNode, 0] + '.sql'; - if MessageDialog(_('Delete snippet file?'), snippetfile, mtConfirmation, [mbOk, mbCancel]) = mrOk then + SnippetFile := AppSettings.DirnameSnippets + QueryTabs.ActiveHelpersTree.Text[QueryTabs.ActiveHelpersTree.FocusedNode, 0] + FILEEXT_SNIPPET; + if MessageDialog(_('Delete snippet file?'), SnippetFile, mtConfirmation, [mbOk, mbCancel]) = mrOk then begin Screen.Cursor := crHourGlass; - if DeleteFileWithUndo(snippetfile) then begin + if DeleteFileWithUndo(SnippetFile) then begin // Refresh list with snippets SetSnippetFilenames; end else begin Screen.Cursor := crDefault; - ErrorDialog(f_('Failed deleting %s', [snippetfile])); + ErrorDialog(f_('Failed deleting %s', [SnippetFile])); end; Screen.Cursor := crDefault; end; @@ -8811,7 +8871,7 @@ procedure TMainForm.menuInsertAtCursorClick(Sender: TObject); } procedure TMainForm.menuLoadSnippetClick(Sender: TObject); begin - QueryTabs.ActiveTab.LoadContents(AppSettings.DirnameSnippets + QueryTabs.ActiveHelpersTree.Text[QueryTabs.ActiveHelpersTree.FocusedNode, 0] + '.sql', True, nil); + QueryTabs.ActiveTab.LoadContents(AppSettings.DirnameSnippets + QueryTabs.ActiveHelpersTree.Text[QueryTabs.ActiveHelpersTree.FocusedNode, 0] + FILEEXT_SNIPPET, True, nil); end; @@ -9252,7 +9312,7 @@ procedure TMainForm.ListProcessesFocusChanged(Sender: TBaseVirtualTree; SynMemoProcessView.Enabled := EnableControls; pnlProcessView.Enabled := EnableControls; - lblExplainProcess.Enabled := EnableControls and ActiveConnection.Parameters.IsAnyMySQL; + lblExplainProcess.Enabled := EnableControls and ActiveConnection.SqlProvider.Has(qExplain); menuExplainProcess.Enabled := lblExplainProcess.Enabled; end; @@ -9678,65 +9738,72 @@ procedure TMainForm.DBtreeGetText(Sender: TBaseVirtualTree; Node: Bytes: Int64; AllListsCached: Boolean; begin - DBObj := Sender.GetNodeData(Node); - case Column of - 0: case DBObj.NodeType of - lntNone: CellText := DBObj.Connection.Parameters.SessionPath; - lntDb: CellText := DBObj.Database; - lntGroup: begin - CellText := DBObj.Name; - if Sender.ChildrenInitialized[Node] then - CellText := CellText + ' (' + FormatNumber(Sender.ChildCount[Node]) + ')'; - end; - lntTable..lntEvent: try - if (DBObj.Schema <> '') and (DBObj.Connection.Parameters.NetTypeGroup = ngMSSQL) then - CellText := DBObj.Schema + '.' + DBObj.Name - else + try + DBObj := Sender.GetNodeData(Node); + case Column of + 0: case DBObj.NodeType of + lntNone: CellText := DBObj.Connection.Parameters.SessionPath; + lntDb: CellText := DBObj.Database; + lntGroup: begin CellText := DBObj.Name; - except - CellText := DBObj.Name; + if Sender.ChildrenInitialized[Node] then + CellText := CellText + ' (' + FormatNumber(Sender.ChildCount[Node]) + ')'; + end; + lntTable..lntEvent: try + if (DBObj.Schema <> '') and (DBObj.Connection.Parameters.NetTypeGroup = ngMSSQL) then + CellText := DBObj.Schema + '.' + DBObj.Name + else + CellText := DBObj.Name; + except + CellText := DBObj.Name; + end; + lntColumn: CellText := DBObj.Column; end; - lntColumn: CellText := DBObj.Column; - end; - 1: if DBObj.Connection.Active then case DBObj.NodeType of - // Calculate and display the sum of all table sizes in ALL dbs if all table lists are cached - lntNone: begin - AllListsCached := true; - for i:=0 to DBObj.Connection.AllDatabases.Count-1 do begin - if not DBObj.Connection.DbObjectsCached(DBObj.Connection.AllDatabases[i]) then begin - AllListsCached := false; - break; - end; - end; - // Will be also set to a negative value by GetTableSize and results of SHOW TABLES - Bytes := -1; - if AllListsCached then begin - Bytes := 0; + 1: if DBObj.Connection.Active then case DBObj.NodeType of + // Calculate and display the sum of all table sizes in ALL dbs if all table lists are cached + lntNone: begin + AllListsCached := true; for i:=0 to DBObj.Connection.AllDatabases.Count-1 do begin - DBObjects := DBObj.Connection.GetDBObjects(DBObj.Connection.AllDatabases[i]); - Inc(Bytes, DBObjects.DataSize); + if not DBObj.Connection.DbObjectsCached(DBObj.Connection.AllDatabases[i]) then begin + AllListsCached := false; + break; + end; end; + // Will be also set to a negative value by GetTableSize and results of SHOW TABLES + Bytes := -1; + if AllListsCached then begin + Bytes := 0; + for i:=0 to DBObj.Connection.AllDatabases.Count-1 do begin + DBObjects := DBObj.Connection.GetDBObjects(DBObj.Connection.AllDatabases[i]); + Inc(Bytes, DBObjects.DataSize); + end; + end; + if Bytes >= 0 then CellText := FormatByteNumber(Bytes) + else CellText := ''; end; - if Bytes >= 0 then CellText := FormatByteNumber(Bytes) - else CellText := ''; - end; - // Calculate and display the sum of all table sizes in ONE db, if the list is already cached. - lntDb: begin - if not DBObj.Connection.DbObjectsCached(DBObj.Database) then - CellText := '' - else begin - DBObjects := DBObj.Connection.GetDBObjects(DBObj.Database); - CellText := FormatByteNumber(DBObjects.DataSize); + // Calculate and display the sum of all table sizes in ONE db, if the list is already cached. + lntDb: begin + if not DBObj.Connection.DbObjectsCached(DBObj.Database) then + CellText := '' + else begin + DBObjects := DBObj.Connection.GetDBObjects(DBObj.Database); + CellText := FormatByteNumber(DBObjects.DataSize); + end; end; - end; - lntTable: begin - if DBObj.Size >= 0 then - CellText := FormatByteNumber(DBObj.Size) - else - CellText := ''; - end - else CellText := ''; // Applies for views/procs/... which have no size - end; + lntTable: begin + if DBObj.Size >= 0 then + CellText := FormatByteNumber(DBObj.Size) + else + CellText := ''; + end + else CellText := ''; // Applies for views/procs/... which have no size + end; + end; + except + // Uploaded crash reports show multiple different situations with an AV, + // some of them in conjunction with a killed query. + on E:EAccessViolation do + CellText := ''; end; end; @@ -9748,7 +9815,8 @@ procedure TMainForm.DBtreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); var - DBObj: PDBObject; + DBObj, ParentObj: PDBObject; + TableKeys: TTableKeyList; begin if Column > 0 then Exit; @@ -9758,6 +9826,11 @@ procedure TMainForm.DBtreeGetImageIndex(Sender: TBaseVirtualTree; Node: case Kind of ikNormal, ikSelected: begin ImageIndex := DBObj.ImageIndex; + if DBObj.NodeType = lntColumn then begin // Key/index icon + ParentObj := Sender.GetNodeData(Node.Parent); + ImageIndex := ParentObj.TableKeys.ImageIndex(DBObj.Column); + end; + Ghosted := (DBObj.NodeType = lntNone) and (not DBObj.Connection.Active); Ghosted := Ghosted or ((DBObj.NodeType = lntDB) and (not DBObj.Connection.DbObjectsCached(DBObj.Database)) @@ -9820,8 +9893,7 @@ procedure TMainForm.DBtreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualN DBObjects := DBObj.Connection.GetDBObjects(DBObj.Database, False, DBObj.GroupType); ChildCount := DBObjects.Count; end; - lntTable: - if GetParentFormOrFrame(Sender) is TfrmSelectDBObject then begin + lntTable: begin Columns := DBObj.TableColumns; ChildCount := Columns.Count; end; @@ -9839,6 +9911,21 @@ procedure TMainForm.DBtreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: Item, ParentObj: PDBObject; DBObjects: TDBObjectList; Columns: TTableColumnList; + + function TreeShowColumns: Boolean; + var f: TWinControl; + begin + Result := False; + if Item.NodeType = lntTable then begin + if Sender = DBtree then // optional in dbtree + Result := actTreeShowColumns.Checked + else begin + f := GetParentFormOrFrame(Sender); + Result := Assigned(f) and (f is TfrmSelectDBObject); + end; + end; + end; + begin Item := Sender.GetNodeData(Node); if (not Assigned(ParentNode)) or (ParentNode = nil) then begin @@ -9871,14 +9958,14 @@ procedure TMainForm.DBtreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: end else begin DBObjects := ParentObj.Connection.GetDBObjects(ParentObj.Database); Item^ := DBObjects[Node.Index]; - if (GetParentFormOrFrame(Sender) is TfrmSelectDBObject) and (Item.NodeType = lntTable) then + if TreeShowColumns then Include(InitialStates, ivsHasChildren); end; end; lntGroup: begin DBObjects := ParentObj.Connection.GetDBObjects(ParentObj.Database, False, ParentObj.GroupType); Item^ := DBObjects[Node.Index]; - if (GetParentFormOrFrame(Sender) is TfrmSelectDBObject) and (Item.NodeType = lntTable) then + if TreeShowColumns then Include(InitialStates, ivsHasChildren); end; lntTable: begin @@ -9900,6 +9987,7 @@ procedure TMainForm.DBtreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: procedure TMainForm.DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); var DBObj, PrevDBObj, ParentDBObj: PDBObject; + TableLevelObj: TDBObject; MainTabToActivate: TTabSheet; EnteringSession: Boolean; begin @@ -9907,6 +9995,7 @@ procedure TMainForm.DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualN MainTabToActivate := nil; PrevDBObj := nil; ParentDBObj := nil; + TableLevelObj := nil; if Assigned(Node) then begin LogSQL('DBtreeFocusChanged, Node level: '+IntToStr(Sender.GetNodeLevel(Node))+', FTreeRefreshInProgress: '+IntToStr(Integer(FTreeRefreshInProgress)), lcDebug); @@ -9921,6 +10010,10 @@ procedure TMainForm.DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualN FActiveDbObj.Assign(DBObj^); if Assigned(Node.Parent) and (DBtree.GetNodeLevel(Node) > 0) then ParentDBObj := Sender.GetNodeData(Node.Parent); + if FActiveDbObj.NodeType = lntColumn then + TableLevelObj := ParentDBObj^ + else + TableLevelObj := FActiveDbObj; case FActiveDbObj.NodeType of lntNone: begin @@ -9942,7 +10035,7 @@ procedure TMainForm.DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualN MainTabToActivate := tabDatabase; FActiveObjectGroup := FActiveDbObj.GroupType; end; - lntTable..lntEvent: begin + lntTable..lntEvent, lntColumn: begin try FActiveDbObj.Connection.Database := FActiveDbObj.Database; except on E:EDbError do begin @@ -9961,21 +10054,22 @@ procedure TMainForm.DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualN menuQueryExactRowCount.Checked := False; InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); try - if FActiveDbObj.NodeType in [lntTable, lntView] then begin - SelectedTableColumns := FActiveDbObj.TableColumns; + if TableLevelObj.NodeType in [lntTable, lntView] then begin + SelectedTableColumns := TableLevelObj.TableColumns; try - SelectedTableKeys := FActiveDbObj.TableKeys; + SelectedTableKeys := TableLevelObj.TableKeys; except // No show stopper, happening when a view references a renamed table column, see #1130 on E:EDbError do ErrorDialog(_('This view probably contains an error in its code.')+sLineBreak+sLineBreak+E.Message); end; - SelectedTableForeignKeys := FActiveDbObj.TableForeignKeys; + SelectedTableForeignKeys := TableLevelObj.TableForeignKeys; end; - PlaceObjectEditor(FActiveDbObj); + PlaceObjectEditor(TableLevelObj); // When a table is clicked in the tree, and the current // tab is a Host or Database tab, switch to showing table columns. if (PagecontrolMain.ActivePage = tabHost) or (PagecontrolMain.ActivePage = tabDatabase) then MainTabToActivate := tabEditor; + // Todo: prevent reload when focus has changed within a table's children only if DataGrid.Tag = VTREE_LOADED then InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); // Update the list of columns @@ -10069,8 +10163,8 @@ procedure TMainForm.DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualN if not FTreeRefreshInProgress then begin SetMainTab(MainTabToActivate); tabDatabase.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType <> lntNone); - tabEditor.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType in [lntTable..lntEvent]); - tabData.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType in [lntTable, lntView]); + tabEditor.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType in [lntTable..lntEvent, lntColumn]); + tabData.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType in [lntTable, lntView, lntColumn]); end; // Store click history item @@ -10199,7 +10293,7 @@ procedure TMainForm.DBtreeDblClick(Sender: TObject); // Paste DB or table name into query window on treeview double click. if AppSettings.ReadBool(asDoubleClickInsertsNodeText) and QueryTabs.HasActiveTab and Assigned(DBtree.FocusedNode) then begin DBObj := DBtree.GetNodeData(DBtree.FocusedNode); - if DBObj.NodeType in [lntDb, lntTable..lntEvent] then begin + if DBObj.NodeType in [lntDb, lntTable..lntEvent, lntColumn] then begin m := QueryTabs.ActiveMemo; m.DragDrop(Sender, m.CaretX, m.CaretY); end; @@ -10240,18 +10334,38 @@ procedure TMainForm.DBtreePaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); var - DBObj: PDBObject; + DBObj, ParentObj: PDBObject; WalkNode: PVirtualNode; + Columns: TTableColumnList; + Datatype: TDBDatatype; begin - // Grey out non-current connection nodes, and rather unimportant "Size" column + // Grey out non-current connection nodes DBObj := Sender.GetNodeData(Node); - if DBObj.Connection <> ActiveConnection then - TargetCanvas.Font.Color := clGrayText - else if (Column = 1) and (DBObj.NodeType in [lntTable..lntEvent]) then + if DBObj.Connection <> ActiveConnection then begin TargetCanvas.Font.Color := clGrayText; + Exit; + end; + + // Set text color + case Column of + 0: begin + if DBObj.NodeType = lntColumn then begin + ParentObj := Sender.GetNodeData(Node.Parent); + Columns := ParentObj.TableColumns; + if Columns.Count > Node.Index then begin + Datatype := Columns[Node.Index].DataType; + TargetCanvas.Font.Color := DatatypeCategories[Datatype.Category].Color; + end; + end; + end; + 1: begin // Grey out rather unimportant "Size" column + if DBObj.NodeType in [lntTable..lntEvent] then + TargetCanvas.Font.Color := clGrayText; + end; + end; // Set bold text if painted node is in focused path - if (Column = Sender.Header.MainColumn) then begin + if (Column = DBtree.Header.MainColumn) then begin WalkNode := Sender.FocusedNode; while Assigned(WalkNode) do begin if WalkNode = Node then begin @@ -10314,7 +10428,6 @@ procedure TMainForm.RefreshTree(FocusNewObject: TDBObject=nil); if Assigned(DBNode) then DBtree.ResetNode(DBNode); end; - FTreeRefreshInProgress := False; // Reselect active or new database if present. Could have been deleted or renamed. try @@ -10600,8 +10713,10 @@ procedure TMainForm.AnyGridGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; RowNumber := Sender.GetNodeData(Node); Results.RecNo := RowNumber^; - if Results.IsNull(ResultCol) and (not EditingAndFocused) then - CellText := TEXT_NULL + if Results.IsNull(ResultCol) then begin + // Grid editors come here through Tree.GetTextInfo(), provide empty string then + CellText := IfThen(EditingAndFocused, '', TEXT_NULL); + end else begin case Results.DataType(ResultCol).Category of dtcInteger, dtcReal: begin @@ -10908,7 +11023,6 @@ procedure TMainForm.AnyGridNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; on E:Exception do ErrorDialog(E.Message); end; - FGridEditFunctionMode := False; ValidateControls(Sender); end; @@ -10955,6 +11069,9 @@ procedure TMainForm.AnyGridFocusChanged(Sender: TBaseVirtualTree; Node: PVirtual Sender.ScrollIntoView(Sender.FocusedNode, False, True); // Required for highlighting fields with same text Sender.Invalidate; + // Reset flags when moving focus + FGridEditFunctionMode := False; + FDataEditWithoutLookup := False; end; @@ -11012,7 +11129,7 @@ procedure TMainForm.AnyGridEditing(Sender: TBaseVirtualTree; Node: if Assigned(ColInfo) then begin Allowed := ColInfo.GenerationExpression.IsEmpty; if not Allowed then - ErrorDialog(f_('Column %s is defined as generated. You cannot edit its content.', [Column.ToString])); + ErrorDialog(f_('Column %s is defined as generated per "%s". You cannot edit its content.', [Column.ToString, ColInfo.GenerationExpression])); end; end; @@ -11032,7 +11149,6 @@ procedure TMainForm.AnyGridEdited(Sender: TBaseVirtualTree; Node: if ([tsEditing, tsEditPending] * Sender.TreeStates) = [] then begin actDataCancelChanges.ShortCut := TextToShortcut('Esc'); actDataPostChanges.ShortCut := TextToShortcut('Ctrl+Enter'); - FGridEditFunctionMode := False; end; end; @@ -11070,6 +11186,7 @@ procedure TMainForm.AnyGridCreateEditor(Sender: TBaseVirtualTree; Node: ResultCol: Integer; begin VT := Sender as TVirtualStringTree; + EditLink := nil; Results := GridResult(VT); RowNum := VT.GetNodeData(Node); Results.RecNo := RowNum^; @@ -11080,7 +11197,7 @@ procedure TMainForm.AnyGridCreateEditor(Sender: TBaseVirtualTree; Node: TblColumn := Results.ColAttributes(ResultCol); // Find foreign key values - if AppSettings.ReadBool(asForeignDropDown) and (Sender = DataGrid) then begin + if AppSettings.ReadBool(asForeignDropDown) and (Sender = DataGrid) and (not FDataEditWithoutLookup) then begin for ForeignKey in SelectedTableForeignKeys do begin idx := ForeignKey.Columns.IndexOf(DataGrid.Header.Columns[Column].Text); if idx > -1 then try @@ -11552,10 +11669,13 @@ procedure TMainForm.HandleDataGridAttributes(RefreshingData: Boolean); function TMainForm.GetRegKeyTable: String; +var + o: TDBObject; begin // Return the slightly complex registry path to \Servers\CustomFolder\ActiveServer\curdb|curtable - Result := ActiveDbObj.Connection.Parameters.SessionPath + '\' + - ActiveDatabase + DELIM + ActiveDbObj.Name; + o := ActiveDbObj; + Result := o.Connection.Parameters.SessionPath + '\' + + ActiveDatabase + DELIM + o.Name; end; @@ -11570,7 +11690,10 @@ procedure TMainForm.AnyGridMouseUp(Sender: TObject; Button: TMouseButton; Grid := Sender as TVirtualStringTree; if not Assigned(Grid.FocusedNode) then Exit; - Grid.GetHitTestInfoAt(X, Y, False, Hit); + // Exit early for non-result-grids like ListTables + if Grid <> ActiveGrid then + Exit; + Grid.GetHitTestInfoAt(X, Y, True, Hit); if (Hit.HitNode = nil) or (Hit.HitColumn = NoColumn) or (Hit.HitColumn = InvalidColumn) then begin Results := GridResult(Grid); if Results.Modified then begin @@ -11795,14 +11918,16 @@ procedure TMainForm.HostListBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: Variables.Next; end; Variables.Free; - 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); - FGlobalVars.Values[Variables.Col(0)] := IfThen(Variables.IsNull(1), TEXT_NULL, Variables.Col(1)); - Variables.Next; + if Conn.SqlProvider.Has(qGlobalVariables) then begin + 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); + FGlobalVars.Values[Variables.Col(0)] := IfThen(Variables.IsNull(1), TEXT_NULL, Variables.Col(1)); + Variables.Next; + end; + Variables.Free; end; - Variables.Free; vt.RootNodeCount := FVariableNames.Count; end else if vt = ListStatus then begin Results := Conn.GetResults(Conn.SqlProvider.GetSql(qGlobalStatus)); @@ -11969,10 +12094,10 @@ procedure TMainForm.actFollowForeignKeyExecute(Sender: TObject); var Results: TDBQuery; RowNum: PInt64; - FocusedColumnName, ForeignColumnName, ReferenceTable: String; + FocusedColumnName, ForeignColumnName: String; ForeignKey: TForeignKey; i: Integer; - DBObj: TDBObject; + DBObj, ReferenceTable: TDBObject; Datatype: TDBDatatype; DbObjects: TDBObjectList; Filter: String; @@ -11983,13 +12108,14 @@ procedure TMainForm.actFollowForeignKeyExecute(Sender: TObject); Results.RecNo := RowNum^; FocusedColumnName := Results.ColumnOrgNames[DataGrid.FocusedColumn-1]; Conn := Results.Connection; + ReferenceTable := nil; // find foreign key for current column for ForeignKey in ActiveDBObj.TableForeignKeys do begin i := ForeignKey.Columns.IndexOf(FocusedColumnName); if i > -1 then begin ForeignColumnName := ForeignKey.ForeignColumns[i]; - ReferenceTable := ForeignKey.ReferenceTable; + ReferenceTable := ForeignKey.ReferenceTableObj; break; end; end; @@ -11997,6 +12123,10 @@ procedure TMainForm.actFollowForeignKeyExecute(Sender: TObject); LogSQL(f_('Foreign key not found for column "%s"', [FocusedColumnName]), lcInfo); Exit; end; + if ReferenceTable = nil then begin + LogSQL(_('Foreign key table not found')); + Exit; + end; Datatype := Results.DataType(DataGrid.FocusedColumn-1); // filter to show only rows linked by the foreign key if DataType.Category in [dtcBinary, dtcSpatial] then @@ -12005,13 +12135,7 @@ procedure TMainForm.actFollowForeignKeyExecute(Sender: TObject); Filter := Conn.QuoteIdent(ForeignColumnName)+'='+Conn.EscapeString(Results.Col(DataGrid.FocusedColumn-1)); // Jumping to ReferenceTable. Caution, this invalidates the above used Results - DbObjects := Conn.GetDBObjects(ActiveDatabase); - for DBObj in DbObjects do begin - if DBObj.Database + '.' + DBObj.Name = ReferenceTable then begin - ActiveDBObj := DBObj; - Break; - end; - end; + ActiveDBObj := ReferenceTable; SynMemoFilter.Text := Filter; ToggleFilterPanel(True); @@ -12128,7 +12252,6 @@ procedure TMainForm.actCopyOrCutExecute(Sender: TObject); ClpFormat: Word; ClpData: THandle; APalette: HPalette; - Exporter: TSynExporterRTF; Results: TDBQuery; RowNum: PInt64; ExportDialog: TfrmExportGrid; @@ -12214,6 +12337,40 @@ procedure TMainForm.actCopyOrCutExecute(Sender: TObject); Screen.Cursor := crDefault; end; +procedure TMainForm.actCopyFormattedExecute(Sender: TObject); +var + Exporter: TSynExporterRTF; + SynMemo: TSynMemo; +begin + // Copy formatted SQL text to clipboard + if not (Screen.ActiveControl is TSynMemo) then begin + MessageBeep(MB_ICONWARNING); + LogSQL('Active control is not a SynMemo'); + Exit; + end; + + SynMemo := TSynMemo(Screen.ActiveControl); + if SynMemo.Highlighter = nil then begin + MessageBeep(MB_ICONWARNING); + LogSQL('No highlighter assigned to active SynMemo'); + Exit; + end; + + Exporter := TSynExporterRTF.Create(nil); + try + Exporter.Title := APPNAME; + Exporter.UseBackground := True; + Exporter.Highlighter := SynMemo.Highlighter; + Exporter.ExportAsText := False; + Clipboard.Open; + Clipboard.TryAsText := SynMemo.SelText; + Exporter.ExportAll(Explode(SLineBreak, SynMemo.SelText)); + Exporter.CopyToClipboard; + Clipboard.Close; + finally + Exporter.Free; + end; +end; procedure TMainForm.actPasteExecute(Sender: TObject); var @@ -12532,8 +12689,7 @@ procedure TMainForm.actNewQueryTabExecute(Sender: TObject); QueryTab.CloseButton.Height := 16; QueryTab.CloseButton.Flat := True; VirtualImageListMain.GetBitmap(134, QueryTab.CloseButton.Glyph); - QueryTab.CloseButton.OnMouseDown := CloseButtonOnMouseDown; - QueryTab.CloseButton.OnMouseUp := CloseButtonOnMouseUp; + QueryTab.CloseButton.OnClick := CloseButtonOnClick; SetTabCaption(QueryTab.TabSheet.PageIndex, ''); // Dumb code which replicates all controls from tabQuery @@ -13078,22 +13234,9 @@ procedure TMainForm.editDatabaseTableFilterExit(Sender: TObject); end; -procedure TMainForm.CloseButtonOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +procedure TMainForm.CloseButtonOnClick(Sender: TObject); begin FLastMouseDownCloseButton := Sender; -end; - - -procedure TMainForm.CloseButtonOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); -begin - // Click on "Close" button of Query tab - if Button <> mbLeft then - Exit; - // Between MousDown and MouseUp it is possible that the focused tab has switched. As we simulate a mouse-click - // here, we must check if also the MouseDown event was fired on this particular button. See issue #1469. - if (Sender <> FLastMouseDownCloseButton) then - Exit; - // Prevent EAccessViolation in TControl.GetClientWidth, see issue #1640 TimerCloseTabByButton.Enabled := True; end; @@ -13406,51 +13549,53 @@ function TMainForm.ConfirmTabClear(PageIndex: Integer; AppIsClosing: Boolean): B begin Tab := QueryTabs[PageIndex-tabQuery.PageIndex]; - // Unhide tabsheet so the user sees the memo content. - // If the dialog is suppressed anyway, the user does not need to see the text, and we avoid - // storing this as the focused tab - if AppSettings.ReadBool(asPromptSaveFileOnTabClose) then begin - Tab.TabSheet.PageControl.ActivePage := Tab.TabSheet; - end; - - // Prompt for saving unsaved contents - if Tab.MemoFilename <> '' then - msg := f_('Save changes to file %s ?', [Tab.MemoFilename]) - else - msg := f_('Save content of tab "%s"?', [Trim(Tab.TabSheet.Caption)]); if AppSettings.RestoreTabsInitValue and AppIsClosing then begin - msg := msg + CRLF + CRLF + _('Your code is saved anyway, as auto-restoring is activated.'); - end; + Result := True; + end - if FConnections.Count > 0 then - MsgButtons := [mbYes, mbNo, mbCancel] - else - MsgButtons := [mbYes, mbNo]; + else begin + // Unhide tabsheet so the user sees the memo content. + // If the dialog is suppressed anyway, the user does not need to see the text, and we avoid + // storing this as the focused tab + if AppSettings.ReadBool(asPromptSaveFileOnTabClose) then begin + Tab.TabSheet.PageControl.ActivePage := Tab.TabSheet; + end; + // Prompt for saving unsaved contents + if Tab.MemoFilename <> '' then + msg := f_('Save changes to file %s ?', [Tab.MemoFilename]) + else + msg := f_('Save content of tab "%s"?', [Trim(Tab.TabSheet.Caption)]); - case MessageDialog(_('Modified query'), msg, mtConfirmation, MsgButtons, asPromptSaveFileOnTabClose) of - mrNo: Result := True; - mrYes: begin - if Tab.MemoFilename <> '' then begin - Tab.SaveContents(Tab.MemoFilename, False); - Result := True; - end - else begin - Dialog := TExtFileSaveDialog.Create(Self); - Dialog.Options := Dialog.Options + [fdoOverwritePrompt]; - Dialog.AddFileType('*.sql', _('SQL files')); - Dialog.AddFileType('*.*', _('All files')); - Dialog.DefaultExtension := 'sql'; - Dialog.LineBreakIndex := Tab.MemoLineBreaks; - if Dialog.Execute then begin - Tab.SaveContents(Dialog.FileName, False); - Tab.MemoLineBreaks := Dialog.LineBreakIndex; + if FConnections.Count > 0 then + MsgButtons := [mbYes, mbNo, mbCancel] + else + MsgButtons := [mbYes, mbNo]; + + case MessageDialog(_('Modified query'), msg, mtConfirmation, MsgButtons, asPromptSaveFileOnTabClose) of + mrNo: Result := True; + mrYes: begin + if Tab.MemoFilename <> '' then begin + Tab.SaveContents(Tab.MemoFilename, False); + Result := True; + end + else begin + Dialog := TExtFileSaveDialog.Create(Self); + Dialog.Options := Dialog.Options + [fdoOverwritePrompt]; + Dialog.AddFileType('*.sql', _('SQL files')); + Dialog.AddFileType('*.*', _('All files')); + Dialog.DefaultExtension := 'sql'; + Dialog.LineBreakIndex := Tab.MemoLineBreaks; + if Dialog.Execute then begin + Tab.SaveContents(Dialog.FileName, False); + Tab.MemoLineBreaks := Dialog.LineBreakIndex; + end; + // The save dialog can be cancelled. + Result := not Tab.Memo.Modified; + Dialog.Free; end; - // The save dialog can be cancelled. - Result := not Tab.Memo.Modified; - Dialog.Free; end; + else Result := False; end; - else Result := False; end; // Auto-backup logic @@ -13877,7 +14022,7 @@ procedure TMainForm.DBtreeBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas TargetCanvas.Brush.Color := DbObj.Connection.Parameters.SessionColor; TargetCanvas.FillRect(CellRect); end; - if (Column=1) and DBObj.Connection.DbObjectsCached(DBObj.Database) then begin + if (Column=1) and (DBObj.NodeType in [lntTable..lntEvent]) and DBObj.Connection.DbObjectsCached(DBObj.Database) then begin AllObjects := DBObj.Connection.GetDBObjects(DBObj.Database); PaintColorBar(DBObj.Size, AllObjects.LargestObjectSize, TargetCanvas, CellRect); end; @@ -14390,13 +14535,13 @@ procedure TMainForm.treeQueryHelpersGetImageIndex(Sender: TBaseVirtualTree; Node TQueryTab.HelperNodeBinding: ImageIndex := 119; end; 1: case Node.Parent.Index of - TQueryTab.HelperNodeColumns: ImageIndex := 42; + TQueryTab.HelperNodeColumns: ImageIndex := ICONINDEX_FIELD; TQueryTab.HelperNodeFunctions: ImageIndex := 13; TQueryTab.HelperNodeKeywords: ImageIndex := 25; TQueryTab.HelperNodeSnippets: ImageIndex := 68; TQueryTab.HelperNodeHistory: ImageIndex := 80; TQueryTab.HelperNodeProfile: ImageIndex := 145; - TQueryTab.HelperNodeBinding: ImageIndex := 42; + TQueryTab.HelperNodeBinding: ImageIndex := ICONINDEX_FIELD; end; end; end; @@ -14718,6 +14863,7 @@ procedure TMainForm.treeQueryHelpersContextPopup(Sender: TObject; MousePos: TPoi menuQueryHelpersGenerateDelete.Enabled := False; menuInsertAtCursor.Enabled := False; menuLoadSnippet.Enabled := False; + menuRenameSnippet.Enabled := False; menuDeleteSnippet.Enabled := False; menuExplore.Enabled := False; menuHelp.Enabled := False; @@ -14745,6 +14891,7 @@ procedure TMainForm.treeQueryHelpersContextPopup(Sender: TObject; MousePos: TPoi menuInsertAtCursor.Enabled := True; end; TQueryTab.HelperNodeSnippets: begin + menuRenameSnippet.Enabled := True; menuDeleteSnippet.Enabled := True; menuInsertAtCursor.Enabled := True; menuLoadSnippet.Enabled := True; diff --git a/source/preferences.dfm b/source/preferences.dfm index ca227eb9b..56b77b0ba 100644 --- a/source/preferences.dfm +++ b/source/preferences.dfm @@ -1330,10 +1330,10 @@ object frmPreferences: TfrmPreferences end object TreeShortcutItems: TVirtualStringTree Left = 0 - Top = 0 + Top = 32 Width = 300 - Height = 406 - Align = alLeft + Height = 374 + Anchors = [akLeft, akTop, akBottom] Colors.BorderColor = 15987699 Colors.DisabledColor = clGray Colors.DropMarkColor = 15385233 @@ -1390,6 +1390,19 @@ object frmPreferences: TfrmPreferences TabOrder = 2 OnClick = btnRemoveHotKeyClick end + object editShortcutsFilter: TButtonedEdit + Left = 0 + Top = 4 + Width = 300 + Height = 22 + Images = MainForm.VirtualImageListMain + RightButton.ImageIndex = 193 + RightButton.Visible = True + TabOrder = 3 + TextHint = 'Filter' + OnChange = editShortcutsFilterChange + OnRightButtonClick = editShortcutsFilterRightButtonClick + end end object tabFiles: TTabSheet Caption = 'Files and tabs' diff --git a/source/preferences.pas b/source/preferences.pas index 292add865..8a6c15f53 100644 --- a/source/preferences.pas +++ b/source/preferences.pas @@ -33,6 +33,7 @@ TGridColorsPreset = class TGridColorsPresetList = TObjectList; TfrmPreferences = class(TExtForm) + editShortcutsFilter: TButtonedEdit; pagecontrolMain: TPageControl; tabMisc: TTabSheet; btnCancel: TButton; @@ -192,6 +193,8 @@ TfrmPreferences = class(TExtForm) Label5: TLabel; lblReformatter: TLabel; comboReformatter: TComboBox; + procedure editShortcutsFilterRightButtonClick(Sender: TObject); + procedure editShortcutsFilterChange(Sender: TObject); procedure FormShow(Sender: TObject); procedure Modified(Sender: TObject); procedure Apply(Sender: TObject); @@ -533,8 +536,12 @@ procedure TfrmPreferences.FormCreate(Sender: TObject); InitLanguages; comboAppLanguage.Items.AddStrings(FLanguages); - comboGUIFont.Items.Assign(Screen.Fonts); - comboGUIFont.Items.Insert(0, '<'+_('Default system font')+'>'); + comboGUIFont.Items.Clear; + comboGUIFont.Items.Add('<'+_('Default system font')+'>'); + for i:=0 to Screen.Fonts.Count-1 do begin + if not Screen.Fonts[i].StartsWith('@') then + comboGUIFont.Items.Add(Screen.Fonts[i]); + end; Styles := TStyleManager.StyleNames; for i:=Low(Styles) to High(Styles) do begin @@ -764,7 +771,11 @@ procedure TfrmPreferences.FormShow(Sender: TObject); comboSQLColElementChange(Sender); // Grid formatting: - comboDataFontName.Items := Screen.Fonts; + comboDataFontName.Items.Clear; + for i:=0 to Screen.Fonts.Count-1 do begin + if not Screen.Fonts[i].StartsWith('@') then + comboDataFontName.Items.Add(Screen.Fonts[i]); + end; comboDataFontName.ItemIndex := comboDataFontName.Items.IndexOf(AppSettings.ReadString(asDataFontName)); updownDataFontSize.Position := AppSettings.ReadInt(asDataFontSize); updownMaxQueryResults.Position := AppSettings.ReadINt(asMaxQueryResults); @@ -828,6 +839,16 @@ procedure TfrmPreferences.FormShow(Sender: TObject); screen.Cursor := crdefault; end; +procedure TfrmPreferences.editShortcutsFilterRightButtonClick(Sender: TObject); +begin + editShortcutsFilter.Clear; +end; + +procedure TfrmPreferences.editShortcutsFilterChange(Sender: TObject); +begin + FilterNodesByEdit(editShortcutsFilter, TreeShortcutItems); +end; + procedure TfrmPreferences.SQLFontChange(Sender: TObject); diff --git a/source/routine_editor.dfm b/source/routine_editor.dfm index 728884f71..df6917b7a 100644 --- a/source/routine_editor.dfm +++ b/source/routine_editor.dfm @@ -239,6 +239,7 @@ object frmRoutineEditor: TfrmRoutineEditor Top = 87 Width = 310 Height = 21 + AutoDropDownWidth = True TabOrder = 4 Text = 'comboReturns' OnChange = Modification @@ -267,6 +268,7 @@ object frmRoutineEditor: TfrmRoutineEditor Top = 8 Width = 194 Height = 21 + AutoDropDownWidth = True Anchors = [akLeft, akTop, akRight] TabOrder = 1 Text = 'comboDefiner' diff --git a/source/table_editor.dfm b/source/table_editor.dfm index 75cbbf6cf..2b1427003 100644 --- a/source/table_editor.dfm +++ b/source/table_editor.dfm @@ -41,22 +41,22 @@ object frmTableEditor: TfrmTableEditor object lblName: TLabel Left = 4 Top = 6 - Width = 31 - Height = 13 + Width = 35 + Height = 15 Caption = 'Name:' end object lblComment: TLabel Left = 4 Top = 33 - Width = 49 - Height = 13 + Width = 57 + Height = 15 Caption = 'Comment:' end object editName: TEdit Left = 96 Top = 3 Width = 589 - Height = 21 + Height = 23 Anchors = [akLeft, akTop, akRight] TabOrder = 0 Text = 'editName' @@ -112,7 +112,7 @@ object frmTableEditor: TfrmTableEditor object lblMaxRows: TLabel Left = 4 Top = 52 - Width = 115 + Width = 114 Height = 15 Caption = 'Maximum row count:' end @@ -133,7 +133,7 @@ object frmTableEditor: TfrmTableEditor object lblInsertMethod: TLabel Left = 358 Top = 98 - Width = 84 + Width = 85 Height = 15 Caption = 'INSERT method:' end @@ -150,6 +150,7 @@ object frmTableEditor: TfrmTableEditor Top = 3 Width = 102 Height = 23 + AutoDropDownWidth = True Style = csDropDownList DropDownCount = 16 Sorted = True @@ -178,6 +179,7 @@ object frmTableEditor: TfrmTableEditor Top = 26 Width = 221 Height = 23 + AutoDropDownWidth = True Style = csDropDownList TabOrder = 7 OnSelect = comboEngineSelect @@ -242,10 +244,11 @@ object frmTableEditor: TfrmTableEditor Margins.Top = 0 Margins.Bottom = 0 Align = alClient + Alignment = taRightJustify DefaultNodeHeight = 19 DragMode = dmAutomatic EditDelay = 0 - Header.AutoSizeIndex = 0 + Header.AutoSizeIndex = -1 Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoShowSortGlyphs, hoVisible, hoDisableAnimatedResize, hoAutoResizeInclCaption] Header.PopupMenu = MainForm.popupListHeader Images = MainForm.VirtualImageListMain @@ -253,8 +256,9 @@ object frmTableEditor: TfrmTableEditor TabOrder = 1 TreeOptions.AutoOptions = [toAutoDropExpand, toAutoScrollOnExpand, toAutoTristateTracking, toAutoChangeScale] TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] - TreeOptions.PaintOptions = [toHotTrack, toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines, toUseExplorerTheme, toHideTreeLinesIfThemed] + TreeOptions.PaintOptions = [toHotTrack, toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toGhostedIfUnfocused, toFullVertGridLines, toUseExplorerTheme, toHideTreeLinesIfThemed] TreeOptions.SelectionOptions = [toExtendedFocus, toRightClickSelect] + OnBeforeCellPaint = treeIndexesBeforeCellPaint OnBeforePaint = treeIndexesBeforePaint OnClick = AnyTreeClick OnCreateEditor = treeIndexesCreateEditor @@ -275,7 +279,7 @@ object frmTableEditor: TfrmTableEditor Options = [coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] Position = 0 Text = 'Name' - Width = 226 + Width = 176 end item Options = [coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus] @@ -297,6 +301,16 @@ object frmTableEditor: TfrmTableEditor Position = 4 Text = 'Direction' Width = 80 + end + item + Position = 5 + Text = 'Visibility' + end + item + Alignment = taRightJustify + Position = 6 + Text = 'Size' + Width = 10 end> end object tlbIndexes: TToolBar @@ -512,8 +526,10 @@ object frmTableEditor: TfrmTableEditor Caption = 'Table' end> ColumnClick = False + HotTrack = True ReadOnly = True RowSelect = True + SmallImages = MainForm.VirtualImageListMain TabOrder = 2 ViewStyle = vsReport Visible = False @@ -767,7 +783,7 @@ object frmTableEditor: TfrmTableEditor Top = 0 Hint = 'Add column' Caption = 'Add' - ImageIndex = 45 + ImageIndex = 91 ImageName = 'icons8-add' OnClick = btnAddColumnClick end @@ -776,7 +792,7 @@ object frmTableEditor: TfrmTableEditor Top = 0 Hint = 'Remove column' Caption = 'Remove' - ImageIndex = 46 + ImageIndex = 92 ImageName = 'icons8-delete-button' OnClick = btnRemoveColumnClick end @@ -1028,14 +1044,14 @@ object frmTableEditor: TfrmTableEditor end object menuAddColumn: TMenuItem Caption = 'Add column' - ImageIndex = 45 + ImageIndex = 91 ImageName = 'icons8-add' ShortCut = 16429 OnClick = btnAddColumnClick end object menuRemoveColumn: TMenuItem Caption = 'Remove column' - ImageIndex = 46 + ImageIndex = 92 ImageName = 'icons8-delete-button' ShortCut = 16430 OnClick = btnRemoveColumnClick diff --git a/source/table_editor.pas b/source/table_editor.pas index 26ec241f7..3e9dfbe1e 100644 --- a/source/table_editor.pas +++ b/source/table_editor.pas @@ -117,6 +117,9 @@ TfrmTableEditor = class(TFrame) procedure listColumnsPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure listColumnsCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); + procedure treeIndexesBeforeCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); procedure treeIndexesInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure treeIndexesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); @@ -236,6 +239,14 @@ TfrmTableEditor = class(TFrame) const ColNumInvisible = 13; const ColNumCompressed = 14; const ColNumsCheckboxes = [ColNumUnsigned, ColNumAllownull, ColNumZerofill, ColNumInvisible, ColNumCompressed]; + // Columns in index tree + const IndexColNumName = 0; + const IndexColNumType = 1; + const IndexColNumAlgorithm = 2; + const IndexColNumComment = 3; + const IndexColNumDirection = 4; + const IndexColNumVisibility = 5; + const IndexColNumSize = 6; procedure ValidateColumnControls; procedure ValidateIndexControls; procedure MoveFocusedIndexPart(NewIdx: Cardinal); @@ -636,6 +647,7 @@ function TfrmTableEditor.ComposeAlterStatement: TSQLBatch; Constraint: TCheckConstraint; Node: PVirtualNode; Conn: TDBConnection; + Params: TStringMap; procedure FinishSpecs; begin @@ -649,7 +661,7 @@ function TfrmTableEditor.ComposeAlterStatement: TSQLBatch; procedure AddQuery(Query: String); begin FinishSpecs; - SQL := SQL + Format(Query, [DBObject.QuotedName]) + ';' + CRLF; + SQL := SQL + Format(Query, [DBObject.QuotedName]) + ';' + sLineBreak; end; begin // Compose ALTER query, called by buttons and for SQL code tab @@ -767,12 +779,10 @@ function TfrmTableEditor.ComposeAlterStatement: TSQLBatch; Specs.Add(Format(AddColBase, [ColSpec])); end; end; - AddQuery('EXECUTE sp_addextendedproperty '+Conn.EscapeString('MS_Description')+', '+ - Conn.EscapeString(Col.Comment)+', '+ - Conn.EscapeString('Schema')+', '+Conn.EscapeString(DBObject.Schema)+', '+ - Conn.EscapeString('table')+', '+Conn.EscapeString(DBObject.Name)+', '+ - Conn.EscapeString('column')+', '+Conn.EscapeString(Col.Name) - ); + Params := DBObject.AsStringMap; + Params.Add('NewComment', Conn.EscapeString(Col.Comment)); + Params.Add('TargetColumn', Conn.EscapeString(Col.Name)); + AddQuery(Conn.SqlProvider.GetSql(qSetColumnComment, Params)); end; ngPgSQL: begin @@ -907,10 +917,27 @@ function TfrmTableEditor.ComposeAlterStatement: TSQLBatch; Specs.Add('ADD ' + Constraint.SQLCode); end; - FinishSpecs; - // Separate queries from here on + // Separate ALTER TABLE .. ALTER INDEX query for visible/invisible indexes features, which gets otherwise + // ignored in MySQL and MariaDB when done by a drop + add combined query. See issue #1388 + if Conn.SqlProvider.Has(qIndexInvisible) then begin + for i:=0 to FKeys.Count-1 do begin + if FKeys[i].Modified then begin + Specs.Add('ALTER INDEX ' + Conn.QuoteIdent(FKeys[i].Name) + ' ' + + IfThen( + FKeys[i].Visible, + Conn.SqlProvider.GetSql(qIndexVisible), + Conn.SqlProvider.GetSql(qIndexInvisible) + ) + ); + end; + end; + FinishSpecs; + end; + + + // *** Separate queries from here on // Drop indexes, also changed indexes, which will be readded below for i:=0 to FDeletedKeys.Count-1 do begin @@ -1116,8 +1143,8 @@ procedure TfrmTableEditor.btnAddColumnClick(Sender: TObject); NewCol.DefaultType := cdtText; NewCol.DefaultText := '0'; end else begin - NewCol.DefaultType := FocusedCol.DefaultType; - NewCol.DefaultText := FocusedCol.DefaultText; + NewCol.DefaultType := cdtNothing; + NewCol.DefaultText := ''; end; NewCol.Collation := ''; end else begin @@ -1128,9 +1155,9 @@ procedure TfrmTableEditor.btnAddColumnClick(Sender: TObject); NewCol.AllowNull := True; NewCol.DefaultType := cdtNothing; NewCol.DefaultText := ''; - NewCol.Comment := ''; - NewCol.Collation := ''; end; + NewCol.Comment := ''; + NewCol.Collation := ''; NewCol.Name := _('Column')+' '+IntToStr(idx+1); FColumns.Insert(idx, NewCol); NewNode := listColumns.InsertNode(fn, amInsertAfter, @NewCol); @@ -1536,7 +1563,7 @@ procedure TfrmTableEditor.listColumnsGetText(Sender: TBaseVirtualTree; cdtText: CellText := Col.Connection.EscapeString(Col.DefaultText); cdtNull: CellText := 'NULL'; cdtExpression: CellText := Col.DefaultText; - cdtAutoInc: CellText := Col.AutoIncName; + cdtAutoInc: CellText := Col.Connection.SqlProvider.GetSql(qAutoInc); end; case Col.OnUpdateType of // cdtNothing: leave clause away @@ -1911,6 +1938,23 @@ procedure TfrmTableEditor.listColumnsCreateEditor(Sender: TBaseVirtualTree; end; end; +procedure TfrmTableEditor.treeIndexesBeforeCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); +var + Key: TTableKey; +begin + if Sender.GetNodeLevel(Node) <> 0 then + Exit; + case Column of + IndexColNumSize: begin + // Paint "progress" bar in size column + Key := FKeys[Node.Index]; + MainForm.PaintColorBar(Key.Size, FKeys.MaxSize, TargetCanvas, CellRect); + end; + end; +end; + procedure TfrmTableEditor.editNumEditChange(Sender: TObject); var @@ -2079,16 +2123,21 @@ procedure TfrmTableEditor.treeIndexesGetImageIndex(Sender: TBaseVirtualTree; begin // Icon image showing type of index VT := Sender as TVirtualStringTree; - if Column <> 0 then Exit; - if not (Kind in [ikNormal, ikSelected]) then Exit; + if Column <> IndexColNumName then + Exit; + if not (Kind in [ikNormal, ikSelected]) then + Exit; case VT.GetNodeLevel(Node) of - 0: ImageIndex := FKeys[Node.Index].ImageIndex; + 0: begin + ImageIndex := FKeys[Node.Index].ImageIndex; + Ghosted := not FKeys[Node.Index].Visible; + end; 1: begin TblKey := FKeys[Node.Parent.Index]; if TblKey.IsExpression(Node.Index) then ImageIndex := 13 else - ImageIndex := 42; + ImageIndex := ICONINDEX_FIELD; end; end; end; @@ -2101,28 +2150,37 @@ procedure TfrmTableEditor.treeIndexesGetText(Sender: TBaseVirtualTree; TblKey: TTableKey; begin // Index tree showing cell text + CellText := ''; case Sender.GetNodeLevel(Node) of 0: begin TblKey := FKeys[Node.Index]; case Column of - 0: if TblKey.IsPrimary then - CellText := TblKey.IndexType + ' KEY' // Fixed name "PRIMARY KEY", cannot be changed - else - CellText := TblKey.Name; - 1: CellText := TblKey.IndexType; - 2: CellText := TblKey.Algorithm; - 3: CellText := TblKey.Comment; - 4: CellText := ''; // Column collation + IndexColNumName: begin + if TblKey.IsPrimary then + CellText := TblKey.IndexType + ' KEY' // Fixed name "PRIMARY KEY", cannot be changed + else + CellText := TblKey.Name; + end; + IndexColNumType: CellText := TblKey.IndexType; + IndexColNumAlgorithm: CellText := TblKey.Algorithm; + IndexColNumComment: CellText := TblKey.Comment; + IndexColNumVisibility: CellText := IfThen( + TblKey.Visible, + DBObject.Connection.SqlProvider.GetSql(qIndexVisible), + DBObject.Connection.SqlProvider.GetSql(qIndexInvisible) + ); + IndexColNumSize: begin + if TblKey.Size >= 0 then + CellText := FormatByteNumber(TblKey.Size); + end; end; end; 1: begin TblKey := FKeys[Node.Parent.Index]; case Column of - 0: CellText := TblKey.Columns[Node.Index]; - 1: CellText := TblKey.SubParts[Node.Index]; - 2: CellText := ''; // Index algorithm - 3: CellText := ''; // Index comment - 4: begin + IndexColNumName: CellText := TblKey.Columns[Node.Index]; + IndexColNumType: CellText := TblKey.SubParts[Node.Index]; + IndexColNumDirection: begin CellText := TblKey.Collations[Node.Index]; CellText := IfThen(CellText.ToLower = 'a', 'ASC', 'DESC'); end; @@ -2344,13 +2402,17 @@ procedure TfrmTableEditor.treeIndexesEditing(Sender: TBaseVirtualTree; Allowed := False; if VT.GetNodeLevel(Node) = 0 then begin // Disallow renaming primary key, and direction/collation of key node level - if (Column = 0) and (VT.Text[Node, 1] <> TTableKey.PRIMARY) then - Allowed := True - else - Allowed := Column in [1,2,3]; - end else case Column of - 0: Allowed := True; - 1: begin + case Column of + IndexColNumName: Allowed := (VT.Text[Node, 1] <> TTableKey.PRIMARY); + IndexColNumType: Allowed := True; + IndexColNumAlgorithm: Allowed := True; + IndexColNumComment: Allowed := True; + IndexColNumVisibility: Allowed := DBObject.Connection.SqlProvider.Has(qIndexInvisible); + end; + end + else case Column of + IndexColNumName: Allowed := True; + IndexColNumType: begin // Column length is allowed for (var)char/text types only, even mandantory for text and blobs IndexedColName := VT.Text[Node, 0]; for i:=0 to FColumns.Count-1 do begin @@ -2360,7 +2422,7 @@ procedure TfrmTableEditor.treeIndexesEditing(Sender: TBaseVirtualTree; end; end; end; - 4: Allowed := True; // Collation + IndexColNumDirection: Allowed := True; // Collation end; end; @@ -2377,18 +2439,25 @@ procedure TfrmTableEditor.treeIndexesCreateEditor(Sender: TBaseVirtualTree; // Start cell editor VT := Sender as TVirtualStringTree; Level := (Sender as TVirtualStringtree).GetNodeLevel(Node); - if (Level = 0) and (Column = 1) then begin + if (Level = 0) and (Column = IndexColNumType) then begin // Index type pulldown EnumEditor := TEnumEditorLink.Create(VT, True, nil); EnumEditor.ValueList := TStringList.Create; EnumEditor.ValueList.CommaText := TTableKey.PRIMARY +','+ TTableKey.KEY +','+ TTableKey.UNIQUE +','+ TTableKey.FULLTEXT +','+ TTableKey.SPATIAL; EditLink := EnumEditor; - end else if (Level = 0) and (Column = 2) then begin + end else if (Level = 0) and (Column = IndexColNumAlgorithm) then begin // Algorithm pulldown EnumEditor := TEnumEditorLink.Create(VT, True, nil); EnumEditor.ValueList := Explode(',', ',BTREE,HASH,RTREE'); EditLink := EnumEditor; - end else if (Level = 1) and (Column = 0) then begin + end else if (Level = 0) and (Column = IndexColNumVisibility) then begin + // Visibility pulldown + EnumEditor := TEnumEditorLink.Create(VT, True, nil); + EnumEditor.ValueList.Add(''); + EnumEditor.ValueList.Add(DBObject.Connection.SqlProvider.GetSql(qIndexVisible)); + EnumEditor.ValueList.Add(DBObject.Connection.SqlProvider.GetSql(qIndexInvisible)); + EditLink := EnumEditor; + end else if (Level = 1) and (Column = IndexColNumName) then begin // Column names pulldown EnumEditor := TEnumEditorLink.Create(VT, True, nil); ColNode := listColumns.GetFirst; @@ -2399,7 +2468,7 @@ procedure TfrmTableEditor.treeIndexesCreateEditor(Sender: TBaseVirtualTree; end; EnumEditor.AllowCustomText := True; // Allows adding a subpart in index parts: "TextCol(20)" EditLink := EnumEditor; - end else if (Level = 1) and (Column = 4) then begin + end else if (Level = 1) and (Column = IndexColNumDirection) then begin EnumEditor := TEnumEditorLink.Create(VT, True, nil); EnumEditor.ValueList := Explode(',', ',ASC,DESC'); EditLink := EnumEditor; @@ -2421,14 +2490,15 @@ procedure TfrmTableEditor.treeIndexesNewText(Sender: TBaseVirtualTree; 0: begin TblKey := FKeys[Node.Index]; case Column of - 0: TblKey.Name := NewText; - 1: begin + IndexColNumName: TblKey.Name := NewText; + IndexColNumType: begin TblKey.IndexType := NewText; if NewText = TTableKey.PRIMARY then TblKey.Name := TTableKey.PRIMARY; end; - 2: TblKey.Algorithm := NewText; - 3: TblKey.Comment := NewText; + IndexColNumAlgorithm: TblKey.Algorithm := NewText; + IndexColNumComment: TblKey.Comment := NewText; + IndexColNumVisibility: TblKey.Visible := SameText(NewText, DBObject.Connection.SqlProvider.GetSql(qIndexVisible)); end; // Needs to be called manually for Name and IndexType properties: TblKey.Modification(Sender); @@ -2436,7 +2506,7 @@ procedure TfrmTableEditor.treeIndexesNewText(Sender: TBaseVirtualTree; 1: begin TblKey := FKeys[Node.Parent.Index]; case Column of - 0: begin + IndexColNumName: begin // Detect input of "col(123)" and move "123" into subpart rx := TRegExpr.Create; rx.Expression := '.+\((\d+)\)'; @@ -2446,8 +2516,8 @@ procedure TfrmTableEditor.treeIndexesNewText(Sender: TBaseVirtualTree; end else TblKey.Columns[Node.Index] := NewText; end; - 1: TblKey.SubParts[Node.Index] := NewText; - 4: begin + IndexColNumType: TblKey.SubParts[Node.Index] := NewText; + IndexColNumDirection: begin if NewText.ToLower = 'asc' then TblKey.Collations[Node.Index] := 'A' else diff --git a/source/tabletools.dfm b/source/tabletools.dfm index fbace92eb..5b7f32a27 100644 --- a/source/tabletools.dfm +++ b/source/tabletools.dfm @@ -472,6 +472,7 @@ object frmTableTools: TfrmTableTools Top = 127 Width = 422 Height = 22 + AutoDropDownWidth = True Anchors = [akLeft, akTop, akRight] DropDownCount = 16 ParentShowHint = False @@ -532,6 +533,7 @@ object frmTableTools: TfrmTableTools Top = 3 Width = 339 Height = 22 + AutoDropDownWidth = True Style = csDropDownList Anchors = [akLeft, akTop, akRight] Enabled = False @@ -560,6 +562,7 @@ object frmTableTools: TfrmTableTools Top = 49 Width = 339 Height = 22 + AutoDropDownWidth = True Style = csDropDownList Anchors = [akLeft, akTop, akRight] DropDownCount = 16 @@ -581,6 +584,7 @@ object frmTableTools: TfrmTableTools Top = 26 Width = 339 Height = 22 + AutoDropDownWidth = True Style = csDropDownList Anchors = [akLeft, akTop, akRight] Enabled = False @@ -600,6 +604,7 @@ object frmTableTools: TfrmTableTools Top = 72 Width = 339 Height = 22 + AutoDropDownWidth = True Style = csDropDownList Anchors = [akLeft, akTop, akRight] DropDownCount = 16 diff --git a/source/tabletools.pas b/source/tabletools.pas index 0af99795d..a2a6c11d6 100644 --- a/source/tabletools.pas +++ b/source/tabletools.pas @@ -1794,7 +1794,7 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); KeyList: TTableKeyList; Column: TTableColumn; Quoter: TDBConnection; - TargetFileName, SetCharsetCode: String; + TargetFileName, SetCharsetCode, ColumnsForSelect: String; OrderBy: String; const TempDelim = '//'; @@ -1848,7 +1848,7 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); if ToDir then begin FreeAndNil(ExportStream); - DbDir := IncludeTrailingPathDelimiter(GetOutputFilename(comboExportOutputTarget.Text, DBObj)) + DBObj.Database + '\'; + DbDir := IncludeTrailingPathDelimiter(GetOutputFilename(comboExportOutputTarget.Text, DBObj)) + DBObj.Database + PathDelim; if not DirectoryExists(DbDir) then ForceDirectories(DbDir); ExportStream := TFileStream.Create(DbDir + DBObj.ObjType.ToLower + '-' + DBObj.Name+'.sql', fmCreate or fmOpenWrite); @@ -2012,8 +2012,15 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); lntTrigger: begin StrucResult := DBObj.Connection.GetResults('SHOW TRIGGERS FROM '+DBObj.QuotedDatabase+' WHERE `Trigger`='+DBObj.Connection.EscapeString(DBObj.Name)); Struc := DBObj.GetCreateCode(False, menuExportRemoveDefiner.Checked); - if ToDb then - Insert(Quoter.QuoteIdent(FinalDbName)+'.', Struc, Pos('TRIGGER', Struc) + 8 ); + if ToDb then begin + // Prepend target database to trigger name + Struc := ReplaceRegExpr( + 'TRIGGER(\s+IF\s+NOT\s+EXISTS)?\s+', + Struc, + '$0' + Quoter.QuoteIdent(FinalDbName)+'.', + [rroModifierI, rroUseSubstitution, rroModifierG] // Greedy is required to catch group 1 + ); + end; if ToFile or ToClipboard or ToDir then begin Struc := 'SET @OLDTMP_SQL_MODE=@@SQL_MODE, SQL_MODE=' + DBObj.Connection.EscapeString(StrucResult.Col('sql_mode')) + ';' + CRLF + 'DELIMITER ' + TempDelim + CRLF + @@ -2078,8 +2085,13 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); TargetDbAndObject := Quoter.QuoteIdent(FinalDbName) + '.' + TargetDbAndObject; Offset := 0; RowCount := 0; - // Sort by primary key if one exists, see issue #2168 + // Examine columns ColumnList := DBObj.TableColumns; + if not ColumnList.HasInvisibleColumns then + ColumnsForSelect := '*' + else + ColumnsForSelect := ColumnList.QuoteIdents; + // Sort by primary key if one exists, see issue #2168 KeyList := DBObj.TableKeys; KeyColumns := DBObj.Connection.GetKeyColumns(ColumnList, KeyList); OrderBy := ''; @@ -2102,7 +2114,7 @@ procedure TfrmTableTools.DoExport(DBObj: TDBObject); Data := DBObj.Connection.GetResults( DBObj.Connection.ApplyLimitClause( 'SELECT', - '/* '+APPNAME+' '+MainForm.AppVersion+' */ * FROM '+DBObj.QuotedDbAndTableName + OrderBy, + '/* '+APPNAME+' '+MainForm.AppVersion+' */ ' + ColumnsForSelect + ' FROM '+DBObj.QuotedDbAndTableName + OrderBy, Limit, Offset) ); diff --git a/source/texteditor.dfm b/source/texteditor.dfm index 2b8651a8d..803211e9d 100644 --- a/source/texteditor.dfm +++ b/source/texteditor.dfm @@ -151,6 +151,7 @@ object frmTextEditor: TfrmTextEditor Width = 145 Height = 22 Align = alLeft + AutoDropDownWidth = True Style = csDropDownList Sorted = True TabOrder = 1 diff --git a/source/trigger_editor.dfm b/source/trigger_editor.dfm index f9062310c..b29829d3e 100644 --- a/source/trigger_editor.dfm +++ b/source/trigger_editor.dfm @@ -68,6 +68,7 @@ object frmTriggerEditor: TfrmTriggerEditor Top = 3 Width = 379 Height = 21 + AutoDropDownWidth = True Anchors = [akLeft, akTop, akRight] TabOrder = 0 Text = 'comboDefiner' @@ -89,6 +90,7 @@ object frmTriggerEditor: TfrmTriggerEditor Top = 30 Width = 599 Height = 21 + AutoDropDownWidth = True Style = csDropDownList Anchors = [akLeft, akTop, akRight] TabOrder = 2 diff --git a/source/trigger_editor.pas b/source/trigger_editor.pas index 6724e1fd8..19d57f8b4 100644 --- a/source/trigger_editor.pas +++ b/source/trigger_editor.pas @@ -124,7 +124,7 @@ procedure TfrmTriggerEditor.Init(Obj: TDBObject); QuoteCharsRx := QuoteRegExprMetaChars(DBObject.Connection.QuoteChars); QuotedWordRx := '['+QuoteCharsRx+']?[^'+QuoteCharsRx+']+['+QuoteCharsRx+']?'; rx.Expression := '(\sDEFINER=('+QuotedWordRx+'@'+QuotedWordRx+'))?' + - '\s+TRIGGER\s+'+QuotedWordRx + + '\s+TRIGGER\s+(IF\s+NOT\s+EXISTS\s+)?'+QuotedWordRx + '\s+('+Implode('|', comboTiming.Items)+')' + '\s+('+Implode('|', comboEvent.Items)+')' + '\s+ON\s+('+QuotedWordRx+')' + @@ -133,10 +133,10 @@ procedure TfrmTriggerEditor.Init(Obj: TDBObject); Body := DBObject.Connection.GetCreateCode(DBObject); if rx.Exec(Body) then begin comboDefiner.Text := DBObject.Connection.DeQuoteIdent(rx.Match[2], '@'); - comboTiming.ItemIndex := comboTiming.Items.IndexOf(UpperCase(rx.Match[3])); - comboEvent.ItemIndex := comboEvent.Items.IndexOf(UpperCase(rx.Match[4])); - comboTable.ItemIndex := comboTable.Items.IndexOf(DBObject.Connection.DeQuoteIdent(rx.Match[5])); - Body := rx.Match[6]; + comboTiming.ItemIndex := comboTiming.Items.IndexOf(UpperCase(rx.Match[4])); + comboEvent.ItemIndex := comboEvent.Items.IndexOf(UpperCase(rx.Match[5])); + comboTable.ItemIndex := comboTable.Items.IndexOf(DBObject.Connection.DeQuoteIdent(Trim(rx.Match[6]))); + Body := rx.Match[7]; end else raise EDbError.CreateFmt(_('Result from previous query does not contain expected pattern: %s'), [rx.Expression]); diff --git a/source/usermanager.dfm b/source/usermanager.dfm index da27da447..26a43acd0 100644 --- a/source/usermanager.dfm +++ b/source/usermanager.dfm @@ -17,7 +17,6 @@ object UserManagerForm: TUserManagerForm OnClose = FormClose OnCloseQuery = FormCloseQuery OnCreate = FormCreate - OnResize = FormResize OnShow = FormShow DesignSize = ( 484 @@ -35,7 +34,6 @@ object UserManagerForm: TUserManagerForm Margins.Right = 0 Margins.Bottom = 40 ResizeStyle = rsUpdate - OnMoved = FormResize end object lblWarning: TLabel Left = 8 @@ -94,16 +92,17 @@ object UserManagerForm: TUserManagerForm Left = 3 Top = 3 Width = 171 - Height = 13 + Height = 14 Align = alTop Caption = '&Select user account:' FocusControl = listUsers + ExplicitWidth = 113 end object listUsers: TVirtualStringTree Left = 0 Top = 64 Width = 177 - Height = 236 + Height = 252 Align = alClient Header.AutoSizeIndex = 0 Header.Height = 18 @@ -132,12 +131,16 @@ object UserManagerForm: TUserManagerForm item Position = 0 Text = 'Username' - Width = 93 + Width = 43 end item Position = 1 Text = 'Host' Width = 80 + end + item + Position = 2 + Text = 'Plugin' end> end object ToolBar1: TToolBar @@ -146,7 +149,7 @@ object UserManagerForm: TUserManagerForm Width = 177 Height = 22 AutoSize = True - ButtonWidth = 58 + ButtonWidth = 63 Caption = 'ToolBar1' Images = MainForm.VirtualImageListMain List = True @@ -160,19 +163,18 @@ object UserManagerForm: TUserManagerForm DropdownMenu = menuAdd ImageIndex = 45 ImageName = 'icons8-add' - Style = tbsDropDown - OnClick = btnAddUserClick + Style = tbsWholeDropDown end object btnCloneUser: TToolButton - Left = 58 + Left = 72 Top = 0 Caption = 'Clone' ImageIndex = 3 ImageName = 'icons8-copy-100' - OnClick = btnAddUserClick + OnClick = menuItemUserClick end object btnDeleteUser: TToolButton - Left = 116 + Left = 135 Top = 0 Caption = 'Delete' ImageIndex = 46 @@ -210,71 +212,11 @@ object UserManagerForm: TUserManagerForm BevelOuter = bvNone Constraints.MinWidth = 20 TabOrder = 1 - object tlbObjects: TToolBar - Left = 0 - Top = 145 - Width = 283 - Height = 22 - AutoSize = True - ButtonWidth = 79 - Caption = 'tlbObjects' - Images = MainForm.VirtualImageListMain - List = True - ParentShowHint = False - ShowCaptions = True - ShowHint = True - TabOrder = 1 - Wrapable = False - object lblAllowAccessTo: TLabel - Left = 0 - Top = 0 - Width = 121 - Height = 22 - AutoSize = False - Caption = 'Allow access to:' - Transparent = False - Layout = tlCenter - end - object btnAddObject: TToolButton - Left = 121 - Top = 0 - Hint = 'Add object ...' - Caption = 'Add object' - ImageIndex = 45 - ImageName = 'icons8-add' - OnClick = btnAddObjectClick - end - end - object treePrivs: TVirtualStringTree - Left = 0 - Top = 167 - Width = 283 - Height = 149 - Align = alClient - Header.AutoSizeIndex = 0 - Header.MainColumn = -1 - Images = MainForm.VirtualImageListMain - IncrementalSearch = isAll - TabOrder = 2 - TreeOptions.AutoOptions = [toAutoDropExpand, toAutoTristateTracking, toAutoDeleteMovedNodes, toAutoChangeScale] - TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] - TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages, toUseExplorerTheme, toHideTreeLinesIfThemed] - OnChecked = treePrivsChecked - OnExpanded = treePrivsExpanded - OnGetText = treePrivsGetText - OnPaintText = treePrivsPaintText - OnGetImageIndex = treePrivsGetImageIndex - OnInitChildren = treePrivsInitChildren - OnInitNode = treePrivsInitNode - Touch.InteractiveGestures = [igPan, igPressAndTap] - Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] - Columns = <> - end object PageControlSettings: TPageControl Left = 0 Top = 0 Width = 283 - Height = 145 + Height = 219 ActivePage = tabCredentials Align = alTop TabOrder = 0 @@ -282,43 +224,70 @@ object UserManagerForm: TUserManagerForm Caption = 'Credentials' DesignSize = ( 275 - 117) + 190) object lblUsername: TLabel Left = 3 Top = 10 - Width = 55 - Height = 13 + Width = 62 + Height = 14 Caption = 'User &name:' end object lblFromHost: TLabel Left = 3 Top = 37 - Width = 52 - Height = 13 + Width = 59 + Height = 14 Caption = 'From &host:' FocusControl = editFromHost end object lblPassword: TLabel Left = 3 Top = 64 - Width = 50 - Height = 13 + Width = 55 + Height = 14 Caption = '&Password:' FocusControl = editPassword end object lblRepeatPassword: TLabel Left = 3 - Top = 91 - Width = 88 - Height = 13 + Top = 110 + Width = 98 + Height = 14 Caption = 'Repeat password:' FocusControl = editRepeatPassword end - object editRepeatPassword: TEdit + object lblDefaultRole: TLabel + Left = 3 + Top = 166 + Width = 67 + Height = 14 + Caption = 'Default role:' + end + object lblPlugin: TLabel + Left = 3 + Top = 139 + Width = 36 + Height = 14 + Caption = 'Plugin:' + end + object lblPasswordHint: TLabel Left = 176 Top = 88 + Width = 204 + Height = 14 + Hint = + 'You changed the authentication plugin. This will reset the passw' + + 'ord, so please specify a new one.' + Caption = 'Empty password after plugin change!' + ParentShowHint = False + ShowHint = True + Visible = False + end + object editRepeatPassword: TEdit + Left = 176 + Top = 107 Width = 96 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] PasswordChar = '*' TabOrder = 3 @@ -328,7 +297,7 @@ object UserManagerForm: TUserManagerForm Left = 176 Top = 61 Width = 96 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] Images = MainForm.VirtualImageListMain PasswordChar = '*' @@ -343,7 +312,7 @@ object UserManagerForm: TUserManagerForm Left = 176 Top = 34 Width = 96 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] Images = MainForm.VirtualImageListMain RightButton.DropDownMenu = menuHost @@ -356,51 +325,71 @@ object UserManagerForm: TUserManagerForm Left = 176 Top = 7 Width = 96 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] TabOrder = 0 OnChange = Modification end + object comboDefaultRole: TComboBox + Left = 176 + Top = 163 + Width = 96 + Height = 22 + Style = csDropDownList + Anchors = [akLeft, akTop, akRight] + TabOrder = 5 + OnChange = Modification + end + object comboPlugins: TComboBox + Left = 176 + Top = 135 + Width = 96 + Height = 22 + Style = csDropDownList + Anchors = [akLeft, akTop, akRight] + TabOrder = 4 + OnChange = comboPluginsChange + end end object tabLimitations: TTabSheet Caption = 'Limitations' ImageIndex = 1 DesignSize = ( 275 - 117) + 190) object lblMaxQueries: TLabel Left = 3 Top = 10 - Width = 85 - Height = 13 + Width = 96 + Height = 14 Caption = 'Queries per hour:' end object lblMaxUpdates: TLabel Left = 3 Top = 37 - Width = 88 - Height = 13 + Width = 100 + Height = 14 Caption = 'Updates per hour:' end object lblMaxConnections: TLabel Left = 3 Top = 64 - Width = 107 - Height = 13 + Width = 122 + Height = 14 Caption = 'Connections per hour:' end object lblMaxUserConnections: TLabel Left = 3 Top = 91 - Width = 127 - Height = 13 + Width = 146 + Height = 14 Caption = 'Simultaneous connections:' end object editMaxQueries: TEdit Left = 176 Top = 7 Width = 80 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] NumbersOnly = True TabOrder = 0 @@ -411,7 +400,7 @@ object UserManagerForm: TUserManagerForm Left = 176 Top = 34 Width = 80 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] NumbersOnly = True TabOrder = 2 @@ -422,7 +411,7 @@ object UserManagerForm: TUserManagerForm Left = 176 Top = 61 Width = 80 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] NumbersOnly = True TabOrder = 4 @@ -433,7 +422,7 @@ object UserManagerForm: TUserManagerForm Left = 176 Top = 88 Width = 80 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] NumbersOnly = True TabOrder = 6 @@ -444,7 +433,7 @@ object UserManagerForm: TUserManagerForm Left = 256 Top = 7 Width = 17 - Height = 21 + Height = 22 Anchors = [akTop, akRight] Associate = editMaxQueries Max = 2147483647 @@ -456,7 +445,7 @@ object UserManagerForm: TUserManagerForm Left = 256 Top = 34 Width = 17 - Height = 21 + Height = 22 Anchors = [akTop, akRight] Associate = editMaxUpdates Max = 2147483647 @@ -467,7 +456,7 @@ object UserManagerForm: TUserManagerForm Left = 256 Top = 61 Width = 17 - Height = 21 + Height = 22 Anchors = [akTop, akRight] Associate = editMaxConnections Max = 2147483647 @@ -478,7 +467,7 @@ object UserManagerForm: TUserManagerForm Left = 256 Top = 88 Width = 17 - Height = 21 + Height = 22 Anchors = [akTop, akRight] Associate = editMaxUserConnections Max = 2147483647 @@ -491,43 +480,43 @@ object UserManagerForm: TUserManagerForm ImageIndex = 2 DesignSize = ( 275 - 117) + 190) object lblCipher: TLabel Left = 3 Top = 36 - Width = 35 - Height = 13 + Width = 38 + Height = 14 Caption = '&Cipher:' FocusControl = editCipher end object lblIssuer: TLabel Left = 3 Top = 62 - Width = 34 - Height = 13 + Width = 36 + Height = 14 Caption = '&Issuer:' FocusControl = editIssuer end object lblSubject: TLabel Left = 3 Top = 89 - Width = 40 - Height = 13 + Width = 46 + Height = 14 Caption = '&Subject:' FocusControl = editSubject end object lblSSL: TLabel Left = 3 Top = 9 - Width = 61 - Height = 13 + Width = 69 + Height = 14 Caption = '&Require SSL:' end object editCipher: TEdit Left = 176 Top = 33 Width = 96 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] TabOrder = 1 Text = 'editCipher' @@ -537,7 +526,7 @@ object UserManagerForm: TUserManagerForm Left = 176 Top = 59 Width = 96 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] TabOrder = 2 Text = 'editIssuer' @@ -547,7 +536,7 @@ object UserManagerForm: TUserManagerForm Left = 176 Top = 86 Width = 96 - Height = 21 + Height = 22 Anchors = [akLeft, akTop, akRight] TabOrder = 3 Text = 'editSubject' @@ -557,7 +546,7 @@ object UserManagerForm: TUserManagerForm Left = 176 Top = 6 Width = 96 - Height = 21 + Height = 22 Style = csDropDownList Anchors = [akLeft, akTop, akRight] TabOrder = 0 @@ -570,6 +559,91 @@ object UserManagerForm: TUserManagerForm end end end + object PageControlAccess: TPageControl + Left = 0 + Top = 219 + Width = 283 + Height = 97 + ActivePage = tabPrivileges + Align = alClient + TabOrder = 1 + object tabPrivileges: TTabSheet + Caption = 'Privileges' + object treePrivs: TVirtualStringTree + Left = 0 + Top = 22 + Width = 275 + Height = 46 + Align = alClient + Header.AutoSizeIndex = 0 + Header.Height = 14 + Header.MainColumn = -1 + Images = MainForm.VirtualImageListMain + IncrementalSearch = isAll + TabOrder = 0 + TreeOptions.AutoOptions = [toAutoDropExpand, toAutoTristateTracking, toAutoDeleteMovedNodes, toAutoChangeScale] + TreeOptions.MiscOptions = [toAcceptOLEDrop, toCheckSupport, toFullRepaintOnResize, toInitOnSave, toToggleOnDblClick, toWheelPanning, toEditOnClick] + TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages, toUseExplorerTheme, toHideTreeLinesIfThemed] + OnChecked = treePrivsChecked + OnExpanded = treePrivsExpanded + OnGetText = treePrivsGetText + OnPaintText = treePrivsPaintText + OnGetImageIndex = treePrivsGetImageIndex + OnInitChildren = treePrivsInitChildren + OnInitNode = treePrivsInitNode + Touch.InteractiveGestures = [igPan, igPressAndTap] + Touch.InteractiveGestureOptions = [igoPanSingleFingerHorizontal, igoPanSingleFingerVertical, igoPanInertia, igoPanGutter, igoParentPassthrough] + Columns = <> + end + object tlbObjects: TToolBar + Left = 0 + Top = 0 + Width = 275 + Height = 22 + AutoSize = True + ButtonWidth = 88 + Caption = 'tlbObjects' + Images = MainForm.VirtualImageListMain + List = True + ParentShowHint = False + ShowCaptions = True + ShowHint = True + TabOrder = 1 + Wrapable = False + object btnAddObject: TToolButton + Left = 0 + Top = 0 + Hint = 'Add object ...' + Caption = 'Add object' + ImageIndex = 45 + ImageName = 'icons8-add' + OnClick = btnAddObjectClick + end + end + end + object tabRoles: TTabSheet + Caption = 'Roles' + ImageIndex = 1 + object ValueListEditorRoles: TValueListEditor + Left = 0 + Top = 0 + Width = 275 + Height = 68 + Align = alClient + Strings.Strings = ( + 'Roll=off') + TabOrder = 0 + TitleCaptions.Strings = ( + 'Role name' + 'Assigned') + OnGetPickList = ValueListEditorRolesGetPickList + OnSetEditText = ValueListEditorRolesSetEditText + ColWidths = ( + 150 + 119) + end + end + end end object btnDiscard: TButton Left = 280 @@ -658,12 +732,13 @@ object UserManagerForm: TUserManagerForm end end object menuAdd: TPopupMenu + Images = MainForm.VirtualImageListMain OnPopup = menuAddPopup Left = 80 Top = 280 object menuItemUser: TMenuItem Caption = 'User' - OnClick = btnAddUserClick + OnClick = menuItemUserClick end object menuItemRole: TMenuItem Caption = 'Role' diff --git a/source/usermanager.pas b/source/usermanager.pas index ad2e6435c..878e5f405 100644 --- a/source/usermanager.pas +++ b/source/usermanager.pas @@ -7,7 +7,8 @@ interface Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.StdCtrls, Vcl.ExtCtrls, Vcl.ToolWin, Vcl.ClipBrd, System.Generics.Collections, System.Generics.Defaults, SynRegExpr, extra_controls, dbconnection, dbstructures, dbstructures.mysql, apphelpers, VirtualTrees.BaseTree, VirtualTrees.Types, VirtualTrees, VirtualTrees.EditLink, Vcl.Menus, gnugettext, - VirtualTrees.BaseAncestorVCL, VirtualTrees.AncestorVCL, StrUtils; + VirtualTrees.BaseAncestorVCL, VirtualTrees.AncestorVCL, StrUtils, Vcl.Grids, + Vcl.ValEdit; {$I const.inc} @@ -31,31 +32,42 @@ TPrivComparer = class(TComparer) TUserProblem = (upNone, upEmptyPassword, upInvalidPasswordLen, upSkipNameResolve, upUnknown); TUser = class(TObject) - Username, Host, Password, Cipher, Issuer, Subject: String; + Username, Host, Password, Cipher, Issuer, Subject, DefaultRole, Plugin: String; MaxQueries, MaxUpdates, MaxConnections, MaxUserConnections, SSL: Integer; Problem: TUserProblem; IsRole: Boolean; + Roles: TStringList; public + class var RoleNo: String; + class var RoleYes: String; + class var RoleYesAdmin: String; constructor Create; + destructor Destroy; override; function HostRequiresNameResolve: Boolean; procedure ParseSettings(GrantOrCreate: String; Priv: TPrivObj); function IsUser: Boolean; + function AssignedRolesCount: Integer; end; PUser = ^TUser; - TUserList = TObjectList; + TUserList = class(TObjectList) + public + function GetRoleNames: TStringList; overload; + procedure GetRoleNames(Strings: TStrings); overload; + function GetDefaultRoles(ExcludeRole: TUser): TStringList; + end; EInputError = class(Exception); TUserManagerForm = class(TExtForm) btnCancel: TButton; btnSave: TButton; + comboPlugins: TComboBox; + lblPasswordHint: TLabel; + lblPlugin: TLabel; pnlLeft: TPanel; listUsers: TVirtualStringTree; Splitter1: TSplitter; pnlRight: TPanel; - tlbObjects: TToolBar; - btnAddObject: TToolButton; - treePrivs: TVirtualStringTree; btnDiscard: TButton; lblUsers: TLabel; ToolBar1: TToolBar; @@ -63,7 +75,6 @@ TUserManagerForm = class(TExtForm) btnDeleteUser: TToolButton; btnCloneUser: TToolButton; lblWarning: TLabel; - lblAllowAccessTo: TLabel; menuHost: TPopupMenu; menuHost1: TMenuItem; menuHostLocal4: TMenuItem; @@ -117,9 +128,19 @@ TUserManagerForm = class(TExtForm) menuAdd: TPopupMenu; menuItemUser: TMenuItem; menuItemRole: TMenuItem; + PageControlAccess: TPageControl; + tabPrivileges: TTabSheet; + tabRoles: TTabSheet; + treePrivs: TVirtualStringTree; + tlbObjects: TToolBar; + btnAddObject: TToolButton; + ValueListEditorRoles: TValueListEditor; + lblDefaultRole: TLabel; + comboDefaultRole: TComboBox; + procedure comboPluginsChange(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); - procedure btnAddUserClick(Sender: TObject); + procedure menuItemUserClick(Sender: TObject); procedure btnDeleteUserClick(Sender: TObject); procedure listUsersFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); @@ -162,23 +183,31 @@ TUserManagerForm = class(TExtForm) procedure listUsersHotChange(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode); procedure udMaxQueriesClick(Sender: TObject; Button: TUDBtnType); procedure comboSSLChange(Sender: TObject); - procedure FormResize(Sender: TObject); procedure editFilterUsersRightButtonClick(Sender: TObject); procedure editFilterUsersChange(Sender: TObject); procedure menuItemRoleClick(Sender: TObject); procedure menuAddPopup(Sender: TObject); + procedure ValueListEditorRolesGetPickList(Sender: TObject; + const KeyName: string; Values: TStrings); + procedure ValueListEditorRolesSetEditText(Sender: TObject; ACol, + ARow: LongInt; const Value: string); private { Private declarations } FUsers: TUserList; - FModified, FAdded: Boolean; - FHasIsRole: Boolean; + FModified, FAdded, FPluginModified: Boolean; + FHasIsRole, FHasDefaultRole: Boolean; + FHasPlugin: Boolean; + FPlugins: TStringList; FCloneGrants: TStringList; FPrivObjects: TPrivObjList; FPrivsGlobal, FPrivsDb, FPrivsTable, FPrivsRoutine, FPrivsColumn: TStringList; FConnection: TDBConnection; FColorReadPriv, FColorWritePriv, FColorAdminPriv: TColor; + FSQLPluginPrefix, FSQLPluginPassPrefix: String; procedure SetModified(Value: Boolean); + procedure SetPluginModified(Value: Boolean); property Modified: Boolean read FModified write SetModified; + property PluginModified: Boolean read FPluginModified write SetPluginModified; function GetPrivByNode(Node: PVirtualNode): TPrivObj; function SelectUserNode(User: TUser): Boolean; public @@ -233,13 +262,16 @@ procedure TUserManagerForm.FormCreate(Sender: TObject); 'REPLICATION SLAVE ADMIN,SET USER,SLAVE MONITOR'); FixVT(listUsers); FixVT(treePrivs); + FHasIsRole := False; + FHasDefaultRole := False; + menuItemUser.ImageIndex := ICONINDEX_USER; + menuItemRole.ImageIndex := ICONINDEX_ROLE; end; - -procedure TUserManagerForm.FormResize(Sender: TObject); +procedure TUserManagerForm.comboPluginsChange(Sender: TObject); begin - // Manually right align "Add object" button - lblAllowAccessTo.Width := pnlRight.Width - btnAddObject.Width; + PluginModified := True; + Modification(Sender); end; @@ -248,10 +280,10 @@ procedure TUserManagerForm.FormShow(Sender: TObject); Version, i: Integer; Users: TDBQuery; U: TUser; - tmp, PasswordExpr, IsRoleExpr: String; + tmp, PasswordExpr, IsRoleExpr, DefaultRoleExpr, PluginExpr: String; SkipNameResolve, HasPassword, HasAuthString: Boolean; - PasswordLengthMatters: Boolean; + PasswordLengthMatters, PasswordLengthValid: Boolean; UserTableColumns: TStringList; function InitPrivList(Values: String): TStringList; @@ -282,7 +314,8 @@ procedure TUserManagerForm.FormShow(Sender: TObject); FPrivsTable := InitPrivList('ALTER,CREATE,DELETE,DROP,GRANT,INDEX'); FPrivsRoutine := InitPrivList('GRANT'); FPrivsColumn := InitPrivList('INSERT,SELECT,UPDATE,REFERENCES'); - PasswordLengthMatters := True; + FSQLPluginPrefix := IfThen(FConnection.Parameters.IsMariaDB, 'VIA', 'WITH'); + FSQLPluginPassPrefix := IfThen(FConnection.Parameters.IsMariaDB, 'USING', 'BY'); if Version >= 40002 then begin FPrivsGlobal.Add('REPLICATION CLIENT'); @@ -315,11 +348,6 @@ procedure TUserManagerForm.FormShow(Sender: TObject); PrivsDb.Add('PROXY'); end; } - if Version >= 80000 then begin - // MySQL 8 has predefined length of hashed passwords only with - // mysql_native_password plugin enabled users - PasswordLengthMatters := False; - end; // See https://mariadb.com/kb/en/changes-improvements-in-mariadb-105/#privileges-made-more-granular if FConnection.Parameters.IsMariaDB then begin if Version > 100502 then begin @@ -368,19 +396,13 @@ procedure TUserManagerForm.FormShow(Sender: TObject); tmp := FConnection.GetSessionVariable('skip_name_resolve'); SkipNameResolve := LowerCase(tmp) = 'on'; - try - FConnection.Query(qReloadPrivileges); - except - // FLUSH PRIVILEGE may fail due to missing RELOAD privilege. - // Proceed anyway, it's still ok to read/see the users - on E:EDbError do; - end; - // Peek into user table structure, and find out where the password hash is stored UserTableColumns := FConnection.GetCol('SHOW COLUMNS FROM '+FConnection.QuoteIdent('mysql')+'.'+FConnection.QuoteIdent('user')); HasPassword := UserTableColumns.IndexOf('password') > -1; HasAuthString := UserTableColumns.IndexOf('authentication_string') > -1; FHasIsRole := UserTableColumns.IndexOf('is_role') > -1; + FHasDefaultRole := UserTableColumns.IndexOf('default_role') > -1; + FHasPlugin := UserTableColumns.IndexOf('plugin') > -1; if HasPassword and (not HasAuthString) then PasswordExpr := 'password' else if (not HasPassword) and HasAuthString then @@ -391,27 +413,40 @@ procedure TUserManagerForm.FormShow(Sender: TObject); Raise Exception.Create(_('No password hash column available')); PasswordExpr := PasswordExpr + ' AS ' + FConnection.QuoteIdent('password'); IsRoleExpr := IfThen(FHasIsRole, 'is_role', FConnection.EscapeString('N')+' AS is_role'); + DefaultRoleExpr := IfThen(FHasDefaultRole, 'default_role', FConnection.EscapeString('')+' AS default_role'); + PluginExpr := IfThen(FHasPlugin, 'plugin', FConnection.EscapeString('')+' AS plugin'); + if FConnection.SqlProvider.Has(qGetAuthPlugins) then + FPlugins := FConnection.GetCol(FConnection.SqlProvider.GetSql(qGetAuthPlugins)) + else + FPlugins := TStringList.Create; Users := FConnection.GetResults( 'SELECT '+ FConnection.QuoteIdent('user') + ', ' + FConnection.QuoteIdent('host') + ', ' + PasswordExpr + ', ' + - IsRoleExpr + ' ' + + IsRoleExpr + ', ' + + DefaultRoleExpr + ', ' + + PluginExpr + ' ' + 'FROM '+FConnection.QuoteIdent('mysql')+'.'+FConnection.QuoteIdent('user') ); FUsers := TUserList.Create(True); + ValueListEditorRoles.Strings.Clear; while not Users.Eof do begin U := TUser.Create; U.Username := Users.Col('user'); U.Host := Users.Col('host'); U.Password := Users.Col('password'); U.IsRole := UpperCase(Users.Col('is_role')) = 'Y'; + U.DefaultRole := Users.Col('default_role'); + U.Plugin := Users.Col('plugin'); U.Problem := upNone; if U.IsUser then begin if Length(U.Password) = 0 then U.Problem := upEmptyPassword; - if PasswordLengthMatters and (not (Length(U.Password) in [0, 16, 41])) then + PasswordLengthMatters := ExecRegExpr('(mysql_native_password|mysql_old_password)', U.Plugin) or (not FHasPlugin); + PasswordLengthValid := Byte(Length(U.Password)) in [0, 16, 41]; + if PasswordLengthMatters and (not PasswordLengthValid) then U.Problem := upInvalidPasswordLen else if SkipNameResolve and U.HostRequiresNameResolve then U.Problem := upSkipNameResolve; @@ -419,11 +454,14 @@ procedure TUserManagerForm.FormShow(Sender: TObject); FUsers.Add(U); Users.Next; end; + listUsers.Clear; InvalidateVT(listUsers, VTREE_NOTLOADED, False); FPrivObjects := TPrivObjList.Create(TPrivComparer.Create, True); Modified := False; + PluginModified := False; FAdded := False; + tabRoles.TabVisible := FHasIsRole; listUsers.OnFocusChanged(listUsers, listUsers.FocusedNode, listUsers.FocusedColumn); except on E:EDbError do begin @@ -468,6 +506,23 @@ procedure TUserManagerForm.SetModified(Value: Boolean); listUsers.Invalidate; end; +procedure TUserManagerForm.SetPluginModified(Value: Boolean); +var + User: PUser; +begin + if not Assigned(listUsers.FocusedNode) then + Exit; + FPluginModified := Value; + if not FAdded then begin + lblPasswordHint.Visible := FPluginModified; + if Value then begin + User := listUsers.GetNodeData(listUsers.FocusedNode); + User.Password := ''; + editPassword.TextHint := ''; + end; + end; +end; + procedure TUserManagerForm.Modification(Sender: TObject); var @@ -495,6 +550,20 @@ procedure TUserManagerForm.udMaxQueriesClick(Sender: TObject; Button: TUDBtnType end; +procedure TUserManagerForm.ValueListEditorRolesGetPickList(Sender: TObject; + const KeyName: string; Values: TStrings); +begin + Values.Add(TUser.RoleNo); + Values.Add(TUser.RoleYes); + Values.Add(TUser.RoleYesAdmin); +end; + +procedure TUserManagerForm.ValueListEditorRolesSetEditText(Sender: TObject; + ACol, ARow: LongInt; const Value: string); +begin + Modification(Sender); +end; + procedure TUserManagerForm.listUsersAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); begin // Background painting for sorted column @@ -536,6 +605,8 @@ procedure TUserManagerForm.listUsersFocusChanging(Sender: TBaseVirtualTree; OldN end; mrNo: begin Allowed := True; + Modified := False; + PluginModified := False; if FAdded then btnDeleteUser.Click; end; @@ -550,41 +621,68 @@ procedure TUserManagerForm.listUsersFocusChanged(Sender: TBaseVirtualTree; Node: var P, Ptmp, PCol: TPrivObj; User: PUser; - UserHost, Msg, CreateUser: String; - Grants, AllPNames, Cols: TStringList; + UserHost, UserHostRx, Msg, CreateUser, RxQuotes: String; + Grants, AllPNames, Cols, RoleNames, DefaultRoles: TStringList; rxTemp, rxGrant: TRegExpr; i, j: Integer; UserSelected: Boolean; Obj: TDBObject; begin // Parse and display privileges of focused user + listUsers.TrySetFocus; // Steal focus from roles, prevents empty cell bug UserSelected := Assigned(Node); User := nil; FPrivObjects.Clear; Caption := MainForm.actUserManager.Caption; + // Credentials tab editUsername.Clear; editFromHost.Clear; editPassword.Clear; editPassword.TextHint := ''; editRepeatPassword.Clear; + comboPlugins.Items.Clear; + comboPlugins.Items.Add(_('None')); + comboPlugins.Items.AddStrings(FPlugins); + comboPlugins.ItemIndex := 0; + comboDefaultRole.Items.Clear; + comboDefaultRole.Items.Add(_('None')); + FUsers.GetRoleNames(comboDefaultRole.Items); + comboDefaultRole.ItemIndex := 0; + // Limitations tab udMaxQueries.Position := 0; udMaxUpdates.Position := 0; udMaxConnections.Position := 0; udMaxUserConnections.Position := 0; + // SSL tab comboSSL.ItemIndex := 0; comboSSL.OnChange(Sender); editCipher.Clear; editIssuer.Clear; editSubject.Clear; + // Page control + tabPrivileges.Caption := _('Privileges'); + tabRoles.Caption := _('Roles'); + + // All possible quote chars, escaped for RegExpr. Todo: use in all relevant expressions. + RxQuotes := '['+QuoteRegExprMetaChars(FConnection.QuoteChars + FConnection.StringQuoteChar)+']'; if UserSelected then begin User := Sender.GetNodeData(Node); - if User.IsUser then - UserHost := FConnection.EscapeString(User.Username)+'@'+FConnection.EscapeString(User.Host) - else - UserHost := FConnection.EscapeString(User.Username); + UserHost := FConnection.EscapeString(User.Username); + UserHostRx := RxQuotes + '?' + QuoteRegExprMetaChars(User.Username) + RxQuotes + '?'; + if User.IsUser then begin + UserHost := UserHost + '@' + FConnection.EscapeString(User.Host); + UserHostRx := UserHostRx + '@' + RxQuotes + '?' + QuoteRegExprMetaChars(User.Host) + RxQuotes + '?'; + end; editUsername.Text := User.Username; editFromHost.Text := User.Host; + i := comboPlugins.Items.IndexOf(User.Plugin); + if i > -1 then + comboPlugins.ItemIndex := i; + i := comboDefaultRole.Items.IndexOf(User.DefaultRole); + if i > -1 then + comboDefaultRole.ItemIndex := i; + Caption := Caption + ' - ' + User.Username; AllPNames := TStringList.Create; @@ -616,6 +714,7 @@ procedure TUserManagerForm.listUsersFocusChanged(Sender: TBaseVirtualTree; Node: end; MessageDialog(Msg, mtError, [mbOK]); FModified := False; + FPluginModified := False; SelectNode(listUsers, nil); Exit; end; @@ -736,7 +835,37 @@ procedure TUserManagerForm.listUsersFocusChanged(Sender: TBaseVirtualTree; Node: end; end; + // Find roles assigned to user or role: + // GRANT role_admin TO 'root'@'127.0.0.1'; + // GRANT 'role space' TO 'root'@'127.0.0.1'; + // GRANT role_space to 'role_admin' WITH ADMIN OPTION; + DefaultRoles := FUsers.GetDefaultRoles(User^); + User.Roles.Assign(DefaultRoles); + RoleNames := FUsers.GetRoleNames; + for i:=0 to RoleNames.Count-1 do begin + RoleNames[i] := QuoteRegExprMetaChars(RoleNames[i]); + end; + rxGrant.Expression := '^GRANT\s+'+RxQuotes+'?('+Implode('|', RoleNames)+')'+RxQuotes+'?\s+'+ + 'TO\s+'+UserHostRx+'(\s+WITH ADMIN OPTION)?$'; + for i:=0 to Grants.Count-1 do begin + // Find selected priv objects via regular expression + if not rxGrant.Exec(Grants[i]) then begin + Continue; + end; + j := User.Roles.IndexOfName(rxGrant.Match[1]); + if j > -1 then begin + if rxGrant.MatchLen[2] > 0 then + User.Roles.ValueFromIndex[j] := User.RoleYesAdmin + else + User.Roles.ValueFromIndex[j] := User.RoleYes; + end; + end; + ValueListEditorRoles.BeginUpdate; + ValueListEditorRoles.Strings.Assign(User.Roles); + ValueListEditorRoles.EndUpdate; + DefaultRoles.Free; + // Parse general user options CreateUser := ''; if User.IsUser then try CreateUser := FConnection.GetVar('SHOW CREATE USER '+UserHost); @@ -754,6 +883,8 @@ procedure TUserManagerForm.listUsersFocusChanged(Sender: TBaseVirtualTree; Node: editCipher.Text := User.Cipher; editIssuer.Text := User.Issuer; editSubject.Text := User.Subject; + tabPrivileges.Caption := _('Privileges') + ' (' + FPrivObjects.Count.ToString + ')'; + tabRoles.Caption := _('Roles') + ' (' + User.AssignedRolesCount.ToString + ')'; // Generate grant code for column privs by hand @@ -779,6 +910,7 @@ procedure TUserManagerForm.listUsersFocusChanged(Sender: TBaseVirtualTree; Node: // Populate privilege tree Modified := False; + PluginModified := False; treePrivs.FocusedNode := nil; treePrivs.Clear; treePrivs.RootNodeCount := FPrivObjects.Count; @@ -794,6 +926,10 @@ procedure TUserManagerForm.listUsersFocusChanged(Sender: TBaseVirtualTree; Node: editPassword.Enabled := UserSelected and User.IsUser; lblRepeatPassword.Enabled := UserSelected and User.IsUser; editRepeatPassword.Enabled := UserSelected and User.IsUser; + comboPlugins.Enabled := UserSelected and User.IsUser and FHasPlugin; + lblPlugin.Enabled := comboPlugins.Enabled; + comboDefaultRole.Enabled := UserSelected and User.IsUser and FHasDefaultRole; + lblDefaultRole.Enabled := comboDefaultRole.Enabled; tabCredentials.Enabled := UserSelected; lblMaxQueries.Enabled := UserSelected and User.IsUser and (FConnection.ServerVersionInt >= 40002); @@ -833,9 +969,9 @@ procedure TUserManagerForm.listUsersGetImageIndex(Sender: TBaseVirtualTree; Node case Kind of ikNormal, ikSelected: begin if User.IsUser then - ImageIndex := 43 + ImageIndex := ICONINDEX_USER else - ImageIndex := 95; + ImageIndex := ICONINDEX_ROLE; end; ikOverlay: begin if User.Password = '' then @@ -865,6 +1001,7 @@ procedure TUserManagerForm.listUsersGetText(Sender: TBaseVirtualTree; Node: PVir case Column of 0: CellText := User.Username; 1: CellText := User.Host; + 2: CellText := User.Plugin; end; end; @@ -1080,7 +1217,7 @@ procedure TUserManagerForm.treePrivsPaintText(Sender: TBaseVirtualTree; const Ta end; -procedure TUserManagerForm.btnAddUserClick(Sender: TObject); +procedure TUserManagerForm.menuItemUserClick(Sender: TObject); var P: TPrivObj; User: TUser; @@ -1132,7 +1269,7 @@ procedure TUserManagerForm.menuItemRoleClick(Sender: TObject); // Add role RoleName := ''; - if not InputQuery('Create role', 'Role name', RoleName) then + if not InputQuery(_('Create role'), _('Role name'), RoleName) then Exit; try @@ -1237,8 +1374,9 @@ procedure TUserManagerForm.btnSaveClick(Sender: TObject); FocusedUser: PUser; Tables, WithClauses: TStringList; P: TPrivObj; - i: Integer; + i, j: Integer; PasswordSet, WithGrant: Boolean; + RoleName, RoleAssigned: String; function GetObjectType(ObjType: String): String; begin @@ -1290,13 +1428,18 @@ procedure TUserManagerForm.btnSaveClick(Sender: TObject); // Create added user PasswordSet := False; if FAdded and (FConnection.ServerVersionInt >= 50002) then begin - Create := 'CREATE USER '+UserHost; + Create := 'CREATE USER '+UserHost+' '; if editPassword.Modified then begin + // Insert authentication plugin with minor MariaDB/MySQL difference + if comboPlugins.ItemIndex > 0 then + Create := Create + 'IDENTIFIED ' + FSQLPluginPrefix + ' ' + comboPlugins.Text+' ' + FSQLPluginPassPrefix + ' ' + else + Create := Create + 'IDENTIFIED BY '; // Add "PASSWORD" clause when it's a hash already if (Copy(editPassword.Text, 1, 1) = '*') and (Length(editPassword.Text) = 41) then - Create := Create + ' IDENTIFIED BY PASSWORD '+FConnection.EscapeString(editPassword.Text) + Create := Create + 'PASSWORD '+FConnection.EscapeString(editPassword.Text) else - Create := Create + ' IDENTIFIED BY '+FConnection.EscapeString(editPassword.Text); + Create := Create + FConnection.EscapeString(editPassword.Text); end; FConnection.Query(Create); FConnection.ShowWarnings; @@ -1362,8 +1505,14 @@ procedure TUserManagerForm.btnSaveClick(Sender: TObject); FConnection.ShowWarnings; end; - // Global options for a user + // General user options if (P.DBObj.NodeType = lntNone) and FocusedUser.IsUser then begin + // Plugin + if FPluginModified and (comboPlugins.ItemIndex > 0) then begin + FConnection.Query('ALTER USER ' + UserHost + ' IDENTIFIED ' + FSQLPluginPrefix + ' ' + comboPlugins.Text); + FConnection.ShowWarnings; + end; + // SSL case comboSSL.ItemIndex of 1: RequireClause := 'SSL'; @@ -1396,6 +1545,39 @@ procedure TUserManagerForm.btnSaveClick(Sender: TObject); FConnection.ShowWarnings; end; + // Add or remove roles + for i:=0 to ValueListEditorRoles.Strings.Count-1 do begin + j := FocusedUser.Roles.IndexOf(ValueListEditorRoles.Strings[i]); + if j = -1 then begin + RoleName := ValueListEditorRoles.Strings.Names[i]; + RoleAssigned := ValueListEditorRoles.Strings.ValueFromIndex[i]; + if RoleAssigned = TUser.RoleNo then + FConnection.Query(qRevokeRole, [FConnection.EscapeString(RoleName), OrgUserHost]) + else if RoleAssigned = TUser.RoleYes then + FConnection.Query(qGrantRole, [FConnection.EscapeString(RoleName), OrgUserHost, '']) + else if RoleAssigned = TUser.RoleYesAdmin then + FConnection.Query(qGrantRole, [FConnection.EscapeString(RoleName), OrgUserHost, ' WITH ADMIN OPTION']); + FConnection.ShowWarnings; + end; + end; + + // Set default role + if comboDefaultRole.Enabled and (comboDefaultRole.ItemIndex > -1) then begin + if comboDefaultRole.ItemIndex = 0 then begin + FConnection.Query(qSetDefaultRole, ['NONE', OrgUserHost]); + end + else try + RoleName := comboDefaultRole.Text; + RoleAssigned := ValueListEditorRoles.Strings.Values[RoleName]; + if (RoleAssigned = TUser.RoleYes) or (RoleAssigned = TUser.RoleYesAdmin) then + FConnection.Query(qSetDefaultRole, [FConnection.EscapeString(RoleName), OrgUserHost]); + except + on E:EDbError do; // Happens when this role was not granted before + end; + FConnection.ShowWarnings; + end; + + // Rename user if (FocusedUser.Username <> editUsername.Text) or (FocusedUser.Host <> editFromHost.Text) then begin @@ -1423,15 +1605,19 @@ procedure TUserManagerForm.btnSaveClick(Sender: TObject); FConnection.Query(qReloadPrivileges); Modified := False; + PluginModified := False; FAdded := False; FocusedUser.Username := editUsername.Text; FocusedUser.Host := editFromHost.Text; if editPassword.Modified then FocusedUser.Password := editPassword.Text; + FocusedUser.Plugin := IfThen(comboPlugins.ItemIndex=0, '', comboPlugins.Text); + FocusedUser.DefaultRole := IfThen(comboDefaultRole.ItemIndex=0, '', comboDefaultRole.Text); FocusedUser.SSL := comboSSL.ItemIndex; FocusedUser.Cipher := editCipher.Text; FocusedUser.Issuer := editIssuer.Text; FocusedUser.Subject := editSubject.Text; + FocusedUser.Roles.Assign(ValueListEditorRoles.Strings); listUsers.OnFocusChanged(listUsers, listUsers.FocusedNode, listUsers.FocusedColumn); except on E:EDbError do @@ -1510,6 +1696,7 @@ procedure TUserManagerForm.btnDiscardClick(Sender: TObject); begin // Reset modifications Modified := False; + PluginModified := False; listUsers.OnFocusChanged(listUsers, listUsers.FocusedNode, listUsers.FocusedColumn); end; @@ -1627,6 +1814,7 @@ constructor TUser.Create; Username := ''; Host := ''; Password := ''; + DefaultRole := ''; Cipher := ''; Issuer := ''; Subject := ''; @@ -1637,6 +1825,13 @@ constructor TUser.Create; SSL := 0; Problem := upNone; IsRole := False; + Roles := TStringList.Create; +end; + +destructor TUser.Destroy; +begin + Roles.Free; + inherited; end; function TUser.HostRequiresNameResolve: Boolean; @@ -1658,7 +1853,9 @@ procedure TUser.ParseSettings(GrantOrCreate: String; Priv: TPrivObj); rx: TRegExpr; RequireClause, WithClause: String; begin - // REQUIRE SSL X509 ISSUER '456' SUBJECT '789' CIPHER '123' NONE + // CREATE USER ... + // mysql: IDENTIFIED WITH 'mysql_native_password' AS '*23AE809DDACAF96AF0FD78ED04B6A265E05AA257' REQUIRE SSL X509 ISSUER '456' SUBJECT '789' CIPHER '123' NONE + // mariadb: IDENTIFIED BY PASSWORD '23AE809DDACAF96A'; rx := TRegExpr.Create; rx.ModifierI := True; rx.Expression := '\sREQUIRE\s+(.+)'; @@ -1715,6 +1912,59 @@ function TUser.IsUser: Boolean; end; +function TUser.AssignedRolesCount: Integer; +var + i: Integer; + Val: String; +begin + Result := 0; + for i:=0 to Roles.Count-1 do begin + Val := Roles.ValueFromIndex[i]; + if (Val = RoleYes) or (Val = RoleYesAdmin) then + Inc(Result); + end; +end; + + +{ TUserList } + +function TUserList.GetRoleNames: TStringList; +var + u: TUser; +begin + Result := TStringList.Create; + for u in Self do begin + if u.IsRole then + Result.Add(u.Username); + end; +end; + +procedure TUserList.GetRoleNames(Strings: TStrings); +var + RoleNames: TStringList; +begin + RoleNames := GetRoleNames; + Strings.AddStrings(RoleNames); + RoleNames.Free; +end; + +function TUserList.GetDefaultRoles(ExcludeRole: TUser): TStringList; +var + RoleNames: TStringList; + i: Integer; +begin + // Default role assignments with "no" value for all roles + Result := TStringList.Create; + RoleNames := GetRoleNames; + for i:=0 to RoleNames.Count-1 do begin + if ExcludeRole.IsRole and SameText(RoleNames[i], ExcludeRole.Username) then + Continue; + Result.AddPair(RoleNames[i], TUser.RoleNo); + end; + RoleNames.Free; +end; + + { TPrivObj } constructor TPrivObj.Create; @@ -1756,4 +2006,10 @@ function TPrivComparer.Compare(const Left, Right: TPrivObj): Integer; end; +initialization + +TUser.RoleNo := _('No'); +TUser.RoleYes := _('Yes'); +TUser.RoleYesAdmin := _('Yes, with admin option'); + end. diff --git a/source/view.dfm b/source/view.dfm index 385c86f65..c3d3e00e1 100644 --- a/source/view.dfm +++ b/source/view.dfm @@ -169,6 +169,7 @@ object frmView: TfrmView Top = 3 Width = 204 Height = 21 + AutoDropDownWidth = True Anchors = [akLeft, akTop, akRight] TabOrder = 1 Text = 'comboDefiner'