' + TableName + '

diff --git a/.github/ISSUE_TEMPLATE/bug_report.yml b/.github/ISSUE_TEMPLATE/bug_report.yml index 716732d1b..386650a72 100644 --- a/.github/ISSUE_TEMPLATE/bug_report.yml +++ b/.github/ISSUE_TEMPLATE/bug_report.yml @@ -11,8 +11,8 @@ body: - type: input id: heidisql_version attributes: - label: HeidiSQL version - placeholder: "Example: 12.8.0.6908" + label: HeidiSQL version and OS + placeholder: "Example: 12.15 Linux GTK2" validations: required: true - type: input 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/SECURITY.md b/SECURITY.md new file mode 100644 index 000000000..2f52e4bc7 --- /dev/null +++ b/SECURITY.md @@ -0,0 +1,19 @@ +# Security Policy + +## Supported Versions + +Currently supported releases with security updates: + +| Version | Supported | +| ------- | ------------------ | +| 12.x | :white_check_mark: | +| < 12.x | :x: | + +## Reporting a Vulnerability + +When reporting a vulnerability, please file a ticket here. You may also send an +email to security@heidisql.com . + +It is important that the report is _valid_, and I am able to _understand_ the vulnerability impact. +If so, you may expect an update within weeks, probably quicker. I'll do my best to keep the +software and the user systems intact. 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.dpr b/packages/Delphi12.3/heidisql.dpr index b9d721e61..f25ac703e 100644 --- a/packages/Delphi12.3/heidisql.dpr +++ b/packages/Delphi12.3/heidisql.dpr @@ -6,6 +6,7 @@ uses System.SysUtils, Vcl.Dialogs, Vcl.Controls, + Vcl.ComCtrls, Winapi.Windows, main in '..\..\source\main.pas' {MainForm}, about in '..\..\source\about.pas' {AboutBox}, @@ -96,6 +97,7 @@ begin // First time translation via dxgettext. // Issue #3064: Ignore TFont, so "Default" on mainform for WinXP users does not get broken. gnugettext.TP_GlobalIgnoreClass(TFont); + gnugettext.TP_GlobalIgnoreClass(TComboBoxEx); // Enable padding in customized tooltips HintWindowClass := TExtHintWindow; 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/readme.md b/readme.md index 81d18a9c6..e996fd965 100644 --- a/readme.md +++ b/readme.md @@ -16,7 +16,22 @@ Delphi 12.1 is required for building HeidiSQL for Windows. Older Delphi versions of the other free compilers cannot currently compile HeidiSQL. Once Delphi is installed, you need to load the SynEdit project from the components folder. Build both run-time and design-time packages. Install the -design-time package. Do the same for the VirtualTree component project, and install madExcept. +design-time package. Do the same for the VirtualTree component project. + +Second you need install [madExcept](http://madshi.net/madCollection.exe). + +Third compile *.rc files: + +| folder | file | command | +| ------ | ------ | ------ | +|HeidiSQL/source/vcl-styles-utils |AwesomeFont.RC| brcc32 AwesomeFont.RC| +|HeidiSQL/res| icon.rc | cgrc icon.rc | +|HeidiSQL/res| icon-question.rc | brcc32 icon-question.rc | +|HeidiSQL/res| version.rc | brcc32 version.rc | +|HeidiSQL/res| manifest.rc | manifest.rc | +|HeidiSQL/res| styles.rc | brcc32 styles.rc | +|HeidiSQL/res| updater.rc | brcc32 updater.rc | +> if updater.rc and updater.exe are not exists. you can copy them from updater64.rc and updater64.exe. Afterwards, load the HeidiSQL project from the packages folder. 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 3ca9adb77..5a537ff9f 100644 --- a/res/version.rc +++ b/res/version.rc @@ -1,5 +1,5 @@ 1 VERSIONINFO - FILEVERSION 12,15,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 3021c8535..02fb5e160 100644 --- a/source/apphelpers.pas +++ b/source/apphelpers.pas @@ -77,12 +77,13 @@ TSQLBatch = class(TObjectList) private FSQL: String; FQuotes: THashedStringList; + FEscape: Char; procedure SetSQL(Value: String); function GetSize: Integer; function GetSQLWithoutComments: String; overload; public constructor Create(NetTypeGroup: TNetTypeGroup); - destructor Destroy; overload; + destructor Destroy; override; class function GetSQLWithoutComments(FullSQL: String): String; overload; property Size: Integer read GetSize; property SQL: String read FSQL write SetSQL; @@ -187,16 +188,16 @@ 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, asStartupScriptFilename, asDatabases, asComment, asDatabaseFilter, asTableFilter, asFilterVT, asExportSQLCreateDatabases, asExportSQLCreateTables, asExportSQLDataHow, asExportSQLDataInsertSize, asExportSQLFilenames, asExportZIPFilenames, asExportSQLDirectories, - asExportSQLDatabase, asExportSQLServerDatabase, asExportSQLOutput, asExportSQLAddComments, asExportSQLRemoveAutoIncrement, asExportSQLRemoveDefiner, + asExportSQLDatabase, asExportSQLServerDatabase, asExportSQLOutput, asExportSQLAddComments, asExportSQLTransactions, asExportSQLRemoveAutoIncrement, asExportSQLRemoveDefiner, asGridExportWindowWidth, asGridExportWindowHeight, asGridExportOutputCopy, asGridExportOutputFile, asGridExportFilename, asGridExportRecentFiles, asGridExportEncoding, asGridExportFormat, asGridExportSelection, - asGridExportColumnNames, asGridExportIncludeAutoInc, asGridExportIncludeQuery, asGridExportRemoveLinebreaks, asGridExportOpenFile, + asGridExportColumnNames, asGridExportIncludeAutoInc, asGridExportFocusedColumnOnly, asGridExportIncludeQuery, asGridExportRemoveLinebreaks, asGridExportOpenFile, asGridExportSeparator, asGridExportEncloser, asGridExportTerminator, asGridExportNull, asGridExportClpColumnNames, asGridExportClpIncludeAutoInc, asGridExportClpRemoveLinebreaks, @@ -224,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, @@ -235,8 +236,8 @@ TWinControlHelper = class helper for TWinControl asThemePreviewWidth, asThemePreviewHeight, asThemePreviewTop, asThemePreviewLeft, asCreateDbCollation, asRealTrailingZeros, asSequalSuggestWindowWidth, asSequalSuggestWindowHeight, asSequalSuggestPrompt, asSequalSuggestRecentPrompts, - asReformatter, asReformatterNoDialog, asAlwaysGenerateFilter, - asGenerateDataNumRows, asGenerateDataNullAmount, asWebOnceAction, + asReformatter, asReformatterNoDialog, asAlwaysGenerateFilter, asDisplayReverseForeignKeys, + asGenerateDataNumRows, asGenerateDataNullAmount, asWebOnceAction, asDisplayLogPanel, asDisplayTreeFilters, asUnused); TAppSetting = record Name: String; @@ -359,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; @@ -710,10 +716,13 @@ function EncodeURLParam(const Value: String): String; } procedure StreamWrite(S: TStream; Text: String = ''); var - utf8: AnsiString; + utf8: UTF8String; + L: Integer; begin utf8 := Utf8Encode(Text); - S.Write(utf8[1], Length(utf8)); + L := Length(utf8); + if L > 0 then + S.WriteBuffer(utf8[1], L); end; @@ -1306,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 } @@ -1331,6 +1351,9 @@ procedure OpenTextFile(const Filename: String; out Stream: TFileStream; var Enco Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone); if Encoding = nil then Encoding := DetectEncoding(Stream); + // For a 0-bytes file, override the encoding to one without BOM + if _GetFileSize(Filename) < Length(Encoding.GetPreamble) then + Encoding := UTF8NoBOMEncoding; // If the file contains a BOM, advance the stream's position BomLen := 0; if Length(Encoding.GetPreamble) > 0 then begin @@ -1529,6 +1552,7 @@ procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1); VT.EndUpdate; VT.TextMargin := 6; VT.Margin := 2; + VT.DefaultText := '-'; // "Node" by default // Disable hottracking in non-Vista mode, looks ugly in XP, but nice in Vista if (toUseExplorerTheme in VT.TreeOptions.PaintOptions) and (Win32MajorVersion >= 6) then VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions + [toHotTrack] @@ -1886,9 +1910,9 @@ function TSortItems.ComposeOrderClause(Connection: TDBConnection): String; if Result <> '' then Result := Result + ', '; if SortItem.Order = sioAscending then - SortOrder := Connection.GetSQLSpecifity(spOrderAsc) + SortOrder := Connection.SqlProvider.GetSql(qOrderAsc) else - SortOrder := Connection.GetSQLSpecifity(spOrderDesc); + SortOrder := Connection.SqlProvider.GetSql(qOrderDesc); Result := Result + Connection.QuoteIdent(SortItem.Column) + ' ' + SortOrder; end; end; @@ -2504,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"]+'; @@ -3349,7 +3373,6 @@ procedure TQueryThread.Execute; end; FConnection.SetLockedByThread(nil); Synchronize(procedure begin MainForm.AfterQueryExecution(Self); end); - FConnection.ShowWarnings; // Check if FAborted is set by the main thread, to avoid proceeding the loop in case // FStopOnErrors is set to false if FAborted or ErrorAborted then @@ -3405,9 +3428,11 @@ constructor TSQLBatch.Create(NetTypeGroup: TNetTypeGroup); FQuotes.Sorted := True; FQuotes.Add('"'); FQuotes.Add(''''); + FEscape := '\'; case NetTypeGroup of ngMySQL: FQuotes.Add('`'); // MySQL/MariaDB only ngPgSQL: FQuotes.Add('$$'); // PostgreSQL only ($abc$ unsupported) + ngSQLite: FEscape := ''''; end; end; @@ -3498,7 +3523,7 @@ procedure TSQLBatch.SetSQL(Value: String); end; end; if not InEscape then - InEscape := c = '\' + InEscape := c = FEscape else InEscape := False; @@ -3546,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; @@ -3571,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; @@ -3762,8 +3785,7 @@ procedure TWinControlHelper.TrySetFocus; and CanFocus then SetFocus; except - on E:EInvalidOperation do - MessageBeep(MB_ICONWARNING); + MessageBeep(MB_ICONWARNING); end; end; @@ -3774,7 +3796,6 @@ constructor TAppSettings.Create; var rx: TRegExpr; i: Integer; - DefaultSnippetsDirectory: String; PortableLockFile: String; NewFileHandle: THandle; begin @@ -3840,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 @@ -3856,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'); @@ -3906,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); @@ -3950,6 +3972,7 @@ constructor TAppSettings.Create; InitSetting(asExportSQLServerDatabase, 'ExportSQL_ServerDatabase', 0, False, ''); InitSetting(asExportSQLOutput, 'ExportSQL_Output', 0); InitSetting(asExportSQLAddComments, 'ExportSQLAddComments', 0, True); + InitSetting(asExportSQLTransactions, 'ExportSQLTransactions', 0, False); InitSetting(asExportSQLRemoveAutoIncrement, 'ExportSQLRemoveAutoIncrement', 0, False); InitSetting(asExportSQLRemoveDefiner, 'ExportSQLRemoveDefiner', 0, True); InitSetting(asGridExportWindowWidth, 'GridExportWindowWidth', 400); @@ -3963,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); @@ -4048,16 +4072,10 @@ constructor TAppSettings.Create; InitSetting(asReformatter, 'Reformatter', 0); InitSetting(asReformatterNoDialog, 'ReformatterNoDialog', 0); InitSetting(asAlwaysGenerateFilter, 'AlwaysGenerateFilter', 0, False); + InitSetting(asDisplayReverseForeignKeys, 'DisplayReverseForeignKeys', 0, False); InitSetting(asGenerateDataNumRows, 'GenerateDataNumRows', 1000); InitSetting(asGenerateDataNullAmount, 'GenerateDataNullAmount', 10); - - // 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); @@ -4107,7 +4125,10 @@ 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); InitSetting(asActionShortcut1, 'Shortcut1_%s', 0); InitSetting(asActionShortcut2, 'Shortcut2_%s', 0); InitSetting(asHighlighterForeground, 'SQL Attr %s Foreground', 0); @@ -4124,7 +4145,7 @@ constructor TAppSettings.Create; InitSetting(asDateTimeEditorCursorPos, 'DateTimeEditor_CursorPos_Type%s', 0); InitSetting(asAppLanguage, 'Language', 0, False, ''); InitSetting(asAutoExpand, 'AutoExpand', 0, False); - InitSetting(asDoubleClickInsertsNodeText, 'DoubleClickInsertsNodeText', 0, False); + InitSetting(asDoubleClickInsertsNodeText, 'DoubleClickInsertsNodeText', 0, True); InitSetting(asForeignDropDown, 'ForeignDropDown', 0, True); InitSetting(asIncrementalSearch, 'IncrementalSearch', 0, True); InitSetting(asQueryHistoryEnabled, 'QueryHistory', 0, True); @@ -4713,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; @@ -4745,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; @@ -4758,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 087e7bb4e..2c5994ad8 100644 --- a/source/column_selection.pas +++ b/source/column_selection.pas @@ -89,6 +89,7 @@ procedure TfrmColumnSelection.btnOKClick(Sender: TObject); i: Integer; Col: String; begin + AppSettings.WriteBool(asDisplayedColumnsSorted, chkSort.Checked); AppSettings.WriteBool(asShowRowId, chkShowRowId.Checked); // Prepare string for storing in registry. // Use quote-character as separator to ensure columnnames can @@ -112,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; @@ -169,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 f6eac8c45..8914ff9c7 100644 --- a/source/connections.pas +++ b/source/connections.pas @@ -13,7 +13,7 @@ interface VirtualTrees, Vcl.Menus, Vcl.Graphics, System.Generics.Collections, Winapi.ActiveX, extra_controls, Winapi.Messages, dbconnection, gnugettext, SynRegExpr, System.Types, Vcl.GraphUtil, Data.Win.ADODB, System.StrUtils, System.Math, System.Actions, System.IOUtils, Vcl.ActnList, Vcl.StdActns, VirtualTrees.BaseTree, VirtualTrees.Types, VirtualTrees.EditLink, - VirtualTrees.BaseAncestorVCL, VirtualTrees.AncestorVCL; + VirtualTrees.BaseAncestorVCL, VirtualTrees.AncestorVCL, dbstructures; type Tconnform = class(TExtForm) @@ -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; @@ -1313,7 +1315,7 @@ procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject); Item.Caption := DB; Item.OnClick := MenuDatabasesClick; Item.AutoCheck := True; - Item.RadioItem := Params.NetTypeGroup = ngPgSQL; + Item.RadioItem := Params.IsAnyPostgreSQL; FPopupDatabases.Items.Add(Item); end; Databases.Free; @@ -1461,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) @@ -1498,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; @@ -1615,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; @@ -1626,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]) 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 9b4c32190..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'; - MsgInvalidColumn: String = 'Column #%d not available. Query returned %d columns and %d rows.'; + // 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 9f70e3e01..af3e8aee8 100644 --- a/source/copytable.pas +++ b/source/copytable.pas @@ -358,6 +358,7 @@ procedure TCopyTableForm.btnOKClick(Sender: TObject); Key: TTableKey; ForeignKey: TForeignKey; ClausePattern: String; + NewObj: TDBObject; begin // Compose and run CREATE query @@ -415,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 @@ -487,7 +488,13 @@ procedure TCopyTableForm.btnOKClick(Sender: TObject); end; // actRefresh takes care of whether the table editor is open // See also issue #1597 - MainForm.actRefresh.Execute + MainForm.actRefresh.Execute; + // Select it in tree + NewObj := TDBObject.Create(FDBObj.Connection); + NewObj.NodeType := lntTable; + NewObj.Database := comboDatabase.Text; + NewObj.Name := editNewTablename.Text; + MainForm.ActiveDbObj := NewObj; except on E:EDbError do begin Screen.Cursor := crDefault; 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 cb1883991..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; @@ -166,6 +171,7 @@ TDBObject = class(TPersistent) FCreateCodeLoaded: Boolean; FWasSelected: Boolean; FConnection: TDBConnection; + FMap: TStringMap; function GetObjType: String; function GetImageIndex: Integer; function GetOverlayImageIndex: Integer; @@ -181,10 +187,11 @@ TDBObject = class(TPersistent) Rows, Size, Version, AvgRowLen, MaxDataLen, IndexLen, DataLen, DataFree, AutoInc, CheckSum: Int64; // Routine options: Body, Definer, Returns, DataAccess, Security, ArgTypes: String; - Deterministic, RowsAreExact: Boolean; + Deterministic, RowsAreExact, IsMaterialized: Boolean; NodeType, GroupType: TListNodeType; constructor Create(OwnerConnection: TDBConnection); + destructor Destroy; procedure Assign(Source: TPersistent); override; procedure UnloadDetails; procedure Drop; @@ -197,6 +204,7 @@ TDBObject = class(TPersistent) function RowCount(Reload: Boolean; ForceExact: Boolean=False): Int64; function GetCreateCode: String; overload; function GetCreateCode(RemoveAutoInc, RemoveDefiner: Boolean): String; overload; + function AsStringMap: TStringMap; property ObjType: String read GetObjType; property ImageIndex: Integer read GetImageIndex; property OverlayImageIndex: Integer read GetOverlayImageIndex; @@ -295,29 +303,6 @@ TSQLFunctionList = class(TObjectList) { TConnectionParameters and friends } - TNetType = ( - ntMySQL_TCPIP, - ntMySQL_NamedPipe, - ntMySQL_SSHtunnel, - ntMSSQL_NamedPipe, - ntMSSQL_TCPIP, - ntMSSQL_SPX, - ntMSSQL_VINES, - ntMSSQL_RPC, - ntPgSQL_TCPIP, - ntPgSQL_SSHtunnel, - ntSQLite, - ntMySQL_ProxySQLAdmin, - ntInterbase_TCPIP, - ntInterbase_Local, - ntFirebird_TCPIP, - ntFirebird_Local, - ntMySQL_RDS, - ntSQLiteEncrypted - ); - TNetTypeGroup = (ngMySQL, ngMSSQL, ngPgSQL, ngSQLite, ngInterbase); - TNetTypeLibs = TDictionary; - TConnectionParameters = class(TObject) strict private FDeleteAfterUse: Boolean; @@ -329,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; @@ -394,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; @@ -440,23 +426,20 @@ TDBLogItem = class(TObject) TDBLogEvent = procedure(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil) of object; TDBEvent = procedure(Connection: TDBConnection; Database: String) of object; TDBDataTypeArray = Array of TDBDataType; - TSQLSpecifityId = (spDatabaseTable, spDatabaseTableId, spDatabaseDrop, - spDbObjectsTable, spDbObjectsCreateCol, spDbObjectsUpdateCol, spDbObjectsTypeCol, - spEmptyTable, spRenameTable, spRenameView, spCurrentUserHost, spLikeCompare, - spAddColumn, spChangeColumn, spRenameColumn, spForeignKeyEventAction, - spGlobalStatus, spCommandsCounters, spSessionVariables, spGlobalVariables, - spISSchemaCol, - spUSEQuery, spKillQuery, spKillProcess, - spFuncLength, spFuncCeil, spFuncLeft, spFuncNow, spFuncLastAutoIncNumber, - spLockedTables, spDisableForeignKeyChecks, spEnableForeignKeyChecks, - spOrderAsc, spOrderDesc, - spForeignKeyDrop); - TFeatureOrRequirement = (frSrid, frTimezoneVar, frTemporalTypesFraction, frKillQuery, - frLockedTables, frShowCreateTrigger, frShowWarnings, frShowCollation, frShowCollationExtended, - frShowCharset, frIntegerDisplayWidth, frShowFunctionStatus, frShowProcedureStatus, - frShowTriggers, frShowEvents, frColumnDefaultParentheses, frForeignKeyChecksVar, - frHelpKeyword, frEditVariables, frCreateView, frCreateProcedure, frCreateFunction, - frCreateTrigger, frCreateEvent, frInvisibleColumns, frCompressedColumns); + TFeatureOrRequirement = ( + frSrid, + frTemporalTypesFraction, + frIntegerDisplayWidth, + frColumnDefaultParentheses, + frEditVariables, + frCreateView, + frCreateProcedure, + frCreateFunction, + frCreateTrigger, + frCreateEvent, + frInvisibleColumns, + frCompressedColumns + ); TDBConnection = class(TComponent) private @@ -465,6 +448,7 @@ TDBConnection = class(TComponent) FServerUptime: Integer; FServerDateTimeOnStartup: String; FParameters: TConnectionParameters; + FOwnsParameters: Boolean; FSecureShellCmd: TSecureShellCmd; FDatabase: String; FAllDatabases: TStringList; @@ -502,7 +486,7 @@ TDBConnection = class(TComponent) FQuoteChars: String; FDatatypes: TDBDataTypeArray; FThreadID: Int64; - FSQLSpecifities: Array[TSQLSpecifityId] of String; + FSqlProvider: TSqlProvider; FKeepAliveTimer: TTimer; FFavorites: TStringList; FPrefetchResults: TDBQueryList; @@ -512,6 +496,7 @@ TDBConnection = class(TComponent) FMaxRowsPerInsert: Int64; FCaseSensitivity: Integer; FSQLFunctions: TSQLFunctionList; + FNamedEnums: TStringList; procedure SetActive(Value: Boolean); virtual; abstract; procedure DoBeforeConnect; virtual; procedure StartSSHTunnel(var FinalHost: String; var FinalPort: Integer); @@ -548,7 +533,9 @@ TDBConnection = class(TComponent) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; - procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); virtual; + procedure Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); overload; virtual; + procedure Query(QueryId: TQueryId); overload; + procedure Query(QueryId: TQueryId; const Args: array of const); overload; procedure Log(Category: TDBLogCategory; Msg: String); function EscapeString(Text: String; ProcessJokerChars: Boolean=False; DoQuote: Boolean=True): String; overload; function EscapeString(Text: String; Datatype: TDBDatatype): String; overload; @@ -563,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; @@ -579,8 +567,6 @@ TDBConnection = class(TComponent) function GetSessionVariables(Refresh: Boolean): TDBQuery; function GetSessionVariable(VarName: String; DefaultValue: String=''; Refresh: Boolean=False): String; function MaxAllowedPacket: Int64; virtual; - function GetSQLSpecifity(Specifity: TSQLSpecifityId): String; overload; - function GetSQLSpecifity(Specifity: TSQLSpecifityId; const Args: array of const): String; overload; function GetDateTimeValue(Input: String; Datatype: TDBDatatypeIndex): String; procedure ClearDbObjects(db: String); procedure ClearAllDbObjects; @@ -593,6 +579,7 @@ TDBConnection = class(TComponent) function ApplyLimitClause(QueryType, QueryBody: String; Limit, Offset: Int64): String; function LikeClauseTail: String; property Parameters: TConnectionParameters read FParameters write FParameters; + property OwnsParameters: Boolean read FOwnsParameters write FOwnsParameters; property ThreadId: Int64 read GetThreadId; property ConnectionUptime: Integer read GetConnectionUptime; property ServerUptime: Integer read GetServerUptime; @@ -606,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; @@ -646,6 +634,9 @@ TDBConnection = class(TComponent) function IsNumeric(Text: String): Boolean; function IsHex(Text: String): Boolean; 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; @@ -678,10 +669,7 @@ TMySQLConnection = class(TDBConnection) function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; function GetTableEngines: TStringList; override; - function GetCollationTable: TDBQuery; override; - function GetCharsetTable: TDBQuery; override; function GetCreateViewCode(Database, Name: String): String; - function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public constructor Create(AOwner: TComponent); override; @@ -711,9 +699,6 @@ TAdoDBConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCollationTable: TDBQuery; override; - function GetCharsetTable: TDBQuery; override; - function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public constructor Create(AOwner: TComponent); override; @@ -743,7 +728,6 @@ TPgConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCharsetTable: TDBQuery; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; procedure Drop(Obj: TDBObject); override; public @@ -754,10 +738,8 @@ TPgConnection = class(TDBConnection) function Ping(Reconnect: Boolean): Boolean; override; function GetCreateCode(Obj: TDBObject): String; override; function ConnectionInfo: TStringList; override; - function GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; override; property LastRawResults: TPGRawResults read FLastRawResults; property RegClasses: TOidStringPairs read FRegClasses; - function GetTableColumns(Table: TDBObject): TTableColumnList; override; function GetTableKeys(Table: TDBObject): TTableKeyList; override; function GetTableForeignKeys(Table: TDBObject): TForeignKeyList; override; end; @@ -784,8 +766,6 @@ TSQLiteConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCollationList: TStringList; override; - function GetCharsetTable: TDBQuery; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public constructor Create(AOwner: TComponent); override; @@ -798,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; @@ -818,8 +799,6 @@ TInterbaseConnection = class(TDBConnection) function GetLastErrorCode: Cardinal; override; function GetLastErrorMsg: String; override; function GetAllDatabases: TStringList; override; - function GetCollationTable: TDBQuery; override; - function GetCharsetTable: TDBQuery; override; procedure FetchDbObjects(db: String; var Cache: TDBObjectList); override; public constructor Create(AOwner: TComponent); override; @@ -1045,6 +1024,8 @@ function mysql_authentication_dialog_ask( exports mysql_authentication_dialog_ask; +var + WarningShownOldOleProvider: Boolean = False; {$I const.inc} @@ -1432,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; @@ -1506,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 @@ -1582,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); @@ -2070,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 @@ -2144,6 +2130,7 @@ constructor TDBConnection.Create(AOwner: TComponent); begin inherited; FParameters := TConnectionParameters.Create; + FOwnsParameters := True; FRowsFound := 0; FRowsAffected := 0; FWarningCount := 0; @@ -2175,6 +2162,10 @@ constructor TDBConnection.Create(AOwner: TComponent); FCaseSensitivity := 0; FStringQuoteChar := ''''; FCollationTable := nil; + FCharsetTable := nil; + FQuoteChar := '"'; + FQuoteChars := '"[]'; + FNamedEnums := TStringList.Create; end; @@ -2199,8 +2190,6 @@ constructor TAdoDBConnection.Create(AOwner: TComponent); i: Integer; begin inherited; - FQuoteChar := '"'; - FQuoteChars := '"[]'; SetLength(FDatatypes, Length(MSSQLDatatypes)); for i:=0 to High(MSSQLDatatypes) do FDatatypes[i] := MSSQLDatatypes[i]; @@ -2214,7 +2203,6 @@ constructor TPgConnection.Create(AOwner: TComponent); i: Integer; begin inherited; - FQuoteChar := '"'; FQuoteChars := '"'; SetLength(FDatatypes, Length(PostGreSQLDatatypes)); for i:=0 to High(PostGreSQLDatatypes) do @@ -2231,8 +2219,6 @@ constructor TSQLiteConnection.Create(AOwner: TComponent); i: Integer; begin inherited; - FQuoteChar := '"'; - FQuoteChars := '"[]'; SetLength(FDatatypes, Length(SQLiteDatatypes)); for i:=0 to High(SQLiteDatatypes) do FDatatypes[i] := SQLiteDatatypes[i]; @@ -2246,8 +2232,6 @@ constructor TInterbaseConnection.Create(AOwner: TComponent); i: Integer; begin inherited; - FQuoteChar := '"'; - FQuoteChars := '"[]'; SetLength(FDatatypes, Length(InterbaseDatatypes)); for i:=0 to High(InterbaseDatatypes) do FDatatypes[i] := InterbaseDatatypes[i]; @@ -2262,7 +2246,9 @@ destructor TDBConnection.Destroy; FKeepAliveTimer.Free; FFavorites.Free; FInformationSchemaObjects.Free; - FParameters.Free; + FNamedEnums.Free; + if FOwnsParameters then + FreeAndNil(FParameters); inherited; end; @@ -2325,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 @@ -2377,26 +2365,17 @@ function TDBConnection.GetDatatypeByNativeType(NativeType: Integer; Identifier: i: Integer; rx: TRegExpr; TypeFound: Boolean; - TypeOid: String; begin rx := TRegExpr.Create; TypeFound := False; + for i:=0 to High(Datatypes) do begin - if Datatypes[i].NativeTypes = '?' then begin - // PG oid is set to be populated via '?' - Datatypes[i].NativeTypes := ''; - TypeOid := GetVar('SELECT oid FROM '+QuoteIdent('pg_type')+' WHERE '+QuoteIdent('typname')+' = '+EscapeString(Datatypes[i].Name.ToLower)); - if IsNumeric(TypeOid) then begin - Datatypes[i].NativeTypes := TypeOid; - Log(lcInfo, 'Found oid/NativeTypes of '+Datatypes[i].Name+' data type: '+Datatypes[i].NativeTypes); - end - else begin - Log(lcInfo, 'No support for '+Datatypes[i].Name+' data type on this server.'); - end; - end; - // Skip if native ids / oid's are (still) empty + // Skip if native ids / oid's are (yet) empty if Datatypes[i].NativeTypes.IsEmpty then Continue; + // Skip ? and e which have a special meaning + if Datatypes[i].NativeTypes.Length = 1 then + Continue; rx.Expression := '\b('+Datatypes[i].NativeTypes+')\b'; if rx.Exec(IntToStr(NativeType)) then begin Result := Datatypes[i]; @@ -2568,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 @@ -2685,7 +2666,7 @@ procedure TMySQLConnection.SetActive( Value: Boolean ); Log(lcInfo, _('Characterset')+': '+CharacterSet); FConnectionStarted := GetTickCount div 1000; FServerUptime := -1; - Status := GetResults(GetSQLSpecifity(spGlobalStatus)); + Status := GetResults(FSqlProvider.GetSql(qGlobalStatus)); while not Status.Eof do begin StatusName := LowerCase(Status.Col(0)); if (StatusName = 'uptime') or (StatusName = 'proxysql_uptime') then @@ -2694,7 +2675,7 @@ procedure TMySQLConnection.SetActive( Value: Boolean ); FIsSSL := Status.Col(1) <> ''; Status.Next; end; - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); FServerOS := GetSessionVariable('version_compile_os'); FRealHostname := GetSessionVariable('hostname'); FCaseSensitivity := MakeInt(GetSessionVariable('lower_case_table_names', IntToStr(FCaseSensitivity))); @@ -2751,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 := ''; @@ -2822,7 +2804,7 @@ procedure TAdoDBConnection.SetActive(Value: Boolean); except FServerUptime := -1; end; - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); // Microsoft SQL Server 2008 R2 (RTM) - 10.50.1600.1 (Intel X86) // Apr 2 2010 15:53:02 // Copyright (c) Microsoft Corporation @@ -2894,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 := 'postgres'; // Prepare special stuff for SSH tunnel FinalHost := FParameters.Hostname; @@ -2921,9 +2898,10 @@ procedure TPgConnection.SetActive(Value: Boolean); .AddPair('port', IntToStr(FinalPort)) .AddPair('user', FParameters.Username) .AddPair('password', FParameters.Password) - .AddPair('dbname', dbname) .AddPair('application_name', APPNAME) .AddPair('sslmode', 'disable'); + if 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 @@ -2972,7 +2950,8 @@ procedure TPgConnection.SetActive(Value: Boolean); raise EDbError.Create(Error, LastErrorCode, ErrorHint); end; FActive := True; - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + CharacterSet := 'UTF8'; + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); FServerVersionUntouched := GetVar('SELECT VERSION()'); FConnectionStarted := GetTickCount div 1000; Query('SET statement_timeout TO '+IntToStr(Parameters.QueryTimeout*1000)); @@ -3015,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; @@ -3024,6 +3004,14 @@ procedure TSQLiteConnection.SetActive(Value: Boolean); MainFile := IfThen(FileNames.Count>=1, FileNames[0], ''); if Value then begin + // Fixes "out of memory" crash in sqlite3_open, see issue #1367 + 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 + Log(lcInfo, f_('File does not yet exist, will be created now: %s', [MainFile])); + DoBeforeConnect; ConnectResult := FLib.sqlite3_open( @@ -3099,7 +3087,7 @@ procedure TSQLiteConnection.SetActive(Value: Boolean); Log(lcError, 'Could not enable load_extension()'); end; - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); FServerVersionUntouched := GetVar('SELECT sqlite_version()'); FConnectionStarted := GetTickCount div 1000; FServerUptime := -1; @@ -3206,7 +3194,7 @@ procedure TInterbaseConnection.SetActive(Value: Boolean); FActive := True; //! Query('PRAGMA busy_timeout='+(Parameters.QueryTimeout*1000).ToString); - FServerDateTimeOnStartup := GetVar('SELECT ' + GetSQLSpecifity(spFuncNow)); + FServerDateTimeOnStartup := GetVar('SELECT ' + FSqlProvider.GetSql(qFuncNow)); if Parameters.IsInterbase then FServerVersionUntouched := '' @@ -3280,10 +3268,15 @@ procedure TDBConnection.DoBeforeConnect; Dialog.lblPrompt.Caption := f_('Login to %s:', [FParameters.Hostname]); Dialog.editUsername.Text := FParameters.Username; Dialog.editPassword.Text := FParameters.Password; - Dialog.ShowModal; - FParameters.Username := Dialog.editUsername.Text; - FParameters.Password := Dialog.editPassword.Text; - Dialog.Free; + if Dialog.ShowModal = mrOk then begin + FParameters.Username := Dialog.editUsername.Text; + FParameters.Password := Dialog.editPassword.Text; + Dialog.Free; + end + else begin + Dialog.Free; + raise EDbError.Create(_('Login cancelled')); + end; end; // Prepare connection @@ -3301,160 +3294,20 @@ procedure TDBConnection.DoBeforeConnect; end; end; - FSQLSpecifities[spOrderAsc] := 'ASC'; - FSQLSpecifities[spOrderDesc] := 'DESC'; - FSQLSpecifities[spForeignKeyEventAction] := 'RESTRICT,CASCADE,SET NULL,NO ACTION'; - - case Parameters.NetTypeGroup of - ngMySQL: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP DATABASE %s'; - FSQLSpecifities[spEmptyTable] := 'TRUNCATE '; - FSQLSpecifities[spRenameTable] := 'RENAME TABLE %s TO %s'; - FSQLSpecifities[spRenameView] := FSQLSpecifities[spRenameTable]; - FSQLSpecifities[spCurrentUserHost] := 'SELECT CURRENT_USER()'; - FSQLSpecifities[spLikeCompare] := '%s LIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD COLUMN %s'; - FSQLSpecifities[spChangeColumn] := 'CHANGE COLUMN %s %s'; - FSQLSpecifities[spGlobalStatus] := IfThen( - Parameters.IsProxySQLAdmin, - 'SELECT * FROM stats_mysql_global', - 'SHOW /*!50002 GLOBAL */ STATUS' - ); - FSQLSpecifities[spCommandsCounters] := IfThen( - Parameters.IsProxySQLAdmin, - 'SELECT * FROM stats_mysql_commands_counters', - 'SHOW /*!50002 GLOBAL */ STATUS LIKE ''Com\_%''' - ); - FSQLSpecifities[spSessionVariables] := 'SHOW VARIABLES'; - FSQLSpecifities[spGlobalVariables] := 'SHOW GLOBAL VARIABLES'; - FSQLSpecifities[spISSchemaCol] := '%s_SCHEMA'; - FSQLSpecifities[spUSEQuery] := 'USE %s'; - if Parameters.NetType = ntMySQL_RDS then begin - FSQLSpecifities[spKillQuery] := 'CALL mysql.rds_kill_query(%d)'; - FSQLSpecifities[spKillProcess] := 'CALL mysql.rds_kill(%d)' - end - else begin - FSQLSpecifities[spKillQuery] := 'KILL %d'; // may be overwritten in DoAfterConnect - FSQLSpecifities[spKillProcess] := 'KILL %d'; - end; - FSQLSpecifities[spFuncLength] := 'LENGTH'; - FSQLSpecifities[spFuncCeil] := 'CEIL'; - FSQLSpecifities[spFuncLeft] := IfThen(Parameters.IsProxySQLAdmin, 'SUBSTR(%s, 1, %d)', 'LEFT(%s, %d)'); - FSQLSpecifities[spFuncNow] := IfThen(Parameters.IsProxySQLAdmin, 'CURRENT_TIMESTAMP', 'NOW()'); - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LAST_INSERT_ID()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := 'SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0'; - FSQLSpecifities[spEnableForeignKeyChecks] := 'SET FOREIGN_KEY_CHECKS=IFNULL(@OLD_FOREIGN_KEY_CHECKS, 1)'; - FSQLSpecifities[spForeignKeyDrop] := 'DROP FOREIGN KEY %s'; - end; - ngMSSQL: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP DATABASE %s'; - FSQLSpecifities[spEmptyTable] := 'DELETE FROM '; - FSQLSpecifities[spRenameTable] := 'EXEC sp_rename %s, %s'; - FSQLSpecifities[spRenameView] := FSQLSpecifities[spRenameTable]; - FSQLSpecifities[spCurrentUserHost] := 'SELECT SYSTEM_USER'; - FSQLSpecifities[spLikeCompare] := '%s LIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD %s'; - FSQLSpecifities[spChangeColumn] := 'ALTER COLUMN %s %s'; - FSQLSpecifities[spSessionVariables] := 'SELECT '+QuoteIdent('comment')+', '+QuoteIdent('value')+' FROM '+QuoteIdent('master')+'.'+QuoteIdent('dbo')+'.'+QuoteIdent('syscurconfigs')+' ORDER BY '+QuoteIdent('comment'); - FSQLSpecifities[spGlobalVariables] := FSQLSpecifities[spSessionVariables]; - FSQLSpecifities[spISSchemaCol] := '%s_CATALOG'; - FSQLSpecifities[spUSEQuery] := 'USE %s'; - FSQLSpecifities[spKillQuery] := 'KILL %d'; - FSQLSpecifities[spKillProcess] := 'KILL %d'; - FSQLSpecifities[spFuncLength] := 'LEN'; - FSQLSpecifities[spFuncCeil] := 'CEILING'; - FSQLSpecifities[spFuncLeft] := 'LEFT(%s, %d)'; - FSQLSpecifities[spFuncNow] := 'GETDATE()'; - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LAST_INSERT_ID()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := ''; - FSQLSpecifities[spEnableForeignKeyChecks] := ''; - FSQLSpecifities[spForeignKeyDrop] := 'DROP FOREIGN KEY %s'; - end; - ngPgSQL: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP SCHEMA %s'; - FSQLSpecifities[spEmptyTable] := 'DELETE FROM '; - FSQLSpecifities[spRenameTable] := 'ALTER TABLE %s RENAME TO %s'; - FSQLSpecifities[spRenameView] := 'ALTER VIEW %s RENAME TO %s'; - FSQLSpecifities[spCurrentUserHost] := 'SELECT CURRENT_USER'; - FSQLSpecifities[spLikeCompare] := '%s ILIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD %s'; - FSQLSpecifities[spChangeColumn] := 'ALTER COLUMN %s %s'; - FSQLSpecifities[spRenameColumn] := 'RENAME COLUMN %s TO %s'; - FSQLSpecifities[spForeignKeyEventAction] := 'RESTRICT,CASCADE,SET NULL,NO ACTION,SET DEFAULT'; - FSQLSpecifities[spSessionVariables] := 'SHOW ALL'; - FSQLSpecifities[spGlobalVariables] := FSQLSpecifities[spSessionVariables]; - FSQLSpecifities[spISSchemaCol] := '%s_schema'; - FSQLSpecifities[spUSEQuery] := 'SET search_path TO %s'; - FSQLSpecifities[spKillQuery] := 'SELECT pg_cancel_backend(%d)'; - FSQLSpecifities[spKillProcess] := 'SELECT pg_cancel_backend(%d)'; - FSQLSpecifities[spFuncLength] := 'LENGTH'; - FSQLSpecifities[spFuncCeil] := 'CEIL'; - FSQLSpecifities[spFuncLeft] := 'SUBSTRING(%s, 1, %d)'; - FSQLSpecifities[spFuncNow] := 'NOW()'; - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LASTVAL()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := ''; - FSQLSpecifities[spEnableForeignKeyChecks] := ''; - FSQLSpecifities[spForeignKeyDrop] := 'DROP CONSTRAINT %s'; - end; - ngSQLite: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP DATABASE %s'; - FSQLSpecifities[spEmptyTable] := 'DELETE FROM '; - FSQLSpecifities[spRenameTable] := 'ALTER TABLE %s RENAME TO %s'; - FSQLSpecifities[spRenameView] := FSQLSpecifities[spRenameTable]; - FSQLSpecifities[spCurrentUserHost] := ''; // unsupported - FSQLSpecifities[spLikeCompare] := '%s LIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD COLUMN %s'; - FSQLSpecifities[spChangeColumn] := ''; // SQLite only supports renaming - FSQLSpecifities[spRenameColumn] := 'RENAME COLUMN %s TO %s'; - FSQLSpecifities[spSessionVariables] := 'SELECT null, null'; // Todo: combine "PRAGMA pragma_list" + "PRAGMA a; PRAGMY b; ..."? - FSQLSpecifities[spGlobalVariables] := 'SHOW GLOBAL VARIABLES'; - FSQLSpecifities[spISSchemaCol] := '%s_SCHEMA'; - FSQLSpecifities[spUSEQuery] := ''; - FSQLSpecifities[spKillQuery] := 'KILL %d'; - FSQLSpecifities[spKillProcess] := 'KILL %d'; - FSQLSpecifities[spFuncLength] := 'LENGTH'; - FSQLSpecifities[spFuncCeil] := 'CEIL'; - FSQLSpecifities[spFuncLeft] := 'SUBSTR(%s, 1, %d)'; - FSQLSpecifities[spFuncNow] := 'DATETIME()'; - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LAST_INSERT_ID()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := ''; - FSQLSpecifities[spEnableForeignKeyChecks] := ''; - FSQLSpecifities[spForeignKeyDrop] := 'DROP FOREIGN KEY %s'; - end; - ngInterbase: begin - FSQLSpecifities[spDatabaseDrop] := 'DROP DATABASE %s'; - FSQLSpecifities[spEmptyTable] := 'TRUNCATE '; - FSQLSpecifities[spRenameTable] := 'RENAME TABLE %s TO %s'; - FSQLSpecifities[spRenameView] := FSQLSpecifities[spRenameTable]; - if Self.Parameters.LibraryOrProvider = 'IB' then - FSQLSpecifities[spCurrentUserHost] := 'select user from rdb$database' - else - FSQLSpecifities[spCurrentUserHost] := 'select current_user || ''@'' || mon$attachments.mon$remote_host from mon$attachments where mon$attachments.mon$attachment_id = current_connection'; - FSQLSpecifities[spLikeCompare] := '%s LIKE %s'; - FSQLSpecifities[spAddColumn] := 'ADD COLUMN %s'; - FSQLSpecifities[spChangeColumn] := 'CHANGE COLUMN %s %s'; - FSQLSpecifities[spRenameColumn] := ''; - FSQLSpecifities[spSessionVariables] := 'SHOW VARIABLES'; - FSQLSpecifities[spGlobalVariables] := 'SHOW GLOBAL VARIABLES'; - FSQLSpecifities[spISSchemaCol] := '%s_SCHEMA'; - FSQLSpecifities[spUSEQuery] := ''; - FSQLSpecifities[spKillQuery] := 'KILL %d'; - FSQLSpecifities[spKillProcess] := 'KILL %d'; - FSQLSpecifities[spFuncLength] := 'LENGTH'; - FSQLSpecifities[spFuncCeil] := 'CEIL'; - FSQLSpecifities[spFuncLeft] := 'SUBSTR(%s, 1, %d)'; - FSQLSpecifities[spFuncNow] := ' cast(''now'' as timestamp) from rdb$database'; - FSQLSpecifities[spFuncLastAutoIncNumber] := 'LAST_INSERT_ID()'; - FSQLSpecifities[spLockedTables] := ''; - FSQLSpecifities[spDisableForeignKeyChecks] := ''; - FSQLSpecifities[spEnableForeignKeyChecks] := ''; - FSQLSpecifities[spForeignKeyDrop] := 'DROP FOREIGN KEY %s'; - end; - + // Create SQL provider + case FParameters.NetTypeGroup of + ngMySQL: + FSqlProvider := TMySqlProvider.Create(FParameters.NetType); + ngMSSQL: + FSqlProvider := TMsSqlProvider.Create(FParameters.NetType); + ngPgSQL: + FSqlProvider := TPostgreSQLProvider.Create(FParameters.NetType); + ngSQLite: + FSqlProvider := TSQLiteProvider.Create(FParameters.NetType); + ngInterbase: + FSqlProvider := TInterbaseProvider.Create(FParameters.NetType); + else + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(FParameters.NetType)]); end; end; @@ -3465,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); @@ -3480,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); @@ -3511,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 @@ -3553,9 +3406,60 @@ procedure TDBConnection.EndSSHTunnel; procedure TDBConnection.DoAfterConnect; var + i: Integer; + TypeOid: String; + AllEnums: TDBQuery; + AllEnumsList: TStringList; SQLFunctionsFileOrder: String; MajorMinorVer, MajorVer: String; + StartupScript: String; + StartupBatch: TSQLBatch; + SqlQuery: TSQLSentence; + TZI: TTimeZoneInformation; + Minutes, Hours: Integer; + Offset: String; begin + FSqlProvider.ServerVersion := ServerVersionInt; + + for i:=0 to High(Datatypes) do begin + + if Datatypes[i].NativeTypes = '?' then begin + // PG oid is set to be populated via '?' + TypeOid := GetVar('SELECT oid FROM '+QuoteIdent('pg_type')+' WHERE '+QuoteIdent('typname')+' = '+EscapeString(Datatypes[i].Name.ToLower)); + if IsNumeric(TypeOid) then begin + Datatypes[i].NativeTypes := TypeOid; + Log(lcInfo, 'Found oid/NativeTypes of '+Datatypes[i].Name+' data type: '+Datatypes[i].NativeTypes); + end + else begin + Log(lcInfo, 'No support for '+Datatypes[i].Name+' data type on this server.'); + end; + end + + else if (Datatypes[i].NativeTypes = 'e') and FSqlProvider.Has(qGetEnumTypes) then begin + // PG ENUM types populated via 'e' + AllEnums := GetResults(FSqlProvider.GetSql(qGetEnumTypes)); + AllEnumsList := TStringList.Create; + while not AllEnums.Eof do begin + AllEnumsList.Add(AllEnums.Col('enum_name')); + AllEnumsList.Add(AllEnums.Col('enum_schema') + '.' + AllEnums.Col('enum_name')); + FNamedEnums.AddPair( + AllEnums.Col('enum_name'), + AllEnums.Col('enum_labels') + ); + FNamedEnums.AddPair( + AllEnums.Col('enum_schema') + '.' + AllEnums.Col('enum_name'), + AllEnums.Col('enum_labels') + ); + AllEnums.Next; + end; + AllEnums.Free; + Datatypes[i].Names := Implode('|', AllEnumsList); + AllEnumsList.Free; + end; + + end; + + AppSettings.SessionPath := FParameters.SessionPath; AppSettings.WriteString(asServerVersionFull, FServerVersionUntouched); FParameters.ServerVersion := FServerVersionUntouched; @@ -3587,20 +3491,9 @@ procedure TDBConnection.DoAfterConnect; else SQLFunctionsFileOrder := ''; FSQLFunctions := TSQLFunctionList.Create(Self, SQLFunctionsFileOrder); -end; - - -procedure TMySQLConnection.DoAfterConnect; -var - TZI: TTimeZoneInformation; - Minutes, Hours, i: Integer; - Offset: String; - ObjNames: TStringList; -begin - inherited; // Set timezone offset to UTC - if Has(frTimezoneVar) and Parameters.LocalTimeZone then begin + if FSqlProvider.Has(qSetTimezone) and Parameters.LocalTimeZone then begin Minutes := 0; case GetTimeZoneInformation(TZI) of TIME_ZONE_ID_STANDARD: Minutes := (TZI.Bias + TZI.StandardBias); @@ -3615,9 +3508,36 @@ procedure TMySQLConnection.DoAfterConnect; else Offset := '-'; Offset := Offset + Format('%.2d:%.2d', [Abs(Hours), Abs(Minutes)]); - Query('SET time_zone='+EscapeString(Offset)); + Query(qSetTimezone, [EscapeString(Offset)]); end; + // Process startup script + StartupScript := Trim(FParameters.StartupScriptFilename); + if StartupScript <> '' then begin + StartupScript := ExpandFileName(StartupScript); + if not FileExists(StartupScript) then + Log(lcError, f_('Startup script file not found: %s', [StartupScript])) + else begin + StartupBatch := TSQLBatch.Create(FParameters.NetTypeGroup); + StartupBatch.SQL := ReadTextfile(StartupScript, nil); + for SqlQuery in StartupBatch do try + Query(SqlQuery.SQL); + except + // Suppress popup, errors get logged into SQL log + end; + StartupBatch.Free; + end; + end; +end; + + +procedure TMySQLConnection.DoAfterConnect; +var + ObjNames: TStringList; + i: Integer; +begin + inherited; + // Support microseconds in some temporal datatypes of MariaDB 5.3+ and MySQL 5.6 if Has(frTemporalTypesFraction) then begin for i:=Low(FDatatypes) to High(FDatatypes) do begin @@ -3626,10 +3546,6 @@ procedure TMySQLConnection.DoAfterConnect; end; end; - if Has(frKillQuery) then begin - FSQLSpecifities[spKillQuery] := 'KILL QUERY %d'; - end; - // List of IS tables try ObjNames := GetCol('SHOW TABLES FROM '+QuoteIdent(FInfSch)); @@ -3637,34 +3553,12 @@ procedure TMySQLConnection.DoAfterConnect; ObjNames.Free; except // silently fail if IS does not exist, on super old servers end; - - if Has(frLockedTables) then - FSQLSpecifities[spLockedTables] := 'SHOW OPEN TABLES FROM %s WHERE '+QuoteIdent('in_use')+'!=0'; end; procedure TAdoDBConnection.DoAfterConnect; begin inherited; - // See http://sqlserverbuilds.blogspot.de/ - case ServerVersionInt of - 0..899: begin - FSQLSpecifities[spDatabaseTable] := QuoteIdent('master')+'..'+QuoteIdent('sysdatabases'); - FSQLSpecifities[spDatabaseTableId] := QuoteIdent('dbid'); - FSQLSpecifities[spDbObjectsTable] := '..'+QuoteIdent('sysobjects'); - FSQLSpecifities[spDbObjectsCreateCol] := 'crdate'; - FSQLSpecifities[spDbObjectsUpdateCol] := ''; - FSQLSpecifities[spDbObjectsTypeCol] := 'xtype'; - end; - else begin - FSQLSpecifities[spDatabaseTable] := QuoteIdent('sys')+'.'+QuoteIdent('databases'); - FSQLSpecifities[spDatabaseTableId] := QuoteIdent('database_id'); - FSQLSpecifities[spDbObjectsTable] := '.'+QuoteIdent('sys')+'.'+QuoteIdent('objects'); - FSQLSpecifities[spDbObjectsCreateCol] := 'create_date'; - FSQLSpecifities[spDbObjectsUpdateCol] := 'modify_date'; - FSQLSpecifities[spDbObjectsTypeCol] := 'type'; - end; - end; // List of known IS tables FInformationSchemaObjects.CommaText := 'CHECK_CONSTRAINTS,'+ 'COLUMN_DOMAIN_USAGE,'+ @@ -3741,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 @@ -3812,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 @@ -3850,6 +3754,17 @@ procedure TDBConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogCate end; +procedure TDBConnection.Query(QueryId: TQueryId); +begin + Query(FSqlProvider.GetSql(QueryId)); +end; + +procedure TDBConnection.Query(QueryId: TQueryId; const Args: array of const); +begin + Query(FSqlProvider.GetSql(QueryId, Args)); +end; + + procedure TMySQLConnection.Query(SQL: String; DoStoreResult: Boolean=False; LogCategory: TDBLogCategory=lcSQL); var QueryStatus: Integer; @@ -4220,11 +4135,22 @@ function TPgConnection.GetCreateCode(Obj: TDBObject): String; case Obj.NodeType of lntView: begin // Prefer pg_catalog tables. See http://www.heidisql.com/forum.php?t=16213#p16685 - Result := 'CREATE VIEW ' + QuoteIdent(Obj.Name) + ' AS ' + GetVar('SELECT '+QuoteIdent('definition')+ - ' FROM '+QuoteIdent('pg_views')+ - ' WHERE '+QuoteIdent('viewname')+'='+EscapeString(Obj.Name)+ - ' AND '+QuoteIdent('schemaname')+'='+EscapeString(Obj.Schema) - ); + Result := 'CREATE VIEW ' + QuoteIdent(Obj.Name) + ' AS '; + if not Obj.IsMaterialized then begin // normal view + Result := Result + GetVar('SELECT '+QuoteIdent('definition')+ + ' FROM '+QuoteIdent('pg_views')+ + ' WHERE '+QuoteIdent('viewname')+'='+EscapeString(Obj.Name)+ + ' AND '+QuoteIdent('schemaname')+'='+EscapeString(Obj.Schema) + ); + end + else begin // materialized view + Result := Result + GetVar('SELECT '+QuoteIdent('definition')+ + ' FROM '+QuoteIdent('pg_matviews')+ + ' WHERE '+QuoteIdent('matviewname')+'='+EscapeString(Obj.Name)+ + ' AND '+QuoteIdent('schemaname')+'='+EscapeString(Obj.Schema) + ); + end; + end; lntFunction, lntProcedure: begin Result := 'CREATE '+Obj.GetObjType.ToUpper+' '+QuoteIdent(Obj.Name); @@ -4508,7 +4434,7 @@ procedure TDBConnection.PrefetchCreateCode(Objects: TDBObjectList); // SHOW CREATE TRIGGER was introduced in MySQL 5.1.21 // See #111 if Obj.NodeType = lntTrigger then - UseIt := UseIt and Has(frShowCreateTrigger); + UseIt := UseIt and FSqlProvider.Has(qShowCreateTrigger); if UseIt then Queries.Add('SHOW CREATE '+UpperCase(Obj.ObjType)+' '+QuoteIdent(Obj.Database)+'.'+QuoteIdent(Obj.Name)); end; @@ -4540,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 @@ -4560,9 +4485,8 @@ procedure TDBConnection.SetDatabase(Value: String); s := s + ', ' + EscapeString('public'); end else s := QuoteIdent(Value); - UseQuery := GetSQLSpecifity(spUSEQuery); - if not UseQuery.IsEmpty then begin - Query(GetSQLSpecifity(spUSEQuery, [s]), False); + if FSqlProvider.Has(qUSEQuery) then begin + Query(qUSEQuery, [s]); end; FDatabase := DeQuoteIdent(Value); if Assigned(FOnDatabaseChanged) then @@ -4593,7 +4517,7 @@ procedure TDBConnection.DetectUSEQuery(SQL: String); // Detect query for switching current working database or schema rx := TRegExpr.Create; rx.ModifierI := True; - rx.Expression := '^'+GetSQLSpecifity(spUSEQuery); + rx.Expression := '^'+FSqlProvider.GetSql(qUSEQuery); Quotes := QuoteRegExprMetaChars(FQuoteChars+''';'); rx.Expression := StringReplace(rx.Expression, ' ', '\s+', [rfReplaceAll]); rx.Expression := StringReplace(rx.Expression, '%s', '['+Quotes+']?([^'+Quotes+']+)['+Quotes+']*', [rfReplaceAll]); @@ -4702,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; @@ -4945,8 +4873,8 @@ procedure TMySQLConnection.ShowWarnings; begin // Log warnings // SHOW WARNINGS is implemented as of MySQL 4.1.0 - if (WarningCount > 0) and Has(frShowWarnings) then begin - Warnings := GetResults('SHOW WARNINGS'); + if (WarningCount > 0) and FSqlProvider.Has(qShowWarnings) then begin + Warnings := GetResults(FSqlProvider.GetSql(qShowWarnings)); while not Warnings.Eof do begin Log(lcError, _(Warnings.Col('Level')) + ': ('+Warnings.Col('Code')+') ' + Warnings.Col('Message')); Warnings.Next; @@ -5001,7 +4929,7 @@ function TAdoDBConnection.GetAllDatabases: TStringList; Result := inherited; if not Assigned(Result) then begin try - FAllDatabases := GetCol('SELECT '+QuoteIdent('name')+' FROM '+GetSQLSpecifity(spDatabaseTable)+' ORDER BY '+QuoteIdent('name')); + FAllDatabases := GetCol('SELECT '+QuoteIdent('name')+' FROM '+FSqlProvider.GetSql(qDatabaseTable)+' ORDER BY '+QuoteIdent('name')); except on E:EDbError do FAllDatabases := TStringList.Create; end; @@ -5329,11 +5257,13 @@ function TDBConnection.EscapeString(Text: String; ProcessJokerChars: Boolean=fal function TDBConnection.EscapeString(Text: String; Datatype: TDBDatatype): String; var DoQuote: Boolean; + ValuePrefix: String; const CategoriesNeedQuote = [dtcText, dtcBinary, dtcTemporal, dtcSpatial, dtcOther]; begin // Quote text based on the passed datatype DoQuote := Datatype.Category in CategoriesNeedQuote; + ValuePrefix := ''; case Datatype.Category of // Some special cases dtcBinary: begin @@ -5343,11 +5273,13 @@ function TDBConnection.EscapeString(Text: String; Datatype: TDBDatatype): String dtcInteger, dtcReal: begin if (not IsNumeric(Text)) and (not IsHex(Text)) then DoQuote := True; - if Datatype.Index = dbdtBit then + if (Datatype.Index = dbdtBit) and FParameters.IsAnyMySQL then begin DoQuote := True; + ValuePrefix := 'b'; + end; end; end; - Result := EscapeString(Text, False, DoQuote); + Result := ValuePrefix + EscapeString(Text, False, DoQuote); end; @@ -5582,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; @@ -5598,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; @@ -5705,56 +5643,14 @@ function TDBConnection.GetCollationTable: TDBQuery; begin Log(lcDebug, 'Fetching list of collations ...'); Ping(True); - Result := FCollationTable; -end; - - -function TMySQLConnection.GetCollationTable: TDBQuery; -begin - inherited; - if (not Assigned(FCollationTable)) and Has(frShowCollation) then begin - if Has(frShowCollationExtended) then try - // Issue #1917: MariaDB 10.10.1+ versions have additional collations in IS.COLLATION_CHARACTER_SET_APPLICABILITY - FCollationTable := GetResults('SELECT'+ - ' FULL_COLLATION_NAME AS '+QuoteIdent('Collation')+ - ', CHARACTER_SET_NAME AS '+QuoteIdent('Charset')+ - ', ID AS '+QuoteIdent('Id')+ - ', IS_DEFAULT AS '+QuoteIdent('Default')+ - ', 0 AS '+QuoteIdent('Sortlen')+ - ' FROM '+QuoteIdent(InfSch)+'.COLLATION_CHARACTER_SET_APPLICABILITY'+ - ' ORDER BY '+QuoteIdent('Collation') - ); + if (not Assigned(FCollationTable)) and FSqlProvider.Has(qGetCollations) then begin + if FSqlProvider.Has(qGetCollationsExtended) then try + FCollationTable := GetResults(FSqlProvider.GetSql(qGetCollationsExtended)); except on E:EDbError do; end; if not Assigned(FCollationTable) then - FCollationTable := GetResults('SHOW COLLATION'); - end; - if Assigned(FCollationTable) then - FCollationTable.First; - Result := FCollationTable; -end; - - -function TAdoDBConnection.GetCollationTable: TDBQuery; -begin - inherited; - if (not Assigned(FCollationTable)) then - FCollationTable := GetResults('SELECT '+EscapeString('')+' AS '+QuoteIdent('Collation')+', '+ - EscapeString('')+' AS '+QuoteIdent('Charset')+', 0 AS '+QuoteIdent('Id')+', '+ - EscapeString('')+' AS '+QuoteIdent('Default')+', '+EscapeString('')+' AS '+QuoteIdent('Compiled')+', '+ - '1 AS '+QuoteIdent('Sortlen')); - if Assigned(FCollationTable) then - FCollationTable.First; - Result := FCollationTable; -end; - - -function TInterbaseConnection.GetCollationTable: TDBQuery; -begin - inherited; - if not Assigned(FCollationTable) then begin - FCollationTable := GetResults('SELECT RDB$COLLATION_NAME AS '+QuoteIdent('Collation')+', RDB$COLLATION_ID AS '+QuoteIdent('Id')+', RDB$CHARACTER_SET_ID FROM RDB$COLLATIONS'); + FCollationTable := GetResults(FSqlProvider.GetSql(qGetCollations)); end; if Assigned(FCollationTable) then FCollationTable.First; @@ -5775,69 +5671,12 @@ function TDBConnection.GetCollationList: TStringList; end; -function TSQLiteConnection.GetCollationList: TStringList; -begin - // See https://www.sqlite.org/datatype3.html#collation_sequence_examples - Result := TStringList.Create; - Result.CommaText := 'nocase,binary,rtrim'; -end; - - function TDBConnection.GetCharsetTable: TDBQuery; begin Log(lcDebug, 'Fetching charset list ...'); Ping(True); - Result := nil; -end; - - -function TMySQLConnection.GetCharsetTable: TDBQuery; -begin - inherited; - if (not Assigned(FCharsetTable)) and Has(frShowCharset) then - FCharsetTable := GetResults('SHOW CHARSET'); - Result := FCharsetTable; -end; - - -function TAdoDBConnection.GetCharsetTable: TDBQuery; -begin - inherited; - if not Assigned(FCharsetTable) then - FCharsetTable := GetResults('SELECT '+QuoteIdent('name')+' AS '+QuoteIdent('Charset')+', '+QuoteIdent('description')+' AS '+QuoteIdent('Description')+ - ' FROM '+QuotedDbAndTableName('master', 'syscharsets') - ); - Result := FCharsetTable; -end; - - -function TPgConnection.GetCharsetTable: TDBQuery; -begin - inherited; - if not Assigned(FCharsetTable) then - FCharsetTable := GetResults('SELECT PG_ENCODING_TO_CHAR('+QuoteIdent('encid')+') AS '+QuoteIdent('Charset')+', '+EscapeString('')+' AS '+QuoteIdent('Description')+' FROM ('+ - 'SELECT '+QuoteIdent('conforencoding')+' AS '+QuoteIdent('encid')+' FROM '+QuoteIdent('pg_conversion')+', '+QuoteIdent('pg_database')+' '+ - 'WHERE '+QuoteIdent('contoencoding')+'='+QuoteIdent('encoding')+' AND '+QuoteIdent('datname')+'=CURRENT_DATABASE()) AS '+QuoteIdent('e') - ); - Result := FCharsetTable; -end; - - -function TSQLiteConnection.GetCharsetTable; -begin - inherited; - if not Assigned(FCharsetTable) then begin - //FCharsetTable := // Todo! - end; - Result := FCharsetTable; -end; - - -function TInterbaseConnection.GetCharsetTable: TDBQuery; -begin - inherited; - if not Assigned(FCharsetTable) then - FCharsetTable := GetResults('SELECT RDB$CHARACTER_SET_NAME AS '+QuoteIdent('Charset')+', RDB$CHARACTER_SET_NAME AS '+QuoteIdent('Description')+' FROM RDB$CHARACTER_SETS'); + if (not Assigned(FCharsetTable)) and FSqlProvider.Has(qGetCharsets) then + FCharsetTable := GetResults(FSqlProvider.GetSql(qGetCharsets)); Result := FCharsetTable; end; @@ -5865,7 +5704,7 @@ function TDBConnection.GetSessionVariables(Refresh: Boolean): TDBQuery; if (not Assigned(FSessionVariables)) or Refresh then begin if Assigned(FSessionVariables) then FreeAndNil(FSessionVariables); - FSessionVariables := GetResults(GetSQLSpecifity(spSessionVariables)); + FSessionVariables := GetResults(FSqlProvider.GetSql(qSessionVariables)); end; FSessionVariables.First; Result := FSessionVariables; @@ -5920,7 +5759,7 @@ function TDBConnection.GetLockedTableCount(db: String): Integer; begin // Find tables which are currently locked. // Used to prevent waiting time in GetDBObjects. - sql := GetSQLSpecifity(spLockedTables); + sql := FSqlProvider.GetSql(qLockedTables); Result := 0; if not sql.IsEmpty then try LockedTables := GetCol(Format(sql, [QuoteIdent(db,False)])); @@ -5987,19 +5826,27 @@ function TDBConnection.GetTableColumns(Table: TDBObject): TTableColumnList; TableIdx: Integer; ColQuery: TDBQuery; Col: TTableColumn; - dt, DefText, ExtraText, MaxLen: String; + dt, DefText, ExtraText, MaxLen, ColSQL: String; begin - // Generic: query table columns from IS.COLUMNS + // Generic: query table columns from IS.COLUMNS or query from provider Log(lcDebug, 'Getting fresh columns for '+Table.QuotedDbAndTableName); Result := TTableColumnList.Create(True); - TableIdx := InformationSchemaObjects.IndexOf('columns'); - if TableIdx = -1 then begin - // No is.columns table available - Exit; + + if FSqlProvider.Has(qGetTableColumns) then begin + ColSQL := FSqlProvider.GetSql(qGetTableColumns, [EscapeString(Table.Schema), EscapeString(Table.Name)]); + end + else begin + TableIdx := InformationSchemaObjects.IndexOf('columns'); + if TableIdx = -1 then begin + // No is.columns table available + Exit; + end; + ColSQL := 'SELECT * FROM '+QuoteIdent(InfSch)+'.'+QuoteIdent(InformationSchemaObjects[TableIdx])+ + ' WHERE '+Table.SchemaClauseIS('TABLE')+' AND TABLE_NAME='+EscapeString(Table.Name)+ + ' ORDER BY ORDINAL_POSITION'; end; - ColQuery := GetResults('SELECT * FROM '+QuoteIdent(InfSch)+'.'+QuoteIdent(InformationSchemaObjects[TableIdx])+ - ' WHERE '+Table.SchemaClauseIS('TABLE')+' AND TABLE_NAME='+EscapeString(Table.Name)+ - ' ORDER BY ORDINAL_POSITION'); + ColQuery := GetResults(ColSQL); + while not ColQuery.Eof do begin Col := TTableColumn.Create(Self); Result.Add(Col); @@ -6076,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; @@ -6164,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 @@ -6228,34 +6075,6 @@ function TAdoDBConnection.GetTableColumns(Table: TDBObject): TTableColumnList; end; -function TPgConnection.GetTableColumns(Table: TDBObject): TTableColumnList; -var - Comments: TDBQuery; - TableCol: TTableColumn; -begin - Result := inherited; - // Column comments in Postgre. See issue #859 - // Todo: add current schema to WHERE clause? - Comments := GetResults('SELECT a.attname AS column, des.description AS comment'+ - ' FROM pg_attribute AS a, pg_description AS des, pg_class AS pgc'+ - ' WHERE'+ - ' pgc.oid = a.attrelid'+ - ' AND des.objoid = pgc.oid'+ - ' AND pg_table_is_visible(pgc.oid)'+ - ' AND pgc.relname = '+EscapeString(Table.Name)+ - ' AND a.attnum = des.objsubid' - ); - while not Comments.Eof do begin - for TableCol in Result do begin - if TableCol.Name = Comments.Col('column') then begin - TableCol.Comment := Comments.Col('comment'); - Break; - end; - end; - Comments.Next; - end; -end; - function TSQLiteConnection.GetTableColumns(Table: TDBObject): TTableColumnList; var ColQuery: TDBQuery; @@ -6265,7 +6084,7 @@ function TSQLiteConnection.GetTableColumns(Table: TDBObject): TTableColumnList; // Todo: include database name // Todo: default values Result := TTableColumnList.Create(True); - ColQuery := GetResults('SELECT * FROM '+QuoteIdent(Table.Database)+'.pragma_table_xinfo('+EscapeString(Table.Name)+')'); + ColQuery := GetResults(FSqlProvider.GetSql(qGetTableColumns, [EscapeString(Table.Name), EscapeString(Table.Database)])); while not ColQuery.Eof do begin Col := TTableColumn.Create(Self); Result.Add(Col); @@ -6275,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 @@ -6295,24 +6118,7 @@ function TInterbaseConnection.GetTableColumns(Table: TDBObject): TTableColumnLis begin // Todo Result := TTableColumnList.Create(True); - ColQuery := GetResults('SELECT r.RDB$FIELD_NAME AS field_name,'+ - ' r.RDB$DESCRIPTION AS field_description,'+ - ' r.RDB$DEFAULT_VALUE AS field_default_value,'+ - ' r.RDB$NULL_FLAG AS null_flag,'+ - ' f.RDB$FIELD_LENGTH AS field_length,'+ - ' f.RDB$FIELD_PRECISION AS field_precision,'+ - ' f.RDB$FIELD_SCALE AS field_scale,'+ - ' f.RDB$FIELD_TYPE AS field_type,'+ - ' f.RDB$FIELD_SUB_TYPE AS field_subtype,'+ - ' coll.RDB$COLLATION_NAME AS field_collation,'+ - ' cset.RDB$CHARACTER_SET_NAME AS field_charset'+ - ' FROM RDB$RELATION_FIELDS r'+ - ' LEFT JOIN RDB$FIELDS f ON r.RDB$FIELD_SOURCE = f.RDB$FIELD_NAME'+ - ' LEFT JOIN RDB$CHARACTER_SETS cset ON f.RDB$CHARACTER_SET_ID = cset.RDB$CHARACTER_SET_ID'+ - ' LEFT JOIN RDB$COLLATIONS coll ON f.RDB$COLLATION_ID = coll.RDB$COLLATION_ID'+ - ' AND F.RDB$CHARACTER_SET_ID = COLL.RDB$CHARACTER_SET_ID'+ - ' WHERE r.RDB$RELATION_NAME='+EscapeString(Table.Name)+ - ' ORDER BY r.RDB$FIELD_POSITION'); + ColQuery := GetResults(FSqlProvider.GetSql(qGetTableColumns, [EscapeString(Table.Name)])); while not ColQuery.Eof do begin Col := TTableColumn.Create(Self); Result.Add(Col); @@ -6379,6 +6185,8 @@ function TMySQLConnection.GetTableKeys(Table: TDBObject): TTableKeyList; var KeyQuery, ColQuery: TDBQuery; NewKey: TTableKey; + SizeQuery: String; + SizeByIndex: TStringList; begin Result := TTableKeyList.Create(True); @@ -6429,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 @@ -6453,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')+')'); @@ -6552,7 +6375,7 @@ function TSQLiteConnection.GetTableKeys(Table: TDBObject): TTableKeyList; begin Result := TTableKeyList.Create(True); ColQuery := GetResults('SELECT * '+ - 'FROM '+QuoteIdent(Table.Database)+'.pragma_table_xinfo('+EscapeString(Table.Name)+') '+ + 'FROM pragma_table_xinfo('+EscapeString(Table.Name)+', '+EscapeString(Table.Database)+') '+ 'WHERE pk!=0 ORDER BY pk'); NewKey := nil; while not ColQuery.Eof do begin @@ -6572,7 +6395,7 @@ function TSQLiteConnection.GetTableKeys(Table: TDBObject): TTableKeyList; ColQuery.Free; KeyQuery := GetResults('SELECT * '+ - 'FROM '+QuoteIdent(Table.Database)+'.pragma_index_list('+EscapeString(Table.Name)+') '+ + 'FROM pragma_index_list('+EscapeString(Table.Name)+', '+EscapeString(Table.Database)+') '+ 'WHERE origin!='+EscapeString('pk')); while not KeyQuery.Eof do begin NewKey := TTableKey.Create(Self); @@ -6582,7 +6405,7 @@ function TSQLiteConnection.GetTableKeys(Table: TDBObject): TTableKeyList; NewKey.IndexType := IfThen(KeyQuery.Col('unique')='0', TTableKey.KEY, TTableKey.UNIQUE); NewKey.OldIndexType := NewKey.IndexType; ColQuery := GetResults('SELECT * '+ - 'FROM '+QuoteIdent(Table.Database)+'.pragma_index_info('+EscapeString(NewKey.Name)+')'); + 'FROM pragma_index_info('+EscapeString(NewKey.Name)+', '+EscapeString(Table.Database)+')'); while not ColQuery.Eof do begin NewKey.Columns.Add(ColQuery.Col('name')); NewKey.SubParts.Add(''); @@ -6678,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 @@ -6694,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; @@ -6714,37 +6541,56 @@ function TPgConnection.GetTableForeignKeys(Table: TDBObject): TForeignKeyList; // see #158 Result := TForeignKeyList.Create(True); try - ForeignQuery := GetResults('SELECT'+ - ' refc.constraint_name,'+ - ' refc.update_rule,'+ - ' refc.delete_rule,'+ - ' kcu.table_name,'+ - ' STRING_AGG(distinct kcu.column_name, '','') AS columns,'+ - ' ccu.table_schema AS ref_schema,'+ - ' ccu.table_name AS ref_table,'+ - ' STRING_AGG(distinct ccu.column_name, '','') AS ref_columns,'+ - ' STRING_AGG(distinct kcu.ordinal_position::text, '','') AS ord_position'+ - ' FROM'+ - ' '+InfSch+'.referential_constraints AS refc,'+ - ' '+InfSch+'.key_column_usage AS kcu,'+ - ' '+InfSch+'.constraint_column_usage AS ccu'+ - ' WHERE'+ - ' refc.constraint_schema = '+EscapeString(Table.Schema)+ - ' AND kcu.table_name = '+EscapeString(Table.Name)+ - ' AND kcu.constraint_name = refc.constraint_name'+ - ' AND kcu.table_schema = refc.constraint_schema'+ - ' AND ccu.constraint_name = refc.constraint_name'+ - ' AND ccu.constraint_schema = refc.constraint_schema'+ - ' GROUP BY'+ - ' refc.constraint_name,'+ - ' refc.update_rule,'+ - ' refc.delete_rule,'+ - ' kcu.table_name,'+ - ' ccu.table_schema,'+ - ' ccu.table_name'+ - ' ORDER BY'+ - ' ord_position' - ); + ForeignQuery := GetResults( + 'SELECT ' + + ' con.conname AS constraint_name, ' + + ' CASE con.confupdtype ' + + ' WHEN ''a'' THEN ''NO ACTION'' ' + + ' WHEN ''r'' THEN ''RESTRICT'' ' + + ' WHEN ''c'' THEN ''CASCADE'' ' + + ' WHEN ''n'' THEN ''SET NULL'' ' + + ' WHEN ''d'' THEN ''SET DEFAULT'' ' + + ' END AS update_rule, ' + + ' CASE con.confdeltype ' + + ' WHEN ''a'' THEN ''NO ACTION'' ' + + ' WHEN ''r'' THEN ''RESTRICT'' ' + + ' WHEN ''c'' THEN ''CASCADE'' ' + + ' WHEN ''n'' THEN ''SET NULL'' ' + + ' WHEN ''d'' THEN ''SET DEFAULT'' ' + + ' END AS delete_rule, ' + + ' src_ns.nspname AS table_schema, ' + + ' src_tbl.relname AS table_name, ' + + ' string_agg(src_col.attname, '','' ORDER BY ord.pos) AS columns, ' + + ' ref_ns.nspname AS ref_schema, ' + + ' ref_tbl.relname AS ref_table, ' + + ' string_agg(ref_col.attname, '','' ORDER BY ord.pos) AS ref_columns, ' + + ' string_agg(ord.pos::text, '','' ORDER BY ord.pos) AS ord_position ' + + 'FROM pg_constraint con ' + + 'JOIN pg_class src_tbl ON src_tbl.oid = con.conrelid ' + + 'JOIN pg_namespace src_ns ON src_ns.oid = src_tbl.relnamespace ' + + 'JOIN LATERAL unnest(con.conkey) WITH ORDINALITY AS ord(attnum, pos) ON TRUE ' + + 'JOIN pg_attribute src_col ON src_col.attrelid = src_tbl.oid AND src_col.attnum = ord.attnum ' + + 'JOIN pg_class ref_tbl ON ref_tbl.oid = con.confrelid ' + + 'JOIN pg_namespace ref_ns ON ref_ns.oid = ref_tbl.relnamespace ' + + 'JOIN LATERAL unnest(con.confkey) WITH ORDINALITY AS ref_ord(attnum, pos) ' + + ' ON ref_ord.pos = ord.pos ' + + 'JOIN pg_attribute ref_col ON ref_col.attrelid = ref_tbl.oid AND ref_col.attnum = ref_ord.attnum ' + + 'WHERE ' + + ' con.contype = ''f'' ' + + ' AND src_ns.nspname = '+EscapeString(Table.Schema) + + ' AND src_tbl.relname = '+EscapeString(Table.Name) + + 'GROUP BY ' + + ' con.conname, ' + + ' con.confupdtype, ' + + ' con.confdeltype, ' + + ' src_ns.nspname, ' + + ' src_tbl.relname, ' + + ' ref_ns.nspname, ' + + ' ref_tbl.relname ' + + 'ORDER BY ' + + ' MIN(ord.pos)' + ); + while not ForeignQuery.Eof do begin ForeignKey := TForeignKey.Create(Self); Result.Add(ForeignKey); @@ -6778,7 +6624,7 @@ function TSQLiteConnection.GetTableForeignKeys(Table: TDBObject): TForeignKeyLis // SQLite: query PRAGMA foreign_key_list Result := TForeignKeyList.Create(True); ForeignQuery := GetResults('SELECT * '+ - 'FROM '+QuoteIdent(Table.Database)+'.pragma_foreign_key_list('+EscapeString(Table.Name)+')'); + 'FROM pragma_foreign_key_list('+EscapeString(Table.Name)+', '+EscapeString(Table.Database)+')'); ForeignKey := nil; while not ForeignQuery.Eof do begin if (not Assigned(ForeignKey)) or (ForeignKey.KeyName <> ForeignQuery.Col('id')) then begin @@ -6839,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 @@ -6929,25 +6783,11 @@ function TDBConnection.Has(Item: TFeatureOrRequirement): Boolean; ngMySQL: case Item of frSrid: Result := FParameters.IsMySQL(True) and (ServerVersionInt >= 80000); - frTimezoneVar: Result := ServerVersionInt >= 40103; frTemporalTypesFraction: Result := (FParameters.IsMariaDB and (ServerVersionInt >= 50300)) or (FParameters.IsMySQL(True) and (ServerVersionInt >= 50604)); - frKillQuery: Result := (not FParameters.IsMySQLonRDS) and (ServerVersionInt >= 50000); - frLockedTables: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 50124); - frShowCreateTrigger: Result := ServerVersionInt >= 50121; - frShowWarnings: Result := ServerVersionInt >= 40100; - frShowCollation: Result := ServerVersionInt >= 40100; - frShowCollationExtended: Result := FParameters.IsMariaDB and (ServerVersionInt >= 101001); - frShowCharset: Result := ServerVersionInt >= 40100; frIntegerDisplayWidth: Result := (FParameters.IsMySQL(True) and (ServerVersionInt < 80017)) or (not FParameters.IsMySQL(True)); - frShowFunctionStatus: Result := (not Parameters.IsProxySQLAdmin) and (ServerVersionInt >= 50000); - frShowProcedureStatus: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 50000); - frShowTriggers: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 50010); - frShowEvents: Result := (not Parameters.IsProxySQLAdmin) and (ServerVersionInt >= 50100); frColumnDefaultParentheses: Result := FParameters.IsMySQL(True) and (ServerVersionInt >= 80013); - frForeignKeyChecksVar: Result := ServerVersionInt >= 40014; - frHelpKeyword: Result := (not FParameters.IsProxySQLAdmin) and (ServerVersionInt >= 40100); frEditVariables: Result := ServerVersionInt >= 40003; frCreateView: Result := ServerVersionInt >= 50001; frCreateProcedure: Result := ServerVersionInt >= 50003; @@ -6957,70 +6797,43 @@ 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; -function TDBConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; +procedure TDBConnection.GetColumnDefaultExpressions(Items: TStrings); var - Rows: String; + SQLFunc: TSQLFunction; begin - // Get row number from a table - Rows := GetVar('SELECT COUNT(*) FROM '+QuoteIdent(Obj.Database)+'.'+QuoteIdent(Obj.Name), 0); - Result := MakeInt(Rows); + for SQLFunc in SQLFunctions do begin + Items.Add(SQLFunc.Name + SQLFunc.Declaration); + end; end; -function TMySQLConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; +function TDBConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; var - Rows: String; + Rows, QueryApprox, QueryExact: String; + RowsColumn: Integer; begin - // Get row number from a mysql table - if Parameters.IsProxySQLAdmin or ForceExact then begin - Result := inherited + // Get row number from a table + QueryApprox := FSqlProvider.GetSql(qGetRowCountApprox, Obj.AsStringMap); + if QueryApprox.IsEmpty or ForceExact then begin + QueryExact := FSqlProvider.GetSql(qGetRowCountExact, Obj.AsStringMap); + Rows := GetVar(QueryExact); end else begin - Rows := GetVar('SHOW TABLE STATUS LIKE '+EscapeString(Obj.Name), 'Rows'); - Result := MakeInt(Rows); - end; -end; - - -function TAdoDBConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; -var - Rows: String; -begin - // Get row number from a mssql table - if ServerVersionInt >= 900 then begin - Rows := GetVar('SELECT SUM('+QuoteIdent('rows')+') FROM '+QuoteIdent('sys')+'.'+QuoteIdent('partitions')+ - ' WHERE '+QuoteIdent('index_id')+' IN (0, 1)'+ - ' AND '+QuoteIdent('object_id')+' = object_id('+EscapeString(Obj.Database+'.'+Obj.Schema+'.'+Obj.Name)+')' - ); - end else begin - Rows := GetVar('SELECT COUNT(*) FROM '+Obj.QuotedDbAndTableName); + // This is ugly: in MySQL 4.x we only have SHOW TABLE STATUS, which cannot be limited to the "Rows" column + RowsColumn := IfThen(QueryApprox.StartsWith('SHOW ', True), 4, 0); + Rows := GetVar(QueryApprox, RowsColumn); end; Result := MakeInt(Rows); end; -function TPgConnection.GetRowCount(Obj: TDBObject; ForceExact: Boolean=False): Int64; -var - Rows: String; -begin - // Get row number from a postgres table - Rows := GetVar('SELECT '+QuoteIdent('reltuples')+'::bigint FROM '+QuoteIdent('pg_class')+ - ' LEFT JOIN '+QuoteIdent('pg_namespace')+ - ' ON ('+QuoteIdent('pg_namespace')+'.'+QuoteIdent('oid')+' = '+QuoteIdent('pg_class')+'.'+QuoteIdent('relnamespace')+')'+ - ' WHERE '+QuoteIdent('pg_class')+'.'+QuoteIdent('relkind')+'='+EscapeString('r')+ - ' AND '+QuoteIdent('pg_namespace')+'.'+QuoteIdent('nspname')+'='+EscapeString(Obj.Database)+ - ' AND '+QuoteIdent('pg_class')+'.'+QuoteIdent('relname')+'='+EscapeString(Obj.Name) - ); - Result := MakeInt(Rows); -end; - - procedure TDBConnection.Drop(Obj: TDBObject); begin Query('DROP '+UpperCase(Obj.ObjType)+' '+Obj.QuotedName); @@ -7054,20 +6867,6 @@ procedure TPgConnection.Drop(Obj: TDBObject); end; -function TDBConnection.GetSQLSpecifity(Specifity: TSQLSpecifityId): String; -begin - // Return some version specific SQL clause or snippet - Result := FSQLSpecifities[Specifity]; -end; - - -function TDBConnection.GetSQLSpecifity(Specifity: TSQLSpecifityId; const Args: array of const): String; -begin - Result := GetSQLSpecifity(Specifity); - Result := Format(Result, Args); -end; - - function TDBConnection.ResultCount; begin case Parameters.NetTypeGroup of @@ -7125,8 +6924,8 @@ function TDBConnection.GetCurrentUserHostCombination: String; // Return current user@host combination, used by various object editors for DEFINER clauses Log(lcDebug, 'Fetching user@host ...'); Ping(True); - if FCurrentUserHostCombination.IsEmpty and (not GetSQLSpecifity(spCurrentUserHost).IsEmpty) then - FCurrentUserHostCombination := GetVar(GetSQLSpecifity(spCurrentUserHost)) + if FCurrentUserHostCombination.IsEmpty and (not FSqlProvider.GetSql(qCurrentUserHost).IsEmpty) then + FCurrentUserHostCombination := GetVar(FSqlProvider.GetSql(qCurrentUserHost)) else FCurrentUserHostCombination := ''; Result := FCurrentUserHostCombination; @@ -7458,8 +7257,8 @@ procedure TMySQLConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); end; // Stored functions - if Has(frShowFunctionStatus) then try - Results := GetResults('SHOW FUNCTION STATUS WHERE '+QuoteIdent('Db')+'='+EscapeString(db)); + if FSqlProvider.Has(qShowFunctionStatus) then try + Results := GetResults(FSqlProvider.GetSql(qShowFunctionStatus, [EscapeString(db)])); except on E:EDbError do; end; @@ -7479,8 +7278,8 @@ procedure TMySQLConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); end; // Stored procedures - if Has(frShowProcedureStatus) then try - Results := GetResults('SHOW PROCEDURE STATUS WHERE '+QuoteIdent('Db')+'='+EscapeString(db)); + if FSqlProvider.Has(qShowProcedureStatus) then try + Results := GetResults(FSqlProvider.GetSql(qShowProcedureStatus, [EscapeString(db)])); except on E:EDbError do; end; @@ -7500,8 +7299,8 @@ procedure TMySQLConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); end; // Triggers - if Has(frShowTriggers) then try - Results := GetResults('SHOW TRIGGERS FROM '+QuoteIdent(db)); + if FSqlProvider.Has(qShowTriggers) then try + Results := GetResults(FSqlProvider.GetSql(qShowTriggers, [QuoteIdent(db)])); except on E:EDbError do; end; @@ -7520,9 +7319,8 @@ procedure TMySQLConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); end; // Events - if Has(frShowEvents) then try - Results := GetResults('SELECT *, EVENT_SCHEMA AS '+QuoteIdent('Db')+', EVENT_NAME AS '+QuoteIdent('Name')+ - ' FROM '+InfSch+'.'+QuoteIdent('EVENTS')+' WHERE '+QuoteIdent('EVENT_SCHEMA')+'='+EscapeString(db)) + if FSqlProvider.Has(qShowEvents) then try + Results := GetResults(FSqlProvider.GetSql(qShowEvents, [EscapeString(db)])); except on E:EDbError do begin try @@ -7568,13 +7366,19 @@ procedure TAdoDBConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); // Tables, views and procedures Results := nil; // Schema support introduced in MSSQL 2005 (9.0). See issue #3212. + // RowsInTable added in 12.16 SchemaSelect := EscapeString(''); if ServerVersionInt >= 900 then SchemaSelect := 'SCHEMA_NAME('+QuoteIdent('schema_id')+')'; try - Results := GetResults('SELECT *, '+SchemaSelect+' AS '+EscapeString('schema')+ - ' FROM '+QuoteIdent(db)+GetSQLSpecifity(spDbObjectsTable)+ - ' WHERE '+QuoteIdent('type')+' IN ('+EscapeString('P')+', '+EscapeString('U')+', '+EscapeString('V')+', '+EscapeString('TR')+', '+EscapeString('FN')+', '+EscapeString('TF')+', '+EscapeString('IF')+')'); + Results := GetResults('SELECT o.*, '+SchemaSelect+' AS '+EscapeString('schema')+', rc.RowsInTable'+ + ' FROM '+QuoteIdent(db)+FSqlProvider.GetSql(qDbObjectsTable)+ ' AS o'+ + ' LEFT JOIN ('+ + ' SELECT object_id, SUM(rows) AS RowsInTable FROM '+QuoteIdent(db)+'.sys.partitions'+ + ' WHERE index_id IN (0,1)'+ // -- heap or clustered index + ' GROUP BY object_id'+ + ' ) AS rc ON rc.object_id = o.object_id'+ + ' WHERE o.'+QuoteIdent('type')+' IN ('+EscapeString('P')+', '+EscapeString('U')+', '+EscapeString('V')+', '+EscapeString('TR')+', '+EscapeString('FN')+', '+EscapeString('TF')+', '+EscapeString('IF')+')'); except on E:EDbError do; end; @@ -7583,11 +7387,11 @@ procedure TAdoDBConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); obj := TDBObject.Create(Self); Cache.Add(obj); obj.Name := Results.Col('name'); - obj.Created := ParseDateTime(Results.Col(GetSQLSpecifity(spDbObjectsCreateCol), True)); - obj.Updated := ParseDateTime(Results.Col(GetSQLSpecifity(spDbObjectsUpdateCol), True)); + obj.Created := ParseDateTime(Results.Col(FSqlProvider.GetSql(qDbObjectsCreateCol), True)); + obj.Updated := ParseDateTime(Results.Col(FSqlProvider.GetSql(qDbObjectsUpdateCol), True)); obj.Schema := Results.Col('schema'); obj.Database := db; - tp := Trim(Results.Col(GetSQLSpecifity(spDbObjectsTypeCol), True)); + tp := Trim(Results.Col(FSqlProvider.GetSql(qDbObjectsTypeCol), True)); if tp = 'U' then obj.NodeType := lntTable else if tp = 'P' then @@ -7598,6 +7402,8 @@ procedure TAdoDBConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); obj.NodeType := lntTrigger else if (tp = 'FN') or (tp = 'TF') or (tp = 'IF') then obj.NodeType := lntFunction; + obj.Rows := StrToInt64Def(Results.Col('RowsInTable'), -1); + obj.RowsAreExact := False; // approximate, not guaranteed exact. // Set reasonable default value for calculation of export chunks. See #343 // OFFSET..FETCH supported from v11.0/2012 // Disabled, leave at -1 and prefer a generic calculation in TfrmTableTools.DoExport @@ -7614,35 +7420,53 @@ procedure TPGConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); var obj: TDBObject; Results: TDBQuery; - tp, SchemaTable: String; - DataLenClause, IndexLenClause: String; + tp: String; + DataLenClause, IndexLenClause, ProKindClause: String; begin // Tables, views and procedures Results := nil; try - // See http://www.heidisql.com/forum.php?t=16429 - if ServerVersionInt >= 70300 then - SchemaTable := 'QUOTE_IDENT(t.TABLE_SCHEMA) || '+EscapeString('.')+' || QUOTE_IDENT(t.TABLE_NAME)' - else - SchemaTable := EscapeString(FQuoteChar)+' || t.TABLE_SCHEMA || '+EscapeString(FQuoteChar+'.'+FQuoteChar)+' || t.TABLE_NAME || '+EscapeString(FQuoteChar); // See http://www.heidisql.com/forum.php?t=16996 if Parameters.FullTableStatus and (ServerVersionInt >= 90000) then - DataLenClause := 'pg_table_size('+SchemaTable+')::bigint' + DataLenClause := 'pg_table_size(format(''%I.%I'', n.nspname, c.relname))::bigint' else DataLenClause := 'NULL'; // See https://www.heidisql.com/forum.php?t=34635 if Parameters.FullTableStatus and (ServerVersionInt >= 80100) then - IndexLenClause := 'pg_relation_size('+SchemaTable+')::bigint' + IndexLenClause := 'pg_relation_size(format(''%I.%I'', n.nspname, c.relname))::bigint' else IndexLenClause := 'relpages::bigint * '+SIZE_KB.ToString; - Results := GetResults('SELECT *,'+ - ' '+DataLenClause+' AS data_length,'+ - ' '+IndexLenClause+' AS index_length,'+ - ' c.reltuples, obj_description(c.oid) AS comment'+ - ' FROM '+QuoteIdent(InfSch)+'.'+QuoteIdent('tables')+' AS t'+ - ' LEFT JOIN '+QuoteIdent('pg_namespace')+' n ON t.table_schema = n.nspname'+ - ' LEFT JOIN '+QuoteIdent('pg_class')+' c ON n.oid = c.relnamespace AND c.relname=t.table_name'+ - ' WHERE t.'+QuoteIdent('table_schema')+'='+EscapeString(db) // Use table_schema when using schemata + if ServerVersionInt >= 110000 then + ProKindClause := 'p.prokind' + else + ProKindClause := EscapeString('p'); + Results := GetResults('SELECT '+ + ' n.nspname AS schema_name, '+ + ' c.relname AS object_name, '+ + ' c.relkind AS object_kind, '+ + ' '+DataLenClause+' AS data_length, '+ + ' '+IndexLenClause+' AS index_length, '+ + ' c.reltuples, '+ + ' obj_description(c.oid) AS comment, '+ + ' NULL AS proargtypes '+ + 'FROM pg_class c '+ + 'JOIN pg_namespace n ON n.oid = c.relnamespace '+ + 'WHERE n.nspname = '+EscapeString(db)+' '+ + ' AND c.relkind IN (''r'',''v'',''m'') '+ + 'UNION ALL '+ + 'SELECT '+ + ' n.nspname AS schema_name, '+ + ' p.proname AS object_name, '+ + ' '+ProKindClause+' AS object_kind, '+ + ' NULL::bigint AS data_length, '+ + ' NULL::bigint AS index_length, '+ + ' NULL::real AS reltuples, '+ + ' obj_description(p.oid) AS comment, '+ + ' p.proargtypes '+ + 'FROM pg_proc p '+ + 'JOIN pg_namespace n ON n.oid = p.pronamespace '+ + 'WHERE n.nspname = '+EscapeString(db)+' '+ + ' AND '+ProKindClause+' IN (''f'',''p'') ' ); except on E:EDbError do; @@ -7651,11 +7475,11 @@ procedure TPGConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); while not Results.Eof do begin obj := TDBObject.Create(Self); Cache.Add(obj); - obj.Name := Results.Col('table_name'); + obj.Name := Results.Col('object_name'); obj.Created := 0; obj.Updated := 0; obj.Database := db; - obj.Schema := Results.Col('table_schema'); // Remove when using schemata + obj.Schema := Results.Col('schema_name'); // Remove when using schemata obj.Comment := Results.Col('comment'); obj.Rows := StrToInt64Def(Results.Col('reltuples'), obj.Rows); obj.DataLen := StrToInt64Def(Results.Col('data_length'), obj.DataLen); @@ -7663,41 +7487,22 @@ procedure TPGConnection.FetchDbObjects(db: String; var Cache: TDBObjectList); obj.Size := obj.DataLen + obj.IndexLen; Inc(Cache.FDataSize, Obj.Size); Cache.FLargestObjectSize := Max(Cache.FLargestObjectSize, Obj.Size); - tp := Results.Col('table_type', True); - if tp = 'VIEW' then - obj.NodeType := lntView - else - obj.NodeType := lntTable; - Results.Next; - end; - FreeAndNil(Results); - end; - - // Stored functions and procedures in PostgreSQL. - // See http://dba.stackexchange.com/questions/2357/what-are-the-differences-between-stored-procedures-and-stored-functions - try - Results := GetResults('SELECT '+ - QuoteIdent('p')+'.'+QuoteIdent('proname')+', '+ - QuoteIdent('p')+'.'+QuoteIdent('proargtypes')+', '+ - QuoteIdent('p')+'.'+QuoteIdent('prokind')+' '+ - 'FROM '+QuoteIdent('pg_catalog')+'.'+QuoteIdent('pg_namespace')+' AS '+QuoteIdent('n')+' '+ - 'JOIN '+QuoteIdent('pg_catalog')+'.'+QuoteIdent('pg_proc')+' AS '+QuoteIdent('p')+' ON '+QuoteIdent('p')+'.'+QuoteIdent('pronamespace')+' = '+QuoteIdent('n')+'.'+QuoteIdent('oid')+' '+ - 'WHERE '+QuoteIdent('n')+'.'+QuoteIdent('nspname')+'='+EscapeString(db) - ); - except - on E:EDbError do; - end; - if Assigned(Results) then begin - while not Results.Eof do begin - obj := TDBObject.Create(Self); - Cache.Add(obj); - obj.Name := Results.Col('proname'); + tp := Results.Col('object_kind', True); + if tp = 'r' then + obj.NodeType := lntTable + else if tp = 'v' then begin + obj.NodeType := lntView; + obj.IsMaterialized := False; + end + else if tp = 'm' then begin + obj.NodeType := lntView; + obj.IsMaterialized := True; + end + else if tp = 'f' then + obj.NodeType := lntFunction + else if tp = 'p' then + obj.NodeType := lntProcedure; obj.ArgTypes := Results.Col('proargtypes'); - obj.Database := db; - if Results.Col('prokind') = 'p' then - obj.NodeType := lntProcedure - else - obj.NodeType := lntFunction; Results.Next; end; FreeAndNil(Results); @@ -7711,6 +7516,7 @@ procedure TSQLiteConnection.FetchDbObjects(db: String; var Cache: TDBObjectList) obj: TDBObject; Results: TDBQuery; TypeS: String; + UnionRowCount: TStringList; begin // Tables, views and procedures Results := nil; @@ -7741,6 +7547,34 @@ procedure TSQLiteConnection.FetchDbObjects(db: String; var Cache: TDBObjectList) Results.Next; end; FreeAndNil(Results); + + if FParameters.FullTableStatus then begin + UnionRowCount := TStringList.Create; + for obj in Cache do begin + if obj.NodeType <> lntTable then + Continue; + UnionRowCount.Add('SELECT '+EscapeString(obj.Name)+', COUNT(*) FROM '+QuoteIdent(obj.Database)+'.'+QuoteIdent(obj.Name)); + end; + if UnionRowCount.Count > 0 then + try + Results := GetResults(Implode(' UNION ', UnionRowCount)); + while not Results.Eof do begin + for obj in Cache do begin + if (obj.NodeType = lntTable) and (obj.Name = Results.Col(0)) then begin + obj.Rows := StrToInt64Def(Results.Col(1), -1); + obj.RowsAreExact := True; + break; + end; + end; + Results.Next; + end; + FreeAndNil(Results); + except + on E:EDbError do + Log(lcError, 'Full table status with row count not available in this database'); + end; + UnionRowCount.Free; + end; end; end; @@ -8041,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; @@ -8568,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; @@ -9232,8 +9068,9 @@ function TMySQLQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; end; end; - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + end + else + Result := TextInvalidColumn; end; @@ -9255,15 +9092,16 @@ function TAdoDBQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; except Result := String(FCurrentResults.Fields[Column].AsAnsiString); end; - if Datatype(Column).Index = dbdtBit then begin - if UpperCase(Result) = 'TRUE' then - Result := '1' - else - Result := '0'; - end end; - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + if Datatype(Column).Index = dbdtBit then begin + if (UpperCase(Result) = 'TRUE') or (Result = '1') then + Result := '1' + else + Result := '0'; + end + end + else + Result := TextInvalidColumn; end; @@ -9278,13 +9116,14 @@ 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; - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + end + else + Result := TextInvalidColumn; end; @@ -9296,8 +9135,9 @@ function TSQLiteQuery.Col(Column: Integer; IgnoreErrors: Boolean=False): String; end else begin Result := FCurrentResults[FRecNoLocal][Column].OldText; end; - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + end + else + Result := TextInvalidColumn; end; @@ -9309,8 +9149,9 @@ function TInterbaseQuery.Col(Column: Integer; IgnoreErrors: Boolean): String; end else begin Result := FCurrentResults.Fields[Column].AsString; end; - end else if not IgnoreErrors then - Raise EDbError.CreateFmt(_(MsgInvalidColumn), [Column, ColumnCount, RecordCount]); + end + else + Result := TextInvalidColumn; end; @@ -9323,8 +9164,8 @@ function TDBQuery.Col(ColumnName: String; IgnoreErrors: Boolean=False): String; idx := ColumnNames.IndexOf(ColumnName); if idx > -1 then Result := Col(idx) - else if not IgnoreErrors then - Raise EDbError.CreateFmt(_('Column "%s" not available.'), [ColumnName]); + else + Result := TextInvalidColumn; end; @@ -9391,19 +9232,33 @@ function TDBQuery.ValueList(Column: Integer): TStringList; i: Integer; begin Result := TStringList.Create; - Result.QuoteChar := ''''; - Result.Delimiter := ','; ColAttr := ColAttributes(Column); if Assigned(ColAttr) then case ColAttr.DataType.Index of + dbdtEnum, dbdtSet: begin - Result.DelimitedText := ColAttr.LengthSet; - // Take care for escaped ENUM definitions, see issue #799 + // Lool up PostgreSQL enum labels in prefetched list + i := FConnection.NamedEnums.IndexOfName(ColAttr.LengthSet); + if i > -1 then begin + Result.Delimiter := '|'; + Result.DelimitedText := FConnection.NamedEnums.ValueFromIndex[i]; + end + else begin + // .. or in MySQL Length/Set + Result.QuoteChar := ''''; + Result.Delimiter := ','; + Result.DelimitedText := ColAttr.LengthSet; + end; + // In any case, take care for escaped ENUM definitions, see issue #799 for i:=0 to Result.Count-1 do begin Result[i] := FConnection.UnescapeString(Result[i]); end; end; - dbdtBool: + + dbdtBool: begin + Result.Delimiter := ','; Result.DelimitedText := 'true,false'; + end; + end; end; @@ -9413,8 +9268,9 @@ function TDBQuery.ColAttributes(Column: Integer): TTableColumn; i: Integer; begin Result := nil; - if (Column < 0) or (Column >= FColumnOrgNames.Count) then - raise EDbError.CreateFmt(_('Column #%s not available.'), [IntToStr(Column)]); + if (Column < 0) or (Column >= FColumnOrgNames.Count) then begin + // Just return nil + end; if FColumns <> nil then begin for i:=0 to FColumns.Count-1 do begin if FColumns[i].Name = FColumnOrgNames[Column] then begin @@ -9729,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); @@ -9958,11 +9814,8 @@ function TDBQuery.SaveModifications: Boolean; else if Cell.NewIsFunction then Val := Cell.NewText else case Datatype(i).Category of - dtcInteger, dtcReal: begin + dtcInteger, dtcReal: Val := Connection.EscapeString(Cell.NewText, Datatype(i)); - if (Datatype(i).Index = dbdtBit) and FConnection.Parameters.IsAnyMySQL then - Val := 'b' + Val; - end; dtcBinary, dtcSpatial: Val := FConnection.EscapeBin(Cell.NewText); dtcTemporal: @@ -9985,7 +9838,7 @@ function TDBQuery.SaveModifications: Boolean; if Assigned(ColAttr) and (ColAttr.DefaultType = cdtAutoInc) then begin Row[i].NewText := UnformatNumber(Row[i].NewText); if Row[i].NewText = '0' then - Row[i].NewText := Connection.GetVar('SELECT ' + Connection.GetSQLSpecifity(spFuncLastAutoIncNumber)); + Row[i].NewText := Connection.GetVar('SELECT ' + Connection.SqlProvider.GetSql(qFuncLastAutoIncNumber)); Row[i].NewIsNull := False; break; end; @@ -9997,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; @@ -10340,7 +10193,7 @@ function TDBQuery.GetWhereClause: String; case DataType(j).Category of dtcInteger, dtcReal: begin if DataType(j).Index = dbdtBit then - Result := Result + '=b' + Connection.EscapeString(ColVal) + Result := Result + '=' + Connection.EscapeString(ColVal, DataType(j)) else begin // Guess (!) the default value silently inserted by the server. This is likely // to be incomplete in cases where a UNIQUE key allows NULL here @@ -10439,6 +10292,7 @@ function TDBObjectDropComparer.Compare(const Left, Right: TDBObject): Integer; constructor TDBObject.Create(OwnerConnection: TDBConnection); begin + // Take care, when adding properties here, add them in Assign() below as well Name := ''; Schema := ''; Database := ''; @@ -10469,12 +10323,20 @@ constructor TDBObject.Create(OwnerConnection: TDBConnection); ArgTypes := ''; Deterministic := False; RowsAreExact := False; + IsMaterialized := False; NodeType := lntNone; GroupType := lntNone; FCreateCode := ''; FCreateCodeLoaded := False; FWasSelected := False; FConnection := OwnerConnection; + FMap := TStringMap.Create; +end; + +destructor TDBObject.Destroy; +begin + FMap.Free; + inherited; end; @@ -10514,6 +10376,7 @@ procedure TDBObject.Assign(Source: TPersistent); ArgTypes := s.ArgTypes; Deterministic := s.Deterministic; RowsAreExact := s.RowsAreExact; + IsMaterialized := s.IsMaterialized; NodeType := s.NodeType; GroupType := s.GroupType; FCreateCode := s.FCreateCode; @@ -10753,7 +10616,7 @@ function TDBObject.SchemaClauseIS(Prefix: String): String; if Schema <> '' then Result := Prefix+'_SCHEMA' + '=' + Connection.EscapeString(Schema) else - Result := Connection.GetSQLSpecifity(spISSchemaCol, [Prefix]) + '=' + Connection.EscapeString(Database); + Result := Connection.SqlProvider.GetSql(qISSchemaCol, [Prefix]) + '=' + Connection.EscapeString(Database); end; function TDBObject.RowCount(Reload: Boolean; ForceExact: Boolean=False): Int64; @@ -10823,6 +10686,21 @@ function TDBObject.GetTableCheckConstraints: TCheckConstraintList; Result.Assign(CheckConstraintsInCache); end; +function TDBObject.AsStringMap: TStringMap; +begin + FMap.Clear; + FMap.Add('EscapedName', FConnection.EscapeString(Name)); + FMap.Add('EscapedSchema', FConnection.EscapeString(Schema)); + FMap.Add('EscapedDatabase', FConnection.EscapeString(Database)); + FMap.Add('EscapedDbSchemaName', FConnection.EscapeString(Database+'.'+Schema+'.'+Name)); + FMap.Add('QuotedDatabase', QuotedDatabase); + FMap.Add('QuotedName', QuotedName); + FMap.Add('QuotedDbAndTableName', QuotedDbAndTableName); + FMap.Add('ObjType', UpperCase(ObjType)); + Result := FMap; +end; + + { *** TTableColumn } @@ -10991,24 +10869,29 @@ function TTableColumn.SQLCode(OverrideCollation: String=''; Parts: TColumnParts= end; if InParts(cpType) then begin - case FConnection.Parameters.NetTypeGroup of - ngPgSQL: begin - if DefaultType = cdtAutoInc then - Result := Result + 'SERIAL' - else - Result := Result + DataType.Name; + + if FConnection.Parameters.IsAnyPostgreSQL and (DefaultType = cdtAutoInc) then begin + Result := Result + 'SERIAL'; + end + else begin + + if (DataType.Index = dbdtEnum) and (FConnection.NamedEnums.IndexOfName(LengthSet) > -1) then begin + Result := Result + LengthSet; + end + else begin + Result := Result + DataType.Name; + if (LengthSet <> '') and DataType.HasLength then + Result := Result + '(' + LengthSet + ')'; end; - else Result := Result + DataType.Name; + + if (DataType.Category in [dtcInteger, dtcReal]) and Unsigned then + Result := Result + ' UNSIGNED'; + if (DataType.Category in [dtcInteger, dtcReal]) and ZeroFill then + Result := Result + ' ZEROFILL'; + if Compressed and FConnection.Parameters.IsMariaDB then + Result := Result + ' /*!100301 COMPRESSED*/'; end; - if (LengthSet <> '') and DataType.HasLength then - Result := Result + '(' + LengthSet + ')'; - if (DataType.Category in [dtcInteger, dtcReal]) and Unsigned then - Result := Result + ' UNSIGNED'; - if (DataType.Category in [dtcInteger, dtcReal]) and ZeroFill then - Result := Result + ' ZEROFILL'; - if Compressed and FConnection.Parameters.IsMariaDB then - Result := Result + ' /*!100301 COMPRESSED*/'; Result := Result + ' '; // Add space after each part end; @@ -11034,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 @@ -11100,7 +10983,9 @@ procedure TTableColumn.ParseDatatype(Source: String); var InLiteral: Boolean; ParenthLeft, i: Integer; + OrgSource: String; begin + OrgSource := Source; DataType := Connection.GetDatatypeByName(Source, True); // Length / Set // Various datatypes, e.g. BLOBs, don't have any length property @@ -11118,6 +11003,11 @@ procedure TTableColumn.ParseDatatype(Source: String); LengthSet := ''; end else begin LengthSet := ''; + if DataType.Index = dbdtEnum then begin + // Assign PostgreSQL enum type to LengthSet, so we can provide it in table editor + // Some enum types are wrapped in double quotes + LengthSet := OrgSource.Trim([FConnection.QuoteChar]); + end; end; Unsigned := ExecRegExpr('\bunsigned\b', Source.ToLowerInvariant); ZeroFill := ExecRegExpr('\bzerofill\b', Source.ToLowerInvariant); @@ -11126,42 +11016,40 @@ 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; function TTableColumn.FullDataType: String; begin Result := DataType.Name; - if not LengthSet.IsEmpty then - Result := Result + '(' + LengthSet + ')'; + if not LengthSet.IsEmpty then begin + if (DataType.Index = dbdtEnum) and (FConnection.NamedEnums.IndexOfName(LengthSet) > -1) then + Result := LengthSet + else + Result := Result + '(' + LengthSet + ')'; + end; end; @@ -11190,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 } @@ -11204,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; @@ -11226,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); @@ -11343,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: @@ -11374,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 ad466f929..cadd7e8b2 100644 --- a/source/dbstructures.interbase.pas +++ b/source/dbstructures.interbase.pas @@ -4,7 +4,13 @@ interface uses - dbstructures; + dbstructures, StrUtils; + +type + TInterbaseProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; var @@ -171,4 +177,66 @@ interface implementation + +{ TInterbaseProvider } + +function TInterbaseProvider.GetSql(AId: TQueryId): string; +begin + case AId of + qDatabaseDrop: Result := 'DROP DATABASE %s'; + qEmptyTable: Result := 'TRUNCATE %s'; + qRenameTable: Result := 'RENAME TABLE %s TO %s'; + qRenameView: Result := 'RENAME TABLE %s TO %s'; + qCurrentUserHost: Result := IfThen( + FNetType in [ntInterbase_TCPIP, ntInterbase_Local], + 'select user from rdb$database', + 'select current_user || ''@'' || mon$attachments.mon$remote_host from mon$attachments where mon$attachments.mon$attachment_id = current_connection' + ); + qLikeCompare: Result := '%s LIKE %s'; + qAddColumn: Result := 'ADD COLUMN %s'; + qChangeColumn: Result := 'CHANGE COLUMN %s %s'; + qRenameColumn: Result := ''; + qSessionVariables: Result := 'SHOW VARIABLES'; + qGlobalVariables: Result := 'SHOW GLOBAL VARIABLES'; + qISSchemaCol: Result := '%s_SCHEMA'; + qUSEQuery: Result := ''; + qKillQuery: Result := 'KILL %d'; + qKillProcess: Result := 'KILL %d'; + qFuncLength: Result := 'LENGTH'; + qFuncCeil: Result := 'CEIL'; + qFuncLeft: Result := 'SUBSTR(%s, 1, %d)'; + qFuncNow: Result := ' cast(''now'' as timestamp) from rdb$database'; + qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; + qLockedTables: Result := ''; + qDisableForeignKeyChecks: Result := ''; + qEnableForeignKeyChecks: Result := ''; + qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + qGetTableColumns: Result := 'SELECT r.RDB$FIELD_NAME AS field_name,'+ + ' r.RDB$DESCRIPTION AS field_description,'+ + ' r.RDB$DEFAULT_VALUE AS field_default_value,'+ + ' r.RDB$NULL_FLAG AS null_flag,'+ + ' f.RDB$FIELD_LENGTH AS field_length,'+ + ' f.RDB$FIELD_PRECISION AS field_precision,'+ + ' f.RDB$FIELD_SCALE AS field_scale,'+ + ' f.RDB$FIELD_TYPE AS field_type,'+ + ' f.RDB$FIELD_SUB_TYPE AS field_subtype,'+ + ' coll.RDB$COLLATION_NAME AS field_collation,'+ + ' cset.RDB$CHARACTER_SET_NAME AS field_charset'+ + ' FROM RDB$RELATION_FIELDS r'+ + ' LEFT JOIN RDB$FIELDS f ON r.RDB$FIELD_SOURCE = f.RDB$FIELD_NAME'+ + ' LEFT JOIN RDB$CHARACTER_SETS cset ON f.RDB$CHARACTER_SET_ID = cset.RDB$CHARACTER_SET_ID'+ + ' LEFT JOIN RDB$COLLATIONS coll ON f.RDB$COLLATION_ID = coll.RDB$COLLATION_ID'+ + ' AND F.RDB$CHARACTER_SET_ID = COLL.RDB$CHARACTER_SET_ID'+ + ' WHERE r.RDB$RELATION_NAME=%s'+ + ' ORDER BY r.RDB$FIELD_POSITION'; + qGetCollations: Result := 'SELECT RDB$COLLATION_NAME AS "Collation",'+ + ' RDB$COLLATION_ID AS "Id",'+ + ' RDB$CHARACTER_SET_ID'+ + ' FROM RDB$COLLATIONS'; + qGetCharsets: Result := 'SELECT RDB$CHARACTER_SET_NAME AS "Charset", RDB$CHARACTER_SET_NAME AS "Description" FROM RDB$CHARACTER_SETS'; + else Result := inherited; + end; +end; + + end. \ No newline at end of file diff --git a/source/dbstructures.mssql.pas b/source/dbstructures.mssql.pas index 2072334ba..750e02b43 100644 --- a/source/dbstructures.mssql.pas +++ b/source/dbstructures.mssql.pas @@ -3,7 +3,13 @@ interface uses - dbstructures; + dbstructures, StrUtils, SysUtils; + +type + TMsSqlProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; var @@ -407,4 +413,103 @@ interface implementation +{$I const.inc} + +function TMsSqlProvider.GetSql(AId: TQueryId): string; +begin + case AId of + qDatabaseTable: Result := IfThen( + ServerVersion<=899, + 'master..sysdatabases', + 'sys.databases' + ); + qDatabaseTableId: Result := IfThen( + ServerVersion<=899, + 'dbid', + 'database_id' + ); + qDatabaseDrop: Result := 'DROP DATABASE %s'; + qDbObjectsTable: Result := IfThen( + ServerVersion<=899, + '..sysobjects', + '.sys.objects' + ); + qDbObjectsCreateCol: Result := IfThen( + ServerVersion<=899, + 'crdate', + 'create_date' + ); + qDbObjectsUpdateCol: Result := IfThen( + ServerVersion<=899, + '', + 'modify_date' + ); + qDbObjectsTypeCol: Result := IfThen( + ServerVersion<=899, + 'xtype', + 'type' + ); + 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'; + qUSEQuery: Result := 'USE %s'; + qKillQuery: Result := 'KILL %d'; + qKillProcess: Result := 'KILL %d'; + qFuncLength: Result := 'LEN'; + qFuncCeil: Result := 'CEILING'; + qFuncLeft: Result := 'LEFT(%s, %d)'; + qFuncNow: Result := 'GETDATE()'; + qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; + qLockedTables: Result := ''; + qDisableForeignKeyChecks: Result := ''; + qEnableForeignKeyChecks: Result := ''; + qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + qGetTableColumns: Result := ''; + qGetCollations: Result := 'SELECT '''' AS "Collation", '+ + ''''' AS "Charset", 0 AS "Id", '+ + ''''' AS "Default", '''' AS "Compiled", '+ + '1 AS "Sortlen"'; + qGetCharsets: Result := 'SELECT name AS Charset, description AS Description FROM master.sys.syscharsets'; + qGetRowCountApprox: Result := IfThen( + FServerVersion >= 900, + '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; + + end. diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas index 84cb90677..c872f0833 100644 --- a/source/dbstructures.mysql.pas +++ b/source/dbstructures.mysql.pas @@ -4,7 +4,7 @@ interface uses - System.Classes, System.SysUtils, dbstructures; + System.Classes, System.SysUtils, dbstructures, StrUtils; const @@ -318,13 +318,20 @@ TMySQLLib = class(TDbLib) constructor Create(DllFile, DefaultDll: String); override; function IsLibMariadb: Boolean; end; + + TMySqlProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; + + var MySQLKeywords: TStringList; MySQLErrorCodes: TStringList; // MySQL Data Type List and Properties - MySQLDatatypes: array [0..41] of TDBDatatype = + MySQLDatatypes: array [0..42] of TDBDatatype = ( ( Index: dbdtUnknown; @@ -353,6 +360,19 @@ TMySQLLib = class(TDbLib) LoadPart: False; Category: dtcInteger; ), + ( + Index: dbdtBool; + NativeType: 1; + Name: 'BOOLEAN'; + Description: 'Synonym of TINYINT(1)'; + HasLength: False; + RequiresLength: False; + MaxSize: 127; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), ( Index: dbdtSmallint; NativeType: 2; @@ -3215,6 +3235,211 @@ procedure TMySQLLib.AssignProcedures; end; +{ 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 %s'; + qRenameTable: Result := 'RENAME TABLE %s TO %s'; + qRenameView: Result := 'RENAME TABLE %s TO %s'; + qCurrentUserHost: Result := 'SELECT CURRENT_USER()'; + qLikeCompare: Result := '%s LIKE %s'; + qAddColumn: Result := 'ADD COLUMN %s'; + qChangeColumn: Result := 'CHANGE COLUMN %s %s'; + qGlobalStatus: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'SELECT * FROM stats_mysql_global', + 'SHOW /*!50002 GLOBAL */ STATUS' + ); + qCommandsCounters: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'SELECT * FROM stats_mysql_commands_counters', + 'SHOW /*!50002 GLOBAL */ STATUS LIKE ''Com\_%''' + ); + qSessionVariables: Result := 'SHOW VARIABLES'; + qGlobalVariables: Result := IfThen( + FServerVersion >= 40000, + 'SHOW GLOBAL VARIABLES', + '' + ); + qISSchemaCol: Result := '%s_SCHEMA'; + qUSEQuery: Result := 'USE %s'; + qKillQuery: Result := IfThen( + FNetType = ntMySQL_RDS, + 'CALL mysql.rds_kill_query(%d)', + IfThen( + FServerVersion >= 50000, + 'KILL QUERY %d', + 'KILL %d' + ) + ); + qKillProcess: Result := IfThen( + FNetType = ntMySQL_RDS, + 'CALL mysql.rds_kill(%d)', + 'KILL %d' + ); + qFuncLength: Result := 'LENGTH'; + qFuncCeil: Result := 'CEIL'; + qFuncLeft: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'SUBSTR(%s, 1, %d)', + 'LEFT(%s, %d)' + ); + qFuncNow: Result := IfThen( + FNetType = ntMySQL_ProxySQLAdmin, + 'CURRENT_TIMESTAMP', + 'NOW()' + ); + qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; + qLockedTables: Result := IfThen( + (FNetType <> ntMySQL_ProxySQLAdmin) and (FServerVersion >= 50124), + 'SHOW OPEN TABLES FROM %s WHERE in_use!=0', + '' + ); + qDisableForeignKeyChecks: Result := IfThen( + FServerVersion >= 40014, + 'SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0', + '' + ); + qEnableForeignKeyChecks: Result := IfThen( + FServerVersion >= 40014, + 'SET FOREIGN_KEY_CHECKS=IFNULL(@OLD_FOREIGN_KEY_CHECKS, 1)', + '' + ); + qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + qGetTableColumns: Result := ''; + qGetCollations: Result := IfThen( + FServerVersion >= 40100, + 'SHOW COLLATION', + '' + ); + // Issue #1917: MariaDB 10.10.1+ versions have additional collations in IS.COLLATION_CHARACTER_SET_APPLICABILITY + qGetCollationsExtended: Result := IfThen( + FServerVersion >= 101001, + 'SELECT'+ + ' FULL_COLLATION_NAME AS `Collation`'+ + ', CHARACTER_SET_NAME AS `Charset`'+ + ', ID AS `Id`'+ + ', IS_DEFAULT AS `Default`'+ + ', 0 AS `Sortlen`'+ + ' FROM INFORMATION_SCHEMA.COLLATION_CHARACTER_SET_APPLICABILITY'+ + ' ORDER BY `Collation`', + '' + ); + qGetCharsets: Result := IfThen( + FServerVersion >= 40100, + 'SHOW CHARSET', + '' + ); + qGetRowCountApprox: Result := IfThen( + FNetType <> ntMySQL_ProxySQLAdmin, + 'SHOW TABLE STATUS FROM :QuotedDatabase LIKE :EscapedName', + '' + ); + qGetReverseForeignKeys: Result := 'SELECT DISTINCT'+ + ' k.TABLE_SCHEMA, k.TABLE_NAME'+ + ' FROM INFORMATION_SCHEMA.KEY_COLUMN_USAGE k'+ + ' WHERE'+ + ' REFERENCED_TABLE_SCHEMA = :EscapedDatabase AND'+ + ' REFERENCED_TABLE_NAME = :EscapedName'; + qExplain: Result := IfThen( + (FServerVersion >= 80400) and (FServerVersion < 100000), // Not MariaDB + 'EXPLAIN FORMAT=TRADITIONAL %s', + 'EXPLAIN %s' + ); + qSetTimezone: Result := IfThen( + FServerVersion >= 40103, + 'SET time_zone=%s', + '' + ); + qShowFunctionStatus: Result := IfThen( + (FServerVersion >= 50000) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'SHOW FUNCTION STATUS WHERE LOWER(Db) = LOWER(%s)', + '' + ); + qShowProcedureStatus: Result := IfThen( + (FServerVersion >= 50000) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'SHOW PROCEDURE STATUS WHERE LOWER(Db) = LOWER(%s)', + '' + ); + qShowTriggers: Result := IfThen( + (FServerVersion >= 50010) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'SHOW TRIGGERS FROM %s', + '' + ); + qShowEvents: Result := IfThen( + (FServerVersion >= 50010) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'SELECT *, EVENT_SCHEMA AS `Db`, EVENT_NAME AS `Name` FROM INFORMATION_SCHEMA.`EVENTS` WHERE EVENT_SCHEMA=%s', + '' + ); + qHelpKeyword: Result := IfThen( + (FServerVersion >= 40100) and (FNetType <> ntMySQL_ProxySQLAdmin), + 'HELP %s', + '' + ); + qShowCreateTrigger: Result := IfThen( + FServerVersion >= 50121, + 'SHOW CREATE TRIGGER :QuotedDatabase.:QuotedName', + '' + ); + qShowWarnings: Result := IfThen( + FServerVersion >= 40100, + 'SHOW WARNINGS', + '' + ); + qDropUser: Result := IfThen( + FServerVersion < 40101, + 'DELETE FROM mysql.user WHERE User=%s AND Host=%s', + 'DROP USER %s@%s' + ); + 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; + + initialization // Keywords copied from SynHighligherSQL diff --git a/source/dbstructures.pas b/source/dbstructures.pas index b11070abb..8056bca0c 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -6,11 +6,69 @@ interface uses - gnugettext, Vcl.Graphics, Winapi.Windows, System.SysUtils, System.Classes, System.IOUtils; + gnugettext, Vcl.Graphics, Winapi.Windows, System.SysUtils, System.Classes, System.IOUtils, + System.Generics.Collections, StrUtils; type + TNetType = ( + ntMySQL_TCPIP, + ntMySQL_NamedPipe, + ntMySQL_SSHtunnel, + ntMSSQL_NamedPipe, + ntMSSQL_TCPIP, + ntMSSQL_SPX, + ntMSSQL_VINES, + ntMSSQL_RPC, + ntPgSQL_TCPIP, + ntPgSQL_SSHtunnel, + ntSQLite, + ntMySQL_ProxySQLAdmin, + ntInterbase_TCPIP, + ntInterbase_Local, + ntFirebird_TCPIP, + ntFirebird_Local, + ntMySQL_RDS, + ntSQLiteEncrypted + ); + TNetTypeGroup = (ngMySQL, ngMSSQL, ngPgSQL, ngSQLite, ngInterbase); + TNetTypeLibs = TDictionary; + + // SQL query ids and provider + TStringMap = TDictionary; + TQueryId = (qDatabaseTable, qDatabaseTableId, qDatabaseDrop, + qDbObjectsTable, qDbObjectsCreateCol, qDbObjectsUpdateCol, qDbObjectsTypeCol, + qEmptyTable, qRenameTable, qRenameView, qCurrentUserHost, qLikeCompare, + qAddColumn, qChangeColumn, qRenameColumn, qSetColumnComment, qForeignKeyEventAction, + qGlobalStatus, qCommandsCounters, qSessionVariables, qGlobalVariables, + qISSchemaCol, + qUSEQuery, qKillQuery, qKillProcess, + qFuncLength, qFuncCeil, qFuncLeft, qFuncNow, qFuncLastAutoIncNumber, + qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks, + qOrderAsc, qOrderDesc, qGetRowCountExact, qGetRowCountApprox, + qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets, + qGetReverseForeignKeys, qExplain, qSetTimezone, + qShowFunctionStatus, qShowProcedureStatus, qShowTriggers, qShowEvents, qShowCreateTrigger, + qHelpKeyword, qShowWarnings, qGetEnumTypes, + qDropUser, qCreateRole, qDropRole, qReloadPrivileges, qGrantRole, qRevokeRole, qSetDefaultRole, + qAutoInc, qIndexVisible, qIndexInvisible, qGetAuthPlugins, qCastAsText, qIndexSize); + TSqlProvider = class + strict protected + FNetType: TNetType; + FServerVersion: Integer; + public + constructor Create(ANetType: TNetType); + function Has(AId: TQueryId): Boolean; + // Base version, just returns the original SQL string + function GetSql(AId: TQueryId): string; overload; virtual; + // Version for simple strings passed to Format() + function GetSql(AId: TQueryId; const Args: array of const): string; overload; + // Version for named parameters + function GetSql(AId: TQueryId; NamedParameters: TStringMap): string; overload; + property ServerVersion: Integer read FServerVersion write FServerVersion; + end; + // Column types TDBDatatypeIndex = (dbdtTinyint, dbdtSmallint, dbdtMediumint, dbdtInt, dbdtUint, dbdtBigint, dbdtSerial, dbdtBigSerial, dbdtFloat, dbdtDouble, dbdtDecimal, dbdtNumeric, dbdtReal, dbdtDoublePrecision, dbdtMoney, dbdtSmallmoney, @@ -135,6 +193,54 @@ implementation uses apphelpers; +{ TSqlProvider } + +constructor TSqlProvider.Create(ANetType: TNetType); +begin + FNetType := ANetType; + FServerVersion := 0; +end; + +function TSqlProvider.Has(AId: TQueryId): Boolean; +begin + Result := not GetSql(AId).IsEmpty; +end; + +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; + +function TSqlProvider.GetSql(AId: TQueryId; const Args: array of const): string; +begin + Result := GetSql(AId); + if Result.IsEmpty then + Exit; + Result := Format(Result, Args); +end; + +function TSqlProvider.GetSql(AId: TQueryId; NamedParameters: TStringMap): string; +var + Key: String; +begin + Result := GetSql(AId); + if Result.IsEmpty then + Exit; + for Key in NamedParameters.Keys do begin + Result := StringReplace(Result, ':'+Key, NamedParameters[Key], [rfReplaceAll]); + end; +end; + + { EDbError } diff --git a/source/dbstructures.postgresql.pas b/source/dbstructures.postgresql.pas index 251c1a578..9489241ba 100644 --- a/source/dbstructures.postgresql.pas +++ b/source/dbstructures.postgresql.pas @@ -3,7 +3,7 @@ interface uses - dbstructures; + dbstructures, StrUtils; type // PostgreSQL structures @@ -36,10 +36,15 @@ TPostgreSQLLib = class(TDbLib) procedure AssignProcedures; override; end; + TPostgreSQLProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; + const InvalidOid: POid = 0; var - PostgreSQLDatatypes: Array[0..38] of TDBDatatype = + PostgreSQLDatatypes: Array[0..39] of TDBDatatype = ( ( Index: dbdtUnknown; @@ -504,6 +509,19 @@ TPostgreSQLLib = class(TDbLib) LoadPart: False; Category: dtcOther; ), + ( + Index: dbdtEnum; + NativeTypes: 'e'; + Name: 'ENUM'; + Names: ''; + Description: 'A list of quoted labels, each of which must be less than NAMEDATALEN bytes long (64 bytes in a standard PostgreSQL build)'; + HasLength: True; // Enables the Length/set field in table editor + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcOther; + ), ( Index: dbdtJson; NativeTypes: '114'; @@ -573,4 +591,163 @@ procedure TPostgreSQLLib.AssignProcedures; end; +{ TPostgreSQLProvider } + +function TPostgreSQLProvider.GetSql(AId: TQueryId): string; +begin + case AId of + qDatabaseDrop: Result := 'DROP SCHEMA %s'; + qRenameTable: Result := 'ALTER TABLE %s RENAME TO %s'; + qRenameView: Result := 'ALTER VIEW %s RENAME TO %s'; + qCurrentUserHost: Result := 'SELECT CURRENT_USER'; + qLikeCompare: Result := '%s ILIKE %s'; + qAddColumn: Result := 'ADD %s'; + qChangeColumn: Result := 'ALTER COLUMN %s %s'; + qRenameColumn: Result := 'RENAME COLUMN %s TO %s'; + qForeignKeyEventAction: Result := 'RESTRICT,CASCADE,SET NULL,NO ACTION,SET DEFAULT'; + qSessionVariables: Result := 'SHOW ALL'; + qGlobalVariables: Result := 'SHOW ALL'; + qISSchemaCol: Result := '%s_schema'; + qUSEQuery: Result := 'SET search_path TO %s'; + qKillQuery: Result := 'SELECT pg_cancel_backend(%d)'; + qKillProcess: Result := 'SELECT pg_cancel_backend(%d)'; + qFuncLength: Result := 'LENGTH'; + qFuncCeil: Result := 'CEIL'; + qFuncLeft: Result := 'SUBSTRING(%s, 1, %d)'; + qFuncNow: Result := 'NOW()'; + qFuncLastAutoIncNumber: Result := 'LASTVAL()'; + qLockedTables: Result := ''; + qDisableForeignKeyChecks: Result := ''; + qEnableForeignKeyChecks: Result := ''; + qForeignKeyDrop: Result := 'DROP CONSTRAINT %s'; + + // This uses pg_attribute.attgenerated, which only exists starting in PostgreSQL 12 + qGetTableColumns: Result := IfThen( + FServerVersion >= 120000, + 'SELECT ' + + ' n.nspname AS table_schema, ' + + ' c.relname AS table_name, ' + + ' a.attname AS column_name, ' + + ' a.attnum AS ordinal_position, ' + + ' pg_catalog.format_type(a.atttypid, a.atttypmod) AS data_type, ' + + // YES/NO like information_schema.is_nullable + ' CASE ' + + ' WHEN a.attnotnull THEN ''NO'' ' + + ' ELSE ''YES'' ' + + ' END AS is_nullable, ' + + // Character maximum length (in characters) + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' AND a.atttypmod <> -1 ' + + ' THEN a.atttypmod - 4 ' + + ' ELSE NULL ' + + ' END AS character_maximum_length, ' + + // Numeric precision / scale (NULL for non-numeric) + ' CASE ' + + ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.atttypmod = -1 THEN NULL ' + + ' ELSE ((a.atttypmod - 4) >> 16)::integer ' + + ' END ' + + ' END AS numeric_precision, ' + + ' CASE ' + + ' WHEN (bt.typcategory IN (''N'',''F'')) OR (bt.oid IS NULL AND t.typcategory IN (''N'',''F'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.atttypmod = -1 THEN NULL ' + + ' ELSE ((a.atttypmod - 4) & 65535)::integer ' + + ' END ' + + ' END AS numeric_scale, ' + + // Datetime precision (for time/timestamp/interval) + ' CASE ' + + ' WHEN (bt.typcategory = ''D'' OR (bt.oid IS NULL AND t.typcategory = ''D'')) ' + + ' AND a.atttypmod <> -1 ' + + ' THEN a.atttypmod ' + + ' ELSE NULL ' + + ' END AS datetime_precision, ' + + // Character set name: PostgreSQL has one per DB; mimic information_schema + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' THEN current_database() ' + + ' ELSE NULL ' + + ' END AS character_set_name, ' + + // Collation name for collatable columns + ' CASE ' + + ' WHEN (bt.typcategory = ''S'' OR (bt.oid IS NULL AND t.typcategory = ''S'')) ' + + ' THEN ' + + ' CASE ' + + ' WHEN a.attcollation <> t.typcollation ' + + ' THEN coll.collname ' + + ' ELSE NULL ' + + ' END ' + + ' ELSE NULL ' + + ' END AS collation_name, ' + + // Default expression for non-generated columns + ' CASE ' + + ' WHEN a.attgenerated = '''' AND a.atthasdef ' + + ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + + ' ELSE NULL ' + + ' END AS column_default, ' + + // Generation expression for generated columns + ' CASE ' + + ' WHEN a.attgenerated <> '''' AND a.atthasdef ' + + ' THEN pg_get_expr(ad.adbin, ad.adrelid) ' + + ' ELSE NULL ' + + ' END AS generation_expression, ' + + ' d.description AS column_comment ' + + 'FROM pg_catalog.pg_class AS c ' + + 'JOIN pg_catalog.pg_namespace AS n ON n.oid = c.relnamespace ' + + 'JOIN pg_catalog.pg_attribute AS a ON a.attrelid = c.oid ' + + 'JOIN pg_catalog.pg_type AS t ON t.oid = a.atttypid ' + + 'LEFT JOIN pg_catalog.pg_type AS bt ON bt.oid = t.typbasetype ' + + 'LEFT JOIN pg_catalog.pg_attrdef AS ad ' + + ' ON ad.adrelid = a.attrelid ' + + ' AND ad.adnum = a.attnum ' + + 'LEFT JOIN pg_catalog.pg_description AS d ' + + ' ON d.objoid = a.attrelid ' + + ' AND d.objsubid = a.attnum ' + + 'LEFT JOIN pg_catalog.pg_collation AS coll ' + + ' ON coll.oid = a.attcollation ' + + 'WHERE n.nspname = %s ' + + ' AND a.attnum > 0 ' + + ' AND NOT a.attisdropped ' + + ' AND c.relname = %s ' + + 'ORDER BY ordinal_position', + '' // ServerVersion < 12 + ); + + qGetCharsets: Result := 'SELECT DISTINCT pg_encoding_to_char(enc) AS "Charset" FROM '+ + '(SELECT conforencoding AS enc FROM pg_catalog.pg_conversion '+ + ' UNION '+ + ' SELECT contoencoding AS enc FROM pg_catalog.pg_conversion) AS x'; + qGetRowCountApprox: Result := 'SELECT reltuples::bigint FROM pg_class'+ + ' LEFT JOIN pg_namespace ON pg_namespace.oid = pg_class.relnamespace'+ + ' WHERE pg_class.relkind=''r'''+ + ' AND pg_namespace.nspname=:EscapedDatabase'+ + ' AND pg_class.relname=:EscapedName'; + qExplain: Result := 'EXPLAIN %s'; + qGetEnumTypes: Result := IfThen( + FServerVersion >= 90000, + 'SELECT ' + + ' n.nspname AS enum_schema, ' + + ' t.typname AS enum_name, ' + + ' string_agg(e.enumlabel, ''|'' ORDER BY e.enumsortorder) AS enum_labels ' + + 'FROM pg_type AS t ' + + 'JOIN pg_enum AS e ' + + ' ON t.oid = e.enumtypid ' + + 'JOIN pg_namespace AS n ' + + ' ON n.oid = t.typnamespace ' + + 'WHERE t.typtype = ''e'' ' + + 'GROUP BY n.nspname, t.typname ' + + 'ORDER BY UPPER(t.typname)', + '' // ServerVersion < 9 + ); + qAutoInc: Result := 'SERIAL'; + qCastAsText: Result := '%s::text'; + else Result := inherited; + end; +end; + + end. diff --git a/source/dbstructures.sqlite.pas b/source/dbstructures.sqlite.pas index f9d2be952..fb1cef0cc 100644 --- a/source/dbstructures.sqlite.pas +++ b/source/dbstructures.sqlite.pas @@ -152,6 +152,11 @@ TSQLiteLib = class(TDbLib) constructor CreateWithMultipleCipherFunctions(DllFile, DefaultDll: String); end; + TSQLiteProvider = class(TSqlProvider) + public + function GetSql(AId: TQueryId): string; override; + end; + var SQLiteDatatypes: Array[0..15] of TDBDatatype = @@ -387,4 +392,46 @@ procedure TSQLiteLib.AssignProcedures; end; end; + +{ TSQLiteProvider } + +function TSQLiteProvider.GetSql(AId: TQueryId): string; +begin + case AId of + qDatabaseDrop: Result := 'DROP DATABASE %s'; + qRenameTable: Result := 'ALTER TABLE %s RENAME TO %s'; + qRenameView: Result := 'ALTER TABLE %s RENAME TO %s'; + qCurrentUserHost: Result := ''; // unsupported + qLikeCompare: Result := '%s LIKE %s'; + qAddColumn: Result := 'ADD COLUMN %s'; + qChangeColumn: Result := ''; // SQLite only supports renaming + qRenameColumn: Result := 'RENAME COLUMN %s TO %s'; + qSessionVariables: Result := 'SELECT null, null'; // Todo: combine "PRAGMA pragma_list" + "PRAGMA a; PRAGMY b; ..."? + qGlobalVariables: Result := 'SHOW GLOBAL VARIABLES'; + qISSchemaCol: Result := '%s_SCHEMA'; + qUSEQuery: Result := ''; + qKillQuery: Result := 'KILL %d'; + qKillProcess: Result := 'KILL %d'; + qFuncLength: Result := 'LENGTH'; + qFuncCeil: Result := 'CEIL'; + qFuncLeft: Result := 'SUBSTR(%s, 1, %d)'; + qFuncNow: Result := 'DATETIME()'; + qFuncLastAutoIncNumber: Result := 'LAST_INSERT_ID()'; + qLockedTables: Result := ''; + qDisableForeignKeyChecks: Result := ''; + qEnableForeignKeyChecks: Result := ''; + qForeignKeyDrop: Result := 'DROP FOREIGN KEY %s'; + qGetTableColumns: Result := 'SELECT * FROM pragma_table_xinfo(%s, %s)'; + // See https://www.sqlite.org/datatype3.html#collation_sequence_examples + qGetCollations: Result := 'SELECT name AS "Collation", '''' AS "Charset", '''' AS "Id", '''' AS "Default", '''' AS "Compiled", ''1'' AS Sortlen from pragma_collation_list'; + qGetCharsets: Result := 'SELECT ''UTF-8'' AS "Charset", ''UTF-8'' AS "Description" '+ + 'UNION SELECT ''UTF-16le'', ''UTF-16 Little Endian'' '+ + 'UNION SELECT ''UTF-16be'', ''UTF-16 Big Endian'''; + qExplain: Result := 'EXPLAIN %s'; + qCastAsText: Result := 'CAST(%s AS CHAR)'; + else Result := inherited; + end; +end; + + end. \ No newline at end of file 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 2f5c1e47b..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,19 +490,27 @@ 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 + MainForm.LogSQL('Failed to get current results'); + Exit; + 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; @@ -506,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)); @@ -647,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; @@ -662,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); @@ -690,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; @@ -731,15 +764,15 @@ procedure TfrmExportGrid.btnOKClick(Sender: TObject); CodeIndent(2) + '' + TableName + '' + sLineBreak + CodeIndent(2) + '' + sLineBreak + CodeIndent(2) + '' + sLineBreak + + CodeIndent(2) + '' + sLineBreak + CodeIndent(2) + '