+ <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <VersionInfo> + <UseVersionInfo Value="True"/> + <MajorVersionNr Value="12"/> + <MinorVersionNr Value="10"/> + </VersionInfo> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <RequiredPackages> + <Item> + <PackageName Value="laz.virtualtreeview_package"/> + </Item> + <Item> + <PackageName Value="SynEditDsgn"/> + </Item> + <Item> + <PackageName Value="SynEdit"/> + </Item> + <Item> + <PackageName Value="LCL"/> + </Item> + </RequiredPackages> + <Units> + <Unit> + <Filename Value="heidisql.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="source/main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit> + <Unit> + <Filename Value="source/apphelpers.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="source/dbconnection.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="source/dbstructures.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="source/dbstructures.mysql.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="out\heidisql"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="source"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerMessages> + <IgnoredMessages idx3177="True" idx3175="True"/> + </CompilerMessages> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/heidisql.lpr b/heidisql.lpr new file mode 100644 index 00000000..f3a4088f --- /dev/null +++ b/heidisql.lpr @@ -0,0 +1,74 @@ +program heidisql; + +{$mode delphi}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + {$IFDEF HASAMIGA} + athreads, + {$ENDIF} + Interfaces, // this includes the LCL widgetset + SysUtils, + Forms, main, + { you can add units after this } + apphelpers, + dbconnection, + //gnugettext + dbstructures, + dbstructures.mysql + ; + +{$R *.res} +{.$R resources.rc} + +begin + PostponedLogItems := TDBLogItems.Create(True); + //Application.MainFormOnTaskBar := True; + + // Use MySQL standard format for date/time variables: YYYY-MM-DD HH:MM:SS + // Be aware that Delphi internally converts the slashes in ShortDateFormat to the DateSeparator + DefaultFormatSettings.DateSeparator := '-'; + DefaultFormatSettings.TimeSeparator := ':'; + DefaultFormatSettings.ShortDateFormat := 'yyyy/mm/dd'; + DefaultFormatSettings.LongTimeFormat := 'hh:nn:ss'; + + //AppSettings := TAppSettings.Create; + //SecondInstMsgId := RegisterWindowMessage(APPNAME); + if false then begin // (not AppSettings.ReadBool(asAllowMultipleInstances)) and CheckForSecondInstance then begin + //AppSettings.Free; + Application.Terminate; + end else begin + + {AppLanguage := AppSettings.ReadString(asAppLanguage); + // SysLanguage may be zh_CN, while we don't offer such a language, but anyway, this is just the current system language: + SysLanguage := gnugettext.DefaultInstance.GetCurrentLocaleName; + gnugettext.UseLanguage(AppLanguage); + // First time translation via dxgettext. + // Issue #3064: Ignore TFont, so "Default" on mainform for WinXP users does not get broken. + gnugettext.TP_GlobalIgnoreClass(TFont); + + // Enable padding in customized tooltips + HintWindowClass := TExtHintWindow;} + + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + //Application.UpdateFormatSettings := False; + + // Try to set style name. If that fails, the user gets an error message box - reset it to default when that happened + {WantedStyle := AppSettings.ReadString(asTheme); + TStyleManager.TrySetStyle(WantedStyle); + if TStyleManager.ActiveStyle.Name <> WantedStyle then begin + AppSettings.WriteString(asTheme, TStyleManager.ActiveStyle.Name); + end;} + Application.CreateForm(TMainForm, MainForm); + MainForm.AfterFormCreate; + //Application.OnDeactivate := MainForm.ApplicationDeActivate; + //Application.OnShowHint := MainForm.ApplicationShowHint; + //Application.MainFormOnTaskBar := True; + Application.Run; + end; +end. + diff --git a/out/libmariadb.dll b/out/libmariadb.dll new file mode 100644 index 00000000..fa87599f Binary files /dev/null and b/out/libmariadb.dll differ diff --git a/source/apphelpers.pas b/source/apphelpers.pas new file mode 100644 index 00000000..f30c817d --- /dev/null +++ b/source/apphelpers.pas @@ -0,0 +1,4610 @@ +unit apphelpers; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, + dbconnection; + +type + + {TSortItemOrder = (sioAscending, sioDescending); + TSortItem = class(TPersistent) + public + Column: String; + Order: TSortItemOrder; + procedure Assign(Source: TPersistent); override; + end; + TSortItems = class(TObjectList<TSortItem>) + public + function AddNew(Column: String=''; Order: TSortItemOrder=sioAscending): TSortItem; + function ComposeOrderClause(Connection: TDBConnection): String; + function FindByColumn(Column: String): TSortItem; + procedure Assign(Source: TSortItems); + end;} + + TLineBreaks = (lbsNone, lbsWindows, lbsUnix, lbsMac, lbsWide, lbsMixed); + + {TUTF8NoBOMEncoding = class(TUTF8Encoding) + public + function GetPreamble: TBytes; override; + end;} + + {TDBObjectEditor = class(TFrame) + private + FModified: Boolean; + procedure SetModified(Value: Boolean); + protected + FMainSynMemo: TSynMemo; // Main editor in case of routine, view, trigger or event + FMainSynMemoPreviousTopLine: Integer; + function ObjectExists: Boolean; + public + DBObject: TDBObject; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Init(Obj: TDBObject); virtual; + function DeInit: TModalResult; virtual; + property Modified: Boolean read FModified write SetModified; + function ApplyModifications: TModalResult; virtual; abstract; + end; + TDBObjectEditorClass = class of TDBObjectEditor;} + + {TSQLBatch = class; + TSQLSentence = class(TObject) + private + FOwner: TSQLBatch; + function GetSize: Integer; + function GetSQL: String; + function GetSQLWithoutComments: String; + public + LeftOffset, RightOffset: Integer; + constructor Create(Owner: TSQLBatch); + property SQL: String read GetSQL; + property SQLWithoutComments: String read GetSQLWithoutComments; + property Size: Integer read GetSize; + end; + TSQLBatch = class(TObjectList<TSQLSentence>) + private + FSQL: String; + procedure SetSQL(Value: String); + function GetSize: Integer; + function GetSQLWithoutComments: String; overload; + public + class function GetSQLWithoutComments(FullSQL: String): String; overload; + property Size: Integer read GetSize; + property SQL: String read FSQL write SetSQL; + property SQLWithoutComments: String read GetSQLWithoutComments; + end; } + + // Download + {THttpDownload = class(TObject) + private + FOwner: TComponent; + FURL: String; + FLastContent: String; + FBytesRead: Integer; + FContentLength: Integer; + FTimeOut: Cardinal; + FOnProgress: TNotifyEvent; + public + constructor Create(Owner: TComponent); + procedure SendRequest(Filename: String); + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + property URL: String read FURL write FURL; + property TimeOut: Cardinal read FTimeOut write FTimeOut; + property BytesRead: Integer read FBytesRead; + property ContentLength: Integer read FContentLength; + property LastContent: String read FLastContent; + end; } + + // Extended string list with support for empty values + {TExtStringList = class(TStringList) + private + function GetValue(const Name: string): string; + procedure SetValue(const Name, Value: string); reintroduce; + public + property Values[const Name: string]: string read GetValue write SetValue; + end;} + + // Threading stuff + {TQueryThread = class(TThread) + private + FConnection: TDBConnection; + FBatch: TSQLBatch; + FTabNumber: Integer; + FBatchInOneGo: Boolean; + FStopOnErrors: Boolean; + FAborted: Boolean; + FErrorMessage: String; + FBatchPosition: Integer; + FQueriesInPacket: Integer; + FQueryStartedAt: TDateTime; + FQueryTime: Cardinal; + FQueryNetTime: Cardinal; + FRowsAffected: Int64; + FRowsFound: Int64; + FWarningCount: Int64; + public + property Connection: TDBConnection read FConnection; + property Batch: TSQLBatch read FBatch; + property TabNumber: Integer read FTabNumber; + property BatchPosition: Integer read FBatchPosition; + property QueriesInPacket: Integer read FQueriesInPacket; + property QueryStartedAt: TDateTime read FQueryStartedAt; + property QueryTime: Cardinal read FQueryTime; + property QueryNetTime: Cardinal read FQueryNetTime; + property RowsAffected: Int64 read FRowsAffected; + property RowsFound: Int64 read FRowsFound; + property WarningCount: Int64 read FWarningCount; + property Aborted: Boolean read FAborted write FAborted; + property ErrorMessage: String read FErrorMessage; + constructor Create(Connection: TDBConnection; Batch: TSQLBatch; TabNumber: Integer); + procedure Execute; override; + procedure LogFromThread(Msg: String; Category: TDBLogCategory); + end;} + + {TSqlTranspiler = class(TObject) + class function CreateTable(SQL: String; SourceDb, TargetDb: TDBConnection): String; + end;} + + {TClipboardHelper = class helper for TClipboard + private + function GetTryAsText: String; + procedure SetTryAsText(AValue: String); + public + property TryAsText: String read GetTryAsText write SetTryAsText; + end;} + + {TWinControlHelper = class helper for TWinControl + public + procedure TrySetFocus; + end;} + + //TSimpleKeyValuePairs = TDictionary<String, String>; + + TAppSettingDataType = (adInt, adBool, adString); + TAppSettingIndex = (asHiddenColumns, asFilter, asSort, asDisplayedColumnsSorted, asLastSessions, + asLastActiveSession, asAutoReconnect, asRestoreLastUsedDB, asLastUsedDB, asTreeBackground, asIgnoreDatabasePattern, asLogFileDdl, asLogFileDml, asLogFilePath, + asFontName, asFontSize, asTabWidth, asDataFontName, asDataFontSize, asDataLocalNumberFormat, asLowercaseHex, asHintsOnResultTabs, asHightlightSameTextBackground, + asShowRowId, + asLogsqlnum, asLogsqlwidth, asSessionLogsDirectory, asLogHorizontalScrollbar, asSQLColActiveLine, + asSQLColMatchingBraceForeground, asSQLColMatchingBraceBackground, + asMaxColWidth, asDatagridMaximumRows, asDatagridRowsPerStep, asGridRowLineCount, asColumnHeaderClick, asReuseEditorConfiguration, + asLogToFile, asMainWinMaximized, asMainWinLeft, asMainWinTop, asMainWinWidth, + asMainWinHeight, asMainWinOnMonitor, asCoolBandIndex, asCoolBandBreak, asCoolBandWidth, asToolbarShowCaptions, asQuerymemoheight, asDbtreewidth, + asDataPreviewHeight, asDataPreviewEnabled, asLogHeight, asQueryhelperswidth, asStopOnErrorsInBatchMode, + 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, + 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, + asGridExportWindowWidth, asGridExportWindowHeight, asGridExportOutputCopy, asGridExportOutputFile, + asGridExportFilename, asGridExportRecentFiles, asGridExportEncoding, asGridExportFormat, asGridExportSelection, + asGridExportColumnNames, asGridExportIncludeAutoInc, asGridExportIncludeQuery, asGridExportRemoveLinebreaks, + asGridExportSeparator, asGridExportEncloser, asGridExportTerminator, asGridExportNull, + + asGridExportClpColumnNames, asGridExportClpIncludeAutoInc, asGridExportClpRemoveLinebreaks, + asGridExportClpSeparator, asGridExportClpEncloser, asGridExportClpTerminator, asGridExportClpNull, + + asCSVImportSeparator, asCSVImportEncloser, asCSVImportTerminator, asCSVImportFieldEscaper, asCSVImportWindowWidth, asCSVImportWindowHeight, + asCSVImportFilename, asCSVImportFieldsEnclosedOptionally, asCSVImportIgnoreLines, asCSVImportLowPriority, asCSVImportLocalNumbers, + asCSVImportDuplicateHandling, asCSVImportParseMethod, asCSVKeepDialogOpen, + asUpdatecheck, asUpdatecheckBuilds, asUpdatecheckInterval, asUpdatecheckLastrun, asUpdateCheckWindowWidth, asUpdateCheckWindowHeight, + asTableToolsWindowWidth, asTableToolsWindowHeight, asTableToolsTreeWidth, + asTableToolsFindTextTab, asTableToolsFindText, asTableToolsFindSQL, asTableToolsDatatype, asTableToolsFindCaseSensitive, asTableToolsFindMatchType, asFileImportWindowWidth, asFileImportWindowHeight, + asEditVarWindowWidth, asEditVarWindowHeight, asUsermanagerWindowWidth, asUsermanagerWindowHeight, asUsermanagerListWidth, + asSelectDBOWindowWidth, asSelectDBOWindowHeight, + asSessionManagerListWidth, asSessionManagerWindowWidth, asSessionManagerWindowHeight, asSessionManagerWindowLeft, asSessionManagerWindowTop, + asCopyTableWindowHeight, asCopyTableWindowWidth, asCopyTableColumns, asCopyTableKeys, asCopyTableForeignKeys, + asCopyTableData, asCopyTableRecentFilter, asServerVersion, asServerVersionFull, asLastConnect, + asConnectCount, asRefusedCount, asSessionCreated, asDoUsageStatistics, + asLastUsageStatisticCall, asWheelZoom, asDisplayBars, asMySQLBinaries, asCustomSnippetsDirectory, + asPromptSaveFileOnTabClose, asRestoreTabs, asTabCloseOnDoubleClick, asTabCloseOnMiddleClick, asTabsInMultipleLines, asTabIconsGrayscaleMode, + asWarnUnsafeUpdates, asQueryGridLongSortRowNum, + asCompletionProposal, asCompletionProposalInterval, asCompletionProposalSearchOnMid, asCompletionProposalWidth, asCompletionProposalNbLinesInWindow, asAutoUppercase, + asTabsToSpaces, asFilterPanel, asAllowMultipleInstances, asFindDialogSearchHistory, asGUIFontName, asGUIFontSize, + asTheme, asIconPack, asWebSearchBaseUrl, + asFindDialogReplaceHistory, asMaxQueryResults, asLogErrors, + asLogUserSQL, asLogSQL, asLogInfos, asLogDebug, asLogScript, asLogTimestamp, asFieldColorNumeric, + asFieldColorReal, asFieldColorText, asFieldColorBinary, asFieldColorDatetime, asFieldColorSpatial, + asFieldColorOther, asFieldEditorBinary, asFieldEditorDatetime, asFieldEditorDatetimePrefill, asFieldEditorEnum, + asFieldEditorSet, asFieldNullBackground, asRowBackgroundEven, asRowBackgroundOdd, asGroupTreeObjects, asDisplayObjectSizeColumn, asSQLfile, + asActionShortcut1, asActionShortcut2, asHighlighterForeground, asHighlighterBackground, asHighlighterStyle, + asListColWidths, asListColsVisible, asListColPositions, asListColSort, asSessionFolder, + asRecentFilter, asTimestampColumns, asDateTimeEditorCursorPos, asAppLanguage, asAutoExpand, asDoubleClickInsertsNodeText, asForeignDropDown, + asIncrementalSearch, asQueryHistoryEnabled, asQueryHistoryKeepDays, + asColumnSelectorWidth, asColumnSelectorHeight, asDonatedEmail, asFavoriteObjects, asFavoriteObjectsOnly, asFullTableStatus, asLineBreakStyle, + asPreferencesWindowWidth, asPreferencesWindowHeight, + asFileDialogEncoding, + asThemePreviewWidth, asThemePreviewHeight, asThemePreviewTop, asThemePreviewLeft, + asCreateDbCollation, asRealTrailingZeros, + asSequalSuggestWindowWidth, asSequalSuggestWindowHeight, asSequalSuggestPrompt, asSequalSuggestRecentPrompts, + asReformatter, asReformatterNoDialog, asAlwaysGenerateFilter, + asGenerateDataNumRows, asGenerateDataNullAmount, asWebOnceAction, + asUnused); + TAppSetting = record + Name: String; + Session: Boolean; + DefaultInt, CurrentInt: Integer; + DefaultBool, CurrentBool: Boolean; + DefaultString, CurrentString: String; + Synced: Boolean; + end; + {TAppSettings = class(TObject) + private + FReads, FWrites: Integer; + FBasePath: String; + FSessionPath: String; + FStoredPath: String; + FRegistry: TRegistry; + FPortableMode: Boolean; + FPortableModeReadOnly: Boolean; + FRestoreTabsInitValue: Boolean; + FSettingsFile: String; + FSettings: Array[TAppSettingIndex] of TAppSetting; + const FPortableLockFileBase: String='portable.lock'; + procedure InitSetting(Index: TAppSettingIndex; Name: String; + DefaultInt: Integer=0; DefaultBool: Boolean=False; DefaultString: String=''; + Session: Boolean=False); + procedure SetSessionPath(Value: String); + procedure PrepareRegistry; + procedure Read(Index: TAppSettingIndex; FormatName: String; + DataType: TAppSettingDataType; var I: Integer; var B: Boolean; var S: String; + DI: Integer; DB: Boolean; DS: String); + procedure Write(Index: TAppSettingIndex; FormatName: String; + DataType: TAppSettingDataType; I: Integer; B: Boolean; S: String); + public + constructor Create; + destructor Destroy; override; + function ReadInt(Index: TAppSettingIndex; FormatName: String=''; Default: Integer=0): Integer; + function ReadIntDpiAware(Index: TAppSettingIndex; AControl: TControl; FormatName: String=''; Default: Integer=0): Integer; + function ReadBool(Index: TAppSettingIndex; FormatName: String=''; Default: Boolean=False): Boolean; + function ReadString(Index: TAppSettingIndex; FormatName: String=''; Default: String=''): String; overload; + function ReadString(ValueName: String): String; overload; + procedure WriteInt(Index: TAppSettingIndex; Value: Integer; FormatName: String=''); + procedure WriteIntDpiAware(Index: TAppSettingIndex; AControl: TControl; Value: Integer; FormatName: String=''); + procedure WriteBool(Index: TAppSettingIndex; Value: Boolean; FormatName: String=''); + procedure WriteString(Index: TAppSettingIndex; Value: String; FormatName: String=''); overload; + procedure WriteString(ValueName, Value: String); overload; + function GetDefaultInt(Index: TAppSettingIndex): Integer; + function GetDefaultBool(Index: TAppSettingIndex): Boolean; + function GetDefaultString(Index: TAppSettingIndex): String; + function GetValueName(Index: TAppSettingIndex): String; + function GetValueNames: TStringList; + function GetKeyNames: TStringList; + function GetSessionNames(ParentPath: String; var Folders: TStringList): TStringList; + procedure GetSessionPaths(ParentPath: String; var Sessions: TStringList); + function DeleteValue(Index: TAppSettingIndex; FormatName: String=''): Boolean; overload; + function DeleteValue(ValueName: String): Boolean; overload; + procedure DeleteCurrentKey; + procedure MoveCurrentKey(TargetPath: String); + function ValueExists(Index: TAppSettingIndex): Boolean; + function SessionPathExists(SessionPath: String): Boolean; + function IsEmptyKey: Boolean; + procedure ResetPath; + procedure StorePath; + procedure RestorePath; + property SessionPath: String read FSessionPath write SetSessionPath; + property PortableMode: Boolean read FPortableMode; + property PortableModeReadOnly: Boolean read FPortableModeReadOnly write FPortableModeReadOnly; + property Writes: Integer read FWrites; + procedure ImportSettings(Filename: String); + function ExportSettings(Filename: String): Boolean; overload; + function ExportSettings: Boolean; overload; + // Common directories + function DirnameUserAppData: String; + function DirnameUserDocuments: String; + function DirnameSnippets: String; + function DirnameBackups: String; + function DirnameHighlighters: String; + // "Static" options, initialized in OnCreate only. For settings which need a restart to take effect. + property RestoreTabsInitValue: Boolean read FRestoreTabsInitValue; + end;} + +{$I const.inc} + + function Implode(Separator: String; a: TStrings): String; + function Explode(Separator, Text: String) :TStringList; + //procedure ExplodeQuotedList(Text: String; var List: TStringList); + //function StrEllipsis(const S: String; MaxLen: Integer; FromLeft: Boolean=True): String; + //function encrypt(str: String): String; + //function decrypt(str: String): String; + //function HTMLSpecialChars(str: String): String; + //function EncodeURLParam(const Value: String): String; + //procedure StreamWrite(S: TStream; Text: String = ''); + //function _GetFileSize(Filename: String): Int64; + //function DeleteFileWithUndo(sFileName: String): Boolean; + //function MakeInt(Str: String) : Int64; + //function MakeFloat(Str: String): Extended; + //function RoundCommercial(e: Extended): Int64; + //function CleanupNumber(Str: String): String; + //function IsInt(Str: String): Boolean; + //function IsFloat(Str: String): Boolean; + //function ScanLineBreaks(Text: String): TLineBreaks; + //function fixNewlines(txt: String): String; + //procedure StripNewLines(var txt: String; Replacement: String=' '); + //function GetLineBreak(LineBreakIndex: TLineBreaks): String; + //procedure RemoveNullChars(var Text: String; var HasNulls: Boolean); + //function GetShellFolder(FolderId: TGUID): String; + //function ValidFilename(Str: String): String; + //function FormatNumber( str: String; Thousands: Boolean=True): String; Overload; + //function UnformatNumber(Val: String): String; + //function FormatNumber( int: Int64; Thousands: Boolean=True): String; Overload; + //function FormatNumber( flt: Double; decimals: Integer = 0; Thousands: Boolean=True): String; Overload; + //procedure ShellExec(cmd: String; path: String=''; params: String=''; RunHidden: Boolean=False); + //function getFirstWord(text: String; MustStartWithWordChar: Boolean=True): String; + //function RegExprGetMatch(Expression: String; var Input: String; ReturnMatchNum: Integer; DeleteFromSource, CaseInsensitive: Boolean): String; Overload; + //function RegExprGetMatch(Expression: String; Input: String; ReturnMatchNum: Integer): String; Overload; + //function ExecRegExprI(const ARegExpr, AInputStr: RegExprString): Boolean; + //function FormatByteNumber( Bytes: Int64; Decimals: Byte = 1 ): String; Overload; + //function FormatByteNumber( Bytes: String; Decimals: Byte = 1 ): String; Overload; + //function FormatTimeNumber(Seconds: Double; DisplaySeconds: Boolean; MilliSecondsPrecision: Integer=1): String; + //function GetTempDir: 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; + //function ReadTextfileChunk(Stream: TFileStream; Encoding: TEncoding; ChunkSize: Int64 = 0): String; + //function ReadTextfile(Filename: String; Encoding: TEncoding): String; + //function ReadBinaryFile(Filename: String; MaxBytes: Int64): AnsiString; + //procedure StreamToClipboard(Text, HTML: TStream); + //function WideHexToBin(text: String): AnsiString; + //function BinToWideHex(bin: AnsiString): String; + //procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1); + //function GetTextHeight(Font: TFont): Integer; + //function ColorAdjustBrightness(Col: TColor; Shift: SmallInt): TColor; + //procedure DeInitializeVTNodes(Sender: TBaseVirtualTree); + //function FindNode(VT: TVirtualStringTree; idx: Int64; ParentNode: PVirtualNode): PVirtualNode; + //function SelectNode(VT: TVirtualStringTree; idx: Int64; ParentNode: PVirtualNode=nil): Boolean; overload; + //function SelectNode(VT: TVirtualStringTree; Node: PVirtualNode; ClearSelection: Boolean=True): Boolean; overload; + //procedure GetVTSelection(VT: TVirtualStringTree; var SelectedCaptions: TStringList; var FocusedCaption: String); + //procedure SetVTSelection(VT: TVirtualStringTree; SelectedCaptions: TStringList; FocusedCaption: String); + //function GetNextNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode; + //function GetPreviousNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode; + //function DateBackFriendlyCaption(d: TDateTime): String; + //function DateTimeToStrDef(DateTime: TDateTime; Default: String): String; + //function TruncDef(X: Real; Default: Int64): Int64; + //function GetLightness(AColor: TColor): Byte; + //function ParamBlobToStr(lpData: Pointer): String; + //function ParamStrToBlob(out cbData: DWORD): Pointer; + //function CheckForSecondInstance: Boolean; + //function GetParentFormOrFrame(Comp: TWinControl): TWinControl; + //function KeyPressed(Code: Integer): Boolean; + //function GeneratePassword(Len: Integer): String; + //procedure InvalidateVT(VT: TVirtualStringTree; RefreshTag: Integer; ImmediateRepaint: Boolean); + //function CharAtPos(Str: String; Pos: Integer): Char; + //function CompareAnyNode(Text1, Text2: String): Integer; + //function StringListCompareAnythingAsc(List: TStringList; Index1, Index2: Integer): Integer; + //function StringListCompareAnythingDesc(List: TStringList; Index1, Index2: Integer): Integer; + //function StringListCompareByValue(List: TStringList; Index1, Index2: Integer): Integer; + //function StringListCompareByLength(List: TStringList; Index1, Index2: Integer): Integer; + //function GetImageLinkTimeStamp(const FileName: string): TDateTime; + //function IsEmpty(Str: String): Boolean; + //function IsNotEmpty(Str: String): Boolean; + //function MessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; overload; + //function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; KeepAskingSetting: TAppSettingIndex=asUnused; FooterText: String=''): Integer; overload; + //function ErrorDialog(Msg: string): Integer; overload; + //function ErrorDialog(const Title, Msg: string): Integer; overload; + //function GetLocaleString(const ResourceId: Integer): WideString; + //function GetHTMLCharsetByEncoding(Encoding: TEncoding): String; + //procedure ParseCommandLine(CommandLine: String; var ConnectionParams: TConnectionParameters; var FileNames: TStringList; var RunFrom: String); + function _(const Pattern: string): string; + function f_(const Pattern: string; const Args: array of const): string; + //function GetOutputFilename(FilenameWithPlaceholders: String; DBObj: TDBObject): String; + //function GetOutputFilenamePlaceholders: TStringList; + //function GetSystemImageList: TImageList; + //function GetSystemImageIndex(Filename: String): Integer; + //function GetExecutableBits: Byte; + //procedure Help(Sender: TObject; Anchor: String); + //function PortOpen(Port: Word): Boolean; + //function IsValidFilePath(FilePath: String): Boolean; + //function FileIsWritable(FilePath: String): Boolean; + //function GetProductInfo(dwOSMajorVersion, dwOSMinorVersion, dwSpMajorVersion, dwSpMinorVersion: DWORD; out pdwReturnedProductType: DWORD): BOOL stdcall; external kernel32 delayed; + //function GetCurrentPackageFullName(out Len: Cardinal; Name: PWideChar): Integer; stdcall; external kernel32 delayed; + //function GetThemeColor(Color: TColor): TColor; + //function ThemeIsDark(ThemeName: String=''): Boolean; + //function ProcessExists(pid: Cardinal; ExeNamePattern: String): Boolean; + //procedure ToggleCheckBoxWithoutClick(chk: TCheckBox; State: Boolean); + //function SynCompletionProposalPrettyText(ImageIndex: Integer; LeftText, CenterText, RightText: String; LeftColor: TColor=-1; CenterColor: TColor=-1; RightColor: TColor=-1): String; + //function PopupComponent(Sender: TObject): TComponent; + //function IsWine: Boolean; + //function DirSep: Char; + //procedure FindComponentInstances(BaseForm: TComponent; ClassType: TClass; var List: TObjectList); + //function WebColorStrToColorDef(WebColor: string; Default: TColor): TColor; + //function UserAgent(OwnerComponent: TComponent): String; + //function CodeIndent(Steps: Integer=1): String; + //function EscapeHotkeyPrefix(Text: String): String; + +var + //AppSettings: TAppSettings; + MutexHandle: THandle = 0; + //SystemImageList: TImageList = nil; + //mtCriticalConfirmation: TMsgDlgType = mtCustom; + //ConfirmIcon: TIcon; + NumberChars: TSysCharSet; + LibHandleUser32: THandle; + //UTF8NoBOMEncoding: TUTF8NoBOMEncoding; + DateTimeNever: TDateTime; + IsWineStored: Integer = -1; + +implementation + +uses main; //, extra_controls; + + + +{function WideHexToBin(text: String): AnsiString; +var + buf: AnsiString; +begin + buf := AnsiString(text); + SetLength(Result, Length(text) div 2); + HexToBin(PAnsiChar(buf), @Result[1], Length(Result)); +end;} + +{function BinToWideHex(bin: AnsiString): String; +var + buf: AnsiString; +begin + SetLength(buf, Length(bin) * 2); + BinToHex(@bin[1], PAnsiChar(buf), Length(bin)); + Result := String(buf); +end;} + + +{*** + Convert a TStringList to a string using a separator-string + + @todo Look at each caller to see if escaping is necessary. + @param string Separator + @param a TStringList Containing strings + @return string +} +function Implode(Separator: String; a: TStrings): String; +var + i : Integer; +begin + Result := ''; + for i:=0 to a.Count-1 do + begin + Result := Result + a[i]; + if i < a.Count-1 then + Result := Result + Separator; + end; +end; + + +function Explode(Separator, Text: String): TStringList; +var + i: Integer; + Item: String; +begin + // Explode a string by separator into a TStringList + Result := TStringList.Create; + while true do begin + i := Pos(Separator, Text); + if i = 0 then begin + // Last or only segment: Add to list if it's the last. Add also if it's not empty and list is empty. + // Do not add if list is empty and text is also empty. + if (Result.Count > 0) or (Text <> '') then + Result.Add(Text); + break; + end; + Item := Copy(Text, 1, i-1); + Result.Add(Item); + Delete(Text, 1, i-1+Length(Separator)); + end; +end; + + +{*** + Shorten string to length len and append 3 dots + + @param string String to shorten + @param integer Wished Length of string + @return string +} +{function StrEllipsis(const S: String; MaxLen: Integer; FromLeft: Boolean=True): String; +begin + Result := S; + if Length(Result) <= MaxLen then + Exit; + if FromLeft then begin + SetLength(Result, MaxLen); + Result[MaxLen] := '�'; + end else begin + Result := Copy(Result, Length(Result)-MaxLen, Length(Result)); + Result := '�' + Result; + end; +end;} + + + +{*** + Password-encryption, used to store session-passwords in registry + + @param string Text to encrypt + @return string Encrypted Text +} +{function encrypt(str: String) : String; +var + i, salt, nr : integer; + h : String; +begin + randomize(); + result := ''; + salt := random(9) + 1; + for i:=1 to length(str) do begin + nr := ord(str[i])+salt; + if nr > 255 then + nr := nr - 255; + h := inttohex(nr,0); + if length(h) = 1 then + h := '0' + h; + result := result + h; + end; + result := result + inttostr(salt); +end;} + + + +{*** + Password-decryption, used to restore session-passwords from registry + + @param string Text to decrypt + @return string Decrypted Text +} +{function decrypt(str: String) : String; +var + j, salt, nr : integer; +begin + result := ''; + if str = '' then exit; + j := 1; + salt := StrToIntDef(str[length(str)],0); + result := ''; + while j < length(str)-1 do begin + nr := StrToInt('$' + str[j] + str[j+1]) - salt; + if nr < 0 then + nr := nr + 255; + result := result + chr(nr); + inc(j, 2); + end; +end;} + + +{function HTMLSpecialChars(str: String) : String; +begin + // Convert critical HTML-characters to entities. Used in grid export. + result := StringReplace(str, '&', '&', [rfReplaceAll]); + result := StringReplace(result, '<', '<', [rfReplaceAll]); + result := StringReplace(result, '>', '>', [rfReplaceAll]); +end;} + + +{function EncodeURLParam(const Value: String): String; +var + c: Char; +const} + //UnsafeChars: String = '*<>#%"{}|\^[]`?&+;'; +{begin + // Encode critical chars in url parameter + Result := ''; + for c in Value do begin + if (Pos(c, UnsafeChars)>0) or (Ord(c) < 33) or (Ord(c) > 128) then + Result := Result + '%'+IntToHex(Ord(c), 2) + else + Result := Result + c; + end; +end;} + + +{** + Write some UTF8 text to a file- or memorystream +} +{procedure StreamWrite(S: TStream; Text: String = ''); +var + utf8: AnsiString; +begin + utf8 := Utf8Encode(Text); + S.Write(utf8[1], Length(utf8)); +end;} + + +{*** + Return filesize of a given file + Partly taken from https://www.delphipraxis.net/194137-getfilesize-welches-ist-die-bessere-funktion-2.html + @param string Filename + @return int64 Size in bytes +} +{function _GetFileSize(Filename: String): Int64; +var + Attr: TWin32FileAttributeData; +begin + FillChar(Attr, SizeOf(Attr), 0); + if GetFileAttributesEx(PChar(Filename), GetFileExInfoStandard, @Attr) then + begin + Result := Int64(Attr.nFileSizeHigh) shl 32 + Int64(Attr.nFileSizeLow); + end + else + Result := -1; +end;} + + +{function DeleteFileWithUndo(sFileName: string): Boolean; +var + fos: TSHFileOpStruct; +begin + FillChar(fos, SizeOf(fos), 0); + fos.wFunc := FO_DELETE; + fos.pFrom := PChar(sFileName + #0); + fos.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT; + Result := (0 = ShFileOperation(fos)); +end;} + + +{*** + Convert a string-number to an integer-number + + @param string String-number + @return int64 +} +{function MakeInt(Str: String): Int64; +begin + // Result has to be of integer type + try + Result := Trunc(MakeFloat(Str)); + except + Result := 0; + end; +end;} + + +{function CleanupNumber(Str: String): String; +var + i: Integer; + HasDecimalSep: Boolean; +begin + // Ensure the passed string contains a valid number, which is convertable by StrToFloat afterwards + // Return it as string again, as there are callers which need to handle unsigned bigint's somehow - + // there is no unsigned 64 bit integer type in Delphi. + Result := ''; + + // Unformatted float coming in? Detect by order of thousand and decimal char + if ((Pos(',', Str) > 0) and (Pos(',', Str) < Pos('.', Str))) + or ((Pos('.', Str) > 0) and (Pos('.', ReverseString(Str)) <> 4)) + then begin + Str := StringReplace(Str, '.', '*', [rfReplaceAll]); + Str := StringReplace(Str, ',', FormatSettings.ThousandSeparator, [rfReplaceAll]); + Str := StringReplace(Str, '*', FormatSettings.DecimalSeparator, [rfReplaceAll]); + end; + + HasDecimalSep := False; + for i:=1 to Length(Str) do begin + if CharInSet(Str[i], NumberChars) or ((Str[i] = '-') and (Result='')) then + begin + // Avoid confusion and AV in StrToFloat() + if (FormatSettings.ThousandSeparator = FormatSettings.DecimalSeparator) and (Str[i] = FormatSettings.DecimalSeparator) then + continue; + // Ensure only 1 decimalseparator is left + if (Str[i] = FormatSettings.DecimalSeparator) and HasDecimalSep then + continue; + if Str[i] = FormatSettings.DecimalSeparator then + HasDecimalSep := True; + if Str[i] = FormatSettings.ThousandSeparator then + Continue; + Result := Result + Str[i]; + end else + Break; + end; + if (Result = '') or (Result = '-') then + Result := '0'; +end;} + + +{function IsInt(Str: String): Boolean; +begin + Result := IntToStr(MakeInt(Str)) = Str; +end;} + + +{function IsFloat(Str: String): Boolean; +begin + Result := FloatToStr(MakeFloat(Str)) = Str; +end;} + + +{*** + Convert a string-number to an floatingpoint-number + + @param String text representation of a number + @return Extended +} +{function MakeFloat(Str: String): Extended; +var + p_kb, p_mb, p_gb, p_tb, p_pb : Integer; +begin + // Convert result to a floating point value to ensure + // we don't discard decimal digits for the next step + Result := StrToFloat(CleanupNumber(Str)); + + // Detect if the string was previously formatted by FormatByteNumber + // and convert it back by multiplying it with its byte unit + p_kb := Pos(NAME_KB, Str); + p_mb := Pos(NAME_MB, Str); + p_gb := Pos(NAME_GB, Str); + p_tb := Pos(NAME_TB, Str); + p_pb := Pos(NAME_PB, Str); + + if (p_kb > 0) and (p_kb = Length(Str)-Length(NAME_KB)+1) then + Result := Result * SIZE_KB + else if (p_mb > 0) and (p_mb = Length(Str)-Length(NAME_MB)+1) then + Result := Result * SIZE_MB + else if (p_gb > 0) and (p_gb = Length(Str)-Length(NAME_GB)+1) then + Result := Result * SIZE_GB + else if (p_tb > 0) and (p_tb = Length(Str)-Length(NAME_TB)+1) then + Result := Result * SIZE_TB + else if (p_pb > 0) and (p_pb = Length(Str)-Length(NAME_PB)+1) then + Result := Result * SIZE_PB; +end;} + + +{function RoundCommercial(e: Extended): Int64; +begin + // "Kaufm�nnisch runden" + // In contrast to Delphi's Round() which rounds *.5 to the next even number + Result := Trunc(e); + if Frac(e) >= 0.5 then + Result := Result + 1; +end;} + + +{*** + SynEdit removes all newlines and semi-randomly decides a + new newline format to use for any text edited. + See also: Delphi's incomplete implementation of TTextLineBreakStyle in System.pas + + @param string Text to test + @return TLineBreaks +} +{function ScanLineBreaks(Text: String): TLineBreaks; +var + i, SeekSize: Integer; + c: Char; + procedure SetResult(Style: TLineBreaks); + begin + // Note: Prefer "(foo <> a) and (foo <> b)" over "not (foo in [a, b])" in excessive loops + // for performance reasons - there is or was a Delphi bug leaving those inline SETs in memory + // after usage. Unfortunately can't remember which bug id it was and if it still exists. + if (Result <> lbsNone) and (Result <> Style) then + Result := lbsMixed + else + Result := Style; + end; +begin + Result := lbsNone; + SeekSize := Min(Length(Text), SIZE_MB); + if SeekSize = 0 then + Exit; + i := 1; + repeat + c := Text[i]; + if c = #13 then begin + if (i < SeekSize) and (Text[i+1] = #10) then begin + Inc(i); + SetResult(lbsWindows); + end else + SetResult(lbsMac); + end else if c = LB_UNIX then + SetResult(lbsUnix) + else if c = LB_WIDE then + SetResult(lbsWide); + i := i + 1; + // No need to do more checks after detecting mixed style + if Result = lbsMixed then + break; + until i > SeekSize; +end;} + + +{*** + Unify CR's and LF's to CRLF + + @param string Text to fix + @return string +} +{function fixNewlines(txt: String): String; +begin + txt := StringReplace(txt, CRLF, #10, [rfReplaceAll]); + txt := StringReplace(txt, #13, #10, [rfReplaceAll]); + txt := StringReplace(txt, #10, CRLF, [rfReplaceAll]); + result := txt; +end;} + +{procedure StripNewLines(var txt: String; Replacement: String=' '); +begin + txt := StringReplace(txt, #13#10, Replacement, [rfReplaceAll]); + txt := StringReplace(txt, #13, Replacement, [rfReplaceAll]); + txt := StringReplace(txt, #10, Replacement, [rfReplaceAll]); +end;} + +{function GetLineBreak(LineBreakIndex: TLineBreaks): String; +begin + case LineBreakIndex of + lbsUnix: Result := LB_UNIX; + lbsMac: Result := LB_MAC; + else Result := CRLF; + end; +end;} + + +{*** + Mangle input text so that SynEdit can load it. +} +{procedure RemoveNullChars(var Text: String; var HasNulls: Boolean); +var + i, Len: Integer; +begin + HasNulls := False; + Len := Length(Text); + for i:=1 to Len do begin + if Text[i] = #0 then begin + Text[i] := #32; // space + HasNulls := True; + end; + end; +end;} + + +{*** + Get the path of a Windows(r)-shellfolder, specified by a KNOWNFOLDERID constant + @see https://docs.microsoft.com/en-us/windows/win32/shell/knownfolderid + @param TGUID constant + @return string Path +} +{function GetShellFolder(FolderId: TGUID): String; +var + Path: PWideChar; +begin + if Succeeded(SHGetKnownFolderPath(FolderId, 0, 0, Path)) then begin + Result := Path; + end else begin + Result := EmptyStr; + end; +end;} + + + +{*** + Remove special characters from a filename + + @param string Filename + @return string +} +{function ValidFilename(Str: String): String; +var + c: Char; +begin + Result := Str; + for c in TPath.GetInvalidFileNameChars do begin + Result := StringReplace(Result, c, '_', [rfReplaceAll]); + end; +end;} + + +{** + Unformat a formatted integer or float. Used for CSV export and composing WHERE clauses for grid editing. +} +{function UnformatNumber(Val: String): String; +var + i: Integer; + HasDecim: Boolean; + c: Char; +const + Numbers = ['0'..'9']; +begin + Result := ''; + HasDecim := False; + for i:=1 to Length(Val) do begin + c := Val[i]; + if (c = '-') and (i = 1) then + Result := Result + c + else if CharInSet(c, Numbers) then begin + if (c = '0') and (Result = '') then + // remove zeropadding + else + Result := Result + c + end else if (c = FormatSettings.DecimalSeparator) and (not HasDecim) then begin + if Result = '' then + Result := '0'; + Result := Result + '.'; + HasDecim := True; + end else if c <> FormatSettings.ThousandSeparator then + break; + end; + if Result = '' then + Result := '0'; +end;} + + +{*** + Return a formatted integer or float from a string + @param string Text containing a number + @return string +} +{function FormatNumber(str: String; Thousands: Boolean=True): String; Overload; +var + i, p, Left: Integer; +begin + Result := StringReplace(str, '.', FormatSettings.DecimalSeparator, [rfReplaceAll]); + if Thousands then begin + // Do not add thousand separators to zerofilled numbers + if ((Length(Result) >= 1) and (Result[1] = '0')) + or ((Length(Result) >= 2) and (Result[1] = '-') and (Result[2] = '0')) + then + Exit; + p := Pos(FormatSettings.DecimalSeparator, Result); + if p = 0 then p := Length(Result)+1; + Left := 2; + if (Length(Result) >= 1) and (Result[1] = '-') then + Left := 3; + if p > 0 then for i:=p-1 downto Left do begin + if (p-i) mod 3 = 0 then + Insert(FormatSettings.ThousandSeparator, Result, i); + end; + end; +end;} + + + +{*** + Return a formatted number from an integer + + @param int64 Number to format + @return string +} +{function FormatNumber(int: Int64; Thousands: Boolean=True): String; Overload; +begin + result := FormatNumber(IntToStr(int), Thousands); +end;} + + + +{*** + Return a formatted number from a float + This function is called by two overloaded functions + + @param double Number to format + @param integer Number of decimals + @return string +} +{function FormatNumber(flt: Double; decimals: Integer = 0; Thousands: Boolean=True): String; Overload; +begin + Result := Format('%10.'+IntToStr(decimals)+'f', [flt]); + Result := Trim(Result); + Result := FormatNumber(Result, Thousands); +end;} + + +{*** + Open URL or execute system command + + @param string Command or URL to execute + @param string Working directory, only usefull is first param is a system command +} +{procedure ShellExec(cmd: String; path: String=''; params: String=''; RunHidden: Boolean=False); +var + Msg: String; + ShowCmd: Integer; +begin + ShowCmd := IfThen(RunHidden, SW_HIDE, SW_SHOWNORMAL); + Msg := 'Executing shell command: "'+cmd+'"'; + if not path.IsEmpty then + Msg := Msg + ' path: "'+path+'"'; + if not params.IsEmpty then + Msg := Msg + ' params: "'+params+'"'; + MainForm.LogSQL(Msg, lcDebug); + ShellExecute(0, 'open', PChar(cmd), PChar(params), PChar(path), ShowCmd); +end;} + + + +{*** + Returns first word of a given text + @param string Given text + @return string First word-boundary +} +{function getFirstWord(text: String; MustStartWithWordChar: Boolean=True): String; +var + i : Integer; + wordChars, wordCharsFirst : TSysCharSet; +begin + result := ''; + text := trim( text ); + // First char in word must not be numerical. Fixes queries like + // /*!40000 SHOW ENGINES */ to be recognized as "result"-queries + // while not breaking getFirstWord in situations where the second + // or later char can be a number (fx the collation in createdatabase). + wordChars := ['a'..'z', 'A'..'Z', '0'..'9', '_', '-']; + if MustStartWithWordChar then + wordCharsFirst := wordChars - ['0'..'9'] + else + wordCharsFirst := wordChars; + i := 1; + + // Find beginning of the first word, ignoring non-alphanumeric chars at the very start + // @see bug #1692828 + while i < Length(text) do + begin + if CharInSet(text[i], wordCharsFirst) then + begin + // Found beginning of word! + break; + end; + if i = Length(text)-1 then + begin + // Give up in the very last loop, reset counter + // and break. We can't find the start of a word + i := 1; + break; + end; + inc(i); + end; + + // Add chars as long as they're alpha-numeric + while i <= Length(text) do + begin + if ((result = '') and CharInSet(text[i], wordCharsFirst)) or CharInSet(text[i], wordChars) then + begin + result := result + text[i]; + end + else + begin + // Stop here because we found a non-alphanumeric char. + // This applies to all different whitespaces, brackets, commas etc. + break; + end; + inc(i); + end; +end;} + + +{function RegExprGetMatch(Expression: String; var Input: String; ReturnMatchNum: Integer; DeleteFromSource, CaseInsensitive: Boolean): String; +var + rx: TRegExpr; +begin + Result := ''; + rx := TRegExpr.Create; + rx.ModifierI := CaseInsensitive; + rx.Expression := Expression; + if rx.Exec(Input) then begin + if rx.SubExprMatchCount >= ReturnMatchNum then begin + Result := rx.Match[ReturnMatchNum]; + if DeleteFromSource then begin + Delete(Input, rx.MatchPos[ReturnMatchNum], rx.MatchLen[ReturnMatchNum]); + Input := Trim(Input); + end; + end; + end; + rx.Free; +end;} + + +{function RegExprGetMatch(Expression: String; Input: String; ReturnMatchNum: Integer): String; +begin + // Version without possibility to delete captured match from input + Result := RegExprGetMatch(Expression, Input, ReturnMatchNum, False, False); +end;} + + +{function ExecRegExprI(const ARegExpr, AInputStr: RegExprString): Boolean; +var + r: TRegExpr; +begin + Result := False; + r := TRegExpr.Create; + r.ModifierI := True; + try + r.Expression := ARegExpr; + Result := r.Exec(AInputStr); + finally + r.Free; + end; +end;} + + +{** + Format a filesize to automatically use the best fitting expression + 16 100 000 Bytes -> 16,1 MB + 4 500 Bytes -> 4,5 KB + @param Int64 Number of Bytes + @param Byte Decimals to display when bytes is bigger than 1M +} +{function FormatByteNumber( Bytes: Int64; Decimals: Byte = 1 ): String; Overload; +begin + if Bytes >= FSIZE_PB then + Result := FormatNumber( Bytes / SIZE_PB, Decimals ) + NAME_PB + else if Bytes >= FSIZE_TB then + Result := FormatNumber( Bytes / SIZE_TB, Decimals ) + NAME_TB + else if Bytes >= FSIZE_GB then + Result := FormatNumber( Bytes / SIZE_GB, Decimals ) + NAME_GB + else if Bytes >= FSIZE_MB then + Result := FormatNumber( Bytes / SIZE_MB, Decimals ) + NAME_MB + else if Bytes >= FSIZE_KB then + Result := FormatNumber( Bytes / SIZE_KB, Decimals ) + NAME_KB + else + Result := FormatNumber( Bytes ) + NAME_BYTES +end;} + + +{** + An overloaded function of the previous one which can + take a string as input +} +{function FormatByteNumber( Bytes: String; Decimals: Byte = 1 ): String; Overload; +begin + Result := FormatByteNumber( MakeInt(Bytes), Decimals ); +end;} + + +{** + Format a number of seconds to a human readable time format + @param Cardinal Number of seconds + @result String 12:34:56.7 +} +{function FormatTimeNumber(Seconds: Double; DisplaySeconds: Boolean; MilliSecondsPrecision: Integer=1): String; +var + d, h, m, s, ms: Integer; + msStr: String; +begin + s := TruncDef(Seconds, 0); + ms := TruncDef((Seconds - s) * Power(10, MilliSecondsPrecision), 0); // Milliseconds, with variable precision/digits + msStr := IntToStr(ms).PadLeft(MilliSecondsPrecision, '0'); + d := s div (60*60*24); + s := s mod (60*60*24); + h := s div (60*60); + s := s mod (60*60); + m := s div 60; + s := s mod 60; + if d > 0 then begin + if DisplaySeconds then begin + Result := Format('%d '+_('days')+', %.2d:%.2d:%.2d', [d, h, m, s]); + Result := Result + '.' + msStr; // Append milliseconds + end + else begin + Result := Format('%d '+_('days')+', %.2d:%.2d h', [d, h, m]); + end; + end else begin + if DisplaySeconds then begin + Result := Format('%.2d:%.2d:%.2d', [h, m, s]); + Result := Result + '.' + msStr; // Append milliseconds + end + else begin + Result := Format('%.2d:%.2d h', [h, m]); + end; + end; +end;} + + +{function GetTempDir: String; +var + TempPath: array[0..MAX_PATH] of Char; +begin + GetTempPath(MAX_PATH, PChar(@TempPath)); + Result := StrPas(TempPath); +end;} + + +{** + Save a textfile with unicode +} +{procedure SaveUnicodeFile(Filename: String; Text: String; Encoding: TEncoding); +var + Writer: TStreamWriter; +begin + Writer := TStreamWriter.Create(Filename, False, Encoding); + Writer.Write(Text); + Writer.Free; +end;} + + +{procedure OpenTextFile(const Filename: String; out Stream: TFileStream; var Encoding: TEncoding); +var + Header: TBytes; + BomLen: Integer; +begin + // Open a textfile and return a stream. Detect its encoding if not passed by the caller + Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone); + if Encoding = nil then + Encoding := DetectEncoding(Stream); + // If the file contains a BOM, advance the stream's position + BomLen := 0; + if Length(Encoding.GetPreamble) > 0 then begin + SetLength(Header, Length(Encoding.GetPreamble)); + Stream.ReadBuffer(Pointer(Header)^, Length(Header)); + if CompareMem(Header, Encoding.GetPreamble, SizeOf(Header)) then + BomLen := Length(Encoding.GetPreamble); + end; + Stream.Position := BomLen; +end;} + + +{** + Detect stream's content encoding through SynEdit's GetEncoding. Result can be: + UTF-16 BE with BOM + UTF-16 LE with BOM + UTF-8 with or without BOM + ANSI + Aimed to work better than WideStrUtils.IsUTF8String() which didn't work in any test case here. + @see http://en.wikipedia.org/wiki/Byte_Order_Mark + Could also do that with TEncoding.GetBufferEncoding, but that relies on the file having a BOM +} +{function DetectEncoding(Stream: TStream): TEncoding; +var + SynEnc: TSynEncoding; + WithBOM: Boolean; +begin + SynEnc := SynUnicode.GetEncoding(Stream, WithBOM); + case SynEnc of + seUTF8: begin + if WithBOM then + Result := TEncoding.UTF8 + else + Result := UTF8NoBOMEncoding; + end; + seUTF16LE: Result := TEncoding.Unicode; + seUTF16BE: Result := TEncoding.BigEndianUnicode; + seAnsi: Result := TEncoding.ANSI; + else Result := UTF8NoBOMEncoding; + end; +end;} + + +{function ReadTextfileChunk(Stream: TFileStream; Encoding: TEncoding; ChunkSize: Int64 = 0): String; +const + BufferPadding = 1; +var + DataLeft, StartPosition: Int64; + LBuffer: TBytes; + i: Integer; +begin + // Read a chunk or the complete contents out of a textfile, opened by OpenTextFile() + if Stream.Size = 0 then begin + Result := ''; + Exit; + end; + + StartPosition := Stream.Position; + DataLeft := Stream.Size - Stream.Position; + if (ChunkSize = 0) or (ChunkSize > DataLeft) then + ChunkSize := DataLeft; + + i := 0; + while True do begin + Inc(i); + try + SetLength(LBuffer, ChunkSize); + Stream.ReadBuffer(Pointer(LBuffer)^, ChunkSize); + LBuffer := Encoding.Convert(Encoding, TEncoding.Unicode, LBuffer); + // Success, exit loop + Break; + except + on E:EEncodingError do begin + if i=10 then // Give up + Raise; + Stream.Position := StartPosition; + Inc(ChunkSize, BufferPadding); + end; + end; + end; + + Result := TEncoding.Unicode.GetString(LBuffer); +end;} + + +{function ReadTextfile(Filename: String; Encoding: TEncoding): String; +var + Stream: TFileStream; +begin + // Read a text file into memory + OpenTextfile(Filename, Stream, Encoding); + Result := ReadTextfileChunk(Stream, Encoding); + Stream.Free; +end;} + + +{function ReadBinaryFile(Filename: String; MaxBytes: Int64): AnsiString; +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone); + Stream.Position := 0; + if (MaxBytes < 1) or (MaxBytes > Stream.Size) then MaxBytes := Stream.Size; + SetLength(Result, MaxBytes); + Stream.Read(PAnsiChar(Result)^, Length(Result)); + Stream.Free; +end;} + + +{procedure StreamToClipboard(Text, HTML: TStream); +var + TextContent, HTMLContent, HTMLHeader, NullPos: AnsiString; + GlobalMem: HGLOBAL; + lp: PChar; + ClpLen: Integer; + CF_HTML: Word; + StartHTML, EndHTML, StartFragment, EndFragment: Integer; +const + PosFormat: AnsiString = '%.10d'; + + procedure ReplacePos(Name: AnsiString; Value: Integer); + var NewPos: AnsiString; + begin + NewPos := Format(PosFormat, [Value]); + HTMLContent := StringReplace(HTMLContent, Name+':'+NullPos, Name+':'+NewPos, []); + end; +begin + // Copy unicode text to clipboard + if Assigned(Text) then begin + SetLength(TextContent, Text.Size); + Text.Position := 0; + Text.Read(PAnsiChar(TextContent)^, Text.Size); + Clipboard.TryAsText := Utf8ToString(TextContent); + SetString(TextContent, nil, 0); + end; + + if Assigned(HTML) then begin + // If wanted, add a HTML portion, so formatted text can be pasted in WYSIWYG + // editors (mostly MS applications). + // Note that the content is UTF8 encoded ANSI. Using unicode variables results in raw + // text pasted in editors. TODO: Find out why and optimize redundant code away by a loop. + OpenClipBoard(0); + CF_HTML := RegisterClipboardFormat('HTML Format'); + SetLength(HTMLContent, HTML.Size); + HTML.Position := 0; + HTML.Read(PAnsiChar(HTMLContent)^, HTML.Size); + if Pos(AnsiString('Version:'), HTMLContent) = 0 then begin + // Only required if header was not already prepended by SynEdit, e.g. in grid export of SQL Inserts + NullPos := Format(PosFormat, [0]); + HTMLHeader := 'Version:0.9' + sLineBreak + + 'StartHTML:' + NullPos + sLineBreak + + 'EndHTML:' + NullPos + sLineBreak + + 'StartFragment:' + NullPos + sLineBreak + + 'EndFragment:' + NullPos + sLineBreak; + StartHTML := Length(HTMLHeader); + HTMLContent := HTMLHeader + HTMLContent; + EndHTML := Length(HTMLContent); + StartFragment := Pos(AnsiString('<body>'), HTMLContent) + 6; + EndFragment := Pos(AnsiString('</body'), HTMLContent)-1; + ReplacePos('StartHTML', StartHTML); + ReplacePos('EndHTML', EndHTML); + ReplacePos('StartFragment', StartFragment); + ReplacePos('EndFragment', EndFragment); + end; + ClpLen := Length(HTMLContent) + 1; + GlobalMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, ClpLen); + lp := GlobalLock(GlobalMem); + Move(PAnsiChar(HTMLContent)^, lp[0], ClpLen); + SetString(HTMLContent, nil, 0); + GlobalUnlock(GlobalMem); + SetClipboardData(CF_HTML, GlobalMem); + CloseClipboard; + end; +end;} + + +{procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1); +var + SingleLineHeight: Integer; + Node: PVirtualNode; +begin + // This is called either in some early stage, or from preferences dialog + VT.BeginUpdate; + SingleLineHeight := GetTextHeight(VT.Font) + 7; + // Multiline nodes? + VT.DefaultNodeHeight := SingleLineHeight * MultiLineCount; + VT.Header.Height := SingleLineHeight; + // Apply new height to multi line grid nodes + Node := VT.GetFirstInitialized; + while Assigned(Node) do begin + VT.NodeHeight[Node] := VT.DefaultNodeHeight; + // Nodes have vsMultiLine through InitNode event + VT.MultiLine[Node] := MultiLineCount > 1; + Node := VT.GetNextInitialized(Node); + end; + VT.EndUpdate; + // 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] + else + VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions - [toHotTrack]; + VT.OnGetHint := MainForm.AnyGridGetHint; + VT.OnScroll := MainForm.AnyGridScroll; + VT.OnMouseWheel := MainForm.AnyGridMouseWheel; + VT.ShowHint := True; + + if toGridExtensions in VT.TreeOptions.MiscOptions then + VT.HintMode := hmHint // Show cell contents with linebreakds in datagrid and querygrid's + else + VT.HintMode := hmTooltip; // Just a quick tooltip for clipped nodes + // Apply case insensitive incremental search event + if VT.IncrementalSearch <> VirtualTrees.Types.isNone then + VT.OnIncrementalSearch := Mainform.AnyGridIncrementalSearch; + VT.OnStartOperation := Mainform.AnyGridStartOperation; + VT.OnEndOperation := Mainform.AnyGridEndOperation; +end;} + + +{function GetTextHeight(Font: TFont): Integer; +var + DC: HDC; + SaveFont: HFont; + SysMetrics, Metrics: TTextMetric; +begin + // Code taken from StdCtrls.TCustomEdit.AdjustHeight + DC := GetDC(0); + GetTextMetrics(DC, SysMetrics); + SaveFont := SelectObject(DC, Font.Handle); + GetTextMetrics(DC, Metrics); + SelectObject(DC, SaveFont); + ReleaseDC(0, DC); + Result := Metrics.tmHeight; +end;} + + +{function ColorAdjustBrightness(Col: TColor; Shift: SmallInt): TColor; +var + Lightness: Byte; +begin + // If base color is bright, make bg color darker (grey), and vice versa, so that + // colors work with high contrast mode for accessibility + Lightness := GetLightness(Col); + if (Lightness < 128) and (Shift < 0) then + Shift := Abs(Shift) + else if (Lightness > 128) and (Shift > 0) then + Shift := 0 - Abs(Shift); + Result := ColorAdjustLuma(Col, Shift, true); +end;} + + +{procedure DeInitializeVTNodes(Sender: TBaseVirtualTree); +var + Node: PVirtualNode; +begin + // Forces a VirtualTree to (re-)initialize its nodes. + // I wonder why this is not implemented in VirtualTree. + Node := Sender.GetFirstInitialized; + while Assigned(Node) do begin + Node.States := Node.States - [vsInitialized]; + Node := Sender.GetNextInitialized(Node); + end; +end;} + + +{function FindNode(VT: TVirtualStringTree; idx: Int64; ParentNode: PVirtualNode): PVirtualNode; +var + Node: PVirtualNode; +begin + // Helper to find a node by its index + Result := nil; + Node := nil; + try + if Assigned(ParentNode) then + Node := VT.GetFirstChild(ParentNode) + else + Node := VT.GetFirst; + except + // Sporadically, TBaseVirtualTree.GetFirst throws an exception when reading FRoot.FirstChild + // Tab restoring is sometimes crashing for that reason. + end; + while Assigned(Node) do begin + // Note: Grid.RootNodeCount is unfortunately Cardinal, not UInt64. + if Node.Index = idx then begin + Result := Node; + break; + end; + Node := VT.GetNextSibling(Node); + end; +end;} + + +{function SelectNode(VT: TVirtualStringTree; idx: Int64; ParentNode: PVirtualNode=nil): Boolean; overload; +var + Node: PVirtualNode; +begin + // Helper to focus and highlight a node by its index + Node := FindNode(VT, idx, ParentNode); + if Assigned(Node) then + Result := SelectNode(VT, Node) + else + Result := False; +end;} + + +{function SelectNode(VT: TVirtualStringTree; Node: PVirtualNode; ClearSelection: Boolean=True): Boolean; overload; +var + OldFocus: PVirtualNode; + MinimumColumnIndex: TColumnIndex; +begin + if Node = VT.RootNode then + Node := nil; + OldFocus := VT.FocusedNode; + Result := True; + if (Node <> OldFocus) and Assigned(VT.OnFocusChanging) then begin + VT.OnFocusChanging(VT, OldFocus, Node, VT.FocusedColumn, VT.FocusedColumn, Result); + end; + if Result then begin + if ClearSelection then + VT.ClearSelection; + VT.FocusedNode := Node; + MinimumColumnIndex := VT.Header.Columns.GetFirstVisibleColumn(True); + if VT.FocusedColumn < MinimumColumnIndex then + VT.FocusedColumn := MinimumColumnIndex; + VT.Selected[Node] := True; + VT.ScrollIntoView(Node, False); + if (OldFocus = Node) and Assigned(VT.OnFocusChanged) then + VT.OnFocusChanged(VT, Node, VT.FocusedColumn); + end; +end;} + + +{procedure GetVTSelection(VT: TVirtualStringTree; var SelectedCaptions: TStringList; var FocusedCaption: String); +var + Node: PVirtualNode; + InvalidationTag: Integer; +begin + // Return captions of selected nodes + InvalidationTag := vt.Tag; + vt.Tag := VTREE_LOADED; + SelectedCaptions.Clear; + Node := GetNextNode(VT, nil, true); + while Assigned(Node) do begin + SelectedCaptions.Add(VT.Text[Node, VT.Header.MainColumn]); + if Node = VT.FocusedNode then begin + FocusedCaption := VT.Text[Node, VT.Header.MainColumn]; + end; + Node := GetNextNode(VT, Node, true); + end; + vt.Tag := InvalidationTag; +end;} + + +{procedure SetVTSelection(VT: TVirtualStringTree; SelectedCaptions: TStringList; FocusedCaption: String); +var + Node: PVirtualNode; + idx: Integer; + DoFocusChange: Boolean; +begin + // Restore selected nodes based on captions list + DoFocusChange := False; + Node := GetNextNode(VT, nil, false); + while Assigned(Node) do begin + idx := SelectedCaptions.IndexOf(VT.Text[Node, VT.Header.MainColumn]); + if idx > -1 then + VT.Selected[Node] := True; + if (not FocusedCaption.IsEmpty) and (VT.Text[Node, VT.Header.MainColumn] = FocusedCaption) then begin + VT.FocusedNode := Node; + DoFocusChange := True; + end; + Node := GetNextNode(VT, Node, false); + end; + // Fire focus change event if there was a focused one before + if DoFocusChange and Assigned(VT.OnFocusChanged) then begin + VT.OnFocusChanged(VT, VT.FocusedNode, VT.FocusedColumn); + end; +end;} + + +{function GetNextNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode; +begin + // Get next visible + selected node. Not possible with VTree's own functions. + Result := CurrentNode; + while True do begin + if Selected then begin + if not Assigned(Result) then + Result := Tree.GetFirstSelected + else + Result := Tree.GetNextSelected(Result); + end else begin + if not Assigned(Result) then + Result := Tree.GetFirst + else + Result := Tree.GetNext(Result); + end; + if (not Assigned(Result)) or Tree.IsVisible[Result] then + break; + end; +end;} + + +{function GetPreviousNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode; +begin + // Get previous visible + selected node. + Result := CurrentNode; + while True do begin + if Selected then begin + if not Assigned(Result) then begin + Result := Tree.GetLast; + if not Tree.Selected[Result] then + Result := Tree.GetPreviousSelected(Result); + end else + Result := Tree.GetPreviousSelected(Result); + end else begin + if not Assigned(Result) then + Result := Tree.GetLast + else + Result := Tree.GetPrevious(Result); + end; + if (not Assigned(Result)) or Tree.IsVisible[Result] then + break; + end; +end;} + + +{function DateBackFriendlyCaption(d: TDateTime): String; +var + MonthsAgo, DaysAgo, HoursAgo, MinutesAgo: Int64; +begin + MonthsAgo := MonthsBetween(Now, d); + DaysAgo := DaysBetween(Now, d); + HoursAgo := HoursBetween(Now, d); + MinutesAgo := MinutesBetween(Now, d); + if MonthsAgo = 1 then Result := f_('%s month ago', [FormatNumber(MonthsAgo)]) + else if MonthsAgo > 1 then Result := f_('%s months ago', [FormatNumber(MonthsAgo)]) + else if DaysAgo = 1 then Result := f_('%s day ago', [FormatNumber(DaysAgo)]) + else if DaysAgo > 1 then Result := f_('%s days ago', [FormatNumber(DaysAgo)]) + else if HoursAgo = 1 then Result := f_('%s hour ago', [FormatNumber(HoursAgo)]) + else if HoursAgo > 1 then Result := f_('%s hours ago', [FormatNumber(HoursAgo)]) + else if MinutesAgo = 1 then Result := f_('%s minute ago', [FormatNumber(MinutesAgo)]) + else if MinutesAgo > 0 then Result := f_('%s minutes ago', [FormatNumber(MinutesAgo)]) + else Result := _('less than a minute ago'); +end;} + + +{function DateTimeToStrDef(DateTime: TDateTime; Default: String) : String; +begin + try + if DateTime = 0 then + Result := Default + else + Result := DateTimeToStr(DateTime); + except + on EInvalidOp do Result := Default; + end; +end;} + + +{function TruncDef(X: Real; Default: Int64): Int64; +begin + try + Result := Trunc(X); + except + on EInvalidOp do Result := Default; + end; +end;} + + +{procedure ExplodeQuotedList(Text: String; var List: TStringList); +var + i: Integer; + Quote: Char; + Opened, Closed: Boolean; + Item: String; +begin + Text := Trim(Text); + if Length(Text) > 0 then + Quote := Text[1] + else + Quote := '`'; + Opened := False; + Closed := True; + Item := ''; + for i:=1 to Length(Text) do begin + if Text[i] = Quote then begin + Opened := not Opened; + Closed := not Closed; + if Closed then begin + List.Add(Item); + Item := ''; + end; + Continue; + end; + if Opened and (not Closed) then + Item := Item + Text[i]; + end; +end;} + + +{function GetLightness(AColor: TColor): Byte; +var + R, G, B: Byte; + MaxValue, MinValue: Double; + Lightness: Double; +begin + R := GetRValue(ColorToRGB(AColor)); + G := GetGValue(ColorToRGB(AColor)); + B := GetBValue(ColorToRGB(AColor)); + MaxValue := Max(Max(R,G),B); + MinValue := Min(Min(R,G),B); + Lightness := (((MaxValue + MinValue) * 240) + 255 ) / 510; + Result := Round(Lightness); +end;} + + + +{ *** TSortItem } + +{procedure TSortItem.Assign(Source: TPersistent); +var + SourceItem: TSortItem; +begin + if Source is TSortItem then begin + SourceItem := Source as TSortItem; + Column := SourceItem.Column; + Order := SourceItem.Order; + end + else + Inherited; +end;} + + +{ *** TSortItems } + +{function TSortItems.AddNew(Column: String=''; Order: TSortItemOrder=sioAscending): TSortItem; +begin + Result := TSortItem.Create; + Result.Column := Column; + Result.Order := Order; + Add(Result); +end;} + + +{function TSortItems.ComposeOrderClause(Connection: TDBConnection): String; +var + SortItem: TSortItem; + SortOrder: String; +begin + // Concat all sort options to an ORDER BY clause + Result := ''; + for SortItem in Self do begin + if Result <> '' then + Result := Result + ', '; + if SortItem.Order = sioAscending then + SortOrder := Connection.GetSQLSpecifity(spOrderAsc) + else + SortOrder := Connection.GetSQLSpecifity(spOrderDesc); + Result := Result + Connection.QuoteIdent(SortItem.Column) + ' ' + SortOrder; + end; +end;} + + +{function TSortItems.FindByColumn(Column: String): TSortItem; +var + SortItem: TSortItem; +begin + Result := nil; + for SortItem in Self do begin + if SortItem.Column = Column then begin + Result := SortItem; + Break; + end; + end; +end;} + + +{procedure TSortItems.Assign(Source: TSortItems); +var + Item, ItemCopy: TSortItem; +begin + Clear; + for Item in Source do begin + ItemCopy := AddNew; + ItemCopy.Assign(Item); + end; +end;} + + +{ *** TDBObjectEditor } + +{constructor TDBObjectEditor.Create(AOwner: TComponent); +begin + inherited; + // Do not set alClient via DFM! In conjunction with ExplicitXXX properties that + // repeatedly breaks the GUI layout when you reload the project + Align := alClient; + FMainSynMemo := nil; + DBObject := nil; + TranslateComponent(Self); +end;} + +{destructor TDBObjectEditor.Destroy; +begin + inherited; +end;} + +{procedure TDBObjectEditor.SetModified(Value: Boolean); +begin + FModified := Value; +end;} + +{function TDBObjectEditor.ObjectExists: Boolean; +begin + Result := not DBObject.Name.IsEmpty; +end;} + +{procedure TDBObjectEditor.Init(Obj: TDBObject); +var + editName: TWinControl; + SynMemo: TSynMemo; + popup: TPopupMenu; + Item: TMenuItem; + i: Integer; + IsRefresh: Boolean; +begin + Mainform.ShowStatusMsg(_('Initializing editor ...')); + Mainform.LogSQL(Self.ClassName+'.Init, using object "'+Obj.Name+'"', lcDebug); + TExtForm.FixControls(Self); + IsRefresh := Assigned(DBObject) and DBObject.IsSameAs(Obj); + if IsRefresh and Assigned(FMainSynMemo) then + FMainSynMemoPreviousTopLine := FMainSynMemo.TopLine + else + FMainSynMemoPreviousTopLine := 0; + DBObject := TDBObject.Create(Obj.Connection); + DBObject.Assign(Obj); + Mainform.UpdateEditorTab; + Screen.Cursor := crHourglass; + // Enable user to start typing immediately when creating a new object + if DBObject.Name = '' then begin + editName := FindComponent('editName') as TWinControl; + if Assigned(editName) and editName.CanFocus then + editName.SetFocus; + end; + + for i:=0 to ComponentCount-1 do begin + if not(Components[i] is TSynMemo) then + Continue; + + SynMemo := Components[i] as TSynMemo; + if (not Assigned(SynMemo)) or Assigned(SynMemo.PopupMenu) then + Continue; + + popup := TPopupMenu.Create(Self); + popup.Images := MainForm.VirtualImageListMain; + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actCopy; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actCut; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actPaste; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actSelectAll; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actSaveSynMemoToTextfile; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actToggleComment; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actReformatSQL; + popup.Items.Add(Item); + + SynMemo.PopupMenu := popup; + + end; + +end;} + +{function TDBObjectEditor.DeInit: TModalResult; +var + Msg, ObjType: String; +begin + // Ask for saving modifications + Result := mrOk; + if Modified then begin + ObjType := _(LowerCase(DBObject.ObjType)); + // Todo: no save button for objects without minimum requirements, such as name. See #1134 + if DBObject.Name <> '' then + Msg := f_('Save modified %s "%s"?', [ObjType, DBObject.Name]) + else + Msg := f_('Save new %s?', [ObjType]); + Result := MessageDialog(Msg, mtConfirmation, [mbYes, mbNo, mbCancel]); + case Result of + mrYes: Result := ApplyModifications; + mrNo: Modified := False; + end; + end; +end;} + + + + +// Following code taken from OneInst.pas, http://assarbad.net/de/stuff/!import/nico.old/ +// Slightly modified to better integrate that into our code, comments translated from german. + +// Fetch and separate command line parameters into strings +{function ParamBlobToStr(lpData: Pointer): String; +var + pStr: PChar; +begin + pStr := lpData; + Result := string(pStr); +end;} + +// Pack current command line parameters +{function ParamStrToBlob(out cbData: DWORD): Pointer; +var + cmd: String; +begin + cmd := GetCommandLine; + cbData := Length(cmd)*2 + 3; + Result := PChar(cmd); +end;} + +{procedure HandleSecondInstance; +var + Run: DWORD; + Now: DWORD; + Msg: TMsg; + Wnd: HWND; + Dat: TCopyDataStruct; +begin + // MessageBox(0, 'already running', nil, MB_ICONINFORMATION); + // Send a message to all main windows (HWND_BROADCAST) with the identical, + // previously registered message id. We should only get reply from 0 or 1 + // instances. + // (Broadcast should only be called with registered message ids!) + + SendMessage(HWND_BROADCAST, SecondInstMsgId, GetCurrentThreadId, 0); + + // Waiting for reply by first instance. For those of you which didn't knew: + // Threads have message queues too ;o) + Wnd := 0; + Run := GetTickCount; + while True do + begin + if PeekMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId, PM_NOREMOVE) then + begin + GetMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId); + if Msg.message = SecondInstMsgId then + begin + Wnd := Msg.wParam; + Break; + end; + end; + Now := GetTickCount; + if Now < Run then + Run := Now; // Avoid overflow, each 48 days. + if Now - Run > 5000 then + Break; + end; + + if (Wnd <> 0) and IsWindow(Wnd) then + begin + // As a reply we got a handle to which we now send current parameters + Dat.dwData := SecondInstMsgId; + Dat.lpData := ParamStrToBlob(Dat.cbData); + SendMessage(Wnd, WM_COPYDATA, 0, LPARAM(@Dat)); + // Leads to an AV in 64bit mode. See issue #3475: + // FreeMemory(Dat.lpData); + + // Bring first instance to front + if IsIconic(Wnd) then + ShowWindow(Wnd, SW_RESTORE); + BringWindowToTop(Wnd); + SetForegroundWindow(Wnd); + end; +end;} + +{function CheckForSecondInstance: Boolean; +var + Loop: Integer; + MutexName: PChar; +begin + // Try to create a system wide named kernel object (mutex). And check if that + // already exists. + // The name of such a mutex must not be longer than MAX_PATH (260) chars and + // can contain all chars but not '\' + + Result := False; + MutexName := PChar(APPNAME); + for Loop := lstrlen(MutexName) to MAX_PATH - 1 do + begin + MutexHandle := CreateMutex(nil, False, MutexName); + if (MutexHandle = 0) and (GetLastError = INVALID_HANDLE_VALUE) then + // Looks like there is already a mutex using this name + // Try to solve that by appending an underscore + lstrcat(MutexName, '_') + else + // At least no naming conflict + Break; + end; + + case GetLastError of + 0: begin + // We created the mutex, so this is the first instance + end; + ERROR_ALREADY_EXISTS: + begin + // There is already one instance + try + HandleSecondInstance; + finally + // Terminating is done in .dpr file, before Application.Initialize + Result := True; + end; + end; + else + // No clue why we should get here. Oh, maybe Microsoft has changed rules, again. + // However, we return false and let the application start + end; +end;} + + +{function GetParentFormOrFrame(Comp: TWinControl): TWinControl; +begin + Result := Comp; + while True do begin + try + Result := Result.Parent; + except + on E:EAccessViolation do + Break; + end; + // On a windows shutdown, GetParentForm() seems sporadically unable to find the owner form + // In that case we would cause an exception when accessing it. Emergency break in that case. + // See issue #1462 + if (not Assigned(Result)) or (Result is TCustomForm) or (Result is TFrame) then + break; + end; +end;} + + +{function KeyPressed(Code: Integer): Boolean; +var + State: TKeyboardState; +begin + // Checks whether a key is pressed, defined by virtual key code + GetKeyboardState(State); + Result := (State[Code] and 128) <> 0; +end;} + + +{function GeneratePassword(Len: Integer): String; +var + i: Integer; + CharTable: String; +const + Consos = 'bcdfghjklmnpqrstvwxyzBCDFGHJKLMNPQRSTVWXYZ'; + Vocals = 'aeiouAEIOU'; + Numbers = '123456789'; +begin + // Create a random, mnemonic password + SetLength(Result, Len); + for i:=1 to Len do begin + if Random(4) = 1 then + CharTable := Numbers + else if i mod 2 = 0 then + CharTable := Vocals + else + CharTable := Consos; + Result[i] := CharTable[Random(Length(CharTable)-1)+1]; + end; +end;} + + +{procedure InvalidateVT(VT: TVirtualStringTree; RefreshTag: Integer; ImmediateRepaint: Boolean); +begin + // Avoid AVs in OnDestroy events + if not Assigned(VT) then + Exit; + VT.Tag := RefreshTag; + if ImmediateRepaint then + VT.Repaint + else + VT.Invalidate; +end;} + + +{function CharAtPos(Str: String; Pos: Integer): Char; +begin + // Access char in string without causing access violation + if Length(Str) < Pos then + Result := #0 + else + Result := Str[Pos]; +end;} + + +{function CompareAnyNode(Text1, Text2: String): Integer; +var + Number1, Number2 : Extended; + a1, a2, b1, b2: Char; + NumberMode: Boolean; +const + Numbers = ['0'..'9']; +begin + Result := 0; + // Apply different comparisons for numbers and text + a1 := CharAtPos(Text1, 1); + a2 := CharAtPos(Text1, 2); + b1 := CharAtPos(Text2, 1); + b2 := CharAtPos(Text2, 2); + NumberMode := ((a1='-') and (CharInSet(a2, Numbers)) or CharInSet(a1, Numbers)) + and ((b1='-') and (CharInSet(b2, Numbers)) or CharInSet(b1, Numbers)); + if NumberMode then begin + // Assuming numeric values + Number1 := MakeFloat(Text1); + Number2 := MakeFloat(Text2); + if Number1 > Number2 then + Result := 1 + else if Number1 = Number2 then + Result := 0 + else if Number1 < Number2 then + Result := -1; + end; + if (not NumberMode) or (Result=0) then begin + // Compare Strings + Result := CompareText(Text1, Text2); + end; +end;} + + +{function StringListCompareAnythingAsc(List: TStringList; Index1, Index2: Integer): Integer; +begin + // Sort TStringList items, containing numbers or strings, ascending + Result := CompareAnyNode(List[Index1], List[Index2]); +end;} + + +{function StringListCompareAnythingDesc(List: TStringList; Index1, Index2: Integer): Integer; +begin + // Sort TStringList items, containing numbers or strings, descending + Result := CompareAnyNode(List[Index2], List[Index1]); +end;} + + +{function StringListCompareByValue(List: TStringList; Index1, Index2: Integer): Integer; +begin + // Sort TStringList items which are stored as name=value pairs + Result := CompareAnyNode(List.ValueFromIndex[Index2], List.ValueFromIndex[Index1]); +end;} + + +{function StringListCompareByLength(List: TStringList; Index1, Index2: Integer): Integer; +begin + // Sort TStringList items by their length + Result := CompareValue(List[Index2].Length, List[Index1].Length); +end;} + + +{** + Return compile date/time from passed .exe name + Code taken and modified from Michael Puff + http://www.michael-puff.de/Programmierung/Delphi/Code-Snippets/GetImageLinkTimeStamp.shtml +} +{function GetImageLinkTimeStamp(const FileName: string): TDateTime; +const + INVALID_SET_FILE_POINTER = DWORD(-1); + BorlandMagicTimeStamp = $2A425E19; // Delphi 4-6 (and above?) + FileTime1970: TFileTime = (dwLowDateTime:$D53E8000; dwHighDateTime:$019DB1DE); +type + PImageSectionHeaders = ^TImageSectionHeaders; + TImageSectionHeaders = array [Word] of TImageSectionHeader; +type + PImageResourceDirectory = ^TImageResourceDirectory; + TImageResourceDirectory = packed record + Characteristics: DWORD; + TimeDateStamp: DWORD; + MajorVersion: Word; + MinorVersion: Word; + NumberOfNamedEntries: Word; + NumberOfIdEntries: Word; + end; +var + FileHandle: THandle; + BytesRead: DWORD; + ImageDosHeader: TImageDosHeader; + ImageNtHeaders: TImageNtHeaders; + SectionHeaders: PImageSectionHeaders; + Section: Word; + ResDirRVA: DWORD; + ResDirSize: DWORD; + ResDirRaw: DWORD; + ResDirTable: TImageResourceDirectory; + FileTime: TFileTime; + TimeStamp: DWord; +begin + TimeStamp := 0; + Result := 0; + // Open file for read access + FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); + if (FileHandle <> INVALID_HANDLE_VALUE) then try + // Read MS-DOS header to get the offset of the PE32 header + // (not required on WinNT based systems - but mostly available) + if not ReadFile(FileHandle, ImageDosHeader, SizeOf(TImageDosHeader), + BytesRead, nil) or (BytesRead <> SizeOf(TImageDosHeader)) or + (ImageDosHeader.e_magic <> IMAGE_DOS_SIGNATURE) then begin + ImageDosHeader._lfanew := 0; + end; + // Read PE32 header (including optional header + if (SetFilePointer(FileHandle, ImageDosHeader._lfanew, nil, FILE_BEGIN) = INVALID_SET_FILE_POINTER) then + Exit; + if not(ReadFile(FileHandle, ImageNtHeaders, SizeOf(TImageNtHeaders), BytesRead, nil) and (BytesRead = SizeOf(TImageNtHeaders))) then + Exit; + // Validate PE32 image header + if (ImageNtHeaders.Signature <> IMAGE_NT_SIGNATURE) then + Exit; + // Seconds since 1970 (UTC) + TimeStamp := ImageNtHeaders.FileHeader.TimeDateStamp; + + // Check for Borland's magic value for the link time stamp + // (we take the time stamp from the resource directory table) + if (ImageNtHeaders.FileHeader.TimeDateStamp = BorlandMagicTimeStamp) then + with ImageNtHeaders, FileHeader, OptionalHeader do begin + // Validate Optional header + if (SizeOfOptionalHeader < IMAGE_SIZEOF_NT_OPTIONAL_HEADER) or (Magic <> IMAGE_NT_OPTIONAL_HDR_MAGIC) then + Exit; + // Read section headers + SectionHeaders := + GetMemory(NumberOfSections * SizeOf(TImageSectionHeader)); + if Assigned(SectionHeaders) then try + if (SetFilePointer(FileHandle, SizeOfOptionalHeader - IMAGE_SIZEOF_NT_OPTIONAL_HEADER, nil, FILE_CURRENT) = INVALID_SET_FILE_POINTER) then + Exit; + if not(ReadFile(FileHandle, SectionHeaders^, NumberOfSections * SizeOf(TImageSectionHeader), BytesRead, nil) and (BytesRead = NumberOfSections * SizeOf(TImageSectionHeader))) then + Exit; + // Get RVA and size of the resource directory + with DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE] do begin + ResDirRVA := VirtualAddress; + ResDirSize := Size; + end; + // Search for section which contains the resource directory + ResDirRaw := 0; + for Section := 0 to NumberOfSections - 1 do + with SectionHeaders[Section] do + if (VirtualAddress <= ResDirRVA) and (VirtualAddress + SizeOfRawData >= ResDirRVA + ResDirSize) then begin + ResDirRaw := PointerToRawData - (VirtualAddress - ResDirRVA); + Break; + end; + // Resource directory table found? + if (ResDirRaw = 0) then + Exit; + // Read resource directory table + if (SetFilePointer(FileHandle, ResDirRaw, nil, FILE_BEGIN) = INVALID_SET_FILE_POINTER) then + Exit; + if not(ReadFile(FileHandle, ResDirTable, SizeOf(TImageResourceDirectory), BytesRead, nil) and (BytesRead = SizeOf(TImageResourceDirectory))) then + Exit; + // Convert from DosDateTime to SecondsSince1970 + if DosDateTimeToFileTime(HiWord(ResDirTable.TimeDateStamp), LoWord(ResDirTable.TimeDateStamp), FileTime) then begin + // FIXME: Borland's linker uses the local system time + // of the user who linked the executable image file. + // (is that information anywhere?) + TimeStamp := (ULARGE_INTEGER(FileTime).QuadPart - ULARGE_INTEGER(FileTime1970).QuadPart) div 10000000; + end; + finally + FreeMemory(SectionHeaders); + end; + end; + finally + CloseHandle(FileHandle); + end; + Result := UnixToDateTime(TimeStamp); +end;} + + +{function IsEmpty(Str: String): Boolean; +begin + // Alternative version of "Str = ''" + Result := Str = ''; +end;} + +{function IsNotEmpty(Str: String): Boolean; +begin + // Alternative version of "Str <> ''" + Result := Str <> ''; +end;} + + +{function MessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; +begin + Result := MessageDialog('', Msg, DlgType, Buttons); +end;} + + +{function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; KeepAskingSetting: TAppSettingIndex=asUnused; FooterText: String=''): Integer; +var + m: String; + Dialog: TTaskDialog; + Btn: TTaskDialogButtonItem; + MsgButton: TMsgDlgBtn; + rx: TRegExpr; + KeepAskingValue: Boolean; + Hotkeys: String; + WebSearchUrl, WebSearchHost: String; + + procedure AddButton(BtnCaption: String; BtnResult: TModalResult; ResourceId: Integer=0); + var + i: Integer; + cap: String; + begin + Btn := TTaskDialogButtonItem(Dialog.Buttons.Add); + cap := ''; + if ResourceId > 0 then begin + // Prefer string from user32.dll + // May be empty on Wine! + cap := GetLocaleString(ResourceId) + end; + if cap.IsEmpty then begin + cap := _(BtnCaption); + for i:=1 to Length(cap) do begin + // Auto apply hotkey + if (Pos(LowerCase(cap[i]), Hotkeys) = 0) and cap[i].IsLetter then begin + Hotkeys := Hotkeys + LowerCase(cap[i]); + Insert('&', cap, i); + break; + end; + end; + end; + Btn.Caption := cap; + Btn.ModalResult := BtnResult; + if (DlgType = mtCriticalConfirmation) and (BtnResult = mrCancel) then + Btn.Default := True; + end; +begin + // Remember current path and restore it later, so the caller does not try to read from the wrong path after this dialog + AppSettings.StorePath; + + if (Win32MajorVersion >= 6) and StyleServices.Enabled then begin + // Use modern task dialog on Vista and above + Dialog := TTaskDialog.Create(nil); + Dialog.Flags := [tfEnableHyperlinks, tfAllowDialogCancellation]; + Dialog.CommonButtons := []; + if Assigned(MainForm) then + Dialog.OnHyperlinkClicked := MainForm.TaskDialogHyperLinkClicked; + + // Caption, title and text + case DlgType of + mtWarning: Dialog.Caption := _('Warning'); + mtError: Dialog.Caption := _('Error'); + mtInformation: Dialog.Caption := _('Information'); + mtConfirmation, mtCustom: Dialog.Caption := _('Confirm'); + end; + if Title <> Dialog.Caption then + Dialog.Title := Title; + if Assigned(MainForm) and (MainForm.ActiveConnection <> nil) then + Dialog.Caption := MainForm.ActiveConnection.Parameters.SessionName + ': ' + Dialog.Caption; + rx := TRegExpr.Create; + rx.Expression := 'https?://[^\s"]+'; + if ThemeIsDark then + Dialog.Text := Msg + else // See issue #2036 + Dialog.Text := rx.Replace(Msg, '<a href="$0">$0</a>', True); + rx.Free; + + // Main icon, and footer link + case DlgType of + mtWarning: + Dialog.MainIcon := tdiWarning; + mtError: begin + Dialog.MainIcon := tdiError; + WebSearchUrl := AppSettings.ReadString(asWebSearchBaseUrl); + WebSearchUrl := StringReplace(WebSearchUrl, '%q', EncodeURLParam(Copy(Msg, 1, 1000)), []); + rx := TRegExpr.Create; + rx.Expression := 'https?://(www\.)?([^/]+)/'; + if rx.Exec(WebSearchUrl) then + WebSearchHost := rx.Match[2] + else + WebSearchHost := '[unknown host]'; + rx.Free; + Dialog.FooterText := IfThen(FooterText.IsEmpty, '', FooterText + sLineBreak + sLineBreak) + + '<a href="'+WebSearchUrl+'">'+_('Find some help on this error')+' (=> '+WebSearchHost+')</a>'; + Dialog.FooterIcon := tdiInformation; + end; + mtInformation: + Dialog.MainIcon := tdiInformation; + mtConfirmation, mtCustom: begin + Dialog.Flags := Dialog.Flags + [tfUseHiconMain]; + Dialog.CustomMainIcon := ConfirmIcon; + end; + else + Dialog.MainIcon := tdiNone; + end; + + // Add buttons + for MsgButton in Buttons do begin + case MsgButton of + mbYes: AddButton('Yes', mrYes, 805); + mbNo: AddButton('No', mrNo, 806); + mbOK: AddButton('OK', mrOk, 800); + mbCancel: AddButton('Cancel', mrCancel, 801); + mbAbort: AddButton('Abort', mrAbort, 802); + mbRetry: AddButton('Retry', mrRetry, 803); + mbIgnore: AddButton('Ignore', mrIgnore, 804); + mbAll: AddButton('All', mrAll); + mbNoToAll: AddButton('No to all', mrNoToAll); + mbYesToAll: AddButton('Yes to all', mrYesToAll); + mbClose: AddButton('Close', mrClose, 807); + end; + end; + + // Checkbox, s'il vous plait? + KeepAskingValue := True; + if KeepAskingSetting <> asUnused then begin + if (not (mbNo in Buttons)) and (Buttons <> [mbOK]) then + raise Exception.CreateFmt(_('Missing "No" button in %() call'), ['MessageDialog']); + KeepAskingValue := AppSettings.ReadBool(KeepAskingSetting); + Dialog.Flags := Dialog.Flags + [tfVerificationFlagChecked]; + if Buttons = [mbOK] then + Dialog.VerificationText := _('Keep showing this dialog.') + else + Dialog.VerificationText := _('Keep asking this question.'); + end; + + // Supress dialog and assume "No" if user disabled this dialog + if KeepAskingValue then begin + Dialog.Execute; + Result := Dialog.ModalResult; + if (KeepAskingSetting <> asUnused) and (not (tfVerificationFlagChecked in Dialog.Flags)) then + AppSettings.WriteBool(KeepAskingSetting, False); + end else + Result := mrNo; + + Dialog.Free; + end else begin + // Backwards compatible dialog on Windows XP + m := Msg; + if not Title.IsEmpty then + m := Title + SLineBreak + SLineBreak + m; + if not FooterText.IsEmpty then + m := m + SLineBreak + SLineBreak + FooterText; + + if KeepAskingSetting <> asUnused then + KeepAskingValue := AppSettings.ReadBool(KeepAskingSetting) + else + KeepAskingValue := True; + + if KeepAskingValue then + Result := MessageDlg(m, DlgType, Buttons, 0) + else + Result := mrNo; + end; + + AppSettings.RestorePath; +end;} + + +{function ErrorDialog(Msg: string): Integer; +begin + Result := MessageDialog('', Msg, mtError, [mbOK]); +end;} + + +{function ErrorDialog(const Title, Msg: string): Integer; +begin + Result := MessageDialog(Title, Msg, mtError, [mbOK]); +end;} + + +{function GetLocaleString(const ResourceId: Integer): WideString; +var + Buffer: WideString; + BufferLen: Integer; +begin + Result := ''; + if LibHandleUser32 <> 0 then begin + SetLength(Buffer, 255); + BufferLen := LoadStringW(LibHandleUser32, ResourceId, PWideChar(Buffer), Length(Buffer)); + if BufferLen <> 0 then + Result := Copy(Buffer, 1, BufferLen); + end; +end;} + + +{function GetHTMLCharsetByEncoding(Encoding: TEncoding): String; +begin + Result := ''; + if Encoding = TEncoding.Default then + Result := 'Windows-'+IntToStr(GetACP) + else if Encoding.CodePage = 437 then + Result := 'ascii' + else if Encoding = TEncoding.Unicode then + Result := 'utf-16le' + else if Encoding = TEncoding.BigEndianUnicode then + Result := 'utf-16' + else if Encoding = TEncoding.UTF8 then + Result := 'utf-8' + else if Encoding = TEncoding.UTF7 then + Result := 'utf-7'; +end;} + + +{procedure ParseCommandLine(CommandLine: String; var ConnectionParams: TConnectionParameters; var FileNames: TStringList; var RunFrom: String); +var + rx: TRegExpr; + ExeName, SessName, Host, Lib, Port, User, Pass, Socket, AllDatabases, + SSLPrivateKey, SSLCACertificate, SSLCertificate, SSLCipher: String; + NetType, WindowsAuth, WantSSL, CleartextPluginEnabled, SSLVerification: Integer; + AbsentFiles: TStringList; + + function GetParamValue(ShortName, LongName: String): String; + begin + // Return one command line switch. Doublequotes are not mandatory. + Result := ''; + rx.Expression := '\s(\-'+ShortName+'|\-\-'+LongName+')\s*\=?\s*\"([^\-][^\"]*)\"'; + if rx.Exec(CommandLine) then + Result := rx.Match[2] + else begin + rx.Expression := '\s(\-'+ShortName+'|\-\-'+LongName+')\s*\=?\s*([^\-]\S*)'; + if rx.Exec(CommandLine) then + Result := rx.Match[2]; + end; + end; + + procedure GetFileNames(Expression: String); + begin + rx.Expression := Expression; + if rx.Exec(CommandLine) then while true do begin + if FileExists(rx.Match[1]) then + FileNames.Add(rx.Match[1]) + else + AbsentFiles.Add(rx.Match[1]); + // Remove match from input string, so the second call to GetFileNames without quotes + // does not detect filenames cut at whitespace + Delete(CommandLine, rx.MatchPos[1], rx.MatchLen[1]); + if not rx.ExecNext then + break; + end; + end; + +begin + // Parse command line, probably sent by blocked second application instance. + // Try to build connection parameters out of it. + SessName := ''; + FileNames := TStringList.Create; + AbsentFiles := TStringList.Create; + + // Add leading (and trailing) space, so the regular expressions can request a mandantory space + // before (and after) each param (and filename) including the first one (and last one) + ExeName := ExtractFileName(ParamStr(0)); + CommandLine := Copy(CommandLine, Pos(ExeName, CommandLine)+Length(ExeName), Length(CommandLine)); + CommandLine := CommandLine + ' '; + rx := TRegExpr.Create; + + // --runfrom=scheduler after build update + RunFrom := GetParamValue('rf', 'runfrom'); + + SessName := GetParamValue('d', 'description'); + if SessName <> '' then begin + try + ConnectionParams := TConnectionParameters.Create(SessName); + except + on E:Exception do begin + // Session params not found in registry + MainForm.LogSQL(E.Message); + end; + end; + end; + + // Test if params were passed. If given, override previous values loaded from registry. + // Enables the user to log into a session with a different, non-stored user: -dSession -uSomeOther + NetType := StrToIntDef(GetParamValue('n', 'nettype'), 0); + Host := GetParamValue('h', 'host'); + Lib := GetParamValue('l', 'library'); + User := GetParamValue('u', 'user'); + Pass := GetParamValue('p', 'password'); + CleartextPluginEnabled := StrToIntDef(GetParamValue('cte', 'cleartextenabled'), -1); + Socket := GetParamValue('S', 'socket'); + Port := GetParamValue('P', 'port'); + AllDatabases := GetParamValue('db', 'databases'); + WindowsAuth := StrToIntDef(GetParamValue('W', 'winauth'), -1); + WantSSL := StrToIntDef(GetParamValue('ssl', 'ssl'), -1); + SSLPrivateKey := GetParamValue('sslpk', 'sslprivatekey'); + SSLCACertificate := GetParamValue('sslca', 'sslcacertificate'); + SSLCertificate := GetParamValue('sslcert', 'sslcertificate'); + SSLCipher := GetParamValue('sslcip', 'sslcipher'); + SSLVerification := StrToIntDef(GetParamValue('sslvrf', 'sslverification'), -1); + // Leave out support for startup script, seems reasonable for command line connecting + + if (Host <> '') or (User <> '') or (Pass <> '') or (Port <> '') or (Socket <> '') or (AllDatabases <> '') then begin + if not Assigned(ConnectionParams) then begin + ConnectionParams := TConnectionParameters.Create; + ConnectionParams.SessionPath := SessName; + end; + if NetType <> 0 then ConnectionParams.NetType := TNetType(NetType); + try + ConnectionParams.GetNetTypeGroup; + except + ConnectionParams.NetType := ntMySQL_TCPIP; + end; + if Host <> '' then ConnectionParams.Hostname := Host; + if Lib <> '' then ConnectionParams.LibraryOrProvider := Lib; + if ConnectionParams.LibraryOrProvider.IsEmpty then ConnectionParams.LibraryOrProvider := ConnectionParams.DefaultLibrary; + if User <> '' then ConnectionParams.Username := User; + if Pass <> '' then ConnectionParams.Password := Pass; + if CleartextPluginEnabled in [0,1] then + ConnectionParams.CleartextPluginEnabled := Boolean(CleartextPluginEnabled); + if Port <> '' then ConnectionParams.Port := StrToIntDef(Port, 0); + if Socket <> '' then begin + ConnectionParams.Hostname := Socket; + ConnectionParams.NetType := ntMySQL_NamedPipe; + end; + if AllDatabases <> '' then ConnectionParams.AllDatabasesStr := AllDatabases; + if WantSSL in [0,1] then + ConnectionParams.WantSSL := Boolean(WantSSL); + if SSLPrivateKey <> '' then + ConnectionParams.SSLPrivateKey := SSLPrivateKey; + if SSLCACertificate <> '' then + ConnectionParams.SSLCACertificate := SSLCACertificate; + if SSLCertificate <> '' then + ConnectionParams.SSLCertificate := SSLCertificate; + if SSLCipher <> '' then + ConnectionParams.SSLCipher := SSLCipher; + if SSLVerification >= 0 then + ConnectionParams.SSLVerification := SSLVerification; + + if WindowsAuth in [0,1] then + ConnectionParams.WindowsAuth := Boolean(WindowsAuth); + + // Ensure we have a session name to pass to InitConnection + if (ConnectionParams.SessionPath = '') and (ConnectionParams.Hostname <> '') then + ConnectionParams.SessionPath := ConnectionParams.Hostname; + end; + + // Check for valid filename(s) in parameters. + // We support doublequoted and unquoted parameters. + GetFileNames('\"([^\"]+\.sql)\"'); + GetFileNames('\s([^\s\"]+\.sql)\b'); + if AbsentFiles.Count > 0 then + ErrorDialog(_('Could not load file(s):'), AbsentFiles.Text); + AbsentFiles.Free; + + rx.Free; +end;} + + +function _(const Pattern: string): string; +begin + // gnugettext not working yet... + Result := Pattern; +end; + + +function f_(const Pattern: string; const Args: array of const): string; +var + TranslatedPattern: String; +begin + // Helper for translation, replacement for Format(_()) + try + TranslatedPattern := Pattern; //_(Pattern); + Result := Format(TranslatedPattern, Args); + except + on E:Exception do begin + MainForm.LogSQL(E.ClassName+' in translation string with invalid format arguments: "'+TranslatedPattern+'"', lcError); + Result := Format(Pattern, Args); + end; + end; +end; + + +{function GetOutputFilename(FilenameWithPlaceholders: String; DBObj: TDBObject): String; +var + Arguments: TExtStringList; + Year, Month, Day, Hour, Min, Sec, MSec: Word; + i: Integer; +begin + // Rich format output filename, replace certain markers. See issue #2622 + Arguments := TExtStringList.Create; + + if Assigned(DBObj) then begin + Arguments.Values['session'] := ValidFilename(DBObj.Connection.Parameters.SessionName); + Arguments.Values['host'] := ValidFilename(DBObj.Connection.Parameters.Hostname); + Arguments.Values['u'] := ValidFilename(DBObj.Connection.Parameters.Username); + Arguments.Values['db'] := ValidFilename(DBObj.Database); + end; + Arguments.Values['date'] := ValidFilename(DateTimeToStr(Now)); + DecodeDateTime(Now, Year, Month, Day, Hour, Min, Sec, MSec); + Arguments.Values['d'] := Format('%.2d', [Day]); + Arguments.Values['m'] := Format('%.2d', [Month]); + Arguments.Values['y'] := Format('%.4d', [Year]); + Arguments.Values['h'] := Format('%.2d', [Hour]); + Arguments.Values['i'] := Format('%.2d', [Min]); + Arguments.Values['s'] := Format('%.2d', [Sec]); + + Result := FilenameWithPlaceholders; + for i:=0 to Arguments.Count-1 do begin + Result := StringReplace(Result, '%'+Arguments.Names[i], Arguments.ValueFromIndex[i], [rfReplaceAll]); + end; + Arguments.Free; +end;} + + +{function GetOutputFilenamePlaceholders: TStringList; +begin + // Return a list with valid placeholder=>description pairs + Result := TStringList.Create; + Result.Values['session'] := _('Session name'); + Result.Values['host'] := _('Hostname'); + Result.Values['u'] := _('Username'); + Result.Values['db'] := _('Database'); + Result.Values['date'] := _('Date and time'); + Result.Values['d'] := _('Day of month'); + Result.Values['m'] := _('Month'); + Result.Values['y'] := _('Year'); + Result.Values['h'] := _('Hour'); + Result.Values['i'] := _('Minute'); + Result.Values['s'] := _('Second'); +end;} + + +{function GetSystemImageList: TImageList; +var + Info: TSHFileInfo; + ImageListHandle: Cardinal; +begin + // Create shared imagelist once and use in TPopupMenu and TVirtualTree or whatever + if SystemImageList = nil then begin + ImageListHandle := SHGetFileInfo('', 0, Info, SizeOf(Info), SHGFI_SYSICONINDEX or SHGFI_SMALLICON); + if ImageListHandle <> 0 then begin + SystemImageList := TImageList.Create(MainForm); + SystemImageList.Handle := ImageListHandle; + SystemImageList.ShareImages := true; + SystemImageList.DrawingStyle := dsTransparent; + end; + end; + Result := SystemImageList; +end;} + + +{function GetSystemImageIndex(Filename: String): Integer; +var + Info: TSHFileInfo; +begin + // Return image index of shared system image list, for a given filename + SHGetFileInfo(PChar(Filename), 0, Info, SizeOf(Info), SHGFI_SYSICONINDEX or SHGFI_TYPENAME); + Result := Info.iIcon; +end;} + + +{function GetExecutableBits: Byte; +begin} + //{$IFDEF WIN64} + //Result := 64; + //{$ELSE} + //Result := 32; + //{$ENDIF} +//end; + + +{procedure Help(Sender: TObject; Anchor: String); +var + Place: String; +begin + // Go to online help page + if Sender is TAction then + Place := (Sender as TAction).ActionComponent.Name + else if Sender is TControl then + Place := (Sender as TControl).Name + else + Place := 'unhandled-'+Sender.ClassName; + if not Anchor.IsEmpty then + Anchor := '#'+Anchor; + ShellExec(APPDOMAIN+'help.php?place='+EncodeURLParam(Place)+Anchor); +end;} + + +{function PortOpen(Port: Word): Boolean; +var + client: sockaddr_in; + sock: Integer; + ret: Integer; + wsdata: WSAData; +begin + Result := True; + ret := WSAStartup($0002, wsdata); + if ret<>0 then + Exit; + try + client.sin_family := AF_INET; + client.sin_port := htons(Port); + client.sin_addr.s_addr := inet_addr(PAnsiChar('127.0.0.1')); + sock := socket(AF_INET, SOCK_STREAM, 0); + Result := connect(sock, client, SizeOf(client)) <> 0; + finally + WSACleanup; + end; +end;} + + +{function IsValidFilePath(FilePath: String): Boolean; +var + Pieces: TStringList; + i: Integer; +begin + // Check file path for invalid characters. See http://www.heidisql.com/forum.php?t=20873 + Result := True; + Pieces := TStringList.Create; + SplitRegExpr('[\\\/]', FilePath, Pieces); + for i:=1 to Pieces.Count-1 do begin + Result := Result and TPath.HasValidFileNameChars(Pieces[i], False); + end; + Pieces.Free; +end;} + + +{function FileIsWritable(FilePath: String): Boolean; +var + hFile: DWORD; +begin + // Check if file is writable + if not FileExists(FilePath) then begin + // Return true if file does not exist + Result := True; + end else begin + hFile := CreateFile(PChar(FilePath), GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0); + Result := hFile <> INVALID_HANDLE_VALUE; + CloseHandle(hFile); + end; +end;} + + +{function GetThemeColor(Color: TColor): TColor; +begin + // Not required with vcl-style-utils: + // Result := TStyleManager.ActiveStyle.GetSystemColor(Color); + Result := Color; +end;} + + +{function ThemeIsDark(ThemeName: String=''): Boolean; +const + DarkThemes: String = 'Amakrits,Aqua Graphite,Auric,Carbon,Charcoal Dark Slate,Cobalt XEMedia,Glossy,Glow,Golden Graphite,Material,Onyx Blue,Ruby Graphite,TabletDark,Windows10 Dark,Windows10 SlateGray'; +var + DarkThemesList: TStringList; +begin + DarkThemesList := Explode(',', DarkThemes); + if ThemeName.IsEmpty then + ThemeName := TStyleManager.ActiveStyle.Name; + Result := DarkThemesList.IndexOf(ThemeName) > -1; + DarkThemesList.Free; +end;} + + +{function ProcessExists(pid: Cardinal; ExeNamePattern: String): Boolean; +var + Proc: TProcessEntry32; + SnapShot: THandle; + ContinueLoop: Boolean; +begin + // Check if a given process id exists + SnapShot := CreateToolhelp32Snapshot(TH32CS_SnapProcess, 0); + Proc.dwSize := Sizeof(Proc); + Result := False; + ContinueLoop := Process32First(SnapShot, Proc); + while ContinueLoop do begin + Result := (Proc.th32ProcessID = pid) and ContainsText(Proc.szExeFile, ExeNamePattern); + if Result then + Break; + ContinueLoop := Process32Next(SnapShot, Proc); + end; + CloseHandle(Snapshot); +end;} + + +{procedure ToggleCheckBoxWithoutClick(chk: TCheckBox; State: Boolean); +var + ClickEvent: TNotifyEvent; +begin + ClickEvent := chk.OnClick; + chk.OnClick := nil; + chk.Checked := State; + chk.OnClick := ClickEvent; +end;} + + +{function SynCompletionProposalPrettyText(ImageIndex: Integer; LeftText, CenterText, RightText: String; + LeftColor: TColor=-1; CenterColor: TColor=-1; RightColor: TColor=-1): String; +const} +// LineFormat = '\image{%d}\hspace{5}\color{%s}%s\column{}\color{%s}%s\hspace{10}\color{%s}\style{+i}%s'; +{begin + // Return formatted item string for a TSynCompletionProposal + if LeftColor = -1 then LeftColor := clGrayText; + if CenterColor = -1 then CenterColor := clWindowText; + if RightColor = -1 then RightColor := clGrayText; + Result := Format(LineFormat, [ImageIndex, ColorToString(LeftColor), LeftText, ColorToString(CenterColor), CenterText, ColorToString(RightColor), RightText]); +end;} + + +{function PopupComponent(Sender: TObject): TComponent; +var + Menu: TObject; +begin + // Return owner component of clicked menu item, probably combined with a TAction + Result := nil; + Menu := nil; + if Sender is TAction then + Sender := (Sender as TAction).ActionComponent; + + if Sender is TMenuItem then + Menu := (Sender as TMenuItem).GetParentMenu + else if Sender is TPopupMenu then + Menu := Sender; + + if Menu is TPopupMenu then + Result := (Menu as TPopupMenu).PopupComponent; +end;} + + +{function IsWine: Boolean; +var + NTHandle: THandle; + wine_nt_to_unix_file_name: procedure(p1:pointer; p2:pointer); stdcall; +begin + // Detect if we're running on Wine, not on native Windows + // Idea taken from http://ruminatedrumblings.blogspot.com/2008/04/detecting-virtualized-environment.html + if IsWineStored = -1 then begin + NTHandle := LoadLibrary('NTDLL.DLL'); + if NTHandle>32 then + wine_nt_to_unix_file_name := GetProcAddress(NTHandle, 'wine_nt_to_unix_file_name') + else + wine_nt_to_unix_file_name := nil; + IsWineStored := IfThen(Assigned(wine_nt_to_unix_file_name), 1, 0); + FreeLibrary(NTHandle); + end; + Result := IsWineStored = 1; +end;} + + +{function DirSep: Char; +begin + if IsWine then + Result := '/' + else + Result := '\'; +end;} + +{procedure FindComponentInstances(BaseForm: TComponent; ClassType: TClass; var List: TObjectList); +var + i: Integer; +begin + for i:=0 to BaseForm.ComponentCount-1 do begin + if BaseForm.Components[i] is ClassType then + List.Add(BaseForm.Components[i] as ClassType) + else + FindComponentInstances(BaseForm.Components[i], ClassType, List); + end; +end;} + +{function WebColorStrToColorDef(WebColor: string; Default: TColor): TColor; +begin + try + Result := WebColorStrToColor(WebColor); + except + Result := Default; + end; +end;} + + +{function UserAgent(OwnerComponent: TComponent): String; +var + OS: String; +begin + if IsWine then + OS := 'Linux/Wine' + else + OS := 'Windows NT '+IntToStr(Win32MajorVersion)+'.'+IntToStr(Win32MinorVersion); + Result := APPNAME+'/'+MainForm.AppVersion+' ('+OS+'; '+ExtractFilename(Application.ExeName)+'; '+OwnerComponent.Name+')'; +end;} + + +{function CodeIndent(Steps: Integer=1): String; +begin + // Provide tab or spaces for indentation, uniquely used for all SQL statements + if AppSettings.ReadBool(asTabsToSpaces) then + Result := StringOfChar(' ', AppSettings.ReadInt(asTabWidth) * Steps) + else + Result := StringOfChar(#9, Steps); +end;} + + +{function EscapeHotkeyPrefix(Text: String): String; +begin + // Issue #1992: Escape ampersand in caption of menus and tabs, preventing underlined hotkey generation + Result := StringReplace(Text, Vcl.Menus.cHotkeyPrefix, Vcl.Menus.cHotkeyPrefix + Vcl.Menus.cHotkeyPrefix, [rfReplaceAll]); +end;} + + +{ Get SID of current Windows user, probably useful in the future +{function GetCurrentUserSID: string; +type + PTOKEN_USER = ^TOKEN_USER; + _TOKEN_USER = record + User: TSidAndAttributes; + end; + TOKEN_USER = _TOKEN_USER; +var + hToken: THandle; + cbBuf: Cardinal; + ptiUser: PTOKEN_USER; + bSuccess: Boolean; + StrSid: PWideChar; +begin + // Taken from https://stackoverflow.com/a/71730865/4110077 + // SidToString does not exist, prefer WinApi.Windows.ConvertSidToStringSid() + Result := ''; + + // Get the calling thread's access token. + if not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hToken) then + begin + if (GetLastError <> ERROR_NO_TOKEN) then + Exit; + + // Retry against process token if no thread token exists. + if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken) then + Exit; + end; + try + // Obtain the size of the user information in the token. + bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf); + ptiUser := nil; + try + while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do + begin + ReallocMem(ptiUser, cbBuf); + bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf); + end; + ConvertSidToStringSid(ptiUser.User.Sid, StrSid); + Result := StrSid; + finally + FreeMem(ptiUser); + end; + finally + CloseHandle(hToken); + end; +end;} + + +{ Threading stuff } + +{constructor TQueryThread.Create(Connection: TDBConnection; Batch: TSQLBatch; TabNumber: Integer); +begin + inherited Create(False); + FConnection := Connection; + FAborted := False; + FBatch := Batch; + FTabNumber := TabNumber; + FBatchPosition := 0; + FQueryStartedAt := Now; + FQueryTime := 0; + FQueryNetTime := 0; + FRowsAffected := 0; + FRowsFound := 0; + FWarningCount := 0; + FErrorMessage := ''; + FBatchInOneGo := MainForm.actBatchInOneGo.Checked; + FStopOnErrors := MainForm.actQueryStopOnErrors.Checked; + FreeOnTerminate := True; + Priority := tpNormal; +end;} + + +{procedure TQueryThread.Execute; +var + SQL: String; + i, BatchStartOffset, ResultCount: Integer; + PacketSize, MaxAllowedPacket: Int64; + DoStoreResult, ErrorAborted, LogMaxResultsDone: Boolean; +begin + inherited; + + MaxAllowedPacket := 0; + i := 0; + ResultCount := 0; + ErrorAborted := False; + LogMaxResultsDone := False; + + while i < FBatch.Count do begin + SQL := ''; + if not FBatchInOneGo then begin + SQL := FBatch[i].SQL; + Inc(i); + end else begin + // Concat queries up to a size of max_allowed_packet + if MaxAllowedPacket = 0 then begin + FConnection.SetLockedByThread(Self); + MaxAllowedPacket := FConnection.MaxAllowedPacket; + FConnection.SetLockedByThread(nil); + // TODO: Log('Detected maximum allowed packet size: '+FormatByteNumber(MaxAllowedPacket), lcDebug); + end; + BatchStartOffset := FBatch[i].LeftOffset; + while i < FBatch.Count do begin + PacketSize := FBatch[i].RightOffset - BatchStartOffset + ((i-FBatchPosition) * 20); + if not SQL.IsEmpty then begin + if PacketSize >= MaxAllowedPacket then begin + // TODO: Log('Limiting batch packet size to '+FormatByteNumber(Length(SQL))+' with '+FormatNumber(i-FUserQueryOffset)+' queries.', lcDebug); + Break; + end + else begin + // Don't append to the very last query. See issue #1583 + SQL := SQL + '; '; + end; + end; + SQL := SQL + FBatch[i].SQL; + Inc(i); + end; + FQueriesInPacket := i - FBatchPosition; + end; + Synchronize(procedure begin MainForm.BeforeQueryExecution(Self); end); + try + FConnection.SetLockedByThread(Self); + DoStoreResult := ResultCount < AppSettings.ReadInt(asMaxQueryResults); + if (not DoStoreResult) and (not LogMaxResultsDone) then begin + // Inform user about preference setting for limiting result tabs + FConnection.Log(lcInfo, + f_('Reached maximum number of result tabs (%d). To display more results, increase setting in Preferences > SQL', [AppSettings.ReadInt(asMaxQueryResults)]) + ); + LogMaxResultsDone := True; + end; + FConnection.Query(SQL, DoStoreResult, lcUserFiredSQL); + Inc(ResultCount, FConnection.ResultCount); + FBatchPosition := i; + Inc(FQueryTime, FConnection.LastQueryDuration); + Inc(FQueryNetTime, FConnection.LastQueryNetworkDuration); + Inc(FRowsAffected, FConnection.RowsAffected); + Inc(FRowsFound, FConnection.RowsFound); + Inc(FWarningCount, FConnection.WarningCount); + except + on E:EDbError do begin + if FStopOnErrors or (i = FBatch.Count - 1) then begin + FErrorMessage := E.Message; + ErrorAborted := True; + end; + end; + 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 + break; + end; + + Synchronize(procedure begin MainForm.FinishedQueryExecution(Self); end); +end;} + + +{procedure TQueryThread.LogFromThread(Msg: String; Category: TDBLogCategory); +begin + Queue(procedure begin FConnection.Log(Category, Msg); end); +end;} + + +{ TSQLSentence } + +{constructor TSQLSentence.Create(Owner: TSQLBatch); +begin + // Use a back reference to the parent batch object, so we can extract SQL from it + FOwner := Owner; +end;} + + +{function TSQLSentence.GetSize: Integer; +begin + Result := RightOffset - LeftOffset; +end;} + + +{function TSQLSentence.GetSQL: String; +begin + // Result := Copy(FOwner.SQL, LeftOffset, RightOffset-LeftOffset); + // Probably faster than Copy(): + SetString(Result, PChar(FOwner.SQL) +LeftOffset -1, RightOffset-LeftOffset); +end;} + + +{function TSQLSentence.GetSQLWithoutComments: String; +begin + Result := FOwner.GetSQLWithoutComments(GetSQL); +end;} + + +{ TSQLBatch } + +{function TSQLBatch.GetSize: Integer; +var + Query: TSQLSentence; +begin + // Return overall string length of batch + Result := 0; + for Query in Self do + Inc(Result, Query.Size); +end;} + + +{procedure TSQLBatch.SetSQL(Value: String); +var + i, AllLen, DelimLen, DelimStart, LastLeftOffset, RightOffset: Integer; + c, n, LastStringEncloser: Char; + Delim, DelimTest, QueryTest: String; + InString, InComment, InBigComment, InEscape: Boolean; + Marker: TSQLSentence; + rx: TRegExpr; +const + StringEnclosers = ['"', '''', '`']; + NewLines = [#13, #10]; + WhiteSpaces = NewLines + [#9, ' ']; +begin + // Scan SQL batch for delimiters and store a list with start + end offsets + FSQL := Value; + Clear; + AllLen := Length(FSQL); + i := 0; + LastLeftOffset := 1; + Delim := Mainform.Delimiter; + InString := False; // Loop in "enclosed string" or `identifier` + InComment := False; // Loop in one-line comment (# or --) + InBigComment := False; // Loop in /* multi-line */ or /*! condictional comment */ + InEscape := False; // Previous char was backslash + LastStringEncloser := #0; + DelimLen := Length(Delim); + rx := TRegExpr.Create; + rx.Expression := '^\s*DELIMITER\s+(\S+)'; + rx.ModifierG := True; + rx.ModifierI := True; + rx.ModifierM := False; + while i < AllLen do begin + Inc(i); + // Current and next char + c := FSQL[i]; + if i < AllLen then n := FSQL[i+1] + else n := #0; + + // Check for comment syntax and for enclosed literals, so a query delimiter can be ignored + if (not InComment) and (not InBigComment) and (not InString) and ((c + n = '--') or (c = '#')) then + InComment := True; + if (not InComment) and (not InBigComment) and (not InString) and (c + n = '/*') then + InBigComment := True; + if InBigComment and (not InComment) and (not InString) and (c + n = '*/') then + InBigComment := False; + if (not InEscape) and (not InComment) and (not InBigComment) and CharInSet(c, StringEnclosers) then begin + if (not InString) or (InString and (c = LastStringEncloser)) then begin + InString := not InString; + LastStringEncloser := c; + end; + end; + if (CharInSet(c, NewLines) and (not CharInSet(n, NewLines))) or (i = 1) then begin + if i > 1 then + InComment := False; + if (not InString) and (not InBigComment) and rx.Exec(copy(FSQL, i, 100)) then begin + Delim := rx.Match[1]; + DelimLen := rx.MatchLen[1]; + Inc(i, rx.MatchLen[0]); + LastLeftOffset := i; + continue; + end; + end; + if not InEscape then + InEscape := c = '\' + else + InEscape := False; + + // Prepare delimiter test string + if (not InComment) and (not InString) and (not InBigComment) then begin + DelimStart := Max(1, i+1-DelimLen); + DelimTest := Copy(FSQL, DelimStart, i-Max(i-DelimLen, 0)); + end else + DelimTest := ''; + + // End of query or batch reached. Add query markers to result list if sentence is not empty. + if (DelimTest = Delim) or (i = AllLen) then begin + RightOffset := i+1; + if DelimTest = Delim then + Dec(RightOffset, DelimLen); + QueryTest := Trim(Copy(FSQL, LastLeftOffset, RightOffset-LastLeftOffset)); + if (QueryTest <> '') and (QueryTest <> Delim) then begin + Marker := TSQLSentence.Create(Self); + while CharInSet(FSQL[LastLeftOffset], WhiteSpaces) do + Inc(LastLeftOffset); + Marker.LeftOffset := LastLeftOffset; + Marker.RightOffset := RightOffset; + Add(Marker); + LastLeftOffset := i+1; + end; + end; + end; +end;} + +{function TSQLBatch.GetSQLWithoutComments: String; +begin + Result := GetSQLWithoutComments(SQL); +end;} + +{class function TSQLBatch.GetSQLWithoutComments(FullSQL: String): String; +var + InLineComment, InMultiLineComment: Boolean; + AddCur: Boolean; + i: Integer; + Cur, Prev1, Prev2: Char; +begin + // Strip comments out of SQL sentence + // TODO: leave quoted string literals and identifiers untouched + 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 (Cur = '*') and (Prev1 = '/') then begin + InMultiLineComment := True; + System.Delete(Result, Length(Result), 1); // Delete comment chars + end + else if InMultiLineComment and (Cur = '/') and (Prev1 = '*') then begin + InMultiLineComment := False; + System.Delete(Result, Length(Result), 1); + AddCur := False; + end; + + if not InMultiLineComment then begin + if InLineComment and ((Cur = #13) or (Cur = #10)) then begin + InLineComment := False; // Reset + end + else if Cur = '#' then begin + InLineComment := True; + end + else if (Cur = ' ') and (Prev1 = '-') and (Prev2 = '-') then begin + InLineComment := True; + System.Delete(Result, Length(Result)-1, 2); // Delete comment chars + end; + end; + + if AddCur and (not InLineComment) and (not InMultiLineComment) then begin + Result := Result + Cur; + end; + end; +end;} + +{ THttpDownload } + +{constructor THttpDownload.Create(Owner: TComponent); +begin + FBytesRead := -1; + FContentLength := -1; + FOwner := Owner; + FTimeOut := 10; +end;} + + +{procedure THttpDownload.SendRequest(Filename: String); +var + NetHandle: HINTERNET; + UrlHandle: HINTERNET; + Buffer: array[1..4096] of AnsiChar; + Head: array[1..1024] of Char; + BytesInChunk, HeadSize, Reserved, TimeOutSeconds: Cardinal; + LocalFile: File; + DoStore: Boolean; + HttpStatus: Integer; + ContentChunk: UTF8String; +begin + DoStore := False; + NetHandle := InternetOpen(PChar(UserAgent(FOwner)), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); + + // Do not let the user wait 30s + TimeOutSeconds := FTimeOut * 1000; + InternetSetOption(NetHandle, INTERNET_OPTION_CONNECT_TIMEOUT, @TimeOutSeconds, SizeOf(TimeOutSeconds)); + + UrlHandle := nil; + FLastContent := ''; + try + UrlHandle := InternetOpenURL(NetHandle, PChar(FURL), nil, 0, INTERNET_FLAG_RELOAD, 0); + if (not Assigned(UrlHandle)) and FURL.StartsWith('https:', true) then begin + // Try again without SSL. See issue #65 and #1209 + MainForm.LogSQL(f_('Could not open %s (%s) - trying again without SSL...', [FURL, SysErrorMessage(GetLastError)]), lcError); + FURL := ReplaceRegExpr('^https:', FURL, 'http:'); + UrlHandle := InternetOpenURL(NetHandle, PChar(FURL), nil, 0, INTERNET_FLAG_RELOAD, 0); + end; + if not Assigned(UrlHandle) then begin + raise Exception.CreateFmt(_('Could not open %s (%s)'), [FURL, SysErrorMessage(GetLastError)]); + end; + + // Detect content length + HeadSize := SizeOf(Head); + Reserved := 0; + if HttpQueryInfo(UrlHandle, HTTP_QUERY_CONTENT_LENGTH, @Head, HeadSize, Reserved) then + FContentLength := StrToIntDef(Head, -1) + else + raise Exception.CreateFmt(_('Server did not send required "Content-Length" header: %s'), [FURL]); + + // Check if we got HTTP status 200 + HeadSize := SizeOf(Head); + Reserved := 0; + if HttpQueryInfo(UrlHandle, HTTP_QUERY_STATUS_CODE, @Head, HeadSize, Reserved) then begin + HttpStatus := StrToIntDef(Head, -1); + if HttpStatus <> 200 then + raise Exception.CreateFmt(_('Got HTTP status %d from %s'), [HttpStatus, FURL]); + end; + + // Create local file + if Filename <> '' then begin + AssignFile(LocalFile, FileName); + Rewrite(LocalFile, 1); + DoStore := True; + end; + + // Stream contents + while true do begin + InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesInChunk); + // Either store as file or in memory variable + if DoStore then begin + BlockWrite(LocalFile, Buffer, BytesInChunk) + end else begin + SetString(ContentChunk, PAnsiChar(@Buffer[1]), BytesInChunk); + FLastContent := FLastContent + String(ContentChunk); + end; + Inc(FBytesRead, BytesInChunk); + if Assigned(FOnProgress) then + FOnProgress(Self); + if BytesInChunk = 0 then + break; + end; + + finally + if DoStore then + CloseFile(LocalFile); + if Assigned(UrlHandle) then + InternetCloseHandle(UrlHandle); + if Assigned(NetHandle) then + InternetCloseHandle(NetHandle); + end; +end;} + + + +{ TExtStringList } +// taken from https://stackoverflow.com/questions/33893377/can-i-prevent-tstringlist-removing-key-value-pair-when-value-set-to-empty + +{function TExtStringList.GetValue(const Name: string): string; +begin + Result := Self.GetValue(Name); +end;} + + +{procedure TExtStringList.SetValue(const Name, Value: string); +var + I: Integer; +begin + I := IndexOfName(Name); + if I < 0 then I := Add(''); + Put(I, Name + NameValueSeparator + Value); +end;} + + +{ TSqlTranspiler } + +{class function TSqlTranspiler.CreateTable(SQL: String; SourceDb, TargetDb: TDBConnection): String; +begin + Result := SQL; + + if SourceDb.Parameters.IsMySQL(False) and TargetDb.Parameters.IsMariaDB then begin + // Remove COLLATE clause from virtual column definition: + // `tax_status` varchar(255) COLLATE utf8mb4_unicode_ci GENERATED ALWAYS AS (json_unquote(json_extract(`price`,'$.taxStatus'))) VIRTUAL + Result := ReplaceRegExpr('\sCOLLATE\s\w+(\s+GENERATED\s)', Result, '$1', [rroModifierI, rroUseSubstitution]); + end; + +end;} + + +{ TClipboardHelper } + +{function TClipboardHelper.GetTryAsText: String; +var + AttemptsLeft: Integer; + Success: Boolean; + LastError: String; +begin + AttemptsLeft := 5; + Result := ''; + Success := False; + while AttemptsLeft > 0 do begin + Dec(AttemptsLeft); + try + Result := AsText; + Success := True; + Break; + except + // We could also just catch EClipboardException + on E:Exception do begin + LastError := E.Message; + Sleep(100); + end; + end; + end; + if not Success then + MainForm.LogSQL(LastError, lcError); +end;} + +{procedure TClipboardHelper.SetTryAsText(AValue: String); +var + AttemptsLeft: Integer; + Success: Boolean; + LastError: String; +begin + AttemptsLeft := 5; + Success := False; + while AttemptsLeft > 0 do begin + Dec(AttemptsLeft); + try + AsText := AValue; + Success := True; + Break; + except + // We could also just catch EClipboardException + on E:Exception do begin + LastError := E.Message; + Sleep(100); + end; + end; + end; + if not Success then + MainForm.LogSQL(LastError, lcError); +end;} + + +{procedure TWinControlHelper.TrySetFocus; +begin + try + if Enabled + and CanFocus then + SetFocus; + except + on E:EInvalidOperation do + MessageBeep(MB_ICONWARNING); + end; +end;} + + +{ TAppSettings } + +{constructor TAppSettings.Create; +var + rx: TRegExpr; + i: Integer; + DefaultSnippetsDirectory: String; + PortableLockFile: String; + NewFileHandle: THandle; +begin + inherited; + FRegistry := TRegistry.Create; + FReads := 0; + FWrites := 0; + + PortableLockFile := ExtractFilePath(ParamStr(0)) + FPortableLockFileBase; + + // Use filename from command line. If not given, use file in directory of executable. + rx := TRegExpr.Create; + rx.Expression := '^\-\-?psettings\=(.+)$'; + for i:=1 to ParamCount do begin + if rx.Exec(ParamStr(i)) then begin + FSettingsFile := rx.Match[1]; + break; + end; + end; + // Default settings file, if not given per command line + if FSettingsFile = '' then + FSettingsFile := ExtractFilePath(ParamStr(0)) + 'portable_settings.txt'; + // Backwards compatibility: only settings file exists, create lock file in that case + if FileExists(FSettingsFile) and (not FileExists(PortableLockFile)) then begin + NewFileHandle := FileCreate(PortableLockFile); + FileClose(NewFileHandle); + end; + + // Switch to portable mode if lock file exists. File content is ignored. + FPortableMode := FileExists(PortableLockFile); + FPortableModeReadOnly := False; + + if FPortableMode then begin + // Create file if only the lock file exists + if not FileExists(FSettingsFile) then begin + NewFileHandle := FileCreate(FSettingsFile); + FileClose(NewFileHandle); + end; + FBasePath := '\Software\' + APPNAME + ' Portable '+IntToStr(GetCurrentProcessId)+'\'; + try + ImportSettings(FSettingsFile); + except + on E:Exception do + MessageDlg(E.Message, mtError, [mbOK], 0, mbOK); + end; + end else begin + FBasePath := '\Software\' + APPNAME + '\'; + FSettingsFile := ''; + end; + + PrepareRegistry; + + InitSetting(asHiddenColumns, 'HiddenColumns', 0, False, '', True); + InitSetting(asFilter, 'Filter', 0, False, '', True); + InitSetting(asSort, 'Sort', 0, False, '', True); + InitSetting(asDisplayedColumnsSorted, 'DisplayedColumnsSorted', 0, False); + InitSetting(asLastSessions, 'LastSessions', 0, False, ''); + InitSetting(asLastActiveSession, 'LastActiveSession', 0, False, ''); + InitSetting(asAutoReconnect, 'AutoReconnect', 0, False); + InitSetting(asRestoreLastUsedDB, 'RestoreLastUsedDB', 0, True); + InitSetting(asLastUsedDB, 'lastUsedDB', 0, False, '', True); + InitSetting(asTreeBackground, 'TreeBackground', clNone, False, '', True); + 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); + if Screen.Fonts.IndexOf('Consolas') > -1 then + InitSetting(asFontName, 'FontName', 0, False, 'Consolas') + else + InitSetting(asFontName, 'FontName', 0, False, 'Courier New'); + InitSetting(asFontSize, 'FontSize', 9); + InitSetting(asTabWidth, 'TabWidth', 3); + InitSetting(asDataFontName, 'DataFontName', 0, False, 'Tahoma'); + InitSetting(asDataFontSize, 'DataFontSize', 8); + InitSetting(asDataLocalNumberFormat, 'DataLocalNumberFormat', 0, True); + InitSetting(asLowercaseHex, 'LowercaseHex', 0, True); + InitSetting(asHintsOnResultTabs, 'HintsOnResultTabs', 0, True); + InitSetting(asShowRowId, 'ShowRowId', 0, True); + InitSetting(asHightlightSameTextBackground, 'HightlightSameTextBackground', GetThemeColor(clInfoBk)); + InitSetting(asLogsqlnum, 'logsqlnum', 300); + InitSetting(asLogsqlwidth, 'logsqlwidth', 2000); + InitSetting(asSessionLogsDirectory, 'SessionLogsDirectory', 0, False, DirnameUserAppData + 'Sessionlogs\'); + InitSetting(asLogHorizontalScrollbar, 'LogHorizontalScrollbar', 0, False); + InitSetting(asSQLColActiveLine, 'SQLColActiveLine', 0, False, 'clNone'); + InitSetting(asSQLColMatchingBraceForeground, 'SQLColMatchingBraceForeground', 0, False, 'clBlack'); + InitSetting(asSQLColMatchingBraceBackground, 'SQLColMatchingBraceBackground', 0, False, 'clAqua'); + InitSetting(asMaxColWidth, 'MaxColWidth', 300); + InitSetting(asDatagridMaximumRows, 'DatagridMaximumRows', 100000); + InitSetting(asDatagridRowsPerStep, 'DatagridRowsPerStep', 1000); + InitSetting(asGridRowLineCount, 'GridRowLineCount', 1); + InitSetting(asColumnHeaderClick, 'ColumnHeaderClick', 0, True); + InitSetting(asReuseEditorConfiguration, 'ReuseEditorConfiguration', 0, True); + InitSetting(asLogToFile, 'LogToFile', 0, False); + InitSetting(asMainWinMaximized, 'MainWinMaximized', 0, False); + InitSetting(asMainWinLeft, 'MainWinLeft', 100); + InitSetting(asMainWinTop, 'MainWinTop', 100); + InitSetting(asMainWinWidth, 'MainWinWidth', 950); + InitSetting(asMainWinHeight, 'MainWinHeight', 600); + InitSetting(asMainWinOnMonitor, 'MainWinOnMonitor', 1); + InitSetting(asCoolBandIndex, 'CoolBand%sIndex', 0); + InitSetting(asCoolBandBreak, 'CoolBand%sBreak', 0, True); + InitSetting(asCoolBandWidth, 'CoolBand%sWidth', 0); + InitSetting(asToolbarShowCaptions, 'ToolbarShowCaptions', 0, False); + InitSetting(asQuerymemoheight, 'querymemoheight', 100); + InitSetting(asDbtreewidth, 'dbtreewidth', 270); + InitSetting(asDataPreviewHeight, 'DataPreviewHeight', 100); + InitSetting(asDataPreviewEnabled, 'DataPreviewEnabled', 0, False); + InitSetting(asLogHeight, 'sqloutheight', 80); + InitSetting(asQueryhelperswidth, 'queryhelperswidth', 200); + InitSetting(asStopOnErrorsInBatchMode, 'StopOnErrorsInBatchMode', 0, True); + InitSetting(asWrapLongLines, 'WrapLongLines', 0, False); + InitSetting(asCodeFolding, 'CodeFolding', 0, True); + InitSetting(asDisplayBLOBsAsText, 'DisplayBLOBsAsText', 0, True); + InitSetting(asSingleQueries, 'SingleQueries', 0, True); + InitSetting(asMemoEditorWidth, 'MemoEditorWidth', 500); + InitSetting(asMemoEditorHeight, 'MemoEditorHeight', 200); + InitSetting(asMemoEditorMaximized, 'MemoEditorMaximized', 0, False); + InitSetting(asMemoEditorWrap, 'MemoEditorWrap', 0, False); + InitSetting(asMemoEditorHighlighter, 'MemoEditorHighlighter_%s', 0, False, 'General', True); + InitSetting(asMemoEditorAlwaysFormatCode, 'MemoEditorAlwaysFormatCode', 0, False); + InitSetting(asDelimiter, 'Delimiter', 0, False, ';'); + InitSetting(asSQLHelpWindowLeft, 'SQLHelp_WindowLeft', 0); + InitSetting(asSQLHelpWindowTop, 'SQLHelp_WindowTop', 0); + InitSetting(asSQLHelpWindowWidth, 'SQLHelp_WindowWidth', 600); + InitSetting(asSQLHelpWindowHeight, 'SQLHelp_WindowHeight', 400); + InitSetting(asSQLHelpPnlLeftWidth, 'SQLHelp_PnlLeftWidth', 150); + InitSetting(asSQLHelpPnlRightTopHeight, 'SQLHelp_PnlRightTopHeight', 150); + InitSetting(asHost, 'Host', 0, False, '', True); + InitSetting(asUser, 'User', 0, False, '', True); + InitSetting(asPassword, 'Password', 0, False, '', True); + InitSetting(asCleartextPluginEnabled, 'CleartextPluginEnabled', 0, False, '', True); + InitSetting(asWindowsAuth, 'WindowsAuth', 0, False, '', True); + InitSetting(asLoginPrompt, 'LoginPrompt', 0, False, '', True); + InitSetting(asPort, 'Port', 0, False, '', True); + InitSetting(asLibrary, 'Library', 0, False, '', True); // Gets its default in TConnectionParameters.Create + InitSetting(asAllProviders, 'AllProviders', 0, False); + InitSetting(asSSHtunnelActive, 'SSHtunnelActive', -1, False, '', True); + InitSetting(asPlinkExecutable, 'PlinkExecutable', 0, False, 'plink.exe'); // Legacy support with global setting + InitSetting(asSshExecutable, 'SshExecutable', 0, False, '', True); + InitSetting(asSSHtunnelHost, 'SSHtunnelHost', 0, False, '', True); + InitSetting(asSSHtunnelHostPort, 'SSHtunnelHostPort', 22, False, '', True); + InitSetting(asSSHtunnelPort, 'SSHtunnelPort', 0, False, '', True); + InitSetting(asSSHtunnelUser, 'SSHtunnelUser', 0, False, '', True); + InitSetting(asSSHtunnelPassword, 'SSHtunnelPassword', 0, False, '', True); + InitSetting(asSSHtunnelTimeout, 'SSHtunnelTimeout', 4, False, '', True); + InitSetting(asSSHtunnelPrivateKey, 'SSHtunnelPrivateKey', 0, False, '', True); + InitSetting(asSSLActive, 'SSL_Active', 0, False, '', True); + InitSetting(asSSLKey, 'SSL_Key', 0, False, '', True); + InitSetting(asSSLCert, 'SSL_Cert', 0, False, '', True); + InitSetting(asSSLCA, 'SSL_CA', 0, False, '', True); + InitSetting(asSSLCipher, 'SSL_Cipher', 0, False, '', True); + InitSetting(asSSLVerification, 'SSL_Verification', 2, False, '', True); + InitSetting(asSSLWarnUnused, 'SSL_WarnUnused', 0, True); + InitSetting(asNetType, 'NetType', Integer(ntMySQL_TCPIP), False, '', True); + InitSetting(asCompressed, 'Compressed', 0, False, '', True); + InitSetting(asLocalTimeZone, 'LocalTimeZone', 0, False, '', True); + InitSetting(asQueryTimeout, 'QueryTimeout', 30, False, '', True); + InitSetting(asKeepAlive, 'KeepAlive', 20, False, '', True); + InitSetting(asStartupScriptFilename, 'StartupScriptFilename', 0, False, '', True); + InitSetting(asDatabases, 'Databases', 0, False, '', True); + InitSetting(asComment, 'Comment', 0, False, '', True); + InitSetting(asDatabaseFilter, 'DatabaseFilter', 0, False, ''); + InitSetting(asTableFilter, 'TableFilter', 0, False, ''); + InitSetting(asFilterVT, 'FilterVTHistory', 0, False, ''); + InitSetting(asExportSQLCreateDatabases, 'ExportSQL_CreateDatabases', 0, False); + InitSetting(asExportSQLCreateTables, 'ExportSQL_CreateTables', 0, False); + InitSetting(asExportSQLDataHow, 'ExportSQL_DataHow', 0); + InitSetting(asExportSQLDataInsertSize, 'ExportSQL_DataInsertSize', 1024); + InitSetting(asExportSQLFilenames, 'ExportSQL_Filenames', 0, False, ''); + InitSetting(asExportZIPFilenames, 'ExportSQL_ZipFilenames', 0, False, ''); + InitSetting(asExportSQLDirectories, 'ExportSQL_Directories', 0, False, ''); + InitSetting(asExportSQLDatabase, 'ExportSQL_Database', 0, False, ''); + InitSetting(asExportSQLServerDatabase, 'ExportSQL_ServerDatabase', 0, False, ''); + InitSetting(asExportSQLOutput, 'ExportSQL_Output', 0); + InitSetting(asExportSQLAddComments, 'ExportSQLAddComments', 0, True); + InitSetting(asExportSQLRemoveAutoIncrement, 'ExportSQLRemoveAutoIncrement', 0, False); + InitSetting(asExportSQLRemoveDefiner, 'ExportSQLRemoveDefiner', 0, True); + InitSetting(asGridExportWindowWidth, 'GridExportWindowWidth', 400); + InitSetting(asGridExportWindowHeight, 'GridExportWindowHeight', 480); + InitSetting(asGridExportOutputCopy, 'GridExportOutputCopy', 0, True); + InitSetting(asGridExportOutputFile, 'GridExportOutputFile', 0, False); + InitSetting(asGridExportFilename, 'GridExportFilename', 0, False, ''); + InitSetting(asGridExportRecentFiles, 'GridExportRecentFiles', 0, False, ''); + InitSetting(asGridExportEncoding, 'GridExportEncoding', 4); + InitSetting(asGridExportFormat, 'GridExportFormat', 0); + InitSetting(asGridExportSelection, 'GridExportSelection', 1); + InitSetting(asGridExportColumnNames, 'GridExportColumnNames', 0, True); + InitSetting(asGridExportIncludeAutoInc, 'GridExportAutoInc', 0, True); + InitSetting(asGridExportIncludeQuery, 'GridExportIncludeQuery', 0, False); + InitSetting(asGridExportRemoveLinebreaks, 'GridExportRemoveLinebreaks', 0, False); + InitSetting(asGridExportSeparator, 'GridExportSeparator', 0, False, ';'); + InitSetting(asGridExportEncloser, 'GridExportEncloser', 0, False, ''); + InitSetting(asGridExportTerminator, 'GridExportTerminator', 0, False, '\r\n'); + InitSetting(asGridExportNull, 'GridExportNull', 0, False, '\N'); + // Copy to clipboard defaults: + InitSetting(asGridExportClpColumnNames, 'GridExportClpColumnNames', 0, True); + InitSetting(asGridExportClpIncludeAutoInc, 'GridExportClpAutoInc', 0, True); + InitSetting(asGridExportClpRemoveLinebreaks, 'GridExportClpRemoveLinebreaks', 0, False); + InitSetting(asGridExportClpSeparator, 'GridExportClpSeparator', 0, False, ';'); + InitSetting(asGridExportClpEncloser, 'GridExportClpEncloser', 0, False, ''); + InitSetting(asGridExportClpTerminator, 'GridExportClpTerminator', 0, False, '\r\n'); + InitSetting(asGridExportClpNull, 'GridExportClpNull', 0, False, '\N'); + + InitSetting(asCSVImportSeparator, 'CSVSeparatorV2', 0, False, ';'); + InitSetting(asCSVImportEncloser, 'CSVEncloserV2', 0, False, '"'); + InitSetting(asCSVImportTerminator, 'CSVTerminator', 0, False, '\r\n'); + InitSetting(asCSVImportFieldEscaper, 'CSVImportFieldEscaperV2', 0, False, '"'); + InitSetting(asCSVImportWindowWidth, 'CSVImportWindowWidth', 530); + InitSetting(asCSVImportWindowHeight, 'CSVImportWindowHeight', 550); + InitSetting(asCSVImportFilename, 'loadfilename', 0, False, ''); + InitSetting(asCSVImportFieldsEnclosedOptionally, 'CSVImportFieldsEnclosedOptionallyV2', 0, True); + InitSetting(asCSVImportIgnoreLines, 'CSVImportIgnoreLines', 1); + InitSetting(asCSVImportLowPriority, 'CSVImportLowPriority', 0, True); + InitSetting(asCSVImportLocalNumbers, 'CSVImportLocalNumbers', 0, False); + InitSetting(asCSVImportDuplicateHandling, 'CSVImportDuplicateHandling', 2); + InitSetting(asCSVImportParseMethod, 'CSVImportParseMethod', 0); + InitSetting(asCSVKeepDialogOpen, 'CSVKeepDialogOpen', 0, False); + InitSetting(asUpdatecheck, 'Updatecheck', 0, False); + InitSetting(asUpdatecheckBuilds, 'UpdatecheckBuilds', 0, False); + InitSetting(asUpdatecheckInterval, 'UpdatecheckInterval', 3); + InitSetting(asUpdatecheckLastrun, 'UpdatecheckLastrun', 0, False, DateToStr(DateTimeNever)); + InitSetting(asUpdateCheckWindowWidth, 'UpdateCheckWindowWidth', 400); + InitSetting(asUpdateCheckWindowHeight, 'UpdateCheckWindowHeight', 460); + InitSetting(asTableToolsWindowWidth, 'TableTools_WindowWidth', 800); + InitSetting(asTableToolsWindowHeight, 'TableTools_WindowHeight', 420); + InitSetting(asTableToolsTreeWidth, 'TableTools_TreeWidth', 300); + InitSetting(asTableToolsFindTextTab, 'TableToolsFindTextTab', 0); + InitSetting(asTableToolsFindText, 'TableTools_FindText', 0, False, ''); + InitSetting(asTableToolsFindSQL, 'TableToolsFindSQL', 0, False, ''); + InitSetting(asTableToolsDatatype, 'TableTools_Datatype', 0); + InitSetting(asTableToolsFindCaseSensitive, 'TableTools_FindCaseSensitive', 0, False); + InitSetting(asTableToolsFindMatchType, 'TableToolsFindMatchType', 0); + InitSetting(asFileImportWindowWidth, 'FileImport_WindowWidth', 530); + InitSetting(asFileImportWindowHeight, 'FileImport_WindowHeight', 530); + InitSetting(asEditVarWindowWidth, 'EditVar_WindowWidth', 300); + InitSetting(asEditVarWindowHeight, 'EditVar_WindowHeight', 260); + InitSetting(asUsermanagerWindowWidth, 'Usermanager_WindowWidth', 500); + InitSetting(asUsermanagerWindowHeight, 'Usermanager_WindowHeight', 400); + InitSetting(asUsermanagerListWidth, 'Usermanager_ListWidth', 180); + InitSetting(asSelectDBOWindowWidth, 'SelectDBO_WindowWidth', 250); + InitSetting(asSelectDBOWindowHeight, 'SelectDBO_WindowHeight', 350); + InitSetting(asSessionManagerListWidth, 'SessionManager_ListWidth', 220); + InitSetting(asSessionManagerWindowWidth, 'SessionManager_WindowWidth', 700); + InitSetting(asSessionManagerWindowHeight, 'SessionManager_WindowHeight', 490); + InitSetting(asSessionManagerWindowLeft, 'SessionManager_WindowLeft', 50); + InitSetting(asSessionManagerWindowTop, 'SessionManager_WindowTop', 50); + InitSetting(asCopyTableWindowHeight, 'CopyTable_WindowHeight', 340); + InitSetting(asCopyTableWindowWidth, 'CopyTable_WindowWidth', 380); + InitSetting(asCopyTableColumns, 'CopyTable_Columns', 0, True); + InitSetting(asCopyTableKeys, 'CopyTable_Keys', 0, True); + InitSetting(asCopyTableForeignKeys, 'CopyTable_ForeignKeys', 0, True); + InitSetting(asCopyTableData, 'CopyTable_Data', 0, True); + InitSetting(asCopyTableRecentFilter, 'CopyTable_RecentFilter_%s', 0, False, ''); + InitSetting(asServerVersion, 'ServerVersion', 0, False, '', True); + InitSetting(asServerVersionFull, 'ServerVersionFull', 0, False, '', True); + InitSetting(asLastConnect, 'LastConnect', 0, False, DateToStr(DateTimeNever), True); + InitSetting(asConnectCount, 'ConnectCount', 0, False, '', True); + InitSetting(asRefusedCount, 'RefusedCount', 0, False, '', True); + InitSetting(asSessionCreated, 'SessionCreated', 0, False, '', True); + InitSetting(asDoUsageStatistics, 'DoUsageStatistics', 0, False); + InitSetting(asLastUsageStatisticCall, 'LastUsageStatisticCall', 0, False, DateToStr(DateTimeNever)); + InitSetting(asWheelZoom, 'WheelZoom', 0, True); + InitSetting(asDisplayBars, 'DisplayBars', 0, true); + InitSetting(asMySQLBinaries, 'MySQL_Binaries', 0, False, ''); + InitSetting(asSequalSuggestWindowWidth, 'SequalSuggestWindowWidth', 500); + InitSetting(asSequalSuggestWindowHeight, 'SequalSuggestWindowHeight', 400); + InitSetting(asSequalSuggestPrompt, 'SequalSuggestPrompt', 0, False, ''); + InitSetting(asSequalSuggestRecentPrompts, 'SequalSuggestRecentPrompts', 0, False, ''); + InitSetting(asReformatter, 'Reformatter', 0); + InitSetting(asReformatterNoDialog, 'ReformatterNoDialog', 0); + InitSetting(asAlwaysGenerateFilter, 'AlwaysGenerateFilter', 0, False); + InitSetting(asGenerateDataNumRows, 'GenerateDataNumRows', 1000); + InitSetting(asGenerateDataNullAmount, 'GenerateDataNullAmount', 10); + + // Default folder for snippets + if FPortableMode then + DefaultSnippetsDirectory := ExtractFilePath(ParamStr(0)) + else + DefaultSnippetsDirectory := DirnameUserDocuments; + DefaultSnippetsDirectory := DefaultSnippetsDirectory + 'Snippets\'; + InitSetting(asCustomSnippetsDirectory, 'CustomSnippetsDirectory', 0, False, DefaultSnippetsDirectory); + 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); + InitSetting(asTabCloseOnDoubleClick, 'TabCloseOnDoubleClick', 0, True); + InitSetting(asTabCloseOnMiddleClick, 'TabCloseOnMiddleClick', 0, True); + InitSetting(asTabsInMultipleLines, 'TabsInMultipleLines', 0, True); + InitSetting(asTabIconsGrayscaleMode, 'TabIconsGrayscaleMode', 1); + InitSetting(asWarnUnsafeUpdates, 'WarnUnsafeUpdates', 0, True); + InitSetting(asQueryGridLongSortRowNum, 'QueryGridLongSortRowNum', 10000); + InitSetting(asCompletionProposal, 'CompletionProposal', 0, True); + InitSetting(asCompletionProposalInterval, 'CompletionProposalInterval', 500); + InitSetting(asCompletionProposalSearchOnMid, 'CompletionProposalSearchOnMid', 0, True); + InitSetting(asCompletionProposalWidth, 'CompletionProposalWidth', 350); + InitSetting(asCompletionProposalNbLinesInWindow,'CompletionProposalNbLinesInWindow', 12); + InitSetting(asAutoUppercase, 'AutoUppercase', 0, True); + InitSetting(asTabsToSpaces, 'TabsToSpaces', 0, False); + InitSetting(asFilterPanel, 'FilterPanel', 0, True); + InitSetting(asAllowMultipleInstances, 'AllowMultipleInstances', 0, True); + InitSetting(asFindDialogSearchHistory, 'FindDialogSearchHistory', 0, False, ''); + InitSetting(asFindDialogReplaceHistory, 'FindDialogReplaceHistory', 0, False, ''); + InitSetting(asGUIFontName, 'GUIFontName', 0, False, ''); + InitSetting(asGUIFontSize, 'GUIFontSize', 8); + InitSetting(asTheme, 'Theme', 0, False, 'Windows'); + InitSetting(asIconPack, 'IconPack', 0, False, 'Icons8'); + InitSetting(asWebSearchBaseUrl, 'WebSearchBaseUrl', 0, False, 'https://www.ecosia.org/search?q=%query'); + InitSetting(asMaxQueryResults, 'MaxQueryResults', 10); + InitSetting(asLogErrors, 'LogErrors', 0, True); + InitSetting(asLogUserSQL, 'LogUserSQL', 0, True); + InitSetting(asLogSQL, 'LogSQL', 0, True); + InitSetting(asLogScript, 'LogScript', 0, False); + InitSetting(asLogInfos, 'LogInfos', 0, True); + InitSetting(asLogDebug, 'LogDebug', 0, False); + InitSetting(asLogTimestamp, 'LogTimestamp', 0, False); + InitSetting(asFieldColorNumeric, 'FieldColor_Numeric', $00FF0000); + InitSetting(asFieldColorReal, 'FieldColor_Real', $00FF0048); + InitSetting(asFieldColorText, 'FieldColor_Text', $00008000); + InitSetting(asFieldColorBinary, 'FieldColor_Binary', $00800080); + InitSetting(asFieldColorDatetime, 'FieldColor_Datetime', $00000080); + InitSetting(asFieldColorSpatial, 'FieldColor_Spatial', $00808000); + InitSetting(asFieldColorOther, 'FieldColor_Other', $00008080); + InitSetting(asFieldEditorBinary, 'FieldEditor_Binary', 0, True); + InitSetting(asFieldEditorDatetime, 'FieldEditor_Datetime', 0, True); + InitSetting(asFieldEditorDatetimePrefill, 'FieldEditor_Datetime_Prefill', 0, True); + InitSetting(asFieldEditorEnum, 'FieldEditor_Enum', 0, True); + InitSetting(asFieldEditorSet, 'FieldEditor_Set', 0, True); + InitSetting(asFieldNullBackground, 'Field_NullBackground', clNone); + InitSetting(asRowBackgroundEven, 'RowBackgroundEven', clNone); + InitSetting(asRowBackgroundOdd, 'RowBackgroundOdd', clNone); + InitSetting(asGroupTreeObjects, 'GroupTreeObjects', 0, False); + InitSetting(asDisplayObjectSizeColumn, 'DisplayObjectSizeColumn', 0, True); + InitSetting(asActionShortcut1, 'Shortcut1_%s', 0); + InitSetting(asActionShortcut2, 'Shortcut2_%s', 0); + InitSetting(asHighlighterForeground, 'SQL Attr %s Foreground', 0); + InitSetting(asHighlighterBackground, 'SQL Attr %s Background', 0); + InitSetting(asHighlighterStyle, 'SQL Attr %s Style', 0); + InitSetting(asSQLfile, 'SQLFile%s', 0, False, ''); + InitSetting(asListColWidths, 'ColWidths_%s', 0, False, ''); + InitSetting(asListColsVisible, 'ColsVisible_%s', 0, False, ''); + InitSetting(asListColPositions, 'ColPositions_%s', 0, False, ''); + InitSetting(asListColSort, 'ColSort_%s', 0, False, ''); + InitSetting(asSessionFolder, 'Folder', 0, False, '', True); + InitSetting(asRecentFilter, '%s', 0, False, '', True); + InitSetting(asTimestampColumns, 'TimestampColumns', 0, False, '', True); + InitSetting(asDateTimeEditorCursorPos, 'DateTimeEditor_CursorPos_Type%s', 0); + InitSetting(asAppLanguage, 'Language', 0, False, ''); + InitSetting(asAutoExpand, 'AutoExpand', 0, False); + InitSetting(asDoubleClickInsertsNodeText, 'DoubleClickInsertsNodeText', 0, True); + InitSetting(asForeignDropDown, 'ForeignDropDown', 0, True); + InitSetting(asIncrementalSearch, 'IncrementalSearch', 0, True); + InitSetting(asQueryHistoryEnabled, 'QueryHistory', 0, True); + InitSetting(asQueryHistoryKeepDays, 'QueryHistoryKeeypDays', 30); + InitSetting(asColumnSelectorWidth, 'ColumnSelectorWidth', 200, False, ''); + InitSetting(asColumnSelectorHeight, 'ColumnSelectorHeight', 270, False, ''); + InitSetting(asDonatedEmail, 'DonatedEmail', 0, False, ''); + InitSetting(asFavoriteObjects, 'FavoriteObjects', 0, False, '', True); + InitSetting(asFavoriteObjectsOnly, 'FavoriteObjectsOnly', 0, False); // No longer used + InitSetting(asFullTableStatus, 'FullTableStatus', 0, True, '', True); + InitSetting(asLineBreakStyle, 'LineBreakStyle', Integer(lbsWindows)); + InitSetting(asPreferencesWindowWidth, 'PreferencesWindowWidth', 740); + InitSetting(asPreferencesWindowHeight, 'PreferencesWindowHeight', 500); + InitSetting(asFileDialogEncoding, 'FileDialogEncoding_%s', 0); + InitSetting(asThemePreviewWidth, 'ThemePreviewWidth', 300); + InitSetting(asThemePreviewHeight, 'ThemePreviewHeight', 200); + InitSetting(asThemePreviewTop, 'ThemePreviewTop', 300); + InitSetting(asThemePreviewLeft, 'ThemePreviewLeft', 300); + InitSetting(asCreateDbCollation, 'CreateDbCollation', 0, False, ''); + InitSetting(asRealTrailingZeros, 'RealTrailingZeros', 1); + InitSetting(asWebOnceAction, 'WebOnceAction', 0, False, DateToStr(DateTimeNever)); + + // Initialization values + FRestoreTabsInitValue := ReadBool(asRestoreTabs); + +end;} + + +{destructor TAppSettings.Destroy; +var + AllKeys: TStringList; + i: Integer; + Proc: TProcessEntry32; + ProcRuns: Boolean; + SnapShot: THandle; + rx: TRegExpr; +begin + // Export settings into textfile in portable mode. + if FPortableMode then try + try + ExportSettings; + except + // do nothing, even ShowMessage or ErrorDialog would trigger timer events followed by crashes; + end; + FRegistry.CloseKey; + FRegistry.DeleteKey(FBasePath); + + // Remove dead keys from instances which didn't close clean, e.g. because of an AV + SnapShot := CreateToolhelp32Snapshot(TH32CS_SnapProcess, 0); + Proc.dwSize := Sizeof(Proc); + FRegistry.OpenKeyReadOnly('\Software\'); + AllKeys := TStringList.Create; + FRegistry.GetKeyNames(AllKeys); + rx := TRegExpr.Create; + rx.Expression := '^' + QuoteRegExprMetaChars(APPNAME) + ' Portable (\d+)$'; + for i:=0 to AllKeys.Count-1 do begin + if not rx.Exec(AllKeys[i]) then + Continue; + ProcRuns := False; + if Process32First(SnapShot, Proc) then while True do begin + ProcRuns := rx.Match[1] = IntToStr(Proc.th32ProcessID); + if ProcRuns or (not Process32Next(SnapShot, Proc)) then + break; + end; + if not ProcRuns then + FRegistry.DeleteKey(AllKeys[i]); + end; + FRegistry.CloseKey; + CloseHandle(SnapShot); + AllKeys.Free; + rx.Free; + except + on E:Exception do // Prefer ShowMessage, see http://www.heidisql.com/forum.php?t=14001 + ShowMessage('Error: '+E.Message); + end; + FRegistry.Free; + inherited; +end;} + + +{procedure TAppSettings.InitSetting(Index: TAppSettingIndex; Name: String; + DefaultInt: Integer=0; DefaultBool: Boolean=False; DefaultString: String=''; + Session: Boolean=False); +begin + FSettings[Index].Name := Name; + FSettings[Index].Session := Session; + FSettings[Index].DefaultInt := DefaultInt; + FSettings[Index].DefaultBool := DefaultBool; + FSettings[Index].DefaultString := DefaultString; + FSettings[Index].Synced := False; +end;} + + +{procedure TAppSettings.SetSessionPath(Value: String); +begin + // Following calls may want to read or write some session specific setting + if Value <> FSessionPath then begin + FSessionPath := Value; + PrepareRegistry; + end; +end;} + + +{procedure TAppSettings.ResetPath; +begin + SessionPath := ''; +end;} + + +{procedure TAppSettings.StorePath; +begin + FStoredPath := SessionPath; +end;} + +{procedure TAppSettings.RestorePath; +begin + SessionPath := FStoredPath; +end;} + + +{procedure TAppSettings.PrepareRegistry; +var + Folder: String; +begin + // Open the wanted registry path + Folder := FBasePath; + if FSessionPath <> '' then + Folder := Folder + REGKEY_SESSIONS + '\' + FSessionPath; + if '\'+FRegistry.CurrentPath <> Folder then try + FRegistry.OpenKey(Folder, True); + except + on E:Exception do begin + // Recreate exception with a more useful message + E.Message := E.Message + CRLF + CRLF + 'While trying to open registry key "'+Folder+'"'; + raise; + end; + end; +end;} + + +{function TAppSettings.GetValueNames: TStringList; +begin + PrepareRegistry; + Result := TStringList.Create; + FRegistry.GetValueNames(Result); +end;} + + +{function TAppSettings.GetValueName(Index: TAppSettingIndex): String; +begin + Result := FSettings[Index].Name; +end;} + + +{function TAppSettings.GetKeyNames: TStringList; +begin + PrepareRegistry; + Result := TStringList.Create; + FRegistry.GetKeyNames(Result); +end;} + + +{function TAppSettings.DeleteValue(Index: TAppSettingIndex; FormatName: String=''): Boolean; +var + ValueName: String; +begin + PrepareRegistry; + ValueName := GetValueName(Index); + if FormatName <> '' then + ValueName := Format(ValueName, [FormatName]); + Result := FRegistry.DeleteValue(ValueName); + FSettings[Index].Synced := False; +end;} + + +{function TAppSettings.DeleteValue(ValueName: String): Boolean; +begin + Result := FRegistry.DeleteValue(ValueName); +end;} + + +{procedure TAppSettings.DeleteCurrentKey; +var + KeyPath: String; +begin + // Delete the current registry key + // Note that, contrary to the documentation, .DeleteKey is done even when this key has subkeys + PrepareRegistry; + if FSessionPath.IsEmpty then + raise Exception.CreateFmt(_('No path set, won''t delete root key %s'), [FRegistry.CurrentPath]) + else begin + KeyPath := REGKEY_SESSIONS + '\' + FSessionPath; + ResetPath; + FRegistry.DeleteKey(KeyPath); + end; +end;} + + +{procedure TAppSettings.MoveCurrentKey(TargetPath: String); +var + KeyPath: String; +begin + PrepareRegistry; + if FSessionPath.IsEmpty then + raise Exception.CreateFmt(_('No path set, won''t move root key %s'), [FRegistry.CurrentPath]) + else begin + KeyPath := REGKEY_SESSIONS + '\' + FSessionPath; + ResetPath; + FRegistry.MoveKey(KeyPath, TargetPath, True); + end; +end;} + + +{function TAppSettings.ValueExists(Index: TAppSettingIndex): Boolean; +var + ValueName: String; +begin + PrepareRegistry; + ValueName := GetValueName(Index); + Result := FRegistry.ValueExists(ValueName); +end;} + + +{function TAppSettings.SessionPathExists(SessionPath: String): Boolean; +begin + Result := FRegistry.KeyExists(FBasePath + REGKEY_SESSIONS + '\' + SessionPath); +end;} + + +{function TAppSettings.IsEmptyKey: Boolean; +var + TestList: TStringList; +begin + TestList := GetValueNames; + Result := (not FRegistry.HasSubKeys) and (TestList.Count = 0); + TestList.Free; +end;} + + +{function TAppSettings.GetDefaultInt(Index: TAppSettingIndex): Integer; +begin + // Return default integer value + Result := FSettings[Index].DefaultInt; +end;} + + +{function TAppSettings.GetDefaultBool(Index: TAppSettingIndex): Boolean; +begin + // Return default boolean value + Result := FSettings[Index].DefaultBool; +end;} + + +{function TAppSettings.GetDefaultString(Index: TAppSettingIndex): String; +begin + // Return default string value + Result := FSettings[Index].DefaultString; +end;} + + +{procedure TAppSettings.Read(Index: TAppSettingIndex; FormatName: String; + DataType: TAppSettingDataType; var I: Integer; var B: Boolean; var S: String; + DI: Integer; DB: Boolean; DS: String); +var + ValueName: String; +begin + // Read user setting value from registry + I := FSettings[Index].DefaultInt; + B := FSettings[Index].DefaultBool; + S := FSettings[Index].DefaultString; + if DI<>0 then I := DI; + if DB<>False then B := DB; + if DS<>'' then S := DS; + ValueName := FSettings[Index].Name; + if FormatName <> '' then + ValueName := Format(ValueName, [FormatName]); + if FSettings[Index].Session and FSessionPath.IsEmpty then + raise Exception.Create(_('Attempt to read session setting without session path')); + if (not FSettings[Index].Session) and (not FSessionPath.IsEmpty) then + SessionPath := '' + else + PrepareRegistry; + if FSettings[Index].Synced then begin + case DataType of + adInt: I := FSettings[Index].CurrentInt; + adBool: B := FSettings[Index].CurrentBool; + adString: S := FSettings[Index].CurrentString; + else raise Exception.CreateFmt(_(SUnsupportedSettingsDatatype), [FSettings[Index].Name]); + end; + end else if FRegistry.ValueExists(ValueName) then begin + Inc(FReads); + case DataType of + adInt: I := FRegistry.ReadInteger(ValueName); + adBool: B := FRegistry.ReadBool(ValueName); + adString: S := FRegistry.ReadString(ValueName); + else raise Exception.CreateFmt(_(SUnsupportedSettingsDatatype), [FSettings[Index].Name]); + end; + end; + if (FormatName = '') and (FSessionPath = '') then begin + FSettings[Index].Synced := True; + FSettings[Index].CurrentInt := I; + FSettings[Index].CurrentBool := B; + FSettings[Index].CurrentString := S; + end; +end;} + + +{function TAppSettings.ReadInt(Index: TAppSettingIndex; FormatName: String=''; Default: Integer=0): Integer; +var + S: String; + B: Boolean; +begin + Read(Index, FormatName, adInt, Result, B, S, Default, False, ''); +end;} + + +{function TAppSettings.ReadIntDpiAware(Index: TAppSettingIndex; AControl: TControl; FormatName: String=''; Default: Integer=0): Integer; +begin + Result := ReadInt(Index, FormatName, Default); + Result := Round(Result * AControl.ScaleFactor); +end;} + + +{function TAppSettings.ReadBool(Index: TAppSettingIndex; FormatName: String=''; Default: Boolean=False): Boolean; +var + I: Integer; + S: String; +begin + Read(Index, FormatName, adBool, I, Result, S, 0, Default, ''); +end;} + + +{function TAppSettings.ReadString(Index: TAppSettingIndex; FormatName: String=''; Default: String=''): String; +var + I: Integer; + B: Boolean; +begin + Read(Index, FormatName, adString, I, B, Result, 0, False, Default); +end;} + + +{function TAppSettings.ReadString(ValueName: String): String; +begin + PrepareRegistry; + Result := FRegistry.ReadString(ValueName); +end;} + + +{procedure TAppSettings.Write(Index: TAppSettingIndex; FormatName: String; + DataType: TAppSettingDataType; I: Integer; B: Boolean; S: String); +var + ValueName: String; + SameAsCurrent: Boolean; +begin + // Write user setting value to registry + ValueName := FSettings[Index].Name; + if FormatName <> '' then + ValueName := Format(ValueName, [FormatName]); + if FSettings[Index].Session and FSessionPath.IsEmpty then + raise Exception.Create(_('Attempt to write session setting without session path')); + if (not FSettings[Index].Session) and (not FSessionPath.IsEmpty) then + SessionPath := '' + else + PrepareRegistry; + case DataType of + adInt: begin + SameAsCurrent := FSettings[Index].Synced and (I = FSettings[Index].CurrentInt); + if not SameAsCurrent then begin + FRegistry.WriteInteger(ValueName, I); + Inc(FWrites); + end; + FSettings[Index].CurrentInt := I; + end; + adBool: begin + SameAsCurrent := FSettings[Index].Synced and (B = FSettings[Index].CurrentBool); + if not SameAsCurrent then begin + FRegistry.WriteBool(ValueName, B); + Inc(FWrites); + end; + FSettings[Index].CurrentBool := B; + end; + adString: begin + SameAsCurrent := FSettings[Index].Synced and (S = FSettings[Index].CurrentString); + if not SameAsCurrent then begin + FRegistry.WriteString(ValueName, S); + Inc(FWrites); + end; + FSettings[Index].CurrentString := S; + end; + else + raise Exception.CreateFmt(_(SUnsupportedSettingsDatatype), [FSettings[Index].Name]); + end; + if (FormatName = '') and (FSessionPath = '') then + FSettings[Index].Synced := True; +end;} + + +{procedure TAppSettings.WriteInt(Index: TAppSettingIndex; Value: Integer; FormatName: String=''); +begin + Write(Index, FormatName, adInt, Value, False, ''); +end;} + + +{procedure TAppSettings.WriteIntDpiAware(Index: TAppSettingIndex; AControl: TControl; Value: Integer; FormatName: String=''); +begin + Value := Round(Value / AControl.ScaleFactor); + WriteInt(Index, Value, FormatName); +end;} + + +{procedure TAppSettings.WriteBool(Index: TAppSettingIndex; Value: Boolean; FormatName: String=''); +begin + Write(Index, FormatName, adBool, 0, Value, ''); +end;} + + +{procedure TAppSettings.WriteString(Index: TAppSettingIndex; Value: String; FormatName: String=''); +begin + Write(Index, FormatName, adString, 0, False, Value); +end;} + + +{procedure TAppSettings.WriteString(ValueName, Value: String); +begin + PrepareRegistry; + FRegistry.WriteString(ValueName, Value); +end;} + + +{function TAppSettings.GetSessionNames(ParentPath: String; var Folders: TStringList): TStringList; +var + i: Integer; + CurPath: String; +begin + ResetPath; + CurPath := FBasePath + REGKEY_SESSIONS + '\' + ParentPath; + FRegistry.OpenKey(CurPath, False); + Result := TStringList.Create; + FRegistry.GetKeyNames(Result); + for i:=Result.Count-1 downto 0 do begin + // Issue #1111 describes a recursive endless loop, which may be caused by an empty key name here? + if Result[i].IsEmpty then + Continue; + // ... may also be caused by some non accessible key. Check result of .OpenKey before looking for "Folder" value: + if FRegistry.OpenKey(CurPath+'\'+Result[i], False) then begin + if FRegistry.ValueExists(GetValueName(asSessionFolder)) then begin + Folders.Add(Result[i]); + Result.Delete(i); + end; + end; + end; +end;} + + +{procedure TAppSettings.GetSessionPaths(ParentPath: String; var Sessions: TStringList); +var + Folders, Names: TStringList; + i: Integer; +begin + Folders := TStringList.Create; + Names := GetSessionNames(ParentPath, Folders); + for i:=0 to Names.Count-1 do + Sessions.Add(ParentPath+Names[i]); + for i:=0 to Folders.Count-1 do + GetSessionPaths(ParentPath+Folders[i]+'\', Sessions); + Sessions.Sort; + Names.Free; + Folders.Free; +end;} + + +{procedure TAppSettings.ImportSettings(Filename: String); +var + Content, Name, Value, KeyPath: String; + Lines, Segments: TStringList; + i: Integer; + DataType: TRegDataType; +begin + // Load registry settings from file + + if not FileExists(Filename) then begin + raise Exception.CreateFmt('File does not exist: %s', [Filename]); + end; + + Content := ReadTextfile(FileName, UTF8NoBOMEncoding); + Lines := Explode(CRLF, Content); + for i:=0 to Lines.Count-1 do begin + // Each line has 3 segments: reg path | data type | value. Continue if explode finds less or more than 3. + Segments := Explode(DELIMITER, Lines[i]); + if Segments.Count <> 3 then + continue; + KeyPath := FBasePath + ExtractFilePath(Segments[0]); + Name := ExtractFileName(Segments[0]); + DataType := TRegDataType(StrToInt(Segments[1])); + FRegistry.OpenKey(KeyPath, True); + if FRegistry.ValueExists(Name) then + Continue; // Don't touch value if already there + Value := ''; + if Segments.Count >= 3 then + Value := Segments[2]; + case DataType of + rdString: begin + Value := StringReplace(Value, CHR13REPLACEMENT, #13, [rfReplaceAll]); + Value := StringReplace(Value, CHR10REPLACEMENT, #10, [rfReplaceAll]); + FRegistry.WriteString(Name, Value); + end; + rdInteger: + FRegistry.WriteInteger(Name, MakeInt(Value)); + rdBinary, rdUnknown, rdExpandString: + ErrorDialog(Name+' has an unsupported data type.'); + end; + Segments.Free; + end; + Lines.Free; +end;} + + +{function TAppSettings.ExportSettings(Filename: String): Boolean; +var + Content, Value: String; + DataType: TRegDataType; + + procedure ReadKeyToContent(Path: String); + var + Names: TStringList; + i: Integer; + SubPath: String; + begin + // Recursively read values in keys and their subkeys into "content" variable + FRegistry.OpenKey(Path, True); + SubPath := Copy(Path, Length(FBasePath)+1, MaxInt); + Names := TStringList.Create; + FRegistry.GetValueNames(Names); + for i:=0 to Names.Count-1 do begin + DataType := FRegistry.GetDataType(Names[i]); + Content := Content + + SubPath + Names[i] + DELIMITER + + IntToStr(Integer(DataType)) + DELIMITER; + case DataType of + rdString: begin + Value := FRegistry.ReadString(Names[i]); + Value := StringReplace(Value, #13, CHR13REPLACEMENT, [rfReplaceAll]); + Value := StringReplace(Value, #10, CHR10REPLACEMENT, [rfReplaceAll]); + end; + rdInteger: + Value := IntToStr(FRegistry.ReadInteger(Names[i])); + rdBinary, rdUnknown, rdExpandString: + ErrorDialog(Names[i]+' has an unsupported data type.'); + end; + Content := Content + Value + CRLF; + end; + Names.Clear; + FRegistry.GetKeyNames(Names); + for i:=0 to Names.Count-1 do + ReadKeyToContent(Path + Names[i] + '\'); + Names.Free; + end; + +begin + // Save registry settings to file + Content := ''; + ReadKeyToContent(FBasePath); + SaveUnicodeFile(FileName, Content, UTF8NoBOMEncoding); + Result := True; +end;} + + +{function TAppSettings.ExportSettings: Boolean; +begin + Result := False; + if not FPortableModeReadOnly then begin + try + ExportSettings(FSettingsFile); + Result := True; + except + on E:Exception do begin + FPortableModeReadOnly := True; + Raise Exception.Create(E.ClassName + ': ' + E.Message + CRLF + CRLF + + f_('Switching to read-only mode. Settings won''t be saved. Use the command line parameter %s to use a custom file path.', ['--psettings']) + ); + end; + end; + end; +end;} + + +{function TAppSettings.DirnameUserAppData: String; +begin + // User folder for HeidiSQL's data (<user name>\Application Data) + Result := GetShellFolder(FOLDERID_RoamingAppData) + '\' + APPNAME + '\'; + if not DirectoryExists(Result) then begin + ForceDirectories(Result); + 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. +end;} + + +{function TAppSettings.DirnameSnippets: String; +begin + // Folder for snippets + Result := ReadString(asCustomSnippetsDirectory); + if Result.IsEmpty then + Result := GetDefaultString(asCustomSnippetsDirectory); + Result := IncludeTrailingBackslash(Result); + if not DirectoryExists(Result) then begin + ForceDirectories(Result); + end; +end;} + + +{function TAppSettings.DirnameBackups: String; +begin + // Create backup folder if it does not exist and return it + if PortableMode then begin + Result := ExtractFilePath(Application.ExeName) + 'Backups\' + end else begin + Result := DirnameUserAppData + 'Backups\'; + end; + if not DirectoryExists(Result) then begin + ForceDirectories(Result); + end; +end;} + + +{function TAppSettings.DirnameHighlighters: string; +begin + if PortableMode then begin + Result := ExtractFilePath(Application.ExeName) + 'Highlighters\' + end else begin + Result := DirnameUserAppData + 'Highlighters\'; + end; + if not DirectoryExists(Result) then begin + ForceDirectories(Result); + end; +end;} + + + +{ TUTF8NoBOMEncoding } + +{function TUTF8NoBOMEncoding.GetPreamble: TBytes; +begin + SetLength(Result, 0); +end;} + + +initialization + +NumberChars := ['0'..'9', FormatSettings.DecimalSeparator, FormatSettings.ThousandSeparator]; + +LibHandleUser32 := LoadLibrary('User32.dll'); + +//UTF8NoBOMEncoding := TUTF8NoBOMEncoding.Create; + +DateTimeNever := MinDateTime; + +//ConfirmIcon := TIcon.Create; +//ConfirmIcon.LoadFromResourceName(hInstance, 'Z_ICONQUESTION'); + +end. + + diff --git a/source/const.inc b/source/const.inc new file mode 100644 index 00000000..47cb3026 --- /dev/null +++ b/source/const.inc @@ -0,0 +1,106 @@ +// Common constants +const + + // Line breaks + // TODO: use sLineBreak instead + CRLF = #13#10; + LB_UNIX = #10; + LB_MAC = #13; + LB_WIDE = WideChar($2027); + + // Placeholder text for NULL values + TEXT_NULL = '(NULL)'; + + // General things + APPNAME = 'HeidiSQL'; + APPDOMAIN = 'https://www.heidisql.com/'; + REGKEY_SESSIONS = 'Servers'; + REGKEY_QUERYHISTORY = 'QueryHistory'; + REGKEY_RECENTFILTERS = 'RecentFilters'; + // Some unique char, used to separate e.g. selected columns in registry + DELIM = '|'; + CHR10REPLACEMENT = '<}}}>'; + CHR13REPLACEMENT = '<{{{>'; + LINEDELIMITER = '<|||>'; + + COLORSHIFT_NULLFIELDS = 70; // Brightness adjustment to add to normal field colors for NULL values + COLORSHIFT_SORTCOLUMNS = 12; // Brightness adjustment to add to sorted column backgrounds + + // Various iconindexes + ICONINDEX_PRIMARYKEY = 25; + ICONINDEX_FIELD = 42; + ICONINDEX_INDEXKEY = 23; + ICONINDEX_UNIQUEKEY = 24; + ICONINDEX_FULLTEXTKEY = 22; + ICONINDEX_SPATIALKEY = 126; + ICONINDEX_FOREIGNKEY = 136; + ICONINDEX_SERVER = 36; + ICONINDEX_DB = 5; + ICONINDEX_HIGHLIGHTMARKER = 157; + ICONINDEX_TABLE = 14; + ICONINDEX_VIEW = 81; + ICONINDEX_STOREDPROCEDURE = 119; + ICONINDEX_STOREDFUNCTION = 35; + ICONINDEX_TRIGGER = 137; + ICONINDEX_FUNCTION = 13; + ICONINDEX_EVENT = 80; + ICONINDEX_KEYWORD = 25; + + // Size of byte units + {Kibibyte} SIZE_KB = Int64(1024); + {Mebibyte} SIZE_MB = Int64(1048576); + {Gibibyte} SIZE_GB = Int64(1073741824); + {Tebibyte} SIZE_TB = Int64(1099511627776); + {Pebibyte} SIZE_PB = Int64(1125899906842624); + {Exbibyte} SIZE_EB = Int64(1152921504606846976); + + // Size of byte units for formatting purposes + {Kibibyte} FSIZE_KB = Int64(1000); + {Mebibyte} FSIZE_MB = Int64(1024000); + {Gibibyte} FSIZE_GB = Int64(1048576000); + {Tebibyte} FSIZE_TB = Int64(1073741824000); + {Pebibyte} FSIZE_PB = Int64(1099511627776000); + {Exbibyte} FSIZE_EB = Int64(1125899906842624000); + + // Abbreviations of byte unit names + {Bytes} NAME_BYTES = ' B'; + {Kibibyte} NAME_KB = ' KiB'; + {Mebibyte} NAME_MB = ' MiB'; + {Gibibyte} NAME_GB = ' GiB'; + {Tebibyte} NAME_TB = ' TiB'; + {Pebibyte} NAME_PB = ' PiB'; + {Exbibyte} NAME_EB = ' EiB'; + + // Data grid: How many bytes to fetch from data fields that are potentially large. + GRIDMAXDATA: Int64 = 256; + + BACKUP_MAXFILESIZE = 10 * SIZE_MB; + BACKUP_FILEPATTERN: String = 'query-tab-%s.sql'; + + VTREE_NOTLOADED = 0; + VTREE_NOTLOADED_PURGECACHE = 1; + VTREE_LOADED = 2; + + // Modification indicator for TControl.Tag + MODIFIEDFLAG = 10; + + 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.'; + SIdle = 'Idle.'; + SUnsupported = 'Unsupported by this server'; + SUnsupportedSettingsDatatype = 'Unsupported datatype for setting "%s"'; + SNotImplemented = 'Method not implemented for this connection type'; + MsgSQLError: String = 'SQL Error (%d): %s'; + MsgSQLErrorMultiStatements: String = 'SQL Error (%d) in statement #%d: %s'; + 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.'; + FILEFILTER_SQLITEDB = '*.sqlite3;*.sqlite;*.db;*.s3db'; + FILEEXT_SQLITEDB = 'sqlite3'; + PROPOSAL_ITEM_HEIGHT = 18; + // Note the following should be in sync to what MySQL returns from SHOW WARNINGS + SLogPrefixWarning = 'Warning'; + SLogPrefixNote = 'Note'; + SLogPrefixInfo = 'Info'; + diff --git a/source/dbconnection.pas b/source/dbconnection.pas new file mode 100644 index 00000000..a603f20e --- /dev/null +++ b/source/dbconnection.pas @@ -0,0 +1,37 @@ +unit dbconnection; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Generics.Collections, Generics.Defaults; + +type + TDBConnection = class; + + { TDBConnection } + + TDBLogCategory = (lcInfo, lcSQL, lcUserFiredSQL, lcError, lcDebug, lcScript); + TDBLogItem = class(TObject) + public + Category: TDBLogCategory; + LineText: String; + Connection: TDBConnection; + end; + TDBLogItems = TObjectList<TDBLogItem>; + TDBLogEvent = procedure(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil) of object; + TDBEvent = procedure(Connection: TDBConnection; Database: String) of object; + + TDBConnection = class(TComponent) + private + FActive: Boolean; + public + end; + TDBConnectionList = TObjectList<TDBConnection>; + + +implementation + +end. + diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas new file mode 100644 index 00000000..31c38842 --- /dev/null +++ b/source/dbstructures.mysql.pas @@ -0,0 +1,3389 @@ +unit dbstructures.mysql; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, dbstructures; + + +const + // General declarations + MYSQL_ERRMSG_SIZE = 512; + SQLSTATE_LENGTH = 5; + SCRAMBLE_LENGTH = 20; + MYSQL_PORT = 3306; + LOCAL_HOST = 'localhost'; + NAME_LEN = 64; + PROTOCOL_VERSION = 10; + FRM_VER = 6; + + // Field's flags + NOT_NULL_FLAG = 1; + PRI_KEY_FLAG = 2; + UNIQUE_KEY_FLAG = 4; + MULTIPLE_KEY_FLAG = 8; + BLOB_FLAG = 16; + UNSIGNED_FLAG = 32; + ZEROFILL_FLAG = 64; + BINARY_FLAG = 128; + ENUM_FLAG = 256; + AUTO_INCREMENT_FLAG = 512; + TIMESTAMP_FLAG = 1024; + SET_FLAG = 2048; + NO_DEFAULT_VALUE_FLAG = 4096; // Field has no default value + ON_UPDATE_NOW_FLAG = 8192; // If a field is updated it will get the current time value (NOW()) + NUM_FLAG = 32768; // Field is numeric + PART_KEY_FLAG = 16384; // wrong from here on, where do these come from? + GROUP_FLAG = 32768; + UNIQUE_FLAG = 65536; + BINCMP_FLAG = 131072; + + // Client connection options + CLIENT_LONG_PASSWORD: Int64 = 0; // obsolete flag + CLIENT_MYSQL: Int64 = 1; // mysql/old mariadb server/client + CLIENT_FOUND_ROWS: Int64 = 2; // Found instead of affected rows + CLIENT_LONG_FLAG: Int64 = 4; // Get all column flags + CLIENT_CONNECT_WITH_DB: Int64 = 8; // One can specify db on connect + CLIENT_NO_SCHEMA: Int64 = 16; // Don't allow database.table.column + CLIENT_COMPRESS: Int64 = 32; // Can use compression protocol + CLIENT_ODBC: Int64 = 64; // Odbc client + CLIENT_LOCAL_FILES: Int64 = 128; // Can use LOAD DATA LOCAL + CLIENT_IGNORE_SPACE: Int64 = 256; // Ignore spaces before '(' + CLIENT_PROTOCOL_41: Int64 = 512; // New 4.1 protocol + CLIENT_INTERACTIVE: Int64 = 1024; // This is an interactive client + CLIENT_SSL: Int64 = 2048; // Switch to SSL after handshake + CLIENT_IGNORE_SIGPIPE: Int64 = 4096; // IGNORE sigpipes + CLIENT_TRANSACTIONS: Int64 = 8192; // Client knows about transactions + CLIENT_RESERVED: Int64 = 16384; // Old flag for 4.1 protocol + CLIENT_SECURE_CONNECTION: Int64 = 32768; // New 4.1 authentication + CLIENT_MULTI_STATEMENTS: Int64 = 1 Shl 16; // Enable/disable multi-stmt support + CLIENT_MULTI_RESULTS: Int64 = 1 Shl 17; // Enable/disable multi-results + CLIENT_PS_MULTI_RESULTS: Int64 = 1 Shl 18; // Multi-results in PS-protocol + CLIENT_PLUGIN_AUTH: Int64 = 1 Shl 19; // Client supports plugin authentication + CLIENT_CONNECT_ATTRS: Int64 = 1 Shl 20; // Client supports connection attributes + // Enable authentication response packet to be larger than 255 bytes. + CLIENT_PLUGIN_AUTH_LENENC_CLIENT_DATA: Int64 = 1 Shl 21; + // Don't close the connection for a connection with expired password. + CLIENT_CAN_HANDLE_EXPIRED_PASSWORDS: Int64 = 1 Shl 22; + { + Capable of handling server state change information. Its a hint to the + server to include the state change information in Ok packet. + } + CLIENT_SESSION_TRACK: Int64 = 1 Shl 23; + // Client no longer needs EOF packet + CLIENT_DEPRECATE_EOF: Int64 = 1 Shl 24; + CLIENT_PROGRESS_OBSOLETE: Int64 = 1 Shl 29; + CLIENT_SSL_VERIFY_SERVER_CERT: Int64 = 1 Shl 30; + { + It used to be that if mysql_real_connect() failed, it would delete any + options set by the client, unless the CLIENT_REMEMBER_OPTIONS flag was + given. + That behaviour does not appear very useful, and it seems unlikely that + any applications would actually depend on this. So from MariaDB 5.5 we + always preserve any options set in case of failed connect, and this + option is effectively always set. + } + CLIENT_REMEMBER_OPTIONS: Int64 = 1 Shl 31; + + COLLATION_BINARY = 63; + // Equivalent to COLLATION_BINARY, this is what a new driver returns when connected to a pre-4.1 server. + COLLATION_NONE = 0; + + // Relevant MySQL error codes, taken from include/mysql/server/mysqld_error.h + ER_MUST_CHANGE_PASSWORD = 1820; + ER_NO_SUCH_THREAD = 1094; + ER_NONEXISTING_GRANT = 1141; + ER_WRONG_AUTO_KEY = 1075; + +type + PUSED_MEM=^USED_MEM; + USED_MEM = packed record + next: PUSED_MEM; + left: Integer; + size: Integer; + end; + + PERR_PROC = ^ERR_PROC; + ERR_PROC = procedure; + + PMEM_ROOT = ^MEM_ROOT; + MEM_ROOT = packed record + free: PUSED_MEM; + used: PUSED_MEM; + pre_alloc: PUSED_MEM; + min_malloc: Integer; + block_size: Integer; + block_num: Integer; + first_block_usage: Integer; + error_handler: PERR_PROC; + end; + + NET = record + vio: Pointer; + buff: PAnsiChar; + buff_end: PAnsiChar; + write_pos: PAnsiChar; + read_pos: PAnsiChar; + fd: Integer; + max_packet: Cardinal; + max_packet_size: Cardinal; + pkt_nr: Cardinal; + compress_pkt_nr: Cardinal; + write_timeout: Cardinal; + read_timeout: Cardinal; + retry_count: Cardinal; + fcntl: Integer; + compress: Byte; + remain_in_buf: LongInt; + length: LongInt; + buf_length: LongInt; + where_b: LongInt; + return_status: Pointer; + reading_or_writing: Char; + save_char: Char; + no_send_ok: Byte; + last_error: array[1..MYSQL_ERRMSG_SIZE] of Char; + sqlstate: array[1..SQLSTATE_LENGTH + 1] of Char; + last_errno: Cardinal; + error: Char; + query_cache_query: Pointer; + report_error: Byte; + return_errno: Byte; + end; + + PMYSQL_FIELD = ^MYSQL_FIELD; + MYSQL_FIELD = record + name: PAnsiChar; // Name of column + org_name: PAnsiChar; // Name of original column (added after 3.23.58) + table: PAnsiChar; // Table of column if column was a field + org_table: PAnsiChar; // Name of original table (added after 3.23.58 + db: PAnsiChar; // table schema (added after 3.23.58) + catalog: PAnsiChar; // table catalog (added after 3.23.58) + def: PAnsiChar; // Default value (set by mysql_list_fields) + length: LongInt; // Width of column + max_length: LongInt; // Max width of selected set + // added after 3.23.58 + name_length: Cardinal; + org_name_length: Cardinal; + table_length: Cardinal; + org_table_length: Cardinal; + db_length: Cardinal; + catalog_length: Cardinal; + def_length: Cardinal; + //*********************** + flags: Cardinal; // Div flags + decimals: Cardinal; // Number of decimals in field + charsetnr: Cardinal; // char set number (added in 4.1) + _type: Cardinal; // Type of field. Se mysql_com.h for types + end; + + // Added in Oct 2023, to fix usage of mysql_fetch_lengths(). See issue #1863 + PMYSQL_LENGTHS = ^TMYSQL_LENGTHS; + TMYSQL_LENGTHS = array[0..MaxInt div SizeOf(LongWord) - 1] of LongWord; + + MYSQL_ROW = array[0..$ffff] of PAnsiChar; + PMYSQL_ROW = ^MYSQL_ROW; + + PMYSQL_ROWS = ^MYSQL_ROWS; + MYSQL_ROWS = record + next: PMYSQL_ROWS; + data: PMYSQL_ROW; + end; + + MYSQL_DATA = record + Rows: Int64; + Fields: Cardinal; + Data: PMYSQL_ROWS; + Alloc: MEM_ROOT; + end; + PMYSQL_DATA = ^MYSQL_DATA; + + PMYSQL = ^MYSQL; + MYSQL = record + _net: NET; + connector_fd: Pointer; + host: PAnsiChar; + user: PAnsiChar; + passwd: PAnsiChar; + unix_socket: PAnsiChar; + server_version: PAnsiChar; + host_info: PAnsiChar; + info: PAnsiChar; + db: PAnsiChar; + charset: PAnsiChar; + fields: PMYSQL_FIELD; + field_alloc: MEM_ROOT; + affected_rows: Int64; + insert_id: Int64; + extra_info: Int64; + thread_id: LongInt; + packet_length: LongInt; + port: Cardinal; + client_flag: LongInt; + server_capabilities: LongInt; + protocol_version: Cardinal; + field_count: Cardinal; + server_status: Cardinal; + server_language: Cardinal; + warning_count: Cardinal; + options: Cardinal; + status: Byte; + free_me: Byte; + reconnect: Byte; + scramble: array[1..SCRAMBLE_LENGTH+1] of Char; + rpl_pivot: Byte; + master: PMYSQL; + next_slave: PMYSQL; + last_used_slave: PMYSQL; + last_used_con: PMYSQL; + stmts: Pointer; + methods: Pointer; + thd: Pointer; + unbuffered_fetch_owner: PByte; + end; + + MYSQL_RES = record + row_count: Int64; + field_count, current_field: Integer; + fields: PMYSQL_FIELD; + data: PMYSQL_DATA; + data_cursor: PMYSQL_ROWS; + field_alloc: MEM_ROOT; + row: PMYSQL_ROW; // If unbuffered read + current_row: PMYSQL_ROW; // buffer to current row + lengths: PLongInt; // column lengths of current row + handle: PMYSQL; // for unbuffered reads + eof: Byte; // Used my mysql_fetch_row + is_ps: Byte; + end; + PMYSQL_RES = ^MYSQL_RES; + + Tmgci = function: PAnsiChar; stdcall; + TMySQLLib = class(TDbLib) + mysql_affected_rows: function(Handle: PMYSQL): Int64; stdcall; + mysql_character_set_name: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_close: procedure(Handle: PMYSQL); stdcall; + mysql_data_seek: procedure(Result: PMYSQL_RES; Offset: Int64); stdcall; + mysql_errno: function(Handle: PMYSQL): Cardinal; stdcall; + mysql_error: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_fetch_field_direct: function(Result: PMYSQL_RES; FieldNo: Cardinal): PMYSQL_FIELD; stdcall; + mysql_fetch_field: function(Result: PMYSQL_RES): PMYSQL_FIELD; stdcall; + mysql_fetch_lengths: function(Result: PMYSQL_RES): PMYSQL_LENGTHS; stdcall; + mysql_fetch_row: function(Result: PMYSQL_RES): PMYSQL_ROW; stdcall; + mysql_free_result: procedure(Result: PMYSQL_RES); stdcall; + mysql_get_client_info: function: PAnsiChar; stdcall; + mysql_get_server_info: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_init: function(Handle: PMYSQL): PMYSQL; stdcall; + mysql_info: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_num_fields: function(Result: PMYSQL_RES): Integer; stdcall; + mysql_num_rows: function(Result: PMYSQL_RES): Int64; stdcall; + mysql_options: function(Handle: PMYSQL; Option: Integer; arg: PAnsiChar): Integer; stdcall; + mysql_optionsv: function(Handle: PMYSQL; Option: Integer; arg, val: PAnsiChar): Integer; stdcall; + mysql_ping: function(Handle: PMYSQL): Integer; stdcall; + mysql_real_connect: function(Handle: PMYSQL; const Host, User, Passwd, Db: PAnsiChar; Port: Cardinal; const UnixSocket: PAnsiChar; ClientFlag: Cardinal): PMYSQL; stdcall; + mysql_real_query: function(Handle: PMYSQL; const Query: PAnsiChar; Length: Cardinal): Integer; stdcall; + mysql_stat: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_store_result: function(Handle: PMYSQL): PMYSQL_RES; stdcall; + mysql_thread_id: function(Handle: PMYSQL): Cardinal; stdcall; + mysql_next_result: function(Handle: PMYSQL): Integer; stdcall; + mysql_set_character_set: function(Handle: PMYSQL; csname: PAnsiChar): Integer; stdcall; + mysql_thread_init: function: Byte; stdcall; + mysql_thread_end: procedure; stdcall; + mysql_warning_count: function(Handle: PMYSQL): Cardinal; stdcall; + const + INVALID_OPT = -1; + MYBOOL_FALSE: Byte = 0; + MYBOOL_TRUE: Byte = 1; + protected + procedure AssignProcedures; override; + public + MYSQL_OPT_LOCAL_INFILE, + MYSQL_OPT_CONNECT_TIMEOUT, + MARIADB_OPT_TLS_VERSION, + MYSQL_OPT_TLS_VERSION, + MYSQL_PLUGIN_DIR, + MYSQL_OPT_SSL_KEY, + MYSQL_OPT_SSL_CERT, + MYSQL_OPT_SSL_CA, + MYSQL_OPT_SSL_CIPHER, + MYSQL_OPT_CONNECT_ATTR_ADD, + MYSQL_ENABLE_CLEARTEXT_PLUGIN, + MYSQL_OPT_SSL_MODE, + MYSQL_OPT_SSL_VERIFY_SERVER_CERT: Integer; + SSL_MODE_DISABLED, + SSL_MODE_PREFERRED, + SSL_MODE_REQUIRED, + SSL_MODE_VERIFY_CA, + SSL_MODE_VERIFY_IDENTITY: Integer; + constructor Create(DllFile_, DefaultDll: String); override; + end; +var + MySQLKeywords: TStringList; + MySQLErrorCodes: TStringList; + + + // MySQL Data Type List and Properties + MySQLDatatypes: array of TDBDatatype; + {MySQLDatatypes: array [0..41] of TDBDatatype = + ( + ( + Index: dbdtUnknown; + NativeTypes: '99999'; + Name: 'UNKNOWN'; + Description: 'Unknown data type'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcOther; + ), + ( + Index: dbdtTinyint; + NativeType: 1; + Name: 'TINYINT'; + Description: 'TINYINT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A very small integer. The signed range is -128 to 127. ' + + 'The unsigned range is 0 to 255.'; + HasLength: True; + RequiresLength: False; + MaxSize: 127; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtSmallint; + NativeType: 2; + Name: 'SMALLINT'; + Description: 'SMALLINT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A small integer. The signed range is -32768 to 32767. ' + + 'The unsigned range is 0 to 65535.'; + HasLength: True; + RequiresLength: False; + MaxSize: 32767; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtMediumint; + NativeType: 9; + Name: 'MEDIUMINT'; + Description: 'MEDIUMINT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A medium-sized integer. The signed range is -8388608 to 8388607. ' + + 'The unsigned range is 0 to 16777215.'; + HasLength: True; + RequiresLength: False; + MaxSize: 8388607; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtInt; + NativeType: 3; + Name: 'INT'; + Description: 'INT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A normal-size integer. The signed range is -2147483648 to 2147483647. ' + + 'The unsigned range is 0 to 4294967295.'; + HasLength: True; + RequiresLength: False; + MaxSize: 2147483647; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtBigint; + NativeType: 8; + Name: 'BIGINT'; + Description: 'BIGINT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A large integer. The signed range is -9223372036854775808 to ' + + '9223372036854775807. The unsigned range is 0 to 18446744073709551615.'; + HasLength: True; + RequiresLength: False; + MaxSize: 9223372036854775807; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtFloat; + NativeType: 4; + Name: 'FLOAT'; + Description: 'FLOAT[(M,D)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A small (single-precision) floating-point number. Allowable values are '+ + '-3.402823466E+38 to -1.175494351E-38, 0, and 1.175494351E-38 to '+ + '3.402823466E+38. These are the theoretical limits, based on the IEEE '+ + 'standard. The actual range might be slightly smaller depending on your '+ + 'hardware or operating system.'; + HasLength: True; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcReal; + ), + ( + Index: dbdtDouble; + NativeType: 5; + Name: 'DOUBLE'; + Description: 'DOUBLE[(M,D)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A normal-size (double-precision) floating-point number. Allowable ' + + 'values are -1.7976931348623157E+308 to -2.2250738585072014E-308, 0, and ' + + '2.2250738585072014E-308 to 1.7976931348623157E+308. These are the ' + + 'theoretical limits, based on the IEEE standard. The actual range might ' + + 'be slightly smaller depending on your hardware or operating system.'; + HasLength: True; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcReal; + ), + ( + Index: dbdtDecimal; + NativeType: 246; + Name: 'DECIMAL'; + Description: 'DECIMAL[(M[,D])] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A packed "exact" fixed-point number. M is the total number of digits ' + + '(the precision) and D is the number of digits after the decimal point ' + + '(the scale). The decimal point and (for negative numbers) the "-" sign ' + + 'are not counted in M. If D is 0, values have no decimal point or ' + + 'fractional part. The maximum number of digits (M) for DECIMAL is 65. ' + + 'The maximum number of supported decimals (D) is 30. If D is omitted, ' + + 'the default is 0. If M is omitted, the default is 10.'; + HasLength: True; + RequiresLength: True; + MaxSize: 9223372036854775807; + HasBinary: False; + HasDefault: True; + LoadPart: False; + DefLengthSet: '20,6'; + Category: dtcReal; + ), + ( + Index: dbdtDate; + NativeType: 10; + Name: 'DATE'; + Description: 'DATE' + sLineBreak + + 'A date. The supported range is ''1000-01-01'' to ''9999-12-31''. MySQL ' + + 'displays DATE values in ''YYYY-MM-DD'' format, but allows assignment of ' + + 'values to DATE columns using either strings or numbers.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'yyyy-mm-dd'; + Category: dtcTemporal; + ), + ( + Index: dbdtTime; + NativeType: 11; + Name: 'TIME'; + Description: 'TIME' + sLineBreak + + 'A time. The range is ''-838:59:59'' to ''838:59:59''. MySQL displays TIME ' + + 'values in ''HH:MM:SS'' format, but allows assignment of values to TIME ' + + 'columns using either strings or numbers.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'hh:nn:ss'; + Category: dtcTemporal; + ), + ( + Index: dbdtYear; + NativeType: 13; + Name: 'YEAR'; + Description: 'YEAR[(2|4)]' + sLineBreak + + 'A year in two-digit or four-digit format. The default is four-digit ' + + 'format. In four-digit format, the allowable values are 1901 to 2155, ' + + 'and 0000. In two-digit format, the allowable values are 70 to 69, ' + + 'representing years from 1970 to 2069. MySQL displays YEAR values in ' + + 'YYYY format, but allows you to assign values to YEAR columns using ' + + 'either strings or numbers.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'yyyy'; + Category: dtcTemporal; + ), + ( + Index: dbdtDatetime; + NativeType: 12; + Name: 'DATETIME'; + Description: 'DATETIME' + sLineBreak + + 'A date and time combination. The supported range is ''1000-01-01 ' + + '00:00:00'' to ''9999-12-31 23:59:59''. MySQL displays DATETIME values in ' + + '''YYYY-MM-DD HH:MM:SS'' format, but allows assignment of values to ' + + 'DATETIME columns using either strings or numbers.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'yyyy-mm-dd hh:nn:ss'; + Category: dtcTemporal; + ), + ( + Index: dbdtTimestamp; + NativeType: 7; + Name: 'TIMESTAMP'; + Description: 'TIMESTAMP' + sLineBreak + + 'A timestamp. The range is ''1970-01-01 00:00:01'' UTC to ''2038-01-09 ' + + '03:14:07'' UTC. TIMESTAMP values are stored as the number of seconds ' + + 'since the epoch (''1970-01-01 00:00:00'' UTC). A TIMESTAMP cannot ' + + 'represent the value ''1970-01-01 00:00:00'' because that is equivalent to ' + + '0 seconds from the epoch and the value 0 is reserved for representing ' + + '''0000-00-00 00:00:00'', the "zero" TIMESTAMP value.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'yyyy-mm-dd hh:nn:ss'; + Category: dtcTemporal; + ), + ( + Index: dbdtVarchar; + NativeType: 253; + Name: 'VARCHAR'; + Description: 'VARCHAR(M)' + sLineBreak + + 'A variable-length string. M represents the maximum column length in ' + + 'characters. The range of M is 0 to 65,535. The effective maximum length ' + + 'of a VARCHAR is subject to the maximum row size (65,535 bytes, which is ' + + 'shared among all columns) and the character set used. For example, utf8 ' + + 'characters can require up to three bytes per character, so a VARCHAR ' + + 'column that uses the utf8 character set can be declared to be a maximum ' + + 'of 21,844 characters. ' + sLineBreak + sLineBreak + + '*Note*: MySQL 5.1 follows the standard SQL specification, and does not ' + + 'remove trailing spaces from VARCHAR values.'; + HasLength: True; + RequiresLength: True; + MaxSize: 255; + HasBinary: True; // MySQL-Help says the opposite but it's valid for older versions at least. + HasDefault: True; + LoadPart: True; + DefLengthSet: '50'; + Category: dtcText; + ), + ( + Index: dbdtChar; + NativeType: 254; + Name: 'CHAR'; + Description: 'CHAR[(M)]' + sLineBreak + + 'A fixed-length string that is always right-padded with spaces to the ' + + 'specified length when stored. M represents the column length in ' + + 'characters. The range of M is 0 to 255. If M is omitted, the length is 1.' + sLineBreak + sLineBreak + + '*Note*: Trailing spaces are removed when CHAR values are retrieved ' + + 'unless the PAD_CHAR_TO_FULL_LENGTH SQL mode is enabled.'; + HasLength: True; + RequiresLength: True; + MaxSize: 255; + HasBinary: True; + HasDefault: True; + LoadPart: False; + DefLengthSet: '50'; + Category: dtcText; + ), + ( + Index: dbdtTinytext; + NativeType: 249; + Name: 'TINYTEXT'; + Description: 'TINYTEXT' + sLineBreak + + 'A TEXT column with a maximum length of 255 (2^8 - 1) characters. The ' + + 'effective maximum length is less if the value contains multi-byte ' + + 'characters. Each TINYTEXT value is stored using a one-byte length ' + + 'prefix that indicates the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + MaxSize: 255; + HasBinary: True; + HasDefault: False; + LoadPart: False; + Category: dtcText; + ), + ( + Index: dbdtText; + NativeType: 252; + Name: 'TEXT'; + Description: 'TEXT[(M)]' + sLineBreak + + 'A TEXT column with a maximum length of 65,535 (2^16 - 1) characters. The ' + + 'effective maximum length is less if the value contains multi-byte ' + + 'characters. Each TEXT value is stored using a two-byte length prefix ' + + 'that indicates the number of bytes in the value. ' + sLineBreak + + 'An optional length M can be given for this type. If this is done, MySQL ' + + 'creates the column as the smallest TEXT type large enough to hold ' + + 'values M characters long.'; + HasLength: True; + RequiresLength: False; + MaxSize: 65535; + DefaultSize: 65535; + HasBinary: True; + HasDefault: False; + LoadPart: True; + Category: dtcText; + ), + ( + Index: dbdtMediumtext; + NativeType: 250; + Name: 'MEDIUMTEXT'; + Description: 'MEDIUMTEXT' + sLineBreak + + 'A TEXT column with a maximum length of 16,777,215 (2^24 - 1) characters. ' + + 'The effective maximum length is less if the value contains multi-byte ' + + 'characters. Each MEDIUMTEXT value is stored using a three-byte length ' + + 'prefix that indicates the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + HasBinary: True; + HasDefault: False; + LoadPart: True; + Category: dtcText; + ), + ( + Index: dbdtLongtext; + NativeType: 251; + Name: 'LONGTEXT'; + Description: 'LONGTEXT' + sLineBreak + + 'A TEXT column with a maximum length of 4,294,967,295 or 4GB (2^32 - 1) ' + + 'characters. The effective maximum length is less if the value contains ' + + 'multi-byte characters. The effective maximum length of LONGTEXT columns ' + + 'also depends on the configured maximum packet size in the client/server ' + + 'protocol and available memory. Each LONGTEXT value is stored using a ' + + 'four-byte length prefix that indicates the number of bytes in the ' + + 'value.'; + HasLength: False; + RequiresLength: False; + HasBinary: True; + HasDefault: False; + LoadPart: True; + Category: dtcText; + ), + ( + Index: dbdtJson; + NativeType: 245; + Name: 'JSON'; + Description: 'JSON' + sLineBreak + + 'Documents stored in JSON columns are converted to an internal format that '+ + 'permits quick read access to document elements. When the server later must '+ + 'read a JSON value stored in this binary format, the value need not be parsed '+ + 'from a text representation. The binary format is structured to enable the '+ + 'server to look up subobjects or nested values directly by key or array index '+ + 'without reading all values before or after them in the document.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: True; + Category: dtcText; + ), + ( + Index: dbdtUniqueidentifier; + NativeType: 254; + Name: 'UUID'; + Description: 'UUID' + sLineBreak + + 'The UUID data type is intended for the storage of 128-bit UUID (Universally ' + + 'Unique Identifier) data. See the UUID function page for more details on UUIDs ' + + 'themselves.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcText; + ), + ( + Index: dbdtInet4; + NativeType: 255; + Name: 'INET4'; + Description: 'INET4' + sLineBreak + + 'INET4 is a data type to store IPv4 addresses, as 4-byte binary strings. '+ + 'It was added in MariaDB 10.10.0'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcText; + MinVersion: 10100; + ), + ( + Index: dbdtInet6; + NativeType: 255; + Name: 'INET6'; + Description: 'INET6' + sLineBreak + + 'The INET6 data type is intended for storage of IPv6 addresses, as well as ' + + 'IPv4 addresses assuming conventional mapping of IPv4 addresses into IPv6 ' + + 'addresses. ' + slineBreak + + 'Both short and long IPv6 notation are permitted, according to RFC-5952. '+ + 'It was added in MariaDB 10.5.0'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcText; + MinVersion: 10050; + ), + ( + Index: dbdtBinary; + NativeType: 254; + Name: 'BINARY'; + Description: 'BINARY(M)' + sLineBreak + + 'The BINARY type is similar to the CHAR type, but stores binary byte ' + + 'strings rather than non-binary character strings. M represents the ' + + 'column length in bytes.'; + HasLength: True; + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: False; + DefLengthSet: '50'; + Category: dtcBinary; + ), + ( + Index: dbdtVarbinary; + NativeType: 253; + Name: 'VARBINARY'; + Description: 'VARBINARY(M)' + sLineBreak + + 'The VARBINARY type is similar to the VARCHAR type, but stores binary ' + + 'byte strings rather than non-binary character strings. M represents the ' + + 'maximum column length in bytes.'; + HasLength: True; + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: True; + DefLengthSet: '50'; + Category: dtcBinary; + ), + ( + Index: dbdtTinyblob; + NativeType: 249; + Name: 'TINYBLOB'; + Description: 'TINYBLOB' + sLineBreak + + 'A BLOB column with a maximum length of 255 (2^8 - 1) bytes. Each ' + + 'TINYBLOB value is stored using a one-byte length prefix that indicates ' + + 'the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcBinary; + ), + ( + Index: dbdtBlob; + NativeType: 252; + Name: 'BLOB'; + Description: 'BLOB[(M)]' + sLineBreak + + 'A BLOB column with a maximum length of 65,535 (2^16 - 1) bytes. Each ' + + 'BLOB value is stored using a two-byte length prefix that indicates the ' + + 'number of bytes in the value. ' + sLineBreak + + 'An optional length M can be given for this type. If this is done, MySQL ' + + 'creates the column as the smallest BLOB type large enough to hold ' + + 'values M bytes long.'; + HasLength: True; + RequiresLength: False; + MaxSize: 65535; + DefaultSize: 65535; + HasBinary: False; + HasDefault: False; + LoadPart: True; + Category: dtcBinary; + ), + ( + Index: dbdtMediumblob; + NativeType: 250; + Name: 'MEDIUMBLOB'; + Description: 'MEDIUMBLOB' + sLineBreak + + 'A BLOB column with a maximum length of 16,777,215 (2^24 - 1) bytes. Each ' + + 'MEDIUMBLOB value is stored using a three-byte length prefix that ' + + 'indicates the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: True; + Category: dtcBinary; + ), + ( + Index: dbdtLongblob; + NativeType: 251; + Name: 'LONGBLOB'; + Description: 'LONGBLOB' + sLineBreak + + 'A BLOB column with a maximum length of 4,294,967,295 or 4GB (2^32 - 1) ' + + 'bytes. The effective maximum length of LONGBLOB columns depends on the ' + + 'configured maximum packet size in the client/server protocol and ' + + 'available memory. Each LONGBLOB value is stored using a four-byte ' + + 'length prefix that indicates the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: True; + Category: dtcBinary; + ), + ( + Index: dbdtVector; + NativeType: 253; + Name: 'VECTOR'; + Description: 'VECTOR(N)' + sLineBreak + + 'VECTOR data type with a built-in data validation. N is the number of dimensions ' + + 'that all vector values in the column will have.'; + HasLength: True; + RequiresLength: True; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcBinary; + ), + ( + Index: dbdtEnum; + NativeType: 247; + Name: 'ENUM'; + Description: 'ENUM(''value1'',''value2'',...)' + sLineBreak + + 'An enumeration. A string object that can have only one value, chosen ' + + 'from the list of values ''value1'', ''value2'', ..., NULL or the special '''' ' + + 'error value. An ENUM column can have a maximum of 65,535 distinct ' + + 'values. ENUM values are represented internally as integers.'; + HasLength: True; // Obviously this is not meant as "length", but as "set of values" + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: False; + DefLengthSet: '''Y'',''N'''; + Category: dtcOther; + ), + ( + Index: dbdtSet; + NativeType: 248; + Name: 'SET'; + Description: 'SET(''value1'',''value2'',...)' + sLineBreak + + 'A set. A string object that can have zero or more values, each of which ' + + 'must be chosen from the list of values ''value1'', ''value2'', ... A SET ' + + 'column can have a maximum of 64 members. SET values are represented ' + + 'internally as integers.'; + HasLength: True; // Same as for ENUM + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: False; + DefLengthSet: '''Value A'',''Value B'''; + Category: dtcOther; + ), + ( + Index: dbdtBit; + NativeType: 16; + Name: 'BIT'; + Description: 'BIT[(M)]' + sLineBreak + + 'A bit-field type. M indicates the number of bits per value, from 1 to ' + + '64. The default is 1 if M is omitted.'; + HasLength: True; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtPoint; + NativeType: 255; + Name: 'POINT'; + Description: 'POINT(x,y)' + sLineBreak + + 'Constructs a WKB Point using its coordinates.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtLinestring; + NativeType: 255; + Name: 'LINESTRING'; + Description: 'LINESTRING(pt1,pt2,...)' + sLineBreak + + 'Constructs a WKB LineString value from a number of WKB Point arguments. ' + + 'If any argument is not a WKB Point, the return value is NULL. If the ' + + 'number of Point arguments is less than two, the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtPolygon; + NativeType: 255; + Name: 'POLYGON'; + Description: 'POLYGON(ls1,ls2,...)' + sLineBreak + + 'Constructs a WKB Polygon value from a number of WKB LineString ' + + 'arguments. If any argument does not represent the WKB of a LinearRing ' + + '(that is, not a closed and simple LineString) the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtGeometry; + NativeType: 255; + Name: 'GEOMETRY'; + Description: ''; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtMultipoint; + NativeType: 255; + Name: 'MULTIPOINT'; + Description: 'MULTIPOINT(pt1,pt2,...)' + sLineBreak + + 'Constructs a WKB MultiPoint value using WKB Point arguments. If any ' + + 'argument is not a WKB Point, the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtMultilinestring; + NativeType: 255; + Name: 'MULTILINESTRING'; + Description: 'MULTILINESTRING(ls1,ls2,...)' + sLineBreak + + 'Constructs a WKB MultiLineString value using WKB LineString arguments. ' + + 'If any argument is not a WKB LineString, the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtMultipolygon; + NativeType: 255; + Name: 'MULTIPOLYGON'; + Description: 'MULTIPOLYGON(poly1,poly2,...)' + sLineBreak + + 'Constructs a WKB MultiPolygon value from a set of WKB Polygon ' + + 'arguments. If any argument is not a WKB Polygon, the return value is ' + + 'NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtGeometrycollection; + NativeType: 255; + Name: 'GEOMETRYCOLLECTION'; + Description: 'GEOMETRYCOLLECTION(g1,g2,...)' + sLineBreak + + 'Constructs a WKB GeometryCollection. If any argument is not a ' + + 'well-formed WKB representation of a geometry, the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ) + + );} + + + MySQLVariables: array [0..417] of TServerVariable = + ( + ( + Name: 'auto_increment_increment'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'auto_increment_offset'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'autocommit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'automatic_sp_privileges'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'back_log'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'basedir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'big_tables'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'binlog_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'binlog_checksum'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'binlog_direct_non_transactional_updates'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'binlog_format'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'ROW,STATEMENT,MIXED'; + ), + ( + Name: 'binlog_row_image'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'FULL,MINIMAL,NOBLOB'; + ), + ( + Name: 'binlog_stmt_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'bulk_insert_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_client'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_connection'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_database[a]'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_filesystem'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_results'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_server'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_system'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'character_sets_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'collation_connection'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'collation_database[b]'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'collation_server'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'completion_type'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'NO_CHAIN,CHAIN,RELEASE,0,1,2'; + ), + ( + Name: 'concurrent_insert'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'NEVER,AUTO,ALWAYS,0,1,2'; + ), + ( + Name: 'connect_timeout'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'datadir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'date_format'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'datetime_format'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'debug'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'debug_sync'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'default_storage_engine'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'FEDERATED,MRG_MYISAM,MyISAM,BLACKHOLE,CSV,MEMORY,ARCHIVE,InnoDB'; + ), + ( + Name: 'default_tmp_storage_engine'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'FEDERATED,MRG_MYISAM,MyISAM,BLACKHOLE,CSV,MEMORY,ARCHIVE,InnoDB'; + ), + ( + Name: 'default_week_format'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'delay_key_write'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'ON,OFF,ALL'; + ), + ( + Name: 'delayed_insert_limit'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'delayed_insert_timeout'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'delayed_queue_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'disable_gtid_unsafe_statements'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'div_precision_increment'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'end_markers_in_json'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'engine_condition_pushdown'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'eq_range_index_dive_limit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'error_count'; + IsDynamic: False; + VarScope: vsSession; + ), + ( + Name: 'event_scheduler'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'ON,OFF,DISABLED'; + ), + ( + Name: 'expire_logs_days'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'external_user'; + IsDynamic: False; + VarScope: vsSession; + ), + ( + Name: 'flush'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'flush_time'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'foreign_key_checks'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'ft_boolean_syntax'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'ft_max_word_len'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ft_min_word_len'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ft_query_expansion_limit'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ft_stopword_file'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'general_log'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'general_log_file'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'group_concat_max_len'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'gtid_done'; + IsDynamic: False; + VarScope: vsBoth; + ), + ( + Name: 'gtid_lost'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'gtid_mode'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'gtid_mode'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'gtid_next'; + IsDynamic: True; + VarScope: vsSession; + EnumValues: 'AUTOMATIC,ANONYMOUS'; + ), + ( + Name: 'gtid_owned'; + IsDynamic: False; + VarScope: vsBoth; + ), + ( + Name: 'have_compress'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_crypt'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_csv'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_dynamic_loading'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_geometry'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_innodb'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_ndbcluster'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_openssl'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_partitioning'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_profiling'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_query_cache'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_rtree_keys'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_ssl'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_symlink'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'host_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'hostname'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'identity'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'ignore_builtin_innodb'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'init_connect'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'init_file'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'init_slave'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_adaptive_flushing'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_adaptive_hash_index'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_adaptive_max_sleep_delay'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_additional_mem_pool_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_analyze_is_persistent'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_api_enable_binlog'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_api_enable_mdl'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_api_trx_level'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_autoextend_increment'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_autoinc_lock_mode'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_dump_at_shutdown'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_dump_now'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_filename'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_load_abort'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_load_at_startup'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_load_now'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_change_buffer_max_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_change_buffering'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'INSERTS,DELETES,PURGES,CHANGES,ALL,NONE'; + ), + ( + Name: 'innodb_checksum_algorithm'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'INNODB,CRC32,NONE,STRICT_INNODB,STRICT_CRC32,STRICT_NONE'; + ), + ( + Name: 'innodb_checksums'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_commit_concurrency'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_concurrency_tickets'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_data_file_path'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_data_home_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_doublewrite'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_fast_shutdown'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_file_format'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_file_format_check'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_file_format_max'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_file_per_table'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_flush_log_at_trx_commit'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: '0,1,2'; + ), + ( + Name: 'innodb_flush_method'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_flush_neighbors'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_force_load_corrupted'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_force_recovery'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_aux_table'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_enable_stopword'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_max_token_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_min_token_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_num_word_optimize'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_server_stopword_table'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_sort_pll_degree'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_user_stopword_table'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_io_capacity'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_large_prefix'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_lock_wait_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'innodb_locks_unsafe_for_binlog'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_log_buffer_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_log_file_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_log_files_in_group'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_log_group_home_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_lru_scan_depth'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_max_dirty_pages_pct'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_max_purge_lag'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_mirrored_log_groups'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_monitor_disable'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_monitor_enable'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_monitor_reset'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_monitor_reset_all'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_old_blocks_pct'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_old_blocks_time'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_open_files'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_optimize_fulltext_only'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_page_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_print_all_deadlocks'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_purge_batch_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_purge_threads'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_random_read_ahead'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_read_ahead_threshold'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_read_io_threads'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_replication_delay'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_rollback_on_timeout'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_rollback_segments'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_sort_buffer_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_spin_wait_delay'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_stats_method'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'NULLS_EQUAL,NULLS_UNEQUAL,NULLS_IGNORED'; + ), + ( + Name: 'innodb_stats_on_metadata'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_stats_persistent_sample_pages'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_stats_sample_pages'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_stats_transient_sample_pages'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_strict_mode'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'innodb_support_xa'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'innodb_sync_array_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_sync_spin_loops'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_table_locks'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'innodb_thread_concurrency'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_thread_sleep_delay'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_undo_directory'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_undo_logs'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_undo_tablespaces'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_use_native_aio'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_use_sys_malloc'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_version'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_write_io_threads'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'insert_id'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'interactive_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'join_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'keep_files_on_create'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'key_buffer_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'key_cache_age_threshold'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'key_cache_block_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'key_cache_division_limit'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'language'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'large_files_support'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'large_page_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'large_pages'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'last_insert_id'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'lc_messages'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'lc_messages_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'lc_time_names'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'license'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'local_infile'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'lock_wait_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'locked_in_memory'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_bin'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log_bin_basename'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log_error'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log_output'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_queries_not_using_indexes'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_slave_updates'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log_slow_queries'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_throttle_queries_not_using_indexes'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_warnings'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'long_query_time'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'low_priority_updates'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'lower_case_file_system'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'lower_case_table_names'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'master_info_repository'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'master_verify_checksum'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_allowed_packet'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_binlog_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_binlog_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_binlog_stmt_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_connect_errors'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_connections'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_delayed_threads'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_error_count'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_heap_table_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_insert_delayed_threads'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_join_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_length_for_sort_data'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_prepared_stmt_count'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_relay_log_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_seeks_for_key'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_sort_length'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_sp_recursion_depth'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_tmp_tables'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_user_connections'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_write_lock_count'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'memlock'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'metadata_locks_cache_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_data_pointer_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_max_sort_file_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_mmap_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_recover_options'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_repair_threads'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'myisam_sort_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'myisam_stats_method'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'NULLS_EQUAL,NULLS_UNEQUAL,NULLS_IGNORED'; + ), + ( + Name: 'myisam_use_mmap'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'named_pipe'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'net_buffer_length'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'net_read_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'net_retry_count'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'net_write_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'new'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'old'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'old_alter_table'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'old_passwords'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'open_files_limit'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'optimizer_join_cache_level'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_prune_level'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_search_depth'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_switch'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace_features'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace_limit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace_max_mem_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace_offset'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'have_partitioning'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_accounts_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_digests_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_stages_history_long_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_stages_history_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_statements_history_long_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_statements_history_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_waits_history_long_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_waits_history_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_hosts_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_cond_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_cond_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_file_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_file_handles'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_file_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_mutex_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_mutex_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_rwlock_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_rwlock_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_socket_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_socket_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_stage_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_statement_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_table_handles'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_table_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_thread_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_thread_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_setup_actors_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_setup_objects_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_users_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'pid_file'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'plugin_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'port'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'preload_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'profiling'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'profiling_history_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'protocol_version'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'proxy_user'; + IsDynamic: False; + VarScope: vsSession; + ), + ( + Name: 'pseudo_thread_id'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'query_alloc_block_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'query_cache_limit'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'query_cache_min_res_unit'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'query_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'query_cache_type'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: '0,1,2'; + ), + ( + Name: 'query_cache_wlock_invalidate'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'query_prealloc_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'rand_seed1'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'rand_seed2'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'range_alloc_block_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'read_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'read_only'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'read_rnd_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'relay_log_basename'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_index'; + IsDynamic: False; + VarScope: vsBoth; + ), + ( + Name: 'relay_log_index'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_info_file'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_info_repository'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_purge'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_recovery'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_space_limit'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'report_host'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'report_password'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'report_port'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'report_user'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_master_enabled'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_master_timeout'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_master_trace_level'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_master_wait_no_slave'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_slave_enabled'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_slave_trace_level'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'secure_auth'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'secure_file_priv'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'server_id'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'server_uuid'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'shared_memory'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'shared_memory_base_name'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'skip_external_locking'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'skip_name_resolve'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'skip_networking'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'skip_show_database'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'slave_compressed_protocol'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_exec_mode'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'IDEMPOTENT,STRICT'; + ), + ( + Name: 'slave_load_tmpdir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'slave_net_timeout'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_parallel_workers'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_skip_errors'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'slave_sql_verify_checksum'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_transaction_retries'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_type_conversions'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'slow_launch_time'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slow_query_log'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slow_query_log_file'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'socket'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'sort_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_auto_is_null'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_big_selects'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_big_tables'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_buffer_result'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_log_bin'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_log_off'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_low_priority_updates'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_max_join_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_mode'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_notes'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_quote_show_create'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_safe_updates'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_select_limit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_slave_skip_counter'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sql_warnings'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'ssl_ca'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_capath'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_cert'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_cipher'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_crl'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_crlpath'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_key'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'storage_engine'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'FEDERATED,MRG_MYISAM,MyISAM,BLACKHOLE,CSV,MEMORY,ARCHIVE,InnoDB'; + ), + ( + Name: 'stored_program_cache'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_binlog'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_frm'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_master_info'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_relay_log'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_relay_log_info'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'system_time_zone'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'table_definition_cache'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'table_open_cache'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'thread_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'thread_concurrency'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'thread_handling'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'thread_stack'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'time_format'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'time_zone'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'timed_mutexes'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'timestamp'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'tmp_table_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'tmpdir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'transaction_alloc_block_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'transaction_prealloc_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'tx_isolation'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'READ-UNCOMMITTED,READ-COMMITTED,REPEATABLE-READ,SERIALIZABLE'; + ), + ( + Name: 'tx_read_only'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'unique_checks'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'updatable_views_with_limit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'version'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'version_comment'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'version_compile_machine'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'version_compile_os'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'wait_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'warning_count'; + IsDynamic: False; + VarScope: vsSession; + ) + + ); + + +implementation + +uses apphelpers; + + +constructor TMySQLLib.Create(DllFile_, DefaultDll: String); +var + BaseDll: String; +begin + inherited; + // MYSQL_OPT_* constants + MYSQL_OPT_CONNECT_TIMEOUT := 0; + MYSQL_OPT_LOCAL_INFILE := 8; + MYSQL_PLUGIN_DIR := 22; + MYSQL_OPT_SSL_KEY := 25; + MYSQL_OPT_SSL_CERT := 26; + MYSQL_OPT_SSL_CA := 27; + MYSQL_OPT_SSL_CIPHER := 29; + MYSQL_OPT_CONNECT_ATTR_ADD := 33; + MYSQL_ENABLE_CLEARTEXT_PLUGIN := 36; + MYSQL_OPT_TLS_VERSION := 41; + MARIADB_OPT_TLS_VERSION := INVALID_OPT; + MYSQL_OPT_SSL_MODE := INVALID_OPT; + MYSQL_OPT_SSL_VERIFY_SERVER_CERT := INVALID_OPT; + // Option values + SSL_MODE_DISABLED := 1; + SSL_MODE_PREFERRED := 2; + SSL_MODE_REQUIRED := 3; + SSL_MODE_VERIFY_CA := 4; + SSL_MODE_VERIFY_IDENTITY := 5; + BaseDll := ExtractFileName(FDllFile); + if BaseDLL.StartsWith('libmariadb', True) then begin + // Differences in libmariadb + MYSQL_OPT_SSL_VERIFY_SERVER_CERT := 21; + MARIADB_OPT_TLS_VERSION := 7005; + end + else if String(mysql_get_client_info).StartsWith('8.') then begin + // Some constants were removed in MySQL 8.0, so the offsets differ + MYSQL_PLUGIN_DIR := 16; + MYSQL_OPT_SSL_KEY := 19; + MYSQL_OPT_SSL_CERT := 20; + MYSQL_OPT_SSL_CA := 21; + MYSQL_OPT_SSL_CIPHER := 23; + MYSQL_OPT_CONNECT_ATTR_ADD := 27; + MYSQL_ENABLE_CLEARTEXT_PLUGIN := 30; + MYSQL_OPT_TLS_VERSION := 34; + MYSQL_OPT_SSL_MODE := 35; + end; +end; + +procedure TMySQLLib.AssignProcedures; +begin + AssignProc(@mysql_affected_rows, 'mysql_affected_rows'); + AssignProc(@mysql_character_set_name, 'mysql_character_set_name'); + AssignProc(@mysql_close, 'mysql_close'); + AssignProc(@mysql_data_seek, 'mysql_data_seek'); + AssignProc(@mysql_errno, 'mysql_errno'); + AssignProc(@mysql_error, 'mysql_error'); + AssignProc(@mysql_fetch_field_direct, 'mysql_fetch_field_direct'); + AssignProc(@mysql_fetch_field, 'mysql_fetch_field'); + AssignProc(@mysql_fetch_lengths, 'mysql_fetch_lengths'); + AssignProc(@mysql_fetch_row, 'mysql_fetch_row'); + AssignProc(@mysql_free_result, 'mysql_free_result'); + AssignProc(@mysql_get_client_info, 'mysql_get_client_info'); + AssignProc(@mysql_get_server_info, 'mysql_get_server_info'); + AssignProc(@mysql_init, 'mysql_init'); + AssignProc(@mysql_info, 'mysql_info'); + AssignProc(@mysql_num_fields, 'mysql_num_fields'); + AssignProc(@mysql_num_rows, 'mysql_num_rows'); + AssignProc(@mysql_ping, 'mysql_ping'); + AssignProc(@mysql_options, 'mysql_options'); + AssignProc(@mysql_optionsv, 'mysql_optionsv', False); + AssignProc(@mysql_real_connect, 'mysql_real_connect'); + AssignProc(@mysql_real_query, 'mysql_real_query'); + AssignProc(@mysql_stat, 'mysql_stat'); + AssignProc(@mysql_store_result, 'mysql_store_result'); + AssignProc(@mysql_thread_id, 'mysql_thread_id'); + AssignProc(@mysql_next_result, 'mysql_next_result'); + AssignProc(@mysql_set_character_set, 'mysql_set_character_set'); + AssignProc(@mysql_thread_init, 'mysql_thread_init'); + AssignProc(@mysql_thread_end, 'mysql_thread_end'); + AssignProc(@mysql_warning_count, 'mysql_warning_count'); +end; + + +initialization + +// Keywords copied from SynHighligherSQL +MySQLKeywords := TStringList.Create; +MySQLKeywords.CommaText := 'ACCESSIBLE,ACCOUNT,ACTION,ACTIVE,ADD,ADMIN,AFTER,AGAINST,AGGREGATE,' + + 'ALGORITHM,ALL,ALTER,ALWAYS,ANALYSE,ANALYZE,AND,ANY,ARRAY,AS,ASC,' + + 'ASENSITIVE,AT,ATTRIBUTE,AUTHENTICATION,AUTOEXTEND_SIZE,AUTO_INCREMENT,' + + 'AVG_ROW_LENGTH,BACKUP,BEFORE,BEGIN,BETWEEN,BINLOG,BIT,BLOCK,BOTH,BUCKETS,' + + 'BULK,BY,CACHE,CALL,CASCADE,CASCADED,CATALOG_NAME,CHAIN,CHALLENGE_RESPONSE,' + + 'CHANGE,CHANGED,CHANNEL,CHARACTER,CHARSET,CHECK,CHECKSUM,CIPHER,' + + 'CLASS_ORIGIN,CLIENT,CLONE,CODE,COLLATE,COLLATION,COLUMN,COLUMNS,' + + 'COLUMN_FORMAT,COLUMN_NAME,COMMENT,COMMIT,COMMITTED,COMPLETION,COMPONENT,' + + 'COMPRESSION,CONCURRENT,CONDITION,CONNECTION,CONSISTENT,CONSTRAINT,' + + 'CONSTRAINT_CATALOG,CONSTRAINT_NAME,CONSTRAINT_SCHEMA,CONTAINS,CONTEXT,' + + 'CONTINUE,CONVERT,CPU,CREATE,CROSS,CUBE,CUME_DIST,CURRENT,CURSOR,' + + 'CURSOR_NAME,DATA,DATABASE,DATABASES,DATAFILE,DAY_HOUR,DAY_MICROSECOND,' + + 'DAY_MINUTE,DAY_SECOND,DEALLOCATE,DEC,DECLARE,DEFAULT,DEFAULT_AUTH,DEFINER,' + + 'DEFINITION,DELAYED,DELAY_KEY_WRITE,DELETE,DENSE_RANK,DESC,DESCRIBE,' + + 'DESCRIPTION,DES_KEY_FILE,DETERMINISTIC,DIAGNOSTICS,DIRECTORY,DISABLE,' + + 'DISCARD,DISTINCT,DISTINCTROW,DIV,DO,DROP,DUAL,DUMPFILE,DUPLICATE,EACH,' + + 'ELSE,ELSEIF,EMPTY,ENABLE,ENCLOSED,ENCRYPTION,END,ENDS,ENFORCED,ENGINE,' + + 'ENGINES,ENGINE_ATTRIBUTE,ERROR,ERRORS,ESCAPE,ESCAPED,EVENT,EVENTS,EVERY,' + + 'EXCEPT,EXCHANGE,EXCLUDE,EXECUTE,EXISTS,EXPANSION,EXPIRE,EXPLAIN,EXPORT,' + + 'EXTENDED,EXTENT_SIZE,FACTOR,FAILED_LOGIN_ATTEMPTS,FALSE,FAST,FAULTS,' + + 'FIELDS,FILE,FILE_BLOCK_SIZE,FILTER,FINISH,FIRST,FIRST_VALUE,FLOAT4,FLOAT8,' + + 'FLUSH,FOLLOWING,FOLLOWS,FOR,FORCE,FOREIGN,FOUND,FROM,FULL,FULLTEXT,' + + 'FUNCTION,GENERAL,GENERATE,GENERATED,GEOMCOLLECTION,GET,' + + 'GET_MASTER_PUBLIC_KEY,GET_SOURCE_PUBLIC_KEY,GLOBAL,GRANT,GRANTS,GROUP,' + + 'GROUPING,GROUPS,GROUP_REPLICATION,GTID_ONLY,HAVING,HELP,HIGH_PRIORITY,' + + 'HISTOGRAM,HISTORY,HOST,HOSTS,HOUR_MICROSECOND,HOUR_MINUTE,HOUR_SECOND,' + + 'IDENTIFIED,IGNORE,IGNORE_SERVER_IDS,IMPORT,IN,INACTIVE,INDEX,INDEXES,' + + 'INFILE,INITIAL,INITIAL_SIZE,INITIATE,INNER,INOUT,INSENSITIVE,INSERT,' + + 'INSERT_METHOD,INSTALL,INSTANCE,INT1,INT2,INT3,INT4,INT8,INTERSECT,INTO,' + + 'INVISIBLE,INVOKER,IO,IO_AFTER_GTIDS,IO_BEFORE_GTIDS,IO_THREAD,IPC,IS,' + + 'ISOLATION,ISSUER,JOIN,JSON,JSON_TABLE,JSON_VALUE,KEY,KEYRING,KEYS,' + + 'KEY_BLOCK_SIZE,KILL,LAG,LANGUAGE,LAST,LAST_VALUE,LATERAL,LEAD,LEADING,' + + 'LEAVES,LESS,LEVEL,LIKE,LIMIT,LINEAR,LINES,LIST,LOAD,LOCAL,LOCK,LOCKED,' + + 'LOCKS,LOGFILE,LOGS,LONG,LOW_PRIORITY,MASTER,MASTER_AUTO_POSITION,' + + 'MASTER_BIND,MASTER_COMPRESSION_ALGORITHMS,MASTER_CONNECT_RETRY,' + + 'MASTER_DELAY,MASTER_HEARTBEAT_PERIOD,MASTER_HOST,MASTER_LOG_FILE,' + + 'MASTER_LOG_POS,MASTER_PASSWORD,MASTER_PORT,MASTER_PUBLIC_KEY_PATH,' + + 'MASTER_RETRY_COUNT,MASTER_SERVER_ID,MASTER_SSL,MASTER_SSL_CA,' + + 'MASTER_SSL_CAPATH,MASTER_SSL_CERT,MASTER_SSL_CIPHER,MASTER_SSL_CRL,' + + 'MASTER_SSL_CRLPATH,MASTER_SSL_KEY,MASTER_SSL_VERIFY_SERVER_CERT,' + + 'MASTER_TLS_CIPHERSUITES,MASTER_TLS_VERSION,MASTER_USER,' + + 'MASTER_ZSTD_COMPRESSION_LEVEL,MATCH,MAXVALUE,MAX_CONNECTIONS_PER_HOUR,' + + 'MAX_QUERIES_PER_HOUR,MAX_ROWS,MAX_SIZE,MAX_UPDATES_PER_HOUR,' + + 'MAX_USER_CONNECTIONS,MEDIUM,MEMBER,MESSAGE_TEXT,MIDDLEINT,MIGRATE,' + + 'MINUTE_MICROSECOND,MINUTE_SECOND,MIN_ROWS,MOD,MODE,MODIFIES,MODIFY,MUTEX,' + + 'MYSQL_ERRNO,NAME,NAMES,NATURAL,NCHAR,NESTED,NETWORK_NAMESPACE,NEVER,NEW,' + + 'NEXT,NO,NODEGROUP,NONE,NOT,NOWAIT,NO_WAIT,NO_WRITE_TO_BINLOG,NTH_VALUE,' + + 'NTILE,NULL,NULLS,NUMBER,NVARCHAR,OF,OFF,OFFSET,OJ,OLD,ON,ONE,ONLY,OPEN,' + + 'OPTIMIZE,OPTIMIZER_COSTS,OPTION,OPTIONAL,OPTIONALLY,OPTIONS,OR,ORDER,' + + 'ORDINALITY,ORGANIZATION,OTHERS,OUT,OUTER,OUTFILE,OVER,OWNER,PACK_KEYS,' + + 'PAGE,PARSER,PARSE_GCOL_EXPR,PARTIAL,PARTITION,PARTITIONING,PARTITIONS,' + + 'PASSWORD_LOCK_TIME,PATH,PERCENT_RANK,PERSIST,PERSIST_ONLY,PHASE,PLUGIN,' + + 'PLUGINS,PLUGIN_DIR,PORT,PRECEDES,PRECEDING,PREPARE,PRESERVE,PREV,PRIMARY,' + + 'PRIVILEGES,PRIVILEGE_CHECKS_USER,PROCEDURE,PROCESS,PROCESSLIST,PROFILE,' + + 'PROFILES,PROXY,PURGE,QUERY,QUICK,RANDOM,RANGE,RANK,READ,READS,READ_ONLY,' + + 'READ_WRITE,REBUILD,RECOVER,RECURSIVE,REDOFILE,REDO_BUFFER_SIZE,REFERENCE,' + + 'REFERENCES,REGEXP,REGISTRATION,RELAY,RELAYLOG,RELAY_LOG_FILE,' + + 'RELAY_LOG_POS,RELAY_THREAD,RELEASE,RELOAD,REMOTE,REMOVE,RENAME,REORGANIZE,' + + 'REPAIR,REPEATABLE,REPLACE,REPLICA,REPLICAS,REPLICATE_DO_DB,' + + 'REPLICATE_DO_TABLE,REPLICATE_IGNORE_DB,REPLICATE_IGNORE_TABLE,' + + 'REPLICATE_REWRITE_DB,REPLICATE_WILD_DO_TABLE,REPLICATE_WILD_IGNORE_TABLE,' + + 'REPLICATION,REQUIRE,REQUIRE_ROW_FORMAT,RESET,RESIGNAL,RESOURCE,RESPECT,' + + 'RESTART,RESTORE,RESTRICT,RESUME,RETAIN,RETURN,RETURNED_SQLSTATE,RETURNING,' + + 'RETURNS,REUSE,REVOKE,RLIKE,ROLE,ROLLBACK,ROLLUP,ROTATE,ROUTINE,ROW,ROWS,' + + 'ROW_FORMAT,ROW_NUMBER,RTREE,SAVEPOINT,SCHEDULE,SCHEMA,SCHEMAS,SCHEMA_NAME,' + + 'SECONDARY,SECONDARY_ENGINE,SECONDARY_ENGINE_ATTRIBUTE,SECONDARY_LOAD,' + + 'SECONDARY_UNLOAD,SECOND_MICROSECOND,SECURITY,SELECT,SENSITIVE,SEPARATOR,' + + 'SERIALIZABLE,SERVER,SESSION,SET,SHARE,SHOW,SHUTDOWN,SIGNAL,SIMPLE,SKIP,' + + 'SLAVE,SLOW,SNAPSHOT,SOCKET,SOME,SONAME,SOUNDS,SOURCE,SOURCE_AUTO_POSITION,' + + 'SOURCE_BIND,SOURCE_COMPRESSION_ALGORITHMS,SOURCE_CONNECT_RETRY,' + + 'SOURCE_DELAY,SOURCE_HEARTBEAT_PERIOD,SOURCE_HOST,SOURCE_LOG_FILE,' + + 'SOURCE_LOG_POS,SOURCE_PASSWORD,SOURCE_PORT,SOURCE_PUBLIC_KEY_PATH,' + + 'SOURCE_RETRY_COUNT,SOURCE_SSL,SOURCE_SSL_CA,SOURCE_SSL_CAPATH,' + + 'SOURCE_SSL_CERT,SOURCE_SSL_CIPHER,SOURCE_SSL_CRL,SOURCE_SSL_CRLPATH,' + + 'SOURCE_SSL_KEY,SOURCE_SSL_VERIFY_SERVER_CERT,SOURCE_TLS_CIPHERSUITES,' + + 'SOURCE_TLS_VERSION,SOURCE_USER,SOURCE_ZSTD_COMPRESSION_LEVEL,SPATIAL,' + + 'SPECIFIC,SQL,SQLEXCEPTION,SQLSTATE,SQLWARNING,SQL_AFTER_GTIDS,' + + 'SQL_AFTER_MTS_GAPS,SQL_BEFORE_GTIDS,SQL_BIG_RESULT,SQL_BUFFER_RESULT,' + + 'SQL_CACHE,SQL_CALC_FOUND_ROWS,SQL_NO_CACHE,SQL_SMALL_RESULT,SQL_THREAD,' + + 'SQL_TSI_DAY,SQL_TSI_HOUR,SQL_TSI_MINUTE,SQL_TSI_MONTH,SQL_TSI_QUARTER,' + + 'SQL_TSI_SECOND,SQL_TSI_WEEK,SQL_TSI_YEAR,SSL,STACKED,START,STARTING,' + + 'STARTS,STATS_AUTO_RECALC,STATS_PERSISTENT,STATS_SAMPLE_PAGES,STATUS,STOP,' + + 'STORAGE,STORED,STRAIGHT_JOIN,STREAM,SUBCLASS_ORIGIN,SUBJECT,SUBPARTITION,' + + 'SUBPARTITIONS,SUPER,SUSPEND,SWAPS,SWITCHES,SYSTEM,TABLE,TABLES,TABLESPACE,' + + 'TABLE_CHECKSUM,TABLE_NAME,TEMPORARY,TERMINATED,THAN,THREAD_PRIORITY,TIES,' + + 'TLS,TO,TRAILING,TRANSACTION,TRIGGER,TRIGGERS,TRUE,TYPE,TYPES,UNBOUNDED,' + + 'UNCOMMITTED,UNDO,UNDOFILE,UNDO_BUFFER_SIZE,UNINSTALL,UNION,UNIQUE,UNKNOWN,' + + 'UNLOCK,UNREGISTER,UPDATE,UPGRADE,URL,USAGE,USE,USER_RESOURCES,USE_FRM,' + + 'USING,VALIDATION,VALUE,VALUES,VARCHARACTER,VARIABLES,VARYING,VCPU,VIEW,' + + 'VIRTUAL,VISIBLE,WAIT,WARNINGS,WHERE,WINDOW,WITH,WITHOUT,WORK,WRAPPER,' + + 'WRITE,X509,XA,XID,XML,XOR,YEAR_MONTH,ZONE,' + // SQL Plus commands: + + 'CLOSE,CONDITION,CONTINUE,CURSOR,DECLARE,DO,EXIT,FETCH,FOUND,GOTO,' + + 'HANDLER,ITERATE,LANGUAGE,LEAVE,LOOP,UNTIL,WHILE'; + +// Error codes copied from perror.exe +MySQLErrorCodes := Explode(',', '0=No error,'+ + '1=Operation not permitted,'+ + '2=No such file or directory,'+ + '3=No such process,'+ + '4=Interrupted function call,'+ + '5=Input/output error,'+ + '6=No such device or address,'+ + '7=Arg list too long,'+ + '8=Exec format error,'+ + '9=Bad file descriptor,'+ + '10=No child processes,'+ + '11=Resource temporarily unavailable,'+ + '12=Not enough space,'+ + '13=Permission denied,'+ + '14=Bad address,'+ + '16=Resource device,'+ + '17=File exists,'+ + '18=Improper link,'+ + '19=No such device,'+ + '20=Not a directory,'+ + '21=Is a directory,'+ + '22=Invalid argument,'+ + '23=Too many open files in system,'+ + '24=Too many open files,'+ + '25=Inappropriate I/O control operation,'+ + '27=File too large,'+ + '28=No space left on device,'+ + '29=Invalid seek,'+ + '30=Read-only file system,'+ + '31=Too many links,'+ + '32=Broken pipe,'+ + '33=Domain error,'+ + '34=Result too large,'+ + '36=Resource deadlock avoided,'+ + '38=Filename too long,'+ + '39=No locks available,'+ + '40=Function not implemented,'+ + '41=Directory not empty,'+ + '42=Illegal byte sequence,'+ + '120=Didn''t find key on read or update,'+ + '121=Duplicate key on write or update,'+ + '123=Someone has changed the row since it was read (while the table was locked to prevent it),'+ + '124=Wrong index given to function,'+ + '126=Index file is crashed,'+ + '127=Record-file is crashed,'+ + '128=Out of memory,'+ + '130=Incorrect file format,'+ + '131=Command not supported by database,'+ + '132=Old database file,'+ + '133=No record read before update,'+ + '134=Record was already deleted (or record file crashed),'+ + '135=No more room in record file,'+ + '136=No more room in index file,'+ + '137=No more records (read after end of file),'+ + '138=Unsupported extension used for table,'+ + '139=Too big row,'+ + '140=Wrong create options,'+ + '141=Duplicate unique key or constraint on write or update,'+ + '142=Unknown character set used,'+ + '143=Conflicting table definitions in sub-tables of MERGE table,'+ + '144=Table is crashed and last repair failed,'+ + '145=Table was marked as crashed and should be repaired,'+ + '146=Lock timed out; Retry transaction,'+ + '147=Lock table is full; Restart program with a larger locktable,'+ + '148=Updates are not allowed under a read only transactions,'+ + '149=Lock deadlock; Retry transaction,'+ + '150=Foreign key constraint is incorrectly formed,'+ + '151=Cannot add a child row,'+ + '152=Cannot delete a parent row'); + + + +end. diff --git a/source/dbstructures.pas b/source/dbstructures.pas new file mode 100644 index 00000000..3217bd22 --- /dev/null +++ b/source/dbstructures.pas @@ -0,0 +1,218 @@ +unit dbstructures; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Graphics; + + +type + + // Column types + TDBDatatypeIndex = (dbdtTinyint, dbdtSmallint, dbdtMediumint, dbdtInt, dbdtUint, dbdtBigint, dbdtSerial, dbdtBigSerial, + dbdtFloat, dbdtDouble, dbdtDecimal, dbdtNumeric, dbdtReal, dbdtDoublePrecision, dbdtMoney, dbdtSmallmoney, + dbdtDate, dbdtTime, dbdtYear, dbdtDatetime, dbdtDatetime2, dbdtDatetimeOffset, dbdtSmalldatetime, dbdtTimestamp, dbdtInterval, + dbdtChar, dbdtNchar, dbdtVarchar, dbdtNvarchar, dbdtTinytext, dbdtText, dbdtCiText, dbdtNtext, dbdtMediumtext, dbdtLongtext, + dbdtJson, dbdtJsonB, dbdtCidr, dbdtInet, dbdtMacaddr, + dbdtBinary, dbdtVarbinary, dbdtTinyblob, dbdtBlob, dbdtMediumblob, dbdtLongblob, dbdtVector, dbdtImage, + dbdtEnum, dbdtSet, dbdtBit, dbdtVarBit, dbdtBool, dbdtRegClass, dbdtRegProc, dbdtUnknown, + dbdtCursor, dbdtSqlvariant, dbdtTable, dbdtUniqueidentifier, dbdtInet4, dbdtInet6, dbdtHierarchyid, dbdtXML, + dbdtPoint, dbdtLinestring, dbdtLineSegment, dbdtPolygon, dbdtGeometry, dbdtBox, dbdtPath, dbdtCircle, dbdtMultipoint, dbdtMultilinestring, dbdtMultipolygon, dbdtGeometrycollection + ); + + // Column type categorization + TDBDatatypeCategoryIndex = (dtcInteger, dtcReal, dtcText, dtcBinary, dtcTemporal, dtcSpatial, dtcOther); + + // Column type structure + TDBDatatype = record + Index: TDBDatatypeIndex; + NativeType: Integer; // MySQL column type constant (e.g. 1 = TINYINT). See include/mysql.h.pp. + NativeTypes: String; // Same as above, but for multiple ids (e.g. PostgreSQL oids). Prefer over NativeType. See GetDatatypeByNativeType. + Name: String; + Names: String; + Description: String; + HasLength: Boolean; // Can have Length- or Set-attribute? + RequiresLength: Boolean; // Must have a Length- or Set-attribute? + MaxSize: Int64; + DefaultSize: Int64; // TEXT and BLOB allow custom length, but we want to leave the default max length away from ALTER TABLE's + HasBinary: Boolean; // Can be binary? + HasDefault: Boolean; // Can have a default value? + LoadPart: Boolean; // Select per SUBSTR() or LEFT() + DefLengthSet: String; // Should be set for types which require a length/set + Format: String; // Used for date/time values when displaying and generating queries + ValueMustMatch: String; + Category: TDBDatatypeCategoryIndex; + MinVersion: Integer; + end; + + // Column type category structure + TDBDatatypeCategory = record + Index: TDBDatatypeCategoryIndex; + Name: String; + Color: TColor; + NullColor: TColor; + end; + + // Server variables + TVarScope = (vsGlobal, vsSession, vsBoth); + TServerVariable = record + Name: String; + IsDynamic: Boolean; + VarScope: TVarScope; + EnumValues: String; + end; + + // Custom exception class for any connection or database related error + EDbError = class(Exception) + private + FErrorCode: Cardinal; + FHint: String; + public + property ErrorCode: Cardinal read FErrorCode; + property Hint: String read FHint; + constructor Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String=''); + end; + + // DLL loading + TDbLib = class(TObject) + const + LIB_PROC_ERROR: Cardinal = 1000; + private + FHandle: TLibHandle; + protected + FDllFile: String; + procedure AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True); + procedure AssignProcedures; virtual; abstract; + public + property Handle: TLibHandle read FHandle; + property DllFile: String read FDllFile; + constructor Create(DllFile_, DefaultDll: String); virtual; + destructor Destroy; override; + end; + + +var + + // Column type categories + DatatypeCategories: array[TDBDatatypeCategoryIndex] of TDBDatatypeCategory = ( + ( + Index: dtcInteger; + Name: 'Integer' + ), + ( + Index: dtcReal; + Name: 'Real' + ), + ( + Index: dtcText; + Name: 'Text' + ), + ( + Index: dtcBinary; + Name: 'Binary' + ), + ( + Index: dtcTemporal; + Name: 'Temporal (time)' + ), + ( + Index: dtcSpatial; + Name: 'Spatial (geometry)' + ), + ( + Index: dtcOther; + Name: 'Other' + ) + ); + + + +implementation + +uses apphelpers; + + + +{ EDbError } + +constructor EDbError.Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String=''); +begin + FErrorCode := ErrorCode_; + FHint := Hint_; + inherited Create(Msg); +end; + + + +{ TDbLib } + +constructor TDbLib.Create(DllFile_, DefaultDll: String); +var + msg, ErrorHint: String; +begin + // Load DLL as is (with or without path) + inherited Create; + FDllFile := DllFile_; + if not FileExists(FDllFile) then begin + msg := f_('File does not exist: %s', [FDllFile]) + + sLineBreak + sLineBreak + + f_('Please launch %s from the directory where you have installed it. Or just reinstall %s.', [APPNAME, APPNAME] + ); + Raise EdbError.Create(msg); + end; + + FHandle := LoadLibrary(FDllFile); + if FHandle = NilHandle then begin + msg := f_('Library %s could not be loaded. Please select a different one.', + [ExtractFileName(FDllFile)] + ); + if GetLastOSError <> 0 then begin + msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]); + end; + if (DefaultDll <> '') and (ExtractFileName(FDllFile) <> DefaultDll) then begin + ErrorHint := f_('You could try the default library %s in your session settings. (Current: %s)', + [DefaultDll, ExtractFileName(FDllFile)] + ); + end else begin + ErrorHint := ''; + end; + Raise EDbError.Create(msg, GetLastOSError, ErrorHint); + end; + + // Dll was loaded, now initialize required procedures + AssignProcedures; +end; + + +destructor TDbLib.Destroy; +begin + if FHandle <> 0 then begin + FreeLibrary(FHandle); + FHandle := 0; + end; + inherited; +end; + + +procedure TDbLib.AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True); +var + msg: String; +begin + // Map library procedure to internal procedure + Proc := GetProcAddress(FHandle, Name); + if Proc = nil then begin + if Mandantory then begin + msg := f_('Library error in %s: Could not find procedure address for "%s"', + [ExtractFileName(FDllFile), Name] + ); + if GetLastOSError <> 0 then + msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]); + Raise EDbError.Create(msg, LIB_PROC_ERROR); + end; + end; +end; + + +end. diff --git a/source/main.lfm b/source/main.lfm new file mode 100644 index 00000000..6937d110 --- /dev/null +++ b/source/main.lfm @@ -0,0 +1,1171 @@ +object MainForm: TMainForm + Left = 585 + Height = 500 + Top = 289 + Width = 998 + Caption = 'MainForm' + ClientHeight = 500 + ClientWidth = 998 + DesignTimePPI = 120 + Menu = MainMenu1 + OnCreate = FormCreate + Position = poMainFormCenter + LCLVersion = '3.8.0.0' + object StatusBar: TStatusBar + Left = 0 + Height = 29 + Top = 471 + Width = 998 + Panels = < + item + Width = 150 + end + item + Width = 110 + end + item + Style = psOwnerDraw + Width = 140 + end + item + Style = psOwnerDraw + Width = 170 + end + item + Width = 170 + end + item + Style = psOwnerDraw + Width = 170 + end + item + Style = psOwnerDraw + Width = 250 + end> + SimplePanel = False + end + object ToolBarMainButtons: TToolBar + Left = 0 + Height = 30 + Top = 0 + Width = 998 + AutoSize = True + Caption = 'ToolBarMainButtons' + Images = ImageListIcons8 + TabOrder = 1 + object ToolButton1: TToolButton + Left = 1 + Top = 2 + Action = actSessionManager + Style = tbsDropDown + end + end + inline SynMemoSQLLog: TSynEdit + Left = 0 + Height = 80 + Top = 391 + Width = 998 + Align = alBottom + Font.Height = -13 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Font.Quality = fqCleartypeNatural + ParentColor = False + ParentFont = False + TabOrder = 2 + Gutter.Width = 68 + Gutter.MouseActions = <> + RightGutter.Width = 0 + RightGutter.MouseActions = <> + Highlighter = SynSQLSynUsed + Keystrokes = < + item + Command = ecUp + ShortCut = 38 + end + item + Command = ecSelUp + ShortCut = 8230 + end + item + Command = ecScrollUp + ShortCut = 16422 + end + item + Command = ecDown + ShortCut = 40 + end + item + Command = ecSelDown + ShortCut = 8232 + end + item + Command = ecScrollDown + ShortCut = 16424 + end + item + Command = ecLeft + ShortCut = 37 + end + item + Command = ecSelLeft + ShortCut = 8229 + end + item + Command = ecWordLeft + ShortCut = 16421 + end + item + Command = ecSelWordLeft + ShortCut = 24613 + end + item + Command = ecRight + ShortCut = 39 + end + item + Command = ecSelRight + ShortCut = 8231 + end + item + Command = ecWordRight + ShortCut = 16423 + end + item + Command = ecSelWordRight + ShortCut = 24615 + end + item + Command = ecPageDown + ShortCut = 34 + end + item + Command = ecSelPageDown + ShortCut = 8226 + end + item + Command = ecPageBottom + ShortCut = 16418 + end + item + Command = ecSelPageBottom + ShortCut = 24610 + end + item + Command = ecPageUp + ShortCut = 33 + end + item + Command = ecSelPageUp + ShortCut = 8225 + end + item + Command = ecPageTop + ShortCut = 16417 + end + item + Command = ecSelPageTop + ShortCut = 24609 + end + item + Command = ecLineStart + ShortCut = 36 + end + item + Command = ecSelLineStart + ShortCut = 8228 + end + item + Command = ecEditorTop + ShortCut = 16420 + end + item + Command = ecSelEditorTop + ShortCut = 24612 + end + item + Command = ecLineEnd + ShortCut = 35 + end + item + Command = ecSelLineEnd + ShortCut = 8227 + end + item + Command = ecEditorBottom + ShortCut = 16419 + end + item + Command = ecSelEditorBottom + ShortCut = 24611 + end + item + Command = ecToggleMode + ShortCut = 45 + end + item + Command = ecCopy + ShortCut = 16429 + end + item + Command = ecPaste + ShortCut = 8237 + end + item + Command = ecDeleteChar + ShortCut = 46 + end + item + Command = ecCut + ShortCut = 8238 + end + item + Command = ecDeleteLastChar + ShortCut = 8 + end + item + Command = ecDeleteLastChar + ShortCut = 8200 + end + item + Command = ecDeleteLastWord + ShortCut = 16392 + end + item + Command = ecUndo + ShortCut = 32776 + end + item + Command = ecRedo + ShortCut = 40968 + end + item + Command = ecLineBreak + ShortCut = 13 + end + item + Command = ecSelectAll + ShortCut = 16449 + end + item + Command = ecCopy + ShortCut = 16451 + end + item + Command = ecBlockIndent + ShortCut = 24649 + end + item + Command = ecLineBreak + ShortCut = 16461 + end + item + Command = ecInsertLine + ShortCut = 16462 + end + item + Command = ecDeleteWord + ShortCut = 16468 + end + item + Command = ecBlockUnindent + ShortCut = 24661 + end + item + Command = ecPaste + ShortCut = 16470 + end + item + Command = ecCut + ShortCut = 16472 + end + item + Command = ecDeleteLine + ShortCut = 16473 + end + item + Command = ecDeleteEOL + ShortCut = 24665 + end + item + Command = ecUndo + ShortCut = 16474 + end + item + Command = ecRedo + ShortCut = 24666 + end + item + Command = ecGotoMarker0 + ShortCut = 16432 + end + item + Command = ecGotoMarker1 + ShortCut = 16433 + end + item + Command = ecGotoMarker2 + ShortCut = 16434 + end + item + Command = ecGotoMarker3 + ShortCut = 16435 + end + item + Command = ecGotoMarker4 + ShortCut = 16436 + end + item + Command = ecGotoMarker5 + ShortCut = 16437 + end + item + Command = ecGotoMarker6 + ShortCut = 16438 + end + item + Command = ecGotoMarker7 + ShortCut = 16439 + end + item + Command = ecGotoMarker8 + ShortCut = 16440 + end + item + Command = ecGotoMarker9 + ShortCut = 16441 + end + item + Command = ecSetMarker0 + ShortCut = 24624 + end + item + Command = ecSetMarker1 + ShortCut = 24625 + end + item + Command = ecSetMarker2 + ShortCut = 24626 + end + item + Command = ecSetMarker3 + ShortCut = 24627 + end + item + Command = ecSetMarker4 + ShortCut = 24628 + end + item + Command = ecSetMarker5 + ShortCut = 24629 + end + item + Command = ecSetMarker6 + ShortCut = 24630 + end + item + Command = ecSetMarker7 + ShortCut = 24631 + end + item + Command = ecSetMarker8 + ShortCut = 24632 + end + item + Command = ecSetMarker9 + ShortCut = 24633 + end + item + Command = EcFoldLevel1 + ShortCut = 41009 + end + item + Command = EcFoldLevel2 + ShortCut = 41010 + end + item + Command = EcFoldLevel3 + ShortCut = 41011 + end + item + Command = EcFoldLevel4 + ShortCut = 41012 + end + item + Command = EcFoldLevel5 + ShortCut = 41013 + end + item + Command = EcFoldLevel6 + ShortCut = 41014 + end + item + Command = EcFoldLevel7 + ShortCut = 41015 + end + item + Command = EcFoldLevel8 + ShortCut = 41016 + end + item + Command = EcFoldLevel9 + ShortCut = 41017 + end + item + Command = EcFoldLevel0 + ShortCut = 41008 + end + item + Command = EcFoldCurrent + ShortCut = 41005 + end + item + Command = EcUnFoldCurrent + ShortCut = 41003 + end + item + Command = EcToggleMarkupWord + ShortCut = 32845 + end + item + Command = ecNormalSelect + ShortCut = 24654 + end + item + Command = ecColumnSelect + ShortCut = 24643 + end + item + Command = ecLineSelect + ShortCut = 24652 + end + item + Command = ecTab + ShortCut = 9 + end + item + Command = ecShiftTab + ShortCut = 8201 + end + item + Command = ecMatchBracket + ShortCut = 24642 + end + item + Command = ecColSelUp + ShortCut = 40998 + end + item + Command = ecColSelDown + ShortCut = 41000 + end + item + Command = ecColSelLeft + ShortCut = 40997 + end + item + Command = ecColSelRight + ShortCut = 40999 + end + item + Command = ecColSelPageDown + ShortCut = 40994 + end + item + Command = ecColSelPageBottom + ShortCut = 57378 + end + item + Command = ecColSelPageUp + ShortCut = 40993 + end + item + Command = ecColSelPageTop + ShortCut = 57377 + end + item + Command = ecColSelLineStart + ShortCut = 40996 + end + item + Command = ecColSelLineEnd + ShortCut = 40995 + end + item + Command = ecColSelEditorTop + ShortCut = 57380 + end + item + Command = ecColSelEditorBottom + ShortCut = 57379 + end> + MouseActions = <> + MouseTextActions = <> + MouseSelActions = <> + Options = [eoAutoIndent, eoBracketHighlight, eoGroupUndo, eoSmartTabs, eoTabsToSpaces, eoTrimTrailingSpaces] + VisibleSpecialChars = [vscSpace, vscTabAtLast] + ReadOnly = True + RightEdge = 0 + ScrollBars = ssVertical + SelectedColor.BackPriority = 50 + SelectedColor.ForePriority = 50 + SelectedColor.FramePriority = 50 + SelectedColor.BoldPriority = 50 + SelectedColor.ItalicPriority = 50 + SelectedColor.UnderlinePriority = 50 + SelectedColor.StrikeOutPriority = 50 + BracketHighlightStyle = sbhsBoth + BracketMatchColor.Background = clNone + BracketMatchColor.Foreground = clNone + BracketMatchColor.Style = [fsBold] + FoldedCodeColor.Background = clNone + FoldedCodeColor.Foreground = clGray + FoldedCodeColor.FrameColor = clGray + MouseLinkColor.Background = clNone + MouseLinkColor.Foreground = clBlue + LineHighlightColor.Background = clNone + LineHighlightColor.Foreground = clNone + inline SynLeftGutterPartList1: TSynGutterPartList + object SynGutterMarks1: TSynGutterMarks + Width = 30 + MouseActions = <> + end + object SynGutterLineNumber1: TSynGutterLineNumber + Width = 17 + MouseActions = <> + MarkupInfo.Background = clBtnFace + MarkupInfo.Foreground = clNone + DigitCount = 2 + ShowOnlyLineNumbersMultiplesOf = 1 + ZeroStart = False + LeadingZeros = False + end + object SynGutterChanges1: TSynGutterChanges + Width = 5 + MouseActions = <> + ModifiedColor = 59900 + SavedColor = clGreen + end + object SynGutterSeparator1: TSynGutterSeparator + Width = 3 + MouseActions = <> + MarkupInfo.Background = clWhite + MarkupInfo.Foreground = clGray + end + object SynGutterCodeFolding1: TSynGutterCodeFolding + Width = 13 + MouseActions = <> + MarkupInfo.Background = clNone + MarkupInfo.Foreground = clGray + MouseActionsExpanded = <> + MouseActionsCollapsed = <> + end + end + end + object spltTopBottom: TSplitter + Cursor = crVSplit + Left = 0 + Height = 6 + Top = 385 + Width = 998 + Align = alBottom + AutoSnap = False + ResizeAnchor = akBottom + end + object Panel1: TPanel + Left = 0 + Height = 355 + Top = 30 + Width = 998 + Align = alClient + AutoSize = True + BevelOuter = bvNone + ClientHeight = 355 + ClientWidth = 998 + TabOrder = 4 + object pnlLeft: TPanel + Left = 0 + Height = 355 + Top = 0 + Width = 212 + Align = alLeft + BevelOuter = bvNone + ClientHeight = 355 + ClientWidth = 212 + TabOrder = 0 + object pnlPreview: TPanel + Left = 0 + Height = 100 + Top = 255 + Width = 212 + Align = alBottom + BevelOuter = bvNone + TabOrder = 0 + Visible = False + end + object spltPreview: TSplitter + Cursor = crVSplit + Left = 0 + Height = 6 + Top = 249 + Width = 212 + Align = alBottom + ResizeAnchor = akBottom + Visible = False + end + object ToolBarTree: TToolBar + Left = 0 + Top = 0 + Width = 212 + TabOrder = 2 + end + object DBtree: TLazVirtualStringTree + Left = 0 + Height = 217 + Top = 32 + Width = 212 + Align = alClient + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.MainColumn = -1 + TabOrder = 3 + end + end + object spltDBtree: TSplitter + Left = 212 + Height = 355 + Top = 0 + Width = 6 + end + object Panel2: TPanel + Left = 218 + Height = 355 + Top = 0 + Width = 780 + Align = alClient + BevelOuter = bvNone + ClientHeight = 355 + ClientWidth = 780 + TabOrder = 2 + object pnlFilterVT: TPanel + Left = 0 + Height = 39 + Top = 316 + Width = 780 + Align = alBottom + BevelOuter = bvNone + TabOrder = 0 + end + object PageControlMain: TPageControl + Left = 0 + Height = 316 + Top = 0 + Width = 780 + ActivePage = tabHost + Align = alClient + Images = ImageListIcons8 + TabIndex = 0 + TabOrder = 1 + object tabHost: TTabSheet + Caption = 'Host' + ImageIndex = 1 + end + object tabDatabase: TTabSheet + Caption = 'Database' + end + object tabTable: TTabSheet + Caption = 'Table' + end + object tabData: TTabSheet + Caption = 'Data' + end + object tabQuery: TTabSheet + Caption = 'Query' + end + end + end + end + object MainMenu1: TMainMenu + Images = ImageListIcons8 + Left = 48 + Top = 33 + object MenuItem1: TMenuItem + Caption = 'File' + object MenuItem8: TMenuItem + Action = actExitApplication + end + end + object MenuItem2: TMenuItem + Caption = 'Edit' + end + object MenuItem3: TMenuItem + Caption = 'Search' + end + object MenuItem4: TMenuItem + Caption = 'Query' + end + object MenuItem5: TMenuItem + Caption = 'Tools' + end + object MenuItem6: TMenuItem + Caption = 'Go to' + end + object MenuItem7: TMenuItem + Caption = 'Help' + end + end + object ActionList1: TActionList + Images = ImageListIcons8 + Left = 48 + Top = 120 + object actSessionManager: TAction + Category = 'File' + Caption = 'Session manager' + Hint = 'Display session manager' + ImageIndex = 3 + OnExecute = actSessionManagerExecute + end + object actExitApplication: TAction + Category = 'File' + Caption = 'E&xit' + Hint = 'Exit|Exit application' + ImageIndex = 2 + OnExecute = actExitApplicationExecute + end + object actGotoDbTree: TAction + Category = 'Various' + Caption = 'Database tree' + OnExecute = actGotoDbTreeExecute + ShortCut = 16452 + end + end + object ImageListIcons8: TImageList + Left = 50 + Top = 209 + Bitmap = { + 4C7A0400000010000000100000007C0400000000000078DAC5546D4C535718AE + 09BFFCED7EB022529C20CE820A5591825459290502945A2AB4A032C9C63EE250 + 6CEBC06C88E0BC44C95C6024A8CB5C80586D635089F3839AB8B84FCDB2641831 + 314B9625339898B5B80552DE9DF7B607EE477BEF9565DB499EA4F73DEFF39CF7 + B3168B45A5D56AE7915390BBD4CC34D63A7C5D671A6F9F0A201CBEEEB325CC9E + DAECADB94BB9BE9628971E8D2DAF6AABF7E0AFDB46DB20160A7DEEDF343579D5 + D49FEAE0497FDB7C88F8CCC5E37281BEAA250B7C4DCD962AA5DC28E656D8B758 + 68BE3466F358075CFCE51BB8FBF411049EFC2CA951E8F7FC8EF5C05A71EDFD0F + AEC1D7847FFBC904CF7FDFDDD3F0C9C418CF56723C5267FA5D7DFD18797B127A + 7EBA04C38FEFF07CBB7EBCC8EADA6FF6CCDB9CBE6EB647F4DBF5EDE7AC4FD597 + DD60BAFA218F8F36CC0B7DA88D70C7B97CF777E7587EC5B52E51BE68433EFA70 + F9381BF4DB768361F9877F1816F1D1867775B74EF0E217D66FF0E14DB833F510 + DA897FD9D811166DDF0FC157C47676729CA769EE68646712E78ADA30EFCF1E05 + D8B7B09608FC8DB6127E4DA6B20B22F38C33298CD739DE4B621862514F7E0BEF + 53EC7956FEFC96BEC8FC7AB8F3CB9E25ECFE5870AE24B853A9B6FC1DE84BF7C7 + 22D85F7626495D9C91FDC5FE8EE36FB65605E2FD058079CC4E786BFE18290D3C + 1B8E0DBC9B7DE0DDC9E5703173EFD303CCEB59B0B34C2782FEE372F8A8310B88 + 8F4B8A7FD99D017D6F6A4538E9C9865157862CDFBB7F0D1CDB9325427BDB6638 + DFF2AA2CBFB729137657E48860624AE0C4DE4C59FEFDCE34B8D5B63A26EE913B + 397EE7AE755051BC4984B58356E8685827CB9F3CFE0ADC3F9A161378B7D8F7D7 + 9FAC50F4FE554F060CBCA515E1947B3D5C71CBF72FD8A70129FC97FCD0E92C98 + 1E2A5A34FFAFEBFB6076E20284FA5317F7FE401A84CE6C50FC3EEEEFF3F3E680 + 1484FBDBDCDCAC2AAB3CBACAE6F01BF4FA7C955EAF9741BECA56EB3720877273 + 0C4F1F6FDC1E0AA9533D2695CC494AF114A32F72906BADF31B74E49BD880609A + DC1B25B846F489FA8668CC89445347EDDB82A1581A2C97DCD17730569A2F9EC4 + 14B751C7B9C7380531B3FABAED41CC93D5A735A187D5E0C4873C9A2FE7DDF9D8 + 84FC8806DF9F9BAF5AB310533CBE30DE58F9BC281F734A54C84F8A133FF658A8 + 21E40BFB2BAC5F240EF76BB1F8C2FEC6ED1FF1A11A749E79F92A9C9F97492FE8 + 2E6C5438BF6A417E3B1CFEC252CEFEC4EA914883CC2D777F70075103E350BCBF + 8E85FDFD3F4E4242C2A2B9F5F6F216A6D3CD28D53015E5553247F65FF8C0D33C + B8B7A1FA7DDF17BD61D490E3AD5D9D6CA8B31A0F12FF190288228C1A72DC64F5 + B2A426A771A4BDC51E3E37D0C9E503C621F9FF98B86CB9E79DEA6796D2CDAE37 + 1A8A470F0B34482E5E29BED9985FD9C71C081E7AD71A261AAD44E3324763C654 + A4AF8CC75D93BE5247F3EDEF69FD9368CC59CCB9A8318AB9603DA4DEDE949359 + C5CD35AA11261AAEA67AE388366385418ABF52B33C9DF0A6B91A7D4C6B10EB91 + AC7E2949AEEE4E7BF97BD82382E751FE0CD6036BAA80DB825CD4C0383017AC87 + D279C699543257FFC64EFC93F33731D97C4E + } + BitmapAdv = { + 4C69010000004C7A040000006400000064000000BE2E00000000000078DAED9D + 075454471780E91D0489898205A5837416588AC08262C10A1A8DE68FD12836EC + 1D2CB1A6A8680CD895A231162C88628905C4168DDDD84B127B3489021AA3C9FC + F7BE7D0B88ECB2C07BDB9839E79E3511D9DDF7BDF9A6DD99F7ECD933AD828202 + 958DE397CE68171E3BA275EEE96DFDF34FEF58403484B083708070867083F060 + A325840B8423440B882610D6E79EDE313E79ED82CE9907377555F9BB9E3E7D9A + 79559962AEA5A5D7DA48C7DADFDEAABE9FBD93B59F83D07158BB0E1F883C5AB7 + CA9DDC33323779AC6847D222888D913B9277411C88CC493E0E71868DD3A21DC9 + 05913B92F6C2DF6D879F4B87D759113BA60C6C99F461C790CCB171F07B2321BC + 211A5B04D99A6805AACED7F7F5F5552E0F6708132D2D9D787D9DF75BB9D9BCDF + C72DD8EE5A684F516EF274B8A65BE0DA5E83EBF912A208FE4C6A13F03B5EC1EB + 7FF0FA047EF791881D494B030F0C4E7C7FAF5BBBF7C3DCDC2D626CCCB57CE1F3 + 74AA7B3C8C3FB0D4B58DF1B1B599E7D3DAA6978FB0D9F590BE91B949DFC2B5FA + 09A2A4B6D7BE1AF12FBCDF7D78CDF12BEC3BC926DDA79DCD199FEE36313E5E0D + C2DD8D359D87617D73DD6671423BB7D19D7B47E5242D039F5C802880EBF19702 + 19488B57506FAE423C843FEF0A593F6672D338612B70A599A6F2D0D6D3D5327C + CFC2C836C6B769F4F6A45EC0629728276905BC3E50360FAC979139498720AEC0 + 9FE704AE19E10D9FB59E81A5A9AEA6F1D0D6D5414719BE1FE26A17B523F97FF0 + 7D0BE13E7CA3027542069FA43FC1A16982D40101461F585A01171D75E6616066 + CC7030B77D4FD7DACFDE263A27E943F89E4781C57FAACCA1927AF307D4DF34EF + 39BD7D4D6DADCD0CEB996A9935ACAF563CF4CD8DF5DC3F6DD3F83D5F07CBCED9 + 5343E17B6541FCA34E1CDE6DF793AEC66C4B1EEE3F3ACEAEDDAA316EA64D1B98 + A83A0F7D537DADFA2E1F98D8F71585419F35136232DC5BF7D59843C5288631D0 + 3678BD189235B29FA5ABAD8D65734B95E4A1676AA46DDFDDBF4187AD833F867B + E944A4D8C1FF69100B89BF24AFC5D1391396B45EDAC3CBC2A5B1BE2AF10016BA + 763DC31CA02ECC80CF7A57D318C8887F804B7EE08AC44E961ECDCC5481879EA9 + A15EF3DEE19EF0D9A0DF9AFCB20EB1286D5B701E2170D99001563E2DEA2B9387 + 9E89A1BE435F9110BCB451CDDBEBDA06CEC3DC09481B34CEDADFA191B27868EB + 686B433D7D1FC65013C1552FEB300F9C7739ED35B34F04F42D0D14CD03EB05C3 + C2BD6943185FCF80FAF1BA0EB328574792CE7A26756F8F4C606C6FA2081EC042 + CFE1535130D60BA813B335B10F55CBFED74F6E63BBC484648E4C306A6869CC27 + 0FEC4761DB0D7EDA00318ED68B4A79FC07D7E607B8368F43D247F43269F29E11 + 1F3C707C817DDA88DCE495F09EAFE1FD5ED1EB2F95C96BB68DFF2D387D789C99 + 7D433D2E79E0B8DB215ED0409433E573788F17F49A57ABDF7545B83A31D8DAC9 + 9A331E380782E3EE3A36D6E36C5D253A67E2EEF0AF3AB5E08207CE0DE27C1470 + 3E41AF6D8DE3B97055E2226B81A3556D78E89B1B6A390F086F8C738391F49AD6 + B64DB917B87A703FCB483BED9AF2D0D6D5D6B2F66B6129CA9D3259DDD62D5490 + C735BFF99F06EB591AD5B87E9836B6D26DB373546875E7CC5BEF9C4A3AED9E4D + 3AE4CD24DDF67EC14974DD3B97C4EE9EA9CE4CFE6EB567C246C705EDCD6BC203 + D7F6705D0F586455F7BD7BEE9F47965CD943669EDD44F63C3847F21FFF5CEBD8 + FFF02249BD9CA7EEF5E4379F391FF733B032D3AD2E0F5CEFC635D69A8E333E39 + B488B4DF35837C797E2B3908D7F3F8D31BB58AC22757C9F2AB7B35612E787FCB + B1DDECE5E5813939980782B907B8DE5DDBCFD03E6F06997B7E0B39F0E812E521 + 8EC7DE337B4F366E68A567EED0C8A02A1E981F8539396C1E08276D38B62373CE + 65931FC0399407133F380FE9E01C923E3244160FCC1BC45C35CC8FC29C1C2E3F + 436CDE2C32EBEC66B2EFE1853ACF03AEED03AF19BD46857E377A9DB5BFBDA134 + 1E98C389798398ABC6477E54C7DDB3C8DC735B48C1EF57549A4774EE1412B7EF + 0BD2FD87AFF89C9BDF06F12078F5B0E04A79386B69613E2DFCEC05CC97E4E373 + B4DDF53999F863568DDA7745F040AF46E74E65FA2269977793C59777916EC085 + A73A72135E5F08370D4BD3EA57090F13E0D1CB4788F9FAEC5A382FF75DC2E125 + 64EF83F32AC9035948EAF1A4935924F9A7EF489B9DD3F8E271165E8B8419C392 + B41ABDCB0373FE31CF5C9CDBCC4F3E6DF77D5F91E5D77E50C9F60359F4857AD1 + 79CF1C706A3639F6F43AD9FBF03C19797C7529278E79E01E8A37C17B871F37BC + 686E509107EEBFC09C7FBEBE2FF67BA79FFE1EBEA7EAF5AF703EA15FFE629275 + 339FA45CDCF1D6FB6EBF7B8AFC0F38F1D9FF0D5C36ACD55B3C60048F7B61A07D + 39C5D7BD37F0701AF4772FA85C7F177DF459C1B764DDADC395BEEF9127D7C8AA + EB074847E81FF2C4A344983E6411B6DF121EB847CCEE5A582F114F6B4D38F7B4 + 06BE93AA8D079105DE271BEE1C95F9DEFBA0BD4B3AB58E69FFF818B387EC1D7E + DAECD80786121EB85F0FF788F1C102BFF3C863AB98FBACAA6B8E3F73F0D1CF0A + E3D165CF5CB2F4CADE2A3F173A76FDED42D283BFFEEFBD80D4413E121EB87792 + DDAFC7D97B44B1F7127EE7F5B78FC871FF5F23DF8133BEBEB0BDD231231F3CB0 + FF3DFEC70C78BFAAFB7B38B7300DDA3FAC23D8DE70CCE38FC0D484A1A5F5C3CF + 1EFBB9D7B87C0F9C6F6F0DEDC690C26555D60DECCB6CFBED24F934FF1BA6AF89 + E3F88A7D62BEDA0FFC9C38E759D51815EBC89A1B07613C32977C74603EE773F1 + 81A983D6218F1397CE683B0DE9D02192E3DCDB0105A930BE9A41965CD95DE5BD + 77E8F165E6DE0367965E23C95CBD22FA57BD0F2C20DF818FAAFA9CB9F77E2223 + 8EAD2473CE6DE67CBC1E9A35EA54EC984FF470AF7D4391676BF0551197EFF1BF + 830B493BF0C15770EF55F53D0FFF7E957C0B636111EB38F138651FE33045F0E8 + 5FB018AEF5E92A3FE7965F4F40FB9F4A269ECCE4BC4D0F5A36A45018D54AFBDC + 933BFA11DBA7F6E2FA3B8E39B186195B6D070F49FB7E47C153F89A77FF2CE955 + C1013DF7CF272BAFEF6798A04BF8E4818EFCEAFC36E6F3C8722BAE197C7E7A03 + C9B871A8B47DE4AEBD4DBE3AB47069BD734F6F5B44E4248DE7F277C7EC9ACECC + AF631D39CE5EF3CA62D7FD33A410EAC66229EB7EBD0FA490D5E06C6CE3F73FBA + C8EBF81CFBBD3BC047DFDF91DDF74803FFE2B8BDF39ED95C7F863B0905A9DE78 + 1E08B41D8BB89D17F9922C836B37E5A7EF647EB7D53026C1EB3C001C20D57BEC + 3AE36CE0BBE8522E6F3C708CF4CDCFBB98FE96ACCFBCF65601F4C92F91614796 + 73FD19EE271C4EEB8C67B388C4FB3738FBDD380FF43DF47171BD5BD658031D91 + 73F71489D939BDEA3A073F83731A7CCEB14F3EB996B9970E3DBA2CF573633F10 + FD89F707C79FE1494241DA503C272792E3F9F541854BC94E681F658D7BB13F3B + E1C74C26EF4155D689861E59C6B425EB65F4B5F6C0E7C6366D29F7EEFC03784C + C2338B80C7412E7FF708188F63DBB7BB5C7FB5B2FB6C3070FBFCCC4695E1D1F7 + D037CCBCE7A29F774AFDDCF9D0373FFAE43A53FF397EFF67030B5267E2F951F0 + E7E35CFEEED1C7D7401FF68ACC7527AC3BF8FD471F5FAD323C7A419FAE2DF445 + 66C03D22CBB3C7D8FB89E3F72F4AC84F5D8067788972924E73F9BBC79D48AFB2 + EF8873281F1F4C21894757A80C8F1E3F7CCDF40D65F5438EB1FD45F431D77BDB + 81472A6F3C80058E19A47DAFEF591EC35588C78772F0908C9970ACCE1B0F8ED7 + 3DC69FC860EEA3631A5C3F76F1533F16030F5711C7B93D6398F6E32A3924A3FD + D878E718E99BFF0D338E57151E384F8873BEB3CE6E92B90E834CB6FEFA23E77B + 12603CF805F07082FED53E4EFB57475792FD0F2F91BC7B6765F6AF8640FF7286 + 0AF5AF707E19FB578B615C286BEE13FB57EB6F1572FDFE7F417F772A9EC3293E + FB91CBF1C712667EEE7B19EB1E38FE9878328B8F7E7C8D63D8D1E5CCF8E37B19 + E3A63DF7CF317564C965CEC74D4F81C7183C1315DAF3742E7FF727ECF8FC5B19 + F719F6BDE65DD84E76DCFD89990756360B5C63C2FC1ECCCDCF7F2C7D2D043D55 + 00756426F7F5FA11F0F804CFA78DCC499AC9E5EF8EDFF725590AE36E9C7F9035 + 17947EE310336E1C7C78A9D279E01E139CDFA9EA33630E0A7EE6214738FFCCBF + 0D2A480DC7B38223B6272770BB0E3A9D59E3C3F95D9CBF95F6DD764BEAFE95BD + 707F4E531A0B9C3BC7399E5CA8ABB21C8B7D5D9C73C479E98EBB399FDFBD31F8 + 705A333CB719CF0A66CFA7E5ECF7630E03AEF36DFAE578957D476C4BFA177CAB + 341E9DF6CC66DC899FE7A88C3E3AE62B259FFA8EC9E9E37A7DB0D5FAB167E2E6 + 0C33C033B4F1DC6611C7FB0371AEB0CB9E394C1DA86A6C85F71BCE772B8B07D6 + E7A93FADAF720C8B735758EFD7733F774522B74DFE7960EE7C13717E8943249E + DBCC47DFB162BE5F6581F3D75F5DD8CAE43F28C355D8FFA82A074BD24747AF4D + 01761C7F8ED781A9837E28977FE5CDC55EA8CA72C571AD49D63D57368F7D8E71 + 56143F396732F24B66912FCF6F912307EB3AB37E8C6E8BE73E0FAB283035E1CB + D2FC2B7FFBC691B9494BF85A9BCE843E4955DF17C7581B6E1FE573CF45A5F957 + 634FA433EB7D557D3E6CE3269F5ACB5F0E6F6A4267098F7AC2C626C2834313D9 + FD861CF7EBA7317354F2ECC1C1399695D7F633F9257CD7136C33128FAE247932 + DAB7F2ED1CDE53717BF9D90B12B165E24DF7B15D6C4BF3A903B5B4F09C7FF66C + 795E72CE565CDB27579E2EAE9BAC80FE0BE644F1B1F70239E33E769C63DB79EF + 8C5C9F095D3AF1C74CBEEE8D7F84CB87E6BDB3DF20CCCD1DCFF9E72BBF1DD7BE + E5FDFED8DE60BE39D62BC6D730BEAC6D7D8985F60CEB2A72C6F9427973EDB1CE + 624E09E6F6F1C4E3AFA015438756E46111636BEE57F8E924F139FFDC3FF301E7 + 44B0EF2EEFBEE7636C3FF8AB0BDB985C95E1C75632F9CCD5A933E2BA308BB917 + 66433F15FBE038BE3E2A2307E99D360DFA5D9FF0B3FF03CFFFFC2F7CD784EBF6 + B95176EFEC57F3D5D2B249F7690F2CAEE299B27CDC0B381EC1FE6F75F6734AD6 + 4799FC2BF0188E13705EB8CFC114C6E778BDB15F2D09CCC1C3752564804EFA1A + 786E863129D6B9EABC2FF6A7706E0DC7B53CD58B5FF07CDCE0AD89E95AD32AD9 + 3FD809789CF5E90E2C1E45729C5B5D7EBD07F3978EC9797F32EEFA5DBCDE8039 + 8C38378F6B14C800EB1BD6151CB360AE8E38A6324EC235256483634C6487FD54 + 6471B09A6712605DC67A25DAC14BDFE2298E3B827727EED52AAC7CBF333E1746 + 247E2ED31CBE729C305716C75535DDB77618C6C8B82F0173D2C79DC860C667FD + A12E60E03E27EC33611D4ABDBC9BE4DE3D2D333FB2AA312AEEB1952737AC8671 + 04E2CFE055899F49DB7F8ECFE8C1E7C2E0B348F0F9177CCD6B271E59CEE40354 + 355FA4E890D45B64B10AEA14F60178DA5BFB2AECFBB1A911DB265FF4FDA28FB5 + ACF3329A7613B6C2E7C2C0BF59C257DF1F3D8379FB584FB01F75F8F7AB4A6781 + 6D3CAEA1E1FE2CCCD14327F238FEB9E83CA45DC7E0358963AB3ABFE483484F73 + 7D4B535DFF450981A21D494FF95CFF41B7E37E7B9C6FDF5F8BB34D6A7D7610DC + 0FD8E68F81B1FA97D0FEB7E5777DEC55AB75A3D3EDE284F5BCA7F4785FDEF396 + F0193DF85C183EC6ECA5C18E29DA41DB8B7374585F145957D04F380EC1F1673F + 9CEFC7CFC3F3BC0078E7B2DBB8AEDDAA7BFE153E2F099FD183CF8551C87A29BB + 1FFFDBCB794C3B2CCF1C64CD3988FB4E98A78B6D3F0F7B07A4CE1B86AC1D95D6 + B89BD0AC46E7F5D95A9BE1337A30374851737C5857705C8E5C703F12FA1CF75B + 1CAB613FE9EDBCDB6BCC1813C784384667F601E62A6C2EF94DC4CEC9C7DD6675 + 15D4F4FC447C76153E2F099FD1A3E8F34571FC807B10316F00E755313702C72E + 393046C37BBBAA7E19CE83E1BC13AE4FAE041FCD8171048E45718C88E3200572 + 9078EA5150D6B0910DE2DD6A7CBE283E470C9F5D85FD0165ACA14AE637965CDD + 4376C37810C773D81795672F3BD627741ED60B6C23D04D38DE9E7F713BF9F4D0 + 37BCB71395B92A6CC7D8C576D323746A731E323E470C9F5DC5C533646BDAAE44 + C1F818D75186C2B805E7B370EE7BC7DD53CC9A04EE552F1FF8FF901DF697B0DF + 8AE72AF43990C2F4B1DB2A2FAFE8DFF02D938EBB8D8F73E2E2BC704B375B9BA8 + 9C096922157A064E343B6F1E0FFD65CC99C2C079AB2E7BE7306B1BAA74863BF4 + 536F07CCFF5F77AECE6FC767BAB55EDADD0BFA5AF9BCF67F3533FE146D1E333B + 6854903697CF9B3077B5D50F5835A43378EB3A9B8B42B9C8AC13CCEB8B88EC89 + 1B5A8EEF62C1C7F3582C3D9A99072E1D92004C6E47E6249F12D133C4A59E5709 + F17778F6C41CB7B15D9AF0F9BCA2FA3E2DEA07A4268CF39EF15104F8EB1CBDFE + EFB078225C39ECCBF0EC09792E89B12E8A789E97B5BF838D9EB9B18147528F58 + 78FF93F4ACFD5216BF038B458DA23CED9C06B6F151F4F3EEF03962EE63BBB481 + CFF1038E3FEB727B818E12AE4AFCA251B4979DB29E3F88CF740BCD1CF1193EBB + AAAEB7256C7B91E79410E3ADCCE7A51A35B4320ECE1885E7D1DCADC37DAE17E1 + 5B26E6B88CE8E8AC0ACF13C667BA05678CEC8273C9A2BAF5DC5474C29FC062A3 + EBB8CECD54E979DBF84C37E1EAC41018C7EFC1BD897580C5BF5139C9B7DBAE9F + 34CB6D623C270F41E7FA79F4F84C377C8E9870D5B045F8BC24364FE56F0D6280 + 7D9647383718B175D289902FFB778F8F8FD7E6EAFA71CD4352DEF377B00A593E + B49FE0EBBEC1ADB74FC1B3837ED380B6A5283237F97848E68851E1DB27A67A8C + EFE6C2F575E38B07F3AC8400176D037313ADE049BD2C7CE6F4E907DF673FE671 + AB2107CCD7BC82EB7A1E9FF71434EAE4AFED3CB1B30E1FD78C4F1E6FADFD5A99 + E9E2337A604C3F292A2709F7BA3F50F5FE31BB7FEF22E61EB88DEB1A276D8D55 + 1D79943EEFA5A1A59ECBE0764E5E333E1A15919BBC0DBEEF4DC939FF2AC0E01F + 368713736A8E607E14E6E4601E88A2AE8FA27958D83732085D9D181CBA6EF4BA + 48711D79C1B278A3227D573CF3169F05FC27E6AA617E54C59C1C4DE2513A27E9 + EF6014943E2244B829314D98919814B277C471B66D295142BB8FF5E22FCC33C7 + DC66CCA7C51CCEF279839ACEA3B4E073611A6969E1F32F82970F89102E1FBA28 + 387DC4193CCF9C59C711F795B95A6B91B457AFD93AF918F725E15E18DC7FC1E4 + FC639E79A1F22E87D2795436AE6CFE816140EA20DFC0B4418978867668D6C853 + 7856B02897C903BB2D12EFE1C2BDC07FE01977ECB52D2E17CF58964FD9B1C26F + A2DCE41B61EBC79C8EDC3EE9E780B484BDB87712F7EBE11E3155FAEEC8E3F4E9 + D3CCABAA46FBB17DF482A2C2B4071F5F5C6F507E9AE7C082D4CE780E279EFD08 + 3133213F6DC1C0FCB4343652E1BFE74224E1D92C107D130EA7450C2A4C6DDAF5 + 8BC106FD77CF3551E5EFDABB776F2D4208E7F1DFCB3FCCDEDC3BEE0AE1F2EFBD + E36E1A198FCE3AF071EDF888D7B7768714A5DA1D84F8A128ADF9514D8C927591 + 1BD485C79B5BBB3B028B971045F0D9892606F0B84679501E948766F27896DA9C + 3C5AD4823C58A85EF110E2C9372D348EC7DD147BB276A43B491DE4A956B174B0 + 07C99BE8A2713CAE7EE94086C6FB91CE31812A17B19D84A4ED87A124B6A3F09D + BF8B6F1740BEEEEF4579F01C1DDB07914E6D03814318F14CED4A1CB23F22FE73 + 3B920E5D83290F2544CC476124365648FCBEE848F45E8F23BA643CA9F7CB5012 + 323186F25042B48B0B61EA48F0C4B6C4E0EFB10C8FFAD7069388A15194871242 + 34209274E81C4C5C337A302C304C7F1F417C1774A63C9410D87E77EC104482A6 + B523264F4712C3E2D1A4C185041236BA35E5A1E4BE9560562C71C9FA907117B6 + F17581C7F5AF1CC8989EBEA4576C805AC5C79D0464D1404F8DE3711FC6B95BC6 + B9918CE12DD52AB246B42407A738D3F92B3A7F4579501E9407E54179403C5DDC + 829C9BE3484ECE7052AB3835D389E9ABD3F1876A041D0F2A783C182B246163DA + 9080991D48C49028D2A91DE5A1CCC0F178FBB810D2B667E83B73ED9487E2D73F + 5A7F1C4E9A1CEC4BEAFD3A8C386DE845DAC587501E4A88E8BEE1CCDC95E7926E + A5F3BBE60F8613C1EC58CA43293C22C43CD2BA11BDD7E2F50F8B7B89246016E5 + A1145F75607DF5BF56A4C9A1BEA4C1C504E2B4B12769D72394F250761FABA390 + C4F40E6318D595F6FC97F9F66451822799F2B1B75AC5E79F7893EF47B96BE4FA + C7B85EBEA47747815A45DFCEFE647182E6AD7F608E1FCE3D144E7756AB380271 + 69AE239D4FA4F38994471DE2F1D7B7E236FDE6D70E6A15B720EEA5685E3EF5AF + 0BECC9B2211E64EEA7DE6A155F415F77CB58373AFE50F07C6274BF083A9FA842 + 738B3877D2A95D10E5A1C47A81AF98331A322186787EDB95B41A11FDCE189DF2 + 50503E7577365F34B91DD17F259E4FB4BA3184840F8FA63C9410519F89F3A9DD + 56772F9D6F377B3C9CF8CDEB447928A37EC48730F5035D65796B2893DB6E73B4 + 1FDD6FA0ECB63C56C830F149E9C2B8AAAEE453AB6C3E436721F19DDF99D86FEF + 4D02A7B7AF333CAE7DE54086F7F02371F0FDD4297A760820F33FD3BCF9DD5FE7 + DB9325303E9F0D635E758A2FA06E646BE0F89CCE27521E9407E5A12E3C1E2E6A + 41F64E7661F648A9536C8338365DF3F647FD952A3EC304D740D42DF04C193AFE + A0F9ED7572FDA35D10737646F4A711A46D8F503A3E57620E1C5EFBA8FE91C4E6 + 587F2657D47E5B6F12D32B8CF25046FEEEA7E2FC5D8F657165F3BB0F8713FFB9 + 347F5719D1A64F2BA68EF8CEEB440C5E8E21BAFF8D279677861261723BCA4319 + ED06BBFF23A667287159D783D8EDFE98782DEE4ADA77A3FB3F9499DF1ED52F82 + 585F1EC4AC7F34DDFF096D3F54203A741692D69F86337B09EB4A7FF7C6D70E24 + B98F0FF9ACABBF5AC5A0383FE64C4B4DDD7FFEE30C27B58A931ABAFF9CCE2752 + 1E9407E54179501E9407E54179501E9407E54179501E9407E54179501E9407E5 + 4179501E9407E54179501E9407E5519B285ED282142F7723251941A4385D404A + B24299285EED478A973A521E0AE4C1B058E34F5EEE194AFE399F495E9D5E4A5E + 5FCF25AFAFE5905727169017D95D48F13267CA43513C56B4242FF78D20AF6FE4 + 91D7B7F6BD13FF9CCF202F3675A43C14C403BDF4FAD2FA4A593071338FFC5D30 + 95A923C52BDC280FBE796408C93FE7564BE7716317F9FBE044F09A3DB4250E94 + 07DF3CBE8B82EBBE573A0F8857C7E791E2555EA418DA7BCA833F1ED896BF58DF + 1A9CB45B0E1E3EA4243398F2E0DD5741E49FB3ABA4F3B8BE93FC7D6002E3AAE2 + 654E9407DFFDABE5AEE4E58EBEE49F9F378ABD7573CF5B6DC7AB1F53C069D1B4 + 7FA5C8F120F4795FECF81F78E96BF2EAC86CF2EA542AC462F2777E3229019F15 + 2DA1E34145CF9730E3C2951E4CBF16FB5C251981BCF889F29097873D2981713A + 8E314AD6B7611C852EA33CE87C22E54179501E9407E54179501E9407E5516778 + B40316BF433C80CF5EA489013CCEAA0D8FBB475D4B36769853B2A1C3CC171B3B + 7CAD89F1326FC0783EAEDDE3C78FB576EEDC5965EC3F704977F7EE43DA474FBC + 3138987F43E7F0B1677AF2FCBBBA18FBF69DD4CECBDBAF75F4D86BFD8385F7F5 + 0A8E171BC8F3EFF2F3F399D7AA8AA151335D17AFCDC2660EB36D03A38A47BAF9 + EF6EE51B7EEB23EB0FBA1A68D1F256D1D3B3D676705EEAD8ACD9D4FA4111CF07 + BB079FEAE61D797FA0B5EDC7C655FD5B575757B978E8E89868377598696B69DD + C64C185D1C60EFBEB4B177D8055703A3C63A94C0DB455BDB40AB51A30196F5EA + 85190A5B3DF772F4DFE9EC1971D3C7C0D84EB7B63CB05E200B5BBBF1502F4ABE + 098A2A49081015FF1A105DB45C105574B465D06181B1A9938EB955B05E5DE7A0 + AFDF405B5BDB50AB61A3FE9641E1CFC7018B1E82A8E29B82E8E25DF07AD123EC + B2C8D4DC5BDFC2AA95414D7894396A16B2580C1C8A21FE08882A26F0FB8BE1F5 + 3530392C76D7ED5EF5EBB0BB1847392D756CDA2C191D3505AECF53880778AD20 + 5E41FC1B1055F2B357D04FDD04E1F707BEDFA87277C9E251DE51502F06322C44 + C577591E4FC5EF53B4C1BE25E32E1703235B9DBAEDA881E0A850C3E056CF3AC0 + F5F915E21ACBE305C41BE071D8CD77978B7FD82D5FBCD7E5E55189A390C513F6 + 77578C17E0AE156277150A8CD05D9642BDBAE7A87EE51DF5AB946BF51AAE671E + 70B9E01B72258A71976598812C1E124761BD4016E51D252D2A77571783BAE1A8 + 25E0A8242B7054720547498B8AEE1AD0A0511F63693CB05E607B5199A364F060 + DC2560DCB5CCD63BEC629D7017E3289B044B8B3247FD56CE5144AA4F5877B9FB + E6A1BB7CCABB4BC2A382A31657E1285295BB3C4ADD15A4A7B18E6A58EAA8EE32 + 1C45E4739717B82BD40079E0B8BBBA8EAAC25D6FD05DEE7E7BC27C5BDDEEF9DE + 7B5DF43587C57BACA32657C751B2DD252A75D767E1A2D9C6380782E36ED65109 + F2384A0E776DB46FB9DCD607DD6560ABAD798E0AA98EA364BB4B04EEF2DBCDB8 + CBDBB7ADEE91136F0CE0FA8F0814150BE0F5971AFEEE77DE2B30B2684580A8E8 + 8897EF113F6363471D0B8B205D0D72547C0D1C25B59E044615AF866B9FDFABFF + 8BF7F61FBAA1E3E8B33BB4A9CB121BBFC8E7CBE0EF8B6AD0764875173039DCD2 + 6B4FA87FF0ED1ED6D69DF5D5D6514D27A1A3926AE9A8777C05BFEBB257C8F95E + 7E91F78747B55F6E947FE499AE67C8AD9E6E81E79D05A2A2426C6BD89FAD2D0F + F19831B268A393F30A1BFF808B4E060636DAEAE9A8419616169C38AA7CFCCB5E + A7277E910F6708447FAEE9DAFB9219F6AF2C1B74D5D737B4D576F63BEC0F4C0A + FC238BD6C3CF96F0E52E73F3405DF571D4A77C380AEBC5158887C06256138764 + 63078F55A6EF8C074D9C58772DB5F1E7D75DDD55D95D124735693AB1BCA3EE73 + ECA88FC051236C9A8F3292361E34AD17CC97BBB0FFFC0FB86B9393F34A70D725 + 95765799A382F974D4E7E0A87417DF4D66B2E6AFEA35E82271971FEBAEEFD9BE + 19C7EE3AEA2B765780AE0A3B2A0EAEDD2F1C3BEA51A9A33C579BCA3DDF5EEAAE + 654CBF0B9DC3B6D1DCB9CB5BE2AE4EFA2AE228A7264D27A0A326F3E528FFC8FB + 236D9A8F36AAEE7CBB693D21BAEB43B7C00B4EACBBDE70EFAE55E82E47557017 + 3ACAC666B0C451B1ACA3AEF2EDA8EAAC0F96BACBBFD0CF1FEE67880D1CBB6B25 + BACBBBD45D025D6539EA83324775E3D3518E151C551D1E15DC15D6D465B98D9F + E8F90ABEDC2508BE1D6F6DDD515FB18E4A736AD2643CCF8E7A30CAA6F918A3DA + AE9F97BACB2248D703DD1574C109EAC8111EDCB5D9C96535EBAE46DA8A75D410 + BE1D355D96A36AC243ECAECE15DDB5911F771DF33136760077F9EB2ACE51CFF8 + 72D46CB1A3D698CAF3B9AAC3A3D45DE079A6DFE5FA96BBFEE0D65D7BD15D717C + B84BE2A8C64DC659018B49780FF3E4A8D1B67238AAB63C4C2D02D15D3DDC822E + 9677D73F5CBACB9971D7CFBCB88B7194ED5045382AC3D9A76A47D59607E3AEF7 + D05D36E5DDB5894377BD2C75971F77EEAAE0A8F1E0A8AE3C38EA7199A3D2CDAA + FB196BCAA3A2BB9AB9AE5080BB62F56BEFA8B17C39EA0AEBA831B6CDC71AD5F4 + 73D6968789D85DDD797457B6B3CB1A7497436DDC55E628A101EBA8BB5C3BCA3F + F2E1B49A388A4B1E627775D2D73740771DF1E5C95DABC4EE3ACEB8CBCCCC4FB7 + FA8EEACBBBA31AA3A3BC32CC6A732DB9E0F1B6BBF680BB56A2BB56F2E4AE1070 + 573779DC55E6A831E8A889ACA3EE71ECA8DE8CA35A8C33E2E21A72C9C3C42240 + E22E478EDDF56799BBD2E57697D851C3248EEAC8AFA3369AA91A0F29EEDACC93 + BBBC8D8CECC15DBEBA7238AA0B7F8E4A0247659A7175FDB8E651E62E07D65DAB + F8725721EBAEAEF5EB77D07FC7518D475BF2ECA8B15C394A113C4C2C04E0AEDB + F16E4197F872D71667970C70D765705743EDB71D95C8B7A3A682A332B9729422 + 7888DDD511DCD548DBC5FFA84F3977BDE4D05DABC5EE3AE18DB95D188A729493 + 5796191FD78C4F1EEFB8CB6D356FEE12B67ADE078367478DB36D31DE88CF6BA5 + 081E26E6FEE8AE383EDD1512F6CC15031CD549DD1CA5681E52DC95CDA5BB0244 + 4CEEC735666F23478E82DF75055E1FFB8783A3ECF973943278BCEBAE35E8AE55 + ACBBFEE4E81A12AE1C852C7C02CF7F24087B30AE4993F1868ABA3E8AE66162EE + 2771970397EEE230FE655F9F08C21E260B22FECC7073DB60AAA93CC4EE8AD5D7 + 63DC75CC07E74070DCCDA1BBB870D4EFC06276D3A64946AEAE6B4D14796D94C1 + 4352706E10C774380782E36E25BAABA2A3C6376932C15019D744993C709E16E7 + 06713E2A40B9EEAAE8A84C453A4A557860C1795A9C1BC4F9281C4760DF55C1EE + AAE0A8C9E0A875A6CABA1ECAE62129383728765706BA6BB502DC55D1511394E5 + 2855E481F3B4383788F3510A725779472529D351AAC8030BCED3E2DC20CE47F1 + EC2EA65E08C42C94EE2855E52129382F88735138FFC18EBB39E5011C5E08229F + CF13888AF6B6F43964A64ADF5DE57944F1C32320E2F97CE4E1E94D79482BB896 + 84EB17EC9CF9449C1BE4703EAA7CFCED2F7A9E013C8EB9087EF434306AAE6364 + E6A14B799467D18059D7C3B5245CBF60E7CCEFF2D59E4BE6EAFDA19D72F2FD21 + D823E476AC79FD183DCA43B2AE67A8856BACB8AEC7AE25DDE368CE5C1A8FBFB0 + FF063CB6376FF99D8D9BF0720B3D830FB4EB3A8F4A1CD591C3753DB9DCE5277A + 9E8E739B2E01273D187799B6D4AD8B3CCA1C354C218E92D35D42705707F3FA6D + F4EA1A0FC6514DC65829CA51F2B96BBD8DBB12DDA50C1E2AE02859EECAA8E02E + 1D4DE651E6A8A14A7554F5DCD55A4F5379881D3556E2A8AECA72941CEECA69DE + F27B85BB4B513CCA1CC5EC8599C4E6FCFFC2E1DCE00B36FEE6CE5D458CBB5C03 + 4E81BBECC05DEE3A9AC0438AA37EE372CE3C30E2F93C88F981914519EC5CFD5F + 1CD495923277ED4777B5E7DB5D8AE02176D4382BDCAFC73AEA3E97F951CCF943 + 91457B9910151DE330BFEB5999BB3680BBAEF0EE2E3E79F0EE28F1BA1E3367EE + ED7DC80CC3C7EFA42733570F7D579EDCD552EC2E371D75E251EA289B21CCFE6E + 3E1C255ED77B9884EB1765EB8CCD753CBC7F0876755B8FEB8CE95CB92B40726E + AAA8E830B82B08DCD5D6BC7EB49EBAF04047E11914ACA3BA71EE2866BDFBC104 + 5CD72BBF96646AEAA12B08BE132B08B8D282D3754691B8DF25882CDADEC26323 + BAAB391FEEE29AC75B8E8A783E994F47E17A77656BAC5656317AFAFA1F68FBF8 + 9FF2E0C35DFED867807AE21AF093BBD85DAE3AAAC843ECA8254E786611EBA8A7 + 3C392AB9BCA3A415B1BBF60B5DDDBEB7E1B2DF55A9BBACA2F4548D07E3A8A613 + 58473DE7CB51E32B3A4A5A61DDD5814777E5B4F0D8C4BAEB7D6D55E121715443 + 253A4A5AB1B26A53D15D39FCB9AB998E9149EDDC555B1EACA31CF1EC47FE1D95 + 54E3BD3065EEDA207157093BBEE0D05D0702C15D31E656223D65F1103B6AA2C4 + 51713C38EA31E6FC639E796D729B4D4D5BEAF0E4AE6765EEDA5C6B77D5944705 + 4725B167A2F2E4A8F1865CE4AA29C05D9962779D66DC6568E2A2A3081E0A74D4 + 94DA384ABABBECC4EE72DFC8B7BBDA9855D35D35E1818EC2B3E5F13C73F60CED + FB5C9E15CC3A6A2C3ACAC5258BF3FD172626EE3A02E19DF63CBA6B470B8F6CB1 + BBF4ABE7AEEAF0287354BFF28EE272BFDEE5B71DB591B71C4E2BABD68CBB7CFD + 7F6AC9BA6B074FEE7233306A0AEE72D6E1924799A312D4D251B2DD7540E8E6BE + 09DD95C9A1BB4A5877153AFB1E4477B536B38AD4E38A07E3A86693ADF0B930AC + A31EF0E0A8317C394ABABBDCC05DB7DB0902AEF2E72ECF2D72BBAB2A1EF84CB7 + 728E4AE6D751E37875947477459777D7111EDC952576D7992ADD258B87021D35 + 55918E92E92E9F03416EEE9BF97397DFC1008F905BD1E6F52374ABCB43ECA824 + 2B7CBE1EFB4C371E1D9569A26C1EACBBDAF2E8AE5C7BCFAD32C78C95F1287554 + 23DE1D354B598E92562C2DA358779D7667DD95CBA5BB04A2E7E8AE8296C1A75D + C05DDA46264E3AB278881DB5D4119F8DCBA3A37A018B69CD9A251B69A9683134 + 6CC6BA2B1BDD95C583BB0EBB0A0E0ABC5BDD1299D70FD795C643ECA8E4FAF5C4 + 8EEAC183A31E81A3468B1D9561A2AA3C4C4C5CD15D31E0AEE60165CFDAE0CE5D + 50EF1C7DB736F20CBBDCACBCBB243CCA1CD51F1D35855F478D05476D32D552F1 + 2276D7FB0A70D7197057137097A30EF2D8B7EFA4B683333A6A407947FD5AD71C + 25D35DBE0783DC5A6EB109882E5ACBBAEB3997FD2ED700C65D9101218374F3F2 + F66B356B36151C15C6A7A34681A3D25D5CD24DD48D8789898B8E2018DC1578B5 + B920AAB4DFF59A03773D97B8CBC9771BE32E4FAF70EDA3C75EEB83A306030B2F + E070930F47356E3C462D1C25ADD4B316E9E983E7BD42CEB44426103B3974D74B + 70571A70D9D3BDDF73F38385F7F5DC834F7573F4DFE92C882EDEC57AE605478E + 9AAE8E8E92EA2EE3663AEE8107835C7CB7DAA2BB026AE72EAC67FF05884AEEFB + 86DE1E27087F92D2AE735EBD82E3C506DE91F7077A46DCF481DF7D91F5CC9B5A + 3B2AF4C1487494B3F31A134DE1616CEAACE317713BC637FCAA3DD491C25ABAEB + 3FF6F5B920E2E92241E4F3ED711FDDB1C6FE95B5EDC7C606C676BA1E619745C0 + E46788821ABC8F46394ABABB22C5EE0A2D75D7AE1AB88BA91762167FACB6735A + 58CFD57BA775C5F187B18537BAABABA3FF2EA76AB84BA31D25D55D464DC15D87 + 825CFCB6350677AD93D35D6F3B2AE2698A9D534A3D69E341B3FA61E8AE01E02E + 6FF8DD17E474573947DD1F2176D46A134DE7C1BAAB4D35DD55DE510BD151AE3E + BBAC65CD5F89DDD5ACBCBB0ECB789FF28E9AD9B8F1688D74945477D58F60DCE5 + 1D7AD6BD9CBB5EC9E7A8947AAE3E3BADE59DDF35367FCB5D7915DC55271D25CB + 5D2DC15DAE7EDB2B735799A3C218472D6CEE5CE6287979985985EA83BB3E93E2 + 2E89A31E82A38683A3D6D4054749779713BAABB514779577544A0038CADDF7ED + 7A21EFFA607D9B3E1277459673D7ABB71D35AA4E394A5AB178D75D794CBFAB9C + A3B05EB8FBEEB2AEEDFAB9B1B917B8EBA7AE4E823C2760B20A1CD513587C5E97 + 1D5585BB025DFD721A0744152D651DB5A885F3C27A55FD5B797998598580BBEE + F5F788B889732AF9E0A844B1A3569950026F17235347745734B8AB05D491BD82 + 88278CA3DCA438AA228FFCFC7CE6B5AA088D9E65ECE5DB56B77BBF92FAAD5B2F + 378C8FBF642ACFBFAB8B11143248CFD33B42BBE767C5961DBAE4D58BEF73C75A + 9E7F171B1B4B6F685A68A185165A68A185165A68A185165A68A185165A68D1F0 + B2796D4A2B428836BD12CA2F5BD6A60CC8CE4AF92F3B6BE172CA4435586C59BB + 90605026AAC38232513D169489EAB1A04C548F859807FCDCBA45E1F4AAA9080B + F8797AD5DE2EDB33E73B6C5DB7C84F9ED89231CF89B2E0AF6CCD5C18B7252BE5 + 8D3CD79009FCD9AC945E94050F2CD62DE8B8256BE12BB95948614259D4BE6467 + 2E6A5B2316159850161CD48BAC8551D96B534A6ACC828DAD62CFFD4E59D486C5 + 82302E58948B373086784259D4A02FBA2E4598BD76E1730E5954C9A4AEB3189F + D8B5F1A4E1F1472625C6BB95FFFF9B3216F8437BF1170F2CA432A12CBA369E9C + 18777DF2F078024C1E49986C5D9BE20D2C9EF2C8E21D269445190B492093B479 + E33A413FE8B10258943211B7F194457916929832A6E7EF9B32E7DF50200FA963 + C63AD35E24C65FAB8C0565A2D8327648F78655B1A04C1457A64DEB6E3029316E + 8B3C3C94C9647BE637CD2913D561B275ED7C0F4D6E2F268E8A775027269ACAA3 + 5CDBFD5BF2F06E8EEAC244137954D28F521B269AC643469F562D9868120F5963 + 3D7561A2293CE460A1164C3485075CCF65F25E4FF8D9BBAACA4453784CFBE413 + A3C9C3E3F2D49D8926B51F9AC044D3FA57594B67F9CE9B3EF8A43A32C9CE5AF8 + 5A93E64BC46B49298FB3B352FE9EF779ED99C0DF652B8C0993BF92D24D635860 + 3E60B9753D7562829F155E35E66024CC3DA86CBD5B1D9860FECAE67529311A53 + 2F989C1CE97920AACC8461B17651A4E6B0902F574D1599E03D84F792A6B06073 + 385F54C7D1D5653271E8874EBC3041B78263358645564AA79AE4D32A83C9D4D1 + 3D9FBCC504FA1CD8F7D01C160BE26B93DBAC5426D017C73EB9268DF7AAB5FF42 + C5982CFD7A4C474D5B6BE26A5E42194C260F8F7B9C3C32CE9DF2A04CD48187B2 + 98600E37E5A11A4C98B5E451F1B69487F299681A0B3E7970C904AEFBE64ADA8D + AB9AC6826F1EFC31D14C168AE051132670BDEF4967A2B92C14C5834B26D30675 + 7D5F4B838B22739BB960A2E9654B56CA1D55675271AE5E93CBD6F52976AACC44 + 13FBB4EACB44B3DBEEAA986C5D9BF244E14CA4E612D55D160C8FB50BFBCB7B36 + 0B87FBC91EAF4B9BEBF76ECE1D65A16816F07E7F48D692DECE83A42C145F2F16 + FE959DB550F0D6D8029840DBBD64DCD09E36948502EB05E6126950EE0157253B + 6BC1678A6781F95129ADE8D5AF390BFC39A8474F3870D48BCDEB1644D3AB5F4B + 16EB160DACF5F8449CDBDC8E5EFDDAB3A8F59811586CCD4CE942AF3E772C6ACC + 047389D62DEC4EAF3EF72C68A12C280BCA82B2D0FC82CF50A0E736AB4EC1678C + E0B346280BF5614259A80E13CA4275985016AAC384B2502D2674AE9B165A68A1 + 85165A68A185165A68A185165A68A185165A34BFFC1F558FF11B + } + end + object SynSQLSynUsed: TSynSQLSyn + DefaultFilter = 'SQL Files (*.sql)|*.sql' + Enabled = False + KeyAttri.Foreground = clBlue + SQLDialect = sqlMySQL + Left = 50 + Top = 298 + end +end diff --git a/source/main.pas b/source/main.pas new file mode 100644 index 00000000..58515880 --- /dev/null +++ b/source/main.pas @@ -0,0 +1,15100 @@ +unit main; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ActnList, + ComCtrls, ExtCtrls, SynEdit, SynHighlighterSQL, laz.VirtualTrees, + RegExpr, + Generics.Collections, Generics.Defaults, + dbconnection, dbstructures, dbstructures.mysql; + + +type + + // Bind parameters for query tabs + TBindParam = class(TObject) + Name: String; + Value: String; + Keep: Boolean; + end; + TListBindParam = class(TObjectList<TBindParam>) + private + FPairDelimiter, FItemDelimiter: Char; + function GetAsText: String; + procedure SetAsText(Input: String); + public + constructor Create; + procedure CleanToKeep; + property AsText: String read GetAsText write SetAsText; + end; + TBindParamComparer = class(TComparer<TBindParam>) + function Compare(constref Left, Right: TBindParam): Integer; override; + end; + + {// Query tabs and contained components + TQueryTab = class; + TResultTab = class(TObject) + Results: TDBQuery; + Grid: TVirtualStringTree; + FilterText: String; + private + FTabIndex: Integer; + public + constructor Create(AOwner: TQueryTab); + destructor Destroy; override; + property TabIndex: Integer read FTabIndex; + end; + TResultTabs = TObjectList<TResultTab>;} + {TQueryTab = class(TComponent) + const + IdentBackupFilename = 'BackupFilename'; + IdentFilename = 'Filename'; + IdentFileEncoding = 'FileEncoding'; + IdentCaption = 'Caption'; + IdentPid = 'pid'; + IdentEditorHeight = 'EditorHeight'; + IdentHelpersWidth = 'HelpersWidth'; + IdentBindParams = 'BindParams'; + IdentEditorTopLine = 'EditorTopLine'; + IdentTabFocused = 'TabFocused'; + HelperNodeColumns = 0; + HelperNodeFunctions = 1; + HelperNodeKeywords = 2; + HelperNodeSnippets = 3; + HelperNodeHistory = 4; + HelperNodeProfile = 5; + HelperNodeBinding = 6; + private + FMemoFilename: String; + FQueryRunning: Boolean; + FLastChange: TDateTime; + FDirectoryWatchNotficationRunning: Boolean; + FErrorLine: Integer; + FFileEncoding: String; + procedure SetMemoFilename(Value: String); + procedure SetQueryRunning(Value: Boolean); + procedure TimerLastChangeOnTimer(Sender: TObject); + procedure TimerStatusUpdateOnTimer(Sender: TObject); + function GetBindParamsActivated: Boolean; + procedure SetBindParamsActivated(Value: Boolean); + procedure SetErrorLine(Value: Integer); + public + Number: Integer; + Uid: String; + ExecutionThread: TQueryThread; + CloseButton: TSpeedButton; + pnlMemo: TPanel; + Memo: TSynMemo; + pnlHelpers: TPanel; + filterHelpers: TButtonedEdit; + treeHelpers: TVirtualStringTree; + MemoFileRenamed: Boolean; + MemoLineBreaks: TLineBreaks; + DirectoryWatch: TDirectoryWatch; + MemofileModifiedTimer: TTimer; + LastSaveTime: Cardinal; + spltHelpers: TSplitter; + spltQuery: TSplitter; + tabsetQuery: TTabSet; + TabSheet: TTabSheet; + ResultTabs: TResultTabs; + DoProfile: Boolean; + QueryProfile: TDBQuery; + ProfileTime, MaxProfileTime: Extended; + LeftOffsetInMemo: Integer; + HistoryDays: TStringList; + ListBindParams: TListBindParam; + TimerLastChange: TTimer; + TimerStatusUpdate: TTimer; + function GetActiveResultTab: TResultTab; + procedure DirectoryWatchNotify(const Sender: TObject; const Action: TWatchAction; const FileName: string); + procedure DirectoryWatchErrorHandler(const Sender: TObject; const ErrorCode: Integer; const ErrorMessage: string); + procedure MemofileModifiedTimerNotify(Sender: TObject); + function LoadContents(Filepath: String; ReplaceContent: Boolean; Encoding: TEncoding): Boolean; + property BindParamsActivated: Boolean read GetBindParamsActivated write SetBindParamsActivated; + procedure SaveContents(Filename: String; OnlySelection: Boolean); + procedure BackupUnsavedContent; + property ActiveResultTab: TResultTab read GetActiveResultTab; + property MemoFilename: String read FMemoFilename write SetMemoFilename; + function MemoBackupFilename: String; + property QueryRunning: Boolean read FQueryRunning write SetQueryRunning; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + class function GenerateUid: String; + property ErrorLine: Integer read FErrorLine write SetErrorLine; + property FileEncoding: String read FFileEncoding write FFileEncoding; + end; + TQueryTabList = class(TObjectList<TQueryTab>) + public + function ActiveTab: TQueryTab; + function ActiveMemo: TSynMemo; + function ActiveHelpersTree: TVirtualStringTree; + function HasActiveTab: Boolean; + function TabByNumber(Number: Integer): TQueryTab; + function TabByControl(Control: TWinControl): TQueryTab; + end;} + + {TQueryHistoryItem = class(TObject) + Time: TDateTime; + Database: String; + SQL: String; + Duration: Cardinal; + RegValue: Integer; + end; + TQueryHistory = class(TObjectList<TQueryHistoryItem>) + private + FMaxDuration: Cardinal; + public + constructor Create(SessionPath: String); + property MaxDuration: Cardinal read FMaxDuration; + end; + TQueryHistoryItemComparer = class(TComparer<TQueryHistoryItem>) + function Compare(const Left, Right: TQueryHistoryItem): Integer; override; + end;} + + {ITaskbarList = interface(IUnknown) + [SID_ITaskbarList] + function HrInit: HRESULT; stdcall; + function AddTab(hwnd: HWND): HRESULT; stdcall; + function DeleteTab(hwnd: HWND): HRESULT; stdcall; + function ActivateTab(hwnd: HWND): HRESULT; stdcall; + function SetActiveAlt(hwnd: HWND): HRESULT; stdcall; + end; + ITaskbarList2 = interface(ITaskbarList) + [SID_ITaskbarList2] + function MarkFullscreenWindow(hwnd: HWND; fFullscreen: BOOL): HRESULT; stdcall; + end; + ITaskbarList3 = interface(ITaskbarList2) + [SID_ITaskbarList3] + function SetProgressValue(hwnd: HWND; ullCompleted: ULONGLONG; ullTotal: ULONGLONG): HRESULT; stdcall; + function SetProgressState(hwnd: HWND; tbpFlags: Integer): HRESULT; stdcall; + function RegisterTab(hwndTab: HWND; hwndMDI: HWND): HRESULT; stdcall; + function UnregisterTab(hwndTab: HWND): HRESULT; stdcall; + function SetTabOrder(hwndTab: HWND; hwndInsertBefore: HWND): HRESULT; stdcall; + function SetTabActive(hwndTab: HWND; hwndMDI: HWND; tbatFlags: Integer): HRESULT; stdcall; + function ThumbBarAddButtons(hwnd: HWND; cButtons: UINT; pButton: PThumbButton): HRESULT; stdcall; + function ThumbBarUpdateButtons(hwnd: HWND; cButtons: UINT; pButton: PThumbButton): HRESULT; stdcall; + function ThumbBarSetImageList(hwnd: HWND; himl: HIMAGELIST): HRESULT; stdcall; + function SetOverlayIcon(hwnd: HWND; hIcon: HICON; pszDescription: LPCWSTR): HRESULT; stdcall; + function SetThumbnailTooltip(hwnd: HWND; pszTip: LPCWSTR): HRESULT; stdcall; + function SetThumbnailClip(hwnd: HWND; var prcClip: TRect): HRESULT; stdcall; + end;} + + TMainForm = class(TForm) + actSessionManager: TAction; + ActionList1: TActionList; + actExitApplication: TAction; + ImageListIcons8: TImageList; + DBtree: TLazVirtualStringTree; + MainMenu1: TMainMenu; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + MenuItem4: TMenuItem; + MenuItem5: TMenuItem; + MenuItem6: TMenuItem; + MenuItem7: TMenuItem; + MenuItem8: TMenuItem; + PageControlMain: TPageControl; + Panel1: TPanel; + Panel2: TPanel; + pnlPreview: TPanel; + pnlFilterVT: TPanel; + pnlLeft: TPanel; + spltPreview: TSplitter; + spltDBtree: TSplitter; + spltTopBottom: TSplitter; + StatusBar: TStatusBar; + SynMemoSQLLog: TSynEdit; + SynSQLSynUsed: TSynSQLSyn; + tabHost: TTabSheet; + tabDatabase: TTabSheet; + tabTable: TTabSheet; + tabData: TTabSheet; + tabQuery: TTabSheet; + ToolBarTree: TToolBar; + ToolBarMainButtons: TToolBar; + ToolButton1: TToolButton; + //procedure actCreateDBObjectExecute(Sender: TObject); + //procedure menuConnectionsPopup(Sender: TObject); + procedure actExitApplicationExecute(Sender: TObject); + //procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA; + //procedure CMStyleChanged(var Msg: TMessage); message CM_STYLECHANGED; + //procedure FormDestroy(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure AfterFormCreate; + //procedure FormShow(Sender: TObject); + //procedure FormResize(Sender: TObject); + //procedure AddEditorCommandMenu(const S: string); + //procedure EditorCommandOnClick(Sender: TObject); + //procedure actUserManagerExecute(Sender: TObject); + //procedure actAboutBoxExecute(Sender: TObject); + //procedure actApplyFilterExecute(Sender: TObject); + //procedure actClearEditorExecute(Sender: TObject); + //procedure actTableToolsExecute(Sender: TObject); + //procedure actPrintListExecute(Sender: TObject); + //procedure actCopyTableExecute(Sender: TObject); + //procedure ShowStatusMsg(Msg: String=''; PanelNr: Integer=6); + //procedure actExecuteQueryExecute(Sender: TObject); + //procedure actCreateDatabaseExecute(Sender: TObject); + //procedure actDataCancelChangesExecute(Sender: TObject); + //procedure actExportDataExecute(Sender: TObject); + //procedure actDataPreviewExecute(Sender: TObject); + //procedure UpdatePreviewPanel; + //procedure actInsertFilesExecute(Sender: TObject); + //procedure actDataDeleteExecute(Sender: TObject); + //procedure actDataFirstExecute(Sender: TObject); + //procedure actDataInsertExecute(Sender: TObject); + //procedure actDataLastExecute(Sender: TObject); + //procedure actDataPostChangesExecute(Sender: TObject); + //procedure actDropObjectsExecute(Sender: TObject); + //procedure actEmptyTablesExecute(Sender: TObject); + //procedure actExportSettingsExecute(Sender: TObject); + //procedure actFlushExecute(Sender: TObject); + //procedure actImportCSVExecute(Sender: TObject); + //procedure actImportSettingsExecute(Sender: TObject); + //procedure actLoadSQLExecute(Sender: TObject); + //procedure actNewWindowExecute(Sender: TObject); + procedure actSessionManagerExecute(Sender: TObject); + //procedure actPreferencesExecute(Sender: TObject); + //procedure actQueryFindReplaceExecute(Sender: TObject); + //procedure actQueryStopOnErrorsExecute(Sender: TObject); + //procedure actQueryWordWrapExecute(Sender: TObject); + //procedure actHelpExecute(Sender: TObject); + //procedure actRefreshExecute(Sender: TObject); + //procedure actRemoveFilterExecute(Sender: TObject); + //procedure actSaveSQLExecute(Sender: TObject); + //procedure actSaveSQLAsExecute(Sender: TObject); + //procedure actSetDelimiterExecute(Sender: TObject); + //procedure actSQLhelpExecute(Sender: TObject); + //procedure actUpdateCheckExecute(Sender: TObject); + //procedure actWebbrowse(Sender: TObject); + //procedure popupQueryPopup(Sender: TObject); + //procedure btnDataClick(Sender: TObject); + //procedure ListTablesChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure SynCompletionProposalAfterCodeCompletion(Sender: TObject; + // const Value: String; Shift: TShiftState; Index: Integer; EndToken: Char); + //procedure SynCompletionProposalCodeCompletion(Sender: TObject; + // var Value: String; Shift: TShiftState; Index: Integer; EndToken: Char); + //procedure SynCompletionProposalExecute(Kind: SynCompletionType; + // Sender: TObject; var CurrentInput: String; var x, y: Integer; + // var CanExecute: Boolean); + //procedure PageControlMainChange(Sender: TObject); + //procedure PageControlMainChanging(Sender: TObject; var AllowChange: Boolean); + //procedure PageControlHostChange(Sender: TObject); + //procedure ValidateControls(Sender: TObject); + //procedure ValidateQueryControls(Sender: TObject); + //procedure DataGridBeforePaint(Sender: TBaseVirtualTree; + // TargetCanvas: TCanvas); + procedure LogSQL(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil); + //procedure KillProcess(Sender: TObject); + //procedure TimerHostUptimeTimer(Sender: TObject); + //procedure ListTablesNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; NewText: String); + //procedure TimerConnectedTimer(Sender: TObject); + //procedure QuickFilterClick(Sender: TObject); + //procedure AutoRefreshSetInterval(Sender: TObject); + //procedure AutoRefreshToggle(Sender: TObject); + //procedure SynMemoQueryDragOver(Sender, Source: TObject; X, Y: Integer; + // State: TDragState; var Accept: Boolean); + //procedure SynMemoQueryDragDrop(Sender, Source: TObject; X, Y: Integer); + //procedure SynMemoQueryDropFiles(Sender: TObject; X, Y: Integer; AFiles: TUnicodeStrings); + //procedure popupHostPopup(Sender: TObject); + //procedure popupDBPopup(Sender: TObject); + //procedure popupDataGridPopup(Sender: TObject); + //procedure QFvaluesClick(Sender: TObject); + //procedure DataInsertValueClick(Sender: TObject); + //procedure InsertValue(Sender: TObject); + //procedure actDataSetNullExecute(Sender: TObject); + //procedure AnyGridCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; out EditLink: IVTEditLink); + //procedure AnyGridEditCancelled(Sender: TBaseVirtualTree; Column: TColumnIndex); + //procedure AnyGridEdited(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex); + //procedure AnyGridEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex; var Allowed: Boolean); + //procedure AnyGridFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: + // PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); + //procedure AnyGridGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex; TextType: TVSTTextType; var CellText: String); + //procedure DataGridHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); + //procedure AnyGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + //procedure AnyGridMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; + // MousePos: TPoint; var Handled: Boolean); + //procedure AnyGridNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex; NewText: String); + //procedure AnyGridPaintText(Sender: TBaseVirtualTree; const TargetCanvas: + // TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); + //procedure menuDeleteSnippetClick(Sender: TObject); + //procedure menuExploreClick(Sender: TObject); + //procedure menuInsertAtCursorClick(Sender: TObject); + //procedure menuLoadSnippetClick(Sender: TObject); + //procedure AnyGridHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); + //procedure AnyGridCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: + // PVirtualNode; Column: TColumnIndex; var Result: Integer); + //procedure AnyGridHeaderDraggedOut(Sender: TVTHeader; Column: TColumnIndex; + // DropPosition: TPoint); + //procedure AnyGridIncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const SearchText: String; + // var Result: Integer); + //procedure SetMainTab(Page: TTabSheet); + //procedure DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex); + //procedure DBtreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var + // ImageIndex: TImageIndex); + //procedure DBtreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: + // Integer); + //procedure DBtreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex; TextType: TVSTTextType; var CellText: String); + //procedure DBtreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var + // ChildCount: Cardinal); + //procedure DBtreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: + // PVirtualNode; var InitialStates: TVirtualNodeInitStates); + //procedure DBtreePaintText(Sender: TBaseVirtualTree; const TargetCanvas: + // TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); + //procedure editFilterSearchChange(Sender: TObject); + //procedure editFilterSearchEnter(Sender: TObject); + //procedure editFilterSearchExit(Sender: TObject); + //procedure menuLogToFileClick(Sender: TObject); + //procedure menuOpenLogFolderClick(Sender: TObject); + //procedure AnyGridGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var + // HintText: String); + //procedure ListTablesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + // var ContentRect: TRect); + //procedure ListProcessesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); + //procedure editFilterVTChange(Sender: TObject); + //procedure ListVariablesDblClick(Sender: TObject); + //procedure menuEditVariableClick(Sender: TObject); + //procedure menuTreeCollapseAllClick(Sender: TObject); + //procedure menuTreeExpandAllClick(Sender: TObject); + //procedure SynMemoFilterStatusChange(Sender: TObject; Changes: TSynStatusChanges); + //procedure AnyGridAfterCellPaint(Sender: TBaseVirtualTree; + // TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + // CellRect: TRect); + //procedure menuShowSizeColumnClick(Sender: TObject); + //procedure AnyGridBeforeCellPaint(Sender: TBaseVirtualTree; + // TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + // CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); + //procedure AnyGridMouseUp(Sender: TObject; Button: TMouseButton; + // Shift: TShiftState; X, Y: Integer); + //procedure MainMenuFileClick(Sender: TObject); + //procedure HostListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + //procedure HostListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); + //procedure HostListBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); + //procedure HostListBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + // var ContentRect: TRect); + //procedure ListTablesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); + //procedure ListTablesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; + // Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); + //procedure ListTablesGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); + //procedure ListTablesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + //procedure ListTablesInitNode(Sender: TBaseVirtualTree; ParentNode, + // Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); + //procedure AnyGridAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); + //procedure actFollowForeignKeyExecute(Sender: TObject); + //procedure actCopyOrCutExecute(Sender: TObject); + //procedure actPasteExecute(Sender: TObject); + //procedure actSelectAllExecute(Sender: TObject); + //procedure EnumerateRecentFilters; + //procedure LoadRecentFilter(Sender: TObject); + //procedure ListTablesEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; var Allowed: Boolean); + //procedure DBtreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure ListTablesDblClick(Sender: TObject); + //procedure panelTopDblClick(Sender: TObject); + //procedure PageControlMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + //procedure actNewQueryTabExecute(Sender: TObject); + //procedure actCloseQueryTabExecute(Sender: TObject); + //procedure menuCloseQueryTabClick(Sender: TObject); + //procedure CloseQueryTab(PageIndex: Integer); + //procedure CloseButtonOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + //procedure CloseButtonOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + //function GetMainTabAt(X, Y: Integer): Integer; + //procedure FixQueryTabCloseButtons; + //function GetOrCreateEmptyQueryTab(DoFocus: Boolean): TQueryTab; + //function ActiveSynMemo(AcceptReadOnlyMemo: Boolean): TSynMemo; + //function IsQueryTab(PageIndex: Integer; IncludeFixed: Boolean): Boolean; + //procedure popupMainTabsPopup(Sender: TObject); + //procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + //procedure actFilterPanelExecute(Sender: TObject); + //procedure TimerFilterVTTimer(Sender: TObject); + //procedure PageControlMainContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); + //procedure menuQueryHelpersGenerateStatementClick(Sender: TObject); + //procedure actSelectInverseExecute(Sender: TObject); + //procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; + // var Handled: Boolean); + //procedure actDataResetSortingExecute(Sender: TObject); + //procedure actReformatSQLExecute(Sender: TObject); + //procedure DBtreeFocusChanging(Sender: TBaseVirtualTree; OldNode, + // NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; + // var Allowed: Boolean); + //procedure actBlobAsTextExecute(Sender: TObject); + //procedure SynMemoQueryReplaceText(Sender: TObject; const ASearch, + // AReplace: string; Line, Column: Integer; var Action: TSynReplaceAction); + //procedure SynMemoQueryPaintTransient(Sender: TObject; Canvas: TCanvas; + // TransientType: TTransientType); + //procedure actQueryFindAgainExecute(Sender: TObject); + //procedure AnyGridScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); + //procedure lblExplainProcessClick(Sender: TObject); + //procedure actDataShowNextExecute(Sender: TObject); + //procedure actDataShowAllExecute(Sender: TObject); + //procedure AnyGridInitNode(Sender: TBaseVirtualTree; ParentNode, + // Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); + //procedure AnyGridFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex); + //procedure ListTablesKeyPress(Sender: TObject; var Key: Char); + //procedure DBtreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure ListDatabasesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); + //procedure ListDatabasesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + //procedure ListDatabasesInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + // var InitialStates: TVirtualNodeInitStates); + //procedure ListDatabasesGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); + //procedure menuFetchDBitemsClick(Sender: TObject); + //procedure ListDatabasesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); + //procedure ListDatabasesDblClick(Sender: TObject); + //procedure actRunRoutinesExecute(Sender: TObject); + //procedure AnyGridGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); + //procedure tabsetQueryClick(Sender: TObject); + //procedure tabsetQueryGetImageIndex(Sender: TObject; TabIndex: Integer; var ImageIndex: Integer); + //procedure tabsetQueryMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + //procedure tabsetQueryMouseLeave(Sender: TObject); + //procedure StatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); + //procedure StatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + //procedure StatusBarMouseLeave(Sender: TObject); + //procedure AnyGridStartOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); + //procedure AnyGridEndOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); + //procedure actDataPreviewUpdate(Sender: TObject); + //procedure spltPreviewMoved(Sender: TObject); + //procedure actDataSaveBlobToFileExecute(Sender: TObject); + //procedure DataGridColumnResize(Sender: TVTHeader; Column: TColumnIndex); + //procedure treeQueryHelpersGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + //procedure treeQueryHelpersInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + // var InitialStates: TVirtualNodeInitStates); + //procedure treeQueryHelpersInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; + // var ChildCount: Cardinal); + //procedure treeQueryHelpersGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); + //procedure treeQueryHelpersBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + // var ContentRect: TRect); + //procedure treeQueryHelpersDblClick(Sender: TObject); + //procedure treeQueryHelpersContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); + //procedure treeQueryHelpersFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure treeQueryHelpersPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); + //procedure treeQueryHelpersFocusChanging(Sender: TBaseVirtualTree; OldNode, + // NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); + //procedure treeQueryHelpersResize(Sender: TObject); + //procedure ApplicationEvents1Deactivate(Sender: TObject); + //procedure actDisconnectExecute(Sender: TObject); + //procedure menuEditObjectClick(Sender: TObject); + //procedure Copylinetonewquerytab1Click(Sender: TObject); + //procedure actLogHorizontalScrollbarExecute(Sender: TObject); + //procedure actBatchInOneGoExecute(Sender: TObject); + //function GetFocusedObjects(Sender: TObject; NodeTypes: TListNodeTypes): TDBObjectList; + //function DBTreeClicked(Sender: TObject): Boolean; + //procedure actCancelOperationExecute(Sender: TObject); + //procedure AnyGridChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure actToggleCommentExecute(Sender: TObject); + //procedure DBtreeBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + // var ContentRect: TRect); + //procedure actLaunchCommandlineExecute(Sender: TObject); + //procedure menuClearQueryHistoryClick(Sender: TObject); + //procedure actGridEditFunctionExecute(Sender: TObject); + //procedure ListVariablesPaintText(Sender: TBaseVirtualTree; + // const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + // TextType: TVSTTextType); + //procedure DBtreeExpanding(Sender: TBaseVirtualTree; Node: PVirtualNode; + // var Allowed: Boolean); + //procedure actGroupObjectsExecute(Sender: TObject); + //procedure popupSqlLogPopup(Sender: TObject); + //procedure menuAutoExpandClick(Sender: TObject); + //procedure pnlLeftResize(Sender: TObject); + //procedure editDatabaseTableFilterChange(Sender: TObject); + //procedure editDatabaseTableFilterLeftButtonClick(Sender: TObject); + //procedure editDatabaseTableFilterMenuClick(Sender: TObject); + //procedure editDatabaseTableFilterExit(Sender: TObject); + //procedure menuClearDataTabFilterClick(Sender: TObject); + //procedure actUnixTimestampColumnExecute(Sender: TObject); + //procedure PopupQueryLoadPopup(Sender: TObject); + //procedure DonateClick(Sender: TObject); + //procedure DBtreeExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure ApplicationDeActivate(Sender: TObject); + //procedure ApplicationShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); + //procedure DBtreeAfterCellPaint(Sender: TBaseVirtualTree; + // TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + // CellRect: TRect); + //procedure actFavoriteObjectsOnlyExecute(Sender: TObject); + //procedure DBtreeMouseUp(Sender: TObject; Button: TMouseButton; + // Shift: TShiftState; X, Y: Integer); + //procedure actFullRefreshExecute(Sender: TObject); + //procedure treeQueryHelpersEditing(Sender: TBaseVirtualTree; + // Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); + //procedure treeQueryHelpersCreateEditor(Sender: TBaseVirtualTree; + // Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); + //procedure treeQueryHelpersNodeClick(Sender: TBaseVirtualTree; + // const HitInfo: THitInfo); + //procedure treeQueryHelpersNewText(Sender: TBaseVirtualTree; + // Node: PVirtualNode; Column: TColumnIndex; NewText: string); + //procedure treeQueryHelpersChecking(Sender: TBaseVirtualTree; + // Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean); + //procedure actPreviousResultExecute(Sender: TObject); + //procedure actNextResultExecute(Sender: TObject); + //procedure actSaveSynMemoToTextfileExecute(Sender: TObject); + //procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean); + //procedure buttonedEditClear(Sender: TObject); + //procedure menuDoubleClickInsertsNodeTextClick(Sender: TObject); + //procedure DBtreeDblClick(Sender: TObject); + //procedure editDatabaseTableFilterKeyPress(Sender: TObject; var Key: Char); + procedure actGotoDbTreeExecute(Sender: TObject); + //procedure actGotoFilterExecute(Sender: TObject); + //procedure actGotoTabNumberExecute(Sender: TObject); + //procedure StatusBarClick(Sender: TObject); + //procedure AnySynMemoMouseWheel(Sender: TObject; Shift: TShiftState; + // WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + //procedure SynMemoQueryKeyPress(Sender: TObject; var Key: Char); + //procedure filterQueryHelpersChange(Sender: TObject); + //procedure TimerStoreTabsTimer(Sender: TObject); + //procedure actGoToQueryResultsExecute(Sender: TObject); + //procedure actGoToDataMultiFilterExecute(Sender: TObject); + //procedure actDataOpenUrlExecute(Sender: TObject); + //procedure ApplicationEvents1ShortCut(var Msg: TWMKey; var Handled: Boolean); + //procedure actDetachDatabaseExecute(Sender: TObject); + //procedure actAttachDatabaseExecute(Sender: TObject); + //procedure actSynEditCompletionProposeExecute(Sender: TObject); + //procedure AnyGridHeaderDrawQueryElements(Sender: TVTHeader; + // var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); + //procedure AnyGridAdvancedHeaderDraw(Sender: TVTHeader; + // var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); + //procedure SynMemoQueryScanForFoldRanges(Sender: TObject; + // FoldRanges: TSynFoldRanges; LinesToScan: TStrings; FromLine, + // ToLine: Integer); + //procedure actCodeFoldingExecute(Sender: TObject); + //procedure actCodeFoldingStartRegionExecute(Sender: TObject); + //procedure actCodeFoldingEndRegionExecute(Sender: TObject); + //procedure actCodeFoldingFoldSelectionExecute(Sender: TObject); + //procedure actConnectionPropertiesExecute(Sender: TObject); + //procedure actRenameQueryTabExecute(Sender: TObject); + //procedure menuRenameQueryTabClick(Sender: TObject); + //procedure SynMemoQueryStatusChange(Sender: TObject; Changes: TSynStatusChanges); + //procedure actCloseAllQueryTabsExecute(Sender: TObject); + //procedure menuCloseRightQueryTabsClick(Sender: TObject); + //procedure popupFilterPopup(Sender: TObject); + //procedure actSynMoveDownExecute(Sender: TObject); + //procedure actSynMoveUpExecute(Sender: TObject); + //procedure actCopyTabsToSpacesExecute(Sender: TObject); + //procedure actCopyUpdate(Sender: TObject); + //procedure FormBeforeMonitorDpiChanged(Sender: TObject; OldDPI, + // NewDPI: Integer); + //procedure menuToggleAllClick(Sender: TObject); + //procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, + // NewDPI: Integer); + //procedure menuCloseTabOnDblClickClick(Sender: TObject); + //procedure TimerRefreshTimer(Sender: TObject); + //procedure SynCompletionProposalChange(Sender: TObject; AIndex: Integer); + //procedure SynMemoQuerySpecialLineColors(Sender: TObject; Line: Integer; + // var Special: Boolean; var FG, BG: TColor); + //procedure SynMemoSQLLogSpecialLineColors(Sender: TObject; Line: Integer; + // var Special: Boolean; var FG, BG: TColor); + //procedure actSequalSuggestExecute(Sender: TObject); + //procedure menuQueryExactRowCountClick(Sender: TObject); + //procedure menuCloseTabOnMiddleClickClick(Sender: TObject); + //procedure TimerCloseTabByButtonTimer(Sender: TObject); + //procedure menuTabsInMultipleLinesClick(Sender: TObject); + //procedure actResetPanelDimensionsExecute(Sender: TObject); + //procedure menuAlwaysGenerateFilterClick(Sender: TObject); + //procedure SynMemoQueryTokenHint(Sender: TObject; Coords: TBufferCoord; + // const Token: string; TokenType: Integer; Attri: TSynHighlighterAttributes; + // var HintText: string); + //procedure actCopyGridNodesExecute(Sender: TObject); + private + // Executable file details + FAppVerMajor: Integer; + FAppVerMinor: Integer; + FAppVerRelease: Integer; + FAppVerRevision: Integer; + FAppVersion: String; + + FLastHintMousepos: TPoint; + FLastHintControlIndex: Integer; + FDelimiter: String; + FLogToFile: Boolean; + FFileNameSessionLog: String; + FFileHandleSessionLog: Textfile; + FLastMouseUpOnPageControl: Cardinal; + FLastTabNumberOnMouseUp: Integer; + FLastMouseDownCloseButton: TObject; + //FJumpList: TJumpList; + //// Filter text per tab for filter panel + //FFilterTextDatabases, + //FFilterTextEditor, + //FFilterTextVariables, + //FFilterTextStatus, + //FFilterTextProcessList, + //FFilterTextCommandStats, + //FFilterTextDatabase, + //FFilterTextData: String; + //FTreeRefreshInProgress: Boolean; + //FRefreshActionDisabledAt: Cardinal; + //FDataGridColumnWidthsCustomized: Boolean; + //FDataGridLastClickedColumnHeader: Integer; + //FDataGridLastClickedColumnLeftPos: Integer; + //FDataGridSortItems: TSortItems; + //FSnippetFilenames: TStringList; + //FConnections: TDBConnectionList; + //FTreeClickHistory: TNodeArray; + //FOperationTicker: Cardinal; + //FOperatingGrid: TBaseVirtualTree; + //FActiveDbObj: TDBObject; + //FActiveObjectGroup: TListNodeType; + //FBtnAddTab: TSpeedButton; + //FDBObjectsMaxSize: Int64; + //FDBObjectsMaxRows: Int64; + //FSearchReplaceDialog: TfrmSearchReplace; + //FCreateDatabaseDialog: TCreateDatabaseForm; + //FTableToolsDialog: TfrmTableTools; + //FGridEditFunctionMode: Boolean; + //FClipboardHasNull: Boolean; + FTimeZoneOffset: Integer; + //FGridCopying: Boolean; + //FGridPasting: Boolean; + //FHasDonatedDatabaseCheck: TThreeStateBoolean; + //FFocusedTables: TDBObjectList; + FLastCaptionChange: Cardinal; + //FListTablesSorted: Boolean; + FLastPortableSettingsSave: Cardinal; + FLastAppSettingsWrites: Integer; + FFormatSettings: TFormatSettings; + FDefaultHintFontName: String; + //FActionList1DefaultCaptions: TStringList; + //FActionList1DefaultHints: TStringList; + //FEditorCommandStrings: TStringList; + //FLastSelWordInEditor: String; + //FMatchingBraceForegroundColor: TColor; + //FMatchingBraceBackgroundColor: TColor; + //FSynEditInOnPaintTransient: Boolean; + //FExactRowCountMode: Boolean; + ////FHelpData: TSimpleKeyValuePairs; + // + //// Host subtabs backend structures + //FHostListResults: TDBQueryList; + //FStatusServerUptime: Integer; + //FProcessListMaxTime: Int64; + //FCommandStatsQueryCount: Int64; + //FCommandStatsServerUptime: Integer; + //FVariableNames, FSessionVars, FGlobalVars: TStringList; + // + procedure SetDelimiter(Value: String); + //procedure DisplayRowCountStats(Sender: TBaseVirtualTree); + //procedure insertFunction(Sender: TObject); + //function GetActiveConnection: TDBConnection; + //function GetActiveDatabase: String; + //function GetCurrentQuery(Tab: TQueryTab): String; + //procedure SetActiveDatabase(db: String; Connection: TDBConnection); + //procedure SetActiveDBObj(Obj: TDBObject); + //procedure ToggleFilterPanel(ForceVisible: Boolean = False); + //procedure EnableDataTab(Enable: Boolean); + //procedure AutoCalcColWidth(Tree: TVirtualStringTree; Column: TColumnIndex); + //procedure PlaceObjectEditor(Obj: TDBObject); + //procedure SetTabCaption(PageIndex: Integer; Text: String); + //function ConfirmTabClose(PageIndex: Integer; AppIsClosing: Boolean): Boolean; + //function ConfirmTabClear(PageIndex: Integer; AppIsClosing: Boolean): Boolean; + //procedure UpdateFilterPanel(Sender: TObject); + //procedure ConnectionReady(Connection: TDBConnection; Database: String); + //procedure DatabaseChanged(Connection: TDBConnection; Database: String); + //procedure ObjectnamesChanged(Connection: TDBConnection; Database: String); + //procedure UpdateLineCharPanel; + //procedure SetSnippetFilenames; + //function TreeClickHistoryPrevious(MayBeNil: Boolean=False): PVirtualNode; + //procedure OperationRunning(Runs: Boolean); + //function RunQueryFiles(Filenames: TStrings; Encoding: TEncoding; ForceRun: Boolean): Boolean; + //function RunQueryFile(Filename: String; Encoding: TEncoding; Conn: TDBConnection; + // ProgressDialog: IProgressDialog; FilesizeSum: Int64; var CurrentPosition: Int64): Boolean; + //procedure SetLogToFile(Value: Boolean); + //procedure StoreLastSessions; + //function HandleUnixTimestampColumn(Sender: TBaseVirtualTree; Column: TColumnIndex): Boolean; + //function InitTabsIniFile: TIniFile; + //procedure StoreTabs; + //function RestoreTabs: Boolean; + //procedure SetHintFontByControl(Control: TWinControl=nil); + public + //QueryTabs: TQueryTabList; + //ActiveObjectEditor: TDBObjectEditor; + //FileEncodings: TStringList; + //ImportSettingsDone: Boolean; + // + //// Data grid related stuff + //DataGridHiddenColumns: TStringList; + //DataGridWantedRowCount: Int64; + //DataGridTable: TDBObject; + //DataGridFocusedCell: TStringList; + //DataGridFocusedNodeIndex: Int64; + //DataGridFocusedColumnName: String; + //DataGridResult: TDBQuery; + //DataGridFullRowMode: Boolean; + //DataLocalNumberFormat: Boolean; + //SelectedTableColumns: TTableColumnList; + //SelectedTableKeys: TTableKeyList; + //SelectedTableForeignKeys: TForeignKeyList; + //SelectedTableTimestampColumns: TStringList; + //FilterPanelManuallyOpened: Boolean; + // + //// Task button interface + //TaskbarList: ITaskbarList; + //TaskbarList2: ITaskbarList2; + //TaskbarList3: ITaskbarList3; + //TaskbarList4: ITaskbarList4; + // + property AppVerRevision: Integer read FAppVerRevision; + property AppVersion: String read FAppVersion; + //property Connections: TDBConnectionList read FConnections; + property Delimiter: String read FDelimiter write SetDelimiter; + //property FocusedTables: TDBObjectList read FFocusedTables; + //function GetAlternatingRowBackground(Node: PVirtualNode): TColor; + //procedure PaintAlternatingRowBackground(TargetCanvas: TCanvas; Node: PVirtualNode; CellRect: TRect); + //procedure PaintColorBar(Value, Max: Extended; TargetCanvas: TCanvas; CellRect: TRect); + //procedure CallSQLHelpWithKeyword( keyword: String ); + //procedure AddOrRemoveFromQueryLoadHistory(Filename: String; AddIt: Boolean; CheckIfFileExists: Boolean); + //procedure popupQueryLoadClick( sender: TObject ); + //procedure PopupQueryLoadRemoveAbsentFiles(Sender: TObject); + //procedure PopupQueryLoadRemoveAllFiles(Sender: TObject); + //procedure SessionConnect(Sender: TObject); + //function InitConnection(Params: TConnectionParameters; ActivateMe: Boolean; var Connection: TDBConnection): Boolean; + //procedure ConnectionsNotify(Sender: TObject; const Item: TDBConnection; Action: TCollectionNotification); + //function ActiveGrid: TVirtualStringTree; + //function GridResult(Grid: TBaseVirtualTree): TDBQuery; + //property ActiveConnection: TDBConnection read GetActiveConnection; + //property ActiveDatabase: String read GetActiveDatabase; + //property ActiveDbObj: TDBObject read FActiveDbObj write SetActiveDBObj; + property LogToFile: Boolean read FLogToFile write FLogToFile; //SetLogToFile; + //procedure RefreshTree(FocusNewObject: TDBObject=nil); + //function GetRootNode(Tree: TBaseVirtualTree; Connection: TDBConnection): PVirtualNode; + //function FindDBObjectNode(Tree: TBaseVirtualTree; Obj: TDBObject): PVirtualNode; + //function FindDBNode(Tree: TBaseVirtualTree; Connection: TDBConnection; db: String): PVirtualNode; + //procedure CalcNullColors; + //procedure HandleDataGridAttributes(RefreshingData: Boolean); + //function GetRegKeyTable: String; + //procedure UpdateEditorTab; + //procedure SetWindowCaption; + //procedure DefaultHandler(var Message); override; + //procedure SetupSynEditors; overload; + //procedure SetupSynEditors(BaseForm: TComponent); overload; + //procedure SetupSynEditor(Editor: TSynMemo); + //function AnyGridEnsureFullRow(Grid: TVirtualStringTree; Node: PVirtualNode): Boolean; + //procedure DataGridEnsureFullRows(Grid: TVirtualStringTree; SelectedOnly: Boolean); + //property DataGridSortItems: TSortItems read FDataGridSortItems write FDataGridSortItems; + //function GetEncodingByName(Name: String): TEncoding; + //function GetEncodingName(Encoding: TEncoding): String; + //function GetCharsetByEncoding(Encoding: TEncoding): String; + //procedure RefreshHelperNode(NodeIndex: Cardinal); + //procedure BeforeQueryExecution(Thread: TQueryThread); + //procedure AfterQueryExecution(Thread: TQueryThread); + //procedure FinishedQueryExecution(Thread: TQueryThread); + //procedure EnableProgress(MaxValue: Integer); + //procedure DisableProgress; + //procedure SetProgressPosition(Value: Integer); + //procedure ProgressStep; + //procedure SetProgressState(State: TProgressbarState); + //procedure TaskDialogHyperLinkClicked(Sender: TObject); + //function HasDonated(ForceCheck: Boolean): TThreeStateBoolean; + //procedure ApplyVTFilter(FromTimer: Boolean); + //procedure ApplyFontToGrids; + //procedure PrepareImageList; + //property ActionList1DefaultCaptions: TStringList read FActionList1DefaultCaptions; + //property ActionList1DefaultHints: TStringList read FActionList1DefaultHints; + //function SelectedTableFocusedColumn: TTableColumn; + //property FormatSettings: TFormatSettings read FFormatSettings; + //property MatchingBraceForegroundColor: TColor read FMatchingBraceForegroundColor write FMatchingBraceForegroundColor; + //property MatchingBraceBackgroundColor: TColor read FMatchingBraceBackgroundColor write FMatchingBraceBackgroundColor; + end; + +var + MainForm: TMainForm; + SecondInstMsgId: Cardinal = 0; + SysLanguage: String; + MainFormCreated: Boolean = False; + MainFormAfterCreateDone: Boolean = False; + PostponedLogItems: TDBLogItems; + +const + CheckedStates = [csCheckedNormal, csCheckedPressed, csMixedNormal, csMixedPressed]; + ErrorLineForeground: TColor = $00000000; + ErrorLineBackground: TColor = $00D2B7FF; + WarningLineForeground: TColor = $00000000; + WarningLineBackground: TColor = $00B7CDFF; + NoteLineForeground: TColor = $00000000; + NoteLineBackground: TColor = $00D3F7FF; + InfoLineForeground: TColor = $00000000; + InfoLineBackground: TColor = $00C6FFEC; + +{$I const.inc} + + +implementation + +uses + FileInfo, winpeimagereader, elfreader, machoreader, apphelpers; + +{$R *.lfm} + +{ TMainForm } + + +{procedure TMainForm.ShowStatusMsg(Msg: String=''; PanelNr: Integer=6); +var + PanelRect: TRect; +begin + // Show message in some statusbar panel + if (PanelNr = 6) and (Msg = '') then + Msg := _(SIdle); + if Msg <> StatusBar.Panels[PanelNr].Text then begin + StatusBar.Panels[PanelNr].Text := Msg; + if (PanelNr = 6) and (not IsWine) then begin + // Immediately repaint this special panel, as it holds critical update messages, + // while avoiding StatusBar.Repaint which refreshes all panels + SendMessage(StatusBar.Handle, SB_GETRECT, PanelNr, Integer(@PanelRect)); + StatusBar.OnDrawPanel(StatusBar, StatusBar.Panels[PanelNr], PanelRect); + InvalidateRect(StatusBar.Handle, PanelRect, False); + // Alternatives: + //RedrawWindow(StatusBar.Handle, @PanelRect, 0, RDW_UPDATENOW); + //UpdateWindow(StatusBar.Handle); + //StatusBar.Repaint; + end; + end; +end;} + + +{procedure TMainForm.StatusBarClick(Sender: TObject); +var + Click: TPoint; + i: Integer; + PanelRect: TRect; +begin + // Handle click events on specific statusbar panels + // Prevent SendMessage on Wine + if IsWine then + Exit; + Click := StatusBar.ScreenToClient(Mouse.CursorPos); + for i:=0 to StatusBar.Panels.Count-1 do begin + SendMessage(StatusBar.Handle, SB_GETRECT, i, Integer(@PanelRect)); + if PtInRect(PanelRect, Click) then begin + // We found the clicked panel + case i of + 3: actConnectionProperties.Execute; + end; + Break; + end; + + end; + +end;} + + +{procedure TMainForm.StatusBarClick(Sender: TObject); +var + Click: TPoint; + i: Integer; + PanelRect: TRect; +begin + // Handle click events on specific statusbar panels + // Prevent SendMessage on Wine + if IsWine then + Exit; + Click := StatusBar.ScreenToClient(Mouse.CursorPos); + for i:=0 to StatusBar.Panels.Count-1 do begin + SendMessage(StatusBar.Handle, SB_GETRECT, i, Integer(@PanelRect)); + if PtInRect(PanelRect, Click) then begin + // We found the clicked panel + case i of + 3: actConnectionProperties.Execute; + end; + Break; + end; + + end; + +end;} + +{procedure TMainForm.StatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; + const Rect: TRect); +var + PanelRect: TRect; + ImageIndex: Integer; + Conn: TDBConnection; +begin + // Refresh one status bar panel, probably with icon + ImageIndex := -1; + case Panel.Index of + 2: ImageIndex := 149; + 3: begin + Conn := ActiveConnection; + if Conn <> nil then + ImageIndex := Conn.Parameters.ImageIndex; + end; + 5: ImageIndex := 190; + 6: begin + if Panel.Text = _(SIdle) then + ImageIndex := 151 // Green dot + else + ImageIndex := 150; // Hourglass + end; + end; + PanelRect := Rect; + StatusBar.Canvas.FillRect(PanelRect); + if ImageIndex > -1 then begin + VirtualImageListMain.Draw(StatusBar.Canvas, PanelRect.Left, PanelRect.Top, ImageIndex, true); + OffsetRect(PanelRect, VirtualImageListMain.Width+2, 0); + end; + DrawText(StatusBar.Canvas.Handle, PChar(Panel.Text), -1, PanelRect, DT_SINGLELINE or DT_VCENTER); +end;} + + +{procedure TMainForm.StatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +var + MouseP: TPoint; + Bar: TStatusBar; + PanelRect: TRect; + i: Integer; + Infos: TStringList; + HintText: String; + Conn: TDBConnection; +begin + // Display various server, client and connection related details in a hint + if IsWine then + Exit; + if (FLastHintMousepos.X = X) and (FLastHintMousepos.Y = Y) then + Exit; + FLastHintMousepos := Point(X, Y); + MouseP := StatusBar.ClientOrigin; + Inc(MouseP.X, X); + Inc(MouseP.Y, Y); + Bar := Sender as TStatusBar; + for i:=0 to Bar.Panels.Count-1 do begin + SendMessage(Bar.Handle, SB_GETRECT, i, Integer(@PanelRect)); + if PtInRect(PanelRect, FLastHintMousepos) then + break; + end; + if i = FLastHintControlIndex then + Exit; + FLastHintControlIndex := i; + if FLastHintControlIndex = 3 then begin + Conn := ActiveConnection; + if (Conn <> nil) and (not Conn.IsLockedByThread) then begin + Infos := Conn.ConnectionInfo; + HintText := ''; + for i:=0 to Infos.Count-1 do begin + HintText := HintText + Infos.Names[i] + ': ' + StrEllipsis(Infos.ValueFromIndex[i], 200) + CRLF; + end; + BalloonHint1.Description := Trim(HintText); + OffsetRect(PanelRect, Bar.ClientOrigin.X, Bar.ClientOrigin.Y); + BalloonHint1.ShowHint(PanelRect); + end; + end else + Bar.OnMouseLeave(Sender); +end;} + + +{procedure TMainForm.StatusBarMouseLeave(Sender: TObject); +begin + BalloonHint1.HideHint; + FLastHintControlIndex := -1; +end;} + + +procedure TMainForm.actExitApplicationExecute(Sender: TObject); +begin + Close; +end; + +{procedure TMainForm.actFlushExecute(Sender: TObject); +var + FlushWhat: String; +begin + if Sender = actFlushHosts then + FlushWhat := 'HOSTS' + else if Sender = actFlushLogs then + FlushWhat := 'LOGS' + else if Sender = actFlushPrivileges then + FlushWhat := 'PRIVILEGES' + else if Sender = actFlushTables then + FlushWhat := 'TABLES' + else if Sender = actFlushTableswithreadlock then + FlushWhat := 'TABLES WITH READ LOCK' + else if Sender = actFlushStatus then + FlushWhat := 'STATUS' + else + raise Exception.CreateFmt(_('Unhandled sender control: %s'), [(Sender as TControl).Name]); + try + ActiveConnection.Query('FLUSH ' + FlushWhat); + if Sender = actFlushTableswithreadlock then begin + MessageDialog( + _('Tables have been flushed and read lock acquired. Perform backup or snapshot of table data files now. Press OK to unlock when done...'), + mtInformation, [mbOk] + ); + ActiveConnection.Query('UNLOCK TABLES'); + end; + except + on E:EDbError do + ErrorDialog(E.Message); + end; +end;} + + +{procedure TMainForm.actFullRefreshExecute(Sender: TObject); +var + OldFullTableStatusSetting: Boolean; + Conn: TDBConnection; +begin + // Temorarily enable full table status when it's disabled + Conn := ActiveConnection; + OldFullTableStatusSetting := Conn.Parameters.FullTableStatus; + Conn.Parameters.FullTableStatus := True; + actRefresh.Execute; + Conn.Parameters.FullTableStatus := OldFullTableStatusSetting; +end;} + + +procedure TMainForm.actGotoDbTreeExecute(Sender: TObject); +begin + DBtree.SetFocus; +end; + + +{procedure TMainForm.actGotoFilterExecute(Sender: TObject); +begin + editTableFilter.SetFocus; +end;} + + +{procedure TMainForm.actGoToQueryResultsExecute(Sender: TObject); +var + Tab: TQueryTab; + Grid: TVirtualStringTree; +begin + if QueryTabs.HasActiveTab then begin + // Switch between query editor and result grid + Tab := QueryTabs.ActiveTab; + if Tab.Memo.Focused then begin + if Tab.ActiveResultTab <> nil then begin + Grid := Tab.ActiveResultTab.Grid; + Grid.SetFocus; + if Grid.FocusedNode = nil then + SelectNode(Grid, 0); + end else begin + MessageBeep(MB_ICONASTERISK); + end; + end else begin + Tab.Memo.SetFocus; + end; + end else if PageControlMain.ActivePage = tabData then begin + // Switch between data tab filter and result grid + if SynMemoFilter.Focused then begin + DataGrid.SetFocus; + if DataGrid.FocusedNode = nil then + SelectNode(DataGrid, 0); + end else begin + ToggleFilterPanel(True); + SynMemoFilter.TrySetFocus; + end; + end else begin + MessageBeep(MB_ICONASTERISK); + end; +end;} + + +{procedure TMainForm.actGoToDataMultiFilterExecute(Sender: TObject); +begin + // Go to multi column filter generator + if PageControlMain.ActivePage = tabData then begin + ToggleFilterPanel(True); + editFilterSearch.TrySetFocus; + end else begin + MessageBeep(MB_ICONASTERISK); + end; +end;} + + +{procedure TMainForm.actGotoTabNumberExecute(Sender: TObject); +var + i, Visibles, WantedIndex: Integer; +begin + // Set focus on tab by numeric index + WantedIndex := -1; + if Sender = actGotoTab1 then + WantedIndex := 0 + else if Sender = actGotoTab2 then + WantedIndex := 1 + else if Sender = actGotoTab3 then + WantedIndex := 2 + else if Sender = actGotoTab4 then + WantedIndex := 3 + else if Sender = actGotoTab5 then + WantedIndex := 4; + i := 0; + Visibles := 0; + while true do begin + if i >= PageControlMain.PageCount then + Break; + if PageControlMain.Pages[i].TabVisible then begin + if Visibles = WantedIndex then begin + PageControlMain.ActivePageIndex := i; + Break; + end; + Inc(Visibles); + end; + Inc(i); + end; +end;} + + +{procedure TMainForm.actGridEditFunctionExecute(Sender: TObject); +begin + // Insert SQL function in grid + FGridEditFunctionMode := True; + ActiveGrid.EditNode(ActiveGrid.FocusedNode, ActiveGrid.FocusedColumn); +end;} + + +{procedure TMainForm.StoreLastSessions; +var + OpenSessions, SessionPaths, SortedSessions: TStringList; + Connection: TDBConnection; + JumpTask: TJumpTask; + SessionPath: String; + i: Integer; + LastConnect: TDateTime; +begin + // Store names of open sessions + OpenSessions := TStringList.Create; + for Connection in Connections do + OpenSessions.Add(Connection.Parameters.SessionPath); + AppSettings.WriteString(asLastSessions, Implode(DELIM, OpenSessions)); + OpenSessions.Free; + if Assigned(ActiveConnection) then + AppSettings.WriteString(asLastActiveSession, ActiveConnection.Parameters.SessionPath); + + // Recreate Win7 taskbar jump list with sessions used in the last month, ordered by the number of connects + if Assigned(FJumpList) then try + FJumpList.Clear; + SessionPaths := TStringList.Create; + SortedSessions := TStringList.Create; + AppSettings.GetSessionPaths('', SessionPaths); + for SessionPath in SessionPaths do begin + AppSettings.SessionPath := SessionPath; + LastConnect := StrToDateTimeDef(AppSettings.ReadString(asLastConnect), DateTimeNever); + if DaysBetween(LastConnect, Now) <= 30 then + SortedSessions.Values[SessionPath] := IntToStr(AppSettings.ReadInt(asConnectCount)); + end; + SessionPaths.Free; + AppSettings.ResetPath; + SortedSessions.CustomSort(StringListCompareByValue); + for i:=0 to SortedSessions.Count-1 do begin + JumpTask := TJumpTask.Create; + JumpTask.Title := SortedSessions.Names[i]+' ('+FormatNumber(SortedSessions.ValueFromIndex[i], True)+')'; + JumpTask.ApplicationPath := ParamStr(0); + JumpTask.Arguments := '-d="'+SortedSessions.Names[i]+'"'; + JumpTask.CustomCategory := _('Recent sessions'); + FJumpList.JumpItems.Add(JumpTask); + end; + SortedSessions.Free; + // Seems to randomly produce access violations, not only on Wine + // See issue #3428 + FJumpList.Apply; + except + on E:Exception do + LogSQL(E.Message, lcError); + end; +end;} + + +{procedure TMainForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, + NewDPI: Integer); +begin + // DPI settings change finished + FormResize(Sender); +end;} + +{procedure TMainForm.FormBeforeMonitorDpiChanged(Sender: TObject; OldDPI, + NewDPI: Integer); +var + Factor: Extended; +begin + // Moving window to different screen or user changed DPI setting for current screen + Factor := 100 / PixelsPerInchDesigned * NewDPI; + LogSQL(f_('Scaling controls to screen DPI: %d%%', [Round(Factor)])); + //LogSQL('PixelsPerInchDesigned:'+PixelsPerInchDesigned.ToString+' OldDPI:'+OldDPI.ToString+' NewDPI:'+NewDPI.ToString); +end;} + + +{procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +var + i: Integer; +begin + // Prompt on modified changes + CanClose := True; + + // Unsaved changes in some query tab? + // Also backups automatically if option is activated + for i:=0 to QueryTabs.Count-1 do begin + CanClose := ConfirmTabClose(i+tabQuery.PageIndex, True); + if not CanClose then + Exit; + end; + // Unsaved modified table, trigger, view or routine? + if Assigned(ActiveObjectEditor) then + CanClose := not (ActiveObjectEditor.DeInit in [mrAbort, mrCancel]); +end;} + +{procedure TMainForm.FormDestroy(Sender: TObject); +begin + // Destroy dialogs + FreeAndNil(FSearchReplaceDialog); + + StoreLastSessions; + + // Store tab setup for the last time, before tabs are destroyed + if TimerStoreTabs.Enabled then begin + TimerStoreTabs.OnTimer(Sender); + end; + + // Some grid editors access the registry - be sure these are gone before freeing AppSettings + QueryTabs.Clear; + DataGrid.EndEditNode; + + // Clearing query and browse data. + FreeAndNil(DataGridResult); + + // Close database connections + Connections.Clear; + + // Save various settings + AppSettings.WriteBool(asStopOnErrorsInBatchMode, actQueryStopOnErrors.Checked); + AppSettings.WriteBool(asDisplayBLOBsAsText, actBlobAsText.Checked); + AppSettings.WriteString(asDelimiter, FDelimiter); + AppSettings.WriteInt(asQuerymemoheight, pnlQueryMemo.Height); + AppSettings.WriteInt(asQueryhelperswidth, pnlQueryHelpers.Width); + AppSettings.WriteInt(asCompletionProposalWidth, SynCompletionProposal.Width); + AppSettings.WriteInt(asCompletionProposalNbLinesInWindow, SynCompletionProposal.NbLinesInWindow); + AppSettings.WriteInt(asDbtreewidth, pnlLeft.width); + AppSettings.WriteBool(asGroupTreeObjects, actGroupObjects.Checked); + AppSettings.WriteInt(asDataPreviewHeight, pnlPreview.Height); + AppSettings.WriteBool(asDataPreviewEnabled, actDataPreview.Checked); + AppSettings.WriteInt(asLogHeight, SynMemoSQLLog.Height); + AppSettings.WriteBool(asFilterPanel, actFilterPanel.Checked); + AppSettings.WriteBool(asWrapLongLines, actQueryWordWrap.Checked); + AppSettings.WriteBool(asCodeFolding, actCodeFolding.Checked); + AppSettings.WriteBool(asSingleQueries, actSingleQueries.Checked); + AppSettings.WriteBool(asLogHorizontalScrollbar, actLogHorizontalScrollbar.Checked); + AppSettings.WriteBool(asMainWinMaximized, WindowState=wsMaximized); + AppSettings.WriteInt(asMainWinOnMonitor, Monitor.MonitorNum); + // Window dimensions are only valid when WindowState is normal. + if WindowState = wsNormal then begin + AppSettings.WriteInt(asMainWinLeft, Left); + AppSettings.WriteInt(asMainWinTop, Top); + AppSettings.WriteIntDpiAware(asMainWinWidth, Self, Width); + AppSettings.WriteIntDpiAware(asMainWinHeight, Self, Height); + end; + SaveListSetup(ListDatabases); + SaveListSetup(ListVariables); + SaveListSetup(ListStatus); + SaveListSetup(ListProcesses); + SaveListSetup(ListCommandStats); + SaveListSetup(ListTables); + + LogToFile := False; + AppSettings.Free; +end;} +procedure TMainForm.FormCreate(Sender: TObject); +var + i, j, MonitorIndex: Integer; + //QueryTab: TQueryTab; + //Action, CopyAsAction: TAction; + //ExportFormat: TGridExportFormat; + VI: TVersionInfo; + CopyAsMenu, CommandMenu: TMenuItem; + //TZI: TTimeZoneInformation; + //dti: TDBDatatypeCategoryIndex; + //EditorCommand: TSynEditorCommand; + CmdCap: String; + Lib: TMySQLLib; + test: String; +begin + {*** + OnCreate Event + Important to set the windowstate here instead of in OnShow + because possible windowstate-switching is done with an animation + if set in Windows. This animation takes some milliseconds + to complete and can be annoying. + } + Caption := APPNAME; + + // Load preferred ImageCollection into VirtualImageList + {PrepareImageList; + + if AppSettings.ReadBool(asToolbarShowCaptions) then begin + for i:=0 to ToolBarMainButtons.ButtonCount-1 do begin + if ToolBarMainButtons.Buttons[i].Style = tbsSeparator then + Continue; + ToolBarMainButtons.Buttons[i].AutoSize := True; + //ToolBarMainButtons.Buttons[i].AutoSize := False; + //ToolBarMainButtons.Buttons[i].Width := 25; + ToolBarMainButtons.Buttons[i].Style := tbsTextButton; + end; + //ToolBarMainButtons.AllowTextButtons := True; + //ToolBarMainButtons.List := True; + ToolBarMainButtons.ShowCaptions := true; + end;} + + {// Translate menu items + menuQueryHelpersGenerateSelect.Caption := f_('Generate %s ...', ['SELECT']); + menuQueryHelpersGenerateInsert.Caption := f_('Generate %s ...', ['INSERT']); + menuQueryHelpersGenerateUpdate.Caption := f_('Generate %s ...', ['UPDATE']); + menuQueryHelpersGenerateDelete.Caption := f_('Generate %s ...', ['DELETE']);} + + {// Translate data type categories + for dti:=Low(DatatypeCategories) to High(DatatypeCategories) do begin + DatatypeCategories[dti].Name := _(DatatypeCategories[dti].Name); + end;} + + // Detect version + try + VI := TVersionInfo.Create; + VI.Load(HINSTANCE); + FAppVerMajor := VI.FixedInfo.FileVersion[0]; + FAppVerMinor := VI.FixedInfo.FileVersion[1]; + FAppVerRelease := VI.FixedInfo.FileVersion[2]; + FAppVerRevision := VI.FixedInfo.FileVersion[3]; + VI.Free; + except + FAppVerMajor := 0; + FAppVerMinor := 0; + FAppVerRelease := 0; + FAppVerRevision := 0; + end; + FAppVersion := Format('%d.%d.%d.%d', [FAppVerMajor, FAppVerMinor, FAppVerRelease, FAppVerRevision]); + + {// Taskbar button interface for Windows 7 + // Possibly fails. See http://www.heidisql.com/forum.php?t=22451 + if CheckWin32Version(6, 1) then + try + TaskbarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList; + TaskbarList.HrInit; + Supports(TaskbarList, IID_ITaskbarList2, TaskbarList2); + Supports(TaskbarList, IID_ITaskbarList3, TaskbarList3); + Supports(TaskbarList, IID_ITaskbarList4, TaskbarList4); + except + on E:EOleSysError do; + end;} + + // Load snippet filenames + {SetSnippetFilenames;} + + // Dynamically create actions and menuitems in "Copy as" context menu + {for ExportFormat:=Low(TGridExportFormat) to High(TGridExportFormat) do begin + CopyAsAction := TAction.Create(ActionList1); + CopyAsAction.ActionList := ActionList1; + CopyAsAction.Category := actExportData.Category; + CopyAsAction.Name := TfrmExportGrid.CopyAsActionPrefix + Integer(ExportFormat).ToString; + CopyAsAction.Caption := TfrmExportGrid.FormatToDescription[ExportFormat]; + CopyAsAction.ImageIndex := TfrmExportGrid.FormatToImageIndex[ExportFormat]; + CopyAsAction.Tag := Integer(ExportFormat); + CopyAsAction.OnExecute := actCopyOrCutExecute; + CopyAsMenu := TMenuItem.Create(popupDataGrid); + CopyAsMenu.Action := CopyAsAction; + menuCopyAs.Add(CopyAsMenu); + end;} + + // Generate submenu with SynEdit commands + {FEditorCommandStrings := TStringList.Create; + SynEditKeyCmds.GetEditorCommandValues(AddEditorCommandMenu); + for i:=0 to FEditorCommandStrings.Count-1 do begin + EditorCommand := ConvertCodeStringToCommand(FEditorCommandStrings[i]); + CommandMenu := TMenuItem.Create(MainMenu1); + CmdCap := FEditorCommandStrings[i]; + CmdCap := Copy(CmdCap, 3, Length(CmdCap)-2); + // Insert spaces before uppercase chars + for j:=Length(CmdCap) downto 1 do begin + if (j > 1) and CmdCap[j].IsUpper then + Insert(' ', CmdCap, j); + end; + CommandMenu.Caption := CmdCap; + for j:=0 to SynMemoQuery.Keystrokes.Count-1 do begin + if SynMemoQuery.Keystrokes[j].Command = EditorCommand then begin + CommandMenu.Caption := CommandMenu.Caption + ' (' + ShortCutToText(SynMemoQuery.Keystrokes[j].ShortCut) + ')'; + Break; + end; + end; + CommandMenu.OnClick := EditorCommandOnClick; + menuEditorCommands.Add(CommandMenu); + end;} + + + {Delimiter := AppSettings.ReadString(asDelimiter);} + + // Define static query tab as first one in our QueryTabs list + {QueryTab := TQueryTab.Create(Self); + QueryTab.TabSheet := tabQuery; + QueryTab.Number := 1; + QueryTab.Uid := TQueryTab.GenerateUid; + QueryTab.pnlMemo := pnlQueryMemo; + QueryTab.pnlHelpers := pnlQueryHelpers; + QueryTab.filterHelpers := filterQueryHelpers; + QueryTab.treeHelpers := treeQueryHelpers; + QueryTab.Memo := SynMemoQuery; + QueryTab.MemoLineBreaks := TLineBreaks(AppSettings.ReadInt(asLineBreakStyle)); + QueryTab.spltHelpers := spltQueryHelpers; + QueryTab.spltQuery := spltQuery; + QueryTab.tabsetQuery := tabsetQuery; + InheritFont(QueryTab.tabsetQuery.Font); + QueryTab.ResultTabs := TResultTabs.Create(True); + + QueryTabs := TQueryTabList.Create(True); + QueryTabs.Add(QueryTab);} + + // Populate generic results for "Host" subtabs + {FHostListResults := TDBQueryList.Create(False); + for i:=0 to PageControlHost.PageCount-1 do begin + FHostListResults.Add(nil); + end;} + + // Enable auto completion in data tab, filter editor + {SynCompletionProposal.AddEditor(SynMemoFilter);} + + // Window position + {Left := AppSettings.ReadInt(asMainWinLeft); + Top := AppSettings.ReadInt(asMainWinTop); + // ... state + if AppSettings.ReadBool(asMainWinMaximized) then + WindowState := wsMaximized; + // ... and monitor placement + MonitorIndex := AppSettings.ReadInt(asMainWinOnMonitor); + MonitorIndex := Max(0, MonitorIndex); + MonitorIndex := Min(Screen.MonitorCount-1, MonitorIndex); + MakeFullyVisible(Screen.Monitors[MonitorIndex]);} + + {actQueryStopOnErrors.Checked := AppSettings.ReadBool(asStopOnErrorsInBatchMode); + actBlobAsText.Checked := AppSettings.ReadBool(asDisplayBLOBsAsText); + actQueryWordWrap.Checked := AppSettings.ReadBool(asWrapLongLines); + if AppSettings.ReadBool(asCodeFolding) and (not actCodeFolding.Checked) then + actCodeFolding.Execute; + actSingleQueries.Checked := AppSettings.ReadBool(asSingleQueries); + actBatchInOneGo.Checked := not AppSettings.ReadBool(asSingleQueries); + actPreferencesLogging.ImageIndex := actPreferences.ImageIndex; + actPreferencesLogging.OnExecute := actPreferences.OnExecute; + actPreferencesData.ImageIndex := actPreferences.ImageIndex; + actPreferencesData.OnExecute := actPreferences.OnExecute; + menuAlwaysGenerateFilter.Checked := AppSettings.ReadBool(asAlwaysGenerateFilter); } + + {pnlQueryMemo.Height := AppSettings.ReadInt(asQuerymemoheight); + pnlQueryHelpers.Width := AppSettings.ReadInt(asQueryhelperswidth); + pnlLeft.Width := AppSettings.ReadInt(asDbtreewidth); + pnlPreview.Height := AppSettings.ReadInt(asDataPreviewHeight); + if AppSettings.ReadBool(asDataPreviewEnabled) then + actDataPreviewExecute(actDataPreview); + SynMemoSQLLog.Height := Max(AppSettings.ReadInt(asLogHeight), spltTopBottom.MinSize); + // Force status bar position to below log memo + StatusBar.Top := SynMemoSQLLog.Top + SynMemoSQLLog.Height; + actDataShowNext.Hint := f_('Show next %s rows ...', [FormatNumber(AppSettings.ReadInt(asDatagridRowsPerStep))]); + actAboutBox.Caption := f_('About %s', [APPNAME+' '+FAppVersion]); + // Activate logging + LogToFile := AppSettings.ReadBool(asLogToFile); + if AppSettings.ReadBool(asLogHorizontalScrollbar) then + actLogHorizontalScrollbar.Execute;} + + {// Data-Font: + ApplyFontToGrids; + // Load color settings + DatatypeCategories[dtcInteger].Color := AppSettings.ReadInt(asFieldColorNumeric); + DatatypeCategories[dtcReal].Color := AppSettings.ReadInt(asFieldColorReal); + DatatypeCategories[dtcText].Color := AppSettings.ReadInt(asFieldColorText); + DatatypeCategories[dtcBinary].Color := AppSettings.ReadInt(asFieldColorBinary); + DatatypeCategories[dtcTemporal].Color := AppSettings.ReadInt(asFieldColorDatetime); + DatatypeCategories[dtcSpatial].Color := AppSettings.ReadInt(asFieldColorSpatial); + DatatypeCategories[dtcOther].Color := AppSettings.ReadInt(asFieldColorOther); + CalcNullColors;} + + {FDataGridSortItems := TSortItems.Create(True);} + + {DataLocalNumberFormat := AppSettings.ReadBool(asDataLocalNumberFormat); + DataGridTable := nil; + FActiveDbObj := nil;} + + {// Database tree options + actGroupObjects.Checked := AppSettings.ReadBool(asGroupTreeObjects); + if AppSettings.ReadBool(asDisplayObjectSizeColumn) then + menuShowSizeColumn.Click; + if AppSettings.ReadBool(asAutoExpand) then + menuAutoExpand.Click; + if AppSettings.ReadBool(asDoubleClickInsertsNodeText) then + menuDoubleClickInsertsNodeText.Click;} + + {// Shortcuts + FActionList1DefaultCaptions := TStringList.Create; + FActionList1DefaultHints := TStringList.Create; + for i:=0 to ActionList1.ActionCount-1 do begin + Action := TAction(ActionList1.Actions[i]); + Action.ShortCut := AppSettings.ReadInt(asActionShortcut1, Action.Name, Action.ShortCut); + FActionList1DefaultCaptions.Insert(i, Action.Caption); + FActionList1DefaultHints.Insert(i, Action.Hint); + end;} + + {// Completion proposal window + // The proposal form gets scaled a second time when it shows its form with Scaled=True. + // We already store and restore the dimensions DPI aware. + SynCompletionProposal.Form.Scaled := False; + SynCompletionProposal.TimerInterval := AppSettings.ReadInt(asCompletionProposalInterval); + SynCompletionProposal.Width := AppSettings.ReadInt(asCompletionProposalWidth); + SynCompletionProposal.NbLinesInWindow := AppSettings.ReadInt(asCompletionProposalNbLinesInWindow);} + + {// Place progressbar on the statusbar + ProgressBarStatus.Parent := StatusBar; + ProgressBarStatus.Visible := False;} + + // SynMemo font, hightlighting and shortcuts + {SetupSynEditors;} + + {PageControlMain.MultiLine := AppSettings.ReadBool(asTabsInMultipleLines); + SetMainTab(tabHost); + FBtnAddTab := TSpeedButton.Create(PageControlMain); + FBtnAddTab.Parent := PageControlMain; + VirtualImageListMain.GetBitmap(actNewQueryTab.ImageIndex, FBtnAddTab.Glyph); + FBtnAddTab.Height := PageControlMain.TabRect(0).Bottom - PageControlMain.TabRect(0).Top - 2; + FBtnAddTab.Width := FBtnAddTab.Height; + FBtnAddTab.Flat := True; + FBtnAddTab.Hint := actNewQueryTab.Hint; + FBtnAddTab.OnClick := actNewQueryTab.OnExecute;} + + {// Filter panel + VirtualImageListMain.GetBitmap(134, btnCloseFilterPanel.Glyph); + if AppSettings.ReadBool(asFilterPanel) then + actFilterPanelExecute(nil); + lblFilterVTInfo.Caption := '';} + + {SelectedTableColumns := TTableColumnList.Create; + SelectedTableKeys := TTableKeyList.Create; + SelectedTableForeignKeys := TForeignKeyList.Create; + SelectedTableTimestampColumns := TStringList.Create;} + + {// Set up connections list + FConnections := TDBConnectionList.Create; + FConnections.OnNotify := ConnectionsNotify;} + + {FTreeRefreshInProgress := False; + FGridCopying := False; + FGridPasting := False;} + + {FileEncodings := Explode(',', _('Auto detect (may fail)')+',ANSI,ASCII,Unicode,Unicode Big Endian,UTF-8,UTF-7,UTF-8-BOM');} + + {// Detect timezone offset in seconds, once + case GetTimeZoneInformation(TZI) of + TIME_ZONE_ID_STANDARD: FTimeZoneOffset := (TZI.Bias + TZI.StandardBias); + TIME_ZONE_ID_DAYLIGHT: FTimeZoneOffset := (TZI.Bias + TZI.DaylightBias); + TIME_ZONE_ID_UNKNOWN: FTimeZoneOffset := TZI.Bias; + else RaiseLastOSError; + end; + FTimeZoneOffset := FTimeZoneOffset * 60;} + + // Set noderoot for query helpers box + {treeQueryHelpers.RootNodeCount := 7;} + + // Initialize taskbar jump list + {if not IsWine then begin + FJumpList := TJumpList.Create; + FJumpList.ApplicationId := APPNAME + IntToStr(GetExecutableBits); + end;} + + FLastCaptionChange := 0; + FLastPortableSettingsSave := 0; + FLastAppSettingsWrites := 0; + //FFormatSettings := TFormatSettings.Create('en-US'); + FDefaultHintFontName := Screen.HintFont.Name; + + // Now we are free to use certain methods, which are otherwise fired too early + MainFormCreated := True; + + // Log some application details - useful when analyzing session logs + LogSQL(f_('App path: "%s"', [Application.ExeName]), lcDebug); + LogSQL(f_('Version: "%s"', [AppVersion]), lcDebug); + //LogSQL(f_('Theme: "%s"', [TStyleManager.ActiveStyle.Name]), lcDebug); + LogSQL(f_('Pixels per inch on current monitor: %d', [Monitor.PixelsPerInch]), lcDebug); + LogSQL(f_('Timezone offset: %d', [FTimeZoneOffset]), lcDebug); + + {Lib := TMySQLLib.Create(ExtractFilePath(Application.ExeName)+'libmariadb.dll', 'libmariadb.dll'); + try + test := Lib.mysql_get_client_info; + LogSQL(test); + //ShowMessage(String(Lib.mysql_get_client_info)); + except on E:Exception do + ShowMessage('Wrong error: '+E.Message); + end;} +end; + + +procedure TMainForm.AfterFormCreate; +{var + LastSessions, FileNames: TStringlist; + Connection: TDBConnection; + LoadedParams, ConnectionParams: TConnectionParameters; + LastUpdatecheck, LastStatsCall, LastConnect: TDateTime; + UpdatecheckInterval, i: Integer; + LastActiveSession, Environment, RunFrom: String; + frm : TfrmUpdateCheck; + StatsCall: THttpDownload; + SessionPaths: TStringlist; + DlgResult: TModalResult; + Tab: TQueryTab; + SessionManager: TConnForm;} +begin + {// Check for connection parameters on commandline or show connections form. + if AppSettings.ReadBool(asUpdatecheck) then begin + // Do an updatecheck if checked in settings + LastUpdatecheck := StrToDateTimeDef(AppSettings.ReadString(asUpdatecheckLastrun), DateTimeNever); + UpdatecheckInterval := AppSettings.ReadInt(asUpdatecheckInterval); + if DaysBetween(Now, LastUpdatecheck) >= UpdatecheckInterval then begin + frm := TfrmUpdateCheck.Create(Self); + frm.btnCancel.Caption := _('Skip'); + try + frm.ReadCheckFile; + // Show the dialog if release is available, or - when wanted - build checks are activated + if (AppSettings.ReadBool(asUpdatecheckBuilds) and frm.btnBuild.Enabled) + or frm.LinkLabelRelease.Enabled then begin + frm.ShowModal; + end; + except + on E:Exception do + LogSQL(f_('Error when checking for updates: %s', [E.Message])); + end; + frm.Free; // FormClose has no caFree, as it may not have been called + end; + end;} + + {// Get all session names + SessionPaths := TStringList.Create; + AppSettings.GetSessionPaths('', SessionPaths);} + + {// Probably hide image + FHasDonatedDatabaseCheck := nbUnset; + ToolBarDonate.Visible := HasDonated(True) <> nbTrue;} + + {// Call user statistics if checked in settings + if AppSettings.ReadBool(asDoUsageStatistics) then begin + LastStatsCall := StrToDateTimeDef(AppSettings.ReadString(asLastUsageStatisticCall), DateTimeNever); + if DaysBetween(Now, LastStatsCall) >= 30 then begin + // Report used app version, bits, and theme name (so we find mostly unused ones for removal) + // Also report environment: WinDesktop, WinUWP or Wine + + if IsWine then Environment := 'Wine' + else if AppSettings.PortableMode then Environment := 'WinDesktopPortable' + else Environment := 'WinDesktop'; + + StatsCall := THttpDownload.Create(Self); + StatsCall.URL := APPDOMAIN + 'savestats.php?c=' + IntToStr(FAppVerRevision) + + '&bits=' + IntToStr(GetExecutableBits) + + '&thm=' + EncodeURLParam(TStyleManager.ActiveStyle.Name) + + '&env=' + EncodeURLParam(Environment) + + '&winver=' + EncodeURLParam(IntToStr(Win32MajorVersion)+'.'+IntToStr(Win32MinorVersion)); + // Enumerate actively used server versions + for i:=0 to SessionPaths.Count-1 do begin + AppSettings.SessionPath := SessionPaths[i]; + LastConnect := StrToDateTimeDef(AppSettings.ReadString(asLastConnect), DateTimeNever); + if LastConnect > LastStatsCall then begin + StatsCall.URL := StatsCall.URL + '&s[]=' + IntToStr(AppSettings.ReadInt(asNetType)) + '-' + IntToStr(AppSettings.ReadInt(asServerVersion)); + end; + end; + AppSettings.ResetPath; + try + StatsCall.SendRequest(''); + AppSettings.WriteString(asLastUsageStatisticCall, DateTimeToStr(Now)); + except + // Silently ignore it when the url could not be called over the network. + end; + FreeAndNil(StatsCall); + end; + end;} + + {ConnectionParams := nil; + RunFrom := ''; + ParseCommandLine(GetCommandLine, ConnectionParams, FileNames, RunFrom); + + // Delete scheduled task from previous + if RunFrom = 'scheduler' then begin + DeleteRestartTask; + if HasDonated(False) <> nbTrue then begin + apphelpers.ShellExec(APPDOMAIN + 'after-updatecheck?rev=' + AppVerRevision.ToString); + end; + end; + + if ConnectionParams <> nil then begin + // Minimal parameter for command line mode is hostname + try + InitConnection(ConnectionParams, True, Connection); + except on E:Exception do + ErrorDialog(E.Message); + end; + end else if AppSettings.ReadBool(asAutoReconnect) then begin + // Auto connection via preference setting + // Do not autoconnect if we're in commandline mode and the connection was not successful + LastSessions := Explode(DELIM, AppSettings.ReadString(asLastSessions)); + LastActiveSession := AppSettings.ReadString(asLastActiveSession); + for i:=LastSessions.Count-1 downto 0 do begin + if SessionPaths.IndexOf(LastSessions[i]) = -1 then + LastSessions.Delete(i); + end; + if LastSessions.Count > 0 then begin + if LastSessions.IndexOf(LastActiveSession) = -1 then + LastActiveSession := LastSessions[0]; + for i:=0 to LastSessions.Count-1 do begin + try + LoadedParams := TConnectionParameters.Create(LastSessions[i]); + InitConnection(LoadedParams, LastActiveSession=LastSessions[i], Connection); + except on E:Exception do + ErrorDialog(E.Message); + end; + end; + end; + end;} + + {// Display session manager + if Connections.Count = 0 then begin + // Cannot be done in OnCreate because we need ready forms here: + SessionManager := TConnForm.Create(Self); + DlgResult := mrCancel; + try + DlgResult := SessionManager.ShowModal; + SessionManager.Free; + except + // Work around VCL bug: Suppress access violation in TCustomForm.IsFormSizeStored + // when closing dialog via Alt+F4 + end; + if DlgResult = mrCancel then begin + Free; + Exit; + end; + end;} + + {// Restore backup'ed query tabs + if AppSettings.RestoreTabsInitValue then begin + TimerStoreTabs.Enabled := RestoreTabs; + end;} + + {// Load SQL file(s) by command line + if not RunQueryFiles(FileNames, nil, false) then begin + for i:=0 to FileNames.Count-1 do begin + Tab := GetOrCreateEmptyQueryTab(False); + Tab.LoadContents(FileNames[i], True, nil); + if i = FileNames.Count-1 then + SetMainTab(Tab.TabSheet); + end; + end;} + + MainFormAfterCreateDone := True; +end; + + +{function TMainForm.InitTabsIniFile: TIniFile; +var + WaitingSince: UInt64; + Attempts: Integer; + TabsIniFilename: String; +begin + // Try to open tabs.ini for writing or reading + // Taking multiple application instances into account + if AppSettings.PortableMode then + TabsIniFilename := ExtractFilePath(Application.ExeName) + 'tabs.ini' + else + TabsIniFilename := AppSettings.DirnameUserAppData + 'tabs.ini'; + WaitingSince := GetTickCount64; + Attempts := 0; + while not FileIsWritable(TabsIniFilename) do begin + if GetTickCount64 - WaitingSince > 3000 then + Raise Exception.Create(f_('Could not open file %s', [TabsIniFilename])); + Sleep(200); + Inc(Attempts); + end; + if Attempts > 0 then begin + LogSQL(Format('Had to wait %d ms before opening %s', [GetTickCount64 - WaitingSince, TabsIniFilename]), lcDebug); + end; + // Catch errors when file cannot be created + if not FileExists(TabsIniFilename) then begin + SaveUnicodeFile(TabsIniFilename, '', UTF8NoBOMEncoding); + end; + Result := TIniFile.Create(TabsIniFilename); +end;} + + +{procedure TMainForm.StoreTabs; +var + Tab: TQueryTab; + Section, TabCaption: String; + Sections: TStringList; + TabsIni: TIniFile; + SectionTabExists: Boolean; + pid: Cardinal; +begin + // Store query tab unsaved contents and setup, in tabs.ini + + try + TabsIni := InitTabsIniFile; + + for Tab in QueryTabs do begin + Tab.BackupUnsavedContent; + Section := Tab.Uid; + + // Avoid writing the tabs.ini file if nothing was effectively changed + TabCaption := Tab.TabSheet.Caption; + TabCaption := TabCaption.Trim([' ','*']); + if ExecRegExpr('^'+QuoteRegExprMetaChars(_('Query')+' #')+'\d+$', TabCaption) then + TabCaption := ''; + if TabsIni.ReadString(Section, TQueryTab.IdentBackupFilename, '') <> Tab.MemoBackupFilename then + TabsIni.WriteString(Section, TQueryTab.IdentBackupFilename, Tab.MemoBackupFilename); + if TabsIni.ReadString(Section, TQueryTab.IdentFilename, '') <> Tab.MemoFilename then + TabsIni.WriteString(Section, TQueryTab.IdentFilename, Tab.MemoFilename); + if TabsIni.ReadString(Section, TQueryTab.IdentCaption, '') <> TabCaption then + TabsIni.WriteString(Section, TQueryTab.IdentCaption, TabCaption); + if TabsIni.ReadInteger(Section, TQueryTab.IdentPid, 0) <> Integer(GetCurrentProcessId) then + TabsIni.WriteInteger(Section, TQueryTab.IdentPid, Integer(GetCurrentProcessId)); + if TabsIni.ReadInteger(Section, TQueryTab.IdentEditorHeight, 0) <> Tab.pnlMemo.Height then + TabsIni.WriteInteger(Section, TQueryTab.IdentEditorHeight, Tab.pnlMemo.Height); + if TabsIni.ReadInteger(Section, TQueryTab.IdentHelpersWidth, 0) <> Tab.pnlHelpers.Width then + TabsIni.WriteInteger(Section, TQueryTab.IdentHelpersWidth, Tab.pnlHelpers.Width); + if TabsIni.ReadString(Section, TQueryTab.IdentBindParams, '') <> Tab.ListBindParams.AsText then + TabsIni.WriteString(Section, TQueryTab.IdentBindParams, Tab.ListBindParams.AsText); + if TabsIni.ReadInteger(Section, TQueryTab.IdentEditorTopLine, 1) <> Tab.Memo.TopLine then + TabsIni.WriteInteger(Section, TQueryTab.IdentEditorTopLine, Tab.Memo.TopLine); + if TabsIni.ReadBool(Section, TQueryTab.IdentTabFocused, False) <> (Tab.TabSheet = Tab.TabSheet.PageControl.ActivePage) then + TabsIni.WriteBool(Section, TQueryTab.IdentTabFocused, (Tab.TabSheet = Tab.TabSheet.PageControl.ActivePage)); + if TabsIni.ReadString(Section, TQueryTab.IdentFileEncoding, 'UTF-8') <> Tab.FileEncoding then + TabsIni.WriteString(Section, TQueryTab.IdentFileEncoding, Tab.FileEncoding); + end; + + // Tabs with deleted backup files don't get restored anyway. But a section from a closed user loaded tab + // still needs to be erased. Otherwise it's loaded on next app start again. + Sections := TStringList.Create; + TabsIni.ReadSections(Sections); + for Section in Sections do begin + // Loop through local tabs + SectionTabExists := False; + for Tab in QueryTabs do begin + if Tab.Uid = Section then begin + SectionTabExists := True; + Break; + end; + end; + // Delete tab section if tab was closed and section belongs to this app instance + pid := Cardinal(TabsIni.ReadInteger(Section, TQueryTab.IdentPid, 0)); + if (not SectionTabExists) and (pid = GetCurrentProcessId) then begin + TabsIni.EraseSection(Section); + end; + end; + + // Close file + TabsIni.Free; + except + on E:Exception do begin + TimerStoreTabs.Enabled := False; + ErrorDialog(_('Storing tab setup failed'), + 'Tabs won''t be stored in this session.' + CRLF + CRLF + + E.Message + CRLF + CRLF + + SysErrorMessage(GetLastError) + ); + end; + end; +end;} + + +{function TMainForm.RestoreTabs: Boolean; +var + Tab: TQueryTab; + Sections, SlowTabs: TStringList; + Section, Filename, BackupFilename, TabCaption: String; + TabsIni: TIniFile; + pid: Cardinal; + EditorHeight, HelpersWidth, EditorTopLine: Integer; + BindParams: String; + TabFocused: Boolean; + TabLoadStart, TabLoadTime: UInt64; + Encoding: TEncoding; +const + SlowLoadMilliseconds = 5000; + + procedure CheckSlowTabLoad(CurTab: TQueryTab); + begin + TabLoadTime := GetTickCount64 - TabLoadStart; + if TabLoadTime > SlowLoadMilliseconds then begin + SlowTabs.Add('• ' + Trim(Tab.TabSheet.Caption) + ' (' + FormatTimeNumber(TabLoadTime / 1000, True) + ')'); + end; + end; +begin + // Restore query tab setup from tabs.ini + Result := True; + + try + TabsIni := InitTabsIniFile; + LogSQL('Restoring tab setup from '+TabsIni.FileName, lcDebug); + + Sections := TStringList.Create; + TabsIni.ReadSections(Sections); + SlowTabs := TStringList.Create; + + for Section in Sections do begin + TabLoadStart := GetTickCount64; + + Filename := TabsIni.ReadString(Section, TQueryTab.IdentFilename, ''); + BackupFilename := TabsIni.ReadString(Section, TQueryTab.IdentBackupFilename, ''); + TabCaption := TabsIni.ReadString(Section, TQueryTab.IdentCaption, ''); + pid := Cardinal(TabsIni.ReadInteger(Section, TQueryTab.IdentPid, 0)); + EditorHeight := TabsIni.ReadInteger(Section, TQueryTab.IdentEditorHeight, 0); + HelpersWidth := TabsIni.ReadInteger(Section, TQueryTab.IdentHelpersWidth, 0); + BindParams := TabsIni.ReadString(Section, TQueryTab.IdentBindParams, ''); + EditorTopLine := TabsIni.ReadInteger(Section, TQueryTab.IdentEditorTopLine, 1); + TabFocused := TabsIni.ReadBool(Section, TQueryTab.IdentTabFocused, False); + Encoding := GetEncodingByName(TabsIni.ReadString(Section, TQueryTab.IdentFileEncoding, 'UTF-8')); + + // Don't restore this tab if it belongs to a different running Heidi process + if (pid > 0) and (pid <> GetCurrentProcessId) and ProcessExists(pid, APPNAME) then begin + LogSQL(IfThen(BackupFilename.IsEmpty, Filename, BackupFilename)+' loaded in process #'+pid.ToString); + Continue; + end; + + // Either we have a backup file, or a user stored file. + // Both of them may not exist. + if not BackupFilename.IsEmpty then begin + if FileExists(BackupFilename) then begin + Tab := GetOrCreateEmptyQueryTab(False); + Tab.Uid := Section; + Tab.LoadContents(BackupFilename, True, Encoding); + Tab.MemoFilename := Filename; + Tab.Memo.Modified := True; + if not TabCaption.IsEmpty then + SetTabCaption(Tab.TabSheet.PageIndex, TabCaption); + if EditorHeight > 50 then + Tab.pnlMemo.Height := EditorHeight; + // Causes sporadic long-waiters: + //if HelpersWidth > 50 then + // Tab.pnlHelpers.Width := HelpersWidth; + Tab.ListBindParams.AsText := BindParams; + Tab.BindParamsActivated := Tab.ListBindParams.Count > 0; + Tab.Memo.TopLine := EditorTopLine; + if TabFocused then + SetMainTab(Tab.TabSheet); + CheckSlowTabLoad(Tab); + end else begin + // Remove tab section if backup file is gone or inaccessible for some reason + TabsIni.EraseSection(Section); + end; + end else if not Filename.IsEmpty then begin + if FileExists(Filename) then begin + Tab := GetOrCreateEmptyQueryTab(False); + Tab.Uid := Section; + Tab.LoadContents(Filename, True, Encoding); + Tab.MemoFilename := Filename; + if not TabCaption.IsEmpty then + SetTabCaption(Tab.TabSheet.PageIndex, TabCaption); + if EditorHeight > 50 then + Tab.pnlMemo.Height := EditorHeight; + // Causes sporadic long-waiters: + //if HelpersWidth > 50 then + // Tab.pnlHelpers.Width := HelpersWidth; + Tab.ListBindParams.AsText := BindParams; + Tab.BindParamsActivated := Tab.ListBindParams.Count > 0; + Tab.Memo.TopLine := EditorTopLine; + if TabFocused then + SetMainTab(Tab.TabSheet); + CheckSlowTabLoad(Tab); + end else begin + // Remove tab section if user stored file was deleted by user + TabsIni.EraseSection(Section); + end; + end; + + end; + + Sections.Free; + // Close file + TabsIni.Free; + + // Warn user about tabs which were loading slow + if SlowTabs.Count > 0 then begin + MessageDialog( + f_('%d tab(s) took longer than expected to restore. Closing and reopening these should fix that: %s', + [SlowTabs.Count, sLineBreak + sLineBreak + SlowTabs.Text]), + mtWarning, [mbOk]); + end; + SlowTabs.Free; + + except + on E:Exception do begin + Result := False; + ErrorDialog(_('Restoring tab setup failed'), + 'Tabs won''t be stored in this session.' + CRLF + CRLF + + E.Message + CRLF + CRLF + + SysErrorMessage(GetLastError) + ); + end; + end; +end;} + + +{procedure TMainForm.SetHintFontByControl(Control: TWinControl=nil); +var + UseFontName: String; +begin + // Set hint font name to match the underlying control + if Assigned(Control) and (Control is TSynMemo) then + UseFontName := TSynMemo(Control).Font.Name + else + UseFontName := FDefaultHintFontName; + if Screen.HintFont.Name <> UseFontName then + Screen.HintFont.Name := UseFontName; +end;} + + +{procedure TMainForm.TimerStoreTabsTimer(Sender: TObject); +begin + // Backup unsaved content every 10 seconds + StoreTabs; +end;} + + +procedure TMainForm.actSessionManagerExecute(Sender: TObject); +//var + //Dialog: TConnForm; +begin + //Dialog := TConnForm.Create(Self); + //Dialog.ShowModal; + //Dialog.Free; + ShowMessage('Showing session manager...'); +end; + +{procedure TMainForm.actDisconnectExecute(Sender: TObject); +var + Connection: TDBConnection; + Node: PVirtualNode; + DlgResult: Integer; + Dialog: TConnForm; +begin + // Disconnect active connection. If it's the last, exit application + Connection := ActiveConnection; + // Find and remove connection node from tree + Node := GetRootNode(DBtree, Connection); + DBTree.DeleteNode(Node); + FConnections.Remove(Connection); + // TODO: focus last session? + SelectNode(DBtree, GetNextNode(DBtree, nil)); + if FConnections.Count = 0 then begin + Dialog := TConnForm.Create(Self); + DlgResult := Dialog.ShowModal; + Dialog.Free; + if DlgResult = mrCancel then + actExitApplication.Execute; + end; +end;} + + +{procedure TMainForm.ConnectionsNotify(Sender: TObject; const Item: TDBConnection; Action: TCollectionNotification); +var + Results: TDBQuery; + Tab: TQueryTab; + ResultTab: TResultTab; + i: Integer; + Keys, NamesInKey: TStringList; + rx: TRegExpr; + ForceDeleteTableKey: Boolean; +begin + // Connection removed or added + case Action of + cnRemoved, cnExtracted: begin + // Post pending UPDATE and release current table with result + Results := GridResult(DataGrid); + if Assigned(Results) then begin + if Results.Modified then + actDataPostChangesExecute(DataGrid); + if DataGridResult = Results then begin + FreeAndNil(DataGridResult); + DataGridTable := nil; + end; + end; + + // Remove result sets which may cause AVs when disconnected + for Tab in QueryTabs do begin + if Assigned(Tab.QueryProfile) and (Tab.QueryProfile.Connection = Item) then + FreeAndNil(Tab.QueryProfile); + for ResultTab in Tab.ResultTabs do begin + if ResultTab.Results.Connection = Item then begin + Tab.ResultTabs.Clear; + Tab.tabsetQuery.Tabs.Clear; + break; + end; + end; + end; + for i:=0 to FHostListResults.Count-1 do begin + if (FHostListResults[i] <> nil) and (FHostListResults[i].Connection = Item) then begin + FHostListResults[i].Free; + FHostListResults[i] := nil; + end; + end; + + // Remove table keys if unwanted or empty + ForceDeleteTableKey := not AppSettings.ReadBool(asReuseEditorConfiguration); + AppSettings.SessionPath := Item.Parameters.SessionPath; + Keys := AppSettings.GetKeyNames; + rx := TRegExpr.Create; + rx.Expression := '.+'+QuoteRegExprMetaChars(DELIM)+'.+'; + for i:=0 to Keys.Count-1 do begin + if rx.Exec(Keys[i]) then begin + AppSettings.SessionPath := Item.Parameters.SessionPath + '\' + Keys[i]; + NamesInKey := AppSettings.GetValueNames; + if (NamesInKey.Count = 0) or ForceDeleteTableKey then begin + AppSettings.DeleteCurrentKey; + end; + end; + end; + rx.Free; + + FreeAndNil(ActiveObjectEditor); + RefreshHelperNode(TQueryTab.HelperNodeProfile); + RefreshHelperNode(TQueryTab.HelperNodeColumns); + + // Last chance to access connection related properties before disconnecting + + // Disconnect + Item.Active := False; + end; + + // New connection + cnAdded: DBTree.InsertNode(DBTree.GetLastChild(nil), amInsertAfter); + end; +end;} + + +{procedure TMainForm.actCreateDatabaseExecute(Sender: TObject); +begin + // Create database: + FCreateDatabaseDialog := TCreateDatabaseForm.Create(Self); + FCreateDatabaseDialog.ShowModal; + FreeAndNil(FCreateDatabaseDialog); +end;} + + +{procedure TMainForm.actImportCSVExecute(Sender: TObject); +var + Dialog: Tloaddataform; +begin + // Import Textfile + Dialog := Tloaddataform.Create(Self); + Dialog.ShowModal; + Dialog.Free; +end;} + +{procedure TMainForm.actPreferencesExecute(Sender: TObject); +begin + // Preferences + frmPreferences := TfrmPreferences.Create(Self); + if Sender = actPreferencesLogging then + frmPreferences.pagecontrolMain.ActivePage := frmPreferences.tabLogging + else if Sender = actPreferencesData then + frmPreferences.pagecontrolMain.ActivePage := frmPreferences.tabGridFormatting; + frmPreferences.ShowModal; + frmPreferences.Free; + frmPreferences := nil; // Important in SetupSynEditors +end;} + +{procedure TMainForm.actHelpExecute(Sender: TObject); +begin + // Display help document + Help(Sender, ''); +end;} + +{procedure TMainForm.FormResize(Sender: TObject); +var + PanelRect: TRect; + w0, w1, w2, w3, w4, w5, w6: Integer; + + function CalcPanelWidth(SampleText: String; MaxPercentage: Integer): Integer; + var + MaxPixels: Integer; + begin + MaxPixels := StatusBar.Canvas.TextWidth(SampleText) + VirtualImageListMain.Width + 20; + Result := Round(Min(MaxPixels, Width / 100 * MaxPercentage)); + end; +begin + // Exit early when user pressed "Cancel" on connection dialog + if csDestroying in ComponentState then + Exit; + // No need to resize anything if main window is minimized (= not visible) + if WindowState = wsMinimized then + Exit; + + // Super intelligent calculation of status bar panel width + w1 := CalcPanelWidth('r10 : c10 (10 KiB)', 10); + w2 := CalcPanelWidth('Connected: 1 day, 00:00 h', 10); + w3 := CalcPanelWidth('MariaDB or MySQL 5.7.6', 15); + w4 := CalcPanelWidth('Uptime: 13 days, 00:00 h', 15); + w5 := CalcPanelWidth('Server time: 20:00 ', 10); + w6 := CalcPanelWidth('DummyDummyDummyDummyDummy', 20); + w0 := StatusBar.Width - w1 - w2 - w3 - w4 - w5 - w6; + //logsql(format('IconWidth:%d 0:%d 1:%d 2:%d 3:%d 4:%d 5:%d 6:%d', [VirtualImageListMain.Width, w0, w1, w2, w3, w4, w5, w6])); + StatusBar.Panels[0].Width := w0; + StatusBar.Panels[1].Width := w1; + StatusBar.Panels[2].Width := w2; + StatusBar.Panels[3].Width := w3; + StatusBar.Panels[4].Width := w4; + StatusBar.Panels[5].Width := w5; + StatusBar.Panels[6].Width := w6; + + // Retreive the rectancle of the statuspanel (in our case the fifth panel) + if not IsWine then begin + SendMessage(StatusBar.Handle, SB_GETRECT, 5, Integer(@PanelRect)); + // Position the progressbar over the panel on the statusbar + ProgressBarStatus.SetBounds( + PanelRect.Left, + PanelRect.Top, + PanelRect.Right-PanelRect.Left, + PanelRect.Bottom-PanelRect.Top + ); + end; + + lblDataTop.Width := pnlDataTop.Width - tlbDataButtons.Width - 10; + FixQueryTabCloseButtons; + + // Right aligned button + // Do not set ToolBar.Align to alRight. See issue #1967 + if ToolBarDonate.Visible then begin + //ToolBarDonate.Width := ToolBarDonate.Buttons[0].Width; + ToolBarDonate.Left := ControlBarMain.Width - ToolBarDonate.Width; + //ToolBarDonate.Buttons[0].Height := ToolBarMainButtons.Buttons[0].Height; + end; + +end;} + +{procedure TMainForm.FormShow(Sender: TObject); +begin + // Window dimensions + if WindowState <> wsMaximized then begin + Width := AppSettings.ReadIntDpiAware(asMainWinWidth, Self); + Height := AppSettings.ReadIntDpiAware(asMainWinHeight, Self); + end; + + LogSQL(f_('Scaling controls to screen DPI: %d%%', [Round(ScaleFactor*100)])); + if TStyleManager.IsCustomStyleActive and (ScaleFactor<>1) then begin + LogSQL(f_('Caution: Style "%s" selected and non-default DPI factor - be aware that some styles appear broken with high DPI settings!', [TStyleManager.ActiveStyle.Name])); + end; + + + // Restore width of columns of all VirtualTrees + RestoreListSetup(ListDatabases); + RestoreListSetup(ListVariables); + RestoreListSetup(ListStatus); + RestoreListSetup(ListProcesses); + RestoreListSetup(ListCommandStats); + RestoreListSetup(ListTables); + + // Fix node height on Virtual Trees for current DPI settings + FixVT(DBTree); + FixVT(ListDatabases); + FixVT(ListVariables); + FixVT(ListStatus); + FixVT(ListProcesses); + FixVT(ListCommandStats); + FixVT(ListTables); + FixVT(treeQueryHelpers); + + // Manually set focus to tree - otherwise the database filter as the first + // control catches focus on startup, which is ugly. + if DBtree.CanFocus then + DBtree.SetFocus; + + // Apply resize event and call it once here in OnShow, when the form has its final dimensions + OnResize := FormResize; + OnResize(Sender); + + // Simulated link label, has non inherited blue font color + lblExplainProcess.Font.Color := clBlue; + + // Call once after all query tabs were created: + ValidateControls(Sender); +end;} + +{procedure TMainForm.AddEditorCommandMenu(const S: string); +begin + FEditorCommandStrings.Add(S); +end;} + +{procedure TMainForm.EditorCommandOnClick(Sender: TObject); +var + EditorCommand: TSynEditorCommand; + Editor: TSynMemo; +begin + EditorCommand := IndexToEditorCommand(TMenuItem(Sender).MenuIndex); + Editor := ActiveSynMemo(False); + if Assigned(Editor) then begin + Editor.BeginUndoBlock; + Editor.ExecuteCommand(EditorCommand, #0, nil); + Editor.EndUndoBlock; + end; +end;} + +{procedure TMainForm.actUserManagerExecute(Sender: TObject); +var + Dialog: TUserManagerForm; +begin + Dialog := TUserManagerForm.Create(Self); + Dialog.ShowModal; + Dialog.Free; +end;} + +{procedure TMainForm.actAboutBoxExecute(Sender: TObject); +var + Box: TAboutBox; +begin + // Info-Box + Box := TAboutBox.Create(Self); + Box.ShowModal; + Box.Free; +end;} + +{procedure TMainForm.actClearEditorExecute(Sender: TObject); +var + m: TSynMemo; +begin + if Sender = actClearQueryEditor then begin + m := QueryTabs.ActiveMemo + end else if Sender = actClearQueryLog then begin + m := SynMemoSQLLog; + m.Gutter.LineNumberStart := m.Gutter.LineNumberStart + m.Lines.Count; + end else begin + m := SynMemoFilter; + editFilterSearch.Clear; + end; + m.SelectAll; + m.SelText := ''; + m.SelStart := 0; + m.SelEnd := 0; + if Sender = actClearQueryEditor then begin + QueryTabs.ActiveTab.MemoFilename := ''; + QueryTabs.ActiveTab.Memo.Modified := False; + QueryTabs.ActiveTab.Uid := ''; + end; + if m = SynMemoFilter then begin + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); + end; +end;} + + +{procedure TMainForm.menuClearDataTabFilterClick(Sender: TObject); +begin + // Same as "Clear filter" button, but *before* the data tab is activated + AppSettings.SessionPath := GetRegKeyTable; + if AppSettings.ValueExists(asFilter) then begin + AppSettings.DeleteValue(asFilter); + LogSQL(f_('Data filter for %s deleted', [ActiveDbObj.Name]), lcInfo); + end; + if AppSettings.ValueExists(asSort) then begin + AppSettings.DeleteValue(asSort); + LogSQL(f_('Sort order for %s deleted', [ActiveDbObj.Name]), lcInfo); + end; +end;} + + +{procedure TMainForm.actTableToolsExecute(Sender: TObject); +var + Node: PVirtualNode; + DBObj: PDBObject; +begin + // Show table tools dialog + FTableToolsDialog := TfrmTableTools.Create(Self); + FTableToolsDialog.PreSelectObjects.Clear; + if DBTreeClicked(Sender) then + FTableToolsDialog.PreSelectObjects.Add(ActiveDbObj) + else begin + Node := GetNextNode(ListTables, nil, True); + while Assigned(Node) do begin + DBObj := ListTables.GetNodeData(Node); + FTableToolsDialog.PreSelectObjects.Add(DBObj^); + Node := GetNextNode(ListTables, Node, True); + end; + end; + if Sender = actMaintenance then + FTableToolsDialog.ToolMode := tmMaintenance + else if Sender = actFindTextOnServer then + FTableToolsDialog.ToolMode := tmFind + else if Sender = actExportTables then + FTableToolsDialog.ToolMode := tmSQLExport + else if Sender = actBulkTableEdit then + FTableToolsDialog.ToolMode := tmBulkTableEdit + else if Sender = actGenerateData then + FTableToolsDialog.ToolMode := tmGenerateData; + FTableToolsDialog.ShowModal; + FreeAndNil(FTableToolsDialog); +end;} + + +{procedure TMainForm.actUnixTimestampColumnExecute(Sender: TObject); +var + i: Integer; + FocusedColumnName: String; + GridColumn: TVirtualTreeColumn; +begin + // Mark focused column as UNIX timestamp column + AppSettings.SessionPath := GetRegKeyTable; + GridColumn := DataGrid.Header.Columns[DataGrid.FocusedColumn]; + FocusedColumnName := GridColumn.Text; + i := SelectedTableTimestampColumns.IndexOf(FocusedColumnName); + if i > -1 then + SelectedTableTimestampColumns.Delete(i); + if (Sender as TAction).Checked then begin + SelectedTableTimestampColumns.Add(FocusedColumnName); + if GridColumn.ImageIndex = -1 then + GridColumn.ImageIndex := 149; + end else begin + if GridColumn.ImageIndex = 149 then + GridColumn.ImageIndex := -1; + end; + if SelectedTableTimestampColumns.Count > 0 then + AppSettings.WriteString(asTimestampColumns, SelectedTableTimestampColumns.Text) + else if AppSettings.ValueExists(asTimestampColumns) then + AppSettings.DeleteValue(asTimestampColumns); + + AppSettings.ResetPath; + DataGrid.Invalidate; +end;} + + +{function TMainForm.HandleUnixTimestampColumn(Sender: TBaseVirtualTree; Column: TColumnIndex): Boolean; +var + ResultCol: Integer; +begin + // Shorthand for various places where we would normally have to add all these conditions + ResultCol := Column - 1; + Result := (Sender = DataGrid) + and (ResultCol > NoColumn) + and (DataGridResult <> nil) + and (DataGridResult.DataType(ResultCol).Category in [dtcInteger, dtcReal]) + and (SelectedTableTimestampColumns.IndexOf(DataGrid.Header.Columns[Column].Text) > -1); +end;} + + +{** + Edit view +} +{procedure TMainForm.actPrintListExecute(Sender: TObject); +var + f: TForm; +begin + // Print contents of a list or grid + f := TPrintlistForm.Create(Self); + f.ShowModal; + FreeAndNil(f); +end;} + + +{procedure TMainForm.actCopyTableExecute(Sender: TObject); +var + Dialog: TCopyTableForm; +begin + // copy table + Dialog := TCopyTableForm.Create(Self); + Dialog.ShowModal; + Dialog.Free; +end;} + + +{procedure TMainForm.actCopyTabsToSpacesExecute(Sender: TObject); +begin + // issue #1285: copy text with tabs converted to spaces + actCopyOrCutExecute(Sender); + Clipboard.TryAsText := StringReplace(Clipboard.TryAsText, #9, ' ', [rfReplaceAll]); +end;} + +{procedure TMainForm.actCopyUpdate(Sender: TObject); +begin + actCopyTabsToSpaces.Enabled := actCopy.Enabled; +end;} + +{procedure TMainForm.menuConnectionsPopup(Sender: TObject); +var + i: integer; + item: TMenuItem; + SessionPaths: TStringList; + Connection: TDBConnection; +begin + // Delete dynamically added connection menu items. + menuConnections.Items.Clear; + + // "Session manager" and "New window" items + item := TMenuItem.Create(menuConnections); + item.Action := actSessionManager; + item.Default := True; + menuConnections.Items.Add(item); + item := TMenuItem.Create(menuConnections); + item.Action := actNewWindow; + menuConnections.Items.Add(item); + item := TMenuItem.Create(menuConnections); + item.Caption := '-'; + menuConnections.Items.Add(item); + + // All sessions + SessionPaths := TStringList.Create; + AppSettings.GetSessionPaths('', SessionPaths); + for i:=0 to SessionPaths.Count-1 do begin + item := TMenuItem.Create(menuConnections); + item.Caption := EscapeHotkeyPrefix(SessionPaths[i]); + item.OnClick := SessionConnect; + for Connection in Connections do begin + if SessionPaths[i] = Connection.Parameters.SessionPath then begin + item.Checked := True; + break; + end; + end; + menuConnections.Items.Add(item); + end; + +end;} + + +{procedure TMainForm.MainMenuFileClick(Sender: TObject); +var + Item: TMenuItem; + i: Integer; + SessionPaths: TStringList; + Connection: TDBConnection; +begin + // Add all sessions to submenu + menuConnectTo.Clear; + SessionPaths := TStringList.Create; + AppSettings.GetSessionPaths('', SessionPaths); + for i:=0 to SessionPaths.Count-1 do begin + Item := TMenuItem.Create(menuConnectTo); + Item.Caption := EscapeHotkeyPrefix(SessionPaths[i]); + Item.OnClick := SessionConnect; + for Connection in Connections do begin + if SessionPaths[i] = Connection.Parameters.SessionPath then begin + Item.Checked := True; + break; + end; + end; + menuConnectTo.Add(Item); + end; +end;} + + +{procedure TMainForm.actWebbrowse(Sender: TObject); +begin + // Browse to URL (hint) + ShellExec( TAction(Sender).Hint ); +end;} + + +{procedure TMainForm.DonateClick(Sender: TObject); +var + Dialog: TWinControl; + place: String; +begin + // Click on one of the various donate buttons + if Sender is TWinControl then begin + Dialog := GetParentFormOrFrame(TWinControl(Sender)); + end else begin + Dialog := Self; + end; + if Dialog = nil then + ErrorDialog(f_('Could not determine parent form of this %s', [Sender.ClassName])) + else begin + place := LowerCase(Dialog.UnitName); + ShellExec(APPDOMAIN + 'donatebutton.php?place=' + EncodeURLParam(place)); + end; +end;} + + +{procedure TMainForm.actExportSettingsExecute(Sender: TObject); +var + Dialog: TSaveDialog; +begin + // Export settings to .txt file + Dialog := TSaveDialog.Create(Self); + Dialog.Title := f_('Export %s settings to file ...', [APPNAME]); + Dialog.DefaultExt := 'txt'; + Dialog.Filter := _('Text files')+' (*.txt)|*.txt|'+_('All files')+' (*.*)|*.*'; + Dialog.Options := Dialog.Options + [ofOverwritePrompt]; + if Dialog.Execute then try + AppSettings.ExportSettings(Dialog.FileName); + MessageDialog(f_('Settings successfully exported to %s', [Dialog.FileName]), mtInformation, [mbOK]); + except + on E:Exception do + ErrorDialog(E.Message); + end; + Dialog.Free; +end;} + + +{procedure TMainForm.actImportSettingsExecute(Sender: TObject); +var + Dialog: TOpenDialog; +begin + // Import settings from .txt or .reg file + Dialog := TOpenDialog.Create(Self); + Dialog.Title := f_('Import %s settings from file ...', [APPNAME]); + Dialog.Filter := _('Text files')+' (*.txt)|*.txt|'+_('Registry dump, deprecated')+' (*.reg)|*.reg|'+_('All files')+' (*.*)|*.*'; + ImportSettingsDone := False; + if Dialog.Execute then try + if LowerCase(ExtractFileExt(Dialog.FileName)) = 'reg' then + ShellExec('regedit.exe', '', '"'+Dialog.FileName+'"') + else begin + AppSettings.ImportSettings(Dialog.FileName); + MessageDialog(f_('Settings successfully restored from %s', [Dialog.FileName]), mtInformation, [mbOK]); + end; + ImportSettingsDone := True; + except + on E:Exception do + ErrorDialog(E.Message); + end; + Dialog.Free; +end;} + + +{function TMainForm.GetCurrentQuery(Tab: TQueryTab): String; +var + BatchAll: TSQLBatch; + Query, PrevQuery: TSQLSentence; +begin + // Return SQL query on cursor position + Result := ''; + BatchAll := TSQLBatch.Create; + BatchAll.SQL := Tab.Memo.Text; + PrevQuery := nil; + for Query in BatchAll do begin + if (Tab.Memo.SelStart >= Query.LeftOffset-1) and (Tab.Memo.SelStart < Query.RightOffset) then begin + Result := Query.SQL; + Tab.LeftOffsetInMemo := Query.LeftOffset; + break; + end; + PrevQuery := Query; + end; + // Prefer query left to the current one, if current one contains no text + if Trim(Result).IsEmpty and Assigned(PrevQuery) then begin + Result := PrevQuery.SQL; + Tab.LeftOffsetInMemo := PrevQuery.LeftOffset; + end; + BatchAll.Free; +end;} + + +{procedure TMainForm.actExecuteQueryExecute(Sender: TObject); +var + ProfileNode: PVirtualNode; + Batch: TSQLBatch; + Tab: TQueryTab; + BindParam: Integer; + NewSQL, msg, Command, SQLNoComments, CurrentQuery: String; + Query: TSQLSentence; + rx: TRegExpr; + ContainsUnsafeQueries, DoExecute: Boolean; +begin + Tab := QueryTabs.ActiveTab; + OperationRunning(True); + DoExecute := True; + + ShowStatusMsg(_('Splitting SQL queries ...')); + Batch := TSQLBatch.Create; + if Sender = actExecuteSelection then begin + Batch.SQL := Tab.Memo.SelText; + Tab.LeftOffsetInMemo := Tab.Memo.SelStart; + end else if Sender = actExecuteCurrentQuery then begin + Batch.SQL := GetCurrentQuery(Tab); + end else if Sender = actExplainCurrentQuery then begin + CurrentQuery := GetCurrentQuery(Tab); + if CurrentQuery.Trim.IsEmpty then begin + ErrorDialog(_('Current query is empty'), _('Please move the cursor inside the query you want to use.')); + DoExecute := False; + end else begin + Batch.SQL := 'EXPLAIN ' + CurrentQuery; + end; + end else begin + Batch.SQL := Tab.Memo.Text; + Tab.LeftOffsetInMemo := 0; + end; + + // Check if there is bind parameters + if (tab.ListBindParams.Count > 0) and DoExecute then begin + NewSQL := Batch.SQL; + // Replace all parameters by their values + // by descending to avoid having problems with similar variables name (eg test & test1) + for BindParam := tab.ListBindParams.Count-1 downto 0 do begin + // Do the Replace only if there is a value + if Length(tab.ListBindParams.Items[BindParam].Value)>0 then begin + NewSQL := StringReplace(NewSQL, + tab.ListBindParams.Items[BindParam].Name, + tab.ListBindParams.Items[BindParam].Value, + [rfReplaceAll]); + end; + end; + + Batch.SQL := NewSQL; + end; + + if AppSettings.ReadBool(asWarnUnsafeUpdates) and DoExecute then begin + ShowStatusMsg(_('Checking queries for unsafe UPDATEs/DELETEs ...')); + rx := TRegExpr.Create; + rx.ModifierI := True; + rx.Expression := '\sWHERE\s'; + ContainsUnsafeQueries := False; + for Query in Batch do begin + SQLNoComments := Query.SQLWithoutComments; + Command := UpperCase(getFirstWord(SQLNoComments)); + if ((Command = 'UPDATE') or (Command = 'DELETE')) and (not rx.Exec(SQLNoComments)) then begin + ContainsUnsafeQueries := True; + Break; + end; + end; + rx.Free; + if ContainsUnsafeQueries then begin + msg := _('Your query contains UPDATEs and/or DELETEs without a WHERE clause. Please confirm that you know what you''re doing.'); + DoExecute := MessageDialog(_('Run unsafe queries without a WHERE clause?'), msg, mtConfirmation, [mbYes, mbNo], asWarnUnsafeUpdates) = mrYes; + end; + end; + + + if DoExecute then begin + Screen.Cursor := crHourGlass; + EnableProgress(Batch.Count); + Tab.ResultTabs.Clear; + Tab.tabsetQuery.Tabs.Clear; + FreeAndNil(Tab.QueryProfile); + ProfileNode := FindNode(Tab.treeHelpers, TQueryTab.HelperNodeProfile, nil); + Tab.DoProfile := Assigned(ProfileNode) and (Tab.treeHelpers.CheckState[ProfileNode] in CheckedStates); + if Tab.DoProfile then try + ActiveConnection.Query('SET profiling=1'); + except + on E:EDbError do begin + ErrorDialog(f_('Query profiling requires %s or later, and the server must not be configured with %s.', ['MySQL 5.0.37', '--disable-profiling']), E.Message); + Tab.DoProfile := False; + end; + end; + + // Start the execution thread + Screen.Cursor := crAppStart; + ActiveConnection.Ping(True); // Prevents SynEdit paint exceptions if connection was killed outside + Tab.QueryRunning := True; + Tab.ExecutionThread := TQueryThread.Create(ActiveConnection, Batch, Tab.Number); + end; + + ValidateQueryControls(Sender); +end;} + + + +{procedure TMainForm.BeforeQueryExecution(Thread: TQueryThread); +begin + // Update GUI stuff + SetProgressPosition(Thread.BatchPosition); +end;} + + +{procedure TMainForm.AfterQueryExecution(Thread: TQueryThread); +var + Tab: TQueryTab; + NewTab: TResultTab; + col: TVirtualTreeColumn; + TabCaption, TabCaptions, BatchHead: String; + TabCaptionsList: TStringList; + TabsetColor: TColor; + Results: TDBQuery; + i, HeaderPadding, HeaderLineBreaks: Integer; +begin + // Single query or query packet has finished + + ShowStatusMsg(_('Setting up result grid(s) ...')); + Tab := QueryTabs.TabByNumber(Thread.TabNumber); + + // Use session color on result tabs + TabsetColor := Thread.Connection.Parameters.SessionColor; + if TabsetColor <> clNone then begin + Tab.tabsetQuery.SelectedColor := TabsetColor; + Tab.tabsetQuery.UnselectedColor := ColorAdjustLuma(TabsetColor, 20, False); + end + else begin + Tab.tabsetQuery.SelectedColor := clWindow; + Tab.tabsetQuery.UnselectedColor := clBtnFace; + end; + + // Get tab caption list from comment, similar to a name:xyz in a single query + BatchHead := Copy(Thread.Batch.SQL, 1, SIZE_KB); + TabCaptions := RegExprGetMatch('--\s+names\:\s*([^\r\n]+)', BatchHead, 1, False, True); + TabCaptionsList := Explode(',', TabCaptions); + LogSQL('TabCaptionsList: '+TabCaptionsList.CommaText, lcDebug); + // Create result tabs + for Results in Thread.Connection.GetLastResults do begin + NewTab := TResultTab.Create(Tab); + Tab.ResultTabs.Add(NewTab); + NewTab.Results := Results; + try + TabCaption := NewTab.Results.ResultName; + if TabCaption.IsEmpty and (TabCaptionsList.Count > NewTab.TabIndex) then + TabCaption := TabCaptionsList[NewTab.TabIndex]; + if TabCaption.IsEmpty then + TabCaption := NewTab.Results.TableName; + except + on E:EDbError do begin + TabCaption := _('Result')+' #'+IntToStr(NewTab.TabIndex+1); + end; + end; + TabCaption := Trim(TabCaption); + TabCaption := TabCaption + ' (' + FormatNumber(Results.RecordCount) + 'r × ' + FormatNumber(Results.ColumnCount) + 'c)'; + Tab.tabsetQuery.Tabs.Add(TabCaption); + NewTab.Grid.Name := Format('Tab%dGrid%d', [Tab.Number, NewTab.TabIndex+1]); + + NewTab.Grid.BeginUpdate; + NewTab.Grid.Header.Options := NewTab.Grid.Header.Options + [hoVisible]; + NewTab.Grid.Header.Columns.BeginUpdate; + NewTab.Grid.Header.Columns.Clear; + HeaderLineBreaks := 0; + HeaderPadding := NewTab.Grid.Header.Height - GetTextHeight(NewTab.Grid.Font); + col := NewTab.Grid.Header.Columns.Add; + col.CaptionAlignment := taRightJustify; + col.Alignment := taRightJustify; + col.Options := col.Options + [coFixed]- [coAllowClick, coAllowFocus, coEditable, coResizable]; + if not AppSettings.ReadBool(asShowRowId) then + col.Options := col.Options - [coVisible]; + col.Text := '#'; + for i:=0 to NewTab.Results.ColumnCount-1 do begin + col := NewTab.Grid.Header.Columns.Add; + col.Text := NewTab.Results.ColumnNames[i]; + if NewTab.Results.DataType(i).Category in [dtcInteger, dtcReal] then + col.Alignment := taRightJustify; + if NewTab.Results.ColIsPrimaryKeyPart(i) then + col.ImageIndex := ICONINDEX_PRIMARYKEY + else if NewTab.Results.ColIsUniqueKeyPart(i) then + col.ImageIndex := ICONINDEX_UNIQUEKEY + else if NewTab.Results.ColIsKeyPart(i) then + col.ImageIndex := ICONINDEX_INDEXKEY; + HeaderLineBreaks := Max(HeaderLineBreaks, col.text.CountChar(#10)); + end; + NewTab.Grid.Header.Columns.EndUpdate; + NewTab.Grid.Header.Height := GetTextHeight(NewTab.Grid.Font) * (HeaderLineBreaks+1) + HeaderPadding; + NewTab.Grid.RootNodeCount := NewTab.Results.RecordCount; + NewTab.Grid.EndUpdate; + for i:=0 to NewTab.Grid.Header.Columns.Count-1 do + AutoCalcColWidth(NewTab.Grid, i); + if Tab.tabsetQuery.TabIndex = -1 then + Tab.tabsetQuery.TabIndex := 0; + end; + ShowStatusMsg; +end;} + + +{procedure TMainForm.FinishedQueryExecution(Thread: TQueryThread); +var + Tab: TQueryTab; + MetaInfo, ErroneousSQL, RegName: String; + ProfileAllTime: Extended; + ProfileNode: PVirtualNode; + History: TQueryHistory; + HistoryItem: TQueryHistoryItem; + HistoryNum, RegItemsSize, KeepDays: Integer; + DoDelete, ValueFound: Boolean; + MinDate: TDateTime; + + procedure GoToErrorPos(Err: String); + var + rx: TRegExpr; + SelStart, ErrorPos: Integer; + ErrorCoord: TBufferCoord; + begin + // Try to set memo cursor to the relevant position + if Tab.LeftOffsetInMemo > 0 then + SelStart := Tab.LeftOffsetInMemo-1 + else + SelStart := Thread.Batch[Thread.BatchPosition].LeftOffset-1; + + // Extract erroneous portion of SQL out of error message + ErroneousSQL := ''; + rx := TRegExpr.Create; + rx.Expression := 'for the right syntax to use near ''(.+)'' at line (\d+)'; + if rx.Exec(Err) then + ErroneousSQL := rx.Match[1]; + rx.Expression := 'Duplicate entry ''([^'']+)'''; + if rx.Exec(Err) then + ErroneousSQL := rx.Match[1]; + rx.Free; + + if ErroneousSQL <> '' then begin + // Examine 1M of memo text at given offset + ErrorPos := Pos(ErroneousSQL, Copy(Tab.Memo.Text, SelStart, SIZE_MB)); + if ErrorPos > 0 then begin + Inc(SelStart, ErrorPos-1); + Tab.Memo.SelLength := 0; + Tab.Memo.SelStart := SelStart; + ErrorCoord := Tab.Memo.CharIndexToRowCol(SelStart); + Tab.ErrorLine := ErrorCoord.Line; + end; + end; + end; + +begin + // Find right query tab + Tab := QueryTabs.TabByNumber(Thread.TabNumber); + + // Error handling + if not Thread.ErrorMessage.IsEmpty then begin + SetProgressState(pbsError); + GoToErrorPos(Thread.ErrorMessage); + ErrorDialog(Thread.ErrorMessage); + end; + + // Gather meta info for logging + MetaInfo := _('Affected rows')+': '+FormatNumber(Thread.RowsAffected)+ + ' '+_('Found rows')+': '+FormatNumber(Thread.RowsFound)+ + ' '+_('Warnings')+': '+FormatNumber(Thread.WarningCount)+ + ' '+_('Duration for')+' ' + FormatNumber(Thread.BatchPosition); + if Thread.BatchPosition < Thread.Batch.Count then + MetaInfo := MetaInfo + ' ' + _('of') + ' ' + FormatNumber(Thread.Batch.Count); + if Thread.Batch.Count = 1 then + MetaInfo := MetaInfo + ' ' + _('query') + else + MetaInfo := MetaInfo + ' ' + _('queries'); + if Thread.QueryTime < 60*1000 then + MetaInfo := MetaInfo + ': '+FormatNumber(Thread.QueryTime/1000, 3) +' ' + _('sec.') + else + MetaInfo := MetaInfo + ': '+FormatTimeNumber(Thread.QueryTime/1000, True); + if Thread.QueryNetTime > 0 then + MetaInfo := MetaInfo + ' (+ '+FormatNumber(Thread.QueryNetTime/1000, 3) +' ' + _('sec.') + ' ' + _('network') + ')'; + LogSQL(MetaInfo); + + // Display query profile + if Tab.DoProfile then begin + Tab.QueryProfile := Thread.Connection.GetResults('SHOW PROFILE'); + Tab.ProfileTime := 0; + Tab.MaxProfileTime := 0; + while not Tab.QueryProfile.Eof do begin + ProfileAllTime := MakeFloat(Tab.QueryProfile.Col(1)); + Tab.ProfileTime := Tab.ProfileTime + ProfileAllTime; + Tab.MaxProfileTime := Max(Time, Tab.MaxProfileTime); + Tab.QueryProfile.Next; + end; + ProfileNode := FindNode(Tab.treeHelpers, TQueryTab.HelperNodeProfile, nil); + Tab.treeHelpers.ReinitNode(ProfileNode, True); + Tab.treeHelpers.InvalidateChildren(ProfileNode, True); + Thread.Connection.Query('SET profiling=0'); + end; + + // Store successful query packet in history if it's not a batch. + // Assume that a bunch of up to 5 queries is not a batch. + AppSettings.ResetPath; + if AppSettings.ReadBool(asQueryHistoryEnabled) + and Thread.ErrorMessage.IsEmpty + and (Thread.Batch.Count <= 5) + and (Thread.Batch.Size <= SIZE_MB) + then begin + ShowStatusMsg(_('Updating query history ...')); + KeepDays := AppSettings.ReadInt(asQueryHistoryKeepDays); + + // Load all items so we can clean up + History := TQueryHistory.Create(Thread.Connection.Parameters.SessionPath); + + // Find lowest unused item number + HistoryNum := 0; + while True do begin + Inc(HistoryNum); + RegName := IntToStr(HistoryNum); + ValueFound := False; + for HistoryItem in History do begin + if HistoryItem.RegValue = HistoryNum then begin + ValueFound := True; + Break; + end; + end; + if not ValueFound then + break; + end; + + // Delete identical history items to avoid spam + // Delete old items + // Delete items which exceed a max datasize barrier + AppSettings.SessionPath := Thread.Connection.Parameters.SessionPath + '\' + REGKEY_QUERYHISTORY; + MinDate := IncDay(Now, -KeepDays); + RegItemsSize := Thread.Batch.Size; + for HistoryItem in History do begin + Inc(RegItemsSize, Length(HistoryItem.SQL)); + DoDelete := (HistoryItem.SQL = Thread.Batch.SQL) + or (HistoryItem.Time < MinDate) + or (RegItemsSize > SIZE_MB); + if DoDelete then + AppSettings.DeleteValue(IntToStr(HistoryItem.RegValue)); + end; + History.Free; + + // Store history item and closing registry key to ensure writing has finished + try + AppSettings.WriteString(RegName, DateTimeToStr(Now) + DELIM + + Thread.Connection.Database + DELIM + + IntToStr(Thread.QueryTime+Thread.QueryNetTime) + DELIM + + Thread.Batch.SQL); + except + // Silence sporadic boring write errors. See http://www.heidisql.com/forum.php?t=13088 + on E:ERegistryException do + LogSQL(f_('Error when updating query history: %s', [E.Message]), lcError); + end; + + RefreshHelperNode(TQueryTab.HelperNodeHistory); + end; + + // Clean up + DisableProgress; + Tab.QueryRunning := False; + ValidateControls(Thread); + OperationRunning(False); + Screen.Cursor := crDefault; + ShowStatusMsg; +end;} + + +{procedure TMainForm.tabsetQueryClick(Sender: TObject); +var + QueryTab: TQueryTab; + i: Integer; +begin + // Result tab clicked / changed + Screen.Cursor := crHourGlass; + QueryTab := nil; + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i].tabsetQuery = Sender then begin + QueryTab := QueryTabs[i]; + break; + end; + end; + for i:=0 to QueryTab.ResultTabs.Count-1 do + QueryTab.ResultTabs[i].Grid.Hide; + if QueryTab.ActiveResultTab <> nil then begin + QueryTab.ActiveResultTab.Grid.Show; + // Reset filter if filter panel was disabled + UpdateFilterPanel(Sender); + end; + // Ensure controls are in a valid state + ValidateControls(Sender); + Screen.Cursor := crDefault; + ShowStatusMsg; +end;} + + +{procedure TMainForm.tabsetQueryGetImageIndex(Sender: TObject; TabIndex: Integer; + var ImageIndex: Integer); +begin + // Give result tabs of editable results a table icon + try + QueryTabs.ActiveTab.ResultTabs[TabIndex].Results.TableName; + ImageIndex := 14; + except + ImageIndex := -1; + end; +end;} + + +{procedure TMainForm.actExportDataExecute(Sender: TObject); +var + ExportDialog: TfrmExportGrid; +begin + // Save data in current dataset into various text file formats + ExportDialog := TfrmExportGrid.Create(Self); + ExportDialog.Grid := ActiveGrid; + ExportDialog.ShowModal; + ExportDialog.Free; +end;} + + +{procedure TMainForm.actDataPreviewUpdate(Sender: TObject); +var + Grid: TVirtualStringTree; +begin + // Enable or disable ImageView action + Grid := ActiveGrid; + (Sender as TAction).Enabled := (Grid <> nil) + and (Grid.FocusedColumn <> NoColumn) + and (GridResult(Grid).DataType(Grid.FocusedColumn-1).Category = dtcBinary) +end;} + + +{procedure TMainForm.actDataPreviewExecute(Sender: TObject); +var + MakeVisible: Boolean; +begin + // Show or hide preview area + actDataPreview.Checked := not actDataPreview.Checked; + MakeVisible := actDataPreview.Checked; + pnlPreview.Visible := MakeVisible; + spltPreview.Visible := MakeVisible; + if MakeVisible then + UpdatePreviewPanel; +end;} + + +{procedure TMainForm.UpdatePreviewPanel; +var + Grid: TVirtualStringTree; + Results: TDBQuery; + RowNum: PInt64; + ImgType: String; + Content, Header: AnsiString; + ContentStream: TMemoryStream; + StrLen, ResultCol: Integer; + Graphic: TGraphic; +begin + // Load BLOB contents into preview area + Grid := ActiveGrid; + Results := GridResult(Grid); + if not Assigned(Results) then + Exit; + ResultCol := Grid.FocusedColumn -1; + if ResultCol < 0 then + Exit; + Screen.Cursor := crHourGlass; + try + ShowStatusMsg(_('Loading contents into image viewer ...')); + lblPreviewTitle.Caption := _('Loading ...'); + lblPreviewTitle.Repaint; + imgPreview.Picture := nil; + AnyGridEnsureFullRow(Grid, Grid.FocusedNode); + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; + + Content := AnsiString(Results.Col(ResultCol)); + StrLen := Results.ColumnLengths(ResultCol); + ContentStream := TMemoryStream.Create; + ContentStream.Write(Content[1], StrLen); + ContentStream.Position := 0; + Graphic := nil; + ContentStream.Position := 0; + ImgType := 'UnknownType'; + Header := Copy(Content, 1, 50); + if Copy(Header, 7, 4) = 'JFIF' then begin + ImgType := 'JPEG'; + Graphic := TJPEGImage.Create; + end else if Copy(Header, 1, 3) = 'GIF' then begin + ImgType := 'GIF'; + Graphic := TGIFImage.Create; + end else if Copy(Header, 1, 2) = 'BM' then begin + ImgType := 'BMP'; + Graphic := TBitmap.Create; + end else if Copy(Header, 2, 3) = 'PNG' then begin + ImgType := 'PNG'; + Graphic := TPngImage.Create; + end; + if Assigned(Graphic) then begin + try + Graphic.LoadFromStream(ContentStream); + imgPreview.Picture.Graphic := Graphic; + lblPreviewTitle.Caption := ImgType+': '+ + IntToStr(Graphic.Width)+' x '+IntToStr(Graphic.Height)+' pixels, 100%, '+ + FormatByteNumber(StrLen); + spltPreview.OnMoved(spltPreview); + except + on E:Exception do + lblPreviewTitle.Caption := ImgType+': ' + E.Message + ' ('+E.ClassName+')'; + end; + FreeAndNil(ContentStream); + end else + lblPreviewTitle.Caption := f_('No image detected, %s', [FormatByteNumber(StrLen)]); + finally + lblPreviewTitle.Hint := lblPreviewTitle.Caption; + ShowStatusMsg; + Screen.Cursor := crDefault; + end; +end;} + + +{procedure TMainForm.pnlLeftResize(Sender: TObject); +var + WidthAvail: Integer; +begin + WidthAvail := editDatabaseFilter.Parent.Width - btnTreeFavorites.Width; + editDatabaseFilter.Left := 0; + editDatabaseFilter.Width := (WidthAvail div 2) - 1; + editTableFilter.Width := editDatabaseFilter.Width; + editTableFilter.Left := editDatabaseFilter.Width + 1; + btnTreeFavorites.Left := editTableFilter.Left + editTableFilter.Width + 1; + spltPreview.OnMoved(Sender); +end;} + + +{procedure TMainForm.spltPreviewMoved(Sender: TObject); +var + rx: TRegExpr; + ZoomFactorW, ZoomFactorH: Integer; +begin + // Do not overscale image so it's never zoomed to more than 100% + if (imgPreview.Picture.Graphic = nil) or (imgPreview.Picture.Graphic.Empty) then + Exit; + imgPreview.Stretch := (imgPreview.Picture.Width > imgPreview.Width) or (imgPreview.Picture.Height > imgPreview.Height); + ZoomFactorW := Trunc(Min(imgPreview.Picture.Width, imgPreview.Width) / imgPreview.Picture.Width * 100); + ZoomFactorH := Trunc(Min(imgPreview.Picture.Height, imgPreview.Height) / imgPreview.Picture.Height * 100); + rx := TRegExpr.Create; + rx.Expression := '(\D)(\d+%)';} + //lblPreviewTitle.Caption := rx.Replace(lblPreviewTitle.Caption, '${1}'+IntToStr(Min(ZoomFactorH, ZoomFactorW))+'%', true); + {lblPreviewTitle.Hint := lblPreviewTitle.Caption; + rx.Free; +end;} + + +{procedure TMainForm.actDataSaveBlobToFileExecute(Sender: TObject); +var + Grid: TVirtualStringTree; + Results: TDBQuery; + RowNum: PInt64; + Content: AnsiString; + FileStream: TFileStream; + StrLen: Integer; + Dialog: TSaveDialog; +begin + // Save BLOB to local file + Grid := ActiveGrid; + Results := GridResult(Grid); + Dialog := TSaveDialog.Create(Self); + Dialog.Filter := _('All files')+' (*.*)|*.*'; + Dialog.FileName := Results.ColumnOrgNames[Grid.FocusedColumn-1]; + if not (Results.DataType(Grid.FocusedColumn-1).Category in [dtcBinary, dtcSpatial]) then + Dialog.FileName := Dialog.FileName + '.txt'; + if Dialog.Execute then begin + Screen.Cursor := crHourGlass; + AnyGridEnsureFullRow(Grid, Grid.FocusedNode); + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; + if Results.DataType(Grid.FocusedColumn-1).Category in [dtcBinary, dtcSpatial] then + Content := AnsiString(Results.Col(Grid.FocusedColumn-1)) + else + Content := Utf8Encode(Results.Col(Grid.FocusedColumn-1)); + StrLen := Length(Content); + try + FileStream := TFileStream.Create(Dialog.FileName, fmCreate or fmOpenWrite); + FileStream.Write(Content[1], StrLen); + except on E:Exception do + ErrorDialog(E.Message); + end; + FreeAndNil(FileStream); + Screen.Cursor := crDefault; + end; + Dialog.Free; +end;} + + +{procedure TMainForm.actInsertFilesExecute(Sender: TObject); +var + Dialog: TfrmInsertFiles; +begin + Dialog := TfrmInsertFiles.Create(Self); + Dialog.ShowModal; + Dialog.Free; +end;} + +// Drop Table(s) +{procedure TMainForm.actDropObjectsExecute(Sender: TObject); +var + msg, db: String; + Node: PVirtualNode; + Obj: PDBObject; + DBObject: TDBObject; + ObjectList: TDBObjectList; + Editor: TDBObjectEditor; + Conn: TDBConnection; +begin + Conn := ActiveConnection; + + ObjectList := TDBobjectList.Create(TDBObjectDropComparer.Create, False); + + if DBTreeClicked(Sender) then begin + // drop table selected in tree view. + DBObject := ActiveDBObj; + case DBObject.NodeType of + lntDb: begin + if MessageDialog(f_('Drop Database "%s"?', [DBObject.Database]), f_('WARNING: You will lose all objects in database %s!', [DBObject.Database]), mtCriticalConfirmation, [mbok,mbcancel]) <> mrok then + Abort; + try + db := DBObject.Database; + Node := FindDBNode(DBtree, Conn, db); + SetActiveDatabase('', Conn); + Conn.Query(Conn.GetSQLSpecifity(spDatabaseDrop, [Conn.QuoteIdent(db)])); + DBtree.DeleteNode(Node); + Conn.ClearDbObjects(db); + Conn.RefreshAllDatabases; + InvalidateVT(ListDatabases, VTREE_NOTLOADED_PURGECACHE, False); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + Exit; + end; + lntTable..lntEvent: ObjectList.Add(ActiveDBObj); + end; + end else begin + // Invoked from database tab + Node := GetNextNode(ListTables, nil, True); + while Assigned(Node) do begin + Obj := ListTables.GetNodeData(Node); + ObjectList.Add(Obj^); + Node := GetNextNode(ListTables, Node, True); + end; + end; + + // Fix actions temporarily enabled for popup menu. + ValidateControls(Sender); + + // Safety stop to avoid firing DROP TABLE without tablenames + if ObjectList.Count = 0 then + Exit; + + // Ask user for confirmation to drop selected objects + ObjectList.Sort; + msg := ''; + for DBObject in ObjectList do + msg := msg + DBObject.Name + ', '; + Delete(msg, Length(msg)-1, 2); + if MessageDialog(f_('Drop %d object(s) in database "%s"?', [ObjectList.Count, Conn.Database]), msg, mtCriticalConfirmation, [mbok,mbcancel]) = mrOk then begin + try + // Disable foreign key checks to avoid SQL errors + if Conn.Has(frForeignKeyChecksVar) then + Conn.Query('SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0'); + // Compose and run DROP [TABLE|VIEW|...] queries + Editor := ActiveObjectEditor; + for DBObject in ObjectList do begin + DBObject.Drop; + if Assigned(Editor) and Editor.Modified and Editor.DBObject.IsSameAs(DBObject) then + Editor.Modified := False; + end; + if Conn.Has(frForeignKeyChecksVar) then + Conn.Query('SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS'); + // Refresh ListTables + dbtree so the dropped tables are gone: + Conn.ClearDbObjects(ActiveDatabase); + RefreshTree; + SetActiveDatabase(Conn.Database, Conn); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + ObjectList.Free; + end; +end;} + + +{procedure TMainForm.actLaunchCommandlineExecute(Sender: TObject); +var + path, p, log, cmd: String; + sep: Char; + Conn: TDBConnection; +begin + // Launch mysql.exe + Conn := ActiveConnection; + if not Conn.Parameters.IsAnyMySQL then + ErrorDialog(_('Command line only works on MySQL connections.')) + else begin + if IsWine then begin + cmd := 'mysql'; + sep := '/'; + end else begin + cmd := 'mysql.exe'; + sep := '\'; + end; + path := AppSettings.ReadString(asMySQLBinaries); + if (Length(path)>0) and (path[Length(path)] <> sep) then + path := path + sep; + if not FileExists(path+cmd, true) then begin + ErrorDialog(f_('You need to tell %s where your MySQL binaries reside, in %s > %s > %s.', [APPNAME, _('Tools'), _('Preferences'), _('General')])+ + CRLF+CRLF+f_('Current setting is: "%s"', [path])); + end else begin + p := ''; + if IsWine then begin + p := ' -e '+path+cmd; + path := ''; + cmd := '$TERM'; + end; + + log := path + cmd + p + Conn.Parameters.GetExternalCliArguments(Conn, nbTrue); + LogSQL(f_('Launching command line: %s', [log]), lcInfo); + + p := p + Conn.Parameters.GetExternalCliArguments(Conn, nbFalse); + ShellExec(cmd, path, p); + end; + end; +end;} + + +// Load SQL-file, make sure that SheetQuery is activated +{procedure TMainForm.actLoadSQLExecute(Sender: TObject); +var + i, ProceedResult: Integer; + Dialog: TExtFileOpenDialog; + Encoding: TEncoding; + Tab: TQueryTab; +begin + AppSettings.ResetPath; + Dialog := TExtFileOpenDialog.Create(Self); + Dialog.Options := Dialog.Options + [fdoAllowMultiSelect]; + Dialog.AddFileType('*.sql', _('SQL files')); + Dialog.AddFileType('*.*', _('All files')); + Dialog.DefaultExtension := 'sql'; + Dialog.Encodings.Assign(FileEncodings); + Dialog.EncodingIndex := AppSettings.ReadInt(asFileDialogEncoding, Self.Name); + if Dialog.Execute then begin + Encoding := GetEncodingByName(Dialog.Encodings[Dialog.EncodingIndex]); + if Encoding = nil then begin + ProceedResult := MessageDialog(_('Really auto-detect file encoding?') + SLineBreak + SLineBreak + + _('Auto detecting the encoding of a file is highly discouraged. You may experience data loss if the detection fails.') + SLineBreak + SLineBreak + + _('To avoid this message select the correct encoding before pressing Open.'), + mtConfirmation, [mbYes, mbCancel]); + end else begin + ProceedResult := mrYes; + end; + + if ProceedResult = mrYes then begin + if not RunQueryFiles(Dialog.Files, Encoding, Sender=actRunSQL) then begin + for i:=0 to Dialog.Files.Count-1 do begin + Tab := GetOrCreateEmptyQueryTab(False); + Tab.LoadContents(Dialog.Files[i], True, Encoding); + if i = Dialog.Files.Count-1 then + SetMainTab(Tab.TabSheet); + end; + end; + end; + AppSettings.WriteInt(asFileDialogEncoding, Dialog.EncodingIndex, Self.Name); + end; + Dialog.Free; +end;} + + +{function TMainForm.RunQueryFiles(Filenames: TStrings; Encoding: TEncoding; ForceRun: Boolean): Boolean; +var + i, FilesProcessed: Integer; + Filesize, FilesizeSum, CurrentPosition: Int64; + StartTime: UInt64; + msgtext: String; + AbsentFiles, PopupFileList: TStringList; + DoRunFiles: Boolean; + Dialog: TTaskDialog; + Btn: TTaskDialogButtonItem; + DialogResult: TModalResult; + Conn: TDBConnection; + ProgressDialog: IProgressDialog; + Dummy: Pointer; + TimeElapsed: Double; + RunSuccess: Boolean; +const + RunFileSize = 5*SIZE_MB; +begin + // Ask for execution when loading big files, or return false + Result := False; + + // Remove non existant files + AbsentFiles := TStringList.Create; + for i:=Filenames.Count-1 downto 0 do begin + if not FileExists(Filenames[i]) then begin + AbsentFiles.Add(Filenames[i]); + Filenames.Delete(i); + end; + end; + // Check if one or more files are large + DoRunFiles := ForceRun; + PopupFileList := TStringList.Create; + FilesizeSum := 0; + for i:=0 to Filenames.Count-1 do begin + FileSize := _GetFileSize(Filenames[i]); + Inc(FilesizeSum, Filesize); + PopupFileList.Add(ExtractFilename(Filenames[i]) + ' (' + FormatByteNumber(FileSize) + ')'); + DoRunFiles := DoRunFiles or (FileSize > RunFileSize); + end; + + if DoRunFiles then begin + if ForceRun then begin + // Don't ask, just run files + DialogResult := mrYes; + end else if (Win32MajorVersion >= 6) and StyleServices.Enabled then begin + Dialog := TTaskDialog.Create(Self); + Dialog.Caption := _('Opening large files'); + Dialog.Text := f_('Selected files have a size of %s', [FormatByteNumber(FilesizeSum, 1)]); + Dialog.ExpandButtonCaption := _('File list'); + Dialog.ExpandedText := PopupFileList.Text; + Dialog.Flags := [tfUseCommandLinks, tfExpandFooterArea]; + Dialog.CommonButtons := []; + Dialog.MainIcon := tdiWarning; + Btn := TTaskDialogButtonItem(Dialog.Buttons.Add); + Btn.Caption := _('Run file(s) directly'); + Btn.CommandLinkHint := _('... without loading into the editor'); + Btn.ModalResult := mrYes; + Btn := TTaskDialogButtonItem(Dialog.Buttons.Add); + Btn.Caption := _('Load file(s) into the editor'); + Btn.CommandLinkHint := _('Can cause large memory usage'); + Btn.ModalResult := mrNo; + Btn := TTaskDialogButtonItem(Dialog.Buttons.Add); + Btn.Caption := _('Cancel'); + Btn.ModalResult := mrCancel; + Dialog.Execute; + DialogResult := Dialog.ModalResult; + Dialog.Free; + end else begin + msgtext := f_('One or more of the selected files are larger than %s:', [FormatByteNumber(RunFileSize, 0)]) + CRLF + + Implode(CRLF, PopupFileList) + CRLF + CRLF + + _('Just run these files to avoid loading them into the query-editor (= memory)?') + CRLF + CRLF + + _('Press') + CRLF + + _(' [Yes] to run file(s) without loading it into the editor') + CRLF + + _(' [No] to load file(s) into the query editor') + CRLF + + _(' [Cancel] to cancel file opening.'); + DialogResult := MessageDialog(_('Execute query file(s)?'), msgtext, mtWarning, [mbYes, mbNo, mbCancel]); + end; + + case DialogResult of + mrYes: begin + Result := True; + // progress start + ProgressDialog := CreateComObject(CLSID_ProgressDialog) as IProgressDialog; + Dummy := nil; + CurrentPosition := 0; + FilesProcessed := 0; + StartTime := GetTickCount64; + Conn := ActiveConnection; + RunSuccess := False; + // PROGDLG_MODAL was used previously, but somehow that focuses some other application + ProgressDialog.StartProgressDialog(Handle, nil, PROGDLG_NOMINIMIZE or PROGDLG_AUTOTIME, Dummy); + for i:=0 to Filenames.Count-1 do begin + RunSuccess := RunQueryFile(Filenames[i], Encoding, Conn, ProgressDialog, FilesizeSum, CurrentPosition); + // Add filename to history menu + if Pos(AppSettings.DirnameSnippets, Filenames[i]) = 0 then + MainForm.AddOrRemoveFromQueryLoadHistory(Filenames[i], True, True); + Inc(FilesProcessed); + if not RunSuccess then + Break; + end; + // progress end + ProgressDialog.StopProgressDialog; + TimeElapsed := GetTickCount64 - StartTime; + LogSQL(f_('%s file(s) processed, in %s', [FormatNumber(FilesProcessed), FormatTimeNumber(TimeElapsed/1000, True)])); + if RunSuccess then + MessageBeep(MB_OK) + else + MessageBeep(MB_ICONERROR); + end; + mrNo: Result := False; + mrCancel: Result := True; + end; + end; + + if AbsentFiles.Count > 0 then + ErrorDialog(_('Could not load file(s):'), AbsentFiles.Text); + AbsentFiles.Free; + PopupFileList.Free; +end;} + + +{function TMainForm.RunQueryFile(FileName: String; Encoding: TEncoding; Conn: TDBConnection; + ProgressDialog: IProgressDialog; FilesizeSum: Int64; var CurrentPosition: Int64): Boolean; +var + Dummy: Pointer; + Stream: TFileStream; + Lines, LinesRemain, ErrorNotice: String; + Filesize, QueryCount, ErrorCount, RowsAffected: Int64; + Queries: TSQLBatch; + i: Integer; + + procedure StopProgress; + var + MessageText: String; + begin + ProgressDialog.SetLine(1, PChar(_('Clean up ...')), False, Dummy); + Queries.Free; + try + Stream.Free; + except; // Eat error when stream wasn't yet created properly + end; + // BringToFront; // Not sure why I added this initially, but it steals focus from other applications + if ProgressDialog.HasUserCancelled then + MessageText := 'File "%s" partially executed, with %s queries and %s affected rows' + else + MessageText := 'File "%s" executed, with %s queries and %s affected rows'; + LogSQL(f_(MessageText, [ExtractFileName(FileName), FormatNumber(QueryCount), FormatNumber(RowsAffected)])); + end; + +begin + // Import single SQL file and display progress dialog + ProgressDialog.SetTitle(PChar(f_('Importing file %s', [ExtractFileName(FileName)]))); + Dummy := nil; + + Result := True; + Lines := ''; + ErrorNotice := ''; + QueryCount := 0; + ErrorCount := 0; + RowsAffected := 0; + LinesRemain := ''; + Queries := TSQLBatch.Create; + + try + // Start file operations + Filesize := _GetFileSize(FileName); + + OpenTextfile(FileName, Stream, Encoding); + while Stream.Position < Stream.Size do begin + if ProgressDialog.HasUserCancelled then + Break; + + // Read lines from SQL file until buffer reaches a limit of some MB + // This strategy performs vastly better than looping through each line + ProgressDialog.SetLine(1, PChar(_('Reading next chunk from file...')), False, Dummy); + Lines := ReadTextfileChunk(Stream, Encoding, 20*SIZE_MB); + + // Split buffer into single queries + ProgressDialog.SetLine(1, PChar(_('Splitting queries...')), False, Dummy); + Queries.SQL := LinesRemain + Lines; + Lines := ''; + LinesRemain := ''; + + // Execute detected queries + for i:=0 to Queries.Count-1 do begin + if ProgressDialog.HasUserCancelled then + Break; + // Last line has to be processed in next loop if end of file is not reached + if (i = Queries.Count-1) and (Stream.Position < Stream.Size) then begin + LinesRemain := Queries[i].SQL; + Break; + end; + Inc(QueryCount); + Inc(CurrentPosition, Encoding.GetByteCount(Queries[i].SQL)); + if ErrorCount > 0 then + ErrorNotice := '(' + FormatNumber(ErrorCount) + ' ' + _('Errors') + ')'; + ProgressDialog.SetLine(1, + PChar(f_('Processing query #%s. %s', [FormatNumber(QueryCount), ErrorNotice])), + False, + Dummy + ); + ProgressDialog.SetLine(2, + PChar(f_('Position in file: %s / %s. Affected rows: %s.', [FormatByteNumber(CurrentPosition), FormatByteNumber(Filesize), FormatNumber(RowsAffected)])), + False, + Dummy + ); + ProgressDialog.SetProgress64(CurrentPosition, FilesizeSum); + + // Execute single query + // Break or don't break loop, depending on the state of "Stop on errors" button + try + Conn.Query(Queries[i].SQL, False, lcScript); + RowsAffected := RowsAffected + Conn.RowsAffected; + Conn.ShowWarnings; + except + on E:Exception do begin + if actQueryStopOnErrors.Checked then + raise + else + Inc(ErrorCount); + end; + end; + + end; + end; + if ProgressDialog.HasUserCancelled then begin + LogSQL(_('Cancelled by user')); + Result := False; + end; + StopProgress; + if ErrorCount > 0 then begin + ErrorDialog(_('Errors'), + f_('%s%% of your file has been processed, but there were %s errors when executing %s queries. Please check the SQL log panel for messages.', + [FormatNumber(100/FileSize*CurrentPosition, 0), FormatNumber(ErrorCount), FormatNumber(QueryCount)]) + ); + end; + + except + on E:Exception do begin + if (E is EFileStreamError) + or (E is EEncodingError) + or (E is EReadError) + then begin + StopProgress; + Result := False; + ErrorDialog(f_('Error while reading file "%s"', [FileName]), E.Message); + AddOrRemoveFromQueryLoadHistory(FileName, False, True); + end + else if E is EDbError then begin + StopProgress; + Result := False; + ErrorDialog(E.Message + CRLF + CRLF + + f_('Notice: You can disable the "%s" option to ignore such errors', [actQueryStopOnErrors.Caption]) + ); + end + else begin + raise; + end; + end; + end; +end;} + + +{procedure TMainForm.SessionConnect(Sender: TObject); +var + SessionPath: String; + Connection: TDBConnection; + Params: TConnectionParameters; + Node, SessionNode: PVirtualNode; + DBObj: PDBObject; + i: Integer; +begin + // Click on quick-session menu item: + SessionPath := StripHotkey((Sender as TMenuItem).Caption); + Node := nil; + // Probably wanted session was clicked before: navigate to last node + for i:=High(FTreeClickHistory) downto Low(FTreeClickHistory) do begin + if FTreeClickHistory[i] <> nil then begin + DBObj := DBtree.GetNodeData(FTreeClickHistory[i]); + if DBObj = nil then // Session disconnected + Break; + if DBObj.Connection.Parameters.SessionPath = SessionPath then begin + Node := FTreeClickHistory[i]; + break; + end; + end; + end; + if not Assigned(Node) then begin + // Wanted session was not clicked yet but probably connected: navigate to root node + SessionNode := DBtree.GetFirstChild(nil); + while Assigned(SessionNode) do begin + DBObj := DBtree.GetNodeData(SessionNode); + if DBObj.Connection.Parameters.SessionPath = SessionPath then begin + Node := SessionNode; + end; + SessionNode := DBtree.GetNextSibling(SessionNode); + end; + end; + // Finally we have a node if session is already connected + if Assigned(Node) then + SelectNode(DBtree, Node) + else begin + Params := TConnectionParameters.Create(SessionPath); + InitConnection(Params, True, Connection); + end; +end;} + + +{** + Receive connection parameters and create a connection tree node + Paremeters are either sent by connection-form or by commandline. +} +{function TMainform.InitConnection(Params: TConnectionParameters; ActivateMe: Boolean; var Connection: TDBConnection): Boolean; +var + RestoreLastActiveDatabase: Boolean; + StartupScript, LastActiveDatabase: String; + StartupBatch: TSQLBatch; + Query: TSQLSentence; + SessionNode, DBNode: PVirtualNode; +begin + Connection := Params.CreateConnection(Self); + Connection.OnLog := LogSQL; + Connection.OnConnected := ConnectionReady; + Connection.OnDatabaseChanged := DatabaseChanged; + Connection.OnObjectnamesChanged := ObjectnamesChanged; + try + Connection.Active := True; + // We have a connection + Result := True; + FConnections.Add(Connection); + + if AppSettings.SessionPathExists(Params.SessionPath) then begin + // Save "connected" counter + AppSettings.SessionPath := Params.SessionPath; + AppSettings.WriteInt(asConnectCount, AppSettings.ReadInt(asConnectCount)+1); + // Save server version + AppSettings.WriteInt(asServerVersion, Connection.ServerVersionInt); + AppSettings.WriteString(asLastConnect, DateTimeToStr(Now)); + end; + + if ActivateMe then begin + // Set focus on last uses db. If not wanted or db is gone, go to root node at least + RestoreLastActiveDatabase := AppSettings.ReadBool(asRestoreLastUsedDB); + AppSettings.SessionPath := Params.SessionPath; + LastActiveDatabase := AppSettings.ReadString(asLastUsedDB); + if RestoreLastActiveDatabase + and (Connection.AllDatabases.IndexOf(LastActiveDatabase) >- 1) + and (Connection.GetLockedTableCount(LastActiveDatabase) = 0) + then begin + SetActiveDatabase(LastActiveDatabase, Connection); + DBNode := FindDBNode(DBtree, Connection, LastActiveDatabase); + if Assigned(DBNode) then + DBtree.Expanded[DBNode] := True; + end else begin + SessionNode := GetRootNode(DBtree, Connection); + SelectNode(DBtree, SessionNode); + DBtree.Expanded[SessionNode] := True; + end; + end; + + // Process startup script + StartupScript := Trim(Connection.Parameters.StartupScriptFilename); + if StartupScript <> '' then begin + StartupScript := ExpandFileName(StartupScript); + if not FileExists(StartupScript) then + ErrorDialog(f_('Startup script file not found: %s', [StartupScript])) + else begin + StartupBatch := TSQLBatch.Create; + StartupBatch.SQL := ReadTextfile(StartupScript, nil); + for Query in StartupBatch do try + Connection.Query(Query.SQL); + except + // Suppress popup, errors get logged into SQL log + end; + StartupBatch.Free; + end; + end; + + if Params.WantSSL and not Connection.IsSSL then begin + MessageDialog(_('SSL not used.'), + _('Your SSL settings were not accepted by the server, or the server does not support any SSL configuration.'), + mtWarning, + [mbOK], + asSSLWarnUnused + ); + end; + + // Apply favorite object paths + AppSettings.SessionPath := Params.SessionPath; + Connection.Favorites.Text := AppSettings.ReadString(asFavoriteObjects); + actFavoriteObjectsOnly.Checked := False; + + // Tree node filtering needs a hit once when connected + editDatabaseTableFilterChange(Self); + + except + on E:EDbError do begin + MessageDialog(_('Connection failed'), E.Message, mtError, [mbOK], asUnused, E.Hint); + // attempt failed + if AppSettings.SessionPathExists(Params.SessionPath) then begin + // Save "refused" counter + AppSettings.SessionPath := Params.SessionPath; + AppSettings.WriteInt(asRefusedCount, AppSettings.ReadInt(asRefusedCount)+1); + end; + Result := False; + FreeAndNil(Connection); + end; + end; + + StoreLastSessions; + ValidateControls(Connection); + ShowStatusMsg; +end;} + + +{procedure TMainForm.actDataDeleteExecute(Sender: TObject); +var + Grid: TVirtualStringTree; + Node, FocusAfterDelete: PVirtualNode; + RowNum: PInt64; + Results: TDBQuery; + Nodes: TNodeArray; + i: Integer; +begin + // Delete row(s) + Grid := ActiveGrid; + Results := GridResult(Grid); + if Grid.SelectedCount = 0 then + ErrorDialog(_('No rows selected'), _('Please select one or more rows to delete them.')) + else try + Results.CheckEditable; + if MessageDialog(f_('Delete %s row(s)?', [FormatNumber(Grid.SelectedCount)]), + mtConfirmation, [mbOK, mbCancel]) = mrOK then begin + FocusAfterDelete := nil; + EnableProgress(Grid.SelectedCount); + Node := GetNextNode(Grid, nil, True); + while Assigned(Node) do begin + RowNum := Grid.GetNodeData(Node); + ShowStatusMsg(f_('Deleting row #%s of %s ...', [FormatNumber(ProgressBarStatus.Position+1), FormatNumber(ProgressBarStatus.Max)])); + Results.RecNo := RowNum^; + Results.DeleteRow; + ProgressStep; + SetLength(Nodes, Length(Nodes)+1); + Nodes[Length(Nodes)-1] := Node; + FocusAfterDelete := Node; + Node := GetNextNode(Grid, Node, True); + end; + ShowStatusMsg(_('Clean up ...')); + if Assigned(FocusAfterDelete) then + FocusAfterDelete := Grid.GetNext(FocusAfterDelete); + // Remove nodes and select some nearby node + Grid.BeginUpdate; + for i:=Low(Nodes) to High(Nodes) do + Grid.DeleteNode(Nodes[i]); + Grid.EndUpdate; + if not Assigned(FocusAfterDelete) then + FocusAfterDelete := Grid.GetLast; + if Assigned(FocusAfterDelete) then + SelectNode(Grid, FocusAfterDelete); + DisplayRowCountStats(Grid); + ValidateControls(Sender); + end; + except on E:EDbError do begin + SetProgressState(pbsError); + ErrorDialog(_('Grid editing error'), E.Message); + end; + end; + DisableProgress; + ShowStatusMsg(); +end;} + + +{procedure TMainForm.actUpdateCheckExecute(Sender: TObject); +var + frm : TfrmUpdateCheck; +begin + frm := TfrmUpdateCheck.Create(Self); + frm.ShowModal; + frm.Free; // FormClose has no caFree, as it may not have been called +end;} + + +{procedure TMainForm.actCreateDBObjectExecute(Sender: TObject); +var + Obj: TDBObject; + a: TAction; +begin + // Create a new table, view, etc. + FFocusedTables := GetFocusedObjects(Sender, [lntTable]); + tabEditor.TabVisible := True; + SetMainTab(tabEditor); + a := Sender as TAction; + Obj := TDBObject.Create(ActiveConnection); + Obj.Database := ActiveDatabase; + if a = actCreateTable then Obj.NodeType := lntTable + else if a = actCreateView then Obj.NodeType := lntView + else if a = actCreateProcedure then Obj.NodeType := lntProcedure + else if a = actCreateTrigger then Obj.NodeType := lntTrigger + else if a = actCreateEvent then Obj.NodeType := lntEvent + else if a = actCreateFunction then Obj.NodeType := lntFunction; + + PlaceObjectEditor(Obj); +end;} + + +{procedure TMainForm.actEmptyTablesExecute(Sender: TObject); +var + TableOrView: TDBObject; + Objects: TDBObjectList; + Names, QueryDisableChecks, QueryEnableChecks: String; + Conn: TDBConnection; + Dialog: TTaskDialog; + DialogResult: TModalResult; + DisableForeignKeyChecks: Boolean; +begin + // Delete rows from selected tables and views + + // See issue #3166 + if (not DBtree.Focused) and (not ListTables.Focused) then + Exit; + + Objects := GetFocusedObjects(Sender, [lntTable, lntView]); + for TableOrView in Objects do begin + Names := Names + TableOrView.Name + ', '; + end; + Delete(Names, Length(Names)-1, 2); + + if Objects.Count = 0 then + ErrorDialog(_('No table(s) selected.')) + else begin + Conn := ActiveConnection; + QueryDisableChecks := Conn.GetSQLSpecifity(spDisableForeignKeyChecks); + QueryEnableChecks := Conn.GetSQLSpecifity(spEnableForeignKeyChecks); + if (Win32MajorVersion >= 6) and StyleServices.Enabled then begin + Dialog := TTaskDialog.Create(Self); + Dialog.Text := f_('Empty %d table(s) and/or view(s)?', [Objects.count]); + Dialog.CommonButtons := [tcbOk, tcbCancel]; + Dialog.Flags := Dialog.Flags + [tfUseHiconMain]; + Dialog.CustomMainIcon := ConfirmIcon; + if not QueryDisableChecks.IsEmpty then + Dialog.VerificationText := _('Disable foreign key checks'); + Dialog.Execute; + DialogResult := Dialog.ModalResult; + DisableForeignKeyChecks := tfVerificationFlagChecked in Dialog.Flags; + Dialog.Free; + end else begin + DialogResult := MessageDialog(f_('Empty %d table(s) and/or view(s)?', [Objects.count]), Names, mtConfirmation, [mbOk, mbCancel]); + DisableForeignKeyChecks := False; + end; + if DialogResult = mrOk then begin + Screen.Cursor := crHourglass; + EnableProgress(Objects.Count); + try + if DisableForeignKeyChecks and (not QueryDisableChecks.IsEmpty) then + Conn.Query(QueryDisableChecks); + try + for TableOrView in Objects do begin + Conn.Query(Conn.GetSQLSpecifity(spEmptyTable) + TableOrView.QuotedName); + ProgressStep; + end; + actRefresh.Execute; + except + on E:EDbError do begin + SetProgressState(pbsError); + ErrorDialog(E.Message); + end; + end; + if DisableForeignKeyChecks and (not QueryEnableChecks.IsEmpty) then + Conn.Query(QueryEnableChecks); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + Objects.Free; + DisableProgress; + Screen.Cursor := crDefault; + end; + end; +end;} + + +{procedure TMainForm.actBatchInOneGoExecute(Sender: TObject); +begin + // +end;} + + +{function TMainForm.DBTreeClicked(Sender: TObject): Boolean; +begin + // Find out if user rightclicked in tree or in database tab, + // which is a bit complex, so outsourced here. + Result := DBTree.Focused + or (PageControlMain.ActivePage <> tabDatabase) + or (PopupComponent(Sender) = DBtree); +end;} + + +{function TMainForm.GetFocusedObjects(Sender: TObject; NodeTypes: TListNodeTypes): TDBObjectList; +var + Node: PVirtualNode; + pObj: PDBObject; +begin + // Return list of selected database objects in current area + Result := TDBObjectList.Create(False); + + if DBTreeClicked(Sender) then begin + if ActiveDbObj.NodeType in NodeTypes then + Result.Add(ActiveDbObj); + end else begin + Node := GetNextNode(ListTables, nil, True); + while Assigned(Node) do begin + pObj := ListTables.GetNodeData(Node); + if pObj.NodeType in NodeTypes then + Result.Add(pObj^); + Node := GetNextNode(ListTables, Node, True); + end; + end; +end;} + + +{procedure TMainForm.actRunRoutinesExecute(Sender: TObject); +var + Tab: TQueryTab; + Query, ParamValues, ParamValue: String; + Params: TStringList; + Obj: TDBObject; + Objects: TDBObjectList; + Parameters: TRoutineParamList; + Param: TRoutineParam; + Cancelled: Boolean; +begin + // Run stored function(s) or procedure(s) + Objects := GetFocusedObjects(Sender, [lntProcedure, lntFunction]); + + if Objects.Count = 0 then + ErrorDialog(_('No stored procedure selected.'), _('Please select one or more stored function(s) or routine(s).')); + + for Obj in Objects do begin + actNewQueryTab.Execute; + Tab := QueryTabs[MainForm.QueryTabs.Count-1]; + case Obj.Connection.Parameters.NetTypeGroup of + ngMySQL: + case Obj.NodeType of + lntProcedure: Query := 'CALL '; + lntFunction: Query := 'SELECT '; + end; + ngMSSQL: + Query := 'EXEC '; + ngPgSQL: + Query := 'SELECT '; + else + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(Obj.Connection.Parameters.NetType)]); + end; + Parameters := TRoutineParamList.Create; + Obj.Connection.ParseRoutineStructure(Obj, Parameters); + Query := Query + Obj.QuotedName; + Cancelled := False; + Params := TStringList.Create; + for Param in Parameters do begin + ParamValue := ''; + if not InputQuery(Obj.Name, _('Parameter')+' "'+Param.Name+'" ('+Param.Datatype+')', ParamValue) then begin + Cancelled := True; + Break; + end; + ParamValue := Obj.Connection.EscapeString(ParamValue); + Params.Add(ParamValue); + end; + if not Cancelled then begin + Parameters.Free; + ParamValues := ''; + case Obj.Connection.Parameters.NetTypeGroup of + ngMySQL, ngPgSQL: + ParamValues := '(' + Implode(', ', Params) + ')'; + ngMSSQL: + ParamValues := ' ' + Implode(' ', Params); + else + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(Obj.Connection.Parameters.NetType)]); + end; + Query := Query + ParamValues; + Tab.Memo.Text := Query; + actExecuteQueryExecute(Sender); + end; + // Also cancel the whole loop over multiple procedures + if Cancelled then + Break; + end; +end;} + + +{procedure TMainForm.actNewWindowExecute(Sender: TObject); +begin + ShellExec( ExtractFileName(paramstr(0)), ExtractFilePath(paramstr(0)) ); +end;} + + +{procedure TMainForm.actQueryFindReplaceExecute(Sender: TObject); +var + OldDataLocalNumberFormat: Boolean; +begin + // Display search + replace dialog + if not Assigned(FSearchReplaceDialog) then + FSearchReplaceDialog := TfrmSearchReplace.Create(Self); + if FSearchReplaceDialog.Visible then + Exit; + FSearchReplaceDialog.chkReplace.Checked := Sender = actQueryReplace; + if (ActiveSynMemo(False) <> nil) or (ActiveGrid <> nil) then begin + OldDataLocalNumberFormat := DataLocalNumberFormat; + DataLocalNumberFormat := False; + FSearchReplaceDialog.ShowModal; + DataLocalNumberFormat := OldDataLocalNumberFormat; + ValidateControls(Sender); + end; +end;} + + +{procedure TMainForm.actQueryFindAgainExecute(Sender: TObject); +var + NeedDialog: Boolean; + Editor: TSynMemo; + Grid: TVirtualStringTree; + OldDataLocalNumberFormat: Boolean; +begin + // F3 - search or replace again, using previous settings + NeedDialog := not Assigned(FSearchReplaceDialog); + if Assigned(FSearchReplaceDialog) then begin + NeedDialog := NeedDialog or ((FSearchReplaceDialog.Grid = nil) and (FSearchReplaceDialog.Editor = nil)); + Editor := ActiveSynMemo(False); + Grid := ActiveGrid; + NeedDialog := NeedDialog or ((Grid = nil) and (Editor = nil)); + if (Editor <> nil) and (Editor.Focused) then + NeedDialog := NeedDialog or (FSearchReplaceDialog.Editor<>Editor); + if (Grid <> nil) and (Grid.Focused) then + NeedDialog := NeedDialog or (FSearchReplaceDialog.Grid<>Grid); + end; + + if NeedDialog then + actQueryFindReplaceExecute(Sender) + else begin + OldDataLocalNumberFormat := DataLocalNumberFormat; + DataLocalNumberFormat := False; + Exclude(FSearchReplaceDialog.Options, ssoEntireScope); + FSearchReplaceDialog.DoSearchReplace(Sender); + DataLocalNumberFormat := OldDataLocalNumberFormat; + end; +end;} + + +{procedure TMainForm.SynMemoQueryReplaceText(Sender: TObject; const ASearch, + AReplace: string; Line, Column: Integer; var Action: TSynReplaceAction); +begin + // Fires when "Replace all" in search dialog was pressed with activated "Prompt on replace" + case MessageDialog(f_('Replace this occurrence of "%s"?', [StrEllipsis(ASearch, 100)]), mtConfirmation, [mbYes, mbYesToAll, mbNo, mbCancel]) of + mrYes: Action := raReplace; + mrYesToAll: Action := raReplaceAll; + mrNo: Action := raSkip; + mrCancel: Action := raCancel; + end; +end;} + + +{procedure TMainForm.actRefreshExecute(Sender: TObject); +var + tab1, tab2: TTabSheet; + List: TVirtualStringTree; + OldDbObject: TDBObject; +begin + // Refresh + // Force data tab update when appropriate. + // Disable refresh action and re-enable in ApplicationOnIdle event + tab1 := PageControlMain.ActivePage; + actRefresh.Enabled := False; + FRefreshActionDisabledAt := GetTickCount; + if ActiveControl = DBtree then + RefreshTree + else if tab1 = tabHost then begin + tab2 := PageControlHost.ActivePage; + if tab2 = tabDatabases then + List := ListDatabases + else if tab2 = tabVariables then + List := ListVariables + else if tab2 = tabStatus then + List := ListStatus + else if tab2 = tabProcessList then + List := ListProcesses + else + List := ListCommandStats; + InvalidateVT(List, VTREE_NOTLOADED_PURGECACHE, True); + end else if tab1 = tabDatabase then begin + OldDbObject := TDBObject.Create(FActiveDbObj.Connection); + OldDbObject.Assign(FActiveDbObj); + RefreshTree(OldDbObject); + end else if tab1 = tabEditor then begin + RefreshTree; + end else if tab1 = tabData then + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); +end;} + + +{procedure TMainForm.actSQLhelpExecute(Sender: TObject); +var + keyword: String; + Tree: TVirtualStringTree; + SynMemo: TSynMemo; +begin + // Call SQL Help from various places + keyword := ''; + + // Query-Tab + if ActiveControl is TSynMemo then begin + SynMemo := TSynMemo(ActiveControl); + keyword := SynMemo.WordAtCursor; + if keyword.IsEmpty then begin + keyword := SynMemo.SelText; + end; + end + + // Data-Tab + else if (PageControlMain.ActivePage = tabData) + and Assigned(DataGrid.FocusedNode) then begin + keyword := SelectedTableFocusedColumn.DataType.Name; + + end else if ActiveControl = QueryTabs.ActiveHelpersTree then begin + // Makes only sense if one of the nodes "SQL fn" or "SQL kw" was selected + Tree := QueryTabs.ActiveHelpersTree; + if Assigned(Tree.FocusedNode) + and (Tree.GetNodeLevel(Tree.FocusedNode)=1) + and (Tree.FocusedNode.Parent.Index in [TQueryTab.HelperNodeFunctions, TQueryTab.HelperNodeKeywords]) then + keyword := Tree.Text[Tree.FocusedNode, 0]; + end; + + // Clean existing paranthesis, fx: char(64) + if Pos( '(', keyword ) > 0 then + keyword := Copy( keyword, 1, Pos( '(', keyword )-1 ); + + // Show the window + CallSQLHelpWithKeyword( keyword ); +end;} + + +{procedure TMainForm.actSynEditCompletionProposeExecute(Sender: TObject); +begin + // Show completion proposal explicitely, without the use of its own ShortCut property, + // to support a customized shortcut, see + SynCompletionProposal.Editor := ActiveSynMemo(False); + if Screen.ActiveControl is TCustomSynEdit then + SynCompletionProposal.ActivateCompletion + else + MessageBeep(MB_ICONEXCLAMATION); +end;} + +{procedure TMainForm.actSynMoveDownExecute(Sender: TObject); +var + Editor: TSynMemo; +begin + // Move line of text one down + Editor := ActiveSynMemo(False); + if Assigned(Editor) and (Editor.CaretY < Editor.Lines.Count) then begin + //Logsql('Editor.CaretY:'+Editor.CaretY.ToString+' Editor.Lines.Count:'+Editor.Lines.Count.ToString); + Editor.Lines.Exchange(Editor.CaretY-1, Editor.CaretY); + Editor.CaretY := Editor.CaretY + 1; + // OnStatusChanged implicitly fired here + if Assigned(Editor.OnChange) then + Editor.OnChange(Editor); + Editor.Repaint; + end else begin + MessageBeep(MB_ICONERROR); + end; +end;} + +{procedure TMainForm.actSynMoveUpExecute(Sender: TObject); +var + Editor: TSynMemo; +begin + // Move line of text one up + Editor := ActiveSynMemo(False); + if Assigned(Editor) and (Editor.CaretY >= 2) then begin + Editor.Lines.Exchange(Editor.CaretY-1, Editor.CaretY-2); + Editor.CaretY := Editor.CaretY - 1; + // OnStatusChanged implicitly fired here + if Assigned(Editor.OnChange) then + Editor.OnChange(Editor); + Editor.Repaint; + end else begin + MessageBeep(MB_ICONERROR); + end; +end;} + +{*** + Show SQL Help window directly using a keyword + @param String SQL-keyword + @see FieldeditForm.btnDatatypeHelp +} +{procedure TMainform.CallSQLHelpWithKeyword( keyword: String ); +begin + if FActiveDbObj.Connection.Has(frHelpKeyword) then begin + if not Assigned(SqlHelpDialog) then + SqlHelpDialog := TfrmSQLhelp.Create(Self); + SqlHelpDialog.Show; + SqlHelpDialog.Keyword := keyword; + end else + ErrorDialog(_('SQL help not available.'), f_('HELP <keyword> requires %s or newer.', ['MySQL 4.1'])); +end;} + + +{procedure TMainForm.actSaveSynMemoToTextfileExecute(Sender: TObject); +var + Comp: TComponent; + Memo: TSynMemo; + Dialog: TExtFileSaveDialog; +begin + // Save to textfile, from any TSynMemo (SQL log, "CREATE code" tab in editor, ...) + Memo := nil; + // Try to find memo from menu item's popup component, and if that fails, check ActiveControl. + // See #353 + Comp := PopupComponent(Sender); + if Comp is TSynMemo then + Memo := Comp as TSynMemo + else if ActiveControl is TSynMemo then + Memo := ActiveControl as TSynMemo; + if Assigned(Memo) then begin + Dialog := TExtFileSaveDialog.Create(Self); + Dialog.Options := Dialog.Options + [fdoOverWritePrompt]; + Dialog.AddFileType('*.sql', _('SQL files')); + Dialog.AddFileType('*.*', _('All files')); + Dialog.DefaultExtension := 'sql'; + Dialog.LineBreakIndex := TLineBreaks(AppSettings.ReadInt(asLineBreakStyle)); + if Dialog.Execute then begin + Screen.Cursor := crHourGlass; + SaveUnicodeFile( + Dialog.FileName, + Implode(GetLineBreak(Dialog.LineBreakIndex), Memo.Lines), + UTF8NoBOMEncoding + ); + Screen.Cursor := crDefault; + end; + end else begin + ErrorDialog(f_('No SQL editor focused. ActiveControl is %s', [ActiveControl.Name])); + end; +end;} + + +{procedure TMainForm.actSaveSQLAsExecute(Sender: TObject); +var + i: Integer; + CanSave: TModalResult; + OnlySelection: Boolean; + Dialog: TExtFileSaveDialog; + QueryTab: TQueryTab; + DefaultFilename: String; +begin + // Save SQL + CanSave := mrNo; + QueryTab := QueryTabs.ActiveTab; + Dialog := TExtFileSaveDialog.Create(Self); + if QueryTab.MemoFilename.IsEmpty then + DefaultFilename := QueryTab.TabSheet.Caption + else + DefaultFilename := ExtractFileName(QueryTab.MemoFilename); + DefaultFilename := DefaultFilename.Trim([' ', '*']); + Dialog.FileName := ValidFilename(DefaultFilename); + Dialog.Options := Dialog.Options + [fdoOverwritePrompt]; + if (Sender = actSaveSQLSnippet) or (Sender = actSaveSQLSelectionSnippet) then begin + Dialog.DefaultFolder := AppSettings.DirnameSnippets; + Dialog.Options := Dialog.Options + [fdoNoChangeDir]; + Dialog.Title := _('Save snippet'); + end; + Dialog.AddFileType('*.sql', _('SQL files')); + Dialog.AddFileType('*.*', _('All files')); + Dialog.DefaultExtension := 'sql'; + Dialog.LineBreakIndex := QueryTab.MemoLineBreaks; + while (CanSave = mrNo) and Dialog.Execute do begin + // Save complete content or just the selected text, + // depending on the tag of calling control + CanSave := mrYes; + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i].MemoFilename = Dialog.FileName then begin + CanSave := MessageDialog(f_('Overwrite "%s"?', [Dialog.FileName]), f_('This file is already open in query tab #%d.', [QueryTabs[i].Number]), + mtWarning, [mbYes, mbNo, mbCancel]); + break; + end; + end; + end; + if CanSave = mrYes then begin + OnlySelection := (Sender = actSaveSQLselection) or (Sender = actSaveSQLSelectionSnippet); + QueryTab.MemoLineBreaks := Dialog.LineBreakIndex; + QueryTab.SaveContents(Dialog.FileName, OnlySelection); + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i] = QueryTab then + continue; + if QueryTabs[i].MemoFilename = Dialog.FileName then + QueryTabs[i].Memo.Modified := True; + end; + ValidateQueryControls(Sender); + SetSnippetFilenames; + end; + Dialog.Free; +end;} + + +{procedure TMainForm.actSaveSQLExecute(Sender: TObject); +var + i: Integer; + ObjEditor: TDBObjectEditor; + Handled: Boolean; +begin + Handled := False; + if QueryTabs.HasActiveTab then begin + // Save SQL tab contents to file + if QueryTabs.ActiveTab.MemoFilename <> '' then begin + QueryTabs.ActiveTab.SaveContents(QueryTabs.ActiveTab.MemoFilename, False); + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i] = QueryTabs.ActiveTab then + continue; + if QueryTabs[i].MemoFilename = QueryTabs.ActiveTab.MemoFilename then + QueryTabs[i].Memo.Modified := True; + end; + ValidateQueryControls(Sender); + end else + actSaveSQLAsExecute(Sender); + Handled := True; + end + else if PageControlMain.ActivePage = tabEditor then begin + // Save table, procedure, etc. + ObjEditor := ActiveObjectEditor; + if Assigned(ObjEditor) and ObjEditor.Modified then begin + ObjEditor.ApplyModifications; + Handled := True; + end; + end; + if not Handled then begin + MessageBeep(MB_ICONASTERISK); + end; + +end;} + + +{procedure TMainForm.actQueryStopOnErrorsExecute(Sender: TObject); +begin + // Weird fix: dummy routine to avoid the sending action getting disabled +end;} + + +{procedure TMainForm.actQueryWordWrapExecute(Sender: TObject); +begin + // SetupSynEditors applies all customizations to any SynEditor + if (Sender as TAction).Checked then + actCodeFolding.Checked := False; + SetupSynEditors; +end;} + + +{procedure TMainForm.actCodeFoldingExecute(Sender: TObject); +begin + // Activates code folding + // Wordwrap does not work in conjunction with code folding. + // See https://github.com/SynEdit/SynEdit/blob/master/CodeFolding.md + if (Sender as TAction).Checked then + actQueryWordWrap.Checked := False; + SetupSynEditors; +end;} + + +{procedure TMainForm.actCodeFoldingStartRegionExecute(Sender: TObject); +var + Memo: TSynMemo; +begin + // Insert #region + if not actCodeFolding.Checked then + actCodeFolding.Execute; + Memo := ActiveSynMemo(False); + Memo.InsertLine(Memo.CaretXY, Memo.CaretXY, '#region ', True); +end;} + + +{procedure TMainForm.actConnectionPropertiesExecute(Sender: TObject); +var + Conn: TDBConnection; + i: Integer; + Infos: TStringList; + InfoText: String; +begin + Conn := ActiveConnection; + if Conn <> nil then begin + Infos := Conn.ConnectionInfo; + InfoText := ''; + for i:=0 to Infos.Count-1 do begin + InfoText := InfoText + Infos.Names[i] + ': ' + Infos.ValueFromIndex[i] + sLineBreak; + end; + MessageDialog(Trim(InfoText), mtInformation, [mbOK]); + end; +end;} + + +{procedure TMainForm.actCodeFoldingEndRegionExecute(Sender: TObject); +var + Memo: TSynMemo; +begin + // Insert #endregion + if not actCodeFolding.Checked then + actCodeFolding.Execute; + Memo := ActiveSynMemo(False); + Memo.InsertLine(Memo.CaretXY, Memo.CaretXY, '#endregion ', True); +end;} + + +{procedure TMainForm.actCodeFoldingFoldSelectionExecute(Sender: TObject); +var + Memo: TSynMemo; + AfterText: String; +begin + // Wrap selected text in region/endregion + if not actCodeFolding.Checked then + actCodeFolding.Execute; + Memo := ActiveSynMemo(False); + AfterText := IfThen(Memo.SelText.EndsWith(sLineBreak), '', sLineBreak); + Memo.SelText := '#region ' + sLineBreak + Memo.SelText + AfterText + '#endregion' + sLineBreak; +end;} + + +{procedure TMainForm.PopupQueryLoadPopup(Sender: TObject); +var + i, j: Integer; + Item, SnippetsFolder: TMenuItem; + Filename: String; +begin + // Fill the popupQueryLoad menu + popupQueryLoad.Items.Clear; + + // Apply shared system image list + popupQueryLoad.Images := GetSystemImageList; + + // Snippets + SetSnippetFilenames; + SnippetsFolder := TMenuItem.Create(popupQueryLoad); + SnippetsFolder.Caption := _('Snippets'); + popupQueryLoad.Items.Add(SnippetsFolder); + for i:=0 to FSnippetFilenames.Count-1 do begin + Item := TMenuItem.Create(SnippetsFolder); + Item.Caption := FSnippetFilenames[i]; + Item.OnClick := popupQueryLoadClick; + SnippetsFolder.Add(Item); + end; + + // Separator + Item := TMenuItem.Create(popupQueryLoad); + Item.Caption := '-'; + popupQueryLoad.Items.Add(Item); + + // Recent files + j := 0; + for i:=0 to 19 do begin + Filename := AppSettings.ReadString(asSQLfile, IntToStr(i)); + if Filename = '' then + continue; + Inc(j); + Item := TMenuItem.Create( popupQueryLoad ); + Item.Caption := IntToStr(j) + ' ' + Filename; + Item.OnClick := popupQueryLoadClick; + Item.ImageIndex := GetSystemImageIndex(Filename); + popupQueryLoad.Items.Add(Item); + end; + + // Separator + "Remove absent files" + Item := TMenuItem.Create(popupQueryLoad); + Item.Caption := '-'; + popupQueryLoad.Items.Add(Item); + + Item := TMenuItem.Create(popupQueryLoad); + Item.Caption := _('Remove absent files'); + Item.OnClick := PopupQueryLoadRemoveAbsentFiles; + popupQueryLoad.Items.Add(Item); + + Item := TMenuItem.Create(popupQueryLoad); + Item.Caption := _('Clear file list'); + Item.OnClick := PopupQueryLoadRemoveAllFiles; + popupQueryLoad.Items.Add(Item); +end;} + + +{procedure TMainform.PopupQueryLoadRemoveAbsentFiles(Sender: TObject); +begin + AddOrRemoveFromQueryLoadHistory('', False, True); +end;} + + +{procedure TMainform.PopupQueryLoadRemoveAllFiles(Sender: TObject); +var + i: Integer; +begin + for i:=0 to 20 do begin + if not AppSettings.DeleteValue(asSQLfile, IntToStr(i)) then + break; + end; +end;} + + +{procedure TMainform.popupQueryLoadClick(Sender: TObject); +var + Filename: String; + FileList: TStringList; + p: Integer; + Tab: TQueryTab; +begin + // Click on the popupQueryLoad + Filename := (Sender as TMenuItem).Caption; + Filename := StripHotkey(Filename); + if Pos('\', Filename) = 0 then // assuming we load a snippet + Filename := AppSettings.DirnameSnippets + Filename + '.sql' + else begin // assuming we load a file from the recent-list + p := Pos(' ', Filename) + 1; + filename := Copy(Filename, p, Length(Filename)); + end; + FileList := TStringList.Create; + FileList.Add(Filename); + if not RunQueryFiles(FileList, nil, false) then begin + Tab := GetOrCreateEmptyQueryTab(True); + Tab.LoadContents(Filename, True, nil); + end; + FileList.Free; +end;} + + +{procedure TMainform.AddOrRemoveFromQueryLoadHistory(Filename: String; AddIt: Boolean; CheckIfFileExists: Boolean); +var + i: Integer; + newfilelist: TStringList; + savedfilename: String; +begin + // Add or remove filename to/from history, avoiding duplicates + + newfilelist := TStringList.create; + AppSettings.ResetPath; + + // Add new filename + if AddIt then + newfilelist.Add( filename ); + + // Add all other filenames + for i:=0 to 20 do begin + savedfilename := AppSettings.ReadString(asSQLfile, IntToStr(i)); + if savedfilename.IsEmpty then + Break; + AppSettings.DeleteValue(asSQLfile, IntToStr(i)); + if CheckIfFileExists and (not FileExists( savedfilename )) then + continue; + if (savedfilename <> filename) and (newfilelist.IndexOf(savedfilename)=-1) then + newfilelist.add( savedfilename ); + end; + + // Save new list + for i := 0 to newfilelist.Count-1 do begin + if i >= 20 then + break; + AppSettings.WriteString(asSQLfile, newfilelist[i], IntToStr(i)); + end; +end;} + + +{** + Change default delimiter for SQL execution +} +{procedure TMainForm.actSetDelimiterExecute(Sender: TObject); +var + newVal: String; + ok: Boolean; +begin + // Use a while loop to redisplay the input dialog after setting an invalid value + ok := False; + while not ok do begin + newVal := delimiter; + if InputQuery(_('Set delimiter'), _('SQL statement delimiter (default is ";"):'), newVal) then try + // Set new value + Delimiter := newVal; + ok := True; + except on E:Exception do + ErrorDialog(E.Message); + end else // Cancel clicked + ok := True; + end; +end;} + + +{** + Sets the Delimiter property plus updates the hint on actSetDelimiter +} +procedure TMainForm.SetDelimiter(Value: String); +var + rx: TRegExpr; + Msg: String; +begin + Value := Trim(Value); + Msg := ''; + if Value = '' then + Msg := _('Empty value.') + else begin + rx := TRegExpr.Create; + rx.Expression := '(/\*|--|#|\''|\"|`)'; + if rx.Exec(Value) then + Msg := _('Start-of-comment tokens or string literal markers are not allowed.') + end; + if Msg <> '' then begin + Msg := f_('Error setting delimiter to "%s": %s', [Value, Msg]); + LogSQL(Msg, lcError); + //ErrorDialog(Msg); + end else begin + FDelimiter := Value; + LogSQL(f_('Delimiter changed to %s', [FDelimiter]), lcInfo); + //actSetDelimiter.Hint := actSetDelimiter.Caption + ' (' + _('current value:') + ' ' + FDelimiter + ')'; + end; +end; + + +{procedure TMainForm.actApplyFilterExecute(Sender: TObject); +var + i: Integer; + Filters: TStringList; + val: String; +begin + // If filter box is empty but filter generator box has text, most users expect + // the filter to be auto generated on button click + if ((SynMemoFilter.GetTextLen = 0) or menuAlwaysGenerateFilter.Checked) + and (editFilterSearch.Text <> '') + and (Sender is TAction) + and ((Sender as TAction).ActionComponent = btnFilterApply) + then begin + editFilterSearchChange(editFilterSearch); + end; + + if SynMemoFilter.GetTextLen > 0 then begin + // Recreate recent filters list + Filters := TStringList.Create; + Filters.Add(Trim(SynMemoFilter.Text)); + AppSettings.SessionPath := GetRegKeyTable+'\'+REGKEY_RECENTFILTERS; + // Add old filters + for i:=1 to 20 do begin + val := AppSettings.ReadString(asRecentFilter, IntToStr(i)); + if val.IsEmpty then + Continue; + if Filters.IndexOf(val) = -1 then + Filters.Add(val); + AppSettings.DeleteValue(asRecentFilter, IntToStr(i)); + end; + for i:=0 to Filters.Count-1 do + AppSettings.WriteString(asRecentFilter, Filters[i], IntToStr(i+1)); + FreeAndNil(Filters); + AppSettings.ResetPath; + end; + // Keep current column widths on "Quick filter" clicks, don't keep them on "Apply filter" clicks + if (Sender is TMenuItem) and ((Sender as TMenuItem).GetParentMenu = popupDataGrid) then begin + FDataGridColumnWidthsCustomized := True; + end else + FDataGridColumnWidthsCustomized := False; + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); +end;} + + +{procedure TMainForm.actDataFirstExecute(Sender: TObject); +var + Node: PVirtualNode; +begin + Node := GetNextNode(ActiveGrid, nil); + if Assigned(Node) then + SelectNode(ActiveGrid, Node); + ValidateControls(Sender); +end;} + + +{procedure TMainForm.actDataInsertExecute(Sender: TObject); +var + DupeNode, NewNode: PVirtualNode; + Grid: TVirtualStringTree; + Results: TDBQuery; + RowNum: Int64; + DupeNum: PInt64; + Col, ResultCol: Integer; + Value: String; + IsNull, AllowNewNode: Boolean; +begin + Grid := ActiveGrid; + Results := GridResult(Grid); + // Pre-test if changing node focus is allowed, in cases where current row modifications throw some SQL error when posting + AllowNewNode := False; + Grid.OnFocusChanging(Grid, Grid.FocusedNode, nil, Grid.FocusedColumn, Grid.FocusedColumn, AllowNewNode); + if not AllowNewNode then + exit; + try + Results.CheckEditable; + DupeNode := nil; + if (Sender = actDataDuplicateRowWithoutKeys) or (Sender = actDataDuplicateRowWithKeys) then + DupeNode := Grid.FocusedNode; + RowNum := Results.InsertRow; + NewNode := Grid.InsertNode(Grid.FocusedNode, amInsertAfter, PInt64(RowNum)); + SelectNode(Grid, NewNode); + if Assigned(DupeNode) then begin + // Copy values from source row, ensure we have whole cell data + DupeNum := Grid.GetNodeData(DupeNode); + AnyGridEnsureFullRow(Grid, DupeNode); + for Col:=0 to Grid.Header.Columns.Count-1 do begin + ResultCol := Col - 1; + if not (coVisible in Grid.Header.Columns[Col].Options) then + continue; // Ignore invisible key column + if ResultCol < 0 then + Continue; // Ignore static row id column + if Results.ColIsPrimaryKeyPart(ResultCol) and (Sender = actDataDuplicateRowWithoutKeys) then + continue; // Empty value for primary key column + if Results.ColIsVirtual(ResultCol) then + continue; // Don't copy virtual column value + Results.RecNo := DupeNum^; + Value := Results.Col(ResultCol); + IsNull := Results.IsNull(ResultCol); + Results.RecNo := RowNum; + Results.SetCol(ResultCol, Value, IsNull, False); + end; + end; + except on E:EDbError do + ErrorDialog(_('Grid editing error'), E.Message); + end; +end;} + + +{procedure TMainForm.actDataLastExecute(Sender: TObject); +var + Node: PVirtualNode; + Grid: TVirtualStringTree; +begin + Grid := ActiveGrid; + // Be sure to have all rows + if (Grid = DataGrid) and (DatagridWantedRowCount < AppSettings.ReadInt(asDatagridMaximumRows)) then + actDataShowAll.Execute; + Node := Grid.GetLast; + if Assigned(Node) then + SelectNode(Grid, Node); + ValidateControls(Sender); +end;} + + +{procedure TMainForm.actDataOpenUrlExecute(Sender: TObject); +var + Grid: TVirtualStringTree; +begin + // Open grid cell url in web browser + Grid := ActiveGrid; + ShellExec(Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]); +end;} + + +{procedure TMainForm.actDataPostChangesExecute(Sender: TObject); +var + Grid: TVirtualStringTree; + Results: TDBQuery; +begin + if Sender is TVirtualStringTree then + Grid := Sender as TVirtualStringTree + else + Grid := ActiveGrid; + Results := GridResult(Grid); + Results.SaveModifications; + // Node needs a repaint to remove red triangles + if Assigned(Grid.FocusedNode) then + Grid.InvalidateNode(Grid.FocusedNode); + DisplayRowCountStats(Grid); +end;} + +{procedure TMainForm.actRemoveFilterExecute(Sender: TObject); +begin + actClearFilterEditor.Execute; + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); +end;} + + +{procedure TMainForm.actDataCancelChangesExecute(Sender: TObject); +var + Grid: TVirtualStringTree; + Results: TDBQuery; + RowNum: PInt64; + Node, FocNode: PVirtualNode; +begin + // Cancel INSERT or UPDATE mode + Grid := ActiveGrid; + Node := Grid.FocusedNode; + if Assigned(Node) then begin + Results := GridResult(Grid); + RowNum := Grid.GetNodeData(Node); + Results.RecNo := RowNum^; + Results.DiscardModifications; + if Results.Inserted then begin + FocNode := Grid.GetPreviousSibling(Node); + Grid.DeleteNode(Node); + SelectNode(Grid, FocNode); + end else + Grid.InvalidateNode(Node); + ValidateControls(Sender); + end; +end;} + + +{** + Add a SQL-command or comment to SynMemoSQLLog +} +procedure TMainForm.LogSQL(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil); +var + snip, IsSQL: Boolean; + Len, i, MaxLineWidth: Integer; + Sess, OldSettingsPath: String; + LogIt: Boolean; + LogItem: TDBLogItem; +begin + //OldSettingsPath := AppSettings.SessionPath; + LogItem := TDBLogItem.Create; + LogItem.Category := Category; + if false then // AppSettings.ReadBool(asLogTimestamp) then + LogItem.LineText := '['+FormatDateTime('hh:nn:ss.zzz', Now)+'] '+ Msg + else + LogItem.LineText := Msg; + LogItem.Connection := Connection; + PostponedLogItems.Add(LogItem); + + if not MainFormCreated then + Exit; + if csDestroying in ComponentState then + Exit; + + for LogItem in PostponedLogItems do begin + + // Log only wanted events + {case LogItem.Category of + lcError: LogIt := AppSettings.ReadBool(asLogErrors); + lcUserFiredSQL: LogIt := AppSettings.ReadBool(asLogUserSQL); + lcSQL: LogIt := AppSettings.ReadBool(asLogSQL); + lcScript: LogIt := AppSettings.ReadBool(asLogScript); + lcInfo: LogIt := AppSettings.ReadBool(asLogInfos); + lcDebug: LogIt := AppSettings.ReadBool(asLogDebug); + else LogIt := False; + end;} + LogIt := True; + + if LogIt then begin + // Shorten very long messages + Msg := LogItem.LineText; + Len := Length(Msg); + MaxLineWidth := 0; // AppSettings.ReadInt(asLogsqlwidth); + snip := (MaxLineWidth > 0) and (Len > MaxLineWidth); + IsSQL := LogItem.Category in [lcSQL, lcUserFiredSQL]; + if snip then begin + Msg := + Copy(Msg, 0, MaxLineWidth) + + '/* '+f_('large SQL query (%s), snipped at %s characters', [Len.ToString, MaxLineWidth.ToString]) + ' */'; + end else if (not snip) and IsSQL then + Msg := Msg + Delimiter; + if not IsSQL then + Msg := '/* ' + Msg + ' */'; + + SynMemoSQLLog.Lines.Add(Msg); + + // Delete first line(s) in SQL log and adjust LineNumberStart in gutter + {i := 0; + while SynMemoSQLLog.Lines.Count > AppSettings.ReadInt(asLogsqlnum) do begin + SynMemoSQLLog.Lines.Delete(0); + Inc(i); + end; + // Increase first displayed number in gutter so it doesn't lie about the log entries + if i > 0 then + SynMemoSQLLog.Gutter.LineNumberStart := SynMemoSQLLog.Gutter.LineNumberStart + i;} + + // Scroll to last line and repaint + SynMemoSQLLog.CaretY := SynMemoSQLLog.Lines.Count; + // Causes access violations on a reconnected session firing a user-query: + // SynMemoSQLLog.Repaint; + // SynMemoSQLLog.Update; + // See TDBConnection.Log and TQueryThread.LogFromThread + // See https://github.com/HeidiSQL/HeidiSQL/issues/57 + + // Log to file? + if FLogToFile then + try + Sess := ''; + //if LogItem.Connection <> nil then + // Sess := LogItem.Connection.Parameters.SessionPath; + WriteLn(FFileHandleSessionLog, Format('/* %s [%s] */ %s', [DateTimeToStr(Now), Sess, msg])); + except + on E:Exception do begin + LogToFile := False; + //AppSettings.WriteBool(asLogToFile, False); + //ErrorDialog(_('Error writing to session log file.'), E.Message+CRLF+_('Filename')+': '+FFileNameSessionLog+CRLF+CRLF+_('Logging is disabled now.')); + end; + end; + end; + end; + PostponedLogItems.Clear; + + // Restore possibly overwritten session path + //AppSettings.SessionPath := OldSettingsPath; +end; + + +{procedure TMainForm.actDataShowNextExecute(Sender: TObject); +var + OldRowCount: Int64; +begin + // Show next X rows in datagrid + OldRowCount := DatagridWantedRowCount; + Inc(DatagridWantedRowCount, AppSettings.ReadInt(asDatagridRowsPerStep)); + DataGridWantedRowCount := Min(DataGridWantedRowCount, AppSettings.ReadInt(asDatagridMaximumRows)); + InvalidateVT(DataGrid, VTREE_NOTLOADED, True); + SelectNode(DataGrid, OldRowCount); +end;} + + +{procedure TMainForm.actAttachDatabaseExecute(Sender: TObject); +var + Selector: TOpenDialog; + OldFiles, NewFiles: TStringList; + i: Integer; + Conn: TDBConnection; + DbAlias: String; +begin + // Attach new or existing SQLite database file + Selector := TOpenDialog.Create(Self); + //Selector.InitialDir := ?; + Selector.Filter := 'SQLite databases ('+FILEFILTER_SQLITEDB+')|'+FILEFILTER_SQLITEDB+'|'+_('All files')+' (*.*)|*.*'; + Selector.Options := Selector.Options - [ofFileMustExist]; + Selector.Options := Selector.Options + [ofAllowMultiSelect]; + Selector.DefaultExt := FILEEXT_SQLITEDB; + if Selector.Execute then begin + Conn := ActiveConnection; + OldFiles := Explode(DELIM, Conn.Parameters.Hostname); + NewFiles := TStringList.Create; + NewFiles.Assign(Selector.Files); + try + for i:=0 to NewFiles.Count-1 do begin + // Remove path if it's the application directory + if ExtractFilePath(NewFiles[i]) = ExtractFilePath(Application.ExeName) then + NewFiles[i] := ExtractFileName(NewFiles[i]); + if OldFiles.IndexOf(NewFiles[i]) = -1 then begin + OldFiles.Add(NewFiles[i]); + DbAlias := TPath.GetFileNameWithoutExtension(NewFiles[i]); + Conn.Query('ATTACH DATABASE '+Conn.EscapeString(NewFiles[i])+' AS '+Conn.QuoteIdent(DbAlias)); + end; + end; + AppSettings.SessionPath := Conn.Parameters.SessionPath; + AppSettings.WriteString(asHost, Implode(DELIM, OldFiles)); + RefreshTree; + except + on E:EDbError do begin + ErrorDialog(E.Message); + end; + end; + end; +end;} + +{procedure TMainForm.actDetachDatabaseExecute(Sender: TObject); +var + Obj: TDBObject; + OldFiles: TStringList; + i: Integer; + DbAlias: String; +begin + // Detach previously attached SQLite database file + Obj := ActiveDBObj; + if Obj.NodeType <> lntDb then + Exit; + if MessageDialog( + f_('Detach database "%s" from "%s" session?', [Obj.Database, Obj.Connection.Parameters.SessionPath]) + + CRLF + CRLF + _('Note: The database file will not get deleted.'), + mtConfirmation, + [mbYes, mbNo]) <> mrYes then + Exit; + try + Obj.Connection.Query('DETACH DATABASE '+Obj.Connection.QuoteIdent(Obj.Database)); + OldFiles := Explode(DELIM, Obj.Connection.Parameters.Hostname); + for i:=0 to OldFiles.Count-1 do begin + DbAlias := TPath.GetFileNameWithoutExtension(OldFiles[i]); + if DbAlias = Obj.Database then begin + OldFiles.Delete(i); + Break; + end; + end; + AppSettings.SessionPath := Obj.Connection.Parameters.SessionPath; + AppSettings.WriteString(asHost, Implode(DELIM, OldFiles)); + RefreshTree; + except + on E:EDbError do begin + ErrorDialog(E.Message); + end; + end; +end;} + + +{procedure TMainForm.actDataShowAllExecute(Sender: TObject); +begin + // Remove LIMIT clause + DatagridWantedRowCount := AppSettings.ReadInt(asDatagridMaximumRows); + InvalidateVT(DataGrid, VTREE_NOTLOADED, True); +end;} + + +{function TMainForm.AnyGridEnsureFullRow(Grid: TVirtualStringTree; Node: PVirtualNode): Boolean; +var + RowNum: PInt64; + Data: TDBQuery; +begin + // Load remaining data on a partially loaded row in data grid + Result := True; + if (Grid = DataGrid) and Assigned(Node) then begin + RowNum := Grid.GetNodeData(Node); + Data := GridResult(Grid); + Data.RecNo := RowNum^; + Result := Data.EnsureFullRow(False); + end; +end;} + + +{procedure TMainForm.DataGridEnsureFullRows(Grid: TVirtualStringTree; SelectedOnly: Boolean); +var + Node: PVirtualNode; + Results: TDBQuery; + RowNum: PInt64; +begin + // Load remaining data of all grid rows + Results := GridResult(Grid); + Node := GetNextNode(Grid, nil, SelectedOnly); + while Assigned(Node) do begin + RowNum := Grid.GetNodeData(Node); + Results.RecNo := RowNum^; + if not Results.HasFullData then begin + DataGridFullRowMode := True; + InvalidateVT(Grid, VTREE_NOTLOADED_PURGECACHE, True); + break; + end; + Node := GetNextNode(Grid, Node, SelectedOnly); + end; +end;} + + +{procedure TMainForm.AnyGridHeaderDrawQueryElements(Sender: TVTHeader; + var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); +begin + // Tell the tree we want to paint most of the column header things ourselves + // Only called when Header.OwnerDraw is True + Elements := [hpeHeaderGlyph, hpeText, hpeOverlay]; +end;} + + +{procedure TMainForm.AnyGridAdvancedHeaderDraw(Sender: TVTHeader; + var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); +var + PaintArea, TextArea, IconArea, SortArea: TRect; + SortText, ColCaption: String; + TextSpace, ColSortIndex, NumCharTop: Integer; + ColSortDirection: VirtualTrees.TSortDirection; + Size: TSize; + DC: HDC; + DrawFormat: Cardinal; +const + NumSortChars: Array of Char = ['¹','²','³','⁴','⁵','⁶','⁷','⁸','⁹','⁺']; + + procedure GetSortIndex(Column: TVirtualTreeColumn; var SortIndex: Integer; var SortDirection: VirtualTrees.TSortDirection); + var + SortItem: TSortItem; + begin + SortIndex := -1; + if Column.Owner.Header.Treeview = DataGrid then begin + // Data grid supports multiple sorted columns + SortItem := FDataGridSortItems.FindByColumn(PaintInfo.Column.Text); + if Assigned(SortItem) then begin + SortIndex := FDataGridSortItems.IndexOf(SortItem); + if SortItem.Order = sioAscending then + SortDirection := sdAscending + else + SortDirection := sdDescending; + end; + + end else begin + // We're in a query grid, supporting a single sorted column + if Column.Owner.Header.SortColumn = Column.Index then begin + SortIndex := 0; + SortDirection := Column.Owner.Header.SortDirection; + end; + end; + end; + +begin + // Paint specified elements on column header + + PaintArea := PaintInfo.PaintRectangle; + PaintArea.Inflate(-PaintInfo.Column.Margin, 0); + DC := PaintInfo.TargetCanvas.Handle; + + // Draw column name. Code taken from TVirtualTreeColumns.DrawButtonText and modified for our needs + if hpeText in Elements then begin + ColCaption := PaintInfo.Column.Text; + // Leave space for icons + TextArea := PaintArea; + if PaintInfo.Column.ImageIndex > -1 then + Dec(TextArea.Right, Sender.Images.Width); + GetSortIndex(PaintInfo.Column, ColSortIndex, ColSortDirection); + if ColSortIndex > -1 then + Dec(TextArea.Right, Sender.Images.Width); + + if not (coWrapCaption in PaintInfo.Column.Options) then begin + // Do we need to shorten the caption due to limited space? + GetTextExtentPoint32W(DC, PWideChar(ColCaption), Length(ColCaption), Size); + TextSpace := TextArea.Right - TextArea.Left; + if TextSpace < Size.cx then + ColCaption := VirtualTrees.Utils.ShortenString(DC, ColCaption, TextSpace); + end; + + SetBkMode(DC, TRANSPARENT); + SetTextColor(DC, ColorToRGB(clWindowText)); + DrawFormat := DT_TOP or DT_NOPREFIX or DT_LEFT; + DrawTextW(DC, PWideChar(ColCaption), Length(ColCaption), TextArea, DrawFormat); + end; + + // Draw image, if any + if (hpeHeaderGlyph in Elements) and (PaintInfo.Column.ImageIndex > -1) then begin + IconArea := PaintArea; + Inc(IconArea.Left, IconArea.Width - Sender.Images.Width); + GetSortIndex(PaintInfo.Column, ColSortIndex, ColSortDirection); + if ColSortIndex > -1 then + Dec(IconArea.Left, Sender.Images.Width); + Sender.Images.Draw(PaintInfo.TargetCanvas, IconArea.Left, IconArea.Top, PaintInfo.Column.ImageIndex); + end; + + // Paint sort icon and number + if hpeOverlay in Elements then begin + SortArea := PaintArea; + GetSortIndex(PaintInfo.Column, ColSortIndex, ColSortDirection); + if ColSortIndex > -1 then begin + Inc(SortArea.Left, SortArea.Width - Sender.Images.Width); + // Prepare default font size, also if user selected a bigger one for the grid - we reserved a 16x16 space. + // Font.Height + Font.Size must be set with these values to get this working, larger or smaller Size/Height + // result in wrong size for multiple sort columns. + PaintInfo.TargetCanvas.Font.Height := -11; + PaintInfo.TargetCanvas.Font.Size := 10; + if ColSortDirection = sdAscending then begin + // This is a bit wrong - but the "Ubuntu" font doesn't have the triangle character, + // which seems available on many Windows fonts only. See #1090 + SortText := IfThen(IsWine, '↑', '▲'); + NumCharTop := 0; + end else begin + SortText := IfThen(IsWine, '↓', '▼'); + NumCharTop := 5; + end; + // Paint arrow: + PaintInfo.TargetCanvas.TextOut(SortArea.Left, SortArea.Top, SortText); + // ... and superscript number right besides: + SortText := IfThen(ColSortIndex<9, NumSortChars[ColSortIndex], NumSortChars[9]); + PaintInfo.TargetCanvas.TextOut(SortArea.Left+9, SortArea.Top+NumCharTop, SortText); + end; + end; +end;} + + +{procedure TMainForm.DataGridBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); +var + vt: TVirtualStringTree; + Select, FixedFilter: String; + RefreshingData, IsKeyColumn, NeedFullColumns: Boolean; + i, ColWidth, VisibleColumns, MaximumRows, FullColumnCount: Integer; + ColMaxLen, Offset: Int64; + ColWidths, WantedColumnOrgnames: TStringList; + KeyCols, WantedColumns: TTableColumnList; + c, ColumnInKey: TTableColumn; + OldScrollOffset: TPoint; + DBObj: TDBObject; + rx: TRegExpr; + OldCursor: TBufferCoord; + Col: TVirtualTreeColumn; + + procedure InitColumn(idx: Integer; TblCol: TTableColumn); + var + k: Integer; + begin + col := vt.Header.Columns.Add; + col.Text := TblCol.Name; + col.Hint := TblCol.Comment; + col.Options := col.Options + [coSmartResize]; + if DatagridHiddenColumns.IndexOf(TblCol.Name) > -1 then + col.Options := col.Options - [coVisible]; + // Column header icon + for k:=0 to SelectedTableKeys.Count-1 do begin + if SelectedTableKeys[k].Columns.IndexOf(TblCol.Name) > -1 then begin + col.ImageIndex := SelectedTableKeys[k].ImageIndex; + break; + end; + end; + if col.ImageIndex = -1 then begin + if SelectedTableTimestampColumns.IndexOf(TblCol.Name) > -1 then + col.ImageIndex := 149; + end; + + // Text alignment in grid cells + col.Alignment := taLeftJustify; + if DataGridResult.DataType(idx).Category in [dtcInteger, dtcReal] then + col.Alignment := taRightJustify; + end; + +begin + // Load data into data tab grid + vt := Sender as TVirtualStringTree; + if vt.Tag = VTREE_LOADED then + Exit; + DBObj := ActiveDbObj; + if DBObj = nil then + Exit; + Screen.Cursor := crHourglass; + DBObj.Connection.Ping(True); + + if SelectedTableColumns.Count = 0 then begin + EnableDataTab(False); + end else begin + EnableDataTab(True); + + // Indicates whether the current table data is just refreshed or if we're in another table + // ... or maybe in a table/database with the same name on a different server + RefreshingData := DBObj.IsSameAs(DataGridTable); + + // Load last view settings + HandleDataGridAttributes(RefreshingData); + OldScrollOffset := DataGrid.OffsetXY; + + // Remember old column widths if customized + ColWidths := TStringList.Create; + if not RefreshingData then + FDataGridColumnWidthsCustomized := False; + if FDataGridColumnWidthsCustomized then begin + for i:=0 to vt.Header.Columns.Count-1 do + ColWidths.Values[vt.Header.Columns[i].Text] := IntToStr(vt.Header.Columns[i].Width); + end; + + DataGridTable := DBObj; + + Select := ''; + // Ensure key columns are included to enable editing + KeyCols := DBObj.Connection.GetKeyColumns(SelectedTableColumns, SelectedTableKeys); + WantedColumns := TTableColumnList.Create(False); + WantedColumnOrgnames := TStringList.Create; + FullColumnCount := 0; + // If any column has INVISIBLE attribute: + NeedFullColumns := False; + for i:=0 to SelectedTableColumns.Count-1 do begin + c := SelectedTableColumns[i]; + ColumnInKey := KeyCols.FindByName(c.Name); + IsKeyColumn := Assigned(ColumnInKey); + ColMaxLen := StrToInt64Def(c.LengthSet, 0); + if (DatagridHiddenColumns.IndexOf(c.Name) = -1) + or (IsKeyColumn) + or (KeyCols.Count = 0) + then begin + if not DataGridFullRowMode + and (KeyCols.Count > 0) // We need a sufficient key to be able to load remaining row data + and (c.DataType.LoadPart) + and (not IsKeyColumn) // We need full length of any key column, so DataGridLoadFullRow() has the chance to fetch the right row + and ((ColMaxLen > GRIDMAXDATA) or (ColMaxLen = 0)) // No need to blow SQL with LEFT() if column is shorter anyway + then begin + Select := Select + DBObj.Connection.GetSQLSpecifity(spFuncLeft, [c.CastAsText, GRIDMAXDATA]) + ', '; + end else if DBObj.Connection.Parameters.IsAnyMSSQL and (c.DataType.Index=dbdtTimestamp) then begin + Select := Select + ' CAST(' + DBObj.Connection.QuoteIdent(c.Name) + ' AS INT), '; + end else if DBObj.Connection.Parameters.IsAnyMSSQL and (c.DataType.Index=dbdtHierarchyid) then begin + Select := Select + ' CAST(' + DBObj.Connection.QuoteIdent(c.Name) + ' AS NVARCHAR('+IntToStr(GRIDMAXDATA)+')), '; + end else begin + Select := Select + ' ' + DBObj.Connection.QuoteIdent(c.Name) + ', '; + Inc(FullColumnCount); + end; + WantedColumns.Add(c); + WantedColumnOrgnames.Add(c.Name); + NeedFullColumns := NeedFullColumns or c.Invisible; + end; + end; + // Cut last comma + Delete(Select, Length(Select)-1, 2); + + // Shorten the whole query if all columns are involved + if (FullColumnCount = SelectedTableColumns.Count) and (not NeedFullColumns) then + Select := '*'; + + // Include db name for cases in which dbtree is switching databases and pending updates are in process + Select := Select + ' FROM '+DBObj.QuotedDbAndTableName; + + // Append WHERE clause, and gracefully allow superfluous WHERE from user input + // Also, don't add a "WHERE ..." when the filter contains comments only + if Length(Trim(TSQLBatch.GetSQLWithoutComments(SynMemoFilter.Text))) > 0 then begin + rx := TRegExpr.Create; + rx.ModifierI := True; + rx.Expression := '^\s*WHERE\s+'; + FixedFilter := rx.Replace(SynMemoFilter.Text, ''); + if FixedFilter <> SynMemoFilter.Text then begin + OldCursor := SynMemoFilter.CaretXY; + SynMemoFilter.Text := FixedFilter; + SynMemoFilter.CaretXY := OldCursor; + end; + rx.Free; + Select := Select + ' WHERE ' + SynMemoFilter.Text + CRLF; + tbtnDataFilter.ImageIndex := 108; + end else + tbtnDataFilter.ImageIndex := 107; + SynMemoFilter.OnStatusChange(SynMemoFilter, []); + + // Append ORDER clause + if FDataGridSortItems.Count > 0 then begin + Select := Select + ' ORDER BY ' + FDataGridSortItems.ComposeOrderClause(DBObj.Connection); + tbtnDataSorting.ImageIndex := 108; + tbtnDataSorting.Caption := _('Sorting') + ' ('+IntToStr(FDataGridSortItems.Count)+')'; + end else begin + tbtnDataSorting.ImageIndex := 107; + tbtnDataSorting.Caption := _('Sorting'); + end; + + // Append LIMIT clause + Offset := 0; + if RefreshingData and (vt.Tag <> VTREE_NOTLOADED_PURGECACHE) then begin + case DBObj.Connection.Parameters.NetTypeGroup of + ngMSSQL: Offset := 0; // Does not support offset in all server versions + ngMySQL, ngPgSQL, ngSQLite: Offset := DataGridResult.RecordCount; + else raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(DBObj.Connection.Parameters.NetType)]); + end; + end; + Select := DBObj.Connection.ApplyLimitClause('SELECT', Select, DatagridWantedRowCount-Offset, Offset); + + vt.BeginUpdate; + vt.Header.Columns.Clear; + vt.Clear; + + try + ShowStatusMsg(_('Fetching rows ...')); + // Result object must be of the right vendor type + if not RefreshingData then begin + FreeAndNil(DataGridResult); + DataGridResult := DBObj.Connection.Parameters.CreateQuery(DBObj.Connection); + end; + DataGridResult.DBObject := DBObj; + DataGridResult.SQL := Trim(Select); + DataGridResult.Execute(Offset > 0); + DataGridResult.ColumnOrgNames := WantedColumnOrgnames; + try + DataGridResult.PrepareEditing; + except on E:EDbError do // Do not annoy user with popup when accessing tables in information_schema + LogSQL(_('Data in this table will be read-only.')); + end; + + editFilterVT.Clear; + TimerFilterVT.OnTimer(Sender); + + // Assign new data + vt.RootNodeCount := DataGridResult.RecordCount; + + // Set up grid column headers + ShowStatusMsg(_('Setting up columns ...')); + VisibleColumns := 0; + Col := vt.Header.Columns.Add; + Col.CaptionAlignment := taRightJustify; + Col.Alignment := taRightJustify; + Col.Options := col.Options + [coFixed]- [coAllowClick, coAllowFocus, coEditable, coResizable]; + if not AppSettings.ReadBool(asShowRowId) then + Col.Options := col.Options - [coVisible]; + Col.Text := '#'; + for i:=0 to WantedColumns.Count-1 do begin + InitColumn(i, WantedColumns[i]); + if coVisible in vt.Header.Columns[i+1].Options then + Inc(VisibleColumns); + end; + + // Signal for the user if we hide some columns + if VisibleColumns = SelectedTableColumns.Count then + tbtnDataColumns.ImageIndex := 107 + else + tbtnDataColumns.ImageIndex := 108; + tbtnDataColumns.Caption := _('Columns') + ' ('+IntToStr(VisibleColumns)+'/'+IntToStr(SelectedTableColumns.Count)+')'; + + // Autoset or restore column width + for i:=0 to vt.Header.Columns.Count-1 do begin + ColWidth := 0; + if RefreshingData then + ColWidth := StrToIntDef(ColWidths.Values[vt.Header.Columns[i].Text], ColWidth); + if ColWidth > 0 then + vt.Header.Columns[i].Width := ColWidth + else + AutoCalcColWidth(vt, i); + end; + + except + // Wrong WHERE clause in most cases + on E:EDbError do + ErrorDialog(E.Message); + end; + + vt.EndUpdate; + ApplyFontToGrids; + + // Do not steel filter while writing filters + if not SynMemoFilter.Focused then + vt.TrySetFocus; + + DataGridFocusedNodeIndex := Min(DataGridFocusedNodeIndex, Int64(vt.RootNodeCount)-1); + SelectNode(vt, DataGridFocusedNodeIndex); + for i:=0 to vt.Header.Columns.Count-1 do begin + if vt.Header.Columns[i].Text = DataGridFocusedColumnName then begin + vt.FocusedColumn := i; + break; + end; + end; + if RefreshingData then begin + + if (FDataGridLastClickedColumnHeader >= 0) and (FDataGridLastClickedColumnHeader < vt.Header.Columns.Count) then begin // See issue #3309 + // Horizontal offset based on the left side of a just sorted column + OldScrollOffset.X := -(vt.Header.Columns[FDataGridLastClickedColumnHeader].Left - vt.OffsetX - FDataGridLastClickedColumnLeftPos); + // logsql('Fixing x-offset to '+OldScrollOffset.X.ToString + + // ', FDataGridLastClickedColumnHeader:'+FDataGridLastClickedColumnHeader.ToString + + // ', FDataGridLastClickedColumnLeftPos: '+FDataGridLastClickedColumnLeftPos.ToString + + // ', vt.Header.Columns[FDataGridLastClickedColumnHeader].Left: '+vt.Header.Columns[FDataGridLastClickedColumnHeader].Left.ToString + // ); + end; + + vt.OffsetXY := OldScrollOffset; + end; + + // Reset remembered data for last clicked column header + FDataGridLastClickedColumnHeader := NoColumn; + FDataGridLastClickedColumnLeftPos := -1; + + vt.Header.Invalidate(nil); + vt.UpdateScrollBars(True); + ValidateControls(Sender); + DisplayRowCountStats(vt); + MaximumRows := AppSettings.ReadInt(asDatagridMaximumRows); + actDataShowNext.Enabled := (vt.RootNodeCount = DatagridWantedRowCount) and (DatagridWantedRowCount < MaximumRows); + actDataShowAll.Enabled := actDataShowNext.Enabled; + EnumerateRecentFilters; + ColWidths.Free; + if Integer(vt.RootNodeCount) = MaximumRows then + LogSQL(f_('Browsing is currently limited to a maximum of %s rows. To see more rows, increase this maximum in %s > %s > %s.', [FormatNumber(MaximumRows), _('Tools'), _('Preferences'), _('Data')]), lcInfo); + end; + vt.Tag := VTREE_LOADED; + DataGridFullRowMode := False; + Screen.Cursor := crDefault; + ShowStatusMsg; +end;} + + +{procedure TMainForm.DataGridColumnResize(Sender: TVTHeader; Column: TColumnIndex); +begin + // Remember current table after last column resizing so we can auto size them as long as this did not happen + if not TBaseVirtualTree(Sender.Treeview).IsUpdating then + FDataGridColumnWidthsCustomized := True; +end;} + + +{*** + Calculate + display total rowcount and found rows matching to filter + in data-tab +} +{procedure TMainForm.DisplayRowCountStats(Sender: TBaseVirtualTree); +var + DBObject: TDBObject; + ObjInCache: PDBObject; + IsFiltered, IsLimited: Boolean; + cap: String; + RowsTotal: Int64; +begin + if Sender <> DataGrid then + Exit; // Only data tab has a top label + + DBObject := ActiveDbObj; + if DBObject = nil then // Some cases have no object, don't let them crash + Exit; + + cap := ActiveDatabase + '.' + DBObject.Name; + IsLimited := DataGridWantedRowCount <= Datagrid.RootNodeCount; + IsFiltered := SynMemoFilter.GetTextLen > 0; + if DBObject.NodeType = lntTable then begin + if (not IsLimited) and (not IsFiltered) then begin + RowsTotal := DataGrid.RootNodeCount; // No need to fetch via SHOW TABLE STATUS + DBObject.RowsAreExact := True; + menuQueryExactRowCount.Enabled := False; + end + else begin + Screen.Cursor := crHourGlass; + if (not DBObject.RowsAreExact) or FExactRowCountMode then + RowsTotal := DBObject.RowCount(True, FExactRowCountMode) + else + RowsTotal := DBObject.Rows; + Screen.Cursor := crDefault; + menuQueryExactRowCount.Enabled := True; + end; + if RowsTotal > -1 then begin + cap := cap + ': ' + FormatNumber(RowsTotal) + ' ' + _('rows total'); + if DBObject.Engine = 'InnoDB' then begin + if DBObject.RowsAreExact then + cap := cap + ' ('+_('exact')+')' + else + cap := cap + ' ('+_('approximately')+')'; + end; + // Display either LIMIT or WHERE effect, not both at the same time + if IsLimited then + cap := cap + ', '+_('limited to') + ' ' + FormatNumber(Datagrid.RootNodeCount) + else if IsFiltered then begin + if Datagrid.RootNodeCount = RowsTotal then + cap := cap + ', '+_('all rows match to filter') + else + cap := cap + ', ' + FormatNumber(Datagrid.RootNodeCount) + ' '+_('rows match to filter'); + end; + // Update cached object reference with new row count, which may enable "Data" option + // in table copy dialog. See issue #666 + if Assigned(DBtree.FocusedNode) then begin + ObjInCache := DBtree.GetNodeData(DBtree.FocusedNode); + if Assigned(ObjInCache) and ObjInCache.IsSameAs(DBObject) then begin + ObjInCache.Rows := RowsTotal; + ObjInCache.RowsAreExact := DBObject.RowsAreExact; + end; + end; + end; + end; + lblDataTop.Caption := cap; + lblDataTop.Hint := cap; + FExactRowCountMode := False; +end;} + + +{procedure TMainForm.menuQueryExactRowCountClick(Sender: TObject); +begin + // Activate exact row count mode and let DisplayRowCountStats do the rest + // See https://www.heidisql.com/forum.php?t=41310 + FExactRowCountMode := True; + DisplayRowCountStats(DataGrid); +end;} + + +{procedure TMainForm.AnyGridInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); +var + Idx: PInt64; +begin + // Display multiline grid rows + // Mark all nodes as multiline capable. Fixes painting issues with long lines. (?) + // See issue #1897 and https://www.heidisql.com/forum.php?t=41502 + // Laggy performance with large grid contents (?) + if AppSettings.ReadInt(asGridRowLineCount) = 1 then + Exclude(Node.States, vsMultiLine) + else + Include(Node.States, vsMultiLine); + Sender.NodeHeight[Node] := TVirtualStringTree(Sender).DefaultNodeHeight; + // Node may have data already, if added via InsertRow + if not (vsOnFreeNodeCallRequired in Node.States) then begin + Idx := Sender.GetNodeData(Node); + Idx^ := Node.Index; + end; +end;} + + +{procedure TMainForm.AnyGridGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); +begin + NodeDataSize := SizeOf(Int64); +end;} + + +{*** + Occurs when active tab has changed. +} +{procedure TMainForm.PageControlMainChange(Sender: TObject); +var + tab: TTabSheet; +begin + // Protect from crash when pressing ctrl+tab before main form is displayed + // See #574 + if not Self.Visible then + Exit; + + tab := PageControlMain.ActivePage; + // Query helpers need a hit here, since RefreshHelperNode now only does its update on the active tab + // See https://www.heidisql.com/forum.php?t=37961 + RefreshHelperNode(TQueryTab.HelperNodeColumns); + RefreshHelperNode(TQueryTab.HelperNodeSnippets); + RefreshHelperNode(TQueryTab.HelperNodeHistory); + + // Move focus to relevant controls in order for them to receive keyboard events. + // Do this only if the user clicked the new tab. Not on automatic tab changes. + if Sender = PageControlMain then begin + if tab = tabHost then + PageControlHostChange(Sender) + else if tab = tabDatabase then + ListTables.TrySetFocus + else if tab = tabData then begin + DataGrid.TrySetFocus; + end else if IsQueryTab(tab.PageIndex, True) then begin + QueryTabs.ActiveMemo.TrySetFocus; + QueryTabs.ActiveMemo.WordWrap := actQueryWordWrap.Checked; + SynMemoQueryStatusChange(QueryTabs.ActiveMemo, [scCaretX]); + end; + end; + + // Filter panel has one text per tab, which we need to update + UpdateFilterPanel(Sender); + + // Ensure controls are in a valid state + ValidateControls(Sender); + FixQueryTabCloseButtons; +end;} + + +{procedure TMainForm.PageControlMainChanging(Sender: TObject; var AllowChange: Boolean); +begin + // Leave editing mode on tab changes so the editor does not stay somewhere + if (ActiveGridEditor <> nil) + and Assigned(ActiveGridEditor.Tree) + and ActiveGridEditor.Tree.IsEditing then begin + LogSQL('Cancelling tree edit mode on '+ActiveGridEditor.Tree.Name, lcDebug); + ActiveGridEditor.Tree.CancelEditNode; + end; +end;} + + +{procedure TMainForm.PageControlHostChange(Sender: TObject); +var + tab: TTabSheet; + list: TBaseVirtualTree; +begin + tab := PageControlHost.ActivePage; + if tab = tabDatabases then list := ListDatabases + else if tab = tabVariables then list := ListVariables + else if tab = tabStatus then list := ListStatus + else if tab = tabProcesslist then list := ListProcesses + else if tab = tabCommandStats then list := ListCommandStats + else Exit; // Silence compiler warning + list.TrySetFocus; + UpdateFilterPanel(Sender); + PageControlTabHighlight(PageControlHost); +end;} + + +{procedure TMainForm.ListTablesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); +var + i, NumObj: Integer; + Obj: TDBObject; + Objects: TDBObjectList; + NumObjects: TStringList; + Msg: String; + vt: TVirtualStringTree; + Conn: TDBConnection; + ScrollOffset: TPoint; +begin + // DB-Properties + vt := Sender as TVirtualStringTree; + if vt.Tag = VTREE_LOADED then + Exit; + LogSQL('ListTablesBeforePaint', lcDebug); + Screen.Cursor := crHourGlass; + Conn := ActiveConnection; + ScrollOffset := vt.OffsetXY; + vt.BeginUpdate; + vt.Clear; + Msg := ''; + if Conn <> nil then begin + ShowStatusMsg(f_('Displaying objects from "%s" ...', [Conn.Database])); + Objects := Conn.GetDBObjects(Conn.Database, vt.Tag = VTREE_NOTLOADED_PURGECACHE, FActiveObjectGroup); + vt.RootNodeCount := Objects.Count; + + NumObjects := TStringList.Create; + FDBObjectsMaxSize := 1; + FDBObjectsMaxRows := 1; + for i:=0 to Objects.Count-1 do begin + Obj := Objects[i]; + NumObj := StrToIntDef(NumObjects.Values[Obj.ObjType], 0); + Inc(NumObj); + NumObjects.Values[Obj.ObjType] := IntToStr(NumObj); + if Obj.Size > FDBObjectsMaxSize then FDBObjectsMaxSize := Obj.Size; + if Obj.Rows > FDBObjectsMaxRows then FDBObjectsMaxRows := Obj.Rows; + end; + Msg := Conn.Database + ': ' + FormatNumber(Objects.Count) + ' '; + if NumObjects.Count = 1 then + Msg := Msg + LowerCase(NumObjects.Names[0]) + else + Msg := Msg + 'object'; + if Objects.Count <> 1 then Msg := Msg + 's'; + if (NumObjects.Count > 1) and (Objects.Count > 0) then begin + Msg := Msg + ' ('; + for i:=0 to NumObjects.Count-1 do begin + NumObj := StrToIntDef(NumObjects.ValueFromIndex[i], 0); + if NumObj = 0 then + Continue; + Msg := Msg + FormatNumber(NumObj) + ' ' + LowerCase(NumObjects.Names[i]); + if NumObj <> 1 then Msg := Msg + 's'; + Msg := Msg + ', '; + end; + Delete(Msg, Length(Msg)-1, 2); + Msg := Msg + ')'; + end; + end; + vt.OffsetXY := ScrollOffset; + vt.EndUpdate; + vt.Tag := VTREE_LOADED; + FListTablesSorted := False; + ShowStatusMsg(Msg, 0); + ShowStatusMsg; + ValidateControls(Self); + Screen.Cursor := crDefault; +end;} + + +{procedure TMainForm.ListTablesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); +var + Obj: PDBObject; +begin + if Column <> (Sender as TVirtualStringTree).Header.MainColumn then + Exit; + Obj := Sender.GetNodeData(Node); + case Kind of + ikNormal, ikSelected: + ImageIndex := Obj.ImageIndex; + ikOverlay: + ImageIndex := Obj.OverlayImageIndex; + end; +end;} + + +{procedure TMainForm.ListTablesGetNodeDataSize(Sender: TBaseVirtualTree; + var NodeDataSize: Integer); +begin + NodeDataSize := SizeOf(TDBObject); +end;} + + +{procedure TMainForm.ListTablesGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); +var + Obj: PDBObject; +begin + Obj := Sender.GetNodeData(Node); + CellText := ''; + case Column of + 0: begin + if Obj.Schema <> '' then + CellText := Obj.Schema + '.' + Obj.Name + else + CellText := Obj.Name; + if Sender.IsEditing and (Node = Sender.FocusedNode) then + CellText := Obj.Name; + end; + 1: if Obj.Rows > -1 then CellText := FormatNumber(Obj.Rows); + 2: if Obj.Size > -1 then CellText := FormatByteNumber(Obj.Size); + 3: CellText := DateTimeToStrDef(Obj.Created, ''); + 4: CellText := DateTimeToStrDef(Obj.Updated, ''); + 5: CellText := Obj.Engine; + 6: CellText := Obj.Comment; + 7: if Obj.Version > -1 then CellText := IntToStr(Obj.Version); + 8: CellText := Obj.RowFormat; + 9: if Obj.AvgRowLen > -1 then CellText := FormatByteNumber(Obj.AvgRowLen); + 10: if Obj.MaxDataLen > -1 then CellText := FormatByteNumber(Obj.MaxDataLen); + 11: if Obj.IndexLen > -1 then CellText := FormatByteNumber(Obj.IndexLen); + 12: if Obj.DataFree > -1 then CellText := FormatByteNumber(Obj.DataFree); + 13: if Obj.AutoInc > -1 then CellText := FormatNumber(Obj.AutoInc); + 14: if Obj.LastChecked <> 0 then CellText := DateTimeToStr(Obj.LastChecked); + 15: CellText := Obj.Collation; + 16: if Obj.Checksum > -1 then CellText := IntToStr(Obj.Checksum); + 17: CellText := Obj.CreateOptions; + 18: CellText := Obj.ObjType; + end; +end;} + + +{procedure TMainForm.ListTablesInitNode(Sender: TBaseVirtualTree; ParentNode, + Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); +var + Obj: PDBObject; + Objects: TDBObjectList; + Conn: TDBConnection; +begin + Conn := ActiveConnection; + Obj := Sender.GetNodeData(Node); + if (Conn <> nil) and (not Conn.Database.IsEmpty) then begin + Objects := Conn.GetDBObjects(Conn.Database, False, FActiveObjectGroup); + Obj^ := Objects[Node.Index]; + end else begin + Obj^ := nil; + LogSQL('InitNode on '+Sender.Name+' failed, due to no connection or no database set. Database: "'+Conn.Database+'"', lcDebug); + end; +end;} + + + +{*** + Selection in ListTables is changing +} +{procedure TMainForm.ListTablesChange(Sender: TBaseVirtualTree; Node: + PVirtualNode); +var + Msg: String; +begin + ValidateControls(Sender); + if ListTables.SelectedCount > 1 then + Msg := _('Selected') + ': ' + FormatNumber(ListTables.SelectedCount) + else + Msg := ''; + ShowStatusMsg(Msg, 1) +end;} + + +{*** + Enable/disable various buttons and menu items. + Invoked when + - active sheet changes + - highlighted database changes + ... +} +{procedure TMainForm.ValidateControls(Sender: TObject); +var + inDataTab, inDataOrQueryTab, inDataOrQueryTabNotEmpty, inGrid: Boolean; + HasConnection, GridHasChanges, EnableTimestamp: Boolean; + Grid: TVirtualStringTree; + inSynMemo, inSynMemoEditable: Boolean; + Results: TDBQuery; + RowNum: PInt64; + CellText: String; + Conn: TDBConnection; + ResultCol: Integer; +begin + // When adding some new TAction here, be sure to apply this procedure to its OnUpdate event + + Grid := ActiveGrid; + Conn := ActiveConnection; + HasConnection := Conn <> nil; + Results := nil; + GridHasChanges := False; + EnableTimestamp := False; + CellText := ''; + if HasConnection and Assigned(Grid) then begin + Results := GridResult(Grid); + ResultCol := Grid.FocusedColumn -1; + if (Results<>nil) and Assigned(Grid.FocusedNode) then begin + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; + GridHasChanges := Results.Modified or Results.Inserted; + if ResultCol > NoColumn then begin + EnableTimestamp := Results.DataType(ResultCol).Category in [dtcInteger, dtcReal]; + CellText := Results.Col(ResultCol, True); + end; + end; + end; + inDataTab := Grid = DataGrid; + inDataOrQueryTab := inDataTab or QueryTabs.HasActiveTab; + inDataOrQueryTabNotEmpty := inDataOrQueryTab and Assigned(Grid) and (Grid.RootNodeCount > 0); + inGrid := Assigned(Grid) and (ActiveControl = Grid); + + actFullRefresh.Enabled := HasConnection and (PageControlMain.ActivePage = tabDatabase); + actDataInsert.Enabled := HasConnection and inGrid and Assigned(Results); + actDataDuplicateRowWithoutKeys.Enabled := HasConnection and inGrid and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actDataDuplicateRowWithKeys.Enabled := actDataDuplicateRowWithoutKeys.Enabled; + actDataDelete.Enabled := HasConnection and inGrid and (Grid.SelectedCount > 0); + actDataFirst.Enabled := HasConnection and inDataOrQueryTabNotEmpty and inGrid; + actDataLast.Enabled := HasConnection and inDataOrQueryTabNotEmpty and inGrid; + actDataPostChanges.Enabled := HasConnection and GridHasChanges; + actDataCancelChanges.Enabled := HasConnection and GridHasChanges; + actDataSaveBlobToFile.Enabled := HasConnection and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actGridEditFunction.Enabled := HasConnection and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actDataPreview.Enabled := HasConnection and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actDataOpenUrl.Enabled := (Length(CellText)<SIZE_MB) and ExecRegExpr('^(https?://[^\s]+|www\.\w\S+)$', CellText); + actUnixTimestampColumn.Enabled := HasConnection and inDataTab and EnableTimestamp; + actUnixTimestampColumn.Checked := inDataTab and HandleUnixTimestampColumn(Grid, Grid.FocusedColumn); + actPreviousResult.Enabled := HasConnection and QueryTabs.HasActiveTab and Assigned(QueryTabs.ActiveTab.ActiveResultTab); + actNextResult.Enabled := actPreviousResult.Enabled; + + // Activate export-options if we're in any list control + actExportData.Enabled := HasConnection; + actDataSetNull.Enabled := HasConnection and inDataOrQueryTab and Assigned(Results) and Assigned(Grid.FocusedNode); + + // Help only supported on regular MySQL and MariaDB servers + actSQLHelp.Enabled := HasConnection; + + inSynMemo := ActiveSynMemo(True) <> nil; + inSynMemoEditable := inSynMemo and (not ActiveSynMemo(True).ReadOnly); + actSaveSynMemoToTextfile.Enabled := inSynMemo; + actToggleComment.Enabled := inSynMemoEditable; + if inSynMemo then begin + actCut.Enabled := inSynMemoEditable; + actPaste.Enabled := inSynMemoEditable; + end else begin + actCut.Enabled := True; + actPaste.Enabled := True; + end; + + ValidateQueryControls(Sender); + UpdateLineCharPanel; + PageControlTabHighlight(PageControlMain); +end;} + + +{procedure TMainForm.ValidateQueryControls(Sender: TObject); +var + NotEmpty, HasSelection, HasConnection: Boolean; + Tab: TQueryTab; + cap: String; + InQueryTab, InEditorTab: Boolean; + Conn: TDBConnection; +begin + // Enable/disable TActions, according to the current window/connection state + + // Prevent superfluous calls while setting up query tabs + if not MainFormAfterCreateDone then + Exit; + + for Tab in QueryTabs do begin + cap := Trim(Tab.TabSheet.Caption); + if cap[Length(cap)] = '*' then + cap := Copy(cap, 1, Length(cap)-1); + if Tab.Memo.Modified then + cap := cap + '*'; + if Tab.TabSheet.Caption <> cap then + SetTabCaption(Tab.TabSheet.PageIndex, cap); + end; + InQueryTab := QueryTabs.HasActiveTab; + InEditorTab := PageControlMain.ActivePage = tabEditor; + Tab := QueryTabs.ActiveTab; + NotEmpty := InQueryTab and (Tab.Memo.GetTextLen > 0); + HasSelection := InQueryTab and Tab.Memo.SelAvail; + Conn := ActiveConnection; + HasConnection := Conn <> nil; + actExecuteQuery.Enabled := HasConnection and InQueryTab and NotEmpty and (not Tab.QueryRunning); + actExecuteSelection.Enabled := HasConnection and InQueryTab and HasSelection and (not Tab.QueryRunning); + actExecuteCurrentQuery.Enabled := actExecuteQuery.Enabled; + actExplainCurrentQuery.Enabled := actExecuteQuery.Enabled and (Conn.Parameters.NetTypeGroup in [ngMySQL, ngPgSQL, ngSQLite]); + actSaveSQLAs.Enabled := InQueryTab and NotEmpty; + actSaveSQL.Enabled := (actSaveSQLAs.Enabled and Tab.Memo.Modified) or InEditorTab; + actSaveSQLselection.Enabled := InQueryTab and HasSelection; + actSaveSQLSnippet.Enabled := InQueryTab and NotEmpty; + actSaveSQLSelectionSnippet.Enabled := InQueryTab and HasSelection; + actClearQueryEditor.Enabled := InQueryTab; + actSetDelimiter.Enabled := InQueryTab; + actCloseQueryTab.Enabled := IsQueryTab(PageControlMain.ActivePageIndex, False); + actCloseAllQueryTabs.Enabled := QueryTabs.Count > 1; + actCodeFoldingStartRegion.Enabled := InQueryTab; + actCodeFoldingEndRegion.Enabled := InQueryTab; + actCodeFoldingFoldSelection.Enabled := HasSelection; + if InQueryTab then begin + if HasConnection and (Conn.Parameters.SessionColor <> clNone) then begin + Tab.Memo.Gutter.Color := Conn.Parameters.SessionColor; + end + else begin + Tab.Memo.Gutter.Color := clBtnFace; + end; + end; + +end;} + + +{procedure TMainForm.KillProcess(Sender: TObject); +var + t: Boolean; + pid: Int64; + Node: PVirtualNode; + Conn: TDBConnection; +begin + t := TimerRefresh.Enabled; + TimerRefresh.Enabled := false; // prevent av (ListProcesses.selected...) + Conn := ActiveConnection; + if MessageDialog('Kill '+IntToStr(ListProcesses.SelectedCount)+' Process(es)?', mtConfirmation, [mbok,mbcancel]) = mrok then + begin + Node := GetNextNode(ListProcesses, nil, True); + while Assigned(Node) do begin + pid := StrToInt64Def(ListProcesses.Text[Node, ListProcesses.Header.MainColumn], 0); + // Don't kill own process + if pid = Conn.ThreadId then + LogSQL(f_('Ignoring own process id #%d when trying to kill it.', [pid])) + else try + Conn.Query(Conn.GetSQLSpecifity(spKillProcess, [pid])); + except + on E:EDbError do begin + if Conn.LastErrorCode <> ER_NO_SUCH_THREAD then + if MessageDialog(E.Message, mtError, [mbOK, mbAbort]) = mrAbort then + break; + end; + end; + Node := GetNextNode(ListProcesses, Node, True); + end; + InvalidateVT(ListProcesses, VTREE_NOTLOADED, True); + end; + TimerRefresh.Enabled := t; // re-enable autorefresh timer +end;} + + +{procedure TMainForm.SynCompletionProposalChange(Sender: TObject; + AIndex: Integer); +var + Proposal: TSynCompletionProposal; + SelectedFuncName: String; + SQLFunc: TSQLFunction; +begin + Proposal := Sender as TSynCompletionProposal; + if (AIndex >= 0) and (AIndex < Proposal.ItemList.Count) then begin + Proposal.Title := Proposal.InsertItem(AIndex); + // Show function description in hint panel + ShowStatusMsg('', 0);} + //SelectedFuncName := RegExprGetMatch('}function\\column\{\}\\color\{\w+\}([^\\]+)\\', Proposal.DisplayItem(AIndex), 1); + {if not SelectedFuncName.IsEmpty then begin + for SQLFunc in ActiveConnection.SQLFunctions do begin + if SQLFunc.Name.ToUpper = SelectedFuncName.ToUpper then begin + ShowStatusMsg(SQLFunc.Description.Replace(SLineBreak, ' '), 0); + Break; + end; + end; + end; + end; +end;} + + +{ Proposal about to insert a String into synmemo } +{procedure TMainForm.SynCompletionProposalCodeCompletion(Sender: TObject; + var Value: String; Shift: TShiftState; Index: Integer; EndToken: Char); +var + Proposal: TSynCompletionProposal; + rx: TRegExpr; + ImageIndex, f: Integer; + FunctionDeclaration: String; +begin + Proposal := Sender as TSynCompletionProposal; + // Surround identifiers with backticks if it is a column, table, routine, db + rx := TRegExpr.Create;} + //rx.Expression := '\\image\{(\d+)\}'; + {if rx.Exec(Proposal.ItemList[Index]) then begin + ImageIndex := MakeInt(rx.Match[1]); + if not (ImageIndex in [ICONINDEX_KEYWORD, ICONINDEX_FUNCTION, 113]) then begin + FunctionDeclaration := ''; + f := Pos('(', Value); + if f > 0 then begin + FunctionDeclaration := Copy(Value, f, Length(Value)); + Delete(Value, f, Length(Value)); + end; + + rx.Expression := '^(['+QuoteRegExprMetaChars(ActiveConnection.QuoteChars)+'])(.*)$'; + if rx.Exec(Value) then begin + // Left character of identifier is already a quote: user wants to force quoting. + // Seperate that left quote character away from what gets now quoted automatically, and force quoting + Value := ActiveConnection.QuoteIdent(rx.Match[2], True) + FunctionDeclaration; + end else begin + // Identifier without left quote - quote when required + Value := ActiveConnection.QuoteIdent(Value, False) + FunctionDeclaration; + end; + end; + end; + rx.Free; + Proposal.Form.CurrentEditor.UndoList.AddGroupBreak; + // Hide hint text added in .OnChange event + ShowStatusMsg('', 0); +end;} + + +{procedure TMainForm.SynCompletionProposalAfterCodeCompletion(Sender: TObject; + const Value: String; Shift: TShiftState; Index: Integer; EndToken: Char); +var + Proposal: TSynCompletionProposal; +begin + Proposal := Sender as TSynCompletionProposal; + Proposal.Form.CurrentEditor.UndoList.AddGroupBreak; + // Explicitly set focus again to work around a bug in Ultramon, see issue #2396 + Proposal.Form.CurrentEditor.SetFocus; +end;} + + +{ Proposal-Combobox pops up } +{procedure TMainForm.SynCompletionProposalExecute(Kind: SynCompletionType; + Sender: TObject; var CurrentInput: String; var x, y: Integer; + var CanExecute: Boolean); +var + i, j, ImageIndex, ColumnsInList: Integer; + Results: TDBQuery; + DBObjects: TDBObjectList; + CurrentQuery, TableClauses, TableName, LeftPart, Token1, Token2, Token3, Token, Ident: String; + Tables: TStringList; + rx: TRegExpr; + Start, TokenTypeInt: Integer; + Attri: TSynHighlighterAttributes; + Proposal: TSynCompletionProposal; + Editor: TCustomSynEdit; + Queries: TSQLBatch; + Query: TSQLSentence; + Conn: TDBConnection; + RoutineEditor: TfrmRoutineEditor; + Param: TRoutineParam; + DisplayText: String; + SQLFunc: TSQLFunction; + + procedure AddTable(Obj: TDBObject); + var + FunctionDeclaration: String; + FuncParams: TRoutineParamList; + FuncParam: TRoutineParam; + begin + // Append routine parameter declaration + FunctionDeclaration := ''; + if Obj.NodeType in [lntProcedure, lntFunction] then begin + FuncParams := TRoutineParamList.Create(True); + Obj.Connection.ParseRoutineStructure(Obj, FuncParams); + for FuncParam in FuncParams do begin + FunctionDeclaration := FunctionDeclaration + FuncParam.Name + ', '; + end; + if FunctionDeclaration <> '' then begin + Delete(FunctionDeclaration, Length(FunctionDeclaration)-1, 2); + FunctionDeclaration := '(' + FunctionDeclaration + ')'; + end; + FuncParams.Free; + end; + + DisplayText := SynCompletionProposalPrettyText(Obj.ImageIndex, _(LowerCase(Obj.ObjType)), Obj.Name, FunctionDeclaration); + Proposal.AddItem(DisplayText, Obj.Name+FunctionDeclaration); + end; + + procedure AddColumns(const LeftToken: String); + var + dbname, tblname: String; + Columns: TTableColumnList; + Col: TTableColumn; + Keys: TTableKeyList; + Key: TTableKey; + Obj: TDBObject; + ColumnIcon: Integer; + begin + dbname := ''; + tblname := LeftToken; + if Pos('.', tblname) > -1 then begin + dbname := Copy(tblname, 0, Pos('.', tblname)-1); + tblname := Copy(tblname, Pos('.', tblname)+1, Length(tblname)); + end; + // db and table name may already be quoted + if dbname = '' then + dbname := Conn.Database; + dbname := Conn.DeQuoteIdent(dbname); + tblname := Conn.DeQuoteIdent(tblname); + DBObjects := Conn.GetDBObjects(dbname); + for Obj in DBObjects do begin + if (Obj.Name.ToLowerInvariant = tblname.ToLowerInvariant) and (Obj.NodeType in [lntTable, lntView]) then begin + Columns := Obj.TableColumns; + Keys := Obj.TableKeys; + for Col in Columns do begin + // Detect index icon, if any + ColumnIcon := ICONINDEX_FIELD; + for Key in Keys do begin + if Key.Columns.Contains(Col.Name) then begin + ColumnIcon := Key.ImageIndex; + Break; + end; + end; + // Put formatted text and icon into proposal + DisplayText := SynCompletionProposalPrettyText(ColumnIcon, LowerCase(Col.DataType.Name), Col.Name, Col.Comment, DatatypeCategories[Col.DataType.Category].NullColor); + if CurrentInput.StartsWith(Conn.QuoteChar) then + Proposal.AddItem(DisplayText, Conn.QuoteChar + Col.Name) + else + Proposal.AddItem(DisplayText, Col.Name); + Inc(ColumnsInList); + end; + Columns.Free; + break; + end; + end; + end; + +begin + Proposal := Sender as TSynCompletionProposal; + Proposal.Font.Assign(Font); + Proposal.TitleFont.Size := Proposal.Font.Size; + Proposal.ItemHeight := ScaleSize(PROPOSAL_ITEM_HEIGHT); + Proposal.ClearList; + Proposal.Columns[0].ColumnWidth := ScaleSize(100); // Kind of random value, but fits well + Proposal.Columns[1].ColumnWidth := ScaleSize(100); + Conn := ActiveConnection; + Editor := Proposal.Form.CurrentEditor; + Editor.GetHighlighterAttriAtRowColEx(Editor.PrevWordPos, Token, TokenTypeInt, Start, Attri); + CanExecute := AppSettings.ReadBool(asCompletionProposal) and + (not (TtkTokenKind(TokenTypeInt) in [SynHighlighterSQL.tkString, SynHighlighterSQL.tkComment])); + if not CanExecute then + Exit; + + // Work around for issue #2640. See ApplicationDeActivate + Proposal.Form.Enabled := True; + + rx := TRegExpr.Create; + + // Find token1.token2.token3, while cursor is somewhere in token3 + Ident := '[^\s,=\.]'; + rx.Expression := '(('+Ident+'+)\.)?('+Ident+'+)\.('+Ident+'*)$'; + LeftPart := Copy(Editor.LineText, 1, Editor.CaretX-1); + if rx.Exec(LeftPart) then begin + Token1 := Conn.DeQuoteIdent(rx.Match[2]); + Token2 := Conn.DeQuoteIdent(rx.Match[3]); + Token3 := Conn.DeQuoteIdent(rx.Match[4]); + end; + + // Server variables, s'il vous plait? + rx.Expression := '^@@(SESSION|GLOBAL)$'; + rx.ModifierI := True; + if rx.Exec(Token2) then begin + try + Results := Conn.GetResults('SHOW '+UpperCase(rx.Match[1])+' VARIABLES'); + while not Results.Eof do begin + DisplayText := SynCompletionProposalPrettyText(ICONINDEX_PRIMARYKEY, _('Variable'), Results.Col(0), StringReplace(Results.Col(1), '\', '\\', [rfReplaceAll])); + Proposal.AddItem(DisplayText, Results.Col(0)); + Results.Next; + end; + except + // Just log error in sql log, do not disturb user while typing + end; + end else begin + // Get column names into the proposal pulldown + // when we write sql like "SELECT t.|col FROM table [AS] t" + // Current limitation: Identifiers (masked or not) containing + // spaces are not detected correctly. + + // 1. find currently edited sql query around the cursor position in synmemo + if Editor = SynMemoFilter then begin + // Make sure the below regexp can find structure + CurrentQuery := 'SELECT * FROM '+ActiveDbObj.QuotedName+' WHERE ' + Editor.Text; + end else begin + // In a query tab + Queries := TSQLBatch.Create; + Queries.SQL := Editor.Text; + for Query in Queries do begin + if (Query.LeftOffset <= Editor.SelStart) and (Editor.SelStart < Query.RightOffset) then begin + CurrentQuery := Query.SQLWithoutComments; + Break; + end; + end; + Queries.Free; + end; + + // 2. Parse FROM clause, detect relevant table/view, probably aliased + rx.ModifierG := True; + rx.ModifierI := True; + rx.Expression := '\b(FROM|INTO|UPDATE)\s+(IGNORE\s+)?(.+)(WHERE|HAVING|ORDER|GROUP)?'; + if rx.Exec(CurrentQuery) then begin + TableClauses := rx.Match[3]; + // Ensure tables in JOIN clause(s) are splitted by comma + TableClauses := ReplaceRegExpr('\sJOIN\s', TableClauses, ',', [rroModifierI]); + // Remove surrounding parentheses + TableClauses := StringReplace(TableClauses, '(', ' ', [rfReplaceAll]); + TableClauses := StringReplace(TableClauses, ')', ' ', [rfReplaceAll]); + // Split table clauses by commas + Tables := TStringList.Create; + Tables.Delimiter := ','; + Tables.StrictDelimiter := true; + Tables.DelimitedText := TableClauses; + rx.Expression := '(\S+)\s+(AS\s+)?(\S+)'; + + for i := 0 to Tables.Count - 1 do begin + // If the just typed word equals the alias of this table or the + // tablename itself, set tablename var and break loop + if rx.Exec(Tables[i]) then while true do begin + if Token2 = Conn.DeQuoteIdent(rx.Match[3]) then begin + TableName := rx.Match[1]; + break; + end; + if not rx.ExecNext then + break; + end; + if TableName <> '' then + break; + end; + end; + + ColumnsInList := 0; + if TableName <> '' then + AddColumns(TableName) + else if Token1 <> '' then + AddColumns(Conn.QuoteIdent(Token1, False)+'.'+Conn.QuoteIdent(Token2, False)) + else if Token2 <> '' then + AddColumns(Conn.QuoteIdent(Token2, False)); + + if Token1 = '' then begin + i := Conn.AllDatabases.IndexOf(Token2); + if i > -1 then begin + // Tables from specific database + Screen.Cursor := crHourGlass; + DBObjects := Conn.GetDBObjects(Conn.AllDatabases[i]); + Conn.PrefetchCreateCode(DBObjects); + for j:=0 to DBObjects.Count-1 do + AddTable(DBObjects[j]); + Conn.PurgePrefetchResults; + Screen.Cursor := crDefault; + end; + end; + + if Token2 = '' then begin + + // Column names from selected table, in data filter memo. + // For query memo only if no columns were added from left side table. + if ColumnsInList = 0 then begin + // Avoid usage of .QuotedName so we don't get the schema in it, see https://www.heidisql.com/forum.php?t=35411 + AddColumns(Conn.QuoteIdent(ActiveDbObj.Name)); + end; + + // All databases + for i:=0 to Conn.AllDatabases.Count-1 do begin + DisplayText := SynCompletionProposalPrettyText(ICONINDEX_DB, _('database'), Conn.AllDatabases[i], ''); + Proposal.AddItem(DisplayText, Conn.AllDatabases[i]); + end; + + // Tables from current db + if Conn.Database <> '' then begin + DBObjects := Conn.GetDBObjects(Conn.Database); + Conn.PrefetchCreateCode(DBObjects); + for j:=0 to DBObjects.Count-1 do + AddTable(DBObjects[j]); + Conn.PurgePrefetchResults; + if Token1 <> '' then // assume that we have already a dbname in memo + Proposal.Position := Conn.AllDatabases.Count; + end; + + // Functions + for SQLFunc in Conn.SQLFunctions do begin + DisplayText := SynCompletionProposalPrettyText(ICONINDEX_FUNCTION, _('function'), SQLFunc.Name, SQLFunc.Declaration); + Proposal.AddItem(DisplayText, SQLFunc.Name + SQLFunc.Declaration); + end; + + + // Keywords + for i:=0 to MySQLKeywords.Count-1 do begin + DisplayText := SynCompletionProposalPrettyText(ICONINDEX_KEYWORD, _('keyword'), MySQLKeywords[i], ''); + Proposal.AddItem(DisplayText, MySQLKeywords[i]); + end; + + // Procedure params + if GetParentFormOrFrame(Editor) is TfrmRoutineEditor then begin + RoutineEditor := GetParentFormOrFrame(Editor) as TfrmRoutineEditor; + for Param in RoutineEditor.Parameters do begin + if Param.Context = 'IN' then ImageIndex := 120 + else if Param.Context = 'OUT' then ImageIndex := 121 + else if Param.Context = 'INOUT' then ImageIndex := 122 + else ImageIndex := -1; + DisplayText := SynCompletionProposalPrettyText(ImageIndex, Param.Datatype, Param.Name, ''); + Proposal.AddItem(DisplayText, Param.Name); + end; + end; + + end; + + end; + rx.Free; + +end;} + + +{procedure TMainForm.SynMemoQueryScanForFoldRanges(Sender: TObject; + FoldRanges: TSynFoldRanges; LinesToScan: TStrings; FromLine, ToLine: Integer); +var + Line: Integer; + LineText: String; +begin + // Code folding detection based on keywords in beginning of lines + for Line:=FromLine to ToLine do begin + LineText := LinesToScan[Line].TrimLeft; + if LineText.StartsWith('#region', True) then + FoldRanges.StartFoldRange(Line+1, FoldRegionType) + else if LineText.StartsWith('#endregion', True) then + FoldRanges.StopFoldRange(Line+1, FoldRegionType) + else + FoldRanges.NoFoldInfo(Line+1); + end; +end;} + + +{procedure TMainForm.SynMemoQuerySpecialLineColors(Sender: TObject; + Line: Integer; var Special: Boolean; var FG, BG: TColor); +var + Edit: TSynMemo; + Tab: TQueryTab; +begin + // Paint error line with red background + Edit := Sender as TSynMemo; + Tab := QueryTabs.TabByControl(Edit); + if Tab <> QueryTabs.ActiveTab then + Exit; + if Line = Tab.ErrorLine then begin + Special := True; + FG := ErrorLineForeground; + BG := ErrorLineBackground; + end; +end;} + + +{procedure TMainForm.SynMemoSQLLogSpecialLineColors(Sender: TObject; + Line: Integer; var Special: Boolean; var FG, BG: TColor); +var + Edit: TSynMemo; + LineText, Search: String; +begin + // Paint error line with red background, or warning in orange + Edit := Sender as TSynMemo; + LineText := Copy(Edit.Lines[Line-1], 1, 100); + Search := _(MsgSQLError); + Search := Copy(Search, 1, Pos('%', Search)-1); + //Logsql(LineText+' ::: '+Search); + if LineText.Contains(Search) then begin + Special := True; + FG := ErrorLineForeground; + BG := ErrorLineBackground; + end + else if LineText.Contains(_(SLogPrefixWarning)+':') then begin + Special := True; + FG := WarningLineForeground; + BG := WarningLineBackground; + end + else if LineText.Contains(_(SLogPrefixNote)+':') then begin + Special := True; + FG := NoteLineForeground; + BG := NoteLineBackground; + end + else if LineText.Contains(_(SLogPrefixInfo)+':') then begin + Special := True; + FG := InfoLineForeground; + BG := InfoLineBackground; + end; +end;} + + +{procedure TMainForm.SynMemoQueryStatusChange(Sender: TObject; Changes: TSynStatusChanges); +var + Edit: TSynMemo; + Tab: TQueryTab; + ContentOrCursor: Boolean; +begin + if not MainFormAfterCreateDone then + Exit; + + Edit := Sender as TSynMemo; + Tab := QueryTabs.TabByControl(Edit); + if Tab <> QueryTabs.ActiveTab then + Exit; + + ContentOrCursor := (scCaretX in Changes) or (scCaretY in Changes) or (scModified in Changes); + if ContentOrCursor then begin + // Disable error marker + Tab.ErrorLine := -1; + + // Check if bind param detection is enabled for text size <1M + // Uncheck checkbox if it's bigger + // Code moved back from TQueryTab.MemoOnChange here + Tab.TimerLastChange.Enabled := False; + Tab.FLastChange := Now; + Tab.TimerLastChange.Enabled := True; + + // Don't ask for saving empty contents. See issue #614 + if Edit.GetTextLen = 0 then begin + Tab.MemoFilename := ''; + Tab.Memo.Modified := False; + end; + + // Update various controls + ValidateQueryControls(Sender); + + UpdateLineCharPanel; + end; +end;} + + +{procedure TMainForm.SynMemoQueryTokenHint(Sender: TObject; Coords: TBufferCoord; + const Token: string; TokenType: Integer; Attri: TSynHighlighterAttributes; + var HintText: string); +var + SQLFunc: TSQLFunction; + Conn: TDBConnection; + AllObjects: TDBObjectList; + Obj: TDBObject; + i, ColumnNameChars: Integer; + Column: TTableColumn; + Parameters: TRoutineParamList; + Params: TStringList; + Param: TRoutineParam; +begin + // Activate hint for SQL function in query editors + Conn := ActiveConnection; + if Assigned(Conn) then begin + case TtkTokenKind(TokenType) of + + SynHighlighterSQL.tkFunction: begin + for SQLFunc in ActiveConnection.SQLFunctions do begin + if SQLFunc.Name.ToUpper = Token.ToUpper then begin + HintText := SQLFunc.Name + SQLFunc.Declaration + sLineBreak + sLineBreak + SQLFunc.Description; + Break; + end; + end; + end; + + SynHighlighterSQL.tkTableName: begin + // Show some details from table listing cache + if (not Conn.IsLockedByThread) and Conn.DbObjectsCached(Conn.Database) then begin + AllObjects := Conn.GetDBObjects(Conn.Database); + for Obj in AllObjects do begin + if (Obj.NodeType = lntTable) and (Obj.Name.ToLower = Token.ToLower) then begin + HintText := _(Obj.ObjType) + ' ' + Obj.Name + ':' + sLineBreak + + _('Rows') + ': ' + FormatNumber(Obj.Rows) + sLineBreak + + _('Size') + ': ' + FormatByteNumber(Obj.DataLen + Obj.IndexLen) + SLineBreak; + ColumnNameChars := 0; + for Column in Obj.TableColumns do begin + ColumnNameChars := Max(ColumnNameChars, Length(Column.Name)); + end; + for Column in Obj.TableColumns do begin + HintText := HintText + Format('%s%'+ColumnNameChars.ToString+'s: %s', [SLineBreak, Column.Name, Column.FullDataType]); + end; + + Break; + end; + end; + end; + end; + + SynHighlighterSQL.tkProcName: begin + // Show routine parameters, comment and body + if (not Conn.IsLockedByThread) and Conn.DbObjectsCached(Conn.Database) then begin + AllObjects := Conn.GetDBObjects(Conn.Database); + for Obj in AllObjects do begin + if (Obj.NodeType in [lntFunction, lntProcedure]) and (Obj.Name.ToLower = Token.ToLower) then begin + Parameters := TRoutineParamList.Create; + Conn.ParseRoutineStructure(Obj, Parameters); + HintText := _(Obj.ObjType) + ' ' + Obj.Name; + Params := TStringList.Create; + for Param in Parameters do begin + Params.Add(Param.Name + ' ['+Param.Datatype+']'); + end; + HintText := HintText + '(' + Implode(', ', Params) + ')' + sLineBreak + sLineBreak; + Params.Free; + if not Obj.Returns.IsEmpty then + HintText := HintText + 'Returns: ' + Obj.Returns + sLineBreak + sLineBreak; + if not Obj.Comment.IsEmpty then + HintText := HintText + Obj.Comment + sLineBreak + sLineBreak; + if not Obj.Body.IsEmpty then + HintText := HintText + StrEllipsis(Obj.Body, SIZE_KB); + HintText := Trim(HintText); + Break; + end; + end; + end; + end; + + SynHighlighterSQL.tkDatatype: begin + for i:=Low(Conn.Datatypes) to High(Conn.Datatypes) do begin + if Conn.Datatypes[i].Name.ToLower = Token.ToLower then begin + HintText := WrapText(Conn.Datatypes[i].Description, 100); + Break; + end; + end; + end; + + SynHighlighterSQL.tkString: begin + HintText := _('String:') + ' ' + FormatByteNumber(Length(Token)); + end; + + end; + end; +end;} + +{procedure TMainForm.TimerHostUptimeTimer(Sender: TObject); +var + Conn: TDBConnection; + Uptime: Integer; + ServerNow: TDateTime; + ServerNowStr: String; +begin + // Display server uptime and current date time + Conn := ActiveConnection; + if Assigned(Conn) then begin + Uptime := Conn.ServerUptime; + if Uptime >= 0 then + ShowStatusMsg(_('Uptime')+': '+FormatTimeNumber(Conn.ServerUptime, False), 4) + else + ShowStatusMsg(_('Uptime')+': '+_('unknown'), 4); + + ServerNow := Conn.ServerNow; + if ServerNow >= 0 then begin + DateTimeToString(ServerNowStr, 't', ServerNow); + ShowStatusMsg(f_('Server time: %s', [ServerNowStr]), 5) + end else + ShowStatusMsg(f_('Server time: %s', [_('unknown')]), 5); + end else begin + ShowStatusMsg('', 4); + end; + +end;} + + +{procedure TMainForm.TimerRefreshTimer(Sender: TObject); +begin + // Auto-refreshing grid or list. Only if main form is active, to prevent issues like #669 + if Screen.ActiveForm = Self then + actRefresh.Execute; +end;} + + +{procedure TMainForm.ListTablesEditing(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); +var + Obj: PDBObject; +begin + // Tables and views can be renamed, routines cannot + if Assigned(Node) then begin + Obj := Sender.GetNodeData(Node); + Allowed := Obj.NodeType in [lntTable, lntView]; + end; +end;} + + +{*** + Rename table after checking the new name for invalid characters +} +{procedure TMainForm.ListTablesNewText(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; NewText: String); +var + Obj: PDBObject; + sql: String; +begin + // Fetch data from node + Obj := Sender.GetNodeData(Node); + + // Try to rename, on any error abort and don't rename ListItem + try + // rename table + case Obj.NodeType of + lntTable: + sql := Obj.Connection.GetSQLSpecifity(spRenameTable); + lntView: + sql := Obj.Connection.GetSQLSpecifity(spRenameView); + else + raise EDbError.Create('Cannot rename '+Obj.ObjType); + end; + + sql := Format(sql, [Obj.QuotedName(True, False), Obj.Connection.QuoteIdent(NewText)]); + Obj.Connection.Query(sql); + + if SynSQLSynUsed.TableNames.IndexOf( NewText ) = -1 then begin + SynSQLSynUsed.TableNames.Add(NewText); + end; + // Update nodedata + Obj.Name := NewText; + Obj.UnloadDetails; + // Now the active tree db has to be updated. But calling RefreshTreeDB here causes an AV + // so we do it manually here + DBTree.InvalidateChildren(FindDBNode(DBtree, Obj.Connection, Obj.Database), True); + except + on E:EDbError do + ErrorDialog(E.Message); + end; +end;} + + +{procedure TMainForm.TimerConnectedTimer(Sender: TObject); +var + ConnectedTime: Integer; + Conn: TDBConnection; +begin + Conn := ActiveConnection; + if (Conn <> nil) and Conn.Active then begin + // Calculate and display connection-time. Also, on any connect or reconnect, update server version panel. + ConnectedTime := Conn.ConnectionUptime; + ShowStatusMsg(_('Connected')+': ' + FormatTimeNumber(ConnectedTime, False), 2); + end else begin + ShowStatusMsg(_('Disconnected'), 2); + end; +end;} + + +{procedure TMainForm.Copylinetonewquerytab1Click(Sender: TObject); +var + Tab: TQueryTab; + LineText: String; +begin + // Create new query tab with current line in SQL log. This is for lazy mouse users. + if actNewQueryTab.Execute then begin + Tab := QueryTabs[MainForm.QueryTabs.Count-1]; + LineText := SynMemoSQLLog.LineText; + if AppSettings.ReadBool(asLogTimestamp) then + LineText := ReplaceRegExpr('^\s*\[[^\]]+\]\s', LineText, ''); + Tab.Memo.Text := LineText; + end; +end;} + + +{procedure TMainForm.QuickFilterClick(Sender: TObject); +var + Filter, Val, Col: String; + TableCol: TTableColumn; + Act: TAction; + Item: TMenuItem; + Conn: TDBConnection; + ShiftKeyPressed: Boolean; +begin + // Set filter for "where..."-clause + if (PageControlMain.ActivePage <> tabData) or (DataGrid.FocusedColumn = NoColumn) then + Exit; + + Filter := ''; + Conn := ActiveConnection; + ShiftKeyPressed := KeyPressed(VK_SHIFT); + + if Sender is TAction then begin + // Normal case for most quick filters + Act := Sender as TAction; + if ExecRegExpr('Prompt\d+$', Act.Name) then begin + // Item needs prompt + TableCol := SelectedTableFocusedColumn; + Col := Conn.QuoteIdent(TableCol.Name, False); + + if (TableCol.DataType.Index = dbdtJson) + and (Conn.Parameters.NetTypeGroup = ngPgSQL) then begin + Col := Col + '::text'; + end; + Val := DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn]; + if InputQuery(_('Specify filter-value...'), Act.Caption, Val) then begin + if Act = actQuickFilterPrompt1 then + Filter := Col + ' = ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt2 then + Filter := Col + ' != ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt3 then + Filter := Col + ' > ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt4 then + Filter := Col + ' < ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt5 then + Filter := Conn.GetSQLSpecifity(spLikeCompare, [Col, Conn.EscapeString('%'+Val+'%', TableCol.DataType)]); + end; + end + else begin + Filter := Act.Hint; + end; + end + else if Sender is TMenuItem then begin + // Sender is one of the subitems in "More values" menu + Item := Sender as TMenuItem; + Filter := Item.Hint; + end; + + if Filter <> '' then begin + if ExecRegExpr('\s+LIKE\s+''', Filter) then + Filter := Filter + Conn.LikeClauseTail; + + SynMemoFilter.UndoList.AddGroupBreak; + SynMemoFilter.SelectAll; + if ShiftKeyPressed + and (Pos(Filter, SynMemoFilter.Text) = 0) and (Pos(SynMemoFilter.Text, Filter) = 0) + and (not SynMemoFilter.Text.Trim.IsEmpty) + then begin + SynMemoFilter.SelText := SynMemoFilter.Text + ' AND ' + Filter + end else begin + SynMemoFilter.SelText := Filter; + end; + ToggleFilterPanel(True); + actApplyFilterExecute(Sender); + end; +end;} + + +{procedure TMainForm.popupQueryPopup(Sender: TObject); +var + SQLFuncs: TSQLFunctionList; + i, j: Integer; + miGroup, miFunction: TMenuItem; +begin + // Sets cursor into memo and activates TAction(s) like paste + QueryTabs.ActiveMemo.SetFocus; + // Create function menu items in popup menu + menuQueryInsertFunction.Clear; + SQLFuncs := ActiveConnection.SQLFunctions; + for i:=0 to SQLFuncs.Categories.Count-1 do begin + // Create a menu item which gets subitems later + miGroup := TMenuItem.Create(popupQuery); + miGroup.Caption := SQLFuncs.Categories[i]; + menuQueryInsertFunction.Add(miGroup); + for j:=0 to SQLFuncs.Count-1 do begin + if SQLFuncs[j].Category <> SQLFuncs.Categories[i] then + Continue; + miFunction := TMenuItem.Create(popupQuery); + miFunction.Caption := SQLFuncs[j].Name; + miFunction.ImageIndex := 13; + // Prevent generating a hotkey + miFunction.Caption := StringReplace(miFunction.Caption, '&', '&&', [rfReplaceAll]); + // Prevent generating a seperator line + if miFunction.Caption = '-' then + miFunction.Caption := '&-'; + miFunction.Hint := SQLFuncs[j].Name + SQLFuncs[j].Declaration + ' - ' + StrEllipsis(SQLFuncs[j].Description, 200); + // Prevent generating a seperator for ShortHint and LongHint + miFunction.Hint := StringReplace( miFunction.Hint, '|', '¦', [rfReplaceAll] ); + miFunction.Tag := j; + // Place menuitem on menu + miFunction.OnClick := insertFunction; + miGroup.Add(miFunction); + end; + end; +end;} + + +{procedure TMainForm.popupSqlLogPopup(Sender: TObject); +begin + // Update popupMenu items + menuLogToFile.Checked := FLogToFile; + menuOpenLogFolder.Enabled := FLogToFile; +end;} + + +{procedure TMainForm.AutoRefreshSetInterval(Sender: TObject); +var + SecondsStr: String; + Seconds: Extended; +begin + // set interval for autorefresh-timer + SecondsStr := FloatToStr(TimerRefresh.interval div 1000); + if InputQuery(_('Auto refresh'),_('Refresh list every ... second(s):'), SecondsStr) then begin + Seconds := StrToFloatDef(SecondsStr, 0); + if Seconds > 0 then begin + TimerRefresh.Interval := Trunc(Seconds * 1000); + TimerRefresh.Enabled := true; + menuAutoRefresh.Checked := true; + end + else + ErrorDialog(f_('Seconds must be between 0 and %d.', [maxint])); + end; +end;} + +{procedure TMainForm.AutoRefreshToggle(Sender: TObject); +begin + // enable autorefresh-timer + TimerRefresh.Enabled := not TimerRefresh.Enabled; + menuAutoRefresh.Checked := TimerRefresh.Enabled; +end;} + +{procedure TMainForm.SynMemoQueryDragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +var + src : TControl; + Memo: TSynMemo; + H: TVirtualStringTree; +begin + // dragging an object over the query-memo + Memo := QueryTabs.ActiveMemo; + src := Source as TControl; + // Accepting drag's from the same editor, from DBTree and from QueryHelpers + H := QueryTabs.ActiveHelpersTree; + Accept := (src = DBtree) or ((src = H) and Assigned(H.FocusedNode) and (H.GetNodeLevel(H.FocusedNode) in [1,2])); + // set x-position of cursor + Memo.CaretX := (x - Memo.Gutter.Width) div Memo.CharWidth - 1 + Memo.LeftChar; + // set y-position of cursor + Memo.CaretY := y div Memo.LineHeight + Memo.TopLine; + if not Memo.Focused then + Memo.SetFocus; +end;} + + +{procedure TMainForm.SynMemoQueryDragDrop(Sender, Source: TObject; X, + Y: Integer); +var + src : TControl; + Text, ItemText: String; + ShiftPressed: Boolean; + Tree: TVirtualStringTree; + Node: PVirtualNode; + History: TQueryHistory; +begin + // dropping a tree node or listbox item into the query-memo + QueryTabs.ActiveMemo.UndoList.AddGroupBreak; + src := Source as TControl; + Text := ''; + ShiftPressed := KeyPressed(VK_SHIFT); + Tree := QueryTabs.ActiveHelpersTree; + // Check for allowed controls as source has already + // been performed in OnDragOver. So, only do typecasting here. + if src = DBtree then begin + // Insert table or database name. If a table is dropped and Shift is pressed, prepend the db name. + case ActiveDbObj.NodeType of + lntDb: Text := ActiveDbObj.QuotedDatabase(False); + lntTable..lntEvent: begin + if ShiftPressed then + Text := ActiveDbObj.QuotedDatabase(False) + '.'; + Text := Text + ActiveDbObj.QuotedName(False); + end; + end; + end else if src = Tree then begin + case Tree.GetNodeLevel(Tree.FocusedNode) of + 1: + case Tree.FocusedNode.Parent.Index of + TQueryTab.HelperNodeSnippets: + Text := ReadTextFile(AppSettings.DirnameSnippets + Tree.Text[Tree.FocusedNode, 0] + '.sql', nil); + TQueryTab.HelperNodeHistory: + Text := ''; + else begin + Node := Tree.GetFirstChild(Tree.FocusedNode.Parent); + while Assigned(Node) do begin + if Tree.Selected[Node] then begin + ItemText := Tree.Text[Node, 0]; + if Node.Parent.Index = TQueryTab.HelperNodeColumns then + ItemText := ActiveConnection.QuoteIdent(ItemText, False); // Quote column names + if ShiftPressed then + Text := Text + ItemText + ',' + CRLF + else + Text := Text + ItemText + ', '; + end; + Node := Tree.GetNextSibling(Node); + end; + Delete(Text, Length(Text)-1, 2); + end; + end; + 2: + case Tree.FocusedNode.Parent.Parent.Index of + TQueryTab.HelperNodeHistory: begin + History := QueryTabs.ActiveTab.HistoryDays.Objects[Tree.FocusedNode.Parent.Index] as TQueryHistory; + Text := History[Tree.FocusedNode.Index].SQL; + end; + end; + end; + end else + raise Exception.Create(_('Unspecified source control in drag''n drop operation!')); + + if Text <> '' then begin + QueryTabs.ActiveMemo.SelText := Text; + QueryTabs.ActiveMemo.UndoList.AddGroupBreak; + // Requires to set focus, as doubleclick actions also call this procedure + QueryTabs.ActiveMemo.SetFocus; + end; +end;} + + + +{procedure TMainForm.SynMemoQueryDropFiles(Sender: TObject; X, Y: Integer; + AFiles: TUnicodeStrings); +var + i: Integer; + Tab: TQueryTab; +begin + // One or more files from explorer or somewhere else was dropped onto the + // query-memo - load their contents into seperate tabs + if not RunQueryFiles(AFiles, nil, False) then begin + for i:=0 to AFiles.Count-1 do begin + Tab := GetOrCreateEmptyQueryTab(True); + Tab.LoadContents(AFiles[i], False, nil); + end; + end; +end;} + + +{procedure TMainForm.SynMemoQueryKeyPress(Sender: TObject; var Key: Char); +var + Editor: TSynMemo; + Token, Replacement: String; + Attri: TSynHighlighterAttributes; + OldCaretXY, StartOfTokenRowCol, EndOfTokenRowCol, CurrentRowCol: TBufferCoord; + TokenTypeInt, Start, CurrentCharIndex: Integer; + //OldSelStart, OldSelEnd: Integer; + LineWithToken: String; + TableIndex, ProcIndex: Integer; + OldOnChange: TNotifyEvent; +const + WordChars = ['A'..'Z', 'a'..'z', '_']; + IgnoreChars = [#8]; // Backspace, and probably more which should not trigger uppercase +begin + // Uppercase reserved words, functions and data types + if CharInSet(Key, WordChars) or CharInSet(Key, IgnoreChars) then + Exit; + if not AppSettings.ReadBool(asAutoUppercase) then + Exit; + Editor := Sender as TSynMemo; + CurrentCharIndex := Editor.RowColToCharIndex(Editor.CaretXY); + // Go one left on trailing line feed, after which PrevWordPos doesn't work + Dec(CurrentCharIndex, 1); + CurrentRowCol := Editor.CharIndexToRowCol(CurrentCharIndex); + StartOfTokenRowCol := Editor.PrevWordPosEx(CurrentRowCol); + Editor.GetHighlighterAttriAtRowColEx(StartOfTokenRowCol, Token, TokenTypeInt, Start, Attri); + Replacement := UpperCase(Token); + + // Check if token is preceded by a dot, so it is most probably a table, column or some alias + LineWithToken := Editor.Lines[StartOfTokenRowCol.Line-1]; + if (StartOfTokenRowCol.Char > 1) and (LineWithToken[StartOfTokenRowCol.Char-1] = '.') then begin + Exit; + end; + + // Auto-fix case of known database objects + TableIndex := SynSQLSynUsed.TableNames.IndexOf(Token); + ProcIndex := SynSQLSynUsed.ProcNames.IndexOf(Token); + if TableIndex > -1 then begin + Replacement := SynSQLSynUsed.TableNames[TableIndex]; + end else if ProcIndex > -1 then begin + Replacement := SynSQLSynUsed.ProcNames[ProcIndex]; + end else if not (TtkTokenKind(TokenTypeInt) in [tkDatatype, tkFunction, tkKey]) then begin + // Only uppercase certain types of keywords + Exit; + end; + + if Token <> Replacement then begin + OldCaretXY := Editor.CaretXY; + //OldSelStart := Editor.SelStart; + //OldSelEnd := Editor.SelEnd; + + EndOfTokenRowCol := Editor.WordEndEx(StartOfTokenRowCol); + OldOnChange := Editor.OnChange; + Editor.OnChange := nil; + Editor.InsertBlock(StartOfTokenRowCol, EndOfTokenRowCol, PWideChar(Replacement), True); + Editor.OnChange := OldOnChange; + + Editor.CaretXY := OldCaretXY; + //Editor.SelStart := OldSelStart; // breaks at least some undo steps + //Editor.SelEnd := OldSelEnd; + end; + +end;} + + +{procedure TMainForm.AnySynMemoMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +var + Editor: TSynEdit; + NewFontSize: Integer; +begin + // Change font size with MouseWheel + // TODO: broken in high-dpi mode, just zooms in + if KeyPressed(VK_CONTROL) and AppSettings.ReadBool(asWheelZoom) then begin + Editor := TSynEdit(Sender); + NewFontSize := Editor.Font.Size; + if WheelDelta > 0 then + Inc(NewFontSize) + else + Dec(NewFontSize); + NewFontSize := Max(NewFontSize, 1); + AppSettings.ResetPath; + AppSettings.WriteInt(asFontSize, NewFontSize); + Editor.Font.Size := NewFontSize; + SetupSynEditors; + Handled := True; + end else begin + Handled := False; + end; +end;} + + +{procedure TMainForm.SynMemoQueryPaintTransient(Sender: TObject; Canvas: TCanvas; TransientType: TTransientType); +var + Editor : TSynEdit; + BufCrd: TBufferCoord; + Pix: TPoint; + DisCrd: TDisplayCoord; + Pnt: TPoint; + S: String; + I, SearchPos, CharIndex: Integer; + Attri: TSynHighlighterAttributes; + SelStart: Integer; + TmpCharA, TmpCharB: Char; + rx: TRegExpr; + SelWord, Line: String; +const} + //BracketChars: TSysCharSet = ['{','[','(','<','}',']',')','>']; + //OpenChars: Array of Char = ['{','[','(','<']; + //CloseChars: Array of Char = ['}',']',')','>']; + { + function CharToPixels(P: TBufferCoord): TPoint; + begin + Result := Editor.RowColumnToPixels(Editor.BufferToDisplayPos(P)); + end; +begin + if not MainFormCreated then + Exit; + if (FMatchingBraceBackgroundColor = clNone) and (FMatchingBraceForegroundColor = clNone) then + Exit; + if FSynEditInOnPaintTransient then + Exit; + FSynEditInOnPaintTransient := True; + + Editor := TSynEdit(Sender); + // Check for Editor.GetTextLen causes some endless loop in SynEdit. + // But not due to activated WordWrap. Must be some interlocked WM_GETTEXTLENGTH message, or an undefined text length. + //if Editor.GetTextLen > 5*SIZE_MB then + // Exit; + + // Highlight matching words, if selected text is a (small) word + if Editor.SelLength < Editor.CharsInWindow then begin + SelWord := Editor.SelText; + BufCrd := Editor.CaretXY; + CharIndex := Editor.RowColToCharIndex(BufCrd); + // Ensure GetWordAtRowCol finds the word by moving Char to the left of the selection + BufCrd.Char := Max(0, BufCrd.Char - (CharIndex - Editor.SelStart)); + if SelWord <> FLastSelWordInEditor then + Editor.Invalidate; // causes lots of additional implicit calls to OnPaintTransient + FLastSelWordInEditor := SelWord; + if (not SelWord.IsEmpty) and (SelWord = Editor.GetWordAtRowCol(BufCrd)) then begin + rx := TRegExpr.Create; + rx.Expression := '\b(' + QuoteRegExprMetaChars(SelWord) + ')\b'; + rx.ModifierI := True; + // Note: TopLine is wrong when lines are soft-wrapped, so we use RowToLine + for i:=Editor.RowToLine(Editor.TopLine) to Editor.RowToLine(Editor.TopLine + Editor.LinesInWindow) do begin + Line := Editor.Lines[i-1]; + if rx.Exec(Line) then while True do begin + SearchPos := rx.MatchPos[1]; + BufCrd := BufferCoord(SearchPos, i); + DisCrd := Editor.BufferToDisplayPos(BufCrd); + Pnt := Editor.RowColumnToPixels(DisCrd); + if (not Editor.IsPointInSelection(BufCrd)) // Found match is not the selection itself + and Editor.GetHighlighterAttriAtRowCol(BufCrd, SelWord, Attri) + then begin + //logsql(SelWord+': '+Attri.FriendlyName); + Canvas.Font.Size := Editor.Font.Size; + Canvas.Font.Style := Attri.Style; + // Todo: check if we need to handle TransientType ttAfter and ttBefore + Canvas.Font.Color:= FMatchingBraceForegroundColor; + Canvas.Brush.Color:= FMatchingBraceBackgroundColor; + if Canvas.Font.Color = clNone then + Canvas.Font.Color := Editor.Font.Color; + if Canvas.Brush.Color = clNone then + Canvas.Brush.Color := Editor.Color; + Canvas.TextOut(Pnt.X, Pnt.Y, rx.Match[1]); + end; + if not rx.ExecNext then + Break; + end; + end; + rx.Free; + end; + end; + + // Highlight matching brackets, only without selection + if not Editor.SelAvail then begin + + BufCrd := Editor.CaretXY; + SelStart := Editor.SelStart; + + if (SelStart > 0) and (SelStart <= Editor.GetTextLen) then + TmpCharA := Editor.Text[SelStart] + else + TmpCharA := #0; + + if (SelStart >= 0) and (SelStart < Editor.GetTextLen) then + TmpCharB := Editor.Text[SelStart + 1] + else + TmpCharB := #0; + + if CharInSet(TmpCharA, BracketChars) or CharInSet(TmpCharB, BracketChars) then begin + S := TmpCharB; + if not CharInSet(TmpCharB, BracketChars) then begin + BufCrd.Char := BufCrd.Char - 1; + S := TmpCharA; + end; + + if Editor.GetHighlighterAttriAtRowCol(BufCrd, S, Attri) and (Attri.FriendlyName = SYNS_FriendlyAttrSymbol) then + begin + + for i:=Low(OpenChars) to High(OpenChars) do begin + if (S = OpenChars[i]) or (S = CloseChars[i]) then begin + Pix := CharToPixels(BufCrd); + + Canvas.Brush.Style := bsSolid; + Canvas.Font.Assign(Editor.Font); + Canvas.Font.Style := Attri.Style; + + if (TransientType = ttAfter) then begin + Canvas.Font.Color := MatchingBraceForegroundColor; + Canvas.Brush.Color := MatchingBraceBackgroundColor; + end else begin + Canvas.Font.Color := Attri.Foreground; + Canvas.Brush.Color := Attri.Background; + end; + if Canvas.Font.Color = clNone then + Canvas.Font.Color := Editor.Font.Color; + if Canvas.Brush.Color = clNone then + Canvas.Brush.Color := Editor.Color; + + Canvas.TextOut(Pix.X, Pix.Y, S); + BufCrd := Editor.GetMatchingBracketEx(BufCrd); + + if (BufCrd.Char > 0) and (BufCrd.Line > 0) then begin + Pix := CharToPixels(BufCrd); + if Pix.X > Editor.Gutter.Width then begin + if S = OpenChars[i] then + Canvas.TextOut(Pix.X, Pix.Y, CloseChars[i]) + else + Canvas.TextOut(Pix.X, Pix.Y, OpenChars[i]); + end; + end; + + end; + end; + Canvas.Brush.Style := bsSolid; + end; + end; + end; + + // Release event handler + FSynEditInOnPaintTransient := False; +end;} + + +{procedure TMainForm.popupHostPopup(Sender: TObject); +begin + menuFetchDBitems.Enabled := (PageControlHost.ActivePage = tabDatabases) and (ListDatabases.SelectedCount > 0); + Kill1.Enabled := (PageControlHost.ActivePage = tabProcessList) and (ListProcesses.SelectedCount > 0); + menuEditVariable.Enabled := False; + if ActiveConnection.Has(frEditVariables) then + menuEditVariable.Enabled := (PageControlHost.ActivePage = tabVariables) and Assigned(ListVariables.FocusedNode) + else + menuEditVariable.Hint := _(SUnsupported); +end;} + + +{procedure TMainForm.popupDBPopup(Sender: TObject); +var + Obj: PDBObject; + HasFocus, IsDb, IsObject: Boolean; + Conn: TDBConnection; +begin + // DBtree and ListTables both use popupDB as menu + if PopupComponent(Sender) = DBtree then begin + Obj := DBTree.GetNodeData(DBTree.FocusedNode); + IsDb := Obj.NodeType = lntDb; + IsObject := Obj.NodeType in [lntTable..lntEvent]; + actCreateDatabase.Enabled := (Obj.NodeType = lntNone) + and (Obj.Connection.Parameters.NetTypeGroup in [ngMySQL, ngMSSQL, ngPgSQL]); + actConnectionProperties.Enabled := Obj.NodeType = lntNone; + actAttachDatabase.Visible := Obj.Connection.Parameters.IsAnySQLite; + actAttachDatabase.Enabled := actAttachDatabase.Visible and (Obj.NodeType = lntNone); + actCreateTable.Enabled := IsDb or IsObject or (Obj.GroupType = lntTable); + actCreateView.Enabled := IsDb or IsObject or (Obj.GroupType = lntView); + actCreateProcedure.Enabled := IsDb or IsObject or (Obj.GroupType in [lntFunction, lntProcedure]); + actCreateFunction.Enabled := actCreateProcedure.Enabled; + actCreateTrigger.Enabled := IsDb or IsObject or (Obj.GroupType = lntTrigger); + actCreateEvent.Enabled := IsDb or IsObject or (Obj.GroupType = lntEvent); + actDropObjects.Enabled := IsObject or + (IsDb and not Obj.Connection.Parameters.IsAnySQLite); + actDetachDatabase.Visible := Obj.Connection.Parameters.IsAnySQLite; + actDetachDatabase.Enabled := actDetachDatabase.Visible and (Obj.NodeType = lntDb); + actCopyTable.Enabled := Obj.NodeType in [lntTable, lntView]; + actEmptyTables.Enabled := Obj.NodeType in [lntTable, lntView]; + actRunRoutines.Enabled := Obj.NodeType in [lntProcedure, lntFunction]; + menuClearDataTabFilter.Enabled := Obj.NodeType in [lntTable, lntView]; + menuEditObject.Enabled := IsDb or IsObject; + // Enable certain items which are valid only here + menuTreeExpandAll.Enabled := True; + menuTreeCollapseAll.Enabled := True; + menuTreeOptions.Enabled := True; + end else begin + HasFocus := Assigned(ListTables.FocusedNode); + actCreateDatabase.Enabled := False; + actConnectionProperties.Enabled := False; + actAttachDatabase.Visible := False; + actCreateTable.Enabled := True; + actCreateView.Enabled := True; + actCreateProcedure.Enabled := True; + actCreateFunction.Enabled := True; + actCreateTrigger.Enabled := True; + actCreateEvent.Enabled := True; + actDropObjects.Enabled := ListTables.SelectedCount > 0; + actDetachDatabase.Visible := False; + actEmptyTables.Enabled := True; + actRunRoutines.Enabled := True; + menuClearDataTabFilter.Enabled := False; + menuEditObject.Enabled := HasFocus; + actCopyTable.Enabled := False; + if HasFocus then begin + Obj := ListTables.GetNodeData(ListTables.FocusedNode); + actCopyTable.Enabled := Obj.NodeType in [lntTable, lntView]; + end; + menuTreeExpandAll.Enabled := False; + menuTreeCollapseAll.Enabled := False; + menuTreeOptions.Enabled := False; + end; + Conn := ActiveConnection; + if (Conn <> nil) and (Conn.Parameters.IsAnyMySQL) then begin + actCreateView.Enabled := actCreateView.Enabled and Conn.Has(frCreateView); + actCreateProcedure.Enabled := actCreateProcedure.Enabled and Conn.Has(frCreateProcedure); + actCreateFunction.Enabled := actCreateFunction.Enabled and Conn.Has(frCreateFunction); + actCreateTrigger.Enabled := actCreateTrigger.Enabled and Conn.Has(frCreateTrigger); + actCreateEvent.Enabled := actCreateEvent.Enabled and Conn.Has(frCreateEvent); + end; +end;} + + +{procedure TMainForm.popupFilterPopup(Sender: TObject); +var + SQLFuncs: TSQLFunctionList; + i, j: Integer; + miGroup, miFunction: TMenuItem; +begin + // Create function menu items in popup menu + menuFilterInsertFunction.Clear; + SQLFuncs := ActiveConnection.SQLFunctions; + for i:=0 to SQLFuncs.Categories.Count-1 do begin + // Create a menu item which gets subitems later + miGroup := TMenuItem.Create(popupFilter); + miGroup.Caption := SQLFuncs.Categories[i]; + menuFilterInsertFunction.Add(miGroup); + for j:=0 to SQLFuncs.Count-1 do begin + if SQLFuncs[j].Category <> SQLFuncs.Categories[i] then + Continue; + miFunction := TMenuItem.Create(popupFilter); + miFunction.Caption := SQLFuncs[j].Name; + miFunction.ImageIndex := 13; + // Prevent generating a hotkey + miFunction.Caption := StringReplace(miFunction.Caption, '&', '&&', [rfReplaceAll]); + // Prevent generating a seperator line + if miFunction.Caption = '-' then + miFunction.Caption := '&-'; + miFunction.Hint := SQLFuncs[j].Name + SQLFuncs[j].Declaration + ' - ' + StrEllipsis(SQLFuncs[j].Description, 200); + // Prevent generating a seperator for ShortHint and LongHint + miFunction.Hint := StringReplace( miFunction.Hint, '|', '¦', [rfReplaceAll] ); + miFunction.Tag := j; + // Place menuitem on menu + miFunction.OnClick := insertFunction; + miGroup.Add(miFunction); + end; + end; +end;} + + +{procedure TMainForm.popupDataGridPopup(Sender: TObject); +var + Grid: TVirtualStringTree; + Results: TDBQuery; + i: Integer; + Col, Value, FocusedColumnName: String; + CellFocused, InDataGrid, HasNullValue, HasNotNullValue: Boolean; + RowNumber: PInt64; + Node: PVirtualNode; + OldDataLocalNumberFormat: Boolean; + IncludedValues: TStringList; + Act: TAction; + Datatype: TDBDatatype; + ForeignKey: TForeignKey; +const + CLPBRD : String = 'CLIPBOARD'; +begin + // Manipulate quick filter menuitems + Grid := ActiveGrid; + // Make sure ValidateControls detects the grid as focused, which is not the case when + // it has 0 nodes, even with TreeOptions.SelectionOptions.RightclickSelect enabled + Grid.SetFocus; + CellFocused := Assigned(Grid.FocusedNode) and (Grid.FocusedColumn > 0); + InDataGrid := Grid = DataGrid; + DataInsertValue.Enabled := CellFocused; + QFvalues.Enabled := CellFocused; + menuQuickFilter.Enabled := InDataGrid; + actDataResetSorting.Enabled := InDataGrid; + menuSQLHelpData.Enabled := InDataGrid; + Refresh3.Enabled := InDataGrid; + actGridEditFunction.Enabled := CellFocused; + + if not CellFocused then + Exit; + Results := GridResult(Grid); + + Datatype := Results.DataType(Grid.FocusedColumn-1); + Col := Results.Connection.QuoteIdent(Results.ColumnOrgNames[Grid.FocusedColumn-1], False); + if InDataGrid + and (Datatype.Index = dbdtJson) + and Results.Connection.Parameters.IsAnyPostgreSQL then begin + Col := Col + '::text'; + end; + + // Block 1: WHERE col IN ([focused cell values]) + actQuickFilterFocused1.Hint := ''; + actQuickFilterFocused2.Hint := ''; + actQuickFilterFocused3.Hint := ''; + actQuickFilterFocused4.Hint := ''; + actQuickFilterFocused5.Hint := ''; + actQuickFilterFocused6.Hint := ''; + actQuickFilterFocused7.Hint := ''; + Node := Grid.GetFirstSelected; + HasNullValue := False; + HasNotNullValue := False; + OldDataLocalNumberFormat := DataLocalNumberFormat; + DataLocalNumberFormat := False; + IncludedValues := TStringList.Create; + while Assigned(Node) do begin + AnyGridEnsureFullRow(Grid, Node); + RowNumber := Grid.GetNodeData(Node); + Results.RecNo := RowNumber^; + if Results.IsNull(Grid.FocusedColumn-1) then + HasNullValue := True + else begin + HasNotNullValue := True; + Value := Grid.Text[Node, Grid.FocusedColumn]; + if IncludedValues.IndexOf(Value) = -1 then begin + actQuickFilterFocused1.Hint := actQuickFilterFocused1.Hint + Results.Connection.EscapeString(Value, Datatype) + ', '; + actQuickFilterFocused2.Hint := actQuickFilterFocused2.Hint + Results.Connection.EscapeString(Value, Datatype) + ', '; + actQuickFilterFocused3.Hint := actQuickFilterFocused3.Hint + + Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''' + Results.Connection.EscapeString(Value, True, False) + '%''']) + + ' OR '; + actQuickFilterFocused4.Hint := actQuickFilterFocused4.Hint + + Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '''']) + + ' OR '; + actQuickFilterFocused5.Hint := actQuickFilterFocused5.Hint + + Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '%''']) + + ' OR '; + actQuickFilterFocused6.Hint := actQuickFilterFocused6.Hint + Col + ' > ' + Results.Connection.EscapeString(Value, Datatype) + ' OR '; + actQuickFilterFocused7.Hint := actQuickFilterFocused7.Hint + Col + ' < ' + Results.Connection.EscapeString(Value, Datatype) + ' OR '; + IncludedValues.Add(Value); + end; + end; + Node := Grid.GetNextSelected(Node); + if Length(actQuickFilterFocused1.Hint) > SIZE_MB then + Break; + end; + DataLocalNumberFormat := OldDataLocalNumberFormat; + if HasNotNullValue then begin + actQuickFilterFocused1.Hint := Col + ' IN (' + Copy(actQuickFilterFocused1.Hint, 1, Length(actQuickFilterFocused1.Hint)-2) + ')'; + actQuickFilterFocused2.Hint := Col + ' NOT IN (' + Copy(actQuickFilterFocused2.Hint, 1, Length(actQuickFilterFocused2.Hint)-2) + ')'; + actQuickFilterFocused3.Hint := Copy(actQuickFilterFocused3.Hint, 1, Length(actQuickFilterFocused3.Hint)-4); + actQuickFilterFocused4.Hint := Copy(actQuickFilterFocused4.Hint, 1, Length(actQuickFilterFocused4.Hint)-4); + actQuickFilterFocused5.Hint := Copy(actQuickFilterFocused5.Hint, 1, Length(actQuickFilterFocused5.Hint)-4); + actQuickFilterFocused6.Hint := Copy(actQuickFilterFocused6.Hint, 1, Length(actQuickFilterFocused6.Hint)-4); + actQuickFilterFocused7.Hint := Copy(actQuickFilterFocused7.Hint, 1, Length(actQuickFilterFocused7.Hint)-4); + end; + if HasNullValue then begin + if HasNotNullValue then begin + actQuickFilterFocused1.Hint := actQuickFilterFocused1.Hint + ' OR '; + actQuickFilterFocused2.Hint := actQuickFilterFocused2.Hint + ' AND '; + actQuickFilterFocused3.Hint := actQuickFilterFocused3.Hint + ' OR '; + actQuickFilterFocused4.Hint := actQuickFilterFocused4.Hint + ' OR '; + actQuickFilterFocused5.Hint := actQuickFilterFocused5.Hint + ' OR '; + actQuickFilterFocused6.Hint := actQuickFilterFocused6.Hint + ' OR '; + actQuickFilterFocused7.Hint := actQuickFilterFocused7.Hint + ' OR '; + end; + actQuickFilterFocused1.Hint := actQuickFilterFocused1.Hint + Col + ' IS NULL'; + actQuickFilterFocused2.Hint := actQuickFilterFocused2.Hint + Col + ' IS NOT NULL'; + actQuickFilterFocused3.Hint := actQuickFilterFocused3.Hint + Col + ' IS NULL'; + actQuickFilterFocused4.Hint := actQuickFilterFocused4.Hint + Col + ' IS NULL'; + actQuickFilterFocused5.Hint := actQuickFilterFocused5.Hint + Col + ' IS NULL'; + actQuickFilterFocused6.Hint := actQuickFilterFocused6.Hint + Col + ' IS NULL'; + actQuickFilterFocused7.Hint := actQuickFilterFocused7.Hint + Col + ' IS NULL'; + end; + actQuickFilterFocused1.Visible := HasNotNullValue or HasNullValue; + actQuickFilterFocused2.Visible := HasNotNullValue or HasNullValue; + actQuickFilterFocused3.Visible := HasNotNullValue; + actQuickFilterFocused4.Visible := HasNotNullValue; + actQuickFilterFocused5.Visible := HasNotNullValue; + actQuickFilterFocused6.Visible := HasNotNullValue; + actQuickFilterFocused7.Visible := HasNotNullValue; + IncludedValues.Free; + + // Block 2: WHERE col = [ask user for value] + actQuickFilterPrompt1.Hint := Col + ' = "..."'; + actQuickFilterPrompt2.Hint := Col + ' != "..."'; + actQuickFilterPrompt3.Hint := Col + ' > "..."'; + actQuickFilterPrompt4.Hint := Col + ' < "..."'; + actQuickFilterPrompt5.Hint := Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '"%...%"']); + actQuickFilterNull.Hint := Col + ' IS NULL'; + actQuickFilterNotNull.Hint := Col + ' IS NOT NULL'; + + // Block 3: WHERE col = [clipboard content] + Value := Trim(Clipboard.TryAsText); + if Length(Value) < SIZE_KB then begin + actQuickFilterClipboard1.Enabled := true; + actQuickFilterClipboard1.Hint := Col + ' = ' + Results.Connection.EscapeString(Value, Datatype); + actQuickFilterClipboard2.Enabled := true; + actQuickFilterClipboard2.Hint := Col + ' != ' + Results.Connection.EscapeString(Value, Datatype); + actQuickFilterClipboard3.Enabled := true; + actQuickFilterClipboard3.Hint := Col + ' > ' + Results.Connection.EscapeString(Value, Datatype); + actQuickFilterClipboard4.Enabled := true; + actQuickFilterClipboard4.Hint := Col + ' < ' + Results.Connection.EscapeString(Value, Datatype); + actQuickFilterClipboard5.Enabled := true; + actQuickFilterClipboard5.Hint := Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '%''']); + actQuickFilterClipboard6.Enabled := true; + actQuickFilterClipboard6.Hint := Col + ' IN (' + Value + ')'; + end else begin + actQuickFilterClipboard1.Enabled := false; + actQuickFilterClipboard1.Hint := Col + ' = ' + CLPBRD; + actQuickFilterClipboard2.Enabled := false; + actQuickFilterClipboard2.Hint := Col + ' != ' + CLPBRD; + actQuickFilterClipboard3.Enabled := false; + actQuickFilterClipboard3.Hint := Col + ' > ' + CLPBRD; + actQuickFilterClipboard4.Enabled := false; + actQuickFilterClipboard4.Hint := Col + ' < ' + CLPBRD; + actQuickFilterClipboard5.Enabled := false; + actQuickFilterClipboard5.Hint := Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '%' + CLPBRD + '%']); + actQuickFilterClipboard6.Enabled := false; + actQuickFilterClipboard6.Hint := Col + ' IN (' + CLPBRD + ')'; + end; + + // Set captions from hints + for i:=0 to menuQuickFilter.Count-1 do begin + if menuQuickFilter[i].Action = nil then + Continue; + Act := menuQuickFilter[i].Action as TAction; + // Stop here + if Act = actRemoveFilter then + Break; + if not Act.Hint.IsEmpty then + Act.Caption := StrEllipsis(Act.Hint, 100); + end; + + actFollowForeignKey.Enabled := False; + if (InDataGrid) then begin + FocusedColumnName := Results.ColumnOrgNames[Grid.FocusedColumn-1]; + //find foreign key for current column + for ForeignKey in ActiveDBObj.TableForeignKeys do begin + i := ForeignKey.Columns.IndexOf(FocusedColumnName); + if i > -1 then begin + actFollowForeignKey.Enabled := True; + break; + end; + end; + end; +end;} + + +{procedure TMainForm.QFvaluesClick(Sender: TObject); +var + Data: TDBQuery; + DbObj: TDBObject; + Conn: TDBConnection; + ColIdx, ResultCol: Integer; + ColName, Query: String; + ColType: TDBDatatype; + TableCol: TTableColumn; + Item: TMenuItem; + i: Integer; + MaxSize: Int64; + ValueList: TStringList; + ColumnHasIndex: Boolean; +begin + // Create a list of distinct column values in selected table + for i:=QFvalues.Count-1 downto 1 do + QFvalues.Delete(i); + QFvalues[0].Caption := ''; + QFvalues[0].Hint := ''; + QFvalues[0].OnClick := nil; + ColIdx := DataGrid.FocusedColumn; + ResultCol := ColIdx - 1; + if ColIdx = NoColumn then + Exit; + ColName := DataGridResult.ColumnOrgNames[ResultCol]; + ColType := DataGridResult.DataType(ResultCol); + ShowStatusMsg(_('Fetching distinct values ...')); + DbObj := ActiveDbObj; + Conn := DbObj.Connection; + MaxSize := SIZE_GB; + ColumnHasIndex := DataGridResult.ColIsKeyPart(ResultCol) + or DataGridResult.ColIsUniqueKeyPart(ResultCol) + or DataGridResult.ColIsPrimaryKeyPart(ResultCol); + if ColumnHasIndex then begin + MaxSize := MaxSize * 5; + end; + try + if DbObj.Size > MaxSize then + raise Exception.Create(f_('Table too large (>%s), avoiding long running SELECT query', [FormatByteNumber(MaxSize)])); + Query := Conn.QuoteIdent(ColName)+', COUNT(*) AS c FROM '+DbObj.QuotedName; + if SynMemoFilter.Text <> '' then + Query := Query + ' WHERE ' + SynMemoFilter.Text + CRLF; + Query := Query + ' GROUP BY '+Conn.QuoteIdent(ColName)+' ORDER BY c DESC, '+Conn.QuoteIdent(ColName); + Data := Conn.GetResults(Conn.ApplyLimitClause('SELECT', Query, 30, 0)); + for i:=0 to Data.RecordCount-1 do begin + if QFvalues.Count > i then + Item := QFvalues[i] + else begin + Item := TMenuItem.Create(QFvalues); + QFvalues.Add(Item); + end; + if Data.IsNull(ColName) then + Item.Hint := Conn.QuoteIdent(ColName)+' IS NULL' + else if ColType.Category in [dtcBinary, dtcSpatial] then + Item.Hint := Conn.QuoteIdent(ColName)+'='+Data.HexValue(0, False) + else + Item.Hint := Conn.QuoteIdent(ColName)+'='+Conn.EscapeString(Data.Col(ColName)); + Item.Caption := StrEllipsis(Item.Hint, 100) + ' (' + FormatNumber(Data.Col('c')) + ')'; + if SynMemoFilter.Text <> '' then begin + if Pos(Item.Hint, SynMemoFilter.Text) > 0 then + Item.Hint := SynMemoFilter.Text + else + Item.Hint := SynMemoFilter.Text + ' AND ' + Item.Hint; + end; + Item.OnClick := QuickFilterClick; + Data.Next; + end; + except + on E:Exception do begin + // Table is too large for the above SELECT query, or the query failed, due to an error in its filter or so + // Get ENUM/SET values instead if possible + QFvalues[0].Caption := StrEllipsis(E.Message, 100); + QFvalues[0].Hint := E.Message; + for TableCol in SelectedTableColumns do begin + if (TableCol.Name = ColName) and (TableCol.DataType.Index in [dbdtEnum, dbdtSet]) then begin + ValueList := TableCol.ValueList; + for i:=0 to ValueList.Count-1 do begin + if QFvalues.Count > i+1 then + Item := QFvalues[i+1] + else begin + Item := TMenuItem.Create(QFvalues); + QFvalues.Add(Item); + end; + Item.Hint := Conn.QuoteIdent(ColName)+'='+Conn.EscapeString(ValueList[i]); + Item.Caption := StrEllipsis(Item.Hint, 100); + Item.OnClick := QuickFilterClick; + end; + Break; + end; + end; + end; + end; + ShowStatusMsg; +end;} + + +{procedure TMainForm.DataInsertValueClick(Sender: TObject); +var + LocalTime, UtcTime: TDateTime; + y, m, d, h, i, s, ms: Word; + Uid: TGuid; + DateTimeSQL, StrUid: String; + UnixTimestamp, UtcUnixTimestamp: Int64; + SystemTime: TSystemTime; + ColNum: TColumnIndex; + Col: TTableColumn; + Conn: TDBConnection; +const + FrmDateTime = '%s: %.4d-%.2d-%.2d %.2d:%.2d:%.2d'; + FrmDate = '%s: %.4d-%.2d-%.2d'; + FrmTime = '%s: %.2d:%.2d:%.2d'; + FrmYear = '%s: %.4d'; + FrmUnixTs = '%s: %d'; +begin + // Local and UTC date/time menu items + Conn := ActiveConnection; + DateTimeSQL := 'SELECT ' + Conn.GetSQLSpecifity(spFuncNow); + LocalTime := Conn.ParseDateTime(Conn.GetVar(DateTimeSQL)); + DecodeDateTime(LocalTime, y, m, d, h, i, s, ms); + DataDateTime.Caption := Format(FrmDateTime, [_('Date and time'), y,m,d,h,i,s]); + DataDate.Caption := Format(FrmDate, [_('Date'), y,m,d]); + DataTime.Caption := Format(FrmTime, [_('Time'), h,i,s]); + DataYear.Caption := Format(FrmYear, [_('Year'), y]); + GetSystemTime(SystemTime); + UnixTimestamp := DateTimeToUnix(SystemTimeToDateTime(SystemTime)); + DataUnixTimestamp.Caption := Format(FrmUnixTs, [_('UNIX Timestamp'), UnixTimestamp]); + + UtcTime := IncSecond(LocalTime, FTimeZoneOffset); + DecodeDateTime(UtcTime, y, m, d, h, i, s, ms); + DataUtcDateTime.Caption := Format(FrmDateTime, ['UTC '+_('Date and time'), y,m,d,h,i,s]); + DataUtcDate.Caption := Format(FrmDate, ['UTC '+_('Date'), y,m,d]); + DataUtcTime.Caption := Format(FrmTime, ['UTC '+_('Time'), h,i,s]); + UtcUnixTimestamp := UnixTimestamp + FTimeZoneOffset; + DataUtcUnixTimestamp.Caption := Format(FrmUnixTs, ['UTC '+_('UNIX Timestamp'), UtcUnixTimestamp]); + + CreateGuid(Uid); + StrUid := GuidToString(Uid); + DataGUID.Caption := _('GUID') + ': ' + StrUid; + DataGUIDwobraces.Caption := _('GUID without braces') + ': ' + Copy(StrUid, 2, Length(StrUid)-2); + DataGUIDlowercase.Caption := _('GUID lowercase') + ': ' + StrUid.ToLower; + DataGUIDlowercaseWobraces.Caption := _('GUID lowercase without braces') + ': ' + Copy(StrUid, 2, Length(StrUid)-2).ToLower; + + ColNum := DataGrid.FocusedColumn; + DataDefaultValue.Caption := _('Default value')+': ?'; + DataDefaultValue.Enabled := False; + if ColNum <> NOCOLUMN then begin + for Col in SelectedTableColumns do begin + if (Col.Name = DataGrid.Header.Columns[ColNum].Text) and (Col.DefaultType = cdtText) then begin + DataDefaultValue.Caption := _('Default value')+': '+Col.DefaultText; + DataDefaultValue.Enabled := True; + break; + end; + end; + end; +end;} + + +{procedure TMainForm.InsertValue(Sender: TObject); +var + d: String; + p: Integer; + Grid: TVirtualStringTree; +begin + // Insert date/time-value into table + d := StripHotkey((Sender as TMenuItem).Caption); + p := Pos(':', d); + if p > 0 then + d := Trim(Copy(d, p+1, MaxInt)); + Grid := ActiveGrid; + try + Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := d; + except on E:EDbError do + ErrorDialog(E.Message); + end; +end;} + + +{function TMainForm.GetRootNode(Tree: TBaseVirtualTree; Connection: TDBConnection): PVirtualNode; +var + SessionNode: PVirtualNode; + SessionObj: PDBObject; +begin + Result := nil; + SessionNode := Tree.GetFirstChild(nil); + while Assigned(SessionNode) do begin + SessionObj := Tree.GetNodeData(SessionNode); + if SessionObj.Connection = Connection then begin + Result := SessionNode; + break; + end; + SessionNode := Tree.GetNextSibling(SessionNode); + end; +end;} + + +{function TMainForm.GetActiveConnection: TDBConnection; +begin + Result := nil; + if Assigned(FActiveDBObj) and (FActiveDbObj <> nil) then + Result := FActiveDbObj.Connection; +end;} + + +{function TMainForm.GetActiveDatabase: String; +begin + // Find currently selected database in active connection + Result := ''; + if (not (csDestroying in ComponentState)) + and Assigned(FActiveDBObj) + and Assigned(FActiveDBObj.Connection) then + Result := FActiveDBObj.Connection.Database; +end;} + + +{procedure TMainForm.SetActiveDatabase(db: String; Connection: TDBConnection); +var + SessionNode, DBNode: PVirtualNode; + DBObj: PDBObject; +begin + // Set focus on the wanted db node + LogSQL('SetActiveDatabase('+db+')', lcDebug); + SessionNode := GetRootNode(DBtree, Connection); + if db = '' then + SelectNode(DBtree, SessionNode) + else begin + DBNode := DBtree.GetFirstChild(SessionNode); + while Assigned(DBNode) do begin + DBObj := DBtree.GetNodeData(DBNode); + if DBObj.Database = db then begin + if DBNode <> DBtree.FocusedNode then + SelectNode(DBtree, DBNode); + break; + end; + DBNode := DBtree.GetNextSibling(DBNode); + end; + end; +end;} + + +{procedure TMainForm.SetActiveDBObj(Obj: TDBObject); +var + FoundNode: PVirtualNode; +begin + // Find right table/view/... node in tree and select it, implicitely call OnFocusChanged + LogSQL('SetActiveDBObj('+Obj.Name+')', lcDebug); + FoundNode := FindDBObjectNode(DBtree, Obj); + if Assigned(FoundNode) then + SelectNode(DBTree, FoundNode) + else + LogSQL(f_('Table node "%s" not found in tree.', [Obj.Name]), lcError); +end;} + + +{function TMainForm.FindDBObjectNode(Tree: TBaseVirtualTree; Obj: TDBObject): PVirtualNode; +var + DbNode, ObjectNode, GroupedNode: PVirtualNode; + DbObj, ObjectObj, GroupedObj: PDBObject; +begin + Result := nil; + DbNode := Tree.GetFirstChild(GetRootNode(Tree, Obj.Connection)); + while Assigned(DbNode) do begin + // Search in database nodes + DbObj := Tree.GetNodeData(DbNode); + if DBObj.IsSameAs(Obj) then begin + Result := DBNode; + break; + end; + + // Search in table/view/... nodes + if DbObj.Database = Obj.Database then begin + ObjectNode := Tree.GetFirstChild(DbNode); + while Assigned(ObjectNode) do begin + ObjectObj := Tree.GetNodeData(ObjectNode); + if ObjectObj.IsSameAs(Obj) then begin + Result := ObjectNode; + break; + end; + + // Search in grouped table/view/... nodes + GroupedNode := Tree.GetFirstChild(ObjectNode); + while Assigned(GroupedNode) do begin + GroupedObj := Tree.GetNodeData(GroupedNode); + if GroupedObj.IsSameAs(Obj) then begin + Result := GroupedNode; + break; + end; + GroupedNode := Tree.GetNextSibling(GroupedNode); + end; + + ObjectNode := Tree.GetNextSibling(ObjectNode); + end; + break; + end; + DbNode := Tree.GetNextSibling(DbNode); + end; +end;} + + +{** + Column selection for datagrid +} +{procedure TMainForm.btnDataClick(Sender: TObject); +var + btn : TToolButton; + frm : TForm; +begin + btn := (Sender as TToolButton); + + if (btn = tbtnDataColumns) or (btn = tbtnDataSorting) then begin + // Create desired form for SELECT and ORDER buttons + btn.Down := not btn.Down; + if not btn.Down then Exit; + if btn = tbtnDataColumns then + frm := TfrmColumnSelection.Create(self) + else if btn = tbtnDataSorting then + frm := TfrmDataSorting.Create(self) + else + frm := TForm.Create(self); // Dummy fallback, should never get created + // Position new form relative to btn's position + frm.Top := btn.ClientOrigin.Y + btn.Height; + frm.Left := btn.ClientOrigin.X + btn.Width - frm.Width; + // Display form + frm.Show; + end else if btn = tbtnDataFilter then begin + // Unhide inline filter panel + ToggleFilterPanel; + FilterPanelManuallyOpened := pnlFilter.Visible; + if FilterPanelManuallyOpened then + SynMemoFilter.SetFocus; + end; +end;} + + +{procedure TMainForm.filterQueryHelpersChange(Sender: TObject); +begin + // Filter nodes in query helpers + FilterNodesByEdit(Sender as TButtonedEdit, QueryTabs.ActiveHelpersTree); +end;} + + +{procedure TMainForm.tabsetQueryMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +var + idx, i: Integer; + Tabs: TTabSet; + Rect: TRect; + Org: TPoint; + QueryTab: TQueryTab; + ResultTab: TResultTab; + HintSQL: TStringList; +begin + // Display some hint with row/col count + SQL when mouse hovers over result tab + if (FLastHintMousepos.X = x) and (FLastHintMousepos.Y = Y) then + Exit; + FLastHintMousepos := Point(X, Y); + Tabs := Sender as TTabSet; + idx := Tabs.ItemAtPos(Point(X, Y), True); + if (idx = -1) or (idx = FLastHintControlIndex) then + Exit; + FLastHintControlIndex := idx; + // Check if user wants these balloon hints + if not AppSettings.ReadBool(asHintsOnResultTabs) then + Exit; + QueryTab := QueryTabs.ActiveTab; + if idx >= QueryTab.ResultTabs.Count then + Exit; + + // Make SQL readable for the tooltip balloon. WrapText() is unsuitable here. + // See issue #2014 + // Also, wee need to work around the awful looking balloon text: + // http://qc.embarcadero.com/wc/qcmain.aspx?d=73771 + ResultTab := QueryTab.ResultTabs[idx]; + HintSQL := TStringList.Create; + HintSQL.Text := Trim(ResultTab.Results.SQL); + for i:=0 to HintSQL.Count-1 do begin + HintSQL[i] := StrEllipsis(HintSQL[i], 100); + HintSQL[i] := StringReplace(HintSQL[i], #9, ' ', [rfReplaceAll]); + end; + BalloonHint1.Description := FormatNumber(ResultTab.Results.ColumnCount) + ' columns × ' + + FormatNumber(ResultTab.Results.RecordCount) + ' rows' + CRLF + CRLF + + Trim(StrEllipsis(HintSQL.Text, SIZE_KB)); + Rect := Tabs.ItemRect(idx); + Org := Tabs.ClientOrigin; + OffsetRect(Rect, Org.X, Org.Y); + BalloonHint1.ShowHint(Rect); +end;} + + +{procedure TMainForm.tabsetQueryMouseLeave(Sender: TObject); +begin + // BalloonHint.HideAfter is -1, so it will stay forever if we wouldn't hide it at some point + BalloonHint1.HideHint; + FLastHintControlIndex := -1; +end;} + + +{** + Insert function name from popupmenu to query memo +} +{procedure TMainForm.insertFunction(Sender: TObject); +var + f : String; + sm : TSynMemo; + Conn: TDBConnection; +begin + // Detect which memo is focused + if SynMemoFilter.Focused then + sm := SynMemoFilter + else + sm := QueryTabs.ActiveMemo; + // Restore function name from tag + Conn := ActiveConnection; + f := Conn.SQLFunctions[TControl(Sender).tag].Name + + Conn.SQLFunctions[TControl(Sender).tag].Declaration; + sm.UndoList.AddGroupBreak; + sm.SelText := f; + sm.UndoList.AddGroupBreak; + if not SynMemoFilter.Focused then + ValidateQueryControls(Sender); +end;} + + +{** + Delete a snippet file +} +{procedure TMainForm.menuDeleteSnippetClick(Sender: TObject); +var + snippetfile : String; +begin + // Don't do anything if no item was selected + if not Assigned(QueryTabs.ActiveHelpersTree.FocusedNode) then + Exit; + + snippetfile := AppSettings.DirnameSnippets + QueryTabs.ActiveHelpersTree.Text[QueryTabs.ActiveHelpersTree.FocusedNode, 0] + '.sql'; + if MessageDialog(_('Delete snippet file?'), snippetfile, mtConfirmation, [mbOk, mbCancel]) = mrOk then + begin + Screen.Cursor := crHourGlass; + if DeleteFileWithUndo(snippetfile) then begin + // Refresh list with snippets + SetSnippetFilenames; + end else begin + Screen.Cursor := crDefault; + ErrorDialog(f_('Failed deleting %s', [snippetfile])); + end; + Screen.Cursor := crDefault; + end; +end;} + + +{procedure TMainForm.menuDoubleClickInsertsNodeTextClick(Sender: TObject); +var + Item: TMenuItem; +begin + // Activate doubleclick node feature + Item := Sender as TMenuItem; + Item.Checked := not Item.Checked; + AppSettings.ResetPath; + AppSettings.WriteBool(asDoubleClickInsertsNodeText, Item.Checked); +end;} + +{** + Load snippet at cursor +} +{procedure TMainForm.menuInsertAtCursorClick(Sender: TObject); +var + Tree: TVirtualStringTree; + Tab: TQueryTab; +begin + Tree := QueryTabs.ActiveHelpersTree; + Tab := QueryTabs.ActiveTab; + Tab.Memo.DragDrop(Tree, Tab.Memo.CaretX, Tab.Memo.CaretY); +end;} + + +{** + Load snippet and replace content +} +{procedure TMainForm.menuLoadSnippetClick(Sender: TObject); +begin + QueryTabs.ActiveTab.LoadContents(AppSettings.DirnameSnippets + QueryTabs.ActiveHelpersTree.Text[QueryTabs.ActiveHelpersTree.FocusedNode, 0] + '.sql', True, nil); +end;} + + +{** + Open snippets-directory in Explorer +} +{procedure TMainForm.menuExploreClick(Sender: TObject); +begin + ShellExec('', AppSettings.DirnameSnippets); +end;} + + +{procedure TMainForm.menuClearQueryHistoryClick(Sender: TObject); +var + Values: TStringList; + PathToDelete: String; +begin + // Clear query history items in registry + // Take care of MessageDialog, probably changing the current SessionPath + PathToDelete := ActiveConnection.Parameters.SessionPath + '\' + REGKEY_QUERYHISTORY; + AppSettings.SessionPath := PathToDelete; + Values := AppSettings.GetValueNames; + if MessageDialog(_('Clear query history?'), f_('%s history items will be deleted.', [FormatNumber(Values.Count)]), mtConfirmation, [mbYes, mbNo]) = mrYes then begin + Screen.Cursor := crHourglass; + AppSettings.SessionPath := PathToDelete; + AppSettings.DeleteCurrentKey; + RefreshHelperNode(TQueryTab.HelperNodeHistory); + Screen.Cursor := crDefault; + end; + Values.Free; + AppSettings.ResetPath; +end;} + + +{procedure TMainForm.menuFetchDBitemsClick(Sender: TObject); +var + Node: PVirtualNode; + db: String; + Conn: TDBConnection; +begin + // Fill db object cache of selected databases + try + Screen.Cursor := crHourglass; + Node := GetNextNode(ListDatabases, nil, True); + Conn := ActiveConnection; + while Assigned(Node) do begin + db := ListDatabases.Text[Node, 0]; + Conn.GetDBObjects(db, True); + ListDatabases.RepaintNode(Node); + DBtree.RepaintNode(FindDBNode(DBtree, Conn, db)); + Node := GetNextNode(ListDatabases, Node, True); + end; + finally + Screen.Cursor := crDefault; + end; +end;} + + +{** + A column header of a VirtualStringTree was clicked: + Toggle the sort direction +} +{procedure TMainForm.AnyGridHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); +var + ConfirmResult: Integer; + MsgStr: String; + LongSortRowNum: Cardinal; +begin + // Don't call sorting procedure on right click + // Some list-headers have a contextmenu which should popup then. + if HitInfo.Button = mbRight then + Exit; + // Beginning with VT's r181, this proc is also called when doubleclicking-to-autofit + // Seems buggy in VT as this suddenly calls it with Column=-1 in those cases. + // See also issue #1150 + if HitInfo.Column = NoColumn then + Exit; + if Sender.Columns[HitInfo.Column].CheckBox then + Exit; + // Header click disabled + if not AppSettings.ReadBool(asColumnHeaderClick) then + Exit; + // Large query result sorting takes too long, see #293 + LongSortRowNum := AppSettings.ReadInt(asQueryGridLongSortRowNum); + if TVirtualStringTree(Sender.Treeview).RootNodeCount > LongSortRowNum then begin + MsgStr := f_('Sort operation on grid containing more than %d rows can take longer. Do you want to wait for it?', [LongSortRowNum]); + ConfirmResult := MessageDialog('Wait longer for sorting?', MsgStr, mtConfirmation, [mbYes, mbNo]); + if ConfirmResult <> mrYes then + Exit; + end; + + if (Sender.SortColumn <> HitInfo.Column) or (Sender.SortDirection = sdDescending) then begin + Sender.SortDirection := sdAscending; + end else if Sender.SortDirection = sdAscending then begin + Sender.SortDirection := sdDescending; + end; + Screen.Cursor := crHourglass; + Sender.SortColumn := HitInfo.Column; + TBaseVirtualTree(Sender.Treeview).SortTree( HitInfo.Column, Sender.SortDirection ); + Screen.Cursor := crDefault; +end;} + + +{** + Sorting a column of a VirtualTree by comparing two cells +} +{procedure TMainForm.AnyGridCompareNodes(Sender: TBaseVirtualTree; Node1, + Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); +var + VT: TVirtualStringTree; +begin + VT := Sender as TVirtualStringTree; + if Assigned(Node1) and Assigned(Node2) then + Result := CompareAnyNode(VT.Text[Node1, Column], VT.Text[Node2, Column]); +end;} + + +{** + VirtualTree was painted. Adjust background color of sorted column. +} +{procedure TMainForm.AnyGridAfterPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas); +var + i: Integer; + h: TVTHeader; + NewColor: TColor; +begin + h := (Sender as TVirtualStringTree).Header; + for i:=0 to h.Columns.Count-1 do begin + NewColor := GetThemeColor(clWindow); + if h.SortColumn = i then + NewColor := ColorAdjustBrightness(NewColor, COLORSHIFT_SORTCOLUMNS); + h.Columns[i].Color := NewColor; + end; +end;} + + +{** + Start writing logfile. + Called either in FormShow or after closing preferences dialog +} +{procedure TMainForm.SetLogToFile(Value: Boolean); +var + LogfilePattern, LogDir: String; + i : Integer; +begin + if Value = FLogToFile then + Exit; + + if Value then begin + // Ensure directory exists + LogDir := AppSettings.ReadString(asSessionLogsDirectory); + LogDir := IncludeTrailingPathDelimiter(LogDir); + ForceDirectories(LogDir); + + // Determine free filename + LogfilePattern := '%.6u.log'; + i := 1; + FFileNameSessionLog := LogDir + ValidFilename(Format(LogfilePattern, [i])); + while FileExists(FFileNameSessionLog) do begin + inc(i); + FFileNameSessionLog := LogDir + ValidFilename(Format(LogfilePattern, [i])); + end; + + // Create file handle for writing + AssignFile( FFileHandleSessionLog, FFileNameSessionLog );} + //{$I-} // Supress errors + //if FileExists(FFileNameSessionLog) then + // Append(FFileHandleSessionLog) + //else + // Rewrite(FFileHandleSessionLog); + //{$I+} + {if IOResult <> 0 then begin + AppSettings.WriteBool(asLogToFile, False); + ErrorDialog(_('Error opening session log file'), FFileNameSessionLog+CRLF+CRLF+_('Logging is disabled now.')); + end else begin + FLogToFile := Value; + LogSQL(f_('Writing to session log file now: %s', [FFileNameSessionLog])); + end; + end else begin} + //{$I-} // Supress errors + //CloseFile(FFileHandleSessionLog); + //{$I+} + {// Reset IOResult so later checks in ActivateFileLogging doesn't get an old value + IOResult; + FLogToFile := Value; + LogSQL(_('Writing to session log file disabled now')); + end; +end;} + + +{** + Display tooltips in VirtualTrees. Imitates default behaviour of TListView. +} +{procedure TMainForm.AnyGridGetHint(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; var LineBreakStyle: + TVTTooltipLineBreakStyle; var HintText: String); +var + Tree: TVirtualStringTree; + NewHint: String; + Conn: TDBConnection; + ValIsNumber: Boolean; +begin + // Disable tooltips on Wine, as they prevent users from clicking + editing clipped cells + if IsWine then + Exit; + + Tree := TVirtualStringTree(Sender); + + if Tree = QueryTabs.ActiveHelpersTree then begin + Conn := ActiveConnection; + case Sender.GetNodeLevel(Node) of + 1: case Node.Parent.Index of + TQueryTab.HelperNodeFunctions: begin + NewHint := Conn.SQLFunctions[Node.Index].Name + Conn.SQLFunctions[Node.Index].Declaration + + ':' + sLineBreak + Conn.SQLFunctions[Node.Index].Description; + if not NewHint.IsEmpty then begin + HintText := NewHint; + end; + end; + end; + end; + end; + + if HintText.IsEmpty then begin + try + ValIsNumber := IntToStr(MakeInt(Tree.Text[Node, Column])) = Tree.Text[Node, Column]; + except + ValIsNumber := False; + end; + if ValIsNumber then + HintText := FormatNumber(Tree.Text[Node, Column]) + else + HintText := StrEllipsis(Tree.Text[Node, Column], SIZE_KB); + end; + // See http://www.heidisql.com/forum.php?t=20458#p20548 + if Sender = DBtree then + LineBreakStyle := hlbForceSingleLine + else + LineBreakStyle := hlbForceMultiLine; +end;} + + +{procedure TMainForm.actLogHorizontalScrollbarExecute(Sender: TObject); +begin + // Toggle visibility of horizontal scrollbar + if TAction(Sender).Checked then + SynMemoSQLLog.ScrollBars := ssBoth + else + SynMemoSQLLog.ScrollBars := ssVertical; +end;} + + +{** + Enable/disable file logging by popupmenuclick +} +{procedure TMainForm.menuLogToFileClick(Sender: TObject); +begin + LogToFile := not LogToFile; + // Save option + AppSettings.ResetPath; + AppSettings.WriteBool(asLogToFile, LogToFile); +end;} + + +{** + Open folder with session logs +} +{procedure TMainForm.menuOpenLogFolderClick(Sender: TObject); +begin + ShellExec('', AppSettings.ReadString(asSessionLogsDirectory)); +end;} + + +{** + A header column of a VirtualTree was "dragged out", which means: + dragged down or up, not to the left or right. + We imitate the behaviour of various applications (fx Outlook) and + hide this dragged column +} +{procedure TMainForm.AnyGridHeaderDraggedOut(Sender: TVTHeader; Column: + TColumnIndex; DropPosition: TPoint); +var + Remaining: TColumnsArray; +begin + // Hide the draggedout column, if it's not the last one + // See also menuToggleAllClick, where hiding all is restricted through the poAllowHideAll option + Remaining := Sender.Columns.GetVisibleColumns; + if Length(Remaining) > 1 then + Sender.Columns[Column].Options := Sender.Columns[Column].Options - [coVisible]; + // Dynamic arrays are free'd when their scope ends, so this should not be required: + SetLength(Remaining, 0); +end;} + + +{procedure TMainForm.AnyGridIncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; + const SearchText: String; var Result: Integer); +var + CellText: String; + VT: TVirtualStringTree; +begin + // Override VT's default incremental search behaviour. Make it case insensitive. + VT := Sender as TVirtualStringTree; + if VT.FocusedColumn = NoColumn then + Exit; + CellText := VT.Text[Node, VT.FocusedColumn]; + Result := StrLIComp(PChar(CellText), PChar(SearchText), Length(SearchText)); +end;} + + +{procedure TMainForm.ListTablesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + var ContentRect: TRect); +var + Obj: PDBObject; +begin + PaintAlternatingRowBackground(TargetCanvas, Node, CellRect); + + // Only paint bar in rows + size column + if Column in [1, 2] then begin + Obj := Sender.GetNodeData(Node); + case Column of + 1: PaintColorBar(Obj.Rows, FDBObjectsMaxRows, TargetCanvas, CellRect); + 2: PaintColorBar(Obj.Size, FDBObjectsMaxSize, TargetCanvas, CellRect); + end; + end; +end;} + + +{function TMainForm.GetAlternatingRowBackground(Node: PVirtualNode): TColor; +var + clEven, clOdd: TColor; + isEven: Boolean; +begin + // Alternating row background. See issue #139 + Result := clNone; + clEven := AppSettings.ReadInt(asRowBackgroundEven); + clOdd := AppSettings.ReadInt(asRowBackgroundOdd); + isEven := Node.Index mod 2 = 0; + if IsEven and (clEven <> clNone) then + Result := clEven + else if (not IsEven) and (clOdd <> clNone) then + Result := clOdd; +end;} + + +{procedure TMainForm.PaintAlternatingRowBackground(TargetCanvas: TCanvas; Node: PVirtualNode; CellRect: TRect); +var + BgColor: TColor; +begin + // Apply color + BgColor := GetAlternatingRowBackground(Node); + if BgColor <> clNone then begin + TargetCanvas.Brush.Color := BgColor; + TargetCanvas.FillRect(CellRect); + end; +end;} + + +{procedure TMainForm.PaintColorBar(Value, Max: Extended; TargetCanvas: TCanvas; CellRect: TRect); +var + BarWidth, CellWidth: Integer; +begin + if not AppSettings.ReadBool(asDisplayBars) then + Exit; + + // Add minimal margin to cell edges + InflateRect(CellRect, -1, -1); + CellWidth := CellRect.Right - CellRect.Left; + + // Avoid division by zero, when max is 0 - very rare case but reported in issue #2196. + if (Value > 0) and (Max > 0) then begin + BarWidth := Round(CellWidth / Max * Value); + TargetCanvas.Brush.Color := ColorAdjustBrightness(TargetCanvas.Brush.Color, 20); + TargetCanvas.Pen.Color := ColorAdjustBrightness(TargetCanvas.Brush.Color, -40); + TargetCanvas.RoundRect(CellRect.Left, CellRect.Top, CellRect.Left+BarWidth, CellRect.Bottom, 2, 2); + end; +end;} + + +{** + A row in the process list was selected. Fill SynMemoProcessView with + the SQL of that row. +} +{procedure TMainForm.ListProcessesFocusChanged(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex); +var + NodeFocused, EnableControls: Boolean; + SQL: String; +begin + NodeFocused := Assigned(Node); + SQL := ''; + if NodeFocused then begin + SQL := ListProcesses.Text[Node, 7]; + end; + EnableControls := not SQL.IsEmpty; + if EnableControls then begin + SynMemoProcessView.Highlighter := SynSQLSynUsed; + SynMemoProcessView.Text := ListProcesses.Text[Node, 7]; + SynMemoProcessView.Color := clWindow; + end else begin + SynMemoProcessView.Highlighter := nil; + SynMemoProcessView.Text := _('Please select a process with a running query'); + SynMemoProcessView.Color := clBtnFace; + end; + + SynMemoProcessView.Enabled := EnableControls; + pnlProcessView.Enabled := EnableControls; + lblExplainProcess.Enabled := EnableControls and ActiveConnection.Parameters.IsAnyMySQL; + menuExplainProcess.Enabled := lblExplainProcess.Enabled; +end;} + + +{*** + Apply a filter to a Virtual Tree. +} +{procedure TMainForm.editFilterVTChange(Sender: TObject); +begin + // Reset typing timer + TimerFilterVT.Enabled := False; + TimerFilterVT.Enabled := True; + editFilterVT.RightButton.Visible := editFilterVT.Text <> ''; +end;} + + +{procedure TMainForm.editDatabaseTableFilterKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #27 then + (Sender as TButtonedEdit).OnRightButtonClick(Sender); +end;} + + +{procedure TMainForm.TimerFilterVTTimer(Sender: TObject); +begin + // Disable timer to avoid filtering in a loop + TimerFilterVT.Enabled := False; + + // Code moved into this procedure in order to call it by different way + ApplyVTFilter(True); +end;} + + +{procedure TMainForm.ApplyVTFilter(FromTimer: Boolean); +var + Node: PVirtualNode; + VT: TVirtualStringTree; + i: Integer; + match: Boolean; + tab: TTabSheet; + VisibleCount: Cardinal; + CellText: String; + rx: TRegExpr; + OldDataLocalNumberFormat: Boolean; + OldImageIndex: Integer; +begin + // Find the correct VirtualTree that shall be filtered + tab := PageControlMain.ActivePage; + if tab = tabHost then + tab := PageControlHost.ActivePage; + VT := nil; + if tab = tabDatabases then begin + VT := ListDatabases; + FFilterTextDatabases := editFilterVT.Text; + end else if tab = tabVariables then begin + VT := ListVariables; + FFilterTextVariables := editFilterVT.Text; + end else if tab = tabStatus then begin + VT := ListStatus; + FFilterTextStatus := editFilterVT.Text; + end else if tab = tabProcesslist then begin + VT := ListProcesses; + FFilterTextProcessList := editFilterVT.Text; + end else if tab = tabCommandStats then begin + VT := ListCommandStats; + FFilterTextCommandStats := editFilterVT.Text; + end else if tab = tabDatabase then begin + VT := ListTables; + FFilterTextDatabase := editFilterVT.Text; + end else if tab = tabEditor then begin + if ActiveObjectEditor is TfrmTableEditor then + VT := TfrmTableEditor(ActiveObjectEditor).listColumns; + FFilterTextEditor := editFilterVT.Text; + end else if tab = tabData then begin + VT := DataGrid; + FFilterTextData := editFilterVT.Text; + end else if QueryTabs.HasActiveTab and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then begin + VT := ActiveGrid; + QueryTabs.ActiveTab.ActiveResultTab.FilterText := editFilterVT.Text; + end; + if not Assigned(VT) then + Exit; + // Loop through all nodes and hide non matching + Node := VT.GetFirst; + rx := TRegExpr.Create; + rx.ModifierI := True; + rx.Expression := editFilterVT.Text; + if rx.Expression <> '' then try + rx.Exec('abc'); + except + on E:ERegExpr do begin + LogSQL('Filter text is not a valid regular expression: "'+rx.Expression+'"', lcError); + rx.Expression := ''; + end; + end; + VisibleCount := 0; + OldDataLocalNumberFormat := DataLocalNumberFormat; + DataLocalNumberFormat := False; + // Display hour glass instead of X icon + OldImageIndex := editFilterVT.RightButton.ImageIndex; + editFilterVT.RightButton.ImageIndex := 150; + editFilterVT.Repaint; + + VT.BeginUpdate; + while Assigned(Node) do begin + // Don't filter anything if the filter text is empty + match := rx.Expression = ''; + // Search for given text in node's captions + if not match then for i := 0 to VT.Header.Columns.Count - 1 do begin + CellText := VT.Text[Node, i]; + match := rx.Exec(CellText); + if match then + break; + end; + VT.IsVisible[Node] := match; + if match then + inc(VisibleCount); + Node := VT.GetNext(Node); + end; + VT.EndUpdate; + if rx.Expression <> '' then begin + lblFilterVTInfo.Caption := f_('%0:d out of %1:d matching. %2:d hidden.', [VisibleCount, VT.RootNodeCount, VT.RootNodeCount - VisibleCount]); + end else + lblFilterVTInfo.Caption := ''; + + if FromTimer then + VT.Invalidate + else + InvalidateVT(VT, VTREE_LOADED, true); + DataLocalNumberFormat := OldDataLocalNumberFormat; + editFilterVT.RightButton.ImageIndex := OldImageIndex; + rx.Free; +end;} + + +{procedure TMainForm.ApplyFontToGrids; +var + QueryTab: TQueryTab; + ResultTab: TResultTab; + Grid: TVirtualStringTree; + IncrementalSearchActive: Boolean; + AllGrids: TObjectList<TVirtualStringTree>; +begin + // Apply changed settings to all existing data and query grids + LogSQL('Apply grid settings...', lcDebug); + AllGrids := TObjectList<TVirtualStringTree>.Create(False); + IncrementalSearchActive := AppSettings.ReadBool(asIncrementalSearch); + AllGrids.Add(DataGrid); // Data tab grid + AllGrids.Add(QueryGrid); // Mother query grid + for QueryTab in QueryTabs do begin // Query tab child grids + for ResultTab in QueryTab.ResultTabs do begin + AllGrids.Add(ResultTab.Grid); + end; + end; + for Grid in AllGrids do begin + Grid.Font.Name := AppSettings.ReadString(asDataFontName); + Grid.Font.Size := AppSettings.ReadInt(asDataFontSize); + FixVT(Grid, AppSettings.ReadInt(asGridRowLineCount)); + if IncrementalSearchActive then + Grid.IncrementalSearch := isInitializedOnly + else + Grid.IncrementalSearch := isNone; + end; + AllGrids.Free; +end;} + + +{procedure TMainForm.PrepareImageList; +var + IconPack: String; + WantedImageCollection: TComponent; +begin + // Load preferred ImageCollection into VirtualImageList + VirtualImageListMain.Clear; + IconPack := AppSettings.ReadString(asIconPack); + WantedImageCollection := FindComponent('ImageCollection' + IconPack); + if (WantedImageCollection <> nil) and (WantedImageCollection is TImageCollection) then begin + VirtualImageListMain.ImageCollection := WantedImageCollection as TImageCollection; + end else begin + VirtualImageListMain.ImageCollection := ImageCollectionIcons8; + end; + // Add all normal color icons from collection to virtual image list + VirtualImageListMain.Add('', 0, VirtualImageListMain.ImageCollection.Count-1); + // Add all icons again in disabled/grayscale mode, used in TExtForm.PageControlTabHighlight + VirtualImageListMain.AddDisabled('', 0, VirtualImageListMain.ImageCollection.Count-1); +end;} + + +{procedure TMainForm.ListVariablesDblClick(Sender: TObject); +begin + menuEditVariable.Click; +end;} + + +{procedure TMainForm.ListVariablesPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); +var + Idx: PInt64; + i, tmp: Integer; + VarName, SessionVal, GlobalVal: String; + dcat: TDBDatatypeCategoryIndex; + vt: TVirtualStringTree; +begin + vt := Sender as TVirtualStringTree; + Idx := Sender.GetNodeData(Node); + VarName := FVariableNames[Idx^]; + tmp := -1; + for i:=Low(MySQLVariables) to High(MySQLVariables) do begin + if MySQLVariables[i].Name = VarName then begin + tmp := i; + break; + end; + end; + if (tmp=-1) or (not MySQLVariables[tmp].IsDynamic) then begin + // Gray out whole row if the variable is either unknown or not editable + TargetCanvas.Font.Color := GetThemeColor(clGrayText) + end else if Column in [1, 2] then begin + SessionVal := vt.Text[Node, 1]; + GlobalVal := vt.Text[Node, 2]; + if IsInt(SessionVal) or IsInt(GlobalVal) then + dcat := dtcInteger + else if (tmp > -1) and ((MySQLVariables[tmp].EnumValues <> '') or (Pos(UpperCase(SessionVal), 'ON,OFF,0,1,YES,NO')>0)) then + dcat := dtcOther + else + dcat := dtcText; + TargetCanvas.Font.Color := DatatypeCategories[dcat].Color; + end; +end;} + + +{procedure TMainForm.HostListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); +var + Results: TDBQuery; + Idx: PInt64; + IsIdle: Boolean; +begin + if (Column <> (Sender as TVirtualStringTree).Header.MainColumn) then + exit; + if Sender = ListProcesses then begin + Idx := Sender.GetNodeData(Node); + Results := GridResult(Sender); + Results.RecNo := Idx^; + case Kind of + ikNormal, ikSelected: begin + case Results.Connection.Parameters.NetTypeGroup of + ngMySQL: IsIdle := Results.Col('Info', True) = ''; + ngMSSQL: IsIdle := (Results.Col(6, True) <> 'running') and (Results.Col(6, True) <> 'runnable'); + else IsIdle := False; + end; + if IsIdle then begin + if MakeInt(Results.Col(5, True)) < 60 then + ImageIndex := 151 // Idle, same icon as in lower right status panel + else + ImageIndex := 167 // Long idle thread + end else + ImageIndex := actExecuteQuery.ImageIndex; // Running query + end; + ikOverlay: begin + if IntToStr(Results.Connection.ThreadId) = Results.Col(0, True) then + ImageIndex := 168; // Indicate users own thread id + if CompareText(Results.Col(4, True), 'Killed') = 0 then + ImageIndex := 158; // Broken + end; + else; + end; + end else begin + case Kind of + ikNormal, ikSelected: ImageIndex := 25; + else; + end; + end; +end;} + + +{procedure TMainForm.HostListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +var + Idx: PInt64; + Results: TDBQuery; + ValIsBytes, ValIsNumber: Boolean; + ValCount, CommandCount: Int64; + tmpval: Double; +begin + Idx := Sender.GetNodeData(Node); + Results := GridResult(Sender); + // See issue #3416 + if (Results = nil) and (Sender <> ListVariables) then + Exit; + if Results <> nil then + Results.RecNo := Idx^; + + if (Sender = ListStatus) and (Column in [1,2,3]) then begin + CellText := Results.Col(1); + + // Detect value type + try + ValIsNumber := IntToStr(MakeInt(CellText)) = CellText; + except + ValIsNumber := False; + end; + ValIsBytes := ValIsNumber and (Copy(Results.Col(0), 1, 6) = 'Bytes_'); + + // Calculate average values ... + case Column of + 1: begin // Format numeric or byte values + if ValIsBytes then + CellText := FormatByteNumber(CellText) + else if ValIsNumber then + CellText := FormatNumber(CellText); + end; + 2,3: begin // ... per hour/second + if ValIsNumber then begin + ValCount := MakeInt(CellText); + tmpval := ValCount / (FStatusServerUptime / 60 / 60); + if Column = 3 then + tmpval := tmpval / 60 / 60; + if ValIsBytes then + CellText := FormatByteNumber(Trunc(tmpval)) + else if ValIsNumber then + CellText := FormatNumber(tmpval, 1); + end else + CellText := ''; + end; + end; + + end else if Sender = ListCommandStats then begin + CommandCount := MakeInt(Results.Col(1)); + case Column of + 0: begin // Strip "Com_" + CellText := Results.Col(Column); + if CellText.StartsWith('Com_', True) then + CellText := Copy(CellText, 5, Length(CellText)); + CellText := StringReplace(CellText, '_', ' ', [rfReplaceAll] ); + end; + 1: begin // Total Frequency + CellText := FormatNumber(CommandCount); + end; + 2: begin // Average per hour + tmpval := CommandCount / (FCommandStatsServerUptime / 60 / 60); + CellText := FormatNumber(tmpval, 1); + end; + 3: begin // Average per second + tmpval := CommandCount / FCommandStatsServerUptime; + CellText := FormatNumber(tmpval, 1); + end; + 4: begin // Percentage. Take care of division by zero errors and Int64's + tmpval := 100 / Max(FCommandStatsQueryCount, 1) * Max(CommandCount, 1); + CellText := FormatNumber(tmpval, 1) + ' %'; + end; + end; + + end else if Sender = ListVariables then begin + try + case Column of + 0: CellText := FVariableNames[Idx^]; + 1: CellText := FSessionVars.Values[FVariableNames[Idx^]]; + 2: CellText := FGlobalVars.Values[FVariableNames[Idx^]]; + end; + except + CellText := ''; + end; + + end else begin + // Values directly from a query result + CellText := StrEllipsis(Results.Col(Column, True), SIZE_KB*50); + end; +end;} + + +{** + Edit a server variable +} +{procedure TMainForm.menuEditVariableClick(Sender: TObject); +var + Dialog: TfrmEditVariable; +begin + Dialog := TfrmEditVariable.Create(Self); + try + try + Dialog.VarName := ListVariables.Text[ListVariables.FocusedNode, 0]; + Dialog.VarValue := ListVariables.Text[ListVariables.FocusedNode, 1]; + // Refresh list node + if Dialog.ShowModal = mrOK then + InvalidateVT(ListVariables, VTREE_NOTLOADED, False); + except + on E:EVariableError do + ErrorDialog(E.Message); + end; + finally + Dialog.Free; + end; +end;} + + +{procedure TMainForm.DBtreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); +begin + // Set pointer size of bound TDBObjects + NodeDataSize := SizeOf(TDBObject); +end;} + + +{** + Set text of a treenode before it gets displayed or fetched in any way +} +{procedure TMainForm.DBtreeGetText(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); +var + DBObjects: TDBObjectList; + DBObj: PDBObject; + i: Integer; + Bytes: Int64; + AllListsCached: Boolean; +begin + DBObj := Sender.GetNodeData(Node); + case Column of + 0: case DBObj.NodeType of + lntNone: CellText := DBObj.Connection.Parameters.SessionPath; + lntDb: CellText := DBObj.Database; + lntGroup: begin + CellText := DBObj.Name; + if Sender.ChildrenInitialized[Node] then + CellText := CellText + ' (' + FormatNumber(Sender.ChildCount[Node]) + ')'; + end; + lntTable..lntEvent: try + if (DBObj.Schema <> '') and (DBObj.Connection.Parameters.NetTypeGroup = ngMSSQL) then + CellText := DBObj.Schema + '.' + DBObj.Name + else + CellText := DBObj.Name; + except + CellText := DBObj.Name; + end; + lntColumn: CellText := DBObj.Column; + end; + 1: if DBObj.Connection.Active then case DBObj.NodeType of + // Calculate and display the sum of all table sizes in ALL dbs if all table lists are cached + lntNone: begin + AllListsCached := true; + for i:=0 to DBObj.Connection.AllDatabases.Count-1 do begin + if not DBObj.Connection.DbObjectsCached(DBObj.Connection.AllDatabases[i]) then begin + AllListsCached := false; + break; + end; + end; + // Will be also set to a negative value by GetTableSize and results of SHOW TABLES + Bytes := -1; + if AllListsCached then begin + Bytes := 0; + for i:=0 to DBObj.Connection.AllDatabases.Count-1 do begin + DBObjects := DBObj.Connection.GetDBObjects(DBObj.Connection.AllDatabases[i]); + Inc(Bytes, DBObjects.DataSize); + end; + end; + if Bytes >= 0 then CellText := FormatByteNumber(Bytes) + else CellText := ''; + end; + // Calculate and display the sum of all table sizes in ONE db, if the list is already cached. + lntDb: begin + if not DBObj.Connection.DbObjectsCached(DBObj.Database) then + CellText := '' + else begin + DBObjects := DBObj.Connection.GetDBObjects(DBObj.Database); + CellText := FormatByteNumber(DBObjects.DataSize); + end; + end; + lntTable: begin + if DBObj.Size >= 0 then + CellText := FormatByteNumber(DBObj.Size) + else + CellText := ''; + end + else CellText := ''; // Applies for views/procs/... which have no size + end; + end; +end;} + + +{** + Set icon of a treenode before it gets displayed +} +{procedure TMainForm.DBtreeGetImageIndex(Sender: TBaseVirtualTree; Node: + PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: + Boolean; var ImageIndex: TImageIndex); +var + DBObj: PDBObject; +begin + if Column > 0 then + Exit; + DBObj := Sender.GetNodeData(Node); + case Kind of + ikNormal, ikSelected: begin + ImageIndex := DBObj.ImageIndex; + Ghosted := (DBObj.NodeType = lntNone) and (not DBObj.Connection.Active); + Ghosted := Ghosted or ((DBObj.NodeType = lntDB) + and (not DBObj.Connection.DbObjectsCached(DBObj.Database)) + ); + Ghosted := Ghosted or ((DBObj.NodeType = lntGroup) + and Sender.ChildrenInitialized[Node] + and (Sender.ChildCount[Node] = 0) + ); + Ghosted := Ghosted or ((DBObj.NodeType in [lntTable..lntEvent]) + and (not DBObj.WasSelected) + ); + end; + ikOverlay: + ImageIndex := DBObj.OverlayImageIndex; + end; +end;} + + +{** + Set childcount of an expanding treenode +} +{procedure TMainForm.DBtreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); +var + DBObj: PDBObject; + Columns: TTableColumnList; + DBObjects: TDBObjectList; +begin + DBObj := Sender.GetNodeData(Node); + case DBObj.NodeType of + // Session node expanding + lntNone: begin + Screen.Cursor := crHourglass; + ShowStatusMsg(_('Reading Databases...')); + if Sender.Tag = VTREE_NOTLOADED_PURGECACHE then + DBObj.Connection.RefreshAllDatabases; + ShowStatusMsg; + Sender.Tag := VTREE_LOADED; + InvalidateVT(ListDatabases, VTREE_NOTLOADED, True); + ChildCount := DBObj.Connection.AllDatabases.Count; + Screen.Cursor := crDefault; + end; + // DB node expanding + lntDb: begin + if actGroupObjects.Checked then begin + // Just tables, views, etc. + ChildCount := 6; + end else begin + ShowStatusMsg(_('Reading objects ...')); + Screen.Cursor := crHourglass; + try + ChildCount := DBObj.Connection.GetDBObjects(DBObj.Connection.AllDatabases[Node.Index]).Count; + finally + ShowStatusMsg; + Screen.Cursor := crDefault; + end; + end; + end; + lntGroup: begin + ChildCount := 0; + DBObjects := DBObj.Connection.GetDBObjects(DBObj.Database, False, DBObj.GroupType); + ChildCount := DBObjects.Count; + end; + lntTable: + if GetParentFormOrFrame(Sender) is TfrmSelectDBObject then begin + Columns := DBObj.TableColumns; + ChildCount := Columns.Count; + end; + end; +end;} + + +{** + Set initial options of a treenode and bind DBobject to node which holds the relevant + connection object, probably its database and probably its table/view/... specific properties +} +{procedure TMainForm.DBtreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: + PVirtualNode; var InitialStates: TVirtualNodeInitStates); +var + Item, ParentObj: PDBObject; + DBObjects: TDBObjectList; + Columns: TTableColumnList; +begin + Item := Sender.GetNodeData(Node); + if (not Assigned(ParentNode)) or (ParentNode = nil) then begin + Item^ := TDBObject.Create(FConnections[Node.Index]); + // Ensure plus sign is visible for root (and dbs, see below) + Include(InitialStates, ivsHasChildren); + end else begin + ParentObj := Sender.GetNodeData(ParentNode); + case ParentObj.NodeType of + lntNone: begin + Item^ := TDBObject.Create(ParentObj.Connection); + Item.NodeType := lntDb; + Item.Database := Item.Connection.AllDatabases[Node.Index]; + Include(InitialStates, ivsHasChildren); + end; + lntDb: begin + if actGroupObjects.Checked then begin + Item^ := TDBObject.Create(ParentObj.Connection); + Item.NodeType := lntGroup; + case Node.Index of + 0: begin Item.GroupType := lntTable; Item.Name := _('Tables'); end; + 1: begin Item.GroupType := lntView; Item.Name := _('Views'); end; + 2: begin Item.GroupType := lntProcedure; Item.Name := _('Procedures'); end; + 3: begin Item.GroupType := lntFunction; Item.Name := _('Functions'); end; + 4: begin Item.GroupType := lntTrigger; Item.Name := _('Triggers'); end; + 5: begin Item.GroupType := lntEvent; Item.Name := _('Events'); end; + end; + Item.Database := ParentObj.Database; + InitialStates := InitialStates + [ivsHasChildren]; + end else begin + DBObjects := ParentObj.Connection.GetDBObjects(ParentObj.Database); + Item^ := DBObjects[Node.Index]; + if (GetParentFormOrFrame(Sender) is TfrmSelectDBObject) and (Item.NodeType = lntTable) then + Include(InitialStates, ivsHasChildren); + end; + end; + lntGroup: begin + DBObjects := ParentObj.Connection.GetDBObjects(ParentObj.Database, False, ParentObj.GroupType); + Item^ := DBObjects[Node.Index]; + if (GetParentFormOrFrame(Sender) is TfrmSelectDBObject) and (Item.NodeType = lntTable) then + Include(InitialStates, ivsHasChildren); + end; + lntTable: begin + Item^ := TDBObject.Create(ParentObj.Connection); + Item.NodeType := lntColumn; + Columns := ParentObj.TableColumns; + Item.Database := ParentObj.Database; + Item.Name := ParentObj.Name; + Item.Column := Columns[Node.Index].Name; + end; + end; + end; +end;} + + +{** + Selection in database tree has changed +} +{procedure TMainForm.DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); +var + DBObj, PrevDBObj, ParentDBObj: PDBObject; + MainTabToActivate: TTabSheet; + EnteringSession: Boolean; +begin + // Set wanted main tab and call SetMainTab later, when all lists have been invalidated + MainTabToActivate := nil; + PrevDBObj := nil; + ParentDBObj := nil; + + if Assigned(Node) then begin + LogSQL('DBtreeFocusChanged, Node level: '+IntToStr(Sender.GetNodeLevel(Node))+', FTreeRefreshInProgress: '+IntToStr(Integer(FTreeRefreshInProgress)), lcDebug); + + // Post pending UPDATE + if (DataGridResult<>nil) and DataGridResult.Modified then + actDataPostChangesExecute(DataGrid); + + DBObj := Sender.GetNodeData(Node); + DBObj.WasSelected := True; + FActiveDbObj := TDBObject.Create(DBObj.Connection); + FActiveDbObj.Assign(DBObj^); + if Assigned(Node.Parent) and (DBtree.GetNodeLevel(Node) > 0) then + ParentDBObj := Sender.GetNodeData(Node.Parent); + + case FActiveDbObj.NodeType of + lntNone: begin + if (not DBtree.Dragging) and (not QueryTabs.HasActiveTab) then + MainTabToActivate := tabHost; + FActiveDbObj.Connection.Database := ''; + end; + lntDb, lntGroup: begin + // Selecting a database can cause an SQL error if the db was deleted from outside. Select previous node in that case. + try + FActiveDbObj.Connection.Database := FActiveDbObj.Database; + except on E:EDbError do begin + ErrorDialog(E.Message); + SelectNode(DBtree, TreeClickHistoryPrevious); + Exit; + end; + end; + if (not DBtree.Dragging) and (not QueryTabs.HasActiveTab) then + MainTabToActivate := tabDatabase; + FActiveObjectGroup := FActiveDbObj.GroupType; + end; + lntTable..lntEvent: begin + try + FActiveDbObj.Connection.Database := FActiveDbObj.Database; + except on E:EDbError do begin + ErrorDialog(E.Message); + SelectNode(DBtree, TreeClickHistoryPrevious); + Exit; + end; + end; + + // Retrieve columns of current table or view. Mainly used in datagrid. + SelectedTableColumns.Clear; + SelectedTableKeys.Clear; + SelectedTableForeignKeys.Clear; + AppSettings.SessionPath := GetRegKeyTable; + SelectedTableTimestampColumns.Text := AppSettings.ReadString(asTimestampColumns); + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); + try + if FActiveDbObj.NodeType in [lntTable, lntView] then begin + SelectedTableColumns := FActiveDbObj.TableColumns; + try + SelectedTableKeys := FActiveDbObj.TableKeys; + except // No show stopper, happening when a view references a renamed table column, see #1130 + on E:EDbError do + ErrorDialog(_('This view probably contains an error in its code.')+sLineBreak+sLineBreak+E.Message); + end; + SelectedTableForeignKeys := FActiveDbObj.TableForeignKeys; + end; + PlaceObjectEditor(FActiveDbObj); + // When a table is clicked in the tree, and the current + // tab is a Host or Database tab, switch to showing table columns. + if (PagecontrolMain.ActivePage = tabHost) or (PagecontrolMain.ActivePage = tabDatabase) then + MainTabToActivate := tabEditor; + if DataGrid.Tag = VTREE_LOADED then + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); + // Update the list of columns + RefreshHelperNode(TQueryTab.HelperNodeColumns); + except on E:EDbError do + ErrorDialog(E.Message); + end; + + if Assigned(ParentDBObj) then + FActiveObjectGroup := ParentDBObj.GroupType; + end; + end; + + if TreeClickHistoryPrevious(True) <> nil then + PrevDBObj := Sender.GetNodeData(TreeClickHistoryPrevious(True)); + + // When clicked node is from a different connection than before, do session specific stuff here: + try + EnteringSession := (FActiveDbObj <> nil) + and ((PrevDBObj = nil) or (PrevDBObj.Connection <> FActiveDbObj.Connection)); + except + on E:EAccessViolation do begin + LogSQL(E.ClassName+' while moving focus in tree.', lcError); + EnteringSession := True; + end; + end; + if EnteringSession then begin + LogSQL(f_('Entering session "%s"', [FActiveDbObj.Connection.Parameters.SessionPath]), lcInfo); + RefreshHelperNode(TQueryTab.HelperNodeHistory); + RefreshHelperNode(TQueryTab.HelperNodeProfile); + case FActiveDbObj.Connection.Parameters.NetTypeGroup of + ngMySQL: + SynSQLSynUsed.SQLDialect := sqlMySQL; + ngMSSQL: + SynSQLSynUsed.SQLDialect := sqlMSSQL2K; + ngPgSQL: + SynSQLSynUsed.SQLDialect := sqlPostgres; + ngSQLite: + SynSQLSynUsed.SQLDialect := sqlStandard; + ngInterbase: + SynSQLSynUsed.SQLDialect := sqlInterbase6; + else + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(FActiveDbObj.Connection.Parameters.NetType)]); + end; + // Extend predefined MySQLFunctions from SynHighlighterSQL with our own functions list + SynSQLSynUsed.FunctionNames.BeginUpdate; + SynSQLSynUsed.FunctionNames.Clear; + SynSQLSynUsed.FunctionNames.AddStrings(FActiveDbObj.Connection.SQLFunctions.Names); + SynSQLSynUsed.FunctionNames.EndUpdate; + end; + + if (FActiveDbObj <> nil) + and (FActiveDbObj.NodeType <> lntNone) + and ( + (PrevDBObj = nil) + or (PrevDBObj.Connection <> FActiveDbObj.Connection) + or (PrevDBObj.Database <> FActiveDbObj.Database) + or (PrevDBObj.GroupType <> FActiveObjectGroup) + ) then + InvalidateVT(ListTables, VTREE_NOTLOADED, True); + if FActiveDbObj.NodeType = lntGroup then + InvalidateVT(ListTables, VTREE_NOTLOADED, True); + + SetTabCaption(tabHost.PageIndex, FActiveDbObj.Connection.Parameters.SessionName); + SetTabCaption(tabDatabase.PageIndex, _('Database')+': '+FActiveDbObj.Connection.Database); + ShowStatusMsg(FActiveDbObj.Connection.Parameters.NetTypeName(False)+' '+FActiveDbObj.Connection.ServerVersionStr, 3); + end else begin + LogSQL('DBtreeFocusChanged without node.', lcDebug); + FreeAndNil(FActiveDbObj); + tabHost.Caption := _('Host'); + tabDatabase.Caption := _('Database'); + // Clear server version panel + ShowStatusMsg('', 3); + end; + + if (FActiveDbObj = nil) or (PrevDBObj = nil) or (PrevDBObj.Connection <> FActiveDbObj.Connection) then begin + TimerConnected.OnTimer(Sender); + TimerHostUptime.OnTimer(Sender); + InvalidateVT(ListDatabases, VTREE_NOTLOADED, False); + InvalidateVT(ListVariables, VTREE_NOTLOADED, False); + InvalidateVT(ListStatus, VTREE_NOTLOADED, False); + InvalidateVT(ListProcesses, VTREE_NOTLOADED, False); + InvalidateVT(ListCommandstats, VTREE_NOTLOADED, False); + InvalidateVT(ListTables, VTREE_NOTLOADED, False); + ValidateQueryControls(Self); + end; + + // Make wanted tab visible before activating, to avoid unset tab on Wine + if Assigned(MainTabToActivate) then + MainTabToActivate.TabVisible := True; + if not FTreeRefreshInProgress then begin + SetMainTab(MainTabToActivate); + tabDatabase.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType <> lntNone); + tabEditor.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType in [lntTable..lntEvent]); + tabData.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType in [lntTable, lntView]); + end; + + // Store click history item + SetLength(FTreeClickHistory, Length(FTreeClickHistory)+1); + FTreeClickHistory[Length(FTreeClickHistory)-1] := Node; + + DBTree.InvalidateColumn(0); + FixQueryTabCloseButtons; + SetWindowCaption; +end;} + + +{procedure TMainForm.DBtreeFocusChanging(Sender: TBaseVirtualTree; OldNode, + NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; + var Allowed: Boolean); +begin + // Check if some editor has unsaved changes + if Assigned(ActiveObjectEditor) and Assigned(NewNode) and (NewNode <> OldNode) and (not FTreeRefreshInProgress) then begin + Allowed := not (ActiveObjectEditor.DeInit in [mrAbort, mrCancel]); + DBTree.Selected[DBTree.FocusedNode] := not Allowed; + end else + Allowed := NewNode <> OldNode; +end;} + + +{procedure TMainForm.DBtreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); +var +// DBObj: PDBObject; + i: Integer; +begin + // Keep track of the previously selected tree node's state, to avoid AVs in OnFocusChanged() + for i:=0 to Length(FTreeClickHistory)-1 do begin + if Node = FTreeClickHistory[i] then + FTreeClickHistory[i] := nil; + end; + // TODO: Free object if its host or db. Tables/views/... already get freed in Connection.ClearDBObjects + // does not work here when table is focused, for some reason: + // DBObj := Sender.GetNodeData(Node); + // if Assigned(DBObj^) and (DBObj.NodeType in [lntNone, lntDb]) then + // logsql('freeing node: type #'+inttostr(integer(dbobj.NodeType))+' name: '+dbobj.database); + // FreeAndNil(DBObj^); + // end; +end;} + + +{function TMainForm.TreeClickHistoryPrevious(MayBeNil: Boolean=False): PVirtualNode; +var + i: Integer; +begin + // Navigate to previous or next existant clicked node + Result := nil; + for i:=High(FTreeClickHistory) downto Low(FTreeClickHistory) do begin + if MayBeNil or (FTreeClickHistory[i] <> nil) then begin + Result := FTreeClickHistory[i]; + break; + end; + end; +end;} + + +{procedure TMainForm.ConnectionReady(Connection: TDBConnection; Database: String); +begin + // Manually trigger changed focused tree node, to display the right server vendor + // and version. Also required on reconnects. + DBtree.OnFocusChanged(DBtree, DBtree.FocusedNode, DBtree.FocusedColumn); +end;} + + +{procedure TMainForm.DatabaseChanged(Connection: TDBConnection; Database: String); +begin + // Immediately force db icons to repaint, so the user sees the active db state + DBtree.Repaint; + + // Clear Filter issue 3466 + FFilterTextDatabase := ''; + + if QueryTabs.ActiveHelpersTree <> nil then + QueryTabs.ActiveHelpersTree.Invalidate; +end;} + + +{procedure TMainForm.ObjectnamesChanged(Connection: TDBConnection; Database: String); +var + DBObjects: TDBObjectList; + Obj: TDBObject; + TableNames, ProcNames: TStringList; +begin + // Tell SQL highlighter about names of tables and procedures in selected database + if (ActiveConnection <> Connection) or (Database <> Connection.Database) then + Exit; + SynSQLSynUsed.TableNames.Clear; + SynSQLSynUsed.ProcNames.Clear; + if Connection.DbObjectsCached(Database) then begin + DBObjects := Connection.GetDBObjects(Database); + TableNames := TStringList.Create; + TableNames.BeginUpdate; + ProcNames := TStringList.Create; + ProcNames.BeginUpdate; + for Obj in DBObjects do begin + case Obj.NodeType of + lntTable, lntView: begin + // Slow highlighter enhanced by uschuster. See http://www.heidisql.com/forum.php?t=16307 + // ... and here: https://github.com/SynEdit/SynEdit/issues/28 + TableNames.Add(Obj.Name); + end; + lntProcedure, lntFunction: begin + ProcNames.Add(Obj.Name); + end; + end; + end; + TableNames.EndUpdate; + ProcNames.EndUpdate; + SynSQLSynUsed.TableNames.Text := TableNames.Text; + SynSQLSynUsed.ProcNames.Text := ProcNames.Text; + TableNames.Free; + ProcNames.Free; + end; +end;} + + +{procedure TMainForm.DBtreeDblClick(Sender: TObject); +var + DBObj: PDBObject; + m: TSynMemo; +begin + // Paste DB or table name into query window on treeview double click. + if AppSettings.ReadBool(asDoubleClickInsertsNodeText) and QueryTabs.HasActiveTab and Assigned(DBtree.FocusedNode) then begin + DBObj := DBtree.GetNodeData(DBtree.FocusedNode); + if DBObj.NodeType in [lntDb, lntTable..lntEvent] then begin + m := QueryTabs.ActiveMemo; + m.DragDrop(Sender, m.CaretX, m.CaretY); + end; + end; +end;} + + +{procedure TMainForm.DBtreeExpanded(Sender: TBaseVirtualTree; + Node: PVirtualNode); +begin + // Table and database filter both need initialized children + Sender.ReinitChildren(Node, False); + editDatabaseTableFilterChange(Self); +end;} + + +{procedure TMainForm.DBtreeExpanding(Sender: TBaseVirtualTree; + Node: PVirtualNode; var Allowed: Boolean); +var + DBObj: PDBObject; + GNode: PVirtualNode; +begin + // Auto-init children of sibling groups + DBObj := Sender.GetNodeData(Node); + if DBObj.NodeType = lntGroup then begin + GNode := Sender.GetFirstChild(Node.Parent); + while Assigned(GNode) do begin + if not Sender.ChildrenInitialized[GNode] then begin + Sender.ReinitChildren(GNode, False); + end; + GNode := Sender.GetNextSibling(GNode); + end; + end; +end;} + + +{procedure TMainForm.DBtreePaintText(Sender: TBaseVirtualTree; const + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: + TVSTTextType); +var + DBObj: PDBObject; + WalkNode: PVirtualNode; +begin + // Grey out non-current connection nodes, and rather unimportant "Size" column + DBObj := Sender.GetNodeData(Node); + if DBObj.Connection <> ActiveConnection then + TargetCanvas.Font.Color := clGrayText + else if (Column = 1) and (DBObj.NodeType in [lntTable..lntEvent]) then + TargetCanvas.Font.Color := clGrayText; + + // Set bold text if painted node is in focused path + if (Column = Sender.Header.MainColumn) then begin + WalkNode := Sender.FocusedNode; + while Assigned(WalkNode) do begin + if WalkNode = Node then begin + TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]; + Break; + end; + try + // This crashes in some situations, which I could never reproduce. + // See uploaded crash reports and issue #1270. + WalkNode := Sender.NodeParent[WalkNode]; + except + on E:EAccessViolation do begin + LogSQL('DBtreePaintText, NodeParent: '+E.Message, lcError); + Break; + end; + end; + end; + end; +end;} + + +{** + Refresh the whole tree +} +{procedure TMainForm.RefreshTree(FocusNewObject: TDBObject=nil); +var + DBNode: PVirtualNode; + OnlyDBNode, Expanded: Boolean; + SessNode: PVirtualNode; +begin + // This refreshes exactly one session node and all its db and table nodes. + // Also, tries to focus the previous focused object, if present. + + // Object editors call RefreshTree in order to make a just created object visible: + OnlyDBNode := FocusNewObject <> nil; + + // Remember currently selected object + if FocusNewObject = nil then begin + FocusNewObject := TDBObject.Create(ActiveConnection); + if FActiveDbObj <> nil then + FocusNewObject.Assign(FActiveDbObj); + end; + + // ReInit tree population + FTreeRefreshInProgress := True; + SelectNode(DBtree, nil); + try + if not OnlyDBNode then begin + FocusNewObject.Connection.ClearAllDbObjects; + FocusNewObject.Connection.RefreshAllDatabases; + SessNode := GetRootNode(DBtree, FocusNewObject.Connection); + if Assigned(SessNode) then begin + Expanded := DBtree.Expanded[SessNode]; + DBtree.ResetNode(SessNode); + DBtree.Expanded[SessNode] := Expanded; + end; + end else begin + FocusNewObject.Connection.ClearDbObjects(FocusNewObject.Database); + DBNode := FindDbNode(DBtree, FocusNewObject.Connection, FocusNewObject.Database); + if Assigned(DBNode) then + DBtree.ResetNode(DBNode); + end; + + // Reselect active or new database if present. Could have been deleted or renamed. + try + if FocusNewObject.NodeType in [lntTable..lntEvent] then + ActiveDBObj := FocusNewObject; + if not Assigned(DBtree.FocusedNode) then + SetActiveDatabase(FocusNewObject.Database, FocusNewObject.Connection); + if not Assigned(DBtree.FocusedNode) then + SetActiveDatabase('', FocusNewObject.Connection); + except + end; + if not Assigned(DBtree.FocusedNode) then + raise Exception.Create(_('Could not find node to focus.')); + + finally + FTreeRefreshInProgress := False; + // Tree node filtering needs a hit in special cases, e.g. after a db was dropped + if editDatabaseFilter.Text <> '' then + editDatabaseFilter.OnChange(editDatabaseFilter); + if editTableFilter.Text <> '' then + editTableFilter.OnChange(editTableFilter); + if editFilterVT.Text <> '' then + ApplyVTFilter(False); + end; +end;} + + +{** + Find a database node in the tree by passing its name +} +{function TMainForm.FindDBNode(Tree: TBaseVirtualTree; Connection: TDBConnection; db: String): PVirtualNode; +var + DBObj: PDBObject; + n, DBNode: PVirtualNode; +begin + Result := nil; + n := GetRootNode(Tree, Connection); + DBNode := Tree.GetFirstChild(n); + while Assigned(DBNode) do begin + DBObj := Tree.GetNodeData(DBNode); + if DBObj.Database = db then begin + Result := DBNode; + Break; + end; + DBNode := Tree.GetNextSibling(DBNode); + end; +end;} + + +{** + Expand all db nodes +} +{procedure TMainForm.menuTreeExpandAllClick(Sender: TObject); +begin + DBtree.FullExpand; + DBtree.ScrollIntoView(DBtree.FocusedNode, False); +end;} + +{** + Collapse all db nodes +} +{procedure TMainForm.menuToggleAllClick(Sender: TObject); +var + Grid: TVirtualStringTree; + Col: TColumnIndex; + VisibleColCount: Integer; + DoHide, AllowHideAll: Boolean; +begin + // Toggle visibility of all columns in list + // Always leave one column visible, synced with poAllowHideAll from popupListHeader.Options + // Logsql(PopupComponent(Sender).Name+': '+PopupComponent(Sender).ClassName); + Grid := PopupComponent(Sender) as TVirtualStringTree; + + VisibleColCount := 0; + Col := Grid.Header.Columns.GetFirstColumn; + while Col > NoColumn do begin + if coVisible in Grid.Header.Columns[Col].Options then + Inc(VisibleColCount); + Col := Grid.Header.Columns.GetNextColumn(Col); + end; + DoHide := VisibleColCount = Grid.Header.Columns.Count; + AllowHideAll := poAllowHideAll in popupListHeader.Options; + + Col := Grid.Header.Columns.GetFirstColumn; + while Col > NoColumn do begin + if DoHide and ((Col <> Grid.Header.Columns.GetFirstColumn) or AllowHideAll) then + Grid.Header.Columns[Col].Options := Grid.Header.Columns[Col].Options - [coVisible] + else + Grid.Header.Columns[Col].Options := Grid.Header.Columns[Col].Options + [coVisible]; + Col := Grid.Header.Columns.GetNextColumn(Col); + end; + +end;} + +{procedure TMainForm.menuTreeCollapseAllClick(Sender: TObject); +var + n: PVirtualNode; + i: Integer; +begin + n := DBtree.GetFirstChild(DBtree.GetFirst); + for i := 0 to DBtree.GetFirst.ChildCount - 1 do begin + DBtree.FullCollapse(n); + n := DBtree.GetNextSibling(n); + end; + DBtree.ScrollIntoView(DBtree.FocusedNode, False); +end;} + + +{procedure TMainForm.editFilterSearchChange(Sender: TObject); +var + Clause, Line, Condition: String; + Conditions: TStringList; + i: Integer; + ed: TEdit; + Conn: TDBConnection; + rx: TRegExpr; +begin + ed := TEdit(Sender); + Clause := ''; + if ed.Text <> '' then begin + + Conn := ActiveConnection; + rx := TRegExpr.Create; + rx.ModifierI := True; + Conditions := TStringList.Create; + for i:=0 to SelectedTableColumns.Count-1 do begin + // The normal case: do a LIKE comparison + Condition := '''%' + Conn.EscapeString(ed.Text, True, False)+'%'''; + Condition := Conn.GetSQLSpecifity(spLikeCompare, [SelectedTableColumns[i].CastAsText, Condition]); + if not SelectedTableColumns[i].DataType.ValueMustMatch.IsEmpty then begin + // Use an exact comparison for some PostgreSQL data types to overcome SQL errors, e.g. UUID, INT etc. + // Also, prevent other errors by matching the value against a certain regular expression. + // If it does not match, leave this column away. + // See http://www.heidisql.com/forum.php?t=20953 + rx.Expression := SelectedTableColumns[i].DataType.ValueMustMatch; + if rx.Exec(ed.Text) then + Condition := Conn.QuoteIdent(SelectedTableColumns[i].Name) + '=' + Conn.EscapeString(ed.Text) + else + Condition := ''; + end; + if not Condition.IsEmpty then + Conditions.Add(Condition); + end; + rx.Free; + + Line := ''; + for i:=0 to Conditions.Count-1 do begin + if i > 0 then + Conditions[i] := ' OR ' + Conditions[i]; + // Add linebreak near right window edge + if (not Line.IsEmpty) and (Length(Line + Conditions[i]) >= SynMemoFilter.CharsInWindow-5) then begin + Clause := Clause + Line + sLineBreak; + Line := ''; + end; + Line := Line + Conditions[i]; + end; + Clause := Clause + Line + Conn.LikeClauseTail; + + end; + SynMemoFilter.UndoList.AddGroupBreak; + SynMemoFilter.SelectAll; + SynMemoFilter.SelText := Clause; +end;} + + +{procedure TMainForm.SynMemoFilterStatusChange(Sender: TObject; Changes: TSynStatusChanges); +var + TextHeight: Integer; + LineCount: Integer; + PanelHeight: Integer; +const + MinDisplayLineCount = 2; + MaxDisplayLineCount = 8; +begin + actClearFilterEditor.Enabled := (Sender as TSynMemo).GetTextLen > 0; + + LineCount := SynMemoFilter.DisplayLineCount; + LineCount := Min(LineCount, MaxDisplayLineCount); + LineCount := Max(LineCount, MinDisplayLineCount); + TextHeight := LineCount * SynMemoFilter.LineHeight + 10; + PanelHeight := pnlFilter.Height + (TextHeight - SynMemoFilter.Height); + PanelHeight := Max(PanelHeight, btnFilterApply.Top + btnFilterApply.Height + 5); + if PanelHeight <> pnlFilter.Height then + pnlFilter.Height := PanelHeight; +end;} + + +{procedure TMainForm.ToggleFilterPanel(ForceVisible: Boolean = False); +var + ShowIt: Boolean; +begin + ShowIt := ForceVisible or (not pnlFilter.Visible); + tbtnDataFilter.Down := ShowIt; + pnlFilter.Visible := ShowIt; +end;} + + +{procedure TMainForm.EnableDataTab(Enable: Boolean); +begin + // Disable data grid to prevent accessing results of disconnected sessions + // Also, no data for routines + DataGrid.Enabled := Enable; + pnlDataTop.Enabled := Enable; + pnlFilter.Enabled := Enable; + if Enable then + lblSorryNoData.Parent := tabData + else + lblSorryNoData.Parent := DataGrid; +end;} + + +{procedure TMainForm.editFilterSearchEnter(Sender: TObject); +begin + // Enables triggering apply button with Enter + btnFilterApply.Default := True; +end;} + + +{procedure TMainForm.editFilterSearchExit(Sender: TObject); +begin + btnFilterApply.Default := False; +end;} + + + +{** + A grid cell fetches its text content +} +{procedure TMainForm.AnyGridGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +var + EditingAndFocused, IsScientific: Boolean; + RowNumber: PInt64; + Results: TDBQuery; + Timestamp: Int64; + DotPos, i, NumZeros, NumDecimals, KeepDecimals: Integer; + ResultCol: Integer; +begin + if Column = -1 then + Exit; + if TextType <> ttNormal then + Exit; + ResultCol := Column - 1; + if ResultCol < 0 then begin + CellText := (Node.Index +1).ToString; + Exit; + end; + + EditingAndFocused := Sender.IsEditing and (Node = Sender.FocusedNode) and (Column = Sender.FocusedColumn); + Results := GridResult(Sender); + if (Results = nil) or (not Results.Connection.Active) then begin + EnableDataTab(False); + Exit; + end; + // Happens in some crashes, see issue #2462 + if ResultCol >= Results.ColumnCount then + Exit; + + RowNumber := Sender.GetNodeData(Node); + Results.RecNo := RowNumber^; + if Results.IsNull(ResultCol) and (not EditingAndFocused) then + CellText := TEXT_NULL + else begin + case Results.DataType(ResultCol).Category of + dtcInteger, dtcReal: begin + // This is a bit crappy... + // UNIX timestamps get *copied* as integers, but *displayed* and *edited* as date/time values. + // Normal integers are *copied* and *edited* as raw numbers, but probably *displayed* as formatted numbers. + if FGridCopying then begin + CellText := Results.Col(ResultCol); + end else if HandleUnixTimestampColumn(Sender, Column) then begin + try + Timestamp := Trunc(StrToFloat(Results.Col(ResultCol), FFormatSettings)); + Dec(Timestamp, FTimeZoneOffset); + CellText := DateTimeToStr(UnixToDateTime(Timestamp)); + except + // EConvertError in StrToFloat or EInvalidOp in Trunc or... + on E:Exception do begin + CellText := Results.Col(ResultCol); + LogSQL('Error when calculating Unix timestamp from "'+CellText+'": '+E.Message, lcError); + end; + end; + end else begin + CellText := Results.Col(ResultCol); + + // Keep only wanted number of trailing zeros after decimal separator + // Bug fixed: Do not cut trailing zeros in scientific values like 2.0e30 => 2.0e3 + if (Results.DataType(ResultCol).Category = dtcReal) and (AppSettings.ReadInt(asRealTrailingZeros) >= 0) then begin + DotPos := Pos('.', CellText); + IsScientific := ContainsText(CellText, 'e'); + if (not IsScientific) and (DotPos > 0) then begin + NumZeros := 0; + NumDecimals := 0; + for i:=DotPos+1 to Length(CellText) do begin + Inc(NumDecimals); + if CellText[i] = '0' then + Inc(NumZeros) + else + NumZeros := 0; + end; + KeepDecimals := Max(NumDecimals - NumZeros, AppSettings.ReadInt(asRealTrailingZeros)); + CellText := Copy(CellText, 1, Length(CellText) - (NumDecimals - KeepDecimals)); + if CellText[Length(CellText)] = '.' then + CellText := Copy(CellText, 1, Length(CellText)-1); + end; + end; + + if DataLocalNumberFormat and (not EditingAndFocused) then + CellText := FormatNumber(CellText, True); + end; + end; + dtcBinary, dtcSpatial: begin + if actBlobAsText.Checked then + CellText := Results.Col(ResultCol) + else + CellText := Results.HexValue(ResultCol, False); + end; + else begin + CellText := Results.Col(ResultCol); + if (Length(CellText) = GRIDMAXDATA) and (not Results.HasFullData) and (Sender = DataGrid) then + CellText := CellText + ' [...]'; + end; + end; + end; +end;} + + +{procedure TMainForm.CalcNullColors; +var + dtc: TDBDatatypeCategoryIndex; + h, l, s: Word; +begin + for dtc:=Low(DatatypeCategories) to High(DatatypeCategories) do begin + ColorRGBToHLS(DatatypeCategories[dtc].Color, h, l, s); + Inc(l, COLORSHIFT_NULLFIELDS); + s := Max(0, s-2*COLORSHIFT_NULLFIELDS); + DatatypeCategories[dtc].NullColor := ColorHLSToRGB(h, l, s); + end; +end;} + + +{** + Cell in data- or query grid gets painted. Colorize font. This procedure is + called extremely often for repainting the grid cells. Keep it highly optimized. +} +{procedure TMainForm.AnyGridPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); +var + cl: TColor; + r: TDBQuery; + RowNumber: PInt64; + ResultCol: Integer; +begin + if Column = NoColumn then + Exit; + ResultCol := Column - 1; + if ResultCol < 0 then begin + TargetCanvas.Font.Color := clGrayText; + //TargetCanvas.Font.Style := [TFontStyle.fsItalic]; + Exit; + end; + + r := GridResult(Sender); + RowNumber := Sender.GetNodeData(Node); + r.RecNo := RowNumber^; + + // Make primary key columns bold + if r.ColIsPrimaryKeyPart(ResultCol) then + TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]; + + // Do not apply any color on a selected, highlighted cell to keep readability + if (vsSelected in Node.States) and (Node = Sender.FocusedNode) and (Column = Sender.FocusedColumn) then + cl := GetThemeColor(clHighlightText) + else if r.IsNull(ResultCol) then + cl := DatatypeCategories[r.DataType(ResultCol).Category].NullColor + else + cl := DatatypeCategories[r.DataType(ResultCol).Category].Color; + TargetCanvas.Font.Color := cl; +end;} + + +{procedure TMainForm.AnyGridAfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); +var + Results: TDBQuery; + RowNum: PInt64; + ResultCol: Integer; +begin + // Don't waist time + if Column = NoColumn then + Exit; + ResultCol := Column - 1; + if ResultCol < 0 then + Exit; + // Paint a red triangle at the top left corner of the cell + Results := GridResult(Sender); + RowNum := Sender.GetNodeData(Node); + Results.RecNo := RowNum^; + if Results.Modified(ResultCol) then + VirtualImageListMain.Draw(TargetCanvas, CellRect.Left, CellRect.Top, 111); +end;} + + +{** + Header column in datagrid clicked. + Left button: handle ORDER BY + Right button: show column selection box +} +{procedure TMainForm.DataGridHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); +var + frm: TForm; + ColName: String; + SortItem: TSortItem; + SortOrder: TSortItemOrder; +begin + if HitInfo.Column = NoColumn then + Exit; + if HitInfo.Button = mbLeft then begin + // Header click disabled + if not AppSettings.ReadBool(asColumnHeaderClick) then + Exit; + ColName := Sender.Columns[HitInfo.Column].Text; + // Add a new order column after a columns title has been clicked + // Check if order column is already existant + SortItem := FDataGridSortItems.FindByColumn(ColName); + if Assigned(SortItem) then begin + // AddOrderCol is already in the list. Switch its direction: + // ASC > DESC > [delete col] + if SortItem.Order = sioAscending then + SortItem.Order := sioDescending + else + FDataGridSortItems.Remove(SortItem); + end + else begin + if KeyPressed(VK_SHIFT) then + SortOrder := sioDescending + else + SortOrder := sioAscending; + FDataGridSortItems.AddNew(ColName, SortOrder); + LogSQL('Created sorting for column '+ColName+'/'+Integer(SortOrder).ToString+' in TMainForm.DataGridHeaderClick', lcDebug); + end; + + // Refresh grid, and remember X scroll offset, so the just clicked column is still at the same place. + FDataGridLastClickedColumnHeader := HitInfo.Column; + FDataGridLastClickedColumnLeftPos := Sender.Columns[HitInfo.Column].Left; + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); + + end else begin + frm := TfrmColumnSelection.Create(Self); + // Position new form relative to btn's position + frm.Top := HitInfo.Y + DataGrid.ClientOrigin.Y - Integer(DataGrid.Header.Height); + frm.Left := HitInfo.X + DataGrid.ClientOrigin.X; + // Display form + frm.Show; + end; +end;} + + +{procedure TMainForm.actDataSetNullExecute(Sender: TObject); +var + RowNum: PInt64; + Grid: TVirtualStringTree; + Results: TDBQuery; +begin + // Set cell to NULL value + Grid := ActiveGrid; + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results := GridResult(Grid); + Results.RecNo := RowNum^; + try + Results.SetCol(Grid.FocusedColumn-1, '', True, False); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + Grid.RepaintNode(Grid.FocusedNode); + ValidateControls(Sender); +end;} + + +{procedure TMainForm.AnyGridMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint; var Handled: Boolean); +var + VT: TVirtualStringTree; + Node: PVirtualNode; + NewFontSize: Integer; +begin + VT := Sender as TVirtualStringTree; + if ssAlt in Shift then begin + // Advance to next or previous grid node on Shift+MouseWheel + if Assigned(VT.FocusedNode) then begin + if WheelDelta > 0 then + Node := VT.FocusedNode.PrevSibling + else + Node := VT.FocusedNode.NextSibling; + if Assigned(Node) then begin + SelectNode(VT, Node); + Handled := True; + end; + end; + end else if KeyPressed(VK_CONTROL) then begin + // Change font size with MouseWheel + if AppSettings.ReadBool(asWheelZoom) then begin + NewFontSize := VT.Font.Size; + if WheelDelta > 0 then + Inc(NewFontSize) + else + Dec(NewFontSize); + NewFontSize := Max(NewFontSize, 1); + AppSettings.ResetPath; + AppSettings.WriteInt(asDataFontSize, NewFontSize); + ApplyFontToGrids; + end; + end else if ssShift in Shift then begin + // Horizontal scrolling with Alt+Mousewheel + VT.OffsetX := VT.OffsetX + WheelDelta; + Handled := True; + end; +end;} + + +{** + Content of a grid cell was modified +} +{procedure TMainForm.AnyGridNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: String); +var + Results: TDBQuery; + RowNum: PInt64; + Timestamp: Int64; + IsNull: Boolean; + ResultCol: Integer; +begin + Results := GridResult(Sender); + if not Results.IsEditable then + Exit; + ResultCol := Column - 1; + RowNum := Sender.GetNodeData(Node); + Results.RecNo := RowNum^; + try + if (not FGridEditFunctionMode) and (Results.DataType(ResultCol).Category in [dtcInteger, dtcReal]) then begin + if HandleUnixTimestampColumn(Sender, Column) then begin + Timestamp := DateTimeToUnix(StrToDateTime(NewText)); + Inc(Timestamp, FTimeZoneOffset); + NewText := IntToStr(Timestamp) + end else + NewText := NewText; + end; + FClipboardHasNull := FClipboardHasNull and (Clipboard.TryAsText = ''); + IsNull := FGridPasting and FClipboardHasNull; + Results.SetCol(ResultCol, NewText, IsNull, FGridEditFunctionMode); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + FGridEditFunctionMode := False; + ValidateControls(Sender); +end;} + + +{** + DataGrid: node and/or column focus is about to change. See if we allow that. +} +{procedure TMainForm.AnyGridFocusChanging(Sender: TBaseVirtualTree; OldNode, + NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: + Boolean); +var + Results: TDBQuery; + RowNum: PInt64; +begin + // Detect changed focus and update row + Allowed := True; + Results := GridResult(Sender); + if Assigned(OldNode) and (OldNode <> NewNode) then begin + RowNum := Sender.GetNodeData(OldNode); + Results.RecNo := RowNum^; + if Results.Modified then begin + Allowed := Results.SaveModifications; + DisplayRowCountStats(Sender); + end else if Results.Inserted then begin + if NewNode <> nil then begin + Results.DiscardModifications; + Sender.DeleteNode(OldNode); + end else begin + Allowed := False; + end; + end; + end; +end;} + + +{procedure TMainForm.AnyGridFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex); +begin + ValidateControls(Sender); + if Assigned(Node) and pnlPreview.Visible then + UpdatePreviewPanel; + // Vtree does not focus cell after tab pressing. See issue #3139. + // Most probably a missing thing / bug in TBaseVirtualTree.SetFocusedNodeAndColumn + Sender.ScrollIntoView(Sender.FocusedNode, False, True); + // Required for highlighting fields with same text + Sender.Invalidate; +end;} + + +{procedure TMainForm.AnyGridChange(Sender: TBaseVirtualTree; Node: PVirtualNode); +begin + // Ensure "delete row" button state is valid, see issue #624 + ValidateControls(Sender); + UpdateLineCharPanel; +end;} + + +{procedure TMainForm.AnyGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +var + g: TVirtualStringTree; +begin + g := TVirtualStringTree(Sender); + case Key of + VK_HOME: begin + g.FocusedColumn := g.Header.Columns.GetFirstVisibleColumn(True); + if ssCtrl in Shift then begin + // VT itself focuses the first node since v7.0 + end else + Key := 0; + end; + VK_END: begin + g.FocusedColumn := g.Header.Columns.GetLastVisibleColumn(True); + if ssCtrl in Shift then begin + if g = DataGrid then + actDataShowAll.Execute; + // VT itself focuses the last node since v7.0 + end else begin + Key := 0; + end; + end; + VK_RETURN: if Assigned(g.FocusedNode) then g.EditNode(g.FocusedNode, g.FocusedColumn); + VK_DOWN: if g.FocusedNode = g.GetLast then actDataInsertExecute(actDataInsert); + VK_NEXT: if (g = DataGrid) and (g.FocusedNode = g.GetLast) then actDataShowNext.Execute; + end; +end;} + + +{procedure TMainForm.AnyGridEditing(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); +begin + Allowed := False; + try + if not AnyGridEnsureFullRow(Sender as TVirtualStringTree, Node) then + ErrorDialog(_('Could not load full row data.')) + else begin + Allowed := True; + // Move Esc shortcut from "Cancel row editing" to "Cancel cell editing" + actDataCancelChanges.ShortCut := 0; + actDataPostChanges.ShortCut := 0; + end; + except on E:EDbError do + ErrorDialog(_('Grid editing error'), E.Message); + end; +end;} + +{procedure TMainForm.AnyGridEdited(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex); +begin + // Reassign Esc to "Cancel row editing" action + if ([tsEditing, tsEditPending] * Sender.TreeStates) = [] then begin + actDataCancelChanges.ShortCut := TextToShortcut('Esc'); + actDataPostChanges.ShortCut := TextToShortcut('Ctrl+Enter'); + end; +end;} + +{procedure TMainForm.AnyGridEditCancelled(Sender: TBaseVirtualTree; Column: + TColumnIndex); +begin + // Reassign Esc to "Cancel row editing" action + actDataCancelChanges.ShortCut := TextToShortcut('Esc'); + actDataPostChanges.ShortCut := TextToShortcut('Ctrl+Enter'); +end;} + +{procedure TMainForm.AnyGridCreateEditor(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); +const + ForeignItemsLimit: Integer = 10000; +var + VT: TVirtualStringTree; + HexEditor: THexEditorLink; + DateTimeEditor: TDateTimeEditorLink; + EnumEditor: TEnumEditorLink; + SetEditor: TSetEditorLink; + InplaceEditor: TInplaceEditorLink; + TypeCat: TDBDatatypeCategoryIndex; + ForeignKey: TForeignKey; + TblColumn: TTableColumn; + idx, MicroSecondsPrecision: Integer; + KeyCol, TextCol, SQL, NowText: String; + Columns: TTableColumnList; + ForeignResults, Results: TDBQuery; + Conn: TDBConnection; + RowNum: PInt64; + RefObj: TDBObject; + AllowEdit, DisplayHex: Boolean; + SQLFunc: TSQLFunction; + ResultCol: Integer; +begin + VT := Sender as TVirtualStringTree; + Results := GridResult(VT); + RowNum := VT.GetNodeData(Node); + Results.RecNo := RowNum^; + ResultCol := Column - 1; + Conn := Results.Connection; + // Allow editing, or leave readonly mode + AllowEdit := Results.IsEditable; + TblColumn := Results.ColAttributes(ResultCol); + + // Find foreign key values + if AppSettings.ReadBool(asForeignDropDown) and (Sender = DataGrid) then begin + for ForeignKey in SelectedTableForeignKeys do begin + idx := ForeignKey.Columns.IndexOf(DataGrid.Header.Columns[Column].Text); + if idx > -1 then try + // Find the first text column if available and use that for displaying in the pulldown instead of using meaningless id numbers + RefObj := ForeignKey.ReferenceTableObj; + if not Assigned(RefObj) then + Continue; + + TextCol := ''; + Columns := RefObj.TableColumns; + for TblColumn in Columns do begin + if (TblColumn.DataType.Category = dtcText) and (TblColumn.Name <> ForeignKey.ForeignColumns[idx]) then begin + TextCol := TblColumn.Name; + break; + end; + end; + + KeyCol := Conn.QuoteIdent(ForeignKey.ForeignColumns[idx]); + if TextCol <> '' then begin + SQL := KeyCol+', ' + Conn.GetSQLSpecifity(spFuncLeft, [Conn.QuoteIdent(TextCol), 256])+ + ' FROM ' + RefObj.QuotedDbAndTableName + + ' GROUP BY '+KeyCol+', '+Conn.QuoteIdent(TextCol)+ // MSSQL complains if the text columns is not grouped + ' ORDER BY '+Conn.QuoteIdent(TextCol); + end else begin + SQL := KeyCol+ + ' FROM ' + RefObj.QuotedDbAndTableName + + ' GROUP BY '+KeyCol+ + ' ORDER BY '+KeyCol; + end; + SQL := Conn.ApplyLimitClause('SELECT', SQL, ForeignItemsLimit, 0); + + ForeignResults := Conn.GetResults(SQL); + if ForeignResults.RecordCount < ForeignItemsLimit then begin + EnumEditor := TEnumEditorLink.Create(VT, AllowEdit, TblColumn); + EditLink := EnumEditor; + DisplayHex := (not actBlobAsText.Checked) and (ForeignResults.DataType(0).Category in [dtcBinary, dtcSpatial]); + while not ForeignResults.Eof do begin + if DisplayHex then + EnumEditor.ValueList.Add(ForeignResults.HexValue(0)) + else + EnumEditor.ValueList.Add(ForeignResults.Col(0)); + if TextCol <> '' then begin + if DisplayHex then + EnumEditor.DisplayList.Add(ForeignResults.HexValue(0)+': '+ForeignResults.Col(1)) + else + EnumEditor.DisplayList.Add(ForeignResults.Col(0)+': '+ForeignResults.Col(1)); + end; + ForeignResults.Next; + end; + end else begin + LogSQL(f_('Connected table has too many rows. Foreign key drop-down is limited to %d items.', [ForeignItemsLimit]), lcInfo); + end; + ForeignResults.Free; + break; + except on E:EDbError do + // Error gets logged, do nothing more here. All other exception types raise please. + end; + end; + end; + + FGridEditFunctionMode := FGridEditFunctionMode or Results.IsFunction(ResultCol); + if FGridEditFunctionMode then begin + EnumEditor := TEnumEditorLink.Create(VT, AllowEdit, TblColumn); + for SQLFunc in Conn.SQLFunctions do + EnumEditor.ValueList.Add(SQLFunc.Name + SQLFunc.Declaration); + EnumEditor.AllowCustomText := True; + EditLink := EnumEditor; + end; + + TypeCat := Results.DataType(ResultCol).Category; + + if Assigned(EditLink) then + // Editor was created above, do nothing now + else if (Results.DataType(ResultCol).Index in [dbdtEnum, dbdtBool]) and AppSettings.ReadBool(asFieldEditorEnum) then begin + EnumEditor := TEnumEditorLink.Create(VT, AllowEdit, TblColumn); + EnumEditor.ValueList := Results.ValueList(ResultCol); + EditLink := EnumEditor; + end else if (TypeCat = dtcText) or ((TypeCat in [dtcBinary, dtcSpatial]) and actBlobAsText.Checked) then begin + InplaceEditor := TInplaceEditorLink.Create(VT, AllowEdit, TblColumn); + InplaceEditor.MaxLength := Results.MaxLength(ResultCol); + InplaceEditor.TitleText := Results.ColumnOrgNames[ResultCol]; + InplaceEditor.ButtonVisible := True; + EditLink := InplaceEditor; + end else if (TypeCat in [dtcBinary, dtcSpatial]) and AppSettings.ReadBool(asFieldEditorBinary) then begin + HexEditor := THexEditorLink.Create(VT, AllowEdit, TblColumn); + HexEditor.MaxLength := Results.MaxLength(ResultCol); + HexEditor.TitleText := Results.ColumnOrgNames[ResultCol]; + EditLink := HexEditor; + end else if (TypeCat = dtcTemporal) + and AppSettings.ReadBool(asFieldEditorDatetime) + and Assigned(TblColumn) // Editor crashes without a column object (on joins), see #1024 + then begin + // Ensure date/time editor starts with a non-empty text value + if (Results.Col(ResultCol) = '') and AppSettings.ReadBool(asFieldEditorDatetimePrefill) then begin + case Results.DataType(ResultCol).Index of + dbdtDate: NowText := DateToStr(Now); + dbdtTime: NowText := TimeToStr(Now); + // Add this case to prevent error with datatype year and sql_mode STRICT_TRANS_TABLES + // who absolutly want year and not date time + // http://www.heidisql.com/forum.php?t=14728 + dbdtYear: NowText := FormatDateTime('yyyy',Now); + else NowText := DateTimeToStr(Now); + end; + MicroSecondsPrecision := MakeInt(Results.ColAttributes(ResultCol).LengthSet); + // Don't generate MicroSecond when DataType is Year + if (MicroSecondsPrecision > 0) and (Results.DataType(ResultCol).Index <> dbdtYear ) then + NowText := NowText + '.' + StringOfChar('0', MicroSecondsPrecision); + VT.Text[Node, Column] := NowText; + end; + DateTimeEditor := TDateTimeEditorLink.Create(VT, AllowEdit, TblColumn); + EditLink := DateTimeEditor; + end else if AppSettings.ReadBool(asFieldEditorDatetime) + and HandleUnixTimestampColumn(Sender, Column) + and Assigned(TblColumn) // see above + then begin + DateTimeEditor := TDateTimeEditorLink.Create(VT, AllowEdit, TblColumn); + EditLink := DateTimeEditor; + end else if (Results.DataType(ResultCol).Index = dbdtSet) and AppSettings.ReadBool(asFieldEditorSet) then begin + SetEditor := TSetEditorLink.Create(VT, AllowEdit, TblColumn); + SetEditor.ValueList := Results.ValueList(ResultCol); + EditLink := SetEditor; + end else begin + InplaceEditor := TInplaceEditorLink.Create(VT, AllowEdit, TblColumn); + InplaceEditor.ButtonVisible := False; + EditLink := InplaceEditor; + end; + Sender.FocusedNode := Node; + Sender.FocusedColumn := Column; +end;} + + +{procedure TMainForm.menuShowSizeColumnClick(Sender: TObject); +var + Item: TMenuItem; +begin + if coVisible in DBtree.Header.Columns[1].Options then + DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options - [coVisible] + else + DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options + [coVisible]; + Item := Sender as TMenuItem; + Item.Checked := coVisible in DBtree.Header.Columns[1].Options; + AppSettings.ResetPath; + AppSettings.WriteBool(asDisplayObjectSizeColumn, Item.Checked); +end;} + + +{procedure TMainForm.menuAlwaysGenerateFilterClick(Sender: TObject); +begin + // Store setting for toggled filter generation + AppSettings.WriteBool(asAlwaysGenerateFilter, menuAlwaysGenerateFilter.Checked); +end;} + +{procedure TMainForm.menuAutoExpandClick(Sender: TObject); +var + Item: TMenuItem; +begin + // Activate expand on click tree feature + if toAutoExpand in DBtree.TreeOptions.AutoOptions then + DBtree.TreeOptions.AutoOptions := DBtree.TreeOptions.AutoOptions - [toAutoExpand] + else + DBtree.TreeOptions.AutoOptions := DBtree.TreeOptions.AutoOptions + [toAutoExpand]; + Item := Sender as TMenuItem; + Item.Checked := toAutoExpand in DBtree.TreeOptions.AutoOptions; + AppSettings.ResetPath; + AppSettings.WriteBool(asAutoExpand, Item.Checked); +end;} + + +{procedure TMainForm.actGroupObjectsExecute(Sender: TObject); +begin + // Group tree objects by type + RefreshTree(nil); +end;} + + +{procedure TMainForm.AutoCalcColWidth(Tree: TVirtualStringTree; Column: TColumnIndex); +var + Node: PVirtualNode; + i, ColTextWidth, ContentTextWidth: Integer; + Rect: TRect; + Col: TVirtualTreeColumn; +begin + // Find optimal default width for columns. Needs to be done late, after the SQL + // composing to enable text width calculation based on actual table content + // Weird: Fixes first time calculation always based on Tahoma/8pt font + Tree.Canvas.Font := Tree.Font; + Col := Tree.Header.Columns[Column]; + if not (coVisible in Col.Options) then + Exit; + ColTextWidth := Tree.Canvas.TextWidth(Col.Text); + // Add space for sort glyph + if Col.ImageIndex > -1 then + ColTextWidth := ColTextWidth + 20; + Node := Tree.GetFirstVisible; + // Go backwards 50 nodes from focused one if tree was scrolled + i := 0; + if Assigned(Tree.FocusedNode) then begin + Node := Tree.FocusedNode; + while Assigned(Node) do begin + inc(i); + if (Node = Tree.GetFirst) or (i > 50) then + break; + Node := Tree.GetPreviousVisible(Node); + end; + end; + i := 0; + while Assigned(Node) do begin + // Note: this causes the node to load, an exception can propagate + // here if the query or connection dies. + Rect := Tree.GetDisplayRect(Node, Column, True, True); + ContentTextWidth := Rect.Right - Rect.Left; + //if vsMultiLine in Node.States then + // ContentTextWidth := Max(ContentTextWidth, Tree.Canvas.TextWidth(Tree.Text[Node, Column])); + ColTextWidth := Max(ColTextWidth, ContentTextWidth); + inc(i); + if i > 100 then break; + // GetDisplayRect may have implicitely taken the node away. + // Strange that Node keeps being assigned though, probably a timing issue. + if Tree.RootNodeCount = 0 then break; + Node := Tree.GetNextVisible(Node); + end; + // text margins and minimal extra space + ColTextWidth := ColTextWidth + Tree.TextMargin*2 + 20; + ColTextWidth := Min(ColTextWidth, AppSettings.ReadInt(asMaxColWidth)); + Col.Width := ColTextWidth; +end;} + + +{procedure TMainForm.AnyGridBeforeCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); +var + r: TDBQuery; + cl, clNull, clSameData: TColor; + RowNumber: PInt64; + FocusedIsNull, CurrentIsNull: Boolean; + FieldText, FocusedFieldText: String; + VT: TVirtualStringTree; + ResultCol: Integer; +begin + if Column = -1 then + Exit; + ResultCol := Column -1; + + r := GridResult(Sender); + if (r=nil) or (not r.Connection.Active) then begin + // This event (BeforeCellPaint) is the very first one to notice a broken connection + Sender.Enabled := False; + Exit; + end; + + if ResultCol < 0 then begin + if r.Connection.Parameters.SessionColor <> AppSettings.GetDefaultInt(asTreeBackground) then + TargetCanvas.Brush.Color := r.Connection.Parameters.SessionColor + else + TargetCanvas.Brush.Color := clBtnFace; + TargetCanvas.FillRect(CellRect); + Exit; + end; + + VT := Sender as TVirtualStringTree; + RowNumber := Sender.GetNodeData(Node); + r.RecNo := RowNumber^; + + cl := GetAlternatingRowBackground(Node); + + if (vsSelected in Node.States) and (Node = Sender.FocusedNode) and (Column = Sender.FocusedColumn) then begin + // Focused cell + cl := GetThemeColor(clHighlight) + end else if vsSelected in Node.States then begin + // Selected but not focused cell + if VT.Color > ColorAdjustBrightness(clWhite, -29) then + cl := ColorAdjustBrightness(VT.Color, -29) + else + cl := ColorAdjustBrightness(VT.Color, 29); + end else if r.IsNull(ResultCol) then begin + // Cell with NULL value + clNull := AppSettings.ReadInt(asFieldNullBackground); + if clNull <> clNone then + cl := clNull; + end; + if cl <> clNone then begin + TargetCanvas.Brush.Color := cl; + TargetCanvas.FillRect(CellRect); + end; + + // Probably display background color on fields with same text + // Result pointer gets moved to the focused node.. careful! + if (Sender.FocusedNode <> nil) and (Sender.FocusedColumn > 0) then begin + if ((Node <> Sender.FocusedNode) and (Column = Sender.FocusedColumn)) + or ((Node = Sender.FocusedNode) and (Column <> Sender.FocusedColumn)) then begin + clSameData := AppSettings.ReadInt(asHightlightSameTextBackground); + if clSameData <> clNone then begin + FieldText := r.Col(ResultCol); + CurrentIsNull := r.IsNull(ResultCol); + RowNumber := Sender.GetNodeData(Sender.FocusedNode); + r.RecNo := RowNumber^; // moving result cursor + FocusedFieldText := r.Col(Sender.FocusedColumn-1); + FocusedIsNull := r.IsNull(Sender.FocusedColumn-1); + if (CompareText(FieldText, FocusedFieldText) = 0) and (CurrentIsNull = FocusedIsNull) then begin + TargetCanvas.Brush.Color := clSameData; + TargetCanvas.FillRect(CellRect); + end; + end; + end; + end; + +end;} + + +{procedure TMainForm.HandleDataGridAttributes(RefreshingData: Boolean); +var + rx: TRegExpr; + i: Integer; + Sort, KeyName, FocusedCol, CellFocus, Filter: String; + SortItem: TSortItem; +begin + actDataResetSorting.Enabled := False; + // Clear filter, column names and sort structure if gr + if not Assigned(DataGridHiddenColumns) then begin + DataGridHiddenColumns := TStringList.Create; + DataGridHiddenColumns.Delimiter := DELIM; + DataGridHiddenColumns.StrictDelimiter := True; + end; + if not Assigned(DataGridFocusedCell) then + DataGridFocusedCell := TStringList.Create; + // Remember focused node and column for selected table + if Assigned(DataGrid.FocusedNode) + and (ActiveConnection <> nil) + and (DataGridTable <> nil) + and Assigned(DataGridTable) + then begin + try + KeyName := DataGridTable.QuotedDatabase+'.'+DataGridTable.QuotedName; + FocusedCol := ''; + if DataGrid.FocusedColumn > NoColumn then + FocusedCol := DataGrid.Header.Columns[DataGrid.FocusedColumn].Text; + DataGridFocusedCell.Values[KeyName] := IntToStr(DataGrid.FocusedNode.Index) + DELIM + FocusedCol; + except + on E:EAccessViolation do begin + LogSQL('HandleDataGridAttributes: '+E.Message, lcError); + end; + end; + end; + DataGridFocusedNodeIndex := 0; + DataGridFocusedColumnName := ''; + KeyName := ActiveDbObj.QuotedDatabase+'.'+ActiveDbObj.QuotedName; + CellFocus := DataGridFocusedCell.Values[KeyName]; + if CellFocus <> '' then begin + DataGridFocusedNodeIndex := MakeInt(Explode(DELIM, CellFocus)[0]); + DataGridFocusedColumnName := Explode(DELIM, CellFocus)[1]; + end; + if not RefreshingData then begin + DataGridHiddenColumns.Clear; + SynMemoFilter.Clear; + FDataGridSortItems.Clear; + DataGridWantedRowCount := 0; + while DataGridFocusedNodeIndex >= DataGridWantedRowCount do + Inc(DataGridWantedRowCount, AppSettings.ReadInt(asDatagridRowsPerStep)); + end else begin + // Save current attributes if grid gets refreshed + AppSettings.SessionPath := GetRegKeyTable; + if DataGridHiddenColumns.Count > 0 then + AppSettings.WriteString(asHiddenColumns, DataGridHiddenColumns.DelimitedText) + else if AppSettings.ValueExists(asHiddenColumns) then + AppSettings.DeleteValue(asHiddenColumns); + + if SynMemoFilter.GetTextLen > 0 then + AppSettings.WriteString(asFilter, SynMemoFilter.Text) + else if AppSettings.ValueExists(asFilter) then + AppSettings.DeleteValue(asFilter); + + Sort := ''; + for SortItem in FDataGridSortItems do begin + Sort := Sort + IntToStr(Integer(SortItem.Order)) + '_' + SortItem.Column + DELIM; + end; + if Sort <> '' then + AppSettings.WriteString(asSort, Sort) + else if AppSettings.ValueExists(asSort) then + AppSettings.DeleteValue(asSort); + end; + + // Auto remove registry spam if table folder is empty + if AppSettings.SessionPathExists(GetRegKeyTable) then begin + AppSettings.SessionPath := GetRegKeyTable; + if AppSettings.IsEmptyKey then + AppSettings.DeleteCurrentKey; + end; + + // Do nothing if table was not filtered yet + if not AppSettings.SessionPathExists(GetRegKeyTable) then + Exit; + + // Columns + if AppSettings.ValueExists(asHiddenColumns) then + DataGridHiddenColumns.DelimitedText := AppSettings.ReadString(asHiddenColumns); + + // Set filter, without changing cursor position + if AppSettings.ValueExists(asFilter) then begin + Filter := AppSettings.ReadString(asFilter); + if SynMemoFilter.Text <> Filter then begin + SynMemoFilter.Text := Filter; + SynMemoFilter.Modified := True; + end; + if SynMemoFilter.GetTextLen > 0 then + ToggleFilterPanel(True); + end; + + // Sort + if AppSettings.ValueExists(asSort) then begin + FDataGridSortItems.Clear; + rx := TRegExpr.Create; + rx.Expression := '\b(\d)_(.+)\'+DELIM; + rx.ModifierG := False; + if rx.Exec(AppSettings.ReadString(asSort)) then while true do begin + // Check if column exists, could be renamed or deleted + for i:=0 to SelectedTableColumns.Count-1 do begin + if SelectedTableColumns[i].Name = rx.Match[2] then begin + SortItem := FDataGridSortItems.AddNew; + SortItem.Column := rx.Match[2]; + SortItem.Order := TSortItemOrder(StrToIntDef(rx.Match[1], 0)); + LogSQL('Restored sorting for column '+SortItem.Column+'/'+Integer(SortItem.Order).ToString+' in TMainForm.HandleDataGridAttributes', lcDebug); + Break; + end; + end; + if not rx.ExecNext then + break; + end; + actDataResetSorting.Enabled := FDataGridSortItems.Count > 0; + end; + + AppSettings.ResetPath; +end;} + + +{function TMainForm.GetRegKeyTable: String; +begin + // Return the slightly complex registry path to \Servers\CustomFolder\ActiveServer\curdb|curtable + Result := ActiveDbObj.Connection.Parameters.SessionPath + '\' + + ActiveDatabase + DELIM + ActiveDbObj.Name; +end;} + + +{procedure TMainForm.AnyGridMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + Grid: TVirtualStringTree; + Hit: THitInfo; + Results: TDBQuery; +begin + // Detect mouse hit in grid whitespace and apply changes. + Grid := Sender as TVirtualStringTree; + if not Assigned(Grid.FocusedNode) then + Exit; + Grid.GetHitTestInfoAt(X, Y, False, Hit); + if (Hit.HitNode = nil) or (Hit.HitColumn = NoColumn) or (Hit.HitColumn = InvalidColumn) then begin + Results := GridResult(Grid); + if Results.Modified then begin + Results.SaveModifications; + DisplayRowCountStats(Grid); + end; + end; +end;} + + +{procedure TMainForm.ListDatabasesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); +var + vt: TVirtualStringTree; + i: Integer; + Conn: TDBConnection; +begin + // Invalidate list of databases, before (re)painting + vt := Sender as TVirtualStringTree; + if vt.Tag = VTREE_LOADED then + Exit; + Conn := ActiveConnection; + Screen.Cursor := crHourglass; + vt.Clear; + if Conn <> nil then begin + if vt.Tag = VTREE_NOTLOADED_PURGECACHE then begin + for i:=0 to Conn.AllDatabases.Count-1 do begin + if Conn.DbObjectsCached(Conn.AllDatabases[i]) then begin + if Conn.AllDatabases[i] = ActiveDatabase then + RefreshTree + else + Conn.GetDBObjects(Conn.AllDatabases[i], True); + end; + end; + end; + vt.RootNodeCount := Conn.AllDatabases.Count; + end; + tabDatabases.Caption := _('Databases') + ' ('+FormatNumber(vt.RootNodeCount)+')'; + vt.Tag := VTREE_LOADED; + Screen.Cursor := crDefault; +end;} + + +{procedure TMainForm.ListDatabasesDblClick(Sender: TObject); +begin + // Select database on doubleclick + // TODO: Have DBObjects bound to ListDatabases, so we can sort nodes without breaking references + if Assigned(ListDatabases.FocusedNode) then + SetActiveDatabase(ListDatabases.Text[ListDatabases.FocusedNode, 0], ActiveConnection); +end;} + + +{procedure TMainForm.ListDatabasesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); +var + db: String; + Conn: TDBConnection; +begin + // Return icon index for databases. Ghosted if db objects not yet in cache. + if Column <> (Sender as TVirtualStringTree).Header.MainColumn then + Exit; + Conn := ActiveConnection; + db := ListDatabases.Text[Node, 0]; + case Kind of + ikNormal, ikSelected: ImageIndex := ICONINDEX_DB; + ikOverlay: if db = Conn.Database then ImageIndex := ICONINDEX_HIGHLIGHTMARKER; + end; + Ghosted := not Conn.DbObjectsCached(db); +end;} + + +{procedure TMainForm.ListDatabasesGetNodeDataSize(Sender: TBaseVirtualTree; + var NodeDataSize: Integer); +begin + // Tell VirtualTree we're using a simple integer as data + NodeDataSize := SizeOf(Int64); +end;} + + +{procedure TMainForm.ListDatabasesInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); +var + Idx: PInt; +begin + // Integers mapped to the node's index so nodes can be sorted without losing their database name + Idx := Sender.GetNodeData(Node); + Idx^ := Node.Index; +end;} + + +{procedure TMainForm.ListDatabasesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +var + Idx: PInt; + Objects: TDBObjectList; + DBname: String; + Conn: TDBConnection; + + function GetItemCount(ItemType: TListNodeType): String; + var + c: Integer; + o: TDBObject; + begin + if Objects <> nil then begin + c := 0; + for o in Objects do begin + if (ItemType = lntNone) or (o.NodeType = ItemType) then + Inc(c); + end; + Result := FormatNumber(c); + end else + Result := ''; + end; + +begin + // Return text for database columns + Idx := Sender.GetNodeData(Node); + + Conn := ActiveConnection; + if Idx^ < Conn.AllDatabases.Count then begin + DBname := Conn.AllDatabases[Idx^]; + end else begin + // Probably a database were dropped shortly before. + DBname := ''; + end; + if Conn.DbObjectsCached(DBname) then + Objects := Conn.GetDBObjects(DBname) + else + Objects := nil; + CellText := ''; + case Column of + 0: CellText := DBname; + 1: if Assigned(Objects) then CellText := FormatByteNumber(Objects.DataSize); + 2: CellText := GetItemCount(lntNone); + 3: if Assigned(Objects) and (Objects.LastUpdate > 0) then CellText := DateTimeToStr(Objects.LastUpdate); + 4: CellText := GetItemCount(lntTable); + 5: CellText := GetItemCount(lntView); + 6: CellText := GetItemCount(lntFunction); + 7: CellText := GetItemCount(lntProcedure); + 8: CellText := GetItemCount(lntTrigger); + 9: CellText := GetItemCount(lntEvent); + 10: if Assigned(Objects) then CellText := Objects.Collation; + end; + +end;} + + +{procedure TMainForm.HostListBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); +var + vt: TVirtualStringTree; + OldOffset: TPoint; + Conn: TDBConnection; + Tab: TTabSheet; + Results, Variables: TDBQuery; + i: Integer; + SelectedCaptions: TStringList; + IS_objects: TDBObjectList; + Obj: TDBObject; + ProcessColumns: TTableColumnList; + Columns, FocusedCaption, CleanTabCaption: String; + Col: TVirtualTreeColumn; + LeaveEnabled: Boolean; + ActiveNetType: String; +begin + // Display server variables + vt := Sender as TVirtualStringTree; + if vt.Tag = VTREE_LOADED then + Exit; + Tab := vt.Parent as TTabSheet; + Conn := ActiveConnection; + + // Status + command statistics only available in MySQL, most others also not available in SQLite + LeaveEnabled := False; + ActiveNetType := _('unknown'); + if Conn <> nil then begin + if vt = ListDatabases then + LeaveEnabled := True + else if vt = ListVariables then + LeaveEnabled := Conn.Parameters.NetTypeGroup in [ngMySQL, ngMSSQL, ngPgSQL] + else if vt = ListStatus then + LeaveEnabled := Conn.Parameters.NetTypeGroup in [ngMySQL] + else if vt = ListProcesses then + LeaveEnabled := Conn.Parameters.NetTypeGroup in [ngMySQL, ngMSSQL, ngPgSQL] + else if vt = ListCommandStats then + LeaveEnabled := Conn.Parameters.NetTypeGroup in [ngMySQL]; + ActiveNetType := Conn.Parameters.NetTypeName(False); + end; + if not LeaveEnabled then begin + vt.Clear; + vt.EmptyListMessage := f_('Not available on %s', [ActiveNetType]); + vt.Tag := VTREE_LOADED; + Exit; + end; + + SelectedCaptions := TStringList.Create; + GetVTSelection(vt, SelectedCaptions, FocusedCaption); + SelectNode(vt, nil); + vt.BeginUpdate; + OldOffset := vt.OffsetXY; + vt.Clear; + Screen.Cursor := crHourglass; + + if Conn <> nil then try + Results := GridResult(vt); + if Results <> nil then + FreeAndNil(Results); + if vt = ListVariables then begin + // Do not use FHostListResults on Variables tab, as we cannot query + // session and global variables in one query + Results := nil; + FreeAndNil(FVariableNames); + FreeAndNil(FSessionVars); + FreeAndNil(FGlobalVars); + FVariableNames := TStringList.Create; + FVariableNames.Duplicates := dupIgnore; + FVariableNames.Sorted := True; + FSessionVars := TStringList.Create; + FGlobalVars := TStringList.Create; + Variables := Conn.GetResults(Conn.GetSQLSpecifity(spSessionVariables)); + while not Variables.Eof do begin + FVariableNames.Add(Variables.Col(0)); + FSessionVars.Values[Variables.Col(0)] := Variables.Col(1); + Variables.Next; + end; + Variables.Free; + Variables := Conn.GetResults(Conn.GetSQLSpecifity(spGlobalVariables)); + while not Variables.Eof do begin + FVariableNames.Add(Variables.Col(0)); + FGlobalVars.Values[Variables.Col(0)] := Variables.Col(1); + Variables.Next; + end; + Variables.Free; + vt.RootNodeCount := FVariableNames.Count; + end else if vt = ListStatus then begin + Results := Conn.GetResults(Conn.GetSQLSpecifity(spGlobalStatus)); + FStatusServerUptime := Conn.ServerUptime; + end else if vt = ListProcesses then begin + case Conn.Parameters.NetTypeGroup of + ngMySQL: begin + if Conn.InformationSchemaObjects.IndexOf('PROCESSLIST') > -1 then begin + // Minimize network traffic on newer servers by fetching only first KB of SQL query in "Info" column + Columns := Conn.QuoteIdent('ID')+', '+ + Conn.QuoteIdent('USER')+', '+ + Conn.QuoteIdent('HOST')+', '+ + Conn.QuoteIdent('DB')+', '+ + Conn.QuoteIdent('COMMAND')+', '+ + Conn.QuoteIdent('TIME')+', '+ + Conn.QuoteIdent('STATE')+', '+ + 'LEFT('+Conn.QuoteIdent('INFO')+', '+IntToStr(SIZE_KB*50)+') AS '+Conn.QuoteIdent('Info'); + // Get additional column names into SELECT query and ListProcesses tree + IS_objects := Conn.GetDBObjects(Conn.InfSch); + for Obj in IS_objects do begin + if Obj.Name = 'PROCESSLIST' then begin + ProcessColumns := Obj.TableColumns; + for i:=8 to ProcessColumns.Count-1 do begin + Columns := Columns + ', '+Conn.QuoteIdent(ProcessColumns[i].Name); + if ListProcesses.Header.Columns.Count <= i then + Col := ListProcesses.Header.Columns.Add + else + Col := ListProcesses.Header.Columns[i]; + Col.Options := Col.Options + [coVisible]; + Col.Text := ProcessColumns[i].Name; + end; + // Hide unused tree columns + for i:=ListProcesses.Header.Columns.Count-1 downto ProcessColumns.Count do + ListProcesses.Header.Columns[i].Options := ListProcesses.Header.Columns[i].Options - [coVisible]; + ProcessColumns.Free; + break; + end; + end; + Results := Conn.GetResults('SELECT '+Columns+' FROM '+ + Conn.QuoteIdent(Conn.InfSch)+'.'+Conn.QuoteIdent('PROCESSLIST')); + end else begin + // Older servers fetch the whole query length, but at least we cut them off below, so a high memory usage is just a peak + Results := Conn.GetResults('SHOW FULL PROCESSLIST'); + end; + end; + ngMSSQL: begin + Results := Conn.GetResults('SELECT '+ + Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('spid')+ + ', RTRIM('+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('loginame')+') AS '+Conn.QuoteIdent('loginname')+ + ', RTRIM('+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('hostname')+') AS '+Conn.QuoteIdent('hostname')+ + ', '+Conn.QuoteIdent('d')+'.'+Conn.QuoteIdent('name')+ + ', '+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('cmd')+ + ', '+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('waittime')+ + ', RTRIM('+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('status')+'), '+ + 'NULL AS '+Conn.QuoteIdent('Info')+' '+ + 'FROM '+Conn.QuoteIdent('sys')+'.'+Conn.QuoteIdent('sysprocesses')+' AS '+Conn.QuoteIdent('p')+ + ', '+Conn.GetSQLSpecifity(spDatabaseTable)+' AS '+Conn.QuoteIdent('d')+ + ' WHERE '+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('dbid')+'='+Conn.QuoteIdent('d')+'.'+Conn.GetSQLSpecifity(spDatabaseTableId) + ); + end; + ngPgSQL: begin + Results := Conn.GetResults('SELECT '+ + Conn.QuoteIdent('pid')+ + ', '+Conn.QuoteIdent('usename')+ + ', '+Conn.QuoteIdent('client_addr')+ + ', '+Conn.QuoteIdent('datname')+ + ', application_name '+ + ', EXTRACT(EPOCH FROM CURRENT_TIMESTAMP - '+Conn.QuoteIdent('query_start')+')::INTEGER'+ + ', '+Conn.QuoteIdent('state')+ + ', '+Conn.QuoteIdent('query')+ + ' FROM '+Conn.QuoteIdent('pg_stat_activity') + ); + end; + else begin + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(Conn.Parameters.NetType)]); + end; + end; + FProcessListMaxTime := 1; + for i:=0 to Results.RecordCount-1 do begin + FProcessListMaxTime := Max(FProcessListMaxTime, MakeInt(Results.Col(5))); + Results.Next; + end; + end else if vt = ListCommandStats then begin + Results := Conn.GetResults(Conn.GetSQLSpecifity(spCommandsCounters)); + FCommandStatsServerUptime := Conn.ServerUptime; + FCommandStatsQueryCount := 0; + while not Results.Eof do begin + Inc(FCommandStatsQueryCount, MakeInt(Results.Col(1))); + Results.Next; + end; + end; + + FHostListResults[Tab.PageIndex] := Results; + if Results <> nil then + vt.RootNodeCount := Results.RecordCount; + vt.OffsetXY := OldOffset; + except + on E:Exception do ErrorDialog(E.Message); + end; + + Screen.Cursor := crDefault; + // Apply or reset filter + editFilterVTChange(Sender); + vt.EndUpdate; + vt.Tag := VTREE_LOADED; + // Display number of listed values on tab + CleanTabCaption := RegExprGetMatch('^([^\(]+)', Tab.Caption, 1); + Tab.Caption := CleanTabCaption.Trim + ' (' + IntToStr(vt.RootNodeCount) + ')'; + // Restore selection + SetVTSelection(vt, SelectedCaptions, FocusedCaption); +end;} + + +{procedure TMainForm.HostListBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + var ContentRect: TRect); +var + vt: TVirtualStringTree; + Val, Max: Extended; + LoopNode: PVirtualNode; + SessionVal, GlobalVal: String; +begin + PaintAlternatingRowBackground(TargetCanvas, Node, CellRect); + vt := Sender as TVirtualStringTree; + + if (Column in [1,2,4..9]) and (vt = ListDatabases) then begin + // Find out maximum value in column + LoopNode := vt.GetFirst; + Max := 1; + while Assigned(LoopNode) do begin + Val := MakeFloat(vt.Text[LoopNode, Column]); + if Val > Max then + Max := Val; + LoopNode := vt.GetNext(LoopNode); + end; + PaintColorBar(MakeFloat(vt.Text[Node, Column]), Max, TargetCanvas, CellRect); + end; + + // Highlight cell if session variable is different to global variable + if (Column = 1) and (vt = ListVariables) then begin + SessionVal := vt.Text[Node, 1]; + GlobalVal := vt.Text[Node, 2]; + if SessionVal <> GlobalVal then begin + TargetCanvas.Brush.Color := clWebBlanchedAlmond; + TargetCanvas.Pen.Color := TargetCanvas.Brush.Color; + TargetCanvas.Rectangle(CellRect); + end; + end; + + // Nothing special on Status tab + + if (Column = 5) and (vt = ListProcesses) then begin + PaintColorBar(MakeFloat(vt.Text[Node, Column]), FProcessListMaxTime, TargetCanvas, CellRect); + end; + + if (Column = 4) and (vt = ListCommandStats) then begin + // Only paint bar in percentage column + PaintColorBar(MakeFloat(vt.Text[Node, Column]), 100, TargetCanvas, CellRect); + end; +end;} + + +{procedure TMainForm.actFollowForeignKeyExecute(Sender: TObject); +var + Results: TDBQuery; + RowNum: PInt64; + FocusedColumnName, ForeignColumnName, ReferenceTable: String; + ForeignKey: TForeignKey; + i: Integer; + DBObj: TDBObject; + Datatype: TDBDatatype; + DbObjects: TDBObjectList; + Filter: String; + Conn: TDBConnection; +begin + Results := GridResult(DataGrid); + RowNum := DataGrid.GetNodeData(DataGrid.FocusedNode); + Results.RecNo := RowNum^; + FocusedColumnName := Results.ColumnOrgNames[DataGrid.FocusedColumn-1]; + Conn := Results.Connection; + + // find foreign key for current column + for ForeignKey in ActiveDBObj.TableForeignKeys do begin + i := ForeignKey.Columns.IndexOf(FocusedColumnName); + if i > -1 then begin + ForeignColumnName := ForeignKey.ForeignColumns[i]; + ReferenceTable := ForeignKey.ReferenceTable; + break; + end; + end; + if ForeignColumnName = '' then begin + LogSQL(f_('Foreign key not found for column "%s"', [FocusedColumnName]), lcInfo); + Exit; + end; + Datatype := Results.DataType(DataGrid.FocusedColumn-1); + // filter to show only rows linked by the foreign key + if DataType.Category in [dtcBinary, dtcSpatial] then + Filter := Conn.QuoteIdent(ForeignColumnName)+'='+Results.HexValue(DataGrid.FocusedColumn-1) + else + Filter := Conn.QuoteIdent(ForeignColumnName)+'='+Conn.EscapeString(Results.Col(DataGrid.FocusedColumn-1)); + + // Jumping to ReferenceTable. Caution, this invalidates the above used Results + DbObjects := Conn.GetDBObjects(ActiveDatabase); + for DBObj in DbObjects do begin + if DBObj.Database + '.' + DBObj.Name = ReferenceTable then begin + ActiveDBObj := DBObj; + Break; + end; + end; + + SynMemoFilter.Text := Filter; + ToggleFilterPanel(True); + actApplyFilter.Execute; + // SynMemoFilter will be cleared and set value of asFilter (in HandleDataGridAttributes from DataGridBeforePaint) + AppSettings.SessionPath := GetRegKeyTable; + AppSettings.WriteString(asFilter, Filter); +end;} + + +{procedure TMainForm.actCopyGridNodesExecute(Sender: TObject); +var + SenderControl: TComponent; + SenderName: String; + Grid: TVirtualStringTree; + Header, Body, Line, Data: String; + Separator, Encloser, Terminator: String; + Node: PVirtualNode; + Col: TColumnIndex; + Indent, NodesCopied: Integer; + IsFirstCol: Boolean; +begin + // Copy tree nodes as CSV, from any VirtualTree, not only from data or result grids + // See issue #2083 + SenderControl := PopupComponent(Sender); + if SenderControl=nil then + SenderControl := Screen.ActiveControl; + + if not (SenderControl is TVirtualStringTree) then begin + if SenderControl=nil then + SenderName := 'nil' + else + SenderName := SenderControl.Name; + ErrorDialog(f_('No listing or tree focused. ActiveControl is %s', [SenderName])); + Exit; + end; + + Screen.Cursor := crHourGlass; + Grid := TVirtualStringTree(SenderControl); + // Grid.CopyToClipboard; // Does nothing (?) + + Separator := #9; + Encloser := ''; + Terminator := SLineBreak; + + Header := ''; + Col := Grid.Header.Columns.GetFirstVisibleColumn(True); + IsFirstCol := True; + while Col > NoColumn do begin + Data := Grid.Header.Columns[Col].Text; + //Data := StringReplace(Data, Encloser, Encloser+Encloser, [rfReplaceAll]); + if not IsFirstCol then + Header := Header + Separator; + IsFirstCol := False; + //Header := Header + Encloser + Data + Encloser; + Header := Header + Data; + Col := Grid.Header.Columns.GetNextVisibleColumn(Col); + end; + Header := Header + Terminator; + + Body := ''; + NodesCopied := 0; + Node := Grid.GetFirstInitialized; + while Assigned(Node) do begin + if Grid.IsVisible[Node] then begin + IsFirstCol := True; + Line := ''; + + // One empty cell for each indentation level + for Indent := 1 to Grid.GetNodeLevel(Node) do begin + if not IsFirstCol then + Line := Line + Separator; + IsFirstCol := False; + //Line := Line + Encloser + Encloser; + end; + + // Add data cells + Col := Grid.Header.Columns.GetFirstVisibleColumn(True); + while Col > NoColumn do begin + Data := Grid.Text[Node, Col]; + //Data := StringReplace(Data, Encloser, Encloser+Encloser, [rfReplaceAll]); + if not IsFirstCol then + Line := Line + Separator; + IsFirstCol := False; + //Line := Line + Encloser + Data + Encloser; + Line := Line + Data; + Col := Grid.Header.Columns.GetNextVisibleColumn(Col); + end; + + Body := Body + Line + Terminator; + Inc(NodesCopied); + end; + Node := Grid.GetNextInitialized(Node); + end; + + Clipboard.TryAsText := Header + Body; + + Screen.Cursor := crDefault; + LogSQL(f_('%s: %s lines copied to clipboard', [SLogPrefixInfo, FormatNumber(NodesCopied)]), lcInfo); + MessageBeep(MB_ICONASTERISK); +end;} + +{procedure TMainForm.actCopyOrCutExecute(Sender: TObject); +var + CurrentControl: TWinControl; + SendingControl: TComponent; + SenderName, TextCopy: String; + Edit: TCustomEdit; + Combo: TCustomComboBox; + Grid: TVirtualStringTree; + SynMemo: TSynMemo; + DoCut, DoCopyRows: Boolean; + IsResultGrid, HasNulls: Boolean; + ClpFormat: Word; + ClpData: THandle; + APalette: HPalette; + Exporter: TSynExporterRTF; + Results: TDBQuery; + RowNum: PInt64; + ExportDialog: TfrmExportGrid; +begin + // Copy text from a focused control to clipboard + CurrentControl := Screen.ActiveControl; + SendingControl := TAction(Sender).ActionComponent; + SenderName := TAction(Sender).Name; + DoCut := Sender = actCut; + DoCopyRows := SenderName.StartsWith(TfrmExportGrid.CopyAsActionPrefix); + FClipboardHasNull := False; + Screen.Cursor := crHourglass; + try + if SendingControl = btnPreviewCopy then begin + if (imgPreview.Picture.Graphic <> nil) and (not imgPreview.Picture.Graphic.Empty) then begin + imgPreview.Picture.SaveToClipBoardFormat(ClpFormat, ClpData, APalette); + ClipBoard.SetAsHandle(ClpFormat, ClpData); + end; + end else if CurrentControl is TCustomEdit then begin + Edit := TCustomEdit(CurrentControl); + if Edit.SelLength > 0 then begin + if DoCut then Edit.CutToClipboard + else Edit.CopyToClipboard; + end; + end else if CurrentControl is TCustomComboBox then begin + Combo := TCustomComboBox(CurrentControl); + if Combo.SelLength > 0 then begin + Clipboard.TryAsText := Combo.SelText; + if DoCut then Combo.SelText := ''; + end; + end else if CurrentControl is TVirtualStringTree then begin + Grid := CurrentControl as TVirtualStringTree; + if Assigned(Grid.FocusedNode) then begin + IsResultGrid := Grid = ActiveGrid; + FGridCopying := True; + if IsResultGrid then begin + if DoCopyRows then begin + ExportDialog := TfrmExportGrid.Create(Sender as TAction); + ExportDialog.Grid := Grid; + ExportDialog.btnOK.Click; + ExportDialog.Free; + end else begin + // Handle NULL values in grids, see issue #3171 + AnyGridEnsureFullRow(Grid, Grid.FocusedNode); + Results := GridResult(Grid); + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; + if Results.IsNull(Grid.FocusedColumn-1) then begin + Clipboard.TryAsText := ''; + FClipboardHasNull := True; + end else begin + TextCopy := Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]; + RemoveNullChars(TextCopy, HasNulls); + Clipboard.TryAsText := TextCopy; + end; + if DoCut then + Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := ''; + end; + end else begin + TextCopy := Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]; + RemoveNullChars(TextCopy, HasNulls); + Clipboard.TryAsText := TextCopy; + end; + FGridCopying := False; + end; + end else if CurrentControl is TSynMemo then begin + SynMemo := CurrentControl as TSynMemo; + if SynMemo.SelAvail then begin + // Create both text and RTF clipboard format, so rich text applications can paste highlighted SQL + Clipboard.Open; + Clipboard.TryAsText := SynMemo.SelText; + Exporter := TSynExporterRTF.Create(Self); + Exporter.Highlighter := SynMemo.Highlighter; + Exporter.ExportAll(Explode(CRLF, SynMemo.SelText)); + if DoCut then SynMemo.CutToClipboard + else SynMemo.CopyToClipboard; + Exporter.CopyToClipboard; + Clipboard.Close; + Exporter.Free; + end; + end else begin + raise Exception.Create('Unhandled control in clipboard action: '+IfThen(Assigned(CurrentControl), CurrentControl.Name, 'nil')); + end; + except + on E:Exception do begin + LogSQL(E.ClassName + ': ' + E.Message); + MessageBeep(MB_ICONASTERISK); + end; + end; + Screen.Cursor := crDefault; +end;} + + +{procedure TMainForm.actPasteExecute(Sender: TObject); +var + Control: TWinControl; + Edit: TCustomEdit; + Combo: TComboBox; + Grid: TVirtualStringTree; + SynMemo: TSynMemo; + Success: Boolean; +begin + // Paste text into the focused control + Success := False; + Control := Screen.ActiveControl; + if not Clipboard.HasFormat(CF_TEXT) then begin + // Do nothing, we cannot paste a picture or so + end else if Control is TCustomEdit then begin + Edit := TCustomEdit(Control); + if not Edit.ReadOnly then begin + Edit.PasteFromClipboard; + Success := True; + end; + end else if Control is TComboBox then begin + Combo := TComboBox(Control); + if Combo.Style = csDropDown then begin + Combo.SelText := Clipboard.TryAsText; + Success := True; + end; + end else if Control is TVirtualStringTree then begin + Grid := Control as TVirtualStringTree; + if Assigned(Grid.FocusedNode) and (Grid = ActiveGrid) then begin + FGridPasting := True; + Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := Clipboard.TryAsText; + Success := True; + FGridPasting := False; + end; + end else if Control is TSynMemo then begin + SynMemo := TSynMemo(Control); + if not SynMemo.ReadOnly then begin + try + SynMemo.PasteFromClipboard; + Success := True; + SynMemo.Modified := True; + except on E:Exception do + ErrorDialog(E.Message); + end; + end; + end; + if not Success then + MessageBeep(MB_ICONASTERISK); +end;} + + +{procedure TMainForm.actSequalSuggestExecute(Sender: TObject); +var + SequalSuggestForm: TSequalSuggestForm; +begin + // Show Sequal Suggest dialog + SequalSuggestForm := TSequalSuggestForm.Create(Self); + SequalSuggestForm.ShowModal; +end;} + +{procedure TMainForm.actSelectAllExecute(Sender: TObject); +var + Control: TWinControl; + Grid: TVirtualStringTree; + ListBox: TListBox; + Success: Boolean; +begin + // Select all items, text or whatever + Success := False; + Control := Screen.ActiveControl; + if Control is TCustomEdit then begin + TCustomEdit(Control).SelectAll; + Success := True; + end else if Control is TVirtualStringTree then begin + Grid := TVirtualStringTree(Control); + if toMultiSelect in Grid.TreeOptions.SelectionOptions then begin + Grid.SelectAll(False); + Success := True; + end; + end else if Control is TSynMemo then begin + TSynMemo(Control).SelectAll; + Success := True; + end else if Control is TListBox then begin + ListBox := TListBox(Control); + if ListBox.MultiSelect then begin + ListBox.SelectAll; + Success := True; + end; + end; + if not Success then + MessageBeep(MB_ICONASTERISK); +end;} + + +{procedure TMainForm.actSelectInverseExecute(Sender: TObject); +var + Control: TWinControl; + Grid: TVirtualStringTree; + ListBox: TListBox; + Success: Boolean; + i: Integer; +begin + // Invert selection in grids or listboxes + Success := False; + Control := Screen.ActiveControl; + if Control is TVirtualStringTree then begin + Grid := TVirtualStringTree(Control); + if toMultiSelect in Grid.TreeOptions.SelectionOptions then begin + Grid.InvertSelection(False); + Success := True; + end; + end else if Control is TListBox then begin + ListBox := TListBox(Control); + if ListBox.MultiSelect then begin + for i:=0 to ListBox.Count-1 do + ListBox.Selected[i] := not ListBox.Selected[i]; + Success := True; + end; + end; + if not Success then + MessageBeep(MB_ICONASTERISK); +end;} + + +{procedure TMainForm.EnumerateRecentFilters; +var + i: Integer; + item: TMenuItem; + rx: TRegExpr; + capt, Path: String; +begin + // Reset menu and combobox + menuRecentFilters.Enabled := False; + for i := menuRecentFilters.Count - 1 downto 0 do + menuRecentFilters.Delete(i); + comboRecentFilters.Items.Clear; + // Enumerate recent filters from registry + Path := GetRegKeyTable+'\'+REGKEY_RECENTFILTERS; + if AppSettings.SessionPathExists(Path) then begin + AppSettings.SessionPath := Path; + rx := TRegExpr.Create; + rx.Expression := '\s+'; + for i:=1 to 20 do begin + // Previously introduced bugs stored some other settings here, see issue #2127 + item := TMenuItem.Create(popupFilter); + capt := AppSettings.ReadString(asRecentFilter, IntToStr(i)); + if capt.IsEmpty then + Break; + capt := rx.Replace(capt, ' ', True); + item.Hint := capt; + item.Caption := StrEllipsis(capt, 50); + item.Tag := i; + item.OnClick := LoadRecentFilter; + menuRecentFilters.Add(item); + comboRecentFilters.Items.Add(capt); + end; + FreeAndNil(rx); + AppSettings.ResetPath; + menuRecentFilters.Enabled := menuRecentFilters.Count > 0; + end; + comboRecentFilters.Visible := comboRecentFilters.Items.Count > 0; + lblRecentFilters.Visible := comboRecentFilters.Visible; + SynMemoFilter.Height := pnlFilter.Height - 3; + SynMemoFilter.Top := comboRecentFilters.Top; + if comboRecentFilters.Visible then begin + SynMemoFilter.Height := SynMemoFilter.Height - comboRecentFilters.Height; + SynMemoFilter.Top := SynMemoFilter.Top + comboRecentFilters.Height; + comboRecentFilters.ItemIndex := 0; + end; +end;} + + +{procedure TMainForm.LoadRecentFilter(Sender: TObject); +var + key: Integer; + Path: String; +begin + // Event handler for both dynamic popup menu items and filter combobox + if Sender is TMenuItem then + key := (Sender as TMenuItem).Tag + else + key := (Sender as TComboBox).ItemIndex+1; + Path := GetRegKeyTable+'\'+REGKEY_RECENTFILTERS; + if AppSettings.SessionPathExists(Path) then begin + AppSettings.SessionPath := Path; + SynMemoFilter.UndoList.AddGroupBreak; + SynMemoFilter.BeginUpdate; + SynMemoFilter.SelectAll; + SynMemoFilter.SelText := AppSettings.ReadString(asRecentFilter, IntToStr(key)); + SynMemoFilter.EndUpdate; + AppSettings.ResetPath; + end; +end;} + + +{procedure TMainForm.PlaceObjectEditor(Obj: TDBObject); +var + EditorClass: TDBObjectEditorClass; +begin + // Place the relevant editor frame onto the editor tab, hide all others + if FTreeRefreshInProgress and Assigned(ActiveObjectEditor) then begin + ActiveObjectEditor.Init(Obj); + UpdateFilterPanel(Self); + end else begin + if Assigned(ActiveObjectEditor) and (Obj.NodeType <> ActiveObjectEditor.DBObject.NodeType) then + FreeAndNil(ActiveObjectEditor); + case Obj.NodeType of + lntTable: EditorClass := TfrmTableEditor; + lntView: EditorClass := TfrmView; + lntProcedure, lntFunction: EditorClass := TfrmRoutineEditor; + lntTrigger: EditorClass := TfrmTriggerEditor; + lntEvent: EditorClass := TfrmEventEditor; + else Exit; + end; + if not Assigned(ActiveObjectEditor) then begin + ActiveObjectEditor := EditorClass.Create(tabEditor); + ActiveObjectEditor.Parent := tabEditor; + SetupSynEditors(ActiveObjectEditor); + end; + ActiveObjectEditor.Init(Obj); + buttonedEditClear(editFilterVT); + end; +end;} + + +{procedure TMainForm.UpdateEditorTab; +var + Cap: String; +begin + tabEditor.ImageIndex := ActiveObjectEditor.DBObject.ImageIndex; + // Reset to grayscale if in background: + PageControlTabHighlight(PageControlMain); + Cap := _(ActiveObjectEditor.DBObject.ObjType)+': '; + if ActiveObjectEditor.DBObject.Name = '' then + Cap := Cap + '['+_('Untitled')+']' + else + Cap := Cap + ActiveObjectEditor.DBObject.Name; + SetTabCaption(tabEditor.PageIndex, Cap); +end;} + + +{procedure TMainForm.menuEditObjectClick(Sender: TObject); +var + Obj: PDBObject; +begin + if ListTables.Focused then begin + // Got here from ListTables.OnDblClick or ListTables's context menu item "Edit" + Obj := ListTables.GetNodeData(ListTables.FocusedNode); + if not Obj.IsSameAs(ActiveDbObj) then + ActiveDBObj := Obj^; + SetMainTab(tabEditor); + end else begin + Obj := DBtree.GetNodeData(DBtree.FocusedNode); + case Obj.NodeType of + lntDb: begin + FCreateDatabaseDialog := TCreateDatabaseForm.Create(Self); + FCreateDatabaseDialog.modifyDB := ActiveDatabase; + if FCreateDatabaseDialog.ShowModal = mrOk then + RefreshTree; + FreeAndNil(FCreateDatabaseDialog); + end; + lntTable..lntEvent: + SetMainTab(tabEditor); + end; + end; +end;} + + +{procedure TMainForm.ListTablesKeyPress(Sender: TObject; var Key: Char); +begin + // Open object editor on pressing Enter + if Ord(Key) = VK_RETURN then + ListTables.OnDblClick(Sender); +end;} + + +{procedure TMainForm.ListTablesDblClick(Sender: TObject); +var + Obj: PDBObject; + vt: TVirtualStringTree; +begin + // DoubleClick: Display editor + vt := Sender as TVirtualStringTree; + if Assigned(vt.FocusedNode) then begin + Obj := vt.GetNodeData(vt.FocusedNode); + ActiveDBObj := Obj^; + // Normally the editor tab is active now, but not when same node was focused before + SetMainTab(tabEditor); + end; +end;} + + +{procedure TMainForm.actNewQueryTabExecute(Sender: TObject); +var + i: Integer; + QueryTab, OldTab: TQueryTab; + HelperColumn: TVirtualTreeColumn; +begin + i := QueryTabs[QueryTabs.Count-1].Number + 1; + OldTab := QueryTabs.ActiveTab; + + QueryTabs.Add(TQueryTab.Create(Self)); + QueryTab := QueryTabs[QueryTabs.Count-1]; + QueryTab.Number := i; + QueryTab.Uid := TQueryTab.GenerateUid; + + QueryTab.TabSheet := TTabSheet.Create(PageControlMain); + QueryTab.TabSheet.Name := tabQuery.Name + i.ToString; + QueryTab.TabSheet.PageControl := PageControlMain; + QueryTab.TabSheet.ImageIndex := tabQuery.ImageIndex; + + QueryTab.CloseButton := TSpeedButton.Create(QueryTab.TabSheet); + QueryTab.CloseButton.Parent := PageControlMain; + QueryTab.CloseButton.Width := 16; + QueryTab.CloseButton.Height := 16; + QueryTab.CloseButton.Flat := True; + VirtualImageListMain.GetBitmap(134, QueryTab.CloseButton.Glyph); + QueryTab.CloseButton.OnMouseDown := CloseButtonOnMouseDown; + QueryTab.CloseButton.OnMouseUp := CloseButtonOnMouseUp; + SetTabCaption(QueryTab.TabSheet.PageIndex, ''); + + // Dumb code which replicates all controls from tabQuery + QueryTab.pnlMemo := TPanel.Create(QueryTab.TabSheet); + QueryTab.pnlMemo.Name := pnlQueryMemo.Name + i.ToString; + QueryTab.pnlMemo.Parent := QueryTab.TabSheet; + QueryTab.pnlMemo.BevelOuter := pnlQueryMemo.BevelOuter; + QueryTab.pnlMemo.Align := pnlQueryMemo.Align; + if Assigned(OldTab) then + QueryTab.pnlMemo.Height := OldTab.pnlMemo.Height + else + QueryTab.pnlMemo.Height := AppSettings.GetDefaultInt(asQuerymemoheight); + QueryTab.pnlMemo.Constraints := pnlQueryMemo.Constraints; + + QueryTab.Memo := TSynMemo.Create(QueryTab.pnlMemo); + QueryTab.Memo.Name := SynMemoQuery.Name + i.ToString; + QueryTab.Memo.Text := ''; + QueryTab.Memo.Parent := QueryTab.pnlMemo; + QueryTab.Memo.Align := SynMemoQuery.Align; + QueryTab.Memo.Constraints := SynMemoQuery.Constraints; + QueryTab.Memo.HintMode := SynMemoQuery.HintMode; + QueryTab.Memo.Left := SynMemoQuery.Left; + QueryTab.Memo.Options := SynMemoQuery.Options; + QueryTab.Memo.PopupMenu := SynMemoQuery.PopupMenu; + QueryTab.Memo.TabWidth := SynMemoQuery.TabWidth; + QueryTab.Memo.RightEdge := SynMemoQuery.RightEdge; + QueryTab.Memo.WantTabs := SynMemoQuery.WantTabs; + QueryTab.Memo.Highlighter := SynMemoQuery.Highlighter; + QueryTab.Memo.Gutter.Assign(SynMemoQuery.Gutter); + QueryTab.Memo.Font.Assign(SynMemoQuery.Font); + QueryTab.Memo.ActiveLineColor := SynMemoQuery.ActiveLineColor; + QueryTab.Memo.OnStatusChange := SynMemoQuery.OnStatusChange; + QueryTab.Memo.OnSpecialLineColors := SynMemoQuery.OnSpecialLineColors; + QueryTab.Memo.OnDragDrop := SynMemoQuery.OnDragDrop; + QueryTab.Memo.OnDragOver := SynMemoQuery.OnDragOver; + QueryTab.Memo.OnDropFiles := SynMemoQuery.OnDropFiles; + QueryTab.Memo.OnKeyPress := SynMemoQuery.OnKeyPress; + QueryTab.Memo.OnMouseWheel := SynMemoQuery.OnMouseWheel; + QueryTab.Memo.OnReplaceText := SynMemoQuery.OnReplaceText; + QueryTab.Memo.OnPaintTransient := SynMemoQuery.OnPaintTransient; + QueryTab.Memo.OnTokenHint := SynMemoQuery.OnTokenHint; + QueryTab.MemoLineBreaks := TLineBreaks(AppSettings.ReadInt(asLineBreakStyle)); + SynCompletionProposal.AddEditor(QueryTab.Memo); + + QueryTab.spltHelpers := TSplitter.Create(QueryTab.pnlMemo); + QueryTab.spltHelpers.Parent := QueryTab.pnlMemo; + QueryTab.spltHelpers.Align := spltQueryHelpers.Align; + QueryTab.spltHelpers.Left := spltQueryHelpers.Left; + QueryTab.spltHelpers.Cursor := spltQueryHelpers.Cursor; + QueryTab.spltHelpers.ResizeStyle := spltQueryHelpers.ResizeStyle; + QueryTab.spltHelpers.Width := spltQueryHelpers.Width; + + QueryTab.pnlHelpers := TPanel.Create(QueryTab.pnlMemo); + QueryTab.pnlHelpers.Name := pnlQueryHelpers.Name + i.ToString; + QueryTab.pnlHelpers.Parent := QueryTab.pnlMemo; + QueryTab.pnlHelpers.Align := pnlQueryHelpers.Align; + QueryTab.pnlHelpers.Constraints := pnlQueryHelpers.Constraints; + QueryTab.pnlHelpers.BevelOuter := pnlQueryHelpers.BevelOuter; + QueryTab.pnlHelpers.Left := pnlQueryHelpers.Left; + if Assigned(OldTab) then + QueryTab.pnlHelpers.Width := OldTab.pnlHelpers.Width + else + QueryTab.pnlHelpers.Width := AppSettings.GetDefaultInt(asQueryhelperswidth); + + QueryTab.filterHelpers := TButtonedEdit.Create(QueryTab.pnlHelpers); + QueryTab.filterHelpers.Name := filterQueryHelpers.Name + i.ToString; + QueryTab.filterHelpers.Text := ''; + QueryTab.filterHelpers.Parent := QueryTab.pnlHelpers; + QueryTab.filterHelpers.Align := filterQueryHelpers.Align; + QueryTab.filterHelpers.TextHint := filterQueryHelpers.TextHint; + QueryTab.filterHelpers.Images := filterQueryHelpers.Images; + QueryTab.filterHelpers.LeftButton.Visible := filterQueryHelpers.LeftButton.Visible; + QueryTab.filterHelpers.LeftButton.ImageIndex := filterQueryHelpers.LeftButton.ImageIndex; + QueryTab.filterHelpers.RightButton.Visible := filterQueryHelpers.RightButton.Visible; + QueryTab.filterHelpers.RightButton.ImageIndex := filterQueryHelpers.RightButton.ImageIndex; + QueryTab.filterHelpers.OnChange := filterQueryHelpers.OnChange; + QueryTab.filterHelpers.OnRightButtonClick := filterQueryHelpers.OnRightButtonClick; + + QueryTab.treeHelpers := TVirtualStringTree.Create(QueryTab.pnlHelpers); + QueryTab.treeHelpers.Name := treeQueryHelpers.Name + i.ToString; + QueryTab.treeHelpers.Parent := QueryTab.pnlHelpers; + QueryTab.treeHelpers.Align := treeQueryHelpers.Align; + QueryTab.treeHelpers.Left := treeQueryHelpers.Left; + QueryTab.treeHelpers.Constraints.MinWidth := treeQueryHelpers.Constraints.MinWidth; + QueryTab.treeHelpers.PopupMenu := treeQueryHelpers.PopupMenu; + QueryTab.treeHelpers.Images := treeQueryHelpers.Images; + QueryTab.treeHelpers.DragMode := treeQueryHelpers.DragMode; + QueryTab.treeHelpers.DragType := treeQueryHelpers.DragType; + QueryTab.treeHelpers.OnBeforeCellPaint := treeQueryHelpers.OnBeforeCellPaint; + QueryTab.treeHelpers.OnChecking := treeQueryHelpers.OnChecking; + QueryTab.treeHelpers.OnContextPopup := treeQueryHelpers.OnContextPopup; + QueryTab.treeHelpers.OnCreateEditor := treeQueryHelpers.OnCreateEditor; + QueryTab.treeHelpers.OnDblClick := treeQueryHelpers.OnDblClick; + QueryTab.treeHelpers.OnEditing := treeQueryHelpers.OnEditing; + QueryTab.treeHelpers.OnFreeNode := treeQueryHelpers.OnFreeNode; + QueryTab.treeHelpers.OnGetImageIndex := treeQueryHelpers.OnGetImageIndex; + QueryTab.treeHelpers.OnGetText := treeQueryHelpers.OnGetText; + QueryTab.treeHelpers.OnInitChildren := treeQueryHelpers.OnInitChildren; + QueryTab.treeHelpers.OnInitNode := treeQueryHelpers.OnInitNode; + QueryTab.treeHelpers.OnNewText := treeQueryHelpers.OnNewText; + QueryTab.treeHelpers.OnNodeClick := treeQueryHelpers.OnNodeClick; + QueryTab.treeHelpers.OnPaintText := treeQueryHelpers.OnPaintText; + QueryTab.treeHelpers.OnResize := treeQueryHelpers.OnResize; + for i:=0 to treeQueryHelpers.Header.Columns.Count-1 do begin + HelperColumn := QueryTab.treeHelpers.Header.Columns.Add; + HelperColumn.Text := treeQueryHelpers.Header.Columns[i].Text; + HelperColumn.Width := treeQueryHelpers.Header.Columns[i].Width; + end; + QueryTab.treeHelpers.TreeOptions := treeQueryHelpers.TreeOptions; + QueryTab.treeHelpers.Header.Options := treeQueryHelpers.Header.Options; + QueryTab.treeHelpers.Header.AutoSizeIndex := treeQueryHelpers.Header.AutoSizeIndex; + QueryTab.treeHelpers.IncrementalSearch := treeQueryHelpers.IncrementalSearch; + QueryTab.treeHelpers.RootNodeCount := treeQueryHelpers.RootNodeCount; + QueryTab.treeHelpers.TextMargin := treeQueryHelpers.TextMargin; + FixVT(QueryTab.treeHelpers); + + QueryTab.spltQuery := TSplitter.Create(QueryTab.TabSheet); + QueryTab.spltQuery.Parent := QueryTab.TabSheet; + QueryTab.spltQuery.Top := spltQuery.Top; // Important to get it below the editor, not above. See #439 + QueryTab.spltQuery.Align := spltQuery.Align; + QueryTab.spltQuery.Height := spltQuery.Height; + QueryTab.spltQuery.Cursor := spltQuery.Cursor; + QueryTab.spltQuery.ResizeStyle := spltQuery.ResizeStyle; + QueryTab.spltQuery.AutoSnap := spltQuery.AutoSnap; + + QueryTab.ResultTabs := TResultTabs.Create(True); + + QueryTab.tabsetQuery := TTabSet.Create(QueryTab.TabSheet); + QueryTab.tabsetQuery.Name := tabsetQuery.Name + i.ToString; + QueryTab.tabsetQuery.Parent := QueryTab.TabSheet; + // Prevent various problems with alignment of controls. See http://www.heidisql.com/forum.php?t=18924 + QueryTab.tabsetQuery.Top := QueryTab.spltQuery.Top + QueryTab.spltQuery.Height; + QueryTab.tabsetQuery.Align := tabsetQuery.Align; + QueryTab.tabsetQuery.Font.Assign(tabsetQuery.Font); + QueryTab.tabsetQuery.Images := tabsetQuery.Images; + QueryTab.tabsetQuery.Style := tabsetQuery.Style; + QueryTab.tabsetQuery.TabHeight := tabsetQuery.TabHeight; + QueryTab.tabsetQuery.Height := tabsetQuery.Height; + QueryTab.tabsetQuery.TabPosition := tabsetQuery.TabPosition; + QueryTab.tabsetQuery.SoftTop := tabsetQuery.SoftTop; + QueryTab.tabsetQuery.DitherBackground := tabsetQuery.DitherBackground; + QueryTab.tabsetQuery.SelectedColor := tabsetQuery.SelectedColor; + QueryTab.tabsetQuery.UnselectedColor := tabsetQuery.UnselectedColor; + QueryTab.tabsetQuery.OnClick := tabsetQuery.OnClick; + QueryTab.tabsetQuery.OnGetImageIndex := tabsetQuery.OnGetImageIndex; + QueryTab.tabsetQuery.OnMouseMove := tabsetQuery.OnMouseMove; + QueryTab.tabsetQuery.OnMouseLeave := tabsetQuery.OnMouseLeave; + + SetupSynEditor(QueryTab.Memo); + + // Show new tab + if Sender <> actNewQueryTabNofocus then begin + SetMainTab(QueryTab.TabSheet); + QueryTab.Memo.TrySetFocus; + end; +end;} + + +{procedure TMainForm.panelTopDblClick(Sender: TObject); +var + aRect: TRect; + aPoint: TPoint; +begin + // Catch doubleclick on PageControlMain's underlying panel, which gets fired + // when user clicks right besides the visible tabs + aPoint := PageControlMain.ClientOrigin; + aRect := Rect(aPoint.X, aPoint.Y, aPoint.X + PageControlMain.Width, aPoint.Y + PageControlMain.Height - tabQuery.Height); + GetCursorPos(aPoint); + if PtInRect(aRect, aPoint) then + actNewQueryTab.Execute; +end;} + + +{procedure TMainForm.actCloseQueryTabExecute(Sender: TObject); +begin + // Close active query tab by main action + CloseQueryTab(PageControlMain.ActivePageIndex); +end;} + + +{procedure TMainForm.menuCloseQueryTabClick(Sender: TObject); +var + aPoint: TPoint; +begin + // Close query tab by menu item + aPoint := PageControlMain.ScreenToClient(popupMainTabs.PopupPoint); + CloseQueryTab(GetMainTabAt(aPoint.X, aPoint.Y)); +end;} + + +{procedure TMainForm.menuCloseRightQueryTabsClick(Sender: TObject); +var + aPoint: TPoint; + i, PageIndexClick: Integer; +begin + // Close tabs to the right + aPoint := PageControlMain.ScreenToClient(popupMainTabs.PopupPoint); + PageIndexClick := GetMainTabAt(aPoint.X, aPoint.Y); + if PageIndexClick > -1 then begin + for i:=PageControlMain.PageCount-1 downto PageIndexClick+1 do begin + CloseQueryTab(PageControlMain.Pages[i].PageIndex); + end; + end; +end;} + + +{procedure TMainForm.menuCloseTabOnDblClickClick(Sender: TObject); +begin + AppSettings.WriteBool(asTabCloseOnDoubleClick, menuCloseTabOnDblClick.Checked); +end;} + + +{procedure TMainForm.menuCloseTabOnMiddleClickClick(Sender: TObject); +begin + AppSettings.WriteBool(asTabCloseOnMiddleClick, menuCloseTabOnMiddleClick.Checked); +end;} + +{procedure TMainForm.menuTabsInMultipleLinesClick(Sender: TObject); +begin + AppSettings.WriteBool(asTabsInMultipleLines, menuTabsInMultipleLines.Checked); + PageControlMain.MultiLine := menuTabsInMultipleLines.Checked; +end;} + +{procedure TMainForm.actCloseAllQueryTabsExecute(Sender: TObject); +var + i: Integer; +begin + // Close all tabs + for i:=PageControlMain.PageCount-1 downto tabQuery.PageIndex do begin + CloseQueryTab(PageControlMain.Pages[i].PageIndex); + end; +end;} + + +{procedure TMainForm.actRenameQueryTabExecute(Sender: TObject); +var + aPoint: TPoint; + PageIndex: Integer; + NewCaption: String; +begin + // Rename query tab + if Sender = menuRenameQueryTab then begin + aPoint := PageControlMain.ScreenToClient(popupMainTabs.PopupPoint); + PageIndex := GetMainTabAt(aPoint.X, aPoint.Y); + end else begin + PageIndex := PageControlMain.ActivePageIndex; + end; + if not IsQueryTab(PageIndex, True) then begin + // Action may have been triggered through shortcut, and active tab is not a query tab + MessageBeep(MB_ICONASTERISK); + end else begin + NewCaption := PageControlMain.Pages[PageIndex].Caption; + NewCaption := NewCaption.Trim([' ', '*']); + if InputQuery(actRenameQueryTab.Caption, _('Enter new name'), NewCaption) then begin + SetTabCaption(PageIndex, NewCaption); + ValidateQueryControls(Sender); + end; + end; +end;} + + +{procedure TMainForm.actResetPanelDimensionsExecute(Sender: TObject); +var + Tab: TQueryTab; +begin + // Reset probably overlapping panels to their default dimensions + pnlLeft.Width := AppSettings.GetDefaultInt(asDbtreewidth); + SynMemoSQLLog.Height := AppSettings.GetDefaultInt(asLogHeight); + for Tab in QueryTabs do begin + Tab.pnlMemo.Height := AppSettings.GetDefaultInt(asQuerymemoheight); + Tab.pnlHelpers.Width := AppSettings.GetDefaultInt(asQueryhelperswidth); + end; + if pnlPreview.Visible then begin + pnlPreview.Height := AppSettings.GetDefaultInt(asDataPreviewHeight); + end; + AppSettings.DeleteValue(asCompletionProposalWidth); + AppSettings.DeleteValue(asCompletionProposalNbLinesInWindow); + SynCompletionProposal.Width := AppSettings.ReadInt(asCompletionProposalWidth); + SynCompletionProposal.NbLinesInWindow := AppSettings.ReadInt(asCompletionProposalNbLinesInWindow); +end;} + +{procedure TMainForm.menuRenameQueryTabClick(Sender: TObject); +begin + // Rename tab by click on menu item (not by shortcut!) + actRenameQueryTabExecute(Sender); +end;} + + +{procedure TMainForm.popupMainTabsPopup(Sender: TObject); +var + aPoint: TPoint; + PageIndexClick: Integer; +begin + // Detect if there is a tab under mouse position + aPoint := PageControlMain.ScreenToClient(popupMainTabs.PopupPoint); + PageIndexClick := GetMainTabAt(aPoint.X, aPoint.Y); + menuCloseQueryTab.ImageIndex := actCloseQueryTab.ImageIndex; + menuCloseQueryTab.Caption := actCloseQueryTab.Caption; + menuCloseQueryTab.Enabled := IsQueryTab(PageIndexClick, False); + menuCloseRightQueryTabs.Enabled := (QueryTabs.Count > 0) and (PageIndexClick < QueryTabs.Last.TabSheet.PageIndex) and (PageIndexClick > -1); + menuRenameQueryTab.ImageIndex := actRenameQueryTab.ImageIndex; + menuRenameQueryTab.Caption := actRenameQueryTab.Caption; + menuRenameQueryTab.Enabled := IsQueryTab(PageIndexClick, True); + menuCloseTabOnDblClick.Checked := AppSettings.ReadBool(asTabCloseOnDoubleClick); + menuCloseTabOnMiddleClick.Checked := AppSettings.ReadBool(asTabCloseOnMiddleClick); + menuTabsInMultipleLines.Checked := AppSettings.ReadBool(asTabsInMultipleLines) +end;} + + +{procedure TMainForm.CloseQueryTab(PageIndex: Integer); +var + NewPageIndex: Integer; + Grid: TVirtualStringTree; +begin + // Special case: the very first tab gets cleared but not closed + if PageIndex = tabQuery.PageIndex then begin + if ConfirmTabClear(PageIndex, False) then + actClearQueryEditor.Execute; + end; + if not IsQueryTab(PageIndex, False) then + Exit; + // Cancel cell editor if active, preventing crash. See issue #2040 + Grid := ActiveGrid; + if Assigned(Grid) and Grid.IsEditing then + Grid.CancelEditNode; + // Ask user if query content shall be saved to disk + if not ConfirmTabClose(PageIndex, False) then + Exit; + // Block too quick further close actions, fix issue #1496. Action gets enabled again in PageControlMainChange/ValidateQueryControls + actCloseQueryTab.Enabled := False; + // Work around bugs in ComCtrls.TPageControl.RemovePage + NewPageIndex := PageControlMain.ActivePageIndex; + if NewPageIndex >= PageIndex then + Dec(NewPageIndex); + // Avoid excessive flicker: + LockWindowUpdate(PageControlMain.Handle); + PageControlMain.Pages[PageIndex].Free; + QueryTabs.Delete(PageIndex-tabQuery.PageIndex); + PageControlMain.ActivePageIndex := NewPageIndex; + FixQueryTabCloseButtons; + LockWindowUpdate(0); + PageControlMain.OnChange(PageControlMain); +end;} + + +{procedure TMainForm.actFavoriteObjectsOnlyExecute(Sender: TObject); +begin + // Click on "tree favorites" main button + editDatabaseTableFilterChange(Sender); + if actFavoriteObjectsOnly.Checked then + actFavoriteObjectsOnly.ImageIndex := 112 + else + actFavoriteObjectsOnly.ImageIndex := 113; +end;} + + +{procedure TMainForm.buttonedEditClear(Sender: TObject); +begin + // Click on "clear" button of any TButtonedEdit control + TButtonedEdit(Sender).Clear; +end;} + + +{procedure TMainForm.editDatabaseTableFilterChange(Sender: TObject); +var + Node: PVirtualNode; + Obj: PDBObject; + rxdb, rxtable: TRegExpr; + NodeMatches: Boolean; + Errors: TStringList; +begin + // Immediately apply database filter + LogSQL('editDatabaseTableFilterChange', lcDebug); + + rxdb := TRegExpr.Create; + rxdb.ModifierI := True; + rxdb.Expression := '('+StringReplace(editDatabaseFilter.Text, ';', '|', [rfReplaceAll])+')'; + rxtable := TRegExpr.Create; + rxtable.ModifierI := True; + rxtable.Expression := '('+StringReplace(editTableFilter.Text, ';', '|', [rfReplaceAll])+')'; + + Errors := TStringList.Create; + + DBtree.BeginUpdate; + Node := DBtree.GetFirst; + while Assigned(Node) do begin + Obj := DBtree.GetNodeData(Node); + NodeMatches := True; + try + case Obj.NodeType of + lntDb: begin + // Match against database filter + if editDatabaseFilter.Text <> '' then + NodeMatches := rxdb.Exec(DBtree.Text[Node, 0]); + end; + lntTable..lntEvent: begin + // Match against table filter + if editTableFilter.Text <> '' then + NodeMatches := rxtable.Exec(DBtree.Text[Node, 0]); + if actFavoriteObjectsOnly.Checked then + // Hide non-favorite object path + NodeMatches := NodeMatches and (Obj.Connection.Favorites.IndexOf(Obj.Path) > -1); + end; + end; + except + on E:Exception do begin + // Log regex errors, but avoid duplicate messages + if Errors.IndexOf(E.Message) = -1 then begin + LogSQL(E.Message); + Errors.Add(E.Message); + end; + end; + end; + DBtree.IsVisible[Node] := NodeMatches; + + Node := DBtree.GetNextInitialized(Node); + end; + DBtree.EndUpdate; + // Fix scroll height of the tree. See issue #2063 and #2002 + DBtree.Repaint; + + rxdb.Free; + rxtable.Free; + + editDatabaseFilter.RightButton.Visible := editDatabaseFilter.Text <> ''; + editTableFilter.RightButton.Visible := editTableFilter.Text <> ''; +end;} + + +{procedure TMainForm.editDatabaseTableFilterLeftButtonClick(Sender: TObject); +var + Menu: TPopupMenu; + Item: TMenuItem; + P: TPoint; + Edit: TButtonedEdit; + History: TStringList; + ItemText: String; + Setting: TAppSettingIndex; +begin + // Create right menu with filter history + Edit := Sender as TButtonedEdit; + Menu := TPopupMenu.Create(Edit); + Menu.AutoHotkeys := maManual; + Menu.Images := VirtualImageListMain; + AppSettings.SessionPath := ''; + if Edit = editDatabaseFilter then + Setting := asDatabaseFilter + else if Edit = editTableFilter then + Setting := asTableFilter + else if Edit = editFilterVT then + Setting := asFilterVT + else + raise Exception.CreateFmt(MsgUnhandledControl, ['editDatabaseTableFilterLeftButtonClick']); + History := TStringList.Create; + History.Text := AppSettings.ReadString(Setting); + for ItemText in History do begin + Item := TMenuItem.Create(Menu); + Item.Caption := ItemText; + Item.OnClick := editDatabaseTableFilterMenuClick; + Item.Tag := 0; + Item.Checked := ItemText = Edit.Text; + Menu.Items.Add(Item); + end; + History.Free; + + Item := TMenuItem.Create(Menu); + Item.Caption := _('Clear'); + Item.ImageIndex := 193; + Item.OnClick := editDatabaseTableFilterMenuClick; + Item.Tag := 1; + Item.Enabled := Edit.Text <> ''; + Menu.Items.Add(Item); + + Item := TMenuItem.Create(Menu); + Item.Caption := _('Empty recent filters'); + Item.ImageIndex := 26; + Item.OnClick := editDatabaseTableFilterMenuClick; + Item.Tag := 2; + Item.Enabled := Menu.Items.Count > 1; + Menu.Items.Add(Item); + + P := Edit.ClientToScreen(Edit.ClientRect.TopLeft); + Menu.Popup(p.X, p.Y+16); +end;} + + +{procedure TMainForm.editDatabaseTableFilterMenuClick(Sender: TObject); +var + Menu: TPopupMenu; + Item: TMenuItem; + Edit: TButtonedEdit; + Setting: TAppSettingIndex; +begin + // Insert text from filter history menu + Item := Sender as TMenuItem; + Menu := Item.Owner as TPopupMenu; + Edit := Menu.Owner as TButtonedEdit; + if Edit = editDatabaseFilter then + Setting := asDatabaseFilter + else if Edit = editTableFilter then + Setting := asTableFilter + else if Edit = editFilterVT then + Setting := asFilterVT + else + raise Exception.CreateFmt(MsgUnhandledControl, ['editDatabaseTableFilterMenuClick']); + case Item.Tag of + 0: Edit.Text := Item.Caption; + 1: Edit.Clear; + 2: AppSettings.DeleteValue(Setting); + end; + Menu.Free; +end;} + + +{procedure TMainForm.editDatabaseTableFilterExit(Sender: TObject); +var + History: TStringList; + Edit: TButtonedEdit; + i: Integer; + Setting: TAppSettingIndex; +begin + // Add (move) custom filter text to (in) drop down history, if not empty + Edit := Sender as TButtonedEdit; + AppSettings.SessionPath := ''; + if Edit = editDatabaseFilter then + Setting := asDatabaseFilter + else if Edit = editTableFilter then + Setting := asTableFilter + else if Edit = editFilterVT then + Setting := asFilterVT + else + raise Exception.CreateFmt(MsgUnhandledControl, ['editDatabaseTableFilterExit']); + History := TStringList.Create; + History.Text := AppSettings.ReadString(Setting); + i := History.IndexOf(Edit.Text); + if i > -1 then + History.Delete(i); + History.Insert(0, Edit.Text); + for i:=History.Count-1 downto 0 do begin + if (i >= 20) or (Trim(History[i]) = '') then + History.Delete(i); + end; + AppSettings.WriteString(Setting, History.Text); + History.Free; +end;} + + +{procedure TMainForm.CloseButtonOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + FLastMouseDownCloseButton := Sender; +end;} + + +{procedure TMainForm.CloseButtonOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + // Click on "Close" button of Query tab + if Button <> mbLeft then + Exit; + // Between MousDown and MouseUp it is possible that the focused tab has switched. As we simulate a mouse-click + // here, we must check if also the MouseDown event was fired on this particular button. See issue #1469. + if (Sender <> FLastMouseDownCloseButton) then + Exit; + // Prevent EAccessViolation in TControl.GetClientWidth, see issue #1640 + TimerCloseTabByButton.Enabled := True; +end;} + + +{procedure TMainForm.TimerCloseTabByButtonTimer(Sender: TObject); +var + i: Integer; +begin + // Asynchronous timer for mousedown event on query tab close button + TimerCloseTabByButton.Enabled := False; + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i].CloseButton = FLastMouseDownCloseButton then begin + CloseQueryTab(QueryTabs[i].TabSheet.PageIndex); + break; + end; + end; +end;} + + +{procedure TMainForm.PageControlMainMouseUp(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + CurTickcount: Cardinal; + TabNumber: Integer; +begin + // Handle click event on poor PageControl tabs in lack of an OnClick + case Button of + mbLeft: begin + // Simulate doubleclick on tab to close it + if AppSettings.ReadBool(asTabCloseOnDoubleClick) then begin + CurTickcount := GetTickCount; + TabNumber := GetMainTabAt(X, Y); + if (TabNumber = FLastTabNumberOnMouseUp) + and (CurTickcount - FLastMouseUpOnPageControl <= GetDoubleClickTime) then begin + CloseQueryTab(TabNumber); + end else begin + FLastMouseUpOnPageControl := CurTickcount; + FLastTabNumberOnMouseUp := TabNumber; + end; + end; + end; + + mbMiddle: begin + // Middle click on tab + if AppSettings.ReadBool(asTabCloseOnMiddleClick) then begin + TabNumber := GetMainTabAt(X, Y); + CloseQueryTab(TabNumber); + end; + end; + end; + +end;} + + +{function TMainForm.GetMainTabAt(X, Y: Integer): Integer; +var + i: Integer; +begin + // Return page index of main tab by coordinates + Result := PageControlMain.IndexOfTabAt(X, Y); + for i:=0 to PageControlMain.PageCount-1 do begin + if (i<=Result) and (not PageControlMain.Pages[i].TabVisible) then + Inc(Result); + end; +end;} + + +{procedure TMainForm.FixQueryTabCloseButtons; +var + i, PageIndex, VisiblePageIndex: Integer; + Rect: TRect; + btn: TSpeedButton; +begin + // Fix positions of "Close" buttons on Query tabs + // Avoid AV on Startup, when Mainform.OnResize is called once or twice implicitely. + if not Assigned(FBtnAddTab) then + Exit; + for PageIndex:=tabQuery.PageIndex+1 to PageControlMain.PageCount-1 do begin + VisiblePageIndex := PageIndex; + for i:=0 to PageControlMain.PageCount-1 do begin + if (i<=VisiblePageIndex) and (not PageControlMain.Pages[i].TabVisible) then + Dec(VisiblePageIndex); + end; + Rect := PageControlMain.TabRect(VisiblePageIndex); + btn := QueryTabs[PageIndex-tabQuery.PageIndex].CloseButton; + btn.Top := Rect.Top + 2; + btn.Left := Rect.Right - 19; + end; + // Set position of "Add tab" button + VisiblePageIndex := PageControlMain.PageCount-1; + for i:=0 to PageControlMain.PageCount-1 do begin + if not PageControlMain.Pages[i].TabVisible then + Dec(VisiblePageIndex); + end; + Rect := PageControlMain.TabRect(VisiblePageIndex); + FBtnAddTab.Top := Rect.Top; + FBtnAddTab.Left := Rect.Right + 5; +end;} + + +{function TMainForm.GetOrCreateEmptyQueryTab(DoFocus: Boolean): TQueryTab; +var + i: Integer; +begin + // Return either a) current query tab if one is active + // or b) the first empty one + // or c) create a new one + // Result should never be nil, unlike in QueryTabs.ActiveTab + Result := nil; + // Search empty tab + for i:=0 to QueryTabs.Count-1 do begin + if (QueryTabs[i].MemoFilename='') and (QueryTabs[i].Memo.GetTextLen=0) then begin + Result := QueryTabs[i]; + if DoFocus then + SetMainTab(Result.TabSheet); + Break; + end; + end; + // Create new tab + if Result = nil then begin + if DoFocus then + actNewQueryTabExecute(actNewQueryTab) + else + actNewQueryTabExecute(actNewQueryTabNofocus); + Result := QueryTabs[QueryTabs.Count-1]; + end; +end;} + + +{function TMainForm.ActiveSynMemo(AcceptReadOnlyMemo: Boolean): TSynMemo; +var + Control: TWinControl; +begin + Result := nil; + Control := Screen.ActiveControl; + if Control is TCustomSynEdit then begin + Result := Control as TSynMemo; + // We have a few readonly-SynMemos which we'll ignore here + if (not AcceptReadOnlyMemo) and Result.ReadOnly then + Result := nil; + end; + if (not Assigned(Result)) and QueryTabs.HasActiveTab then + Result := QueryTabs.ActiveMemo; + if (not Assigned(Result)) and (Screen.ActiveForm is TfrmTextEditor) then begin + Result := TfrmTextEditor(Screen.ActiveForm).MemoText; + end; + +end;} + + +{function TMainForm.ActiveGrid: TVirtualStringTree; +begin + // Return current data or query grid, if main form is active + Result := nil; + if Screen.ActiveForm <> Self then + Exit; + if PageControlMain.ActivePage = tabData then + Result := DataGrid + else if (QueryTabs.ActiveTab <> nil) and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then + Result := QueryTabs.ActiveTab.ActiveResultTab.Grid; +end;} + + +{function TMainForm.GridResult(Grid: TBaseVirtualTree): TDBQuery; +var + QueryTab: TQueryTab; + CurrentTab: TTabSheet; + ResultTab: TResultTab; +begin + // All grids (data- and query-grids, also host subtabs) are placed directly on a TTabSheet + Result := nil; + if Grid = DataGrid then begin + if DataGridResult<>nil then + Result := DataGridResult; + end else if Assigned(Grid) then begin + CurrentTab := Grid.Parent as TTabSheet; + if CurrentTab.Parent = PageControlHost then + Result := FHostListResults[CurrentTab.PageIndex] + else for QueryTab in QueryTabs do begin + if QueryTab.TabSheet = CurrentTab then begin + for ResultTab in QueryTab.ResultTabs do begin + if ResultTab.Grid = Grid then begin + Result := ResultTab.Results; + break; + end; + end; + end; + end; + end; +end;} + + +{function TMainForm.IsQueryTab(PageIndex: Integer; IncludeFixed: Boolean): Boolean; +var + Min: Integer; +begin + // Find out if the given main tab is a query tab + Min := tabQuery.PageIndex+1; + if IncludeFixed then Dec(Min); + Result := PageIndex >= Min; +end;} + +{procedure TMainForm.SetWindowCaption; +var + Cap: String; +begin + // Set window caption and taskbar text + Cap := DBtree.Path(DBtree.FocusedNode, 0, '\') + ' - ' + APPNAME; + if AppSettings.PortableMode then + Cap := Cap + ' Portable'; + Cap := Cap + ' ' + FAppVersion; + Caption := Cap; + Application.Title := Cap; +end;} + + +{procedure TMainForm.SetMainTab(Page: TTabSheet); +begin + // Safely switch main tab + if (Page <> nil) and (not FTreeRefreshInProgress) then begin + PagecontrolMain.ActivePage := Page; + PageControlMain.OnChange(Page); + end; +end;} + + +{procedure TMainForm.SetTabCaption(PageIndex: Integer; Text: String); +var + Tab: TQueryTab; +begin + // The current tab can be closed already if we're here after CloseQueryTab() + if PageIndex >= PageControlMain.PageCount then + Exit; + // Some cases pass -1 which triggers a "List index out of bounds" in below cast + if PageIndex = -1 then + Exit; + // Escape hotkey accelerator in name of session, database or table + Text := EscapeHotkeyPrefix(Text); + Text := StrEllipsis(Text, 70); + // Special case if passed text is empty: Reset query tab caption to "Query #123" + if (PageIndex = tabQuery.PageIndex) and (Text = '') then + Text := _('Query'); + if IsQueryTab(PageIndex, False) then begin + if Text = '' then begin + for Tab in QueryTabs do begin + if Tab.TabSheet = PageControlMain.Pages[PageIndex] then begin + Text := _('Query')+' #'+IntToStr(Tab.Number); + break; + end; + end; + end; + // Leave space for close button on closable query tabs + Text := Text + ' '; + end; + PageControlMain.Pages[PageIndex].Caption := Text; + FixQueryTabCloseButtons; +end;} + + +{function TMainForm.ConfirmTabClose(PageIndex: Integer; AppIsClosing: Boolean): Boolean; +var + Tab: TQueryTab; +begin + Tab := QueryTabs[PageIndex-tabQuery.PageIndex]; + if Tab.QueryRunning then begin + LogSQL(_('Cannot close tab with running query. Please wait until query has finished.')); + Result := False; + end else if not Tab.Memo.Modified then begin + Result := True; + end else begin + Result := ConfirmTabClear(PageIndex, AppIsClosing); + end; +end;} + + +{function TMainForm.ConfirmTabClear(PageIndex: Integer; AppIsClosing: Boolean): Boolean; +var + msg: String; + Tab: TQueryTab; + Dialog: TExtFileSaveDialog; + MsgButtons: TMsgDlgButtons; +begin + Tab := QueryTabs[PageIndex-tabQuery.PageIndex]; + + // Unhide tabsheet so the user sees the memo content. + // If the dialog is suppressed anyway, the user does not need to see the text, and we avoid + // storing this as the focused tab + if AppSettings.ReadBool(asPromptSaveFileOnTabClose) then begin + Tab.TabSheet.PageControl.ActivePage := Tab.TabSheet; + end; + + // Prompt for saving unsaved contents + if Tab.MemoFilename <> '' then + msg := f_('Save changes to file %s ?', [Tab.MemoFilename]) + else + msg := f_('Save content of tab "%s"?', [Trim(Tab.TabSheet.Caption)]); + if AppSettings.RestoreTabsInitValue and AppIsClosing then begin + msg := msg + CRLF + CRLF + _('Your code is saved anyway, as auto-restoring is activated.'); + end; + + if FConnections.Count > 0 then + MsgButtons := [mbYes, mbNo, mbCancel] + else + MsgButtons := [mbYes, mbNo]; + + case MessageDialog(_('Modified query'), msg, mtConfirmation, MsgButtons, asPromptSaveFileOnTabClose) of + mrNo: Result := True; + mrYes: begin + if Tab.MemoFilename <> '' then begin + Tab.SaveContents(Tab.MemoFilename, False); + Result := True; + end + else begin + Dialog := TExtFileSaveDialog.Create(Self); + Dialog.Options := Dialog.Options + [fdoOverwritePrompt]; + Dialog.AddFileType('*.sql', _('SQL files')); + Dialog.AddFileType('*.*', _('All files')); + Dialog.DefaultExtension := 'sql'; + Dialog.LineBreakIndex := Tab.MemoLineBreaks; + if Dialog.Execute then begin + Tab.SaveContents(Dialog.FileName, False); + Tab.MemoLineBreaks := Dialog.LineBreakIndex; + end; + // The save dialog can be cancelled. + Result := not Tab.Memo.Modified; + Dialog.Free; + end; + end; + else Result := False; + end; + + // Auto-backup logic + if AppSettings.RestoreTabsInitValue then begin + if AppIsClosing then begin + // Do last backup before app closes + Tab.BackupUnsavedContent; + end else begin + // Delete backup file if tab is closed by user, intentionally + if (not Tab.MemoBackupFilename.IsEmpty) and FileExists(Tab.MemoBackupFilename) then begin + if not DeleteFileWithUndo(Tab.MemoBackupFilename) then begin + ErrorDialog(f_('Backup file could not be deleted: %s', [Tab.MemoBackupFilename])); + end; + end; + end; + end; + + if (not Result) and (FConnections.Count = 0) then begin + // Upper right "X" button clicked, or save dialog cancelled + Result := True; + end; + + ValidateControls(Self); +end;} + + +{procedure TMainForm.actFilterPanelExecute(Sender: TObject); +begin + // (De-)activate or focus filter panel + if Sender <> actFilterPanel then + actFilterPanel.Checked := not actFilterPanel.Checked; + pnlFilterVT.Visible := actFilterPanel.Checked; + // On startup, we cannot SetFocus, throws exceptons. Call with nil in that special case - see FormCreate + if pnlFilterVT.Visible and editFilterVT.CanFocus and (Sender <> nil) then + editFilterVT.SetFocus; + UpdateFilterPanel(Sender); +end;} + + +{procedure TMainForm.UpdateFilterPanel(Sender: TObject); +var + tab: TTabSheet; + f: String; +begin + // Called when active tab changes + pnlFilterVT.Enabled := (PageControlMain.ActivePage <> tabEditor) or (ActiveObjectEditor is TfrmTableEditor); + lblFilterVT.Enabled := pnlFilterVT.Enabled; + editFilterVT.Enabled := pnlFilterVT.Enabled; + lblFilterVTInfo.Enabled := pnlFilterVT.Enabled; + if pnlFilterVT.Enabled then + editFilterVT.Color := GetThemeColor(clWindow) + else + editFilterVT.Color := GetThemeColor(clBtnFace); + + tab := PageControlMain.ActivePage; + if tab = tabHost then + tab := PageControlHost.ActivePage; + if not pnlFilterVT.Visible then begin + if editFilterVT.Text <> '' then + editFilterVT.Text := '' + else + editFilterVTChange(Sender); + end else begin + if tab = tabDatabases then f := FFilterTextDatabases + else if tab = tabVariables then f := FFilterTextVariables + else if tab = tabStatus then f := FFilterTextStatus + else if tab = tabProcesslist then f := FFilterTextProcessList + else if tab = tabCommandStats then f := FFilterTextCommandStats + else if tab = tabDatabase then f := FFilterTextDatabase + else if tab = tabEditor then f := FFilterTextEditor + else if tab = tabData then f := FFilterTextData + else if QueryTabs.HasActiveTab and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then f := QueryTabs.ActiveTab.ActiveResultTab.FilterText; + if editFilterVT.Text <> f then + editFilterVT.Text := f + else + editFilterVTChange(Sender); + end; +end;} + + +{procedure TMainform.SetupSynEditors; +var + i, j: Integer; + Editors: TObjectList; + BaseEditor: TSynMemo; + KeyStroke: TSynEditKeyStroke; + Attri: TSynHighlighterAttributes; + Shortcut1, Shortcut2: TShortcut; +begin + // Setup all known TSynMemo's + // This version includes global settings for keyboard shortcut, highlighting and completion proposal + Editors := TObjectList.Create(False); + BaseEditor := SynMemoQuery; + for i:=0 to QueryTabs.Count-1 do + Editors.Add(QueryTabs[i].Memo); + Editors.Add(SynMemoFilter); + Editors.Add(SynMemoProcessView); + Editors.Add(SynMemoSQLLog); + if Assigned(ActiveObjectEditor) then + FindComponentInstances(ActiveObjectEditor, TSynMemo, Editors); + if Assigned(frmPreferences) then + Editors.Add(frmPreferences.SynMemoSQLSample); + if Assigned(FCreateDatabaseDialog) then + Editors.Add(FCreateDatabaseDialog.SynMemoCreateCode); + if SqlHelpDialog <> nil then begin + Editors.Add(SqlHelpDialog.memoDescription); + Editors.Add(SqlHelpDialog.MemoExample); + end; + if Assigned(FTableToolsDialog) then + Editors.Add(FTableToolsDialog.SynMemoFindText); + if Assigned(frmCsvDetector) then + Editors.Add(frmCsvDetector.SynMemoCreateTable); + + if AppSettings.ReadBool(asTabsToSpaces) then + BaseEditor.Options := BaseEditor.Options + [eoTabsToSpaces] + else + BaseEditor.Options := BaseEditor.Options - [eoTabsToSpaces]; + FMatchingBraceForegroundColor := StringToColor(AppSettings.ReadString(asSQLColMatchingBraceForeground)); + FMatchingBraceBackgroundColor := StringToColor(AppSettings.ReadString(asSQLColMatchingBraceBackground)); + FSynEditInOnPaintTransient := False; + + // Shortcuts + for j:=0 to BaseEditor.Keystrokes.Count-1 do begin + KeyStroke := BaseEditor.Keystrokes[j]; + Shortcut1 := AppSettings.ReadInt(asActionShortcut1, EditorCommandToCodeString(Keystroke.Command)); + Shortcut2 := AppSettings.ReadInt(asActionShortcut2, EditorCommandToCodeString(Keystroke.Command)); + try + if Shortcut1<>0 then + Keystroke.ShortCut := Shortcut1; + if Shortcut2<>0 then + Keystroke.ShortCut2 := Shortcut2; + except + on E:ESynKeyError do begin + LogSQL(f_('Could not apply SynEdit keystroke shortcut "%s" (or secondary: "%s") to %s. %s. Please go to %s > %s > %s to change this settings.', + [ + ShortCutToText(Shortcut1), + ShortCutToText(Shortcut2), + EditorCommandToCodeString(Keystroke.Command), + E.Message, + _('Tools'), + _('Preferences'), + _('Shortcuts') + ]), + lcError); + end; + end; + end; + // Apply events and options to all known editors + for i:=0 to Editors.Count-1 do begin + SetupSynEditor(Editors[i] as TSynMemo); + end; + Editors.Free; + // Highlighting + for i:=0 to SynSQLSynUsed.AttrCount - 1 do begin + Attri := SynSQLSynUsed.Attribute[i]; + Attri.Foreground := AppSettings.ReadInt(asHighlighterForeground, Attri.Name, Attri.Foreground); + Attri.Background := AppSettings.ReadInt(asHighlighterBackground, Attri.Name, Attri.Background); + // IntegerStyle gathers all font styles (bold, italic, ...) in one number + Attri.IntegerStyle := AppSettings.ReadInt(asHighlighterStyle, Attri.Name, Attri.IntegerStyle); + end; + // Completion proposal + if AppSettings.ReadBool(asCompletionProposalSearchOnMid) then + SynCompletionProposal.Options := SynCompletionProposal.Options + [scoLimitToMatchedTextAnywhere] + else + SynCompletionProposal.Options := SynCompletionProposal.Options - [scoLimitToMatchedTextAnywhere]; +end;} + + +{procedure TMainForm.SetupSynEditors(BaseForm: TComponent); +var + Editors: TObjectList; + i: Integer; +begin + // Restore font, highlighter and shortcuts for all TSynMemo's in given base form + Editors := TObjectList.Create(False); + FindComponentInstances(BaseForm, TSynMemo, Editors); + for i:=0 to Editors.Count-1 do begin + SetupSynEditor(Editors[i] as TSynMemo); + end; + Editors.Free; +end;} + + +{procedure TMainForm.SetupSynEditor(Editor: TSynMemo); +var + BaseEditor: TSynMemo; +begin + LogSQL('Setting up TSynMemo "'+Editor.Name+'"', lcDebug); + BaseEditor := SynMemoQuery; + Editor.Color := GetThemeColor(clWindow); + Editor.ScrollHintColor := GetThemeColor(clInfoBk); + Editor.Font.Name := AppSettings.ReadString(asFontName); + Editor.Font.Size := AppSettings.ReadInt(asFontSize); + Editor.Gutter.BorderColor := GetThemeColor(clWindow); + Editor.Gutter.Font.Name := Editor.Font.Name; + Editor.Gutter.Font.Size := Editor.Font.Size; + Editor.Gutter.Font.Color := BaseEditor.Gutter.Font.Color; + Editor.Gutter.AutoSize := BaseEditor.Gutter.AutoSize; + Editor.Gutter.DigitCount := BaseEditor.Gutter.DigitCount; + Editor.Gutter.LeftOffset := BaseEditor.Gutter.LeftOffset; + Editor.Gutter.RightOffset := BaseEditor.Gutter.RightOffset; + Editor.Gutter.ShowLineNumbers := BaseEditor.Gutter.ShowLineNumbers; + if Editor <> SynMemoSQLLog then begin + Editor.WordWrap := actQueryWordWrap.Checked; + // Assignment of OnScanForFoldRanges event is required for UseCodeFolding + Editor.OnScanForFoldRanges := BaseEditor.OnScanForFoldRanges; + Editor.UseCodeFolding := actCodeFolding.Checked; + end; + Editor.ActiveLineColor := StringToColor(AppSettings.ReadString(asSQLColActiveLine)); + Editor.Options := BaseEditor.Options; + if Editor = SynMemoSQLLog then + Editor.Options := Editor.Options + [eoRightMouseMovesCursor]; + Editor.TabWidth := AppSettings.ReadInt(asTabWidth); + Editor.MaxScrollWidth := BaseEditor.MaxScrollWidth; + Editor.WantTabs := BaseEditor.WantTabs; + Editor.HintMode := BaseEditor.HintMode; + Editor.OnKeyPress := BaseEditor.OnKeyPress; + Editor.OnMouseWheel := BaseEditor.OnMouseWheel; + Editor.OnTokenHint := BaseEditor.OnTokenHint; + if Editor <> SynMemoSQLLog then begin + Editor.OnPaintTransient := BaseEditor.OnPaintTransient; + end; + // Don't reapply shortcuts to base editor again, see issue 1600 + if Editor <> BaseEditor then begin + Editor.Keystrokes := BaseEditor.KeyStrokes; + end; +end;} + + +{procedure TMainForm.actReformatSQLExecute(Sender: TObject); +var + m: TCustomSynEdit; + CursorPosStart, CursorPosEnd: Integer; + Done: Boolean; +begin + // Reformat SQL query + m := ActiveSynMemo(False); + if not Assigned(m) then begin + ErrorDialog(_('Cannot reformat'), _('Please select a non-readonly SQL editor first.')); + Exit; + end; + CursorPosStart := m.SelStart; + CursorPosEnd := m.SelEnd; + if not m.SelAvail then + m.SelectAll; + if m.SelLength = 0 then + ErrorDialog(_('Cannot reformat'), _('The current editor is empty.')) + else begin + frmReformatter := TfrmReformatter.Create(Self); + frmReformatter.InputCode := m.SelText; + if AppSettings.ReadInt(asReformatterNoDialog) <> 0 then begin + frmReformatter.btnOkClick(Self); + Done := True; + end + else begin + Done := frmReformatter.ShowModal = mrOk; + end; + if Done then begin + Screen.Cursor := crHourglass; + m.UndoList.AddGroupBreak; + m.SelText := frmReformatter.OutputCode; + m.SelStart := CursorPosStart; + if CursorPosEnd > CursorPosStart then + m.SelEnd := CursorPosStart + Length(frmReformatter.OutputCode); + m.UndoList.AddGroupBreak; + Screen.Cursor := crDefault; + end; + frmReformatter.Free; + end; +end;} + + +{procedure TMainForm.PageControlMainContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); +var + ClickPoint: TPoint; + TabsHeight: Integer; +begin + // Activate tab popup menu only when clicked on tabs area. + TabsHeight := (FBtnAddTab.Height+2) * PageControlMain.RowCount; + if MousePos.Y <= TabsHeight then begin + ClickPoint := PageControlMain.ClientToScreen(MousePos); + popupMainTabs.Popup(ClickPoint.X, ClickPoint.Y); + Handled := True; + end else + Handled := False; +end;} + + +{procedure TMainForm.menuQueryHelpersGenerateStatementClick(Sender: TObject); +var + MenuItem: TMenuItem; + sql, Val, WhereClause: String; + i, idx: Integer; + ColumnNames, DefaultValues: TStringList; + KeyColumns: TTableColumnList; + Column: TTableColumn; + Tree: TVirtualStringTree; + Node: PVirtualNode; +begin + // Generate SELECT, INSERT, UPDATE or DELETE query using selected columns + MenuItem := (Sender as TMenuItem); + ColumnNames := TStringList.Create; + DefaultValues := TStringList.Create; + Tree := QueryTabs.ActiveHelpersTree; + Node := Tree.GetFirstChild(FindNode(Tree, TQueryTab.HelperNodeColumns, nil)); + while Assigned(Node) do begin + if Tree.Selected[Node] then begin + Column := SelectedTableColumns[Node.Index]; + ColumnNames.Add(Column.Connection.QuoteIdent(Tree.Text[Node, 0], False)); + case Column.DataType.Category of + dtcInteger, dtcReal: Val := '0'; + dtcText, dtcOther: begin + Val := Column.Connection.EscapeString(Column.DefaultText); + if Column.DefaultType in [cdtNull] then + Val := Column.Connection.EscapeString('') + else + Val := Column.Connection.EscapeString(Column.DefaultText); + end; + dtcTemporal: Val := 'NOW()'; + else Val := 'NULL'; + end; + if Column.DefaultType = cdtAutoInc then + Val := 'NULL'; + DefaultValues.Add(Val); + end; + Node := Tree.GetNextSibling(Node); + end; + KeyColumns := ActiveConnection.GetKeyColumns(SelectedTableColumns, SelectedTableKeys); + WhereClause := ''; + for i:=0 to KeyColumns.Count-1 do begin + idx := ColumnNames.IndexOf(ActiveConnection.QuoteIdent(KeyColumns[i].Name, False)); + if idx > -1 then begin + if WhereClause <> '' then + WhereClause := WhereClause + ' AND '; + WhereClause := WhereClause + ActiveConnection.QuoteIdent(KeyColumns[i].Name, False)+'='+DefaultValues[idx]; + end; + end; + + + if MenuItem = menuQueryHelpersGenerateSelect then begin + sql := 'SELECT ' + Implode(', ', ColumnNames) + SLineBreak + + CodeIndent + 'FROM '+ActiveDbObj.QuotedName(False); + + end else if MenuItem = menuQueryHelpersGenerateInsert then begin + sql := 'INSERT INTO ' + ActiveDbObj.QuotedName(False) + SLineBreak + + CodeIndent + '(' + Implode(', ', ColumnNames) + ')' + SLineBreak + + CodeIndent + 'VALUES (' + Implode(', ', DefaultValues) + ')'; + + end else if MenuItem = menuQueryHelpersGenerateUpdate then begin + sql := 'UPDATE ' + ActiveDbObj.QuotedName(False) + SLineBreak + CodeIndent + 'SET' + SLineBreak; + if ColumnNames.Count > 0 then begin + for i:=0 to ColumnNames.Count-1 do begin + sql := sql + CodeIndent(2) + ColumnNames[i] + '=' + DefaultValues[i] + ',' + SLineBreak; + end; + Delete(sql, Length(sql)-2, 1); + end else + sql := sql + CodeIndent(2) + '??? # No column names selected!' + SLineBreak; + sql := sql + CodeIndent + 'WHERE ' + WhereClause; + + end else if MenuItem = menuQueryHelpersGenerateDelete then begin + sql := 'DELETE FROM '+ActiveDbObj.QuotedName(False)+' WHERE ' + WhereClause; + + end; + QueryTabs.ActiveMemo.UndoList.AddGroupBreak; + QueryTabs.ActiveMemo.SelText := sql; +end;} + + +{procedure TMainForm.DBtreeAfterCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellRect: TRect); +var + Obj: PDBObject; +begin + // Paint favorite icon on table node + if Column <> 0 then + Exit; + Obj := Sender.GetNodeData(Node); + if Obj.NodeType in [lntTable..lntEvent] then begin + if Obj.Connection.Favorites.IndexOf(Obj.Path) > -1 then + VirtualImageListMain.Draw(TargetCanvas, CellRect.Left, CellRect.Top, 168) + else if Node = Sender.HotNode then + VirtualImageListMain.Draw(TargetCanvas, CellRect.Left, CellRect.Top, 183); + end; +end;} + + +{procedure TMainForm.DBtreeMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + Obj: PDBObject; + Node: PVirtualNode; + idx: Integer; +begin + // Watch out for clicks on favorite icon + // Add or remove object path from favorite list on click + Node := DBtree.GetNodeAt(X, Y); + if (Button = mbLeft) and (X < VirtualImageListMain.Width) and Assigned(Node) then begin + Obj := DBtree.GetNodeData(Node); + if Obj.NodeType in [lntTable..lntEvent] then begin + idx := Obj.Connection.Favorites.IndexOf(Obj.Path); + if idx > -1 then + Obj.Connection.Favorites.Delete(idx) + else + Obj.Connection.Favorites.Add(Obj.Path); + DBtree.RepaintNode(Node); + AppSettings.SessionPath := Obj.Connection.Parameters.SessionPath; + AppSettings.WriteString(asFavoriteObjects, Obj.Connection.Favorites.Text); + end; + end; +end;} + + +{procedure TMainForm.DBtreeBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + var ContentRect: TRect); +var + DBObj: PDBObject; + AllObjects: TDBObjectList; +begin + if CellPaintMode=cpmPaint then try + DBObj := Sender.GetNodeData(Node); + if DbObj.Connection.Parameters.SessionColor <> AppSettings.GetDefaultInt(asTreeBackground) then begin + TargetCanvas.Brush.Color := DbObj.Connection.Parameters.SessionColor; + TargetCanvas.FillRect(CellRect); + end; + if (Column=1) and DBObj.Connection.DbObjectsCached(DBObj.Database) then begin + AllObjects := DBObj.Connection.GetDBObjects(DBObj.Database); + PaintColorBar(DBObj.Size, AllObjects.LargestObjectSize, TargetCanvas, CellRect); + end; + except; // Silence sporadic EAccessViolation when reading DbObj.Connection.Parameters, found in uploaded reports + end; +end;} + + +{procedure TMainForm.DBtreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode); +var + VT: TVirtualStringTree; +begin + // Resize "Size" column in dbtree to hold widest possible byte numbers without cutting text + VT := Sender as TVirtualStringTree; + if (VT.Header.Columns.Count >= 2) and (coVisible in VT.Header.Columns[1].Options) then + VT.Header.Columns[1].Width := TextWidth(VT.Canvas, FormatByteNumber(SIZE_MB*100)) + VT.TextMargin*2 + 8; +end;} + + +{procedure TMainForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; + var Handled: Boolean); +var + Control: TWinControl; + VT: TBaseVirtualTree; + PageControl: TPageControl; +begin + // Wheel scrolling only works in component which has focus. Help out by doing that by hand at least for any VirtualTree. + // See http://www.delphipraxis.net/viewtopic.php?p=1113607 + // TODO: Does not work when a SynMemo has focus, probably related to the broken solution of this issue: + // http://sourceforge.net/tracker/index.php?func=detail&aid=1574059&group_id=3221&atid=103221 + Control := FindVCLWindow(MousePos); + if (Control is TBaseVirtualTree) and (not Control.Focused) and PtInRect(Control.ClientRect, Control.ScreenToClient(MousePos)) then begin + VT := Control as TBaseVirtualTree; + VT.OffsetY := VT.OffsetY + (WheelDelta div 2); // Don't know why, but WheelDelta is twice as big as it normally appears + VT.UpdateScrollBars(True); + Handled := True; + end else if Control is TPageControl then begin + // Scroll tabs horizontally per mouse wheel + PageControl := Control as TPageControl; + if PageControl.MultiLine then begin + Handled := False; + end + else begin + PageControl.ScrollTabs(WheelDelta div WHEEL_DELTA); + if PageControl = PageControlMain then + FixQueryTabCloseButtons; + Handled := True; + end; + end else + Handled := False; +end;} + + +{procedure TMainForm.actDataResetSortingExecute(Sender: TObject); +begin + FDataGridSortItems.Clear; + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); +end;} + + +{procedure TMainForm.WMCopyData(var Msg: TWMCopyData); +var + i: Integer; + Connection: TDBConnection; + Tab: TQueryTab; + ConnectionParams: TConnectionParameters; + FileNames: TStringList; + RunFrom: String; +begin + // Probably a second instance is posting its command line parameters here + if (Msg.CopyDataStruct.dwData = SecondInstMsgId) and (SecondInstMsgId <> 0) then begin + LogSQL(f_('Preventing second application instance - disabled in %s > %s > %s.', [_('Tools'), _('Preferences'), _('General')]), lcInfo); + ConnectionParams := nil; + ParseCommandLine(ParamBlobToStr(Msg.CopyDataStruct.lpData), ConnectionParams, FileNames, RunFrom); + if not RunQueryFiles(FileNames, nil, False) then begin + for i:=0 to FileNames.Count-1 do begin + Tab := GetOrCreateEmptyQueryTab(True); + Tab.LoadContents(FileNames[i], True, nil); + end; + end; + if ConnectionParams <> nil then + InitConnection(ConnectionParams, True, Connection); + end else + // Not the right message id + inherited; +end;} + + +{procedure TMainForm.CMStyleChanged(var Msg: TMessage); +begin + // Style theme applied, e.g. via preferences dialog + // Ensure SynMemo's have fitting colors + SetupSynEditors; +end;} + + +{procedure TMainForm.DefaultHandler(var Message); +begin + if TMessage(Message).Msg = SecondInstMsgId then begin + // A second instance asked for our handle. Post that into its message queue. + PostThreadMessage(TMessage(Message).WParam, SecondInstMsgId, Handle, 0); + end else + // Otherwise do what would happen without this overridden procedure + inherited; +end;} + + +{procedure TMainForm.actBlobAsTextExecute(Sender: TObject); +begin + // Activate displaying BLOBs as text data, ignoring possible weird effects in grid updates/inserts + DataGrid.InvalidateChildren(nil, True); +end;} + + +{procedure TMainForm.AnyGridScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); +begin + // A tree gets scrolled only when the mouse is over it - see FormMouseWheel + // Our home brewn cell editors do not reposition when the underlying tree scrolls. + // To avoid confusion, terminate editors then. + if Sender.IsEditing and (DeltaX=0) then + Sender.EndEditNode; +end;} + + +{procedure TMainForm.lblExplainProcessClick(Sender: TObject); +var + Tab: TQueryTab; + UsedDatabase: String; +begin + // Click on "Explain" link label, in process viewer + actNewQueryTabExecute(Sender); + Tab := QueryTabs[QueryTabs.Count-1]; + UsedDatabase := listProcesses.Text[listProcesses.FocusedNode, 3]; + if not UsedDatabase.IsEmpty then begin + Tab.Memo.Lines.Add('USE ' + ActiveConnection.QuoteIdent(UsedDatabase) + ';'); + end; + Tab.Memo.Lines.Add('EXPLAIN' + sLineBreak + SynMemoProcessView.Text + ';'); + Tab.TabSheet.Show; + actExecuteQueryExecute(Sender); +end;} + + +{procedure TMainForm.UpdateLineCharPanel; +var + x, y: Int64; + Grid: TVirtualStringTree; + AppendMsg: String; +begin + // Fill panel with "Line:Char" + x := -1; + y := -1; + AppendMsg := ''; + Grid := ActiveGrid; + if Assigned(Grid) and Grid.Focused then begin + if Assigned(Grid.FocusedNode) then + y := Grid.FocusedNode.Index+1; + x := Grid.FocusedColumn+1; + if Grid.SelectedCount > 1 then + AppendMsg := ' ('+FormatNumber(Grid.SelectedCount)+' sel)'; + end else if QueryTabs.HasActiveTab and QueryTabs.ActiveMemo.Focused then begin + x := QueryTabs.ActiveMemo.CaretX; + y := QueryTabs.ActiveMemo.CaretY; + AppendMsg := ' ('+FormatByteNumber(QueryTabs.ActiveMemo.GetTextLen)+')'; + end; + if (x > -1) and (y > -1) then begin + ShowStatusMsg('r'+FormatNumber(y)+' : c'+FormatNumber(x) + AppendMsg, 1) + end else + ShowStatusMsg('', 1); +end;} + +{procedure TMainForm.AnyGridStartOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); +begin + // Display status message on long running sort operations + if not MainFormCreated then begin + // Do nothing before form is not ready to process messages, what OperationRunning silently does. + // See issue #665 + Exit; + end; + if OperationKind = okSortTree then begin + ShowStatusMsg(_('Sorting grid nodes ...')); + FOperatingGrid := Sender; + OperationRunning(True); + end; +end;} + + +{procedure TMainForm.AnyGridEndOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); +begin + // Reset status message after long running operations + if OperationKind = okSortTree then begin + ShowStatusMsg; + FOperatingGrid := nil; + OperationRunning(False); + end; +end;} + + +{procedure TMainForm.actCancelOperationExecute(Sender: TObject); +var + Killer: TDBConnection; + KillCommand: String; + Tab: TQueryTab; +begin + // Stop current operation (sorting grid or running user queries) + if FOperatingGrid <> nil then begin + FOperatingGrid.CancelOperation; + LogSQL(_('Sorting cancelled.')); + end; + for Tab in QueryTabs do begin + if Tab.QueryRunning then begin + Tab.ExecutionThread.Aborted := True; + Killer := ActiveConnection.Parameters.CreateConnection(Self); + Killer.Parameters := ActiveConnection.Parameters; + Killer.LogPrefix := _('Helper connection'); + Killer.OnLog := LogSQL; + try + Killer.Active := True; + KillCommand := Killer.GetSQLSpecifity(spKillQuery, [ActiveConnection.ThreadId]); + Killer.Query(KillCommand); + except + on E:EDbError do begin + MessageDialog(E.Message, mtError, [mbOK]); + end; + end; + Killer.Active := False; + Killer.Free; + end; + end; +end;} + + +{procedure TMainForm.OperationRunning(Runs: Boolean); +begin + if actCancelOperation.Enabled <> Runs then begin + actCancelOperation.ImageIndex := 159; + actCancelOperation.Enabled := Runs; + FOperationTicker := IfThen(Runs, GetTickCount, 0); + Application.ProcessMessages; + end else if Runs then begin + if (GetTickCount-FOperationTicker) > 250 then begin + // Signalize running operation + if actCancelOperation.ImageIndex = 159 then + actCancelOperation.ImageIndex := 160 + else + actCancelOperation.ImageIndex := 159; + Application.ProcessMessages; + FOperationTicker := GetTickCount; + end; + end; +end;} + + +{function TMainForm.GetEncodingByName(Name: String): TEncoding; +begin + Result := nil; + case FileEncodings.IndexOf(Name) of + 1: Result := TEncoding.Default; + 2: Result := TEncoding.GetEncoding(437); + 3: Result := TEncoding.Unicode; + 4: Result := TEncoding.BigEndianUnicode; + 5: Result := UTF8NoBOMEncoding; + 6: Result := TEncoding.UTF7; + 7: Result := TEncoding.UTF8; + end; +end;} + + +{function TMainForm.GetEncodingName(Encoding: TEncoding): String; +var + idx: Integer; +begin + if Encoding = TEncoding.Default then idx := 1 + else if (Encoding <> nil) and (Encoding.CodePage = 437) then idx := 2 + else if Encoding = TEncoding.Unicode then idx := 3 + else if Encoding = TEncoding.BigEndianUnicode then idx := 4 + else if Encoding = UTF8NoBOMEncoding then idx := 5 + else if Encoding = TEncoding.UTF7 then idx := 6 + else if Encoding = TEncoding.UTF8 then idx := 7 + else idx := 0; + Result := FileEncodings[idx]; +end;} + + +{function TMainForm.GetCharsetByEncoding(Encoding: TEncoding): String; +begin + Result := ''; + if Encoding = TEncoding.Default then begin + // Listing taken from http://forge.mysql.com/worklog/task.php?id=1349 + case GetACP of + 437: Result := 'cp850'; + 850: Result := 'cp850'; + 852: Result := 'cp852'; + 858: Result := 'cp850'; + 866: Result := 'cp866'; + 874: Result := 'tis620'; + 932: Result := 'cp932'; + 936: Result := 'gbk'; + 949: Result := 'euckr'; + 959: Result := 'big5'; + 1200: Result := 'utf16le'; + 1201: Result := 'utf16'; + 1250: Result := 'latin2'; + 1251: Result := 'cp1251'; + 1252: Result := 'latin1'; + 1253: Result := 'greek'; + 1254: Result := 'latin5'; + 1255: Result := 'hebrew'; + 1256: Result := 'cp1256'; + 1257: Result := 'cp1257'; + 10000: Result := 'macroman'; + 10001: Result := 'sjis'; + 10002: Result := 'big5'; + 10008: Result := 'gb2312'; + 10021: Result := 'tis620'; + 10029: Result := 'macce'; + 12001: Result := 'utf32'; + 20107: Result := 'swe7'; + 20127: Result := 'ascii'; + 20866: Result := 'koi8r'; + 20932: Result := 'ujis'; + 20936: Result := 'gb2312'; + 20949: Result := 'euckr'; + 21866: Result := 'koi8u'; + 28591: Result := 'latin1'; + 28592: Result := 'latin2'; + 28597: Result := 'greek'; + 28598: Result := 'hebrew'; + 28599: Result := 'latin5'; + 28603: Result := 'latin7'; + 28605: Result := 'latin9'; + 38598: Result := 'hebrew'; + 51932: Result := 'ujis'; + 51936: Result := 'gb2312'; + 51949: Result := 'euckr'; + 51950: Result := 'big5'; + 54936: Result := 'gb18030'; + 65001: Result := 'utf8'; + end; + end else if (Encoding <> nil) and (Encoding.CodePage = 437) then + Result := 'ascii' + else if Encoding = TEncoding.Unicode then + Result := 'utf16le' + else if Encoding = TEncoding.BigEndianUnicode then + Result := 'utf16' + else if Encoding = UTF8NoBOMEncoding then + Result := 'utf8' + else if Encoding = TEncoding.UTF7 then + Result := 'utf7' + else if Encoding = TEncoding.UTF8 then + Result := 'utf8' + // Auto-detection not supported here +end;} + + +{procedure TMainForm.treeQueryHelpersBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + var ContentRect: TRect); +var + Tab: TQueryTab; + History: TQueryHistory; +begin + // Paint green value bar in cell + if (Node.Parent.Index=TQueryTab.HelperNodeProfile) + and (Column=1) + and (Sender.GetNodeLevel(Node)=1) + then begin + Tab := QueryTabs.TabByControl(Sender); + if Tab <> nil then begin + Tab.QueryProfile.RecNo := Node.Index; + PaintColorBar(MakeFloat(Tab.QueryProfile.Col(Column)), Tab.MaxProfileTime, TargetCanvas, CellRect); + end; + end; + if (Sender.GetNodeLevel(Node)=2) + and (Column=1) + and (Node.Parent.Parent.Index=TQueryTab.HelperNodeHistory) then begin + Tab := QueryTabs.TabByControl(Sender); + if Tab <> nil then begin + History := Tab.HistoryDays.Objects[Node.Parent.Index] as TQueryHistory; + PaintColorBar(History[Node.Index].Duration, History.MaxDuration, TargetCanvas, CellRect); + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); +var + History: TQueryHistory; + Tab: TQueryTab; +begin + // Paint text in datatype's color + if (Node.Parent.Index=TQueryTab.HelperNodeColumns) + and (Column=1) + and (Sender.GetNodeLevel(Node)=1) + and (ActiveDbObj.NodeType in [lntView, lntTable]) + then begin + TargetCanvas.Font.Color := DatatypeCategories[SelectedTableColumns[Node.Index].DataType.Category].Color; + end; + if (Sender.GetNodeLevel(Node)=2) + and (Node.Parent.Parent.Index=TQueryTab.HelperNodeHistory) + and (ActiveConnection <> nil) then begin + Tab := QueryTabs.TabByControl(Sender); + if Tab <> nil then begin + History := Tab.HistoryDays.Objects[Node.Parent.Index] as TQueryHistory; + if ActiveConnection.Database <> History[Node.Index].Database then + TargetCanvas.Font.Color := GetThemeColor(clGrayText); + end; + end; + + // If there is no value for bind variable, the font style is Italic and Underline + if (Sender.GetNodeLevel(Node)=1) + and (Column=1) + and (Node.Parent.Index=TQueryTab.HelperNodeBinding) then begin + Tab := QueryTabs.TabByControl(Sender); + if StrLen(PChar(Tab.ListBindParams.Items[Node.Index].Value)) = 0 then + TargetCanvas.Font.Style := [fsItalic]+[fsUnderline]; + + TargetCanvas.Font.Color := GetThemeColor(clGrayText); + + end; + +end;} + + +{procedure TMainForm.treeQueryHelpersResize(Sender: TObject); +var + Tree: TVirtualStringTree; +begin + // Resizing query helpers box: Keep second column at a minimum width. + Tree := Sender as TVirtualStringTree; + if Tree.Header.Columns.Count >= 2 then begin + // See https://github.com/HeidiSQL/HeidiSQL/issues/466 + // Column count may be 0 in an early stage of creating a new query tab + Tree.Header.Columns[1].Width := Max(Tree.Width div 3, 100); + end; +end;} + + +{procedure TMainForm.treeQueryHelpersDblClick(Sender: TObject); +var + m: TSynMemo; +begin + m := QueryTabs.ActiveMemo; + m.DragDrop(Sender, m.CaretX, m.CaretY); +end;} + + +{procedure TMainForm.treeQueryHelpersEditing(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); +begin + // If current column is value of Bind Param, we allow editing + if (Column = 1) + and (Sender.FocusedNode.Parent.Index = TQueryTab.HelperNodeBinding) then begin + Allowed := True; + end +end;} + + +{procedure TMainForm.treeQueryHelpersFocusChanging(Sender: TBaseVirtualTree; OldNode, + NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); +var + Tree: TVirtualStringTree; +begin + // Disable multi selection when snippet node is focused + Tree := Sender as TVirtualStringTree; + if not Assigned(NewNode) then + Exit; + if (Tree.GetNodeLevel(NewNode) = 0) or + (NewNode.Parent.Index=TQueryTab.HelperNodeSnippets) + then begin + Tree.ClearSelection; + Tree.TreeOptions.SelectionOptions := Tree.TreeOptions.SelectionOptions - [toMultiSelect] + end else + Tree.TreeOptions.SelectionOptions := Tree.TreeOptions.SelectionOptions + [toMultiSelect]; +end;} + + +{procedure TMainForm.treeQueryHelpersFreeNode(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + Tab: TQueryTab; +begin + // Free some memory, taken by probably big SQL query history items + if (Sender.GetNodeLevel(Node)=1) + and (Node.Parent.Index = TQueryTab.HelperNodeHistory) then begin + Tab := QueryTabs.TabByControl(Sender); + if Tab <> nil then begin + Tab.HistoryDays.Objects[Node.Index].Free; + Tab.HistoryDays.Delete(Node.Index); + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); +begin + // Query helpers tree fetching node icon index + if not (Kind in [ikNormal, ikSelected]) then + Exit; + if Column <> 0 then + Exit; + case Sender.GetNodeLevel(Node) of + 0: case Node.Index of + TQueryTab.HelperNodeColumns: if (ActiveDbObj <> nil) and (ActiveDbObj.NodeType <> lntNone) then + ImageIndex := ActiveDbObj.ImageIndex + else + ImageIndex := 14; + TQueryTab.HelperNodeFunctions: ImageIndex := 13; + TQueryTab.HelperNodeKeywords: ImageIndex := 25; + TQueryTab.HelperNodeSnippets: ImageIndex := 51; + TQueryTab.HelperNodeHistory: ImageIndex := 149; + TQueryTab.HelperNodeProfile: ImageIndex := 145; + TQueryTab.HelperNodeBinding: ImageIndex := 119; + end; + 1: case Node.Parent.Index of + TQueryTab.HelperNodeColumns: ImageIndex := 42; + TQueryTab.HelperNodeFunctions: ImageIndex := 13; + TQueryTab.HelperNodeKeywords: ImageIndex := 25; + TQueryTab.HelperNodeSnippets: ImageIndex := 68; + TQueryTab.HelperNodeHistory: ImageIndex := 80; + TQueryTab.HelperNodeProfile: ImageIndex := 145; + TQueryTab.HelperNodeBinding: ImageIndex := 42; + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +var + History: TQueryHistory; + Tab: TQueryTab; + Conn: TDBConnection; +begin + // Query helpers tree fetching node text + CellText := ''; + Tab := QueryTabs.TabByControl(Sender); + case Column of + 0: case Sender.GetNodeLevel(Node) of + 0: case Node.Index of + TQueryTab.HelperNodeColumns: begin + CellText := _('Columns'); + if ActiveDbObj <> nil then case ActiveDbObj.NodeType of + lntProcedure, lntFunction: CellText := f_('Parameters in %s', [ActiveDbObj.Name]); + lntTable, lntView: CellText := f_('Columns in %s', [ActiveDbObj.Name]); + end; + end; + TQueryTab.HelperNodeFunctions: CellText := _('SQL functions'); + TQueryTab.HelperNodeKeywords: CellText := _('SQL keywords'); + TQueryTab.HelperNodeSnippets: CellText := _('Snippets'); + TQueryTab.HelperNodeHistory: CellText := _('Query history'); + TQueryTab.HelperNodeProfile: begin + CellText := _('Query profile'); + if Assigned(Tab.QueryProfile) then + CellText := CellText + ' ('+FormatNumber(Tab.ProfileTime, 6)+'s)'; + end; + TQueryTab.HelperNodeBinding: begin + CellText := _('Bind parameters'); + if(Tab.BindParamsActivated) then + CellText := CellText + ' ('+FormatNumber(Tab.ListBindParams.Count)+')'; + end; + end; + 1: case Node.Parent.Index of + TQueryTab.HelperNodeColumns: begin + if ActiveDbObj <> nil then case ActiveDbObj.NodeType of + lntTable, lntView: + if SelectedTableColumns.Count > Integer(Node.Index) then + CellText := SelectedTableColumns[Node.Index].Name; + lntFunction, lntProcedure: + if Assigned(ActiveObjectEditor) then + CellText := TfrmRoutineEditor(ActiveObjectEditor).Parameters[Node.Index].Name; + end; + end; + TQueryTab.HelperNodeFunctions: begin + Conn := ActiveConnection; + if (Conn <> nil) and (Conn.SQLFunctions.Count > Integer(Node.Index)) then + CellText := Conn.SQLFunctions[Node.Index].Name; + end; + TQueryTab.HelperNodeKeywords: CellText := MySQLKeywords[Node.Index]; + TQueryTab.HelperNodeSnippets: CellText := IfThen(Node.Index < Cardinal(FSnippetFilenames.Count), FSnippetFilenames[Node.Index], ''); + TQueryTab.HelperNodeHistory: begin + CellText := Tab.HistoryDays[Node.Index]; + if CellText = DateToStr(Today) then + CellText := CellText + ', '+_('today') + else if CellText = DateToStr(Yesterday) then + CellText := CellText + ', '+_('yesterday'); + end; + TQueryTab.HelperNodeProfile: begin + if Assigned(Tab.QueryProfile) then begin + Tab.QueryProfile.RecNo := Node.Index; + CellText := Tab.QueryProfile.Col(Column); + end; + end; + TQueryTab.HelperNodeBinding: CellText := Tab.ListBindParams[Node.Index].Name; + end; + 2: case Node.Parent.Parent.Index of + TQueryTab.HelperNodeHistory: begin + History := Tab.HistoryDays.Objects[Node.Parent.Index] as TQueryHistory; + CellText := Copy(TimeToStr(History[Node.Index].Time), 1, 5)+': '+History[Node.Index].SQL; + end + else CellText := ''; // unused + end; + end; + 1: case Sender.GetNodeLevel(Node) of + 0: CellText := ''; + 1: case Node.Parent.Index of + TQueryTab.HelperNodeColumns: begin + if (ActiveDbObj <> nil) + and (ActiveDbObj.NodeType in [lntTable, lntView]) + and (SelectedTableColumns.Count > Integer(Node.Index)) then begin + CellText := SelectedTableColumns[Node.Index].DataType.Name; + end; + end; + TQueryTab.HelperNodeFunctions: begin + Conn := ActiveConnection; + if (Conn <> nil) and (Conn.SQLFunctions.Count > Integer(Node.Index)) then + CellText := Conn.SQLFunctions[Node.Index].Declaration; + end; + TQueryTab.HelperNodeProfile: begin + if Assigned(Tab.QueryProfile) then begin + Tab.QueryProfile.RecNo := Node.Index; + CellText := FormatNumber(Tab.QueryProfile.Col(Column))+'s'; + end; + end; + TQueryTab.HelperNodeBinding: begin + // If value is empty, display MsgBindParamNoValue + if StrLen(PChar(Tab.ListBindParams[Node.Index].Value))>0 then + CellText := Tab.ListBindParams[Node.Index].Value + else + CellText := _('Set value'); + end; + else CellText := ''; + end; + 2: case Node.Parent.Parent.Index of + TQueryTab.HelperNodeHistory: begin + History := Tab.HistoryDays.Objects[Node.Parent.Index] as TQueryHistory; + CellText := FormatNumber(History[Node.Index].Duration / 1000, 3)+'s'; + end; + end; + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersInitNode(Sender: TBaseVirtualTree; ParentNode, + Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); +begin + // Query helpers tree asking if plus/minus button should be displayed + case Sender.GetNodeLevel(Node) of + 0: begin + Include(InitialStates, ivsHasChildren); + if Node.Index = TQueryTab.HelperNodeProfile then + Node.CheckType := ctCheckbox; + if Node.Index = TQueryTab.HelperNodeBinding then + Node.CheckType := ctCheckbox; + end; + 1: begin + AppSettings.ResetPath; + if (Node.Parent.Index = TQueryTab.HelperNodeHistory) and AppSettings.ReadBool(asQueryHistoryEnabled) then + Include(InitialStates, ivsHasChildren); + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersNewText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; NewText: string); +var + Tree: TVirtualStringTree; + QueryTab: TQueryTab; +begin + Tree:= Sender as TVirtualStringTree; + QueryTab := QueryTabs.ActiveTab; + + // Save new param value + QueryTab.ListBindParams.Items[Sender.FocusedNode.Index].Value := NewText; + + Tree.RepaintNode(Node); +end;} + + +{procedure TMainForm.treeQueryHelpersNodeClick(Sender: TBaseVirtualTree; + const HitInfo: THitInfo); +var + Tree: TVirtualStringTree; +begin + Tree := Sender as TVirtualStringTree; + // If the column is clicked a parameter value, it goes directly into the edit mode + if (HitInfo.HitNode.Parent.Index = TQueryTab.HelperNodeBinding) and (HitInfo.HitColumn = 1) then + Tree.EditNode(Sender.FocusedNode,Sender.FocusedColumn); +end;} + + +{procedure TMainForm.treeQueryHelpersInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; + var ChildCount: Cardinal); +var + QueryDay: String; + History: TQueryHistory; + Item: TQueryHistoryItem; + Tab: TQueryTab; + i: Integer; + Conn: TDBConnection; +begin + Tab := QueryTabs.TabByControl(Sender); + Conn := ActiveConnection; + case Sender.GetNodeLevel(Node) of + 0: case Node.Index of + TQueryTab.HelperNodeColumns: begin + ChildCount := 0; + if ActiveDbObj <> nil then case ActiveDbObj.NodeType of + lntTable, lntView: + ChildCount := SelectedTableColumns.Count; + lntFunction, lntProcedure: + if Assigned(ActiveObjectEditor) then + ChildCount := TfrmRoutineEditor(ActiveObjectEditor).Parameters.Count + else + ChildCount := 0; + end; + end; + TQueryTab.HelperNodeFunctions: ChildCount := ActiveConnection.SQLFunctions.Count; + TQueryTab.HelperNodeKeywords: ChildCount := MySQLKeywords.Count; + TQueryTab.HelperNodeSnippets: ChildCount := FSnippetFilenames.Count; + TQueryTab.HelperNodeHistory: begin + AppSettings.ResetPath; + if AppSettings.ReadBool(asQueryHistoryEnabled) and (Conn <> nil) then begin + // Find all unique days in history + if not Assigned(Tab.HistoryDays) then + Tab.HistoryDays := TStringList.Create; + Tab.HistoryDays.Clear; + History := TQueryHistory.Create(Conn.Parameters.SessionPath); + for Item in History do begin + QueryDay := DateToStr(Item.Time); + if Tab.HistoryDays.IndexOf(QueryDay) = -1 then + Tab.HistoryDays.Add(QueryDay); + end; + History.Free; + Tab.HistoryDays.CustomSort(StringListCompareAnythingDesc); + ChildCount := Tab.HistoryDays.Count; + end; + end; + TQueryTab.HelperNodeProfile: if not Assigned(Tab.QueryProfile) then ChildCount := 0 + else ChildCount := Tab.QueryProfile.RecordCount; + TQueryTab.HelperNodeBinding: ChildCount := Tab.ListBindParams.Count; + end; + 1: case Node.Parent.Index of + TQueryTab.HelperNodeHistory: begin + if Conn <> nil then begin + History := TQueryHistory.Create(Conn.Parameters.SessionPath); + Tab.HistoryDays.Objects[Node.Index] := History; + for i:=History.Count-1 downto 0 do begin + QueryDay := DateToStr(History[i].Time); + if QueryDay <> Tab.HistoryDays[Node.Index] then + History.Delete(i); + end; + ChildCount := History.Count; + end; + end; + else ChildCount := 0; + end; + end; +end;} + + +{procedure TMainForm.SetSnippetFilenames; +var + Files: TStringDynArray; + Snip: String; + i: Integer; +begin + // Refreshing list of snippet file names needs to refresh helper node too + if not Assigned(FSnippetFilenames) then + FSnippetFilenames := TStringList.Create; + FSnippetFilenames.Clear; + try + Files := TDirectory.GetFiles(AppSettings.DirnameSnippets, '*.sql'); + for i:=0 to Length(Files)-1 do begin + Snip := ExtractFilename(Files[i]); + Snip := Copy(Snip, 1, Length(Snip)-4); + FSnippetFilenames.Add(snip); + end; + FSnippetFilenames.Sort; + except + on E:Exception do begin + LogSQL(f_('Error with snippets directory: %s', [E.Message]), lcError); + end; + end; + RefreshHelperNode(TQueryTab.HelperNodeSnippets); +end;} + + +{procedure TMainForm.treeQueryHelpersChecking(Sender: TBaseVirtualTree; + Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean); +var + Tab: TQueryTab; + Tree: TVirtualStringTree; +begin + Tree := Sender as TVirtualStringTree; + Tab := QueryTabs.TabByControl(Sender); + + case Sender.GetNodeLevel(Node) of + + 0: case Node.Index of + TQueryTab.HelperNodeBinding: begin + // Disallow checkbox clicking on "Bind parameters" when text too big + if NewState in CheckedStates then begin + if Tab.Memo.GetTextLen < SIZE_MB then begin + Allowed := True; + Tab.TimerLastChange.Enabled := False; + Tab.TimerLastChange.Enabled := True; + LogSQL('Bind parameters enabled', lcDebug); + end + else begin + Allowed := False; + MessageDialog(_('The query is too long to enable detection of bind parameters'), mtError, [mbOK]); + end; + end + else begin + Allowed := True; + Tab.ListBindParams.Clear; + NewState := csUncheckedNormal; + Tree.ResetNode(Node); + LogSQL('Bind parameters disabled', lcDebug); + end; + end; + end; + + end; + +end;} + + +{procedure TMainForm.treeQueryHelpersContextPopup(Sender: TObject; MousePos: TPoint; + var Handled: Boolean); +var + Tree: TVirtualStringTree; +begin + Tree := Sender as TVirtualStringTree; + menuQueryHelpersGenerateSelect.Enabled := False; + menuQueryHelpersGenerateInsert.Enabled := False; + menuQueryHelpersGenerateUpdate.Enabled := False; + menuQueryHelpersGenerateDelete.Enabled := False; + menuInsertAtCursor.Enabled := False; + menuLoadSnippet.Enabled := False; + menuDeleteSnippet.Enabled := False; + menuExplore.Enabled := False; + menuHelp.Enabled := False; + menuClearQueryHistory.Enabled := False; + + case Tree.GetNodeLevel(Tree.FocusedNode) of + 0: ; + 1: case Tree.FocusedNode.Parent.Index of + TQueryTab.HelperNodeColumns: begin + if ActiveDbObj.NodeType in [lntTable, lntView] then begin + menuQueryHelpersGenerateSelect.Enabled := True; + menuQueryHelpersGenerateInsert.Enabled := True; + menuQueryHelpersGenerateUpdate.Enabled := True; + menuQueryHelpersGenerateDelete.Enabled := True; + menuInsertAtCursor.Enabled := True; + end; + end; + TQueryTab.HelperNodeFunctions: begin + menuHelp.Enabled := True; + menuInsertAtCursor.Enabled := True; + end; + TQueryTab.HelperNodeKeywords: begin + menuHelp.Enabled := True; + menuInsertAtCursor.Enabled := True; + end; + TQueryTab.HelperNodeSnippets: begin + menuDeleteSnippet.Enabled := True; + menuInsertAtCursor.Enabled := True; + menuLoadSnippet.Enabled := True; + menuExplore.Enabled := True; + end; + TQueryTab.HelperNodeProfile: begin // Query profile + + end; + TQueryTab.HelperNodeHistory: + menuClearQueryHistory.Enabled := True; + end; + 2: case Tree.FocusedNode.Parent.Parent.Index of + TQueryTab.HelperNodeHistory: begin + menuClearQueryHistory.Enabled := True; + menuInsertAtCursor.Enabled := True; + end; + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersCreateEditor(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); +var + InplaceEditor: TInplaceEditorLink; + VT: TVirtualStringTree; +begin + VT := Sender as TVirtualStringTree; + InplaceEditor := TInplaceEditorLink.Create(VT, True, nil); + InplaceEditor.ButtonVisible := true; + EditLink := InplaceEditor; +end;} + + +{procedure TMainForm.RefreshHelperNode(NodeIndex: Cardinal); +var + Tab: TQueryTab; + Node, Child: PVirtualNode; + OldStates: TVirtualNodeStates; + OldCheckState: TCheckState; + ExpandedChildren: TStringList; + Conn: TDBConnection; +begin + if not Assigned(QueryTabs) then + Exit; + Conn := ActiveConnection; + Tab := QueryTabs.ActiveTab; + if Tab = nil then + Exit; + Node := FindNode(Tab.treeHelpers, NodeIndex, nil); + // Store node + children states + OldStates := Node.States; + OldCheckState := Node.CheckState; + ExpandedChildren := TStringList.Create; + Child := Tab.treeHelpers.GetFirstChild(Node); + while Assigned(Child) do begin + if vsExpanded in Child.States then + ExpandedChildren.Add(IntToStr(Child.Index)); + Child := Tab.treeHelpers.GetNextSibling(Child); + end; + // Keep scroll offset + Tab.treeHelpers.BeginUpdate; + // Remove children and grandchildren + Tab.treeHelpers.ResetNode(Node); + // Restore old node + children states + Tab.treeHelpers.CheckState[Node] := OldCheckState; + Tab.treeHelpers.Expanded[Node] := vsExpanded in OldStates; + // Disable profiling when not on MySQL + if (NodeIndex = TQueryTab.HelperNodeProfile) and (Conn <> nil) and (not Conn.Parameters.IsAnyMySQL) then begin + Tab.treeHelpers.CheckState[Node] := csUncheckedNormal; + end; + // Do not check expansion state of children unless the parent node is expanded, to avoid + // initializing children when not required. Accesses registry items when doing so. + if Tab.treeHelpers.Expanded[Node] then begin + Child := Tab.treeHelpers.GetFirstChild(Node); + while Assigned(Child) do begin + Tab.treeHelpers.Expanded[Child] := ExpandedChildren.IndexOf(IntToStr(Child.Index)) > -1; + Child := Tab.treeHelpers.GetNextSibling(Child); + end; + end; + ExpandedChildren.Free; + Tab.treeHelpers.EndUpdate; +end;} + + +{procedure TMainForm.ApplicationEvents1Deactivate(Sender: TObject); +begin + // Force result tab balloon hint to disappear. Does not do so when mouse was moved too fast. + tabsetQueryMouseLeave(Sender); +end;} + + +{procedure TMainForm.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean); +begin + if AppSettings.PortableMode + and (not AppSettings.PortableModeReadOnly) + and (FLastPortableSettingsSave < GetTickCount-60000) then begin + try + if AppSettings.Writes > FLastAppSettingsWrites then begin + if AppSettings.ExportSettings then + LogSQL(f_('Portable settings file written, with %d changes.', [AppSettings.Writes-FLastAppSettingsWrites]), lcDebug); + end; + FLastAppSettingsWrites := AppSettings.Writes; + FLastPortableSettingsSave := GetTickCount; + except + on E:Exception do + ErrorDialog(E.Message); + end; + Done := True; + end; + + // Sort list tables in idle time, so ListTables.TreeOptions.AutoSort does not crash the list + // when dropping a right-clicked database + if (PageControlMain.ActivePage = tabDatabase) and (not FListTablesSorted) then begin + ListTables.SortTree(ListTables.Header.SortColumn, ListTables.Header.SortDirection); + FListTablesSorted := True; + Done := True; + end; + + // Re-enable refresh action when application is idle + if (not actRefresh.Enabled) and (FRefreshActionDisabledAt < (GetTickCount - 1000)) then + begin + actRefresh.Enabled := True; + Done := True; + end; + +end;} + + +{procedure TMainForm.ApplicationEvents1ShortCut(var Msg: TWMKey; + var Handled: Boolean); +var + SendingControl: TComponent; + LastStart: Integer; + Edit: TCustomEdit; + Combo: TComboBox; + rx: TRegExpr; + TextMatches: Boolean; + PressedShortcut: TShortCut; + Act: TContainedAction; +begin + // Support for Ctrl+Backspace shortcut in edit + combobox controls + //LogSQL(msg.CharCode.ToString); + Handled := False; + if (Msg.CharCode = VK_BACK) and KeyPressed(VK_CONTROL) then begin + SendingControl := Screen.ActiveControl; + rx := TRegExpr.Create; + rx.Expression := '\b\W*\w+\W*$'; + if SendingControl is TCustomEdit then begin + Edit := TCustomEdit(SendingControl); + LastStart := Edit.SelStart; + TextMatches := rx.Exec(Copy(Edit.Text, 1, LastStart)); + if TextMatches then begin + Edit.SelStart := rx.MatchPos[0]-1; + Edit.SelLength := LastStart - Edit.SelStart; + // wParam=1 supports undo, in contrast to setting Edit.SelText + if IsWine then + Edit.SelText := '' + else + SendMessage(Edit.Handle, EM_REPLACESEL, 1, LongInt(PChar(''))); + end; + Handled := True; + end + else if SendingControl is TComboBox then begin + Combo := TComboBox(SendingControl); + LastStart := Combo.SelStart; + TextMatches := rx.Exec(Copy(Combo.Text, 1, LastStart)); + if TextMatches then begin + Combo.SelStart := rx.MatchPos[0]-1; + Combo.SelLength := LastStart - Combo.SelStart; + Combo.SelText := ''; + end; + Handled := True; + end; + LogSQL('Caught Ctrl+Backspace shortcut in '+SendingControl.ClassName+ + ', expression "'+rx.Expression+'" matched: '+TextMatches.ToInteger.ToString, + lcDebug); + rx.Free; + + end else begin + // Listen to certain shortcut(s) in other forms than mainform, which do not listen to ActionList + PressedShortcut := ShortCut(Msg.CharCode, KeyDataToShiftState(Msg.KeyData)); + for Act in ActionList1 do begin + if (Act = actSynEditCompletionPropose) + or (Act = actQueryFind) // Support find/replace on grid text editor + or (Act = actQueryFindAgain) + or (Act = actQueryReplace) + then begin + + if PressedShortcut = Act.ShortCut then begin + Act.Execute; + Handled := True; + Break; + end; + + end; + end; + + end; +end;} + +{procedure TMainForm.ApplicationDeActivate(Sender: TObject); +begin + // Prevent completion window from showing up after Alt-Tab. See issue #2640 + // and issue #3342 + // Does not work for some reason in TApplicationEvents.OnDeactivate + // Triggers an EAccessViolation when changing some VCL styles + try + SynCompletionProposal.Form.Enabled := False; + except + on E:EAccessViolation do + LogSQL(E.Message, lcError); + end; + // Gets activated again in SynCompletionProposalExecute +end;} + + +{procedure TMainForm.ApplicationShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); +var + MainTabIndex, QueryTabIndex, NewHideTimeout: integer; + pt: TPoint; + Conn: TDBConnection; + Editor: TSynMemo; +begin + if HintInfo.HintControl = PageControlMain then begin + // Show full filename in tab hint. See issue #3527 + // Code taken from http://www.delphipraxis.net/97988-tabsheet-hint-funktioniert-nicht.html + pt := PageControlMain.ScreenToClient(Mouse.CursorPos); + MainTabIndex := GetMainTabAt(pt.X, pt.Y); + QueryTabIndex := MainTabIndex - tabQuery.PageIndex; + if (QueryTabIndex >= 0) and (QueryTabIndex < QueryTabs.Count) then begin + HintStr := QueryTabs[QueryTabIndex].MemoFilename; + end + else if MainTabIndex = tabHost.TabIndex then begin + Conn := ActiveConnection; + HintStr := Conn.Parameters.Hostname; + if Conn.Parameters.IsAnySQLite then + HintStr := StringReplace(HintStr, DELIM, SLineBreak, [rfReplaceAll]); + end; + HintInfo.ReshowTimeout := 1000; + SetHintFontByControl; + end + else if HintInfo.HintControl is TSynMemo then begin + // Token hint displaying through SynEdit's OnTokenHint event + Editor := TSynMemo(HintInfo.HintControl); + SetHintFontByControl(Editor); + NewHideTimeout := Min(Length(HintStr) * 100, 60*1000); + if NewHideTimeout > HintInfo.HideTimeout then + HintInfo.HideTimeout := NewHideTimeout; + end + else begin + // Probably reset hint font + SetHintFontByControl; + end; +end;} + + +{procedure TMainForm.actToggleCommentExecute(Sender: TObject); +var + Editor: TSynMemo; + rx: TRegExpr; + Sel: TStringList; + i: Integer; + IsComment: Boolean; +begin + // Un/comment selected SQL + Editor := ActiveSynMemo(False); + Editor.UndoList.AddGroupBreak; + rx := TRegExpr.Create; + rx.Expression := '^(\s*)(\-\- |#)?(.*)$'; + if not Editor.SelAvail then begin + rx.Exec(Editor.LineText); + if rx.MatchLen[2] > 0 then begin + Editor.LineText := rx.Match[1] + rx.Match[3]; + Editor.CaretX := Editor.CaretX - rx.MatchLen[2]; + end else begin + Editor.LineText := '-- '+Editor.LineText; + Editor.CaretX := Editor.CaretX + 3; + end; + end else begin + Sel := Explode(CRLF, Editor.SelText); + IsComment := False; + for i:=0 to Sel.Count-1 do begin + rx.Exec(Sel[i]); + if i = 0 then + IsComment := rx.MatchLen[2] > 0; + if IsComment then + Sel[i] := rx.Match[1] + rx.Match[3] + else + Sel[i] := '-- '+Sel[i]; + end; + Editor.SelText := Implode(CRLF, Sel); + if Assigned(Editor.OnStatusChange) then + Editor.OnStatusChange(Editor, [scCaretX]); + end; +end;} + + +{procedure TMainForm.EnableProgress(MaxValue: Integer); +begin + // Initialize progres bar and button + SetProgressState(pbsNormal); + ProgressBarStatus.Visible := True and (not IsWine); + SetProgressPosition(0); + ProgressBarStatus.Max := MaxValue; +end;} + + +{procedure TMainForm.DisableProgress; +begin + // Hide global progress bar + SetProgressPosition(0); + ProgressBarStatus.Hide; + if Assigned(TaskBarList3) then + TaskBarList3.SetProgressState(Handle, 0); +end;} + + +{procedure TMainForm.SetProgressPosition(Value: Integer); +begin + // Advance progress bar and task progress position + try + ProgressBarStatus.Position := Value; + except + // Silence "Floating point division by zero." - see https://www.heidisql.com/forum.php?t=26218 + on E:EZeroDivide do; + end; + ProgressBarStatus.Repaint; + if Assigned(TaskBarList3) then + TaskBarList3.SetProgressValue(Handle, Value, ProgressBarStatus.Max); +end;} + + +{procedure TMainForm.ProgressStep; +begin + SetProgressPosition(ProgressBarStatus.Position+1); +end;} + + +{procedure TMainForm.SetProgressState(State: TProgressbarState); +var + Flag: Integer; +begin + // Set error or pause state in progress bar or task button + ProgressBarStatus.State := State; + ProgressBarStatus.Repaint; + if Assigned(TaskBarList3) then begin + case State of + pbsNormal: Flag := 2; + pbsError: Flag := 4; + pbsPaused: Flag := 8; + else Flag := 0; + end; + TaskBarList3.SetProgressState(Handle, Flag); + end; +end;} + + +{procedure TMainForm.TaskDialogHyperLinkClicked(Sender: TObject); +begin + // Used by hyperlinks in helpers.MessageDialog() + if Sender is TTaskDialog then + ShellExec(TTaskDialog(Sender).URL); +end;} + + +{function TMainForm.HasDonated(ForceCheck: Boolean): TThreeStateBoolean; +var + Email, CheckResult: String; + rx: TRegExpr; + CheckWebpage: THttpDownload; +begin + Screen.Cursor := crHourGlass; + if (FHasDonatedDatabaseCheck = nbUnset) or (ForceCheck) then begin + Email := AppSettings.ReadString(asDonatedEmail); + if Email = '' then begin + // Nothing to check, we know this is not valid + FHasDonatedDatabaseCheck := nbFalse; + end else begin + // Check heidisql.com/hasdonated.php?email=... + // FHasDonatedDatabaseCheck + // = 0 : No check yet done + // = 1 : Not a donor + // = 2 : Valid donor + rx := TRegExpr.Create; + CheckWebpage := THttpDownload.Create(MainForm); + CheckWebpage.URL := APPDOMAIN + 'hasdonated.php?email='+EncodeURLParam(Email); + try + CheckWebpage.SendRequest(''); + CheckResult := CheckWebpage.LastContent; + LogSQL('HTTP response: "'+CheckResult+'"', lcDebug); + rx.Expression := '^\d'; + if rx.Exec(CheckResult) then begin + if CheckResult = '0' then + FHasDonatedDatabaseCheck := nbFalse + else + FHasDonatedDatabaseCheck := nbTrue; + end; + except + on E:Exception do begin + LogSQL(E.Message + sLineBreak + 'HTTP response: "'+CheckResult+'"', lcError); + FHasDonatedDatabaseCheck := nbUnset; // Could have been set before, when ForceCheck=true + end; + end; + CheckWebpage.Free; + rx.Free; + end; + end; + Result := FHasDonatedDatabaseCheck; + Screen.Cursor := crDefault; +end;} + + +{procedure TMainForm.actPreviousResultExecute(Sender: TObject); +var + Tab: TQueryTab; +begin + // Go back to the result tab left to the active one + Tab := QueryTabs.ActiveTab; + if Tab <> nil then begin + if Tab.tabsetQuery.TabIndex > 0 then + Tab.tabsetQuery.SelectNext(False) + else + MessageBeep(MB_ICONEXCLAMATION); + end; +end;} + + +{procedure TMainForm.actNextResultExecute(Sender: TObject); +var + Tab: TQueryTab; +begin + // Advance to the next result tab + Tab := QueryTabs.ActiveTab; + if Tab <> nil then begin + if Tab.tabsetQuery.TabIndex < Tab.tabsetQuery.Tabs.Count-1 then + Tab.tabsetQuery.SelectNext(True) + else + MessageBeep(MB_ICONEXCLAMATION); + end; +end;} + + +{function TMainForm.SelectedTableFocusedColumn: TTableColumn; +var + Col: TTableColumn; +begin + // Return column object of focused data grid column. + // DataGrid columns can be deselected by user, but SelectedTableColumns has all of them, + // so we cannot access them by their 0-based number. Instead, search by name/caption. + Result := nil; + for Col in SelectedTableColumns do begin + if Col.Name = DataGrid.Header.Columns[DataGrid.FocusedColumn].Text then begin + Result := Col; + Break; + end; + end; +end;} + + + + +{ TQueryTab } + + +{constructor TQueryTab.Create; +begin + // Creation of a new main query tab + DirectoryWatch := TDirectoryWatch.Create; + DirectoryWatch.WatchSubTree := False; + DirectoryWatch.OnNotify := DirectoryWatchNotify; + DirectoryWatch.OnError := DirectoryWatchErrorHandler; + // Do not trigger useless file deletion messages, see issue #2948 + DirectoryWatch.WatchActions := DirectoryWatch.WatchActions - [waRemoved]; + // Do not trigger file access. See https://www.heidisql.com/forum.php?t=15500 + DirectoryWatch.WatchOptions := DirectoryWatch.WatchOptions - [woLastAccess]; + // Timer which postpones calling waModified event code until buffers have been saved + MemofileModifiedTimer := TTimer.Create(Memo); + MemofileModifiedTimer.Interval := 1000; + MemofileModifiedTimer.Enabled := False; + MemofileModifiedTimer.OnTimer := MemofileModifiedTimerNotify; + LastSaveTime := 0; + FLastChange := 0; + TimerLastChange := TTimer.Create(Self); + TimerLastChange.Enabled := True; + TimerLastChange.OnTimer := TimerLastChangeOnTimer; + // Contain 2 columns of String : Params & Values + ListBindParams := TListBindParam.Create; + // Update status bar every second while query runs + TimerStatusUpdate := TTimer.Create(Self); + TimerStatusUpdate.Enabled := False; + TimerStatusUpdate.Interval := 100; + TimerStatusUpdate.OnTimer := TimerStatusUpdateOnTimer; + FFileEncoding := 'UTF-8'; +end;} + + +{destructor TQueryTab.Destroy; +begin + ResultTabs.Clear; + DirectoryWatch.Free; + ListBindParams.Free; + TimerLastChange.Free; + TimerStatusUpdate.Free; +end;} + + +{function TQueryTab.GetActiveResultTab: TResultTab; +var + idx: Integer; +begin + Result := nil; + idx := tabsetQuery.TabIndex; + if (idx > -1) and (idx < ResultTabs.Count) then + Result := ResultTabs[idx]; +end;} + + +{procedure TQueryTab.DirectoryWatchNotify(const Sender: TObject; const Action: TWatchAction; const FileName: string); +var + IsCurrentFile: Boolean; +begin + // Notification about file changes in loaded file's directory + + if FDirectoryWatchNotficationRunning then + Exit; + FDirectoryWatchNotficationRunning := True; + + IsCurrentFile := DirectoryWatch.Directory + FileName = MemoFilename; + case Action of + waRemoved: + if IsCurrentFile + and (MessageDialog(_('Close file and query tab?'), f_('File was deleted from outside: %s', [MemoFilename]), mtConfirmation, [mbYes, mbCancel]) = mrYes) then begin + Mainform.actClearQueryEditor.Execute; + if Mainform.IsQueryTab(TabSheet.PageIndex, False) then + Mainform.CloseQueryTab(TabSheet.PageIndex); + end; + + waModified: + if IsCurrentFile and (LastSaveTime < GetTickCount-MemofileModifiedTimer.Interval) then begin + MemofileModifiedTimer.Enabled := False; + MemofileModifiedTimer.Enabled := True; + end; + + waRenamedOld: + if IsCurrentFile then + MemoFileRenamed := True; + + waRenamedNew: + if (not IsCurrentFile) and (MemoFilename <> '') and MemoFileRenamed then begin + MemoFilename := DirectoryWatch.Directory + FileName; + MemoFileRenamed := False; + end; + + end; + FDirectoryWatchNotficationRunning := False; +end;} + + +{procedure TQueryTab.DirectoryWatchErrorHandler(const Sender: TObject; const ErrorCode: Integer; const ErrorMessage: string); +begin + MainForm.LogSQL(Format('File watcher (%d): %s', [ErrorCode, ErrorMessage]), lcError); +end;} + + +{procedure TQueryTab.MemofileModifiedTimerNotify(Sender: TObject); +var + OldTopLine: Integer; + OldCursor: TBufferCoord; +begin + (Sender as TTimer).Enabled := False; + if FDirectoryWatchNotficationRunning then + Exit; + FDirectoryWatchNotficationRunning := True; + if MessageDialog(_('Reload file?'), f_('File was modified from outside: %s', [MemoFilename]), mtConfirmation, [mbYes, mbCancel]) = mrYes then begin + OldCursor := Memo.CaretXY; + OldTopLine := Memo.TopLine; + LoadContents(MemoFilename, True, nil); + Memo.CaretXY := OldCursor; + Memo.TopLine := OldTopLine; + end; + FDirectoryWatchNotficationRunning := False; +end;} + + +{function TQueryTab.LoadContents(Filepath: String; ReplaceContent: Boolean; Encoding: TEncoding): Boolean; +var + Content: String; + Filesize: Int64; + LineBreaks: TLineBreaks; + LoadSuccess: Boolean; +begin + // Load file and add that to the undo-history of SynEdit. + // Normally we would do a simple SynMemo.Lines.LoadFromFile but + // this would prevent SynEdit from adding this step to the undo-history + // so we have to do it by replacing the SelText property + Result := False; + Screen.Cursor := crHourGlass; + Filesize := _GetFileSize(Filepath); + LoadSuccess := False; + MainForm.LogSQL(f_('Loading file "%s" (%s) into query tab #%d', [Filepath, FormatByteNumber(Filesize), Number]), lcInfo); + try + Content := ReadTextfile(Filepath, Encoding); + LoadSuccess := True; + except on E:Exception do + // File does not exist, is locked or broken + ErrorDialog(E.message + sLineBreak + sLineBreak + Filepath); + end; + + if LoadSuccess then begin + if Pos(AppSettings.DirnameSnippets, Filepath) = 0 then + MainForm.AddOrRemoveFromQueryLoadHistory(Filepath, True, True); + Memo.UndoList.AddGroupBreak; + LineBreaks := ScanLineBreaks(Content); + if ReplaceContent then begin + Memo.Clear; + MemoLineBreaks := LineBreaks; + end else begin + if (MemoLineBreaks <> lbsNone) and (MemoLineBreaks <> LineBreaks) then + MemoLineBreaks := lbsMixed + else + MemoLineBreaks := LineBreaks; + end; + if MemoLineBreaks = lbsMixed then + MessageDialog(_('This file contains mixed linebreaks. They have been converted to Windows linebreaks (CR+LF).'), mtInformation, [mbOK]); + + if ReplaceContent then + Memo.Text := Content + else + Memo.SelText := Content; + Memo.SelStart := Memo.SelEnd; + Memo.Modified := False; + MemoFilename := Filepath; + FileEncoding := MainForm.GetEncodingName(Encoding); + //showmessage(FileEncoding); + Result := True; + end; + + Screen.Cursor := crDefault; +end;} + + +{procedure TQueryTab.SaveContents(Filename: String; OnlySelection: Boolean); +var + Text, LB, FileDir: String; +begin + Screen.Cursor := crHourGlass; + MainForm.ShowStatusMsg(_('Saving file ...')); + if OnlySelection then + Text := Memo.SelText + else + Text := Memo.Text; + LB := GetLineBreak(MemoLineBreaks); + if LB <> CRLF then + Text := StringReplace(Text, CRLF, LB, [rfReplaceAll]); + try + FileDir := ExtractFilePath(Filename); + if not DirectoryExists(FileDir) then + ForceDirectories(FileDir); + SaveUnicodeFile(Filename, Text, MainForm.GetEncodingByName(FFileEncoding)); + MemoFilename := Filename; + Memo.Modified := False; + LastSaveTime := GetTickCount; + Screen.Cursor := crDefault; + except + on E:Exception do begin + Screen.Cursor := crDefault; + ErrorDialog(E.Message); + end; + end; + MainForm.ShowStatusMsg; +end;} + + +{class function TQueryTab.GenerateUid: String; +begin + // Generate fresh unique id for a new tab + // Keep it readable by using the date with milliseconds + DateTimeToString(Result, 'yyyy-mm-dd_hh-nn-ss-zzz', Now); +end;} + + +{function TQueryTab.MemoBackupFilename: String; +begin + // Return filename for auto-backup feature + if (MemoFilename <> '') and (not Memo.Modified) then begin + Result := ''; + end else begin + Result := IncludeTrailingBackslash(AppSettings.DirnameBackups) + + ValidFilename(Format(BACKUP_FILEPATTERN, [Uid])) + ; + end; +end;} + + +{procedure TQueryTab.BackupUnsavedContent; +var + LastFileBackup: TDateTime; +begin + // Fired before closing application, and also timer controlled + + // Check if content is a user stored file and if it has modified content: + if MemoBackupFilename.IsEmpty then + Exit; + + // Check if existing backup file is up-to-date: + if FileExists(MemoBackupFilename) then begin + FileAge(MemoBackupFilename, LastFileBackup); + if LastFileBackup > FLastChange then + Exit; + end; + + if Memo.GetTextLen = 0 then begin + // If memo is empty, remove backup file + if FileExists(MemoBackupFilename) then begin + if not DeleteFile(MemoBackupFilename) then begin + MainForm.LogSQL('Could not remove empty backup file "'+MemoBackupFilename+'"', lcError); + end; + end; + end else begin + if Memo.GetTextLen < SIZE_MB*10 then begin + MainForm.LogSQL('Saving backup file to "'+MemoBackupFilename+'"...', lcDebug); + MainForm.ShowStatusMsg(_('Saving backup file...')); + SaveUnicodeFile(MemoBackupFilename, Memo.Text, UTF8NoBOMEncoding); + end else begin + MainForm.LogSQL('Unsaved tab contents too large (> 10M) for creating a backup.', lcDebug); + end; + end; + MainForm.ShowStatusMsg(''); +end;} + + +{function TQueryTab.GetBindParamsActivated: Boolean; +var + Node: PVirtualNode; +begin + // Return state of bind params checkbox + Result := False; + Node := FindNode(treeHelpers, TQueryTab.HelperNodeBinding, nil); + if Assigned(Node) then + Result := treeHelpers.CheckState[Node] in CheckedStates; +end;} + + +{procedure TQueryTab.SetBindParamsActivated(Value: Boolean); +var + Node: PVirtualNode; +begin + // Check bind params checkbox + Node := FindNode(treeHelpers, TQueryTab.HelperNodeBinding, nil); + if Value then + treeHelpers.CheckState[Node] := csCheckedNormal + else + treeHelpers.CheckState[Node] := csUncheckedNormal; +end;} + + +{procedure TQueryTab.SetErrorLine(Value: Integer); +begin + if Value <> FErrorLine then begin + FErrorLine := Value; + Memo.Repaint; + end; +end;} + + +{procedure TQueryTab.SetMemoFilename(Value: String); +begin + FMemoFilename := Value; + MainForm.SetTabCaption(TabSheet.PageIndex, ExtractFilename(FMemoFilename)); + MainForm.ValidateQueryControls(Self); + if (FMemoFilename <> '') and FileExists(FMemoFilename) then begin + DirectoryWatch.Directory := ExtractFilePath(FMemoFilename); + DirectoryWatch.Start; + end else + DirectoryWatch.Stop; +end;} + + +{procedure TQueryTab.SetQueryRunning(Value: Boolean); +begin + // Marker for query tab that it is currently executing and waiting for a query + FQueryRunning := Value; + TimerStatusUpdate.Enabled := Value; +end;} + + +{procedure TQueryTab.TimerLastChangeOnTimer(Sender: TObject); +var + rx: TRegExpr; + BindParam: TBindParam; + ParamCountBefore: Integer; + Node : PVirtualNode; + ParamName: String; + ParamFound: Boolean; +begin + TimerLastChange.Enabled := False; + + if not BindParamsActivated then + Exit; + if Memo.GetTextLen > SIZE_MB then begin + MessageDialog(_('The query is too long to enable detection of bind parameters'), mtError, [mbOK]); + Node := FindNode(treeHelpers, TQueryTab.HelperNodeBinding, nil); + treeHelpers.CheckState[Node] := csUncheckedNormal; + Exit; + end; + + MainForm.LogSQL('Bind parameter detection...', lcInfo); + ParamCountBefore := ListBindParams.Count; + + // Check current Query memo to find all parameters with regular expression ( :params ) + rx := TRegExpr.Create; + // Can't use (?<!\w):\w+ with actuall unit so this is an other solution + // Don't use ^:\w+|\W:[^\W:]\w+ because it detect IP v6 + rx.Expression := '([^:\w]|^):\w+'; + if rx.Exec(Memo.Text) then while true do begin + + // Don't get first char if it's not ':' because RegEx contain \W (A non-word character) before ':' + ParamName := Copy(rx.Match[0], Pos(':',rx.Match[0]), Length(rx.Match[0])-Pos(':',rx.Match[0])+1); + + // Check if parameter already exists + ParamFound := False; + for BindParam in ListBindParams do begin + if BindParam.Name = ParamName then begin + BindParam.Keep := True; + ParamFound := True; + end; + end; + + // If not exists, prepare and add new TBindParam + if not ParamFound then begin + BindParam := TBindParam.Create; + BindParam.Name := ParamName; + BindParam.Value := ''; + BindParam.Keep := True; + ListBindParams.Add(BindParam); + end; + + // Try to find next parameter + if not rx.ExecNext then + break; + end; + + rx.Free; + + // Sort list ascending + ListBindParams.Sort; + // Delete all parameters where variable is to False + ListBindParams.CleanToKeep; + + // Refresh bind param tree node, so it displays its children. Expand it when it has params for the first time. + MainForm.RefreshHelperNode(TQueryTab.HelperNodeBinding); + if (ParamCountBefore=0) and (ListBindParams.Count>0) then begin + Node := FindNode(treeHelpers, TQueryTab.HelperNodeBinding, nil); + treeHelpers.Expanded[Node] := True; + end; + + MainForm.LogSQL(IntToStr(ListBindParams.Count) + ' bind parameters found.', lcDebug); +end;} + + +{procedure TQueryTab.TimerStatusUpdateOnTimer(Sender: TObject); +var + Msg, ElapsedMsg: String; + Elapsed: Int64; +begin + // Update status bar every second with elapsed time + Msg := _('query')+' #' + FormatNumber(ExecutionThread.BatchPosition+1); + if ExecutionThread.QueriesInPacket > 1 then + Msg := f_('queries #%s to #%s', [FormatNumber(ExecutionThread.BatchPosition+1), FormatNumber(ExecutionThread.BatchPosition+ExecutionThread.QueriesInPacket)]); + try + Elapsed := MilliSecondsBetween(ExecutionThread.QueryStartedAt, Now); + ElapsedMsg := FormatTimeNumber(Elapsed/1000, True); + MainForm.ShowStatusMsg(ElapsedMsg + ': ' + f_('Executing %s of %s ...', [Msg, FormatNumber(ExecutionThread.Batch.Count)])); + except; + // Some crashes here, probably when accessing the no longer running thread. + // See https://www.heidisql.com/forum.php?t=25418#p25484 + // See issue https://github.com/HeidiSQL/HeidiSQL/issues/490 + end; +end;} + + +{ TQueryTabList } + +{function TQueryTabList.ActiveTab: TQueryTab; +var + idx: Integer; + FixedTab: TQueryTab; +begin + // Return active tab + Result := nil; + if Self.Count < 1 then + Exit; + FixedTab := Self[0]; + idx := FixedTab.TabSheet.PageControl.ActivePageIndex - FixedTab.TabSheet.PageIndex; + if (idx >= 0) and (idx < Self.Count) then + Result := Self[idx]; +end;} + + +{function TQueryTabList.HasActiveTab: Boolean; +begin + Result := ActiveTab <> nil; +end;} + + +{function TQueryTabList.ActiveMemo: TSynMemo; +var + Tab: TQueryTab; +begin + // Return current query memo + Result := nil; + Tab := ActiveTab; + if Assigned(Tab) then + Result := Tab.Memo; +end;} + + +{function TQueryTabList.ActiveHelpersTree: TVirtualStringTree; +var + Tab: TQueryTab; +begin + // Return current query helpers tree + Result := nil; + Tab := ActiveTab; + if Assigned(Tab) then + Result := Tab.treeHelpers; +end;} + + +{function TQueryTabList.TabByNumber(Number: Integer): TQueryTab; +var + Tab: TQueryTab; +begin + // Find right query tab + Result := nil; + for Tab in Self do begin + if Tab.Number = Number then begin + Result := Tab; + break; + end; + end; +end;} + + +{function TQueryTabList.TabByControl(Control: TWinControl): TQueryTab; +var + Tab: TQueryTab; +begin + // Find query tab where passed control resides + // Supports only most important controls in the upper area, excluding tab close button and result grid + Result := nil; + for Tab in Self do begin + if (Control = Tab.TabSheet) + or (Control = Tab.pnlMemo) or (Control = Tab.Memo) + or (Control = Tab.pnlHelpers) or (Control = Tab.filterHelpers) or (Control = Tab.treeHelpers) + or (Control = Tab.tabsetQuery) + then begin + Result := Tab; + Break; + end; + end; +end;} + + + + + +{ TResultTab } + +{constructor TResultTab.Create(AOwner: TQueryTab); +var + QueryTab: TQueryTab; + OrgGrid: TVirtualStringTree; +begin + inherited Create; + QueryTab := AOwner; + OrgGrid := Mainform.QueryGrid; + Grid := TVirtualStringTree.Create(QueryTab.TabSheet); + Grid.Parent := QueryTab.TabSheet; + Grid.Tag := OrgGrid.Tag; + Grid.BorderStyle := OrgGrid.BorderStyle; + Grid.Align := OrgGrid.Align; + Grid.Visible := False; + Grid.TreeOptions := OrgGrid.TreeOptions; + Grid.PopupMenu := OrgGrid.PopupMenu; + Grid.LineStyle := OrgGrid.LineStyle; + Grid.EditDelay := OrgGrid.EditDelay; + Grid.Font.Assign(OrgGrid.Font); + Grid.Header.Options := OrgGrid.Header.Options; + Grid.Header.PopupMenu := OrgGrid.Header.PopupMenu; + Grid.Header.ParentFont := OrgGrid.Header.ParentFont; + Grid.Header.Images := OrgGrid.Header.Images; + Grid.WantTabs := OrgGrid.WantTabs; + Grid.AutoScrollDelay := OrgGrid.AutoScrollDelay; + // Apply events - keep in alphabetical order for overview reasons + Grid.OnAdvancedHeaderDraw := OrgGrid.OnAdvancedHeaderDraw; + Grid.OnAfterCellPaint := OrgGrid.OnAfterCellPaint; + Grid.OnAfterPaint := OrgGrid.OnAfterPaint; + Grid.OnBeforeCellPaint := OrgGrid.OnBeforeCellPaint; + Grid.OnChange := OrgGrid.OnChange; + Grid.OnCreateEditor := OrgGrid.OnCreateEditor; + Grid.OnCompareNodes := OrgGrid.OnCompareNodes; + Grid.OnEditCancelled := OrgGrid.OnEditCancelled; + Grid.OnEdited := OrgGrid.OnEdited; + Grid.OnEditing := OrgGrid.OnEditing; + Grid.OnEndOperation := OrgGrid.OnEndOperation; + Grid.OnEnter := OrgGrid.OnEnter; + Grid.OnExit := OrgGrid.OnExit; + Grid.OnFocusChanged := OrgGrid.OnFocusChanged; + Grid.OnFocusChanging := OrgGrid.OnFocusChanging; + Grid.OnGetNodeDataSize := OrgGrid.OnGetNodeDataSize; + Grid.OnGetText := OrgGrid.OnGetText; + Grid.OnHeaderClick := OrgGrid.OnHeaderClick; + Grid.OnHeaderDrawQueryElements := OrgGrid.OnHeaderDrawQueryElements; + Grid.OnInitNode := OrgGrid.OnInitNode; + Grid.OnKeyDown := OrgGrid.OnKeyDown; + Grid.OnMouseUp := OrgGrid.OnMouseUp; + Grid.OnMouseWheel := OrgGrid.OnMouseWheel; + Grid.OnNewText := OrgGrid.OnNewText; + Grid.OnPaintText := OrgGrid.OnPaintText; + Grid.OnStartOperation := OrgGrid.OnStartOperation; + FixVT(Grid, AppSettings.ReadInt(asGridRowLineCount)); + FTabIndex := QueryTab.ResultTabs.Count; // Will be 0 for the first one, even if we're already creating the first one here! +end;} + +{destructor TResultTab.Destroy; +begin + Results.Free; + Grid.EndEditNode; + // The grid itself is owned by the parent tabsheet, free it only if the tabsheet is not being closed + if not (csDestroying in Grid.ComponentState) then + Grid.Free; + inherited; +end;} + + +{ TQueryHistory } + +{constructor TQueryHistory.Create(SessionPath: String); +var + ValueNames: TStringList; + i, j, p: Integer; + Raw: String; + Item: TQueryHistoryItem; +begin + inherited Create(TQueryHistoryItemComparer.Create, True); + AppSettings.SessionPath := SessionPath + '\' + REGKEY_QUERYHISTORY; + ValueNames := AppSettings.GetValueNames; + for i:=0 to ValueNames.Count-1 do begin + j := StrToIntDef(ValueNames[i], -1); + // Prevent from running into serious errors when registry has some non-numeric value + if j<>-1 then begin + Item := TQueryHistoryItem.Create; + try + Item.RegValue := j; + Raw := AppSettings.ReadString(ValueNames[i]); + p := Pos(DELIM, Raw); + Item.Time := StrToDateTime(Copy(Raw, 1, p-1)); + System.Delete(Raw, 1, p); + p := Pos(DELIM, Raw); + Item.Database := Copy(Raw, 1, p-1); + System.Delete(Raw, 1, p); + p := Pos(DELIM, Raw); + Item.Duration := StrToIntDef(Copy(Raw, 1, p-1), 0); + FMaxDuration := Max(FMaxDuration, Item.Duration); + Item.SQL := Copy(Raw, p+1, Length(Raw)); + Add(Item); + except + on E:Exception do begin + MainForm.LogSQL(E.ClassName+': '+E.Message+' Sessionpath: '+AppSettings.SessionPath+' Valuename: '+ValueNames[i]+' Raw: '+Raw, lcDebug); + Item.Free; + Break; + end; + end; + end; + end; + // Sort by date + Sort; + ValueNames.Free; + AppSettings.ResetPath; +end;} + + +{function TQueryHistoryItemComparer.Compare(const Left, Right: TQueryHistoryItem): Integer; +begin + // Simple sort method for a TDBObjectList + if Left.Time > Right.Time then + Result := -1 + else if Left.Time = Right.Time then + Result := 0 + else + Result := 1; +end;} + + +{ TListBindParam } + +constructor TListBindParam.Create; +begin + inherited Create(TBindParamComparer.Create); + FPairDelimiter := '|'; + FItemDelimiter := '~'; +end; + + +procedure TListBindParam.CleanToKeep; +var + Index: Integer; +begin + // Check for each parameter if there is to be deleted + for Index:=Count-1 downto 0 do begin + if Items[Index].Keep = False then + Self.Delete(Index); + end; + + // Set False all items for the next call + for Index:=0 to Count-1 do begin + Items[Index].Keep := False; + end; +end; + + +function TListBindParam.GetAsText: String; +var + Param: TBindParam; + Lines: TStringList; +begin + // Return params as storable text + Lines := TStringList.Create; + for Param in Self do begin + Lines.Add(Param.Name + FPairDelimiter + Param.Value); + end; + Result := Implode(FItemDelimiter, Lines); + Lines.Free; +end; + +procedure TListBindParam.SetAsText(Input: String); +var + Param: TBindParam; + Lines, Pair: TStringList; + Line: String; +begin + // Restore params from text + // See #689 + Lines := Explode(FItemDelimiter, Input); + for Line in Lines do begin + Pair := Explode(FPairDelimiter, Line); + if Pair.Count >= 2 then begin + Param := TBindParam.Create; + Param.Name := Pair[0]; + Param.Value := Pair[1]; + Add(Param); + end; + Pair.Free; + end; + Lines.Free; +end; + + +{ TBindParamComparer } + +function TBindParamComparer.Compare(constref Left, Right: TBindParam): Integer; +begin + // Simple sort method for a TDBObjectList + Result := CompareText(Left.Name, Right.Name); +end; + +end. + +

commit f9cd3e94a6cf9179a5c5fb09dc01dbf4ff7d8ea2 Author: Ansgar Becker Date: Mon Feb 24 20:37:38 2025 +0100 Issue #1482: first attempt of a code conversion to Lazarus/FPC, with a small bunch of 5 units (out of 50), and most code commented out diff --git a/.gitignore b/.gitignore new file mode 100644 index 00000000..c90cc388 --- /dev/null +++ b/.gitignore @@ -0,0 +1,30 @@ +# Lazarus compiler-generated binaries (safe to delete) +*.exe +#*.dll +#*.so +*.dylib +*.lrs +*.res +*.compiled +*.dbg +*.ppu +*.o +*.or +*.a + +# Lazarus autogenerated files (duplicated info) +*.rst +*.rsj +*.lrt + +# Lazarus local files (user-specific info) +*.lps + +# Lazarus backups and unit output folders. +# These can be changed by user in Lazarus/project options. +backup/ +*.bak +lib/ + +# Application bundle for Mac OS +*.app/ \ No newline at end of file diff --git a/heidisql.lpi b/heidisql.lpi new file mode 100644 index 00000000..e7ef9f3e --- /dev/null +++ b/heidisql.lpi @@ -0,0 +1,121 @@ + + + + + + + + + <Scaled Value="True"/> + <ResourceType Value="res"/> + <UseXPManifest Value="True"/> + <XPManifest> + <DpiAware Value="True"/> + </XPManifest> + <Icon Value="0"/> + </General> + <VersionInfo> + <UseVersionInfo Value="True"/> + <MajorVersionNr Value="12"/> + <MinorVersionNr Value="10"/> + </VersionInfo> + <BuildModes> + <Item Name="Default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <UseFileFilters Value="True"/> + </PublishOptions> + <RunParams> + <FormatVersion Value="2"/> + </RunParams> + <RequiredPackages> + <Item> + <PackageName Value="laz.virtualtreeview_package"/> + </Item> + <Item> + <PackageName Value="SynEditDsgn"/> + </Item> + <Item> + <PackageName Value="SynEdit"/> + </Item> + <Item> + <PackageName Value="LCL"/> + </Item> + </RequiredPackages> + <Units> + <Unit> + <Filename Value="heidisql.lpr"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="source/main.pas"/> + <IsPartOfProject Value="True"/> + <ComponentName Value="MainForm"/> + <HasResources Value="True"/> + <ResourceBaseClass Value="Form"/> + </Unit> + <Unit> + <Filename Value="source/apphelpers.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="source/dbconnection.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="source/dbstructures.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + <Unit> + <Filename Value="source/dbstructures.mysql.pas"/> + <IsPartOfProject Value="True"/> + </Unit> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="11"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="out\heidisql"/> + </Target> + <SearchPaths> + <IncludeFiles Value="$(ProjOutDir)"/> + <OtherUnitFiles Value="source"/> + <UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <SyntaxMode Value="Delphi"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <DebugInfoType Value="dsDwarf3"/> + </Debugging> + <Options> + <Win32> + <GraphicApplication Value="True"/> + </Win32> + </Options> + </Linking> + <Other> + <CompilerMessages> + <IgnoredMessages idx3177="True" idx3175="True"/> + </CompilerMessages> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions> + <Item> + <Name Value="EAbort"/> + </Item> + <Item> + <Name Value="ECodetoolError"/> + </Item> + <Item> + <Name Value="EFOpenError"/> + </Item> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/heidisql.lpr b/heidisql.lpr new file mode 100644 index 00000000..f3a4088f --- /dev/null +++ b/heidisql.lpr @@ -0,0 +1,74 @@ +program heidisql; + +{$mode delphi}{$H+} + +uses + {$IFDEF UNIX} + cthreads, + {$ENDIF} + {$IFDEF HASAMIGA} + athreads, + {$ENDIF} + Interfaces, // this includes the LCL widgetset + SysUtils, + Forms, main, + { you can add units after this } + apphelpers, + dbconnection, + //gnugettext + dbstructures, + dbstructures.mysql + ; + +{$R *.res} +{.$R resources.rc} + +begin + PostponedLogItems := TDBLogItems.Create(True); + //Application.MainFormOnTaskBar := True; + + // Use MySQL standard format for date/time variables: YYYY-MM-DD HH:MM:SS + // Be aware that Delphi internally converts the slashes in ShortDateFormat to the DateSeparator + DefaultFormatSettings.DateSeparator := '-'; + DefaultFormatSettings.TimeSeparator := ':'; + DefaultFormatSettings.ShortDateFormat := 'yyyy/mm/dd'; + DefaultFormatSettings.LongTimeFormat := 'hh:nn:ss'; + + //AppSettings := TAppSettings.Create; + //SecondInstMsgId := RegisterWindowMessage(APPNAME); + if false then begin // (not AppSettings.ReadBool(asAllowMultipleInstances)) and CheckForSecondInstance then begin + //AppSettings.Free; + Application.Terminate; + end else begin + + {AppLanguage := AppSettings.ReadString(asAppLanguage); + // SysLanguage may be zh_CN, while we don't offer such a language, but anyway, this is just the current system language: + SysLanguage := gnugettext.DefaultInstance.GetCurrentLocaleName; + gnugettext.UseLanguage(AppLanguage); + // First time translation via dxgettext. + // Issue #3064: Ignore TFont, so "Default" on mainform for WinXP users does not get broken. + gnugettext.TP_GlobalIgnoreClass(TFont); + + // Enable padding in customized tooltips + HintWindowClass := TExtHintWindow;} + + RequireDerivedFormResource:=True; + Application.Scaled:=True; + Application.Initialize; + //Application.UpdateFormatSettings := False; + + // Try to set style name. If that fails, the user gets an error message box - reset it to default when that happened + {WantedStyle := AppSettings.ReadString(asTheme); + TStyleManager.TrySetStyle(WantedStyle); + if TStyleManager.ActiveStyle.Name <> WantedStyle then begin + AppSettings.WriteString(asTheme, TStyleManager.ActiveStyle.Name); + end;} + Application.CreateForm(TMainForm, MainForm); + MainForm.AfterFormCreate; + //Application.OnDeactivate := MainForm.ApplicationDeActivate; + //Application.OnShowHint := MainForm.ApplicationShowHint; + //Application.MainFormOnTaskBar := True; + Application.Run; + end; +end. + diff --git a/out/libmariadb.dll b/out/libmariadb.dll new file mode 100644 index 00000000..fa87599f Binary files /dev/null and b/out/libmariadb.dll differ diff --git a/source/apphelpers.pas b/source/apphelpers.pas new file mode 100644 index 00000000..f30c817d --- /dev/null +++ b/source/apphelpers.pas @@ -0,0 +1,4610 @@ +unit apphelpers; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, + dbconnection; + +type + + {TSortItemOrder = (sioAscending, sioDescending); + TSortItem = class(TPersistent) + public + Column: String; + Order: TSortItemOrder; + procedure Assign(Source: TPersistent); override; + end; + TSortItems = class(TObjectList<TSortItem>) + public + function AddNew(Column: String=''; Order: TSortItemOrder=sioAscending): TSortItem; + function ComposeOrderClause(Connection: TDBConnection): String; + function FindByColumn(Column: String): TSortItem; + procedure Assign(Source: TSortItems); + end;} + + TLineBreaks = (lbsNone, lbsWindows, lbsUnix, lbsMac, lbsWide, lbsMixed); + + {TUTF8NoBOMEncoding = class(TUTF8Encoding) + public + function GetPreamble: TBytes; override; + end;} + + {TDBObjectEditor = class(TFrame) + private + FModified: Boolean; + procedure SetModified(Value: Boolean); + protected + FMainSynMemo: TSynMemo; // Main editor in case of routine, view, trigger or event + FMainSynMemoPreviousTopLine: Integer; + function ObjectExists: Boolean; + public + DBObject: TDBObject; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure Init(Obj: TDBObject); virtual; + function DeInit: TModalResult; virtual; + property Modified: Boolean read FModified write SetModified; + function ApplyModifications: TModalResult; virtual; abstract; + end; + TDBObjectEditorClass = class of TDBObjectEditor;} + + {TSQLBatch = class; + TSQLSentence = class(TObject) + private + FOwner: TSQLBatch; + function GetSize: Integer; + function GetSQL: String; + function GetSQLWithoutComments: String; + public + LeftOffset, RightOffset: Integer; + constructor Create(Owner: TSQLBatch); + property SQL: String read GetSQL; + property SQLWithoutComments: String read GetSQLWithoutComments; + property Size: Integer read GetSize; + end; + TSQLBatch = class(TObjectList<TSQLSentence>) + private + FSQL: String; + procedure SetSQL(Value: String); + function GetSize: Integer; + function GetSQLWithoutComments: String; overload; + public + class function GetSQLWithoutComments(FullSQL: String): String; overload; + property Size: Integer read GetSize; + property SQL: String read FSQL write SetSQL; + property SQLWithoutComments: String read GetSQLWithoutComments; + end; } + + // Download + {THttpDownload = class(TObject) + private + FOwner: TComponent; + FURL: String; + FLastContent: String; + FBytesRead: Integer; + FContentLength: Integer; + FTimeOut: Cardinal; + FOnProgress: TNotifyEvent; + public + constructor Create(Owner: TComponent); + procedure SendRequest(Filename: String); + property OnProgress: TNotifyEvent read FOnProgress write FOnProgress; + property URL: String read FURL write FURL; + property TimeOut: Cardinal read FTimeOut write FTimeOut; + property BytesRead: Integer read FBytesRead; + property ContentLength: Integer read FContentLength; + property LastContent: String read FLastContent; + end; } + + // Extended string list with support for empty values + {TExtStringList = class(TStringList) + private + function GetValue(const Name: string): string; + procedure SetValue(const Name, Value: string); reintroduce; + public + property Values[const Name: string]: string read GetValue write SetValue; + end;} + + // Threading stuff + {TQueryThread = class(TThread) + private + FConnection: TDBConnection; + FBatch: TSQLBatch; + FTabNumber: Integer; + FBatchInOneGo: Boolean; + FStopOnErrors: Boolean; + FAborted: Boolean; + FErrorMessage: String; + FBatchPosition: Integer; + FQueriesInPacket: Integer; + FQueryStartedAt: TDateTime; + FQueryTime: Cardinal; + FQueryNetTime: Cardinal; + FRowsAffected: Int64; + FRowsFound: Int64; + FWarningCount: Int64; + public + property Connection: TDBConnection read FConnection; + property Batch: TSQLBatch read FBatch; + property TabNumber: Integer read FTabNumber; + property BatchPosition: Integer read FBatchPosition; + property QueriesInPacket: Integer read FQueriesInPacket; + property QueryStartedAt: TDateTime read FQueryStartedAt; + property QueryTime: Cardinal read FQueryTime; + property QueryNetTime: Cardinal read FQueryNetTime; + property RowsAffected: Int64 read FRowsAffected; + property RowsFound: Int64 read FRowsFound; + property WarningCount: Int64 read FWarningCount; + property Aborted: Boolean read FAborted write FAborted; + property ErrorMessage: String read FErrorMessage; + constructor Create(Connection: TDBConnection; Batch: TSQLBatch; TabNumber: Integer); + procedure Execute; override; + procedure LogFromThread(Msg: String; Category: TDBLogCategory); + end;} + + {TSqlTranspiler = class(TObject) + class function CreateTable(SQL: String; SourceDb, TargetDb: TDBConnection): String; + end;} + + {TClipboardHelper = class helper for TClipboard + private + function GetTryAsText: String; + procedure SetTryAsText(AValue: String); + public + property TryAsText: String read GetTryAsText write SetTryAsText; + end;} + + {TWinControlHelper = class helper for TWinControl + public + procedure TrySetFocus; + end;} + + //TSimpleKeyValuePairs = TDictionary<String, String>; + + TAppSettingDataType = (adInt, adBool, adString); + TAppSettingIndex = (asHiddenColumns, asFilter, asSort, asDisplayedColumnsSorted, asLastSessions, + asLastActiveSession, asAutoReconnect, asRestoreLastUsedDB, asLastUsedDB, asTreeBackground, asIgnoreDatabasePattern, asLogFileDdl, asLogFileDml, asLogFilePath, + asFontName, asFontSize, asTabWidth, asDataFontName, asDataFontSize, asDataLocalNumberFormat, asLowercaseHex, asHintsOnResultTabs, asHightlightSameTextBackground, + asShowRowId, + asLogsqlnum, asLogsqlwidth, asSessionLogsDirectory, asLogHorizontalScrollbar, asSQLColActiveLine, + asSQLColMatchingBraceForeground, asSQLColMatchingBraceBackground, + asMaxColWidth, asDatagridMaximumRows, asDatagridRowsPerStep, asGridRowLineCount, asColumnHeaderClick, asReuseEditorConfiguration, + asLogToFile, asMainWinMaximized, asMainWinLeft, asMainWinTop, asMainWinWidth, + asMainWinHeight, asMainWinOnMonitor, asCoolBandIndex, asCoolBandBreak, asCoolBandWidth, asToolbarShowCaptions, asQuerymemoheight, asDbtreewidth, + asDataPreviewHeight, asDataPreviewEnabled, asLogHeight, asQueryhelperswidth, asStopOnErrorsInBatchMode, + 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, + 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, + asGridExportWindowWidth, asGridExportWindowHeight, asGridExportOutputCopy, asGridExportOutputFile, + asGridExportFilename, asGridExportRecentFiles, asGridExportEncoding, asGridExportFormat, asGridExportSelection, + asGridExportColumnNames, asGridExportIncludeAutoInc, asGridExportIncludeQuery, asGridExportRemoveLinebreaks, + asGridExportSeparator, asGridExportEncloser, asGridExportTerminator, asGridExportNull, + + asGridExportClpColumnNames, asGridExportClpIncludeAutoInc, asGridExportClpRemoveLinebreaks, + asGridExportClpSeparator, asGridExportClpEncloser, asGridExportClpTerminator, asGridExportClpNull, + + asCSVImportSeparator, asCSVImportEncloser, asCSVImportTerminator, asCSVImportFieldEscaper, asCSVImportWindowWidth, asCSVImportWindowHeight, + asCSVImportFilename, asCSVImportFieldsEnclosedOptionally, asCSVImportIgnoreLines, asCSVImportLowPriority, asCSVImportLocalNumbers, + asCSVImportDuplicateHandling, asCSVImportParseMethod, asCSVKeepDialogOpen, + asUpdatecheck, asUpdatecheckBuilds, asUpdatecheckInterval, asUpdatecheckLastrun, asUpdateCheckWindowWidth, asUpdateCheckWindowHeight, + asTableToolsWindowWidth, asTableToolsWindowHeight, asTableToolsTreeWidth, + asTableToolsFindTextTab, asTableToolsFindText, asTableToolsFindSQL, asTableToolsDatatype, asTableToolsFindCaseSensitive, asTableToolsFindMatchType, asFileImportWindowWidth, asFileImportWindowHeight, + asEditVarWindowWidth, asEditVarWindowHeight, asUsermanagerWindowWidth, asUsermanagerWindowHeight, asUsermanagerListWidth, + asSelectDBOWindowWidth, asSelectDBOWindowHeight, + asSessionManagerListWidth, asSessionManagerWindowWidth, asSessionManagerWindowHeight, asSessionManagerWindowLeft, asSessionManagerWindowTop, + asCopyTableWindowHeight, asCopyTableWindowWidth, asCopyTableColumns, asCopyTableKeys, asCopyTableForeignKeys, + asCopyTableData, asCopyTableRecentFilter, asServerVersion, asServerVersionFull, asLastConnect, + asConnectCount, asRefusedCount, asSessionCreated, asDoUsageStatistics, + asLastUsageStatisticCall, asWheelZoom, asDisplayBars, asMySQLBinaries, asCustomSnippetsDirectory, + asPromptSaveFileOnTabClose, asRestoreTabs, asTabCloseOnDoubleClick, asTabCloseOnMiddleClick, asTabsInMultipleLines, asTabIconsGrayscaleMode, + asWarnUnsafeUpdates, asQueryGridLongSortRowNum, + asCompletionProposal, asCompletionProposalInterval, asCompletionProposalSearchOnMid, asCompletionProposalWidth, asCompletionProposalNbLinesInWindow, asAutoUppercase, + asTabsToSpaces, asFilterPanel, asAllowMultipleInstances, asFindDialogSearchHistory, asGUIFontName, asGUIFontSize, + asTheme, asIconPack, asWebSearchBaseUrl, + asFindDialogReplaceHistory, asMaxQueryResults, asLogErrors, + asLogUserSQL, asLogSQL, asLogInfos, asLogDebug, asLogScript, asLogTimestamp, asFieldColorNumeric, + asFieldColorReal, asFieldColorText, asFieldColorBinary, asFieldColorDatetime, asFieldColorSpatial, + asFieldColorOther, asFieldEditorBinary, asFieldEditorDatetime, asFieldEditorDatetimePrefill, asFieldEditorEnum, + asFieldEditorSet, asFieldNullBackground, asRowBackgroundEven, asRowBackgroundOdd, asGroupTreeObjects, asDisplayObjectSizeColumn, asSQLfile, + asActionShortcut1, asActionShortcut2, asHighlighterForeground, asHighlighterBackground, asHighlighterStyle, + asListColWidths, asListColsVisible, asListColPositions, asListColSort, asSessionFolder, + asRecentFilter, asTimestampColumns, asDateTimeEditorCursorPos, asAppLanguage, asAutoExpand, asDoubleClickInsertsNodeText, asForeignDropDown, + asIncrementalSearch, asQueryHistoryEnabled, asQueryHistoryKeepDays, + asColumnSelectorWidth, asColumnSelectorHeight, asDonatedEmail, asFavoriteObjects, asFavoriteObjectsOnly, asFullTableStatus, asLineBreakStyle, + asPreferencesWindowWidth, asPreferencesWindowHeight, + asFileDialogEncoding, + asThemePreviewWidth, asThemePreviewHeight, asThemePreviewTop, asThemePreviewLeft, + asCreateDbCollation, asRealTrailingZeros, + asSequalSuggestWindowWidth, asSequalSuggestWindowHeight, asSequalSuggestPrompt, asSequalSuggestRecentPrompts, + asReformatter, asReformatterNoDialog, asAlwaysGenerateFilter, + asGenerateDataNumRows, asGenerateDataNullAmount, asWebOnceAction, + asUnused); + TAppSetting = record + Name: String; + Session: Boolean; + DefaultInt, CurrentInt: Integer; + DefaultBool, CurrentBool: Boolean; + DefaultString, CurrentString: String; + Synced: Boolean; + end; + {TAppSettings = class(TObject) + private + FReads, FWrites: Integer; + FBasePath: String; + FSessionPath: String; + FStoredPath: String; + FRegistry: TRegistry; + FPortableMode: Boolean; + FPortableModeReadOnly: Boolean; + FRestoreTabsInitValue: Boolean; + FSettingsFile: String; + FSettings: Array[TAppSettingIndex] of TAppSetting; + const FPortableLockFileBase: String='portable.lock'; + procedure InitSetting(Index: TAppSettingIndex; Name: String; + DefaultInt: Integer=0; DefaultBool: Boolean=False; DefaultString: String=''; + Session: Boolean=False); + procedure SetSessionPath(Value: String); + procedure PrepareRegistry; + procedure Read(Index: TAppSettingIndex; FormatName: String; + DataType: TAppSettingDataType; var I: Integer; var B: Boolean; var S: String; + DI: Integer; DB: Boolean; DS: String); + procedure Write(Index: TAppSettingIndex; FormatName: String; + DataType: TAppSettingDataType; I: Integer; B: Boolean; S: String); + public + constructor Create; + destructor Destroy; override; + function ReadInt(Index: TAppSettingIndex; FormatName: String=''; Default: Integer=0): Integer; + function ReadIntDpiAware(Index: TAppSettingIndex; AControl: TControl; FormatName: String=''; Default: Integer=0): Integer; + function ReadBool(Index: TAppSettingIndex; FormatName: String=''; Default: Boolean=False): Boolean; + function ReadString(Index: TAppSettingIndex; FormatName: String=''; Default: String=''): String; overload; + function ReadString(ValueName: String): String; overload; + procedure WriteInt(Index: TAppSettingIndex; Value: Integer; FormatName: String=''); + procedure WriteIntDpiAware(Index: TAppSettingIndex; AControl: TControl; Value: Integer; FormatName: String=''); + procedure WriteBool(Index: TAppSettingIndex; Value: Boolean; FormatName: String=''); + procedure WriteString(Index: TAppSettingIndex; Value: String; FormatName: String=''); overload; + procedure WriteString(ValueName, Value: String); overload; + function GetDefaultInt(Index: TAppSettingIndex): Integer; + function GetDefaultBool(Index: TAppSettingIndex): Boolean; + function GetDefaultString(Index: TAppSettingIndex): String; + function GetValueName(Index: TAppSettingIndex): String; + function GetValueNames: TStringList; + function GetKeyNames: TStringList; + function GetSessionNames(ParentPath: String; var Folders: TStringList): TStringList; + procedure GetSessionPaths(ParentPath: String; var Sessions: TStringList); + function DeleteValue(Index: TAppSettingIndex; FormatName: String=''): Boolean; overload; + function DeleteValue(ValueName: String): Boolean; overload; + procedure DeleteCurrentKey; + procedure MoveCurrentKey(TargetPath: String); + function ValueExists(Index: TAppSettingIndex): Boolean; + function SessionPathExists(SessionPath: String): Boolean; + function IsEmptyKey: Boolean; + procedure ResetPath; + procedure StorePath; + procedure RestorePath; + property SessionPath: String read FSessionPath write SetSessionPath; + property PortableMode: Boolean read FPortableMode; + property PortableModeReadOnly: Boolean read FPortableModeReadOnly write FPortableModeReadOnly; + property Writes: Integer read FWrites; + procedure ImportSettings(Filename: String); + function ExportSettings(Filename: String): Boolean; overload; + function ExportSettings: Boolean; overload; + // Common directories + function DirnameUserAppData: String; + function DirnameUserDocuments: String; + function DirnameSnippets: String; + function DirnameBackups: String; + function DirnameHighlighters: String; + // "Static" options, initialized in OnCreate only. For settings which need a restart to take effect. + property RestoreTabsInitValue: Boolean read FRestoreTabsInitValue; + end;} + +{$I const.inc} + + function Implode(Separator: String; a: TStrings): String; + function Explode(Separator, Text: String) :TStringList; + //procedure ExplodeQuotedList(Text: String; var List: TStringList); + //function StrEllipsis(const S: String; MaxLen: Integer; FromLeft: Boolean=True): String; + //function encrypt(str: String): String; + //function decrypt(str: String): String; + //function HTMLSpecialChars(str: String): String; + //function EncodeURLParam(const Value: String): String; + //procedure StreamWrite(S: TStream; Text: String = ''); + //function _GetFileSize(Filename: String): Int64; + //function DeleteFileWithUndo(sFileName: String): Boolean; + //function MakeInt(Str: String) : Int64; + //function MakeFloat(Str: String): Extended; + //function RoundCommercial(e: Extended): Int64; + //function CleanupNumber(Str: String): String; + //function IsInt(Str: String): Boolean; + //function IsFloat(Str: String): Boolean; + //function ScanLineBreaks(Text: String): TLineBreaks; + //function fixNewlines(txt: String): String; + //procedure StripNewLines(var txt: String; Replacement: String=' '); + //function GetLineBreak(LineBreakIndex: TLineBreaks): String; + //procedure RemoveNullChars(var Text: String; var HasNulls: Boolean); + //function GetShellFolder(FolderId: TGUID): String; + //function ValidFilename(Str: String): String; + //function FormatNumber( str: String; Thousands: Boolean=True): String; Overload; + //function UnformatNumber(Val: String): String; + //function FormatNumber( int: Int64; Thousands: Boolean=True): String; Overload; + //function FormatNumber( flt: Double; decimals: Integer = 0; Thousands: Boolean=True): String; Overload; + //procedure ShellExec(cmd: String; path: String=''; params: String=''; RunHidden: Boolean=False); + //function getFirstWord(text: String; MustStartWithWordChar: Boolean=True): String; + //function RegExprGetMatch(Expression: String; var Input: String; ReturnMatchNum: Integer; DeleteFromSource, CaseInsensitive: Boolean): String; Overload; + //function RegExprGetMatch(Expression: String; Input: String; ReturnMatchNum: Integer): String; Overload; + //function ExecRegExprI(const ARegExpr, AInputStr: RegExprString): Boolean; + //function FormatByteNumber( Bytes: Int64; Decimals: Byte = 1 ): String; Overload; + //function FormatByteNumber( Bytes: String; Decimals: Byte = 1 ): String; Overload; + //function FormatTimeNumber(Seconds: Double; DisplaySeconds: Boolean; MilliSecondsPrecision: Integer=1): String; + //function GetTempDir: 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; + //function ReadTextfileChunk(Stream: TFileStream; Encoding: TEncoding; ChunkSize: Int64 = 0): String; + //function ReadTextfile(Filename: String; Encoding: TEncoding): String; + //function ReadBinaryFile(Filename: String; MaxBytes: Int64): AnsiString; + //procedure StreamToClipboard(Text, HTML: TStream); + //function WideHexToBin(text: String): AnsiString; + //function BinToWideHex(bin: AnsiString): String; + //procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1); + //function GetTextHeight(Font: TFont): Integer; + //function ColorAdjustBrightness(Col: TColor; Shift: SmallInt): TColor; + //procedure DeInitializeVTNodes(Sender: TBaseVirtualTree); + //function FindNode(VT: TVirtualStringTree; idx: Int64; ParentNode: PVirtualNode): PVirtualNode; + //function SelectNode(VT: TVirtualStringTree; idx: Int64; ParentNode: PVirtualNode=nil): Boolean; overload; + //function SelectNode(VT: TVirtualStringTree; Node: PVirtualNode; ClearSelection: Boolean=True): Boolean; overload; + //procedure GetVTSelection(VT: TVirtualStringTree; var SelectedCaptions: TStringList; var FocusedCaption: String); + //procedure SetVTSelection(VT: TVirtualStringTree; SelectedCaptions: TStringList; FocusedCaption: String); + //function GetNextNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode; + //function GetPreviousNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode; + //function DateBackFriendlyCaption(d: TDateTime): String; + //function DateTimeToStrDef(DateTime: TDateTime; Default: String): String; + //function TruncDef(X: Real; Default: Int64): Int64; + //function GetLightness(AColor: TColor): Byte; + //function ParamBlobToStr(lpData: Pointer): String; + //function ParamStrToBlob(out cbData: DWORD): Pointer; + //function CheckForSecondInstance: Boolean; + //function GetParentFormOrFrame(Comp: TWinControl): TWinControl; + //function KeyPressed(Code: Integer): Boolean; + //function GeneratePassword(Len: Integer): String; + //procedure InvalidateVT(VT: TVirtualStringTree; RefreshTag: Integer; ImmediateRepaint: Boolean); + //function CharAtPos(Str: String; Pos: Integer): Char; + //function CompareAnyNode(Text1, Text2: String): Integer; + //function StringListCompareAnythingAsc(List: TStringList; Index1, Index2: Integer): Integer; + //function StringListCompareAnythingDesc(List: TStringList; Index1, Index2: Integer): Integer; + //function StringListCompareByValue(List: TStringList; Index1, Index2: Integer): Integer; + //function StringListCompareByLength(List: TStringList; Index1, Index2: Integer): Integer; + //function GetImageLinkTimeStamp(const FileName: string): TDateTime; + //function IsEmpty(Str: String): Boolean; + //function IsNotEmpty(Str: String): Boolean; + //function MessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; overload; + //function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; KeepAskingSetting: TAppSettingIndex=asUnused; FooterText: String=''): Integer; overload; + //function ErrorDialog(Msg: string): Integer; overload; + //function ErrorDialog(const Title, Msg: string): Integer; overload; + //function GetLocaleString(const ResourceId: Integer): WideString; + //function GetHTMLCharsetByEncoding(Encoding: TEncoding): String; + //procedure ParseCommandLine(CommandLine: String; var ConnectionParams: TConnectionParameters; var FileNames: TStringList; var RunFrom: String); + function _(const Pattern: string): string; + function f_(const Pattern: string; const Args: array of const): string; + //function GetOutputFilename(FilenameWithPlaceholders: String; DBObj: TDBObject): String; + //function GetOutputFilenamePlaceholders: TStringList; + //function GetSystemImageList: TImageList; + //function GetSystemImageIndex(Filename: String): Integer; + //function GetExecutableBits: Byte; + //procedure Help(Sender: TObject; Anchor: String); + //function PortOpen(Port: Word): Boolean; + //function IsValidFilePath(FilePath: String): Boolean; + //function FileIsWritable(FilePath: String): Boolean; + //function GetProductInfo(dwOSMajorVersion, dwOSMinorVersion, dwSpMajorVersion, dwSpMinorVersion: DWORD; out pdwReturnedProductType: DWORD): BOOL stdcall; external kernel32 delayed; + //function GetCurrentPackageFullName(out Len: Cardinal; Name: PWideChar): Integer; stdcall; external kernel32 delayed; + //function GetThemeColor(Color: TColor): TColor; + //function ThemeIsDark(ThemeName: String=''): Boolean; + //function ProcessExists(pid: Cardinal; ExeNamePattern: String): Boolean; + //procedure ToggleCheckBoxWithoutClick(chk: TCheckBox; State: Boolean); + //function SynCompletionProposalPrettyText(ImageIndex: Integer; LeftText, CenterText, RightText: String; LeftColor: TColor=-1; CenterColor: TColor=-1; RightColor: TColor=-1): String; + //function PopupComponent(Sender: TObject): TComponent; + //function IsWine: Boolean; + //function DirSep: Char; + //procedure FindComponentInstances(BaseForm: TComponent; ClassType: TClass; var List: TObjectList); + //function WebColorStrToColorDef(WebColor: string; Default: TColor): TColor; + //function UserAgent(OwnerComponent: TComponent): String; + //function CodeIndent(Steps: Integer=1): String; + //function EscapeHotkeyPrefix(Text: String): String; + +var + //AppSettings: TAppSettings; + MutexHandle: THandle = 0; + //SystemImageList: TImageList = nil; + //mtCriticalConfirmation: TMsgDlgType = mtCustom; + //ConfirmIcon: TIcon; + NumberChars: TSysCharSet; + LibHandleUser32: THandle; + //UTF8NoBOMEncoding: TUTF8NoBOMEncoding; + DateTimeNever: TDateTime; + IsWineStored: Integer = -1; + +implementation + +uses main; //, extra_controls; + + + +{function WideHexToBin(text: String): AnsiString; +var + buf: AnsiString; +begin + buf := AnsiString(text); + SetLength(Result, Length(text) div 2); + HexToBin(PAnsiChar(buf), @Result[1], Length(Result)); +end;} + +{function BinToWideHex(bin: AnsiString): String; +var + buf: AnsiString; +begin + SetLength(buf, Length(bin) * 2); + BinToHex(@bin[1], PAnsiChar(buf), Length(bin)); + Result := String(buf); +end;} + + +{*** + Convert a TStringList to a string using a separator-string + + @todo Look at each caller to see if escaping is necessary. + @param string Separator + @param a TStringList Containing strings + @return string +} +function Implode(Separator: String; a: TStrings): String; +var + i : Integer; +begin + Result := ''; + for i:=0 to a.Count-1 do + begin + Result := Result + a[i]; + if i < a.Count-1 then + Result := Result + Separator; + end; +end; + + +function Explode(Separator, Text: String): TStringList; +var + i: Integer; + Item: String; +begin + // Explode a string by separator into a TStringList + Result := TStringList.Create; + while true do begin + i := Pos(Separator, Text); + if i = 0 then begin + // Last or only segment: Add to list if it's the last. Add also if it's not empty and list is empty. + // Do not add if list is empty and text is also empty. + if (Result.Count > 0) or (Text <> '') then + Result.Add(Text); + break; + end; + Item := Copy(Text, 1, i-1); + Result.Add(Item); + Delete(Text, 1, i-1+Length(Separator)); + end; +end; + + +{*** + Shorten string to length len and append 3 dots + + @param string String to shorten + @param integer Wished Length of string + @return string +} +{function StrEllipsis(const S: String; MaxLen: Integer; FromLeft: Boolean=True): String; +begin + Result := S; + if Length(Result) <= MaxLen then + Exit; + if FromLeft then begin + SetLength(Result, MaxLen); + Result[MaxLen] := '�'; + end else begin + Result := Copy(Result, Length(Result)-MaxLen, Length(Result)); + Result := '�' + Result; + end; +end;} + + + +{*** + Password-encryption, used to store session-passwords in registry + + @param string Text to encrypt + @return string Encrypted Text +} +{function encrypt(str: String) : String; +var + i, salt, nr : integer; + h : String; +begin + randomize(); + result := ''; + salt := random(9) + 1; + for i:=1 to length(str) do begin + nr := ord(str[i])+salt; + if nr > 255 then + nr := nr - 255; + h := inttohex(nr,0); + if length(h) = 1 then + h := '0' + h; + result := result + h; + end; + result := result + inttostr(salt); +end;} + + + +{*** + Password-decryption, used to restore session-passwords from registry + + @param string Text to decrypt + @return string Decrypted Text +} +{function decrypt(str: String) : String; +var + j, salt, nr : integer; +begin + result := ''; + if str = '' then exit; + j := 1; + salt := StrToIntDef(str[length(str)],0); + result := ''; + while j < length(str)-1 do begin + nr := StrToInt('$' + str[j] + str[j+1]) - salt; + if nr < 0 then + nr := nr + 255; + result := result + chr(nr); + inc(j, 2); + end; +end;} + + +{function HTMLSpecialChars(str: String) : String; +begin + // Convert critical HTML-characters to entities. Used in grid export. + result := StringReplace(str, '&', '&', [rfReplaceAll]); + result := StringReplace(result, '<', '<', [rfReplaceAll]); + result := StringReplace(result, '>', '>', [rfReplaceAll]); +end;} + + +{function EncodeURLParam(const Value: String): String; +var + c: Char; +const} + //UnsafeChars: String = '*<>#%"{}|\^[]`?&+;'; +{begin + // Encode critical chars in url parameter + Result := ''; + for c in Value do begin + if (Pos(c, UnsafeChars)>0) or (Ord(c) < 33) or (Ord(c) > 128) then + Result := Result + '%'+IntToHex(Ord(c), 2) + else + Result := Result + c; + end; +end;} + + +{** + Write some UTF8 text to a file- or memorystream +} +{procedure StreamWrite(S: TStream; Text: String = ''); +var + utf8: AnsiString; +begin + utf8 := Utf8Encode(Text); + S.Write(utf8[1], Length(utf8)); +end;} + + +{*** + Return filesize of a given file + Partly taken from https://www.delphipraxis.net/194137-getfilesize-welches-ist-die-bessere-funktion-2.html + @param string Filename + @return int64 Size in bytes +} +{function _GetFileSize(Filename: String): Int64; +var + Attr: TWin32FileAttributeData; +begin + FillChar(Attr, SizeOf(Attr), 0); + if GetFileAttributesEx(PChar(Filename), GetFileExInfoStandard, @Attr) then + begin + Result := Int64(Attr.nFileSizeHigh) shl 32 + Int64(Attr.nFileSizeLow); + end + else + Result := -1; +end;} + + +{function DeleteFileWithUndo(sFileName: string): Boolean; +var + fos: TSHFileOpStruct; +begin + FillChar(fos, SizeOf(fos), 0); + fos.wFunc := FO_DELETE; + fos.pFrom := PChar(sFileName + #0); + fos.fFlags := FOF_ALLOWUNDO or FOF_NOCONFIRMATION or FOF_SILENT; + Result := (0 = ShFileOperation(fos)); +end;} + + +{*** + Convert a string-number to an integer-number + + @param string String-number + @return int64 +} +{function MakeInt(Str: String): Int64; +begin + // Result has to be of integer type + try + Result := Trunc(MakeFloat(Str)); + except + Result := 0; + end; +end;} + + +{function CleanupNumber(Str: String): String; +var + i: Integer; + HasDecimalSep: Boolean; +begin + // Ensure the passed string contains a valid number, which is convertable by StrToFloat afterwards + // Return it as string again, as there are callers which need to handle unsigned bigint's somehow - + // there is no unsigned 64 bit integer type in Delphi. + Result := ''; + + // Unformatted float coming in? Detect by order of thousand and decimal char + if ((Pos(',', Str) > 0) and (Pos(',', Str) < Pos('.', Str))) + or ((Pos('.', Str) > 0) and (Pos('.', ReverseString(Str)) <> 4)) + then begin + Str := StringReplace(Str, '.', '*', [rfReplaceAll]); + Str := StringReplace(Str, ',', FormatSettings.ThousandSeparator, [rfReplaceAll]); + Str := StringReplace(Str, '*', FormatSettings.DecimalSeparator, [rfReplaceAll]); + end; + + HasDecimalSep := False; + for i:=1 to Length(Str) do begin + if CharInSet(Str[i], NumberChars) or ((Str[i] = '-') and (Result='')) then + begin + // Avoid confusion and AV in StrToFloat() + if (FormatSettings.ThousandSeparator = FormatSettings.DecimalSeparator) and (Str[i] = FormatSettings.DecimalSeparator) then + continue; + // Ensure only 1 decimalseparator is left + if (Str[i] = FormatSettings.DecimalSeparator) and HasDecimalSep then + continue; + if Str[i] = FormatSettings.DecimalSeparator then + HasDecimalSep := True; + if Str[i] = FormatSettings.ThousandSeparator then + Continue; + Result := Result + Str[i]; + end else + Break; + end; + if (Result = '') or (Result = '-') then + Result := '0'; +end;} + + +{function IsInt(Str: String): Boolean; +begin + Result := IntToStr(MakeInt(Str)) = Str; +end;} + + +{function IsFloat(Str: String): Boolean; +begin + Result := FloatToStr(MakeFloat(Str)) = Str; +end;} + + +{*** + Convert a string-number to an floatingpoint-number + + @param String text representation of a number + @return Extended +} +{function MakeFloat(Str: String): Extended; +var + p_kb, p_mb, p_gb, p_tb, p_pb : Integer; +begin + // Convert result to a floating point value to ensure + // we don't discard decimal digits for the next step + Result := StrToFloat(CleanupNumber(Str)); + + // Detect if the string was previously formatted by FormatByteNumber + // and convert it back by multiplying it with its byte unit + p_kb := Pos(NAME_KB, Str); + p_mb := Pos(NAME_MB, Str); + p_gb := Pos(NAME_GB, Str); + p_tb := Pos(NAME_TB, Str); + p_pb := Pos(NAME_PB, Str); + + if (p_kb > 0) and (p_kb = Length(Str)-Length(NAME_KB)+1) then + Result := Result * SIZE_KB + else if (p_mb > 0) and (p_mb = Length(Str)-Length(NAME_MB)+1) then + Result := Result * SIZE_MB + else if (p_gb > 0) and (p_gb = Length(Str)-Length(NAME_GB)+1) then + Result := Result * SIZE_GB + else if (p_tb > 0) and (p_tb = Length(Str)-Length(NAME_TB)+1) then + Result := Result * SIZE_TB + else if (p_pb > 0) and (p_pb = Length(Str)-Length(NAME_PB)+1) then + Result := Result * SIZE_PB; +end;} + + +{function RoundCommercial(e: Extended): Int64; +begin + // "Kaufm�nnisch runden" + // In contrast to Delphi's Round() which rounds *.5 to the next even number + Result := Trunc(e); + if Frac(e) >= 0.5 then + Result := Result + 1; +end;} + + +{*** + SynEdit removes all newlines and semi-randomly decides a + new newline format to use for any text edited. + See also: Delphi's incomplete implementation of TTextLineBreakStyle in System.pas + + @param string Text to test + @return TLineBreaks +} +{function ScanLineBreaks(Text: String): TLineBreaks; +var + i, SeekSize: Integer; + c: Char; + procedure SetResult(Style: TLineBreaks); + begin + // Note: Prefer "(foo <> a) and (foo <> b)" over "not (foo in [a, b])" in excessive loops + // for performance reasons - there is or was a Delphi bug leaving those inline SETs in memory + // after usage. Unfortunately can't remember which bug id it was and if it still exists. + if (Result <> lbsNone) and (Result <> Style) then + Result := lbsMixed + else + Result := Style; + end; +begin + Result := lbsNone; + SeekSize := Min(Length(Text), SIZE_MB); + if SeekSize = 0 then + Exit; + i := 1; + repeat + c := Text[i]; + if c = #13 then begin + if (i < SeekSize) and (Text[i+1] = #10) then begin + Inc(i); + SetResult(lbsWindows); + end else + SetResult(lbsMac); + end else if c = LB_UNIX then + SetResult(lbsUnix) + else if c = LB_WIDE then + SetResult(lbsWide); + i := i + 1; + // No need to do more checks after detecting mixed style + if Result = lbsMixed then + break; + until i > SeekSize; +end;} + + +{*** + Unify CR's and LF's to CRLF + + @param string Text to fix + @return string +} +{function fixNewlines(txt: String): String; +begin + txt := StringReplace(txt, CRLF, #10, [rfReplaceAll]); + txt := StringReplace(txt, #13, #10, [rfReplaceAll]); + txt := StringReplace(txt, #10, CRLF, [rfReplaceAll]); + result := txt; +end;} + +{procedure StripNewLines(var txt: String; Replacement: String=' '); +begin + txt := StringReplace(txt, #13#10, Replacement, [rfReplaceAll]); + txt := StringReplace(txt, #13, Replacement, [rfReplaceAll]); + txt := StringReplace(txt, #10, Replacement, [rfReplaceAll]); +end;} + +{function GetLineBreak(LineBreakIndex: TLineBreaks): String; +begin + case LineBreakIndex of + lbsUnix: Result := LB_UNIX; + lbsMac: Result := LB_MAC; + else Result := CRLF; + end; +end;} + + +{*** + Mangle input text so that SynEdit can load it. +} +{procedure RemoveNullChars(var Text: String; var HasNulls: Boolean); +var + i, Len: Integer; +begin + HasNulls := False; + Len := Length(Text); + for i:=1 to Len do begin + if Text[i] = #0 then begin + Text[i] := #32; // space + HasNulls := True; + end; + end; +end;} + + +{*** + Get the path of a Windows(r)-shellfolder, specified by a KNOWNFOLDERID constant + @see https://docs.microsoft.com/en-us/windows/win32/shell/knownfolderid + @param TGUID constant + @return string Path +} +{function GetShellFolder(FolderId: TGUID): String; +var + Path: PWideChar; +begin + if Succeeded(SHGetKnownFolderPath(FolderId, 0, 0, Path)) then begin + Result := Path; + end else begin + Result := EmptyStr; + end; +end;} + + + +{*** + Remove special characters from a filename + + @param string Filename + @return string +} +{function ValidFilename(Str: String): String; +var + c: Char; +begin + Result := Str; + for c in TPath.GetInvalidFileNameChars do begin + Result := StringReplace(Result, c, '_', [rfReplaceAll]); + end; +end;} + + +{** + Unformat a formatted integer or float. Used for CSV export and composing WHERE clauses for grid editing. +} +{function UnformatNumber(Val: String): String; +var + i: Integer; + HasDecim: Boolean; + c: Char; +const + Numbers = ['0'..'9']; +begin + Result := ''; + HasDecim := False; + for i:=1 to Length(Val) do begin + c := Val[i]; + if (c = '-') and (i = 1) then + Result := Result + c + else if CharInSet(c, Numbers) then begin + if (c = '0') and (Result = '') then + // remove zeropadding + else + Result := Result + c + end else if (c = FormatSettings.DecimalSeparator) and (not HasDecim) then begin + if Result = '' then + Result := '0'; + Result := Result + '.'; + HasDecim := True; + end else if c <> FormatSettings.ThousandSeparator then + break; + end; + if Result = '' then + Result := '0'; +end;} + + +{*** + Return a formatted integer or float from a string + @param string Text containing a number + @return string +} +{function FormatNumber(str: String; Thousands: Boolean=True): String; Overload; +var + i, p, Left: Integer; +begin + Result := StringReplace(str, '.', FormatSettings.DecimalSeparator, [rfReplaceAll]); + if Thousands then begin + // Do not add thousand separators to zerofilled numbers + if ((Length(Result) >= 1) and (Result[1] = '0')) + or ((Length(Result) >= 2) and (Result[1] = '-') and (Result[2] = '0')) + then + Exit; + p := Pos(FormatSettings.DecimalSeparator, Result); + if p = 0 then p := Length(Result)+1; + Left := 2; + if (Length(Result) >= 1) and (Result[1] = '-') then + Left := 3; + if p > 0 then for i:=p-1 downto Left do begin + if (p-i) mod 3 = 0 then + Insert(FormatSettings.ThousandSeparator, Result, i); + end; + end; +end;} + + + +{*** + Return a formatted number from an integer + + @param int64 Number to format + @return string +} +{function FormatNumber(int: Int64; Thousands: Boolean=True): String; Overload; +begin + result := FormatNumber(IntToStr(int), Thousands); +end;} + + + +{*** + Return a formatted number from a float + This function is called by two overloaded functions + + @param double Number to format + @param integer Number of decimals + @return string +} +{function FormatNumber(flt: Double; decimals: Integer = 0; Thousands: Boolean=True): String; Overload; +begin + Result := Format('%10.'+IntToStr(decimals)+'f', [flt]); + Result := Trim(Result); + Result := FormatNumber(Result, Thousands); +end;} + + +{*** + Open URL or execute system command + + @param string Command or URL to execute + @param string Working directory, only usefull is first param is a system command +} +{procedure ShellExec(cmd: String; path: String=''; params: String=''; RunHidden: Boolean=False); +var + Msg: String; + ShowCmd: Integer; +begin + ShowCmd := IfThen(RunHidden, SW_HIDE, SW_SHOWNORMAL); + Msg := 'Executing shell command: "'+cmd+'"'; + if not path.IsEmpty then + Msg := Msg + ' path: "'+path+'"'; + if not params.IsEmpty then + Msg := Msg + ' params: "'+params+'"'; + MainForm.LogSQL(Msg, lcDebug); + ShellExecute(0, 'open', PChar(cmd), PChar(params), PChar(path), ShowCmd); +end;} + + + +{*** + Returns first word of a given text + @param string Given text + @return string First word-boundary +} +{function getFirstWord(text: String; MustStartWithWordChar: Boolean=True): String; +var + i : Integer; + wordChars, wordCharsFirst : TSysCharSet; +begin + result := ''; + text := trim( text ); + // First char in word must not be numerical. Fixes queries like + // /*!40000 SHOW ENGINES */ to be recognized as "result"-queries + // while not breaking getFirstWord in situations where the second + // or later char can be a number (fx the collation in createdatabase). + wordChars := ['a'..'z', 'A'..'Z', '0'..'9', '_', '-']; + if MustStartWithWordChar then + wordCharsFirst := wordChars - ['0'..'9'] + else + wordCharsFirst := wordChars; + i := 1; + + // Find beginning of the first word, ignoring non-alphanumeric chars at the very start + // @see bug #1692828 + while i < Length(text) do + begin + if CharInSet(text[i], wordCharsFirst) then + begin + // Found beginning of word! + break; + end; + if i = Length(text)-1 then + begin + // Give up in the very last loop, reset counter + // and break. We can't find the start of a word + i := 1; + break; + end; + inc(i); + end; + + // Add chars as long as they're alpha-numeric + while i <= Length(text) do + begin + if ((result = '') and CharInSet(text[i], wordCharsFirst)) or CharInSet(text[i], wordChars) then + begin + result := result + text[i]; + end + else + begin + // Stop here because we found a non-alphanumeric char. + // This applies to all different whitespaces, brackets, commas etc. + break; + end; + inc(i); + end; +end;} + + +{function RegExprGetMatch(Expression: String; var Input: String; ReturnMatchNum: Integer; DeleteFromSource, CaseInsensitive: Boolean): String; +var + rx: TRegExpr; +begin + Result := ''; + rx := TRegExpr.Create; + rx.ModifierI := CaseInsensitive; + rx.Expression := Expression; + if rx.Exec(Input) then begin + if rx.SubExprMatchCount >= ReturnMatchNum then begin + Result := rx.Match[ReturnMatchNum]; + if DeleteFromSource then begin + Delete(Input, rx.MatchPos[ReturnMatchNum], rx.MatchLen[ReturnMatchNum]); + Input := Trim(Input); + end; + end; + end; + rx.Free; +end;} + + +{function RegExprGetMatch(Expression: String; Input: String; ReturnMatchNum: Integer): String; +begin + // Version without possibility to delete captured match from input + Result := RegExprGetMatch(Expression, Input, ReturnMatchNum, False, False); +end;} + + +{function ExecRegExprI(const ARegExpr, AInputStr: RegExprString): Boolean; +var + r: TRegExpr; +begin + Result := False; + r := TRegExpr.Create; + r.ModifierI := True; + try + r.Expression := ARegExpr; + Result := r.Exec(AInputStr); + finally + r.Free; + end; +end;} + + +{** + Format a filesize to automatically use the best fitting expression + 16 100 000 Bytes -> 16,1 MB + 4 500 Bytes -> 4,5 KB + @param Int64 Number of Bytes + @param Byte Decimals to display when bytes is bigger than 1M +} +{function FormatByteNumber( Bytes: Int64; Decimals: Byte = 1 ): String; Overload; +begin + if Bytes >= FSIZE_PB then + Result := FormatNumber( Bytes / SIZE_PB, Decimals ) + NAME_PB + else if Bytes >= FSIZE_TB then + Result := FormatNumber( Bytes / SIZE_TB, Decimals ) + NAME_TB + else if Bytes >= FSIZE_GB then + Result := FormatNumber( Bytes / SIZE_GB, Decimals ) + NAME_GB + else if Bytes >= FSIZE_MB then + Result := FormatNumber( Bytes / SIZE_MB, Decimals ) + NAME_MB + else if Bytes >= FSIZE_KB then + Result := FormatNumber( Bytes / SIZE_KB, Decimals ) + NAME_KB + else + Result := FormatNumber( Bytes ) + NAME_BYTES +end;} + + +{** + An overloaded function of the previous one which can + take a string as input +} +{function FormatByteNumber( Bytes: String; Decimals: Byte = 1 ): String; Overload; +begin + Result := FormatByteNumber( MakeInt(Bytes), Decimals ); +end;} + + +{** + Format a number of seconds to a human readable time format + @param Cardinal Number of seconds + @result String 12:34:56.7 +} +{function FormatTimeNumber(Seconds: Double; DisplaySeconds: Boolean; MilliSecondsPrecision: Integer=1): String; +var + d, h, m, s, ms: Integer; + msStr: String; +begin + s := TruncDef(Seconds, 0); + ms := TruncDef((Seconds - s) * Power(10, MilliSecondsPrecision), 0); // Milliseconds, with variable precision/digits + msStr := IntToStr(ms).PadLeft(MilliSecondsPrecision, '0'); + d := s div (60*60*24); + s := s mod (60*60*24); + h := s div (60*60); + s := s mod (60*60); + m := s div 60; + s := s mod 60; + if d > 0 then begin + if DisplaySeconds then begin + Result := Format('%d '+_('days')+', %.2d:%.2d:%.2d', [d, h, m, s]); + Result := Result + '.' + msStr; // Append milliseconds + end + else begin + Result := Format('%d '+_('days')+', %.2d:%.2d h', [d, h, m]); + end; + end else begin + if DisplaySeconds then begin + Result := Format('%.2d:%.2d:%.2d', [h, m, s]); + Result := Result + '.' + msStr; // Append milliseconds + end + else begin + Result := Format('%.2d:%.2d h', [h, m]); + end; + end; +end;} + + +{function GetTempDir: String; +var + TempPath: array[0..MAX_PATH] of Char; +begin + GetTempPath(MAX_PATH, PChar(@TempPath)); + Result := StrPas(TempPath); +end;} + + +{** + Save a textfile with unicode +} +{procedure SaveUnicodeFile(Filename: String; Text: String; Encoding: TEncoding); +var + Writer: TStreamWriter; +begin + Writer := TStreamWriter.Create(Filename, False, Encoding); + Writer.Write(Text); + Writer.Free; +end;} + + +{procedure OpenTextFile(const Filename: String; out Stream: TFileStream; var Encoding: TEncoding); +var + Header: TBytes; + BomLen: Integer; +begin + // Open a textfile and return a stream. Detect its encoding if not passed by the caller + Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone); + if Encoding = nil then + Encoding := DetectEncoding(Stream); + // If the file contains a BOM, advance the stream's position + BomLen := 0; + if Length(Encoding.GetPreamble) > 0 then begin + SetLength(Header, Length(Encoding.GetPreamble)); + Stream.ReadBuffer(Pointer(Header)^, Length(Header)); + if CompareMem(Header, Encoding.GetPreamble, SizeOf(Header)) then + BomLen := Length(Encoding.GetPreamble); + end; + Stream.Position := BomLen; +end;} + + +{** + Detect stream's content encoding through SynEdit's GetEncoding. Result can be: + UTF-16 BE with BOM + UTF-16 LE with BOM + UTF-8 with or without BOM + ANSI + Aimed to work better than WideStrUtils.IsUTF8String() which didn't work in any test case here. + @see http://en.wikipedia.org/wiki/Byte_Order_Mark + Could also do that with TEncoding.GetBufferEncoding, but that relies on the file having a BOM +} +{function DetectEncoding(Stream: TStream): TEncoding; +var + SynEnc: TSynEncoding; + WithBOM: Boolean; +begin + SynEnc := SynUnicode.GetEncoding(Stream, WithBOM); + case SynEnc of + seUTF8: begin + if WithBOM then + Result := TEncoding.UTF8 + else + Result := UTF8NoBOMEncoding; + end; + seUTF16LE: Result := TEncoding.Unicode; + seUTF16BE: Result := TEncoding.BigEndianUnicode; + seAnsi: Result := TEncoding.ANSI; + else Result := UTF8NoBOMEncoding; + end; +end;} + + +{function ReadTextfileChunk(Stream: TFileStream; Encoding: TEncoding; ChunkSize: Int64 = 0): String; +const + BufferPadding = 1; +var + DataLeft, StartPosition: Int64; + LBuffer: TBytes; + i: Integer; +begin + // Read a chunk or the complete contents out of a textfile, opened by OpenTextFile() + if Stream.Size = 0 then begin + Result := ''; + Exit; + end; + + StartPosition := Stream.Position; + DataLeft := Stream.Size - Stream.Position; + if (ChunkSize = 0) or (ChunkSize > DataLeft) then + ChunkSize := DataLeft; + + i := 0; + while True do begin + Inc(i); + try + SetLength(LBuffer, ChunkSize); + Stream.ReadBuffer(Pointer(LBuffer)^, ChunkSize); + LBuffer := Encoding.Convert(Encoding, TEncoding.Unicode, LBuffer); + // Success, exit loop + Break; + except + on E:EEncodingError do begin + if i=10 then // Give up + Raise; + Stream.Position := StartPosition; + Inc(ChunkSize, BufferPadding); + end; + end; + end; + + Result := TEncoding.Unicode.GetString(LBuffer); +end;} + + +{function ReadTextfile(Filename: String; Encoding: TEncoding): String; +var + Stream: TFileStream; +begin + // Read a text file into memory + OpenTextfile(Filename, Stream, Encoding); + Result := ReadTextfileChunk(Stream, Encoding); + Stream.Free; +end;} + + +{function ReadBinaryFile(Filename: String; MaxBytes: Int64): AnsiString; +var + Stream: TFileStream; +begin + Stream := TFileStream.Create(Filename, fmOpenRead or fmShareDenyNone); + Stream.Position := 0; + if (MaxBytes < 1) or (MaxBytes > Stream.Size) then MaxBytes := Stream.Size; + SetLength(Result, MaxBytes); + Stream.Read(PAnsiChar(Result)^, Length(Result)); + Stream.Free; +end;} + + +{procedure StreamToClipboard(Text, HTML: TStream); +var + TextContent, HTMLContent, HTMLHeader, NullPos: AnsiString; + GlobalMem: HGLOBAL; + lp: PChar; + ClpLen: Integer; + CF_HTML: Word; + StartHTML, EndHTML, StartFragment, EndFragment: Integer; +const + PosFormat: AnsiString = '%.10d'; + + procedure ReplacePos(Name: AnsiString; Value: Integer); + var NewPos: AnsiString; + begin + NewPos := Format(PosFormat, [Value]); + HTMLContent := StringReplace(HTMLContent, Name+':'+NullPos, Name+':'+NewPos, []); + end; +begin + // Copy unicode text to clipboard + if Assigned(Text) then begin + SetLength(TextContent, Text.Size); + Text.Position := 0; + Text.Read(PAnsiChar(TextContent)^, Text.Size); + Clipboard.TryAsText := Utf8ToString(TextContent); + SetString(TextContent, nil, 0); + end; + + if Assigned(HTML) then begin + // If wanted, add a HTML portion, so formatted text can be pasted in WYSIWYG + // editors (mostly MS applications). + // Note that the content is UTF8 encoded ANSI. Using unicode variables results in raw + // text pasted in editors. TODO: Find out why and optimize redundant code away by a loop. + OpenClipBoard(0); + CF_HTML := RegisterClipboardFormat('HTML Format'); + SetLength(HTMLContent, HTML.Size); + HTML.Position := 0; + HTML.Read(PAnsiChar(HTMLContent)^, HTML.Size); + if Pos(AnsiString('Version:'), HTMLContent) = 0 then begin + // Only required if header was not already prepended by SynEdit, e.g. in grid export of SQL Inserts + NullPos := Format(PosFormat, [0]); + HTMLHeader := 'Version:0.9' + sLineBreak + + 'StartHTML:' + NullPos + sLineBreak + + 'EndHTML:' + NullPos + sLineBreak + + 'StartFragment:' + NullPos + sLineBreak + + 'EndFragment:' + NullPos + sLineBreak; + StartHTML := Length(HTMLHeader); + HTMLContent := HTMLHeader + HTMLContent; + EndHTML := Length(HTMLContent); + StartFragment := Pos(AnsiString('<body>'), HTMLContent) + 6; + EndFragment := Pos(AnsiString('</body'), HTMLContent)-1; + ReplacePos('StartHTML', StartHTML); + ReplacePos('EndHTML', EndHTML); + ReplacePos('StartFragment', StartFragment); + ReplacePos('EndFragment', EndFragment); + end; + ClpLen := Length(HTMLContent) + 1; + GlobalMem := GlobalAlloc(GMEM_DDESHARE + GMEM_MOVEABLE, ClpLen); + lp := GlobalLock(GlobalMem); + Move(PAnsiChar(HTMLContent)^, lp[0], ClpLen); + SetString(HTMLContent, nil, 0); + GlobalUnlock(GlobalMem); + SetClipboardData(CF_HTML, GlobalMem); + CloseClipboard; + end; +end;} + + +{procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word=1); +var + SingleLineHeight: Integer; + Node: PVirtualNode; +begin + // This is called either in some early stage, or from preferences dialog + VT.BeginUpdate; + SingleLineHeight := GetTextHeight(VT.Font) + 7; + // Multiline nodes? + VT.DefaultNodeHeight := SingleLineHeight * MultiLineCount; + VT.Header.Height := SingleLineHeight; + // Apply new height to multi line grid nodes + Node := VT.GetFirstInitialized; + while Assigned(Node) do begin + VT.NodeHeight[Node] := VT.DefaultNodeHeight; + // Nodes have vsMultiLine through InitNode event + VT.MultiLine[Node] := MultiLineCount > 1; + Node := VT.GetNextInitialized(Node); + end; + VT.EndUpdate; + // 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] + else + VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions - [toHotTrack]; + VT.OnGetHint := MainForm.AnyGridGetHint; + VT.OnScroll := MainForm.AnyGridScroll; + VT.OnMouseWheel := MainForm.AnyGridMouseWheel; + VT.ShowHint := True; + + if toGridExtensions in VT.TreeOptions.MiscOptions then + VT.HintMode := hmHint // Show cell contents with linebreakds in datagrid and querygrid's + else + VT.HintMode := hmTooltip; // Just a quick tooltip for clipped nodes + // Apply case insensitive incremental search event + if VT.IncrementalSearch <> VirtualTrees.Types.isNone then + VT.OnIncrementalSearch := Mainform.AnyGridIncrementalSearch; + VT.OnStartOperation := Mainform.AnyGridStartOperation; + VT.OnEndOperation := Mainform.AnyGridEndOperation; +end;} + + +{function GetTextHeight(Font: TFont): Integer; +var + DC: HDC; + SaveFont: HFont; + SysMetrics, Metrics: TTextMetric; +begin + // Code taken from StdCtrls.TCustomEdit.AdjustHeight + DC := GetDC(0); + GetTextMetrics(DC, SysMetrics); + SaveFont := SelectObject(DC, Font.Handle); + GetTextMetrics(DC, Metrics); + SelectObject(DC, SaveFont); + ReleaseDC(0, DC); + Result := Metrics.tmHeight; +end;} + + +{function ColorAdjustBrightness(Col: TColor; Shift: SmallInt): TColor; +var + Lightness: Byte; +begin + // If base color is bright, make bg color darker (grey), and vice versa, so that + // colors work with high contrast mode for accessibility + Lightness := GetLightness(Col); + if (Lightness < 128) and (Shift < 0) then + Shift := Abs(Shift) + else if (Lightness > 128) and (Shift > 0) then + Shift := 0 - Abs(Shift); + Result := ColorAdjustLuma(Col, Shift, true); +end;} + + +{procedure DeInitializeVTNodes(Sender: TBaseVirtualTree); +var + Node: PVirtualNode; +begin + // Forces a VirtualTree to (re-)initialize its nodes. + // I wonder why this is not implemented in VirtualTree. + Node := Sender.GetFirstInitialized; + while Assigned(Node) do begin + Node.States := Node.States - [vsInitialized]; + Node := Sender.GetNextInitialized(Node); + end; +end;} + + +{function FindNode(VT: TVirtualStringTree; idx: Int64; ParentNode: PVirtualNode): PVirtualNode; +var + Node: PVirtualNode; +begin + // Helper to find a node by its index + Result := nil; + Node := nil; + try + if Assigned(ParentNode) then + Node := VT.GetFirstChild(ParentNode) + else + Node := VT.GetFirst; + except + // Sporadically, TBaseVirtualTree.GetFirst throws an exception when reading FRoot.FirstChild + // Tab restoring is sometimes crashing for that reason. + end; + while Assigned(Node) do begin + // Note: Grid.RootNodeCount is unfortunately Cardinal, not UInt64. + if Node.Index = idx then begin + Result := Node; + break; + end; + Node := VT.GetNextSibling(Node); + end; +end;} + + +{function SelectNode(VT: TVirtualStringTree; idx: Int64; ParentNode: PVirtualNode=nil): Boolean; overload; +var + Node: PVirtualNode; +begin + // Helper to focus and highlight a node by its index + Node := FindNode(VT, idx, ParentNode); + if Assigned(Node) then + Result := SelectNode(VT, Node) + else + Result := False; +end;} + + +{function SelectNode(VT: TVirtualStringTree; Node: PVirtualNode; ClearSelection: Boolean=True): Boolean; overload; +var + OldFocus: PVirtualNode; + MinimumColumnIndex: TColumnIndex; +begin + if Node = VT.RootNode then + Node := nil; + OldFocus := VT.FocusedNode; + Result := True; + if (Node <> OldFocus) and Assigned(VT.OnFocusChanging) then begin + VT.OnFocusChanging(VT, OldFocus, Node, VT.FocusedColumn, VT.FocusedColumn, Result); + end; + if Result then begin + if ClearSelection then + VT.ClearSelection; + VT.FocusedNode := Node; + MinimumColumnIndex := VT.Header.Columns.GetFirstVisibleColumn(True); + if VT.FocusedColumn < MinimumColumnIndex then + VT.FocusedColumn := MinimumColumnIndex; + VT.Selected[Node] := True; + VT.ScrollIntoView(Node, False); + if (OldFocus = Node) and Assigned(VT.OnFocusChanged) then + VT.OnFocusChanged(VT, Node, VT.FocusedColumn); + end; +end;} + + +{procedure GetVTSelection(VT: TVirtualStringTree; var SelectedCaptions: TStringList; var FocusedCaption: String); +var + Node: PVirtualNode; + InvalidationTag: Integer; +begin + // Return captions of selected nodes + InvalidationTag := vt.Tag; + vt.Tag := VTREE_LOADED; + SelectedCaptions.Clear; + Node := GetNextNode(VT, nil, true); + while Assigned(Node) do begin + SelectedCaptions.Add(VT.Text[Node, VT.Header.MainColumn]); + if Node = VT.FocusedNode then begin + FocusedCaption := VT.Text[Node, VT.Header.MainColumn]; + end; + Node := GetNextNode(VT, Node, true); + end; + vt.Tag := InvalidationTag; +end;} + + +{procedure SetVTSelection(VT: TVirtualStringTree; SelectedCaptions: TStringList; FocusedCaption: String); +var + Node: PVirtualNode; + idx: Integer; + DoFocusChange: Boolean; +begin + // Restore selected nodes based on captions list + DoFocusChange := False; + Node := GetNextNode(VT, nil, false); + while Assigned(Node) do begin + idx := SelectedCaptions.IndexOf(VT.Text[Node, VT.Header.MainColumn]); + if idx > -1 then + VT.Selected[Node] := True; + if (not FocusedCaption.IsEmpty) and (VT.Text[Node, VT.Header.MainColumn] = FocusedCaption) then begin + VT.FocusedNode := Node; + DoFocusChange := True; + end; + Node := GetNextNode(VT, Node, false); + end; + // Fire focus change event if there was a focused one before + if DoFocusChange and Assigned(VT.OnFocusChanged) then begin + VT.OnFocusChanged(VT, VT.FocusedNode, VT.FocusedColumn); + end; +end;} + + +{function GetNextNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode; +begin + // Get next visible + selected node. Not possible with VTree's own functions. + Result := CurrentNode; + while True do begin + if Selected then begin + if not Assigned(Result) then + Result := Tree.GetFirstSelected + else + Result := Tree.GetNextSelected(Result); + end else begin + if not Assigned(Result) then + Result := Tree.GetFirst + else + Result := Tree.GetNext(Result); + end; + if (not Assigned(Result)) or Tree.IsVisible[Result] then + break; + end; +end;} + + +{function GetPreviousNode(Tree: TVirtualStringTree; CurrentNode: PVirtualNode; Selected: Boolean=False): PVirtualNode; +begin + // Get previous visible + selected node. + Result := CurrentNode; + while True do begin + if Selected then begin + if not Assigned(Result) then begin + Result := Tree.GetLast; + if not Tree.Selected[Result] then + Result := Tree.GetPreviousSelected(Result); + end else + Result := Tree.GetPreviousSelected(Result); + end else begin + if not Assigned(Result) then + Result := Tree.GetLast + else + Result := Tree.GetPrevious(Result); + end; + if (not Assigned(Result)) or Tree.IsVisible[Result] then + break; + end; +end;} + + +{function DateBackFriendlyCaption(d: TDateTime): String; +var + MonthsAgo, DaysAgo, HoursAgo, MinutesAgo: Int64; +begin + MonthsAgo := MonthsBetween(Now, d); + DaysAgo := DaysBetween(Now, d); + HoursAgo := HoursBetween(Now, d); + MinutesAgo := MinutesBetween(Now, d); + if MonthsAgo = 1 then Result := f_('%s month ago', [FormatNumber(MonthsAgo)]) + else if MonthsAgo > 1 then Result := f_('%s months ago', [FormatNumber(MonthsAgo)]) + else if DaysAgo = 1 then Result := f_('%s day ago', [FormatNumber(DaysAgo)]) + else if DaysAgo > 1 then Result := f_('%s days ago', [FormatNumber(DaysAgo)]) + else if HoursAgo = 1 then Result := f_('%s hour ago', [FormatNumber(HoursAgo)]) + else if HoursAgo > 1 then Result := f_('%s hours ago', [FormatNumber(HoursAgo)]) + else if MinutesAgo = 1 then Result := f_('%s minute ago', [FormatNumber(MinutesAgo)]) + else if MinutesAgo > 0 then Result := f_('%s minutes ago', [FormatNumber(MinutesAgo)]) + else Result := _('less than a minute ago'); +end;} + + +{function DateTimeToStrDef(DateTime: TDateTime; Default: String) : String; +begin + try + if DateTime = 0 then + Result := Default + else + Result := DateTimeToStr(DateTime); + except + on EInvalidOp do Result := Default; + end; +end;} + + +{function TruncDef(X: Real; Default: Int64): Int64; +begin + try + Result := Trunc(X); + except + on EInvalidOp do Result := Default; + end; +end;} + + +{procedure ExplodeQuotedList(Text: String; var List: TStringList); +var + i: Integer; + Quote: Char; + Opened, Closed: Boolean; + Item: String; +begin + Text := Trim(Text); + if Length(Text) > 0 then + Quote := Text[1] + else + Quote := '`'; + Opened := False; + Closed := True; + Item := ''; + for i:=1 to Length(Text) do begin + if Text[i] = Quote then begin + Opened := not Opened; + Closed := not Closed; + if Closed then begin + List.Add(Item); + Item := ''; + end; + Continue; + end; + if Opened and (not Closed) then + Item := Item + Text[i]; + end; +end;} + + +{function GetLightness(AColor: TColor): Byte; +var + R, G, B: Byte; + MaxValue, MinValue: Double; + Lightness: Double; +begin + R := GetRValue(ColorToRGB(AColor)); + G := GetGValue(ColorToRGB(AColor)); + B := GetBValue(ColorToRGB(AColor)); + MaxValue := Max(Max(R,G),B); + MinValue := Min(Min(R,G),B); + Lightness := (((MaxValue + MinValue) * 240) + 255 ) / 510; + Result := Round(Lightness); +end;} + + + +{ *** TSortItem } + +{procedure TSortItem.Assign(Source: TPersistent); +var + SourceItem: TSortItem; +begin + if Source is TSortItem then begin + SourceItem := Source as TSortItem; + Column := SourceItem.Column; + Order := SourceItem.Order; + end + else + Inherited; +end;} + + +{ *** TSortItems } + +{function TSortItems.AddNew(Column: String=''; Order: TSortItemOrder=sioAscending): TSortItem; +begin + Result := TSortItem.Create; + Result.Column := Column; + Result.Order := Order; + Add(Result); +end;} + + +{function TSortItems.ComposeOrderClause(Connection: TDBConnection): String; +var + SortItem: TSortItem; + SortOrder: String; +begin + // Concat all sort options to an ORDER BY clause + Result := ''; + for SortItem in Self do begin + if Result <> '' then + Result := Result + ', '; + if SortItem.Order = sioAscending then + SortOrder := Connection.GetSQLSpecifity(spOrderAsc) + else + SortOrder := Connection.GetSQLSpecifity(spOrderDesc); + Result := Result + Connection.QuoteIdent(SortItem.Column) + ' ' + SortOrder; + end; +end;} + + +{function TSortItems.FindByColumn(Column: String): TSortItem; +var + SortItem: TSortItem; +begin + Result := nil; + for SortItem in Self do begin + if SortItem.Column = Column then begin + Result := SortItem; + Break; + end; + end; +end;} + + +{procedure TSortItems.Assign(Source: TSortItems); +var + Item, ItemCopy: TSortItem; +begin + Clear; + for Item in Source do begin + ItemCopy := AddNew; + ItemCopy.Assign(Item); + end; +end;} + + +{ *** TDBObjectEditor } + +{constructor TDBObjectEditor.Create(AOwner: TComponent); +begin + inherited; + // Do not set alClient via DFM! In conjunction with ExplicitXXX properties that + // repeatedly breaks the GUI layout when you reload the project + Align := alClient; + FMainSynMemo := nil; + DBObject := nil; + TranslateComponent(Self); +end;} + +{destructor TDBObjectEditor.Destroy; +begin + inherited; +end;} + +{procedure TDBObjectEditor.SetModified(Value: Boolean); +begin + FModified := Value; +end;} + +{function TDBObjectEditor.ObjectExists: Boolean; +begin + Result := not DBObject.Name.IsEmpty; +end;} + +{procedure TDBObjectEditor.Init(Obj: TDBObject); +var + editName: TWinControl; + SynMemo: TSynMemo; + popup: TPopupMenu; + Item: TMenuItem; + i: Integer; + IsRefresh: Boolean; +begin + Mainform.ShowStatusMsg(_('Initializing editor ...')); + Mainform.LogSQL(Self.ClassName+'.Init, using object "'+Obj.Name+'"', lcDebug); + TExtForm.FixControls(Self); + IsRefresh := Assigned(DBObject) and DBObject.IsSameAs(Obj); + if IsRefresh and Assigned(FMainSynMemo) then + FMainSynMemoPreviousTopLine := FMainSynMemo.TopLine + else + FMainSynMemoPreviousTopLine := 0; + DBObject := TDBObject.Create(Obj.Connection); + DBObject.Assign(Obj); + Mainform.UpdateEditorTab; + Screen.Cursor := crHourglass; + // Enable user to start typing immediately when creating a new object + if DBObject.Name = '' then begin + editName := FindComponent('editName') as TWinControl; + if Assigned(editName) and editName.CanFocus then + editName.SetFocus; + end; + + for i:=0 to ComponentCount-1 do begin + if not(Components[i] is TSynMemo) then + Continue; + + SynMemo := Components[i] as TSynMemo; + if (not Assigned(SynMemo)) or Assigned(SynMemo.PopupMenu) then + Continue; + + popup := TPopupMenu.Create(Self); + popup.Images := MainForm.VirtualImageListMain; + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actCopy; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actCut; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actPaste; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actSelectAll; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actSaveSynMemoToTextfile; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actToggleComment; + popup.Items.Add(Item); + + Item := TMenuItem.Create(popup); + Item.Action := MainForm.actReformatSQL; + popup.Items.Add(Item); + + SynMemo.PopupMenu := popup; + + end; + +end;} + +{function TDBObjectEditor.DeInit: TModalResult; +var + Msg, ObjType: String; +begin + // Ask for saving modifications + Result := mrOk; + if Modified then begin + ObjType := _(LowerCase(DBObject.ObjType)); + // Todo: no save button for objects without minimum requirements, such as name. See #1134 + if DBObject.Name <> '' then + Msg := f_('Save modified %s "%s"?', [ObjType, DBObject.Name]) + else + Msg := f_('Save new %s?', [ObjType]); + Result := MessageDialog(Msg, mtConfirmation, [mbYes, mbNo, mbCancel]); + case Result of + mrYes: Result := ApplyModifications; + mrNo: Modified := False; + end; + end; +end;} + + + + +// Following code taken from OneInst.pas, http://assarbad.net/de/stuff/!import/nico.old/ +// Slightly modified to better integrate that into our code, comments translated from german. + +// Fetch and separate command line parameters into strings +{function ParamBlobToStr(lpData: Pointer): String; +var + pStr: PChar; +begin + pStr := lpData; + Result := string(pStr); +end;} + +// Pack current command line parameters +{function ParamStrToBlob(out cbData: DWORD): Pointer; +var + cmd: String; +begin + cmd := GetCommandLine; + cbData := Length(cmd)*2 + 3; + Result := PChar(cmd); +end;} + +{procedure HandleSecondInstance; +var + Run: DWORD; + Now: DWORD; + Msg: TMsg; + Wnd: HWND; + Dat: TCopyDataStruct; +begin + // MessageBox(0, 'already running', nil, MB_ICONINFORMATION); + // Send a message to all main windows (HWND_BROADCAST) with the identical, + // previously registered message id. We should only get reply from 0 or 1 + // instances. + // (Broadcast should only be called with registered message ids!) + + SendMessage(HWND_BROADCAST, SecondInstMsgId, GetCurrentThreadId, 0); + + // Waiting for reply by first instance. For those of you which didn't knew: + // Threads have message queues too ;o) + Wnd := 0; + Run := GetTickCount; + while True do + begin + if PeekMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId, PM_NOREMOVE) then + begin + GetMessage(Msg, 0, SecondInstMsgId, SecondInstMsgId); + if Msg.message = SecondInstMsgId then + begin + Wnd := Msg.wParam; + Break; + end; + end; + Now := GetTickCount; + if Now < Run then + Run := Now; // Avoid overflow, each 48 days. + if Now - Run > 5000 then + Break; + end; + + if (Wnd <> 0) and IsWindow(Wnd) then + begin + // As a reply we got a handle to which we now send current parameters + Dat.dwData := SecondInstMsgId; + Dat.lpData := ParamStrToBlob(Dat.cbData); + SendMessage(Wnd, WM_COPYDATA, 0, LPARAM(@Dat)); + // Leads to an AV in 64bit mode. See issue #3475: + // FreeMemory(Dat.lpData); + + // Bring first instance to front + if IsIconic(Wnd) then + ShowWindow(Wnd, SW_RESTORE); + BringWindowToTop(Wnd); + SetForegroundWindow(Wnd); + end; +end;} + +{function CheckForSecondInstance: Boolean; +var + Loop: Integer; + MutexName: PChar; +begin + // Try to create a system wide named kernel object (mutex). And check if that + // already exists. + // The name of such a mutex must not be longer than MAX_PATH (260) chars and + // can contain all chars but not '\' + + Result := False; + MutexName := PChar(APPNAME); + for Loop := lstrlen(MutexName) to MAX_PATH - 1 do + begin + MutexHandle := CreateMutex(nil, False, MutexName); + if (MutexHandle = 0) and (GetLastError = INVALID_HANDLE_VALUE) then + // Looks like there is already a mutex using this name + // Try to solve that by appending an underscore + lstrcat(MutexName, '_') + else + // At least no naming conflict + Break; + end; + + case GetLastError of + 0: begin + // We created the mutex, so this is the first instance + end; + ERROR_ALREADY_EXISTS: + begin + // There is already one instance + try + HandleSecondInstance; + finally + // Terminating is done in .dpr file, before Application.Initialize + Result := True; + end; + end; + else + // No clue why we should get here. Oh, maybe Microsoft has changed rules, again. + // However, we return false and let the application start + end; +end;} + + +{function GetParentFormOrFrame(Comp: TWinControl): TWinControl; +begin + Result := Comp; + while True do begin + try + Result := Result.Parent; + except + on E:EAccessViolation do + Break; + end; + // On a windows shutdown, GetParentForm() seems sporadically unable to find the owner form + // In that case we would cause an exception when accessing it. Emergency break in that case. + // See issue #1462 + if (not Assigned(Result)) or (Result is TCustomForm) or (Result is TFrame) then + break; + end; +end;} + + +{function KeyPressed(Code: Integer): Boolean; +var + State: TKeyboardState; +begin + // Checks whether a key is pressed, defined by virtual key code + GetKeyboardState(State); + Result := (State[Code] and 128) <> 0; +end;} + + +{function GeneratePassword(Len: Integer): String; +var + i: Integer; + CharTable: String; +const + Consos = 'bcdfghjklmnpqrstvwxyzBCDFGHJKLMNPQRSTVWXYZ'; + Vocals = 'aeiouAEIOU'; + Numbers = '123456789'; +begin + // Create a random, mnemonic password + SetLength(Result, Len); + for i:=1 to Len do begin + if Random(4) = 1 then + CharTable := Numbers + else if i mod 2 = 0 then + CharTable := Vocals + else + CharTable := Consos; + Result[i] := CharTable[Random(Length(CharTable)-1)+1]; + end; +end;} + + +{procedure InvalidateVT(VT: TVirtualStringTree; RefreshTag: Integer; ImmediateRepaint: Boolean); +begin + // Avoid AVs in OnDestroy events + if not Assigned(VT) then + Exit; + VT.Tag := RefreshTag; + if ImmediateRepaint then + VT.Repaint + else + VT.Invalidate; +end;} + + +{function CharAtPos(Str: String; Pos: Integer): Char; +begin + // Access char in string without causing access violation + if Length(Str) < Pos then + Result := #0 + else + Result := Str[Pos]; +end;} + + +{function CompareAnyNode(Text1, Text2: String): Integer; +var + Number1, Number2 : Extended; + a1, a2, b1, b2: Char; + NumberMode: Boolean; +const + Numbers = ['0'..'9']; +begin + Result := 0; + // Apply different comparisons for numbers and text + a1 := CharAtPos(Text1, 1); + a2 := CharAtPos(Text1, 2); + b1 := CharAtPos(Text2, 1); + b2 := CharAtPos(Text2, 2); + NumberMode := ((a1='-') and (CharInSet(a2, Numbers)) or CharInSet(a1, Numbers)) + and ((b1='-') and (CharInSet(b2, Numbers)) or CharInSet(b1, Numbers)); + if NumberMode then begin + // Assuming numeric values + Number1 := MakeFloat(Text1); + Number2 := MakeFloat(Text2); + if Number1 > Number2 then + Result := 1 + else if Number1 = Number2 then + Result := 0 + else if Number1 < Number2 then + Result := -1; + end; + if (not NumberMode) or (Result=0) then begin + // Compare Strings + Result := CompareText(Text1, Text2); + end; +end;} + + +{function StringListCompareAnythingAsc(List: TStringList; Index1, Index2: Integer): Integer; +begin + // Sort TStringList items, containing numbers or strings, ascending + Result := CompareAnyNode(List[Index1], List[Index2]); +end;} + + +{function StringListCompareAnythingDesc(List: TStringList; Index1, Index2: Integer): Integer; +begin + // Sort TStringList items, containing numbers or strings, descending + Result := CompareAnyNode(List[Index2], List[Index1]); +end;} + + +{function StringListCompareByValue(List: TStringList; Index1, Index2: Integer): Integer; +begin + // Sort TStringList items which are stored as name=value pairs + Result := CompareAnyNode(List.ValueFromIndex[Index2], List.ValueFromIndex[Index1]); +end;} + + +{function StringListCompareByLength(List: TStringList; Index1, Index2: Integer): Integer; +begin + // Sort TStringList items by their length + Result := CompareValue(List[Index2].Length, List[Index1].Length); +end;} + + +{** + Return compile date/time from passed .exe name + Code taken and modified from Michael Puff + http://www.michael-puff.de/Programmierung/Delphi/Code-Snippets/GetImageLinkTimeStamp.shtml +} +{function GetImageLinkTimeStamp(const FileName: string): TDateTime; +const + INVALID_SET_FILE_POINTER = DWORD(-1); + BorlandMagicTimeStamp = $2A425E19; // Delphi 4-6 (and above?) + FileTime1970: TFileTime = (dwLowDateTime:$D53E8000; dwHighDateTime:$019DB1DE); +type + PImageSectionHeaders = ^TImageSectionHeaders; + TImageSectionHeaders = array [Word] of TImageSectionHeader; +type + PImageResourceDirectory = ^TImageResourceDirectory; + TImageResourceDirectory = packed record + Characteristics: DWORD; + TimeDateStamp: DWORD; + MajorVersion: Word; + MinorVersion: Word; + NumberOfNamedEntries: Word; + NumberOfIdEntries: Word; + end; +var + FileHandle: THandle; + BytesRead: DWORD; + ImageDosHeader: TImageDosHeader; + ImageNtHeaders: TImageNtHeaders; + SectionHeaders: PImageSectionHeaders; + Section: Word; + ResDirRVA: DWORD; + ResDirSize: DWORD; + ResDirRaw: DWORD; + ResDirTable: TImageResourceDirectory; + FileTime: TFileTime; + TimeStamp: DWord; +begin + TimeStamp := 0; + Result := 0; + // Open file for read access + FileHandle := CreateFile(PChar(FileName), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0); + if (FileHandle <> INVALID_HANDLE_VALUE) then try + // Read MS-DOS header to get the offset of the PE32 header + // (not required on WinNT based systems - but mostly available) + if not ReadFile(FileHandle, ImageDosHeader, SizeOf(TImageDosHeader), + BytesRead, nil) or (BytesRead <> SizeOf(TImageDosHeader)) or + (ImageDosHeader.e_magic <> IMAGE_DOS_SIGNATURE) then begin + ImageDosHeader._lfanew := 0; + end; + // Read PE32 header (including optional header + if (SetFilePointer(FileHandle, ImageDosHeader._lfanew, nil, FILE_BEGIN) = INVALID_SET_FILE_POINTER) then + Exit; + if not(ReadFile(FileHandle, ImageNtHeaders, SizeOf(TImageNtHeaders), BytesRead, nil) and (BytesRead = SizeOf(TImageNtHeaders))) then + Exit; + // Validate PE32 image header + if (ImageNtHeaders.Signature <> IMAGE_NT_SIGNATURE) then + Exit; + // Seconds since 1970 (UTC) + TimeStamp := ImageNtHeaders.FileHeader.TimeDateStamp; + + // Check for Borland's magic value for the link time stamp + // (we take the time stamp from the resource directory table) + if (ImageNtHeaders.FileHeader.TimeDateStamp = BorlandMagicTimeStamp) then + with ImageNtHeaders, FileHeader, OptionalHeader do begin + // Validate Optional header + if (SizeOfOptionalHeader < IMAGE_SIZEOF_NT_OPTIONAL_HEADER) or (Magic <> IMAGE_NT_OPTIONAL_HDR_MAGIC) then + Exit; + // Read section headers + SectionHeaders := + GetMemory(NumberOfSections * SizeOf(TImageSectionHeader)); + if Assigned(SectionHeaders) then try + if (SetFilePointer(FileHandle, SizeOfOptionalHeader - IMAGE_SIZEOF_NT_OPTIONAL_HEADER, nil, FILE_CURRENT) = INVALID_SET_FILE_POINTER) then + Exit; + if not(ReadFile(FileHandle, SectionHeaders^, NumberOfSections * SizeOf(TImageSectionHeader), BytesRead, nil) and (BytesRead = NumberOfSections * SizeOf(TImageSectionHeader))) then + Exit; + // Get RVA and size of the resource directory + with DataDirectory[IMAGE_DIRECTORY_ENTRY_RESOURCE] do begin + ResDirRVA := VirtualAddress; + ResDirSize := Size; + end; + // Search for section which contains the resource directory + ResDirRaw := 0; + for Section := 0 to NumberOfSections - 1 do + with SectionHeaders[Section] do + if (VirtualAddress <= ResDirRVA) and (VirtualAddress + SizeOfRawData >= ResDirRVA + ResDirSize) then begin + ResDirRaw := PointerToRawData - (VirtualAddress - ResDirRVA); + Break; + end; + // Resource directory table found? + if (ResDirRaw = 0) then + Exit; + // Read resource directory table + if (SetFilePointer(FileHandle, ResDirRaw, nil, FILE_BEGIN) = INVALID_SET_FILE_POINTER) then + Exit; + if not(ReadFile(FileHandle, ResDirTable, SizeOf(TImageResourceDirectory), BytesRead, nil) and (BytesRead = SizeOf(TImageResourceDirectory))) then + Exit; + // Convert from DosDateTime to SecondsSince1970 + if DosDateTimeToFileTime(HiWord(ResDirTable.TimeDateStamp), LoWord(ResDirTable.TimeDateStamp), FileTime) then begin + // FIXME: Borland's linker uses the local system time + // of the user who linked the executable image file. + // (is that information anywhere?) + TimeStamp := (ULARGE_INTEGER(FileTime).QuadPart - ULARGE_INTEGER(FileTime1970).QuadPart) div 10000000; + end; + finally + FreeMemory(SectionHeaders); + end; + end; + finally + CloseHandle(FileHandle); + end; + Result := UnixToDateTime(TimeStamp); +end;} + + +{function IsEmpty(Str: String): Boolean; +begin + // Alternative version of "Str = ''" + Result := Str = ''; +end;} + +{function IsNotEmpty(Str: String): Boolean; +begin + // Alternative version of "Str <> ''" + Result := Str <> ''; +end;} + + +{function MessageDialog(const Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons): Integer; +begin + Result := MessageDialog('', Msg, DlgType, Buttons); +end;} + + +{function MessageDialog(const Title, Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; KeepAskingSetting: TAppSettingIndex=asUnused; FooterText: String=''): Integer; +var + m: String; + Dialog: TTaskDialog; + Btn: TTaskDialogButtonItem; + MsgButton: TMsgDlgBtn; + rx: TRegExpr; + KeepAskingValue: Boolean; + Hotkeys: String; + WebSearchUrl, WebSearchHost: String; + + procedure AddButton(BtnCaption: String; BtnResult: TModalResult; ResourceId: Integer=0); + var + i: Integer; + cap: String; + begin + Btn := TTaskDialogButtonItem(Dialog.Buttons.Add); + cap := ''; + if ResourceId > 0 then begin + // Prefer string from user32.dll + // May be empty on Wine! + cap := GetLocaleString(ResourceId) + end; + if cap.IsEmpty then begin + cap := _(BtnCaption); + for i:=1 to Length(cap) do begin + // Auto apply hotkey + if (Pos(LowerCase(cap[i]), Hotkeys) = 0) and cap[i].IsLetter then begin + Hotkeys := Hotkeys + LowerCase(cap[i]); + Insert('&', cap, i); + break; + end; + end; + end; + Btn.Caption := cap; + Btn.ModalResult := BtnResult; + if (DlgType = mtCriticalConfirmation) and (BtnResult = mrCancel) then + Btn.Default := True; + end; +begin + // Remember current path and restore it later, so the caller does not try to read from the wrong path after this dialog + AppSettings.StorePath; + + if (Win32MajorVersion >= 6) and StyleServices.Enabled then begin + // Use modern task dialog on Vista and above + Dialog := TTaskDialog.Create(nil); + Dialog.Flags := [tfEnableHyperlinks, tfAllowDialogCancellation]; + Dialog.CommonButtons := []; + if Assigned(MainForm) then + Dialog.OnHyperlinkClicked := MainForm.TaskDialogHyperLinkClicked; + + // Caption, title and text + case DlgType of + mtWarning: Dialog.Caption := _('Warning'); + mtError: Dialog.Caption := _('Error'); + mtInformation: Dialog.Caption := _('Information'); + mtConfirmation, mtCustom: Dialog.Caption := _('Confirm'); + end; + if Title <> Dialog.Caption then + Dialog.Title := Title; + if Assigned(MainForm) and (MainForm.ActiveConnection <> nil) then + Dialog.Caption := MainForm.ActiveConnection.Parameters.SessionName + ': ' + Dialog.Caption; + rx := TRegExpr.Create; + rx.Expression := 'https?://[^\s"]+'; + if ThemeIsDark then + Dialog.Text := Msg + else // See issue #2036 + Dialog.Text := rx.Replace(Msg, '<a href="$0">$0</a>', True); + rx.Free; + + // Main icon, and footer link + case DlgType of + mtWarning: + Dialog.MainIcon := tdiWarning; + mtError: begin + Dialog.MainIcon := tdiError; + WebSearchUrl := AppSettings.ReadString(asWebSearchBaseUrl); + WebSearchUrl := StringReplace(WebSearchUrl, '%q', EncodeURLParam(Copy(Msg, 1, 1000)), []); + rx := TRegExpr.Create; + rx.Expression := 'https?://(www\.)?([^/]+)/'; + if rx.Exec(WebSearchUrl) then + WebSearchHost := rx.Match[2] + else + WebSearchHost := '[unknown host]'; + rx.Free; + Dialog.FooterText := IfThen(FooterText.IsEmpty, '', FooterText + sLineBreak + sLineBreak) + + '<a href="'+WebSearchUrl+'">'+_('Find some help on this error')+' (=> '+WebSearchHost+')</a>'; + Dialog.FooterIcon := tdiInformation; + end; + mtInformation: + Dialog.MainIcon := tdiInformation; + mtConfirmation, mtCustom: begin + Dialog.Flags := Dialog.Flags + [tfUseHiconMain]; + Dialog.CustomMainIcon := ConfirmIcon; + end; + else + Dialog.MainIcon := tdiNone; + end; + + // Add buttons + for MsgButton in Buttons do begin + case MsgButton of + mbYes: AddButton('Yes', mrYes, 805); + mbNo: AddButton('No', mrNo, 806); + mbOK: AddButton('OK', mrOk, 800); + mbCancel: AddButton('Cancel', mrCancel, 801); + mbAbort: AddButton('Abort', mrAbort, 802); + mbRetry: AddButton('Retry', mrRetry, 803); + mbIgnore: AddButton('Ignore', mrIgnore, 804); + mbAll: AddButton('All', mrAll); + mbNoToAll: AddButton('No to all', mrNoToAll); + mbYesToAll: AddButton('Yes to all', mrYesToAll); + mbClose: AddButton('Close', mrClose, 807); + end; + end; + + // Checkbox, s'il vous plait? + KeepAskingValue := True; + if KeepAskingSetting <> asUnused then begin + if (not (mbNo in Buttons)) and (Buttons <> [mbOK]) then + raise Exception.CreateFmt(_('Missing "No" button in %() call'), ['MessageDialog']); + KeepAskingValue := AppSettings.ReadBool(KeepAskingSetting); + Dialog.Flags := Dialog.Flags + [tfVerificationFlagChecked]; + if Buttons = [mbOK] then + Dialog.VerificationText := _('Keep showing this dialog.') + else + Dialog.VerificationText := _('Keep asking this question.'); + end; + + // Supress dialog and assume "No" if user disabled this dialog + if KeepAskingValue then begin + Dialog.Execute; + Result := Dialog.ModalResult; + if (KeepAskingSetting <> asUnused) and (not (tfVerificationFlagChecked in Dialog.Flags)) then + AppSettings.WriteBool(KeepAskingSetting, False); + end else + Result := mrNo; + + Dialog.Free; + end else begin + // Backwards compatible dialog on Windows XP + m := Msg; + if not Title.IsEmpty then + m := Title + SLineBreak + SLineBreak + m; + if not FooterText.IsEmpty then + m := m + SLineBreak + SLineBreak + FooterText; + + if KeepAskingSetting <> asUnused then + KeepAskingValue := AppSettings.ReadBool(KeepAskingSetting) + else + KeepAskingValue := True; + + if KeepAskingValue then + Result := MessageDlg(m, DlgType, Buttons, 0) + else + Result := mrNo; + end; + + AppSettings.RestorePath; +end;} + + +{function ErrorDialog(Msg: string): Integer; +begin + Result := MessageDialog('', Msg, mtError, [mbOK]); +end;} + + +{function ErrorDialog(const Title, Msg: string): Integer; +begin + Result := MessageDialog(Title, Msg, mtError, [mbOK]); +end;} + + +{function GetLocaleString(const ResourceId: Integer): WideString; +var + Buffer: WideString; + BufferLen: Integer; +begin + Result := ''; + if LibHandleUser32 <> 0 then begin + SetLength(Buffer, 255); + BufferLen := LoadStringW(LibHandleUser32, ResourceId, PWideChar(Buffer), Length(Buffer)); + if BufferLen <> 0 then + Result := Copy(Buffer, 1, BufferLen); + end; +end;} + + +{function GetHTMLCharsetByEncoding(Encoding: TEncoding): String; +begin + Result := ''; + if Encoding = TEncoding.Default then + Result := 'Windows-'+IntToStr(GetACP) + else if Encoding.CodePage = 437 then + Result := 'ascii' + else if Encoding = TEncoding.Unicode then + Result := 'utf-16le' + else if Encoding = TEncoding.BigEndianUnicode then + Result := 'utf-16' + else if Encoding = TEncoding.UTF8 then + Result := 'utf-8' + else if Encoding = TEncoding.UTF7 then + Result := 'utf-7'; +end;} + + +{procedure ParseCommandLine(CommandLine: String; var ConnectionParams: TConnectionParameters; var FileNames: TStringList; var RunFrom: String); +var + rx: TRegExpr; + ExeName, SessName, Host, Lib, Port, User, Pass, Socket, AllDatabases, + SSLPrivateKey, SSLCACertificate, SSLCertificate, SSLCipher: String; + NetType, WindowsAuth, WantSSL, CleartextPluginEnabled, SSLVerification: Integer; + AbsentFiles: TStringList; + + function GetParamValue(ShortName, LongName: String): String; + begin + // Return one command line switch. Doublequotes are not mandatory. + Result := ''; + rx.Expression := '\s(\-'+ShortName+'|\-\-'+LongName+')\s*\=?\s*\"([^\-][^\"]*)\"'; + if rx.Exec(CommandLine) then + Result := rx.Match[2] + else begin + rx.Expression := '\s(\-'+ShortName+'|\-\-'+LongName+')\s*\=?\s*([^\-]\S*)'; + if rx.Exec(CommandLine) then + Result := rx.Match[2]; + end; + end; + + procedure GetFileNames(Expression: String); + begin + rx.Expression := Expression; + if rx.Exec(CommandLine) then while true do begin + if FileExists(rx.Match[1]) then + FileNames.Add(rx.Match[1]) + else + AbsentFiles.Add(rx.Match[1]); + // Remove match from input string, so the second call to GetFileNames without quotes + // does not detect filenames cut at whitespace + Delete(CommandLine, rx.MatchPos[1], rx.MatchLen[1]); + if not rx.ExecNext then + break; + end; + end; + +begin + // Parse command line, probably sent by blocked second application instance. + // Try to build connection parameters out of it. + SessName := ''; + FileNames := TStringList.Create; + AbsentFiles := TStringList.Create; + + // Add leading (and trailing) space, so the regular expressions can request a mandantory space + // before (and after) each param (and filename) including the first one (and last one) + ExeName := ExtractFileName(ParamStr(0)); + CommandLine := Copy(CommandLine, Pos(ExeName, CommandLine)+Length(ExeName), Length(CommandLine)); + CommandLine := CommandLine + ' '; + rx := TRegExpr.Create; + + // --runfrom=scheduler after build update + RunFrom := GetParamValue('rf', 'runfrom'); + + SessName := GetParamValue('d', 'description'); + if SessName <> '' then begin + try + ConnectionParams := TConnectionParameters.Create(SessName); + except + on E:Exception do begin + // Session params not found in registry + MainForm.LogSQL(E.Message); + end; + end; + end; + + // Test if params were passed. If given, override previous values loaded from registry. + // Enables the user to log into a session with a different, non-stored user: -dSession -uSomeOther + NetType := StrToIntDef(GetParamValue('n', 'nettype'), 0); + Host := GetParamValue('h', 'host'); + Lib := GetParamValue('l', 'library'); + User := GetParamValue('u', 'user'); + Pass := GetParamValue('p', 'password'); + CleartextPluginEnabled := StrToIntDef(GetParamValue('cte', 'cleartextenabled'), -1); + Socket := GetParamValue('S', 'socket'); + Port := GetParamValue('P', 'port'); + AllDatabases := GetParamValue('db', 'databases'); + WindowsAuth := StrToIntDef(GetParamValue('W', 'winauth'), -1); + WantSSL := StrToIntDef(GetParamValue('ssl', 'ssl'), -1); + SSLPrivateKey := GetParamValue('sslpk', 'sslprivatekey'); + SSLCACertificate := GetParamValue('sslca', 'sslcacertificate'); + SSLCertificate := GetParamValue('sslcert', 'sslcertificate'); + SSLCipher := GetParamValue('sslcip', 'sslcipher'); + SSLVerification := StrToIntDef(GetParamValue('sslvrf', 'sslverification'), -1); + // Leave out support for startup script, seems reasonable for command line connecting + + if (Host <> '') or (User <> '') or (Pass <> '') or (Port <> '') or (Socket <> '') or (AllDatabases <> '') then begin + if not Assigned(ConnectionParams) then begin + ConnectionParams := TConnectionParameters.Create; + ConnectionParams.SessionPath := SessName; + end; + if NetType <> 0 then ConnectionParams.NetType := TNetType(NetType); + try + ConnectionParams.GetNetTypeGroup; + except + ConnectionParams.NetType := ntMySQL_TCPIP; + end; + if Host <> '' then ConnectionParams.Hostname := Host; + if Lib <> '' then ConnectionParams.LibraryOrProvider := Lib; + if ConnectionParams.LibraryOrProvider.IsEmpty then ConnectionParams.LibraryOrProvider := ConnectionParams.DefaultLibrary; + if User <> '' then ConnectionParams.Username := User; + if Pass <> '' then ConnectionParams.Password := Pass; + if CleartextPluginEnabled in [0,1] then + ConnectionParams.CleartextPluginEnabled := Boolean(CleartextPluginEnabled); + if Port <> '' then ConnectionParams.Port := StrToIntDef(Port, 0); + if Socket <> '' then begin + ConnectionParams.Hostname := Socket; + ConnectionParams.NetType := ntMySQL_NamedPipe; + end; + if AllDatabases <> '' then ConnectionParams.AllDatabasesStr := AllDatabases; + if WantSSL in [0,1] then + ConnectionParams.WantSSL := Boolean(WantSSL); + if SSLPrivateKey <> '' then + ConnectionParams.SSLPrivateKey := SSLPrivateKey; + if SSLCACertificate <> '' then + ConnectionParams.SSLCACertificate := SSLCACertificate; + if SSLCertificate <> '' then + ConnectionParams.SSLCertificate := SSLCertificate; + if SSLCipher <> '' then + ConnectionParams.SSLCipher := SSLCipher; + if SSLVerification >= 0 then + ConnectionParams.SSLVerification := SSLVerification; + + if WindowsAuth in [0,1] then + ConnectionParams.WindowsAuth := Boolean(WindowsAuth); + + // Ensure we have a session name to pass to InitConnection + if (ConnectionParams.SessionPath = '') and (ConnectionParams.Hostname <> '') then + ConnectionParams.SessionPath := ConnectionParams.Hostname; + end; + + // Check for valid filename(s) in parameters. + // We support doublequoted and unquoted parameters. + GetFileNames('\"([^\"]+\.sql)\"'); + GetFileNames('\s([^\s\"]+\.sql)\b'); + if AbsentFiles.Count > 0 then + ErrorDialog(_('Could not load file(s):'), AbsentFiles.Text); + AbsentFiles.Free; + + rx.Free; +end;} + + +function _(const Pattern: string): string; +begin + // gnugettext not working yet... + Result := Pattern; +end; + + +function f_(const Pattern: string; const Args: array of const): string; +var + TranslatedPattern: String; +begin + // Helper for translation, replacement for Format(_()) + try + TranslatedPattern := Pattern; //_(Pattern); + Result := Format(TranslatedPattern, Args); + except + on E:Exception do begin + MainForm.LogSQL(E.ClassName+' in translation string with invalid format arguments: "'+TranslatedPattern+'"', lcError); + Result := Format(Pattern, Args); + end; + end; +end; + + +{function GetOutputFilename(FilenameWithPlaceholders: String; DBObj: TDBObject): String; +var + Arguments: TExtStringList; + Year, Month, Day, Hour, Min, Sec, MSec: Word; + i: Integer; +begin + // Rich format output filename, replace certain markers. See issue #2622 + Arguments := TExtStringList.Create; + + if Assigned(DBObj) then begin + Arguments.Values['session'] := ValidFilename(DBObj.Connection.Parameters.SessionName); + Arguments.Values['host'] := ValidFilename(DBObj.Connection.Parameters.Hostname); + Arguments.Values['u'] := ValidFilename(DBObj.Connection.Parameters.Username); + Arguments.Values['db'] := ValidFilename(DBObj.Database); + end; + Arguments.Values['date'] := ValidFilename(DateTimeToStr(Now)); + DecodeDateTime(Now, Year, Month, Day, Hour, Min, Sec, MSec); + Arguments.Values['d'] := Format('%.2d', [Day]); + Arguments.Values['m'] := Format('%.2d', [Month]); + Arguments.Values['y'] := Format('%.4d', [Year]); + Arguments.Values['h'] := Format('%.2d', [Hour]); + Arguments.Values['i'] := Format('%.2d', [Min]); + Arguments.Values['s'] := Format('%.2d', [Sec]); + + Result := FilenameWithPlaceholders; + for i:=0 to Arguments.Count-1 do begin + Result := StringReplace(Result, '%'+Arguments.Names[i], Arguments.ValueFromIndex[i], [rfReplaceAll]); + end; + Arguments.Free; +end;} + + +{function GetOutputFilenamePlaceholders: TStringList; +begin + // Return a list with valid placeholder=>description pairs + Result := TStringList.Create; + Result.Values['session'] := _('Session name'); + Result.Values['host'] := _('Hostname'); + Result.Values['u'] := _('Username'); + Result.Values['db'] := _('Database'); + Result.Values['date'] := _('Date and time'); + Result.Values['d'] := _('Day of month'); + Result.Values['m'] := _('Month'); + Result.Values['y'] := _('Year'); + Result.Values['h'] := _('Hour'); + Result.Values['i'] := _('Minute'); + Result.Values['s'] := _('Second'); +end;} + + +{function GetSystemImageList: TImageList; +var + Info: TSHFileInfo; + ImageListHandle: Cardinal; +begin + // Create shared imagelist once and use in TPopupMenu and TVirtualTree or whatever + if SystemImageList = nil then begin + ImageListHandle := SHGetFileInfo('', 0, Info, SizeOf(Info), SHGFI_SYSICONINDEX or SHGFI_SMALLICON); + if ImageListHandle <> 0 then begin + SystemImageList := TImageList.Create(MainForm); + SystemImageList.Handle := ImageListHandle; + SystemImageList.ShareImages := true; + SystemImageList.DrawingStyle := dsTransparent; + end; + end; + Result := SystemImageList; +end;} + + +{function GetSystemImageIndex(Filename: String): Integer; +var + Info: TSHFileInfo; +begin + // Return image index of shared system image list, for a given filename + SHGetFileInfo(PChar(Filename), 0, Info, SizeOf(Info), SHGFI_SYSICONINDEX or SHGFI_TYPENAME); + Result := Info.iIcon; +end;} + + +{function GetExecutableBits: Byte; +begin} + //{$IFDEF WIN64} + //Result := 64; + //{$ELSE} + //Result := 32; + //{$ENDIF} +//end; + + +{procedure Help(Sender: TObject; Anchor: String); +var + Place: String; +begin + // Go to online help page + if Sender is TAction then + Place := (Sender as TAction).ActionComponent.Name + else if Sender is TControl then + Place := (Sender as TControl).Name + else + Place := 'unhandled-'+Sender.ClassName; + if not Anchor.IsEmpty then + Anchor := '#'+Anchor; + ShellExec(APPDOMAIN+'help.php?place='+EncodeURLParam(Place)+Anchor); +end;} + + +{function PortOpen(Port: Word): Boolean; +var + client: sockaddr_in; + sock: Integer; + ret: Integer; + wsdata: WSAData; +begin + Result := True; + ret := WSAStartup($0002, wsdata); + if ret<>0 then + Exit; + try + client.sin_family := AF_INET; + client.sin_port := htons(Port); + client.sin_addr.s_addr := inet_addr(PAnsiChar('127.0.0.1')); + sock := socket(AF_INET, SOCK_STREAM, 0); + Result := connect(sock, client, SizeOf(client)) <> 0; + finally + WSACleanup; + end; +end;} + + +{function IsValidFilePath(FilePath: String): Boolean; +var + Pieces: TStringList; + i: Integer; +begin + // Check file path for invalid characters. See http://www.heidisql.com/forum.php?t=20873 + Result := True; + Pieces := TStringList.Create; + SplitRegExpr('[\\\/]', FilePath, Pieces); + for i:=1 to Pieces.Count-1 do begin + Result := Result and TPath.HasValidFileNameChars(Pieces[i], False); + end; + Pieces.Free; +end;} + + +{function FileIsWritable(FilePath: String): Boolean; +var + hFile: DWORD; +begin + // Check if file is writable + if not FileExists(FilePath) then begin + // Return true if file does not exist + Result := True; + end else begin + hFile := CreateFile(PChar(FilePath), GENERIC_WRITE, 0, nil, OPEN_EXISTING, 0, 0); + Result := hFile <> INVALID_HANDLE_VALUE; + CloseHandle(hFile); + end; +end;} + + +{function GetThemeColor(Color: TColor): TColor; +begin + // Not required with vcl-style-utils: + // Result := TStyleManager.ActiveStyle.GetSystemColor(Color); + Result := Color; +end;} + + +{function ThemeIsDark(ThemeName: String=''): Boolean; +const + DarkThemes: String = 'Amakrits,Aqua Graphite,Auric,Carbon,Charcoal Dark Slate,Cobalt XEMedia,Glossy,Glow,Golden Graphite,Material,Onyx Blue,Ruby Graphite,TabletDark,Windows10 Dark,Windows10 SlateGray'; +var + DarkThemesList: TStringList; +begin + DarkThemesList := Explode(',', DarkThemes); + if ThemeName.IsEmpty then + ThemeName := TStyleManager.ActiveStyle.Name; + Result := DarkThemesList.IndexOf(ThemeName) > -1; + DarkThemesList.Free; +end;} + + +{function ProcessExists(pid: Cardinal; ExeNamePattern: String): Boolean; +var + Proc: TProcessEntry32; + SnapShot: THandle; + ContinueLoop: Boolean; +begin + // Check if a given process id exists + SnapShot := CreateToolhelp32Snapshot(TH32CS_SnapProcess, 0); + Proc.dwSize := Sizeof(Proc); + Result := False; + ContinueLoop := Process32First(SnapShot, Proc); + while ContinueLoop do begin + Result := (Proc.th32ProcessID = pid) and ContainsText(Proc.szExeFile, ExeNamePattern); + if Result then + Break; + ContinueLoop := Process32Next(SnapShot, Proc); + end; + CloseHandle(Snapshot); +end;} + + +{procedure ToggleCheckBoxWithoutClick(chk: TCheckBox; State: Boolean); +var + ClickEvent: TNotifyEvent; +begin + ClickEvent := chk.OnClick; + chk.OnClick := nil; + chk.Checked := State; + chk.OnClick := ClickEvent; +end;} + + +{function SynCompletionProposalPrettyText(ImageIndex: Integer; LeftText, CenterText, RightText: String; + LeftColor: TColor=-1; CenterColor: TColor=-1; RightColor: TColor=-1): String; +const} +// LineFormat = '\image{%d}\hspace{5}\color{%s}%s\column{}\color{%s}%s\hspace{10}\color{%s}\style{+i}%s'; +{begin + // Return formatted item string for a TSynCompletionProposal + if LeftColor = -1 then LeftColor := clGrayText; + if CenterColor = -1 then CenterColor := clWindowText; + if RightColor = -1 then RightColor := clGrayText; + Result := Format(LineFormat, [ImageIndex, ColorToString(LeftColor), LeftText, ColorToString(CenterColor), CenterText, ColorToString(RightColor), RightText]); +end;} + + +{function PopupComponent(Sender: TObject): TComponent; +var + Menu: TObject; +begin + // Return owner component of clicked menu item, probably combined with a TAction + Result := nil; + Menu := nil; + if Sender is TAction then + Sender := (Sender as TAction).ActionComponent; + + if Sender is TMenuItem then + Menu := (Sender as TMenuItem).GetParentMenu + else if Sender is TPopupMenu then + Menu := Sender; + + if Menu is TPopupMenu then + Result := (Menu as TPopupMenu).PopupComponent; +end;} + + +{function IsWine: Boolean; +var + NTHandle: THandle; + wine_nt_to_unix_file_name: procedure(p1:pointer; p2:pointer); stdcall; +begin + // Detect if we're running on Wine, not on native Windows + // Idea taken from http://ruminatedrumblings.blogspot.com/2008/04/detecting-virtualized-environment.html + if IsWineStored = -1 then begin + NTHandle := LoadLibrary('NTDLL.DLL'); + if NTHandle>32 then + wine_nt_to_unix_file_name := GetProcAddress(NTHandle, 'wine_nt_to_unix_file_name') + else + wine_nt_to_unix_file_name := nil; + IsWineStored := IfThen(Assigned(wine_nt_to_unix_file_name), 1, 0); + FreeLibrary(NTHandle); + end; + Result := IsWineStored = 1; +end;} + + +{function DirSep: Char; +begin + if IsWine then + Result := '/' + else + Result := '\'; +end;} + +{procedure FindComponentInstances(BaseForm: TComponent; ClassType: TClass; var List: TObjectList); +var + i: Integer; +begin + for i:=0 to BaseForm.ComponentCount-1 do begin + if BaseForm.Components[i] is ClassType then + List.Add(BaseForm.Components[i] as ClassType) + else + FindComponentInstances(BaseForm.Components[i], ClassType, List); + end; +end;} + +{function WebColorStrToColorDef(WebColor: string; Default: TColor): TColor; +begin + try + Result := WebColorStrToColor(WebColor); + except + Result := Default; + end; +end;} + + +{function UserAgent(OwnerComponent: TComponent): String; +var + OS: String; +begin + if IsWine then + OS := 'Linux/Wine' + else + OS := 'Windows NT '+IntToStr(Win32MajorVersion)+'.'+IntToStr(Win32MinorVersion); + Result := APPNAME+'/'+MainForm.AppVersion+' ('+OS+'; '+ExtractFilename(Application.ExeName)+'; '+OwnerComponent.Name+')'; +end;} + + +{function CodeIndent(Steps: Integer=1): String; +begin + // Provide tab or spaces for indentation, uniquely used for all SQL statements + if AppSettings.ReadBool(asTabsToSpaces) then + Result := StringOfChar(' ', AppSettings.ReadInt(asTabWidth) * Steps) + else + Result := StringOfChar(#9, Steps); +end;} + + +{function EscapeHotkeyPrefix(Text: String): String; +begin + // Issue #1992: Escape ampersand in caption of menus and tabs, preventing underlined hotkey generation + Result := StringReplace(Text, Vcl.Menus.cHotkeyPrefix, Vcl.Menus.cHotkeyPrefix + Vcl.Menus.cHotkeyPrefix, [rfReplaceAll]); +end;} + + +{ Get SID of current Windows user, probably useful in the future +{function GetCurrentUserSID: string; +type + PTOKEN_USER = ^TOKEN_USER; + _TOKEN_USER = record + User: TSidAndAttributes; + end; + TOKEN_USER = _TOKEN_USER; +var + hToken: THandle; + cbBuf: Cardinal; + ptiUser: PTOKEN_USER; + bSuccess: Boolean; + StrSid: PWideChar; +begin + // Taken from https://stackoverflow.com/a/71730865/4110077 + // SidToString does not exist, prefer WinApi.Windows.ConvertSidToStringSid() + Result := ''; + + // Get the calling thread's access token. + if not OpenThreadToken(GetCurrentThread(), TOKEN_QUERY, True, hToken) then + begin + if (GetLastError <> ERROR_NO_TOKEN) then + Exit; + + // Retry against process token if no thread token exists. + if not OpenProcessToken(GetCurrentProcess, TOKEN_QUERY, hToken) then + Exit; + end; + try + // Obtain the size of the user information in the token. + bSuccess := GetTokenInformation(hToken, TokenUser, nil, 0, cbBuf); + ptiUser := nil; + try + while (not bSuccess) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) do + begin + ReallocMem(ptiUser, cbBuf); + bSuccess := GetTokenInformation(hToken, TokenUser, ptiUser, cbBuf, cbBuf); + end; + ConvertSidToStringSid(ptiUser.User.Sid, StrSid); + Result := StrSid; + finally + FreeMem(ptiUser); + end; + finally + CloseHandle(hToken); + end; +end;} + + +{ Threading stuff } + +{constructor TQueryThread.Create(Connection: TDBConnection; Batch: TSQLBatch; TabNumber: Integer); +begin + inherited Create(False); + FConnection := Connection; + FAborted := False; + FBatch := Batch; + FTabNumber := TabNumber; + FBatchPosition := 0; + FQueryStartedAt := Now; + FQueryTime := 0; + FQueryNetTime := 0; + FRowsAffected := 0; + FRowsFound := 0; + FWarningCount := 0; + FErrorMessage := ''; + FBatchInOneGo := MainForm.actBatchInOneGo.Checked; + FStopOnErrors := MainForm.actQueryStopOnErrors.Checked; + FreeOnTerminate := True; + Priority := tpNormal; +end;} + + +{procedure TQueryThread.Execute; +var + SQL: String; + i, BatchStartOffset, ResultCount: Integer; + PacketSize, MaxAllowedPacket: Int64; + DoStoreResult, ErrorAborted, LogMaxResultsDone: Boolean; +begin + inherited; + + MaxAllowedPacket := 0; + i := 0; + ResultCount := 0; + ErrorAborted := False; + LogMaxResultsDone := False; + + while i < FBatch.Count do begin + SQL := ''; + if not FBatchInOneGo then begin + SQL := FBatch[i].SQL; + Inc(i); + end else begin + // Concat queries up to a size of max_allowed_packet + if MaxAllowedPacket = 0 then begin + FConnection.SetLockedByThread(Self); + MaxAllowedPacket := FConnection.MaxAllowedPacket; + FConnection.SetLockedByThread(nil); + // TODO: Log('Detected maximum allowed packet size: '+FormatByteNumber(MaxAllowedPacket), lcDebug); + end; + BatchStartOffset := FBatch[i].LeftOffset; + while i < FBatch.Count do begin + PacketSize := FBatch[i].RightOffset - BatchStartOffset + ((i-FBatchPosition) * 20); + if not SQL.IsEmpty then begin + if PacketSize >= MaxAllowedPacket then begin + // TODO: Log('Limiting batch packet size to '+FormatByteNumber(Length(SQL))+' with '+FormatNumber(i-FUserQueryOffset)+' queries.', lcDebug); + Break; + end + else begin + // Don't append to the very last query. See issue #1583 + SQL := SQL + '; '; + end; + end; + SQL := SQL + FBatch[i].SQL; + Inc(i); + end; + FQueriesInPacket := i - FBatchPosition; + end; + Synchronize(procedure begin MainForm.BeforeQueryExecution(Self); end); + try + FConnection.SetLockedByThread(Self); + DoStoreResult := ResultCount < AppSettings.ReadInt(asMaxQueryResults); + if (not DoStoreResult) and (not LogMaxResultsDone) then begin + // Inform user about preference setting for limiting result tabs + FConnection.Log(lcInfo, + f_('Reached maximum number of result tabs (%d). To display more results, increase setting in Preferences > SQL', [AppSettings.ReadInt(asMaxQueryResults)]) + ); + LogMaxResultsDone := True; + end; + FConnection.Query(SQL, DoStoreResult, lcUserFiredSQL); + Inc(ResultCount, FConnection.ResultCount); + FBatchPosition := i; + Inc(FQueryTime, FConnection.LastQueryDuration); + Inc(FQueryNetTime, FConnection.LastQueryNetworkDuration); + Inc(FRowsAffected, FConnection.RowsAffected); + Inc(FRowsFound, FConnection.RowsFound); + Inc(FWarningCount, FConnection.WarningCount); + except + on E:EDbError do begin + if FStopOnErrors or (i = FBatch.Count - 1) then begin + FErrorMessage := E.Message; + ErrorAborted := True; + end; + end; + 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 + break; + end; + + Synchronize(procedure begin MainForm.FinishedQueryExecution(Self); end); +end;} + + +{procedure TQueryThread.LogFromThread(Msg: String; Category: TDBLogCategory); +begin + Queue(procedure begin FConnection.Log(Category, Msg); end); +end;} + + +{ TSQLSentence } + +{constructor TSQLSentence.Create(Owner: TSQLBatch); +begin + // Use a back reference to the parent batch object, so we can extract SQL from it + FOwner := Owner; +end;} + + +{function TSQLSentence.GetSize: Integer; +begin + Result := RightOffset - LeftOffset; +end;} + + +{function TSQLSentence.GetSQL: String; +begin + // Result := Copy(FOwner.SQL, LeftOffset, RightOffset-LeftOffset); + // Probably faster than Copy(): + SetString(Result, PChar(FOwner.SQL) +LeftOffset -1, RightOffset-LeftOffset); +end;} + + +{function TSQLSentence.GetSQLWithoutComments: String; +begin + Result := FOwner.GetSQLWithoutComments(GetSQL); +end;} + + +{ TSQLBatch } + +{function TSQLBatch.GetSize: Integer; +var + Query: TSQLSentence; +begin + // Return overall string length of batch + Result := 0; + for Query in Self do + Inc(Result, Query.Size); +end;} + + +{procedure TSQLBatch.SetSQL(Value: String); +var + i, AllLen, DelimLen, DelimStart, LastLeftOffset, RightOffset: Integer; + c, n, LastStringEncloser: Char; + Delim, DelimTest, QueryTest: String; + InString, InComment, InBigComment, InEscape: Boolean; + Marker: TSQLSentence; + rx: TRegExpr; +const + StringEnclosers = ['"', '''', '`']; + NewLines = [#13, #10]; + WhiteSpaces = NewLines + [#9, ' ']; +begin + // Scan SQL batch for delimiters and store a list with start + end offsets + FSQL := Value; + Clear; + AllLen := Length(FSQL); + i := 0; + LastLeftOffset := 1; + Delim := Mainform.Delimiter; + InString := False; // Loop in "enclosed string" or `identifier` + InComment := False; // Loop in one-line comment (# or --) + InBigComment := False; // Loop in /* multi-line */ or /*! condictional comment */ + InEscape := False; // Previous char was backslash + LastStringEncloser := #0; + DelimLen := Length(Delim); + rx := TRegExpr.Create; + rx.Expression := '^\s*DELIMITER\s+(\S+)'; + rx.ModifierG := True; + rx.ModifierI := True; + rx.ModifierM := False; + while i < AllLen do begin + Inc(i); + // Current and next char + c := FSQL[i]; + if i < AllLen then n := FSQL[i+1] + else n := #0; + + // Check for comment syntax and for enclosed literals, so a query delimiter can be ignored + if (not InComment) and (not InBigComment) and (not InString) and ((c + n = '--') or (c = '#')) then + InComment := True; + if (not InComment) and (not InBigComment) and (not InString) and (c + n = '/*') then + InBigComment := True; + if InBigComment and (not InComment) and (not InString) and (c + n = '*/') then + InBigComment := False; + if (not InEscape) and (not InComment) and (not InBigComment) and CharInSet(c, StringEnclosers) then begin + if (not InString) or (InString and (c = LastStringEncloser)) then begin + InString := not InString; + LastStringEncloser := c; + end; + end; + if (CharInSet(c, NewLines) and (not CharInSet(n, NewLines))) or (i = 1) then begin + if i > 1 then + InComment := False; + if (not InString) and (not InBigComment) and rx.Exec(copy(FSQL, i, 100)) then begin + Delim := rx.Match[1]; + DelimLen := rx.MatchLen[1]; + Inc(i, rx.MatchLen[0]); + LastLeftOffset := i; + continue; + end; + end; + if not InEscape then + InEscape := c = '\' + else + InEscape := False; + + // Prepare delimiter test string + if (not InComment) and (not InString) and (not InBigComment) then begin + DelimStart := Max(1, i+1-DelimLen); + DelimTest := Copy(FSQL, DelimStart, i-Max(i-DelimLen, 0)); + end else + DelimTest := ''; + + // End of query or batch reached. Add query markers to result list if sentence is not empty. + if (DelimTest = Delim) or (i = AllLen) then begin + RightOffset := i+1; + if DelimTest = Delim then + Dec(RightOffset, DelimLen); + QueryTest := Trim(Copy(FSQL, LastLeftOffset, RightOffset-LastLeftOffset)); + if (QueryTest <> '') and (QueryTest <> Delim) then begin + Marker := TSQLSentence.Create(Self); + while CharInSet(FSQL[LastLeftOffset], WhiteSpaces) do + Inc(LastLeftOffset); + Marker.LeftOffset := LastLeftOffset; + Marker.RightOffset := RightOffset; + Add(Marker); + LastLeftOffset := i+1; + end; + end; + end; +end;} + +{function TSQLBatch.GetSQLWithoutComments: String; +begin + Result := GetSQLWithoutComments(SQL); +end;} + +{class function TSQLBatch.GetSQLWithoutComments(FullSQL: String): String; +var + InLineComment, InMultiLineComment: Boolean; + AddCur: Boolean; + i: Integer; + Cur, Prev1, Prev2: Char; +begin + // Strip comments out of SQL sentence + // TODO: leave quoted string literals and identifiers untouched + 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 (Cur = '*') and (Prev1 = '/') then begin + InMultiLineComment := True; + System.Delete(Result, Length(Result), 1); // Delete comment chars + end + else if InMultiLineComment and (Cur = '/') and (Prev1 = '*') then begin + InMultiLineComment := False; + System.Delete(Result, Length(Result), 1); + AddCur := False; + end; + + if not InMultiLineComment then begin + if InLineComment and ((Cur = #13) or (Cur = #10)) then begin + InLineComment := False; // Reset + end + else if Cur = '#' then begin + InLineComment := True; + end + else if (Cur = ' ') and (Prev1 = '-') and (Prev2 = '-') then begin + InLineComment := True; + System.Delete(Result, Length(Result)-1, 2); // Delete comment chars + end; + end; + + if AddCur and (not InLineComment) and (not InMultiLineComment) then begin + Result := Result + Cur; + end; + end; +end;} + +{ THttpDownload } + +{constructor THttpDownload.Create(Owner: TComponent); +begin + FBytesRead := -1; + FContentLength := -1; + FOwner := Owner; + FTimeOut := 10; +end;} + + +{procedure THttpDownload.SendRequest(Filename: String); +var + NetHandle: HINTERNET; + UrlHandle: HINTERNET; + Buffer: array[1..4096] of AnsiChar; + Head: array[1..1024] of Char; + BytesInChunk, HeadSize, Reserved, TimeOutSeconds: Cardinal; + LocalFile: File; + DoStore: Boolean; + HttpStatus: Integer; + ContentChunk: UTF8String; +begin + DoStore := False; + NetHandle := InternetOpen(PChar(UserAgent(FOwner)), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0); + + // Do not let the user wait 30s + TimeOutSeconds := FTimeOut * 1000; + InternetSetOption(NetHandle, INTERNET_OPTION_CONNECT_TIMEOUT, @TimeOutSeconds, SizeOf(TimeOutSeconds)); + + UrlHandle := nil; + FLastContent := ''; + try + UrlHandle := InternetOpenURL(NetHandle, PChar(FURL), nil, 0, INTERNET_FLAG_RELOAD, 0); + if (not Assigned(UrlHandle)) and FURL.StartsWith('https:', true) then begin + // Try again without SSL. See issue #65 and #1209 + MainForm.LogSQL(f_('Could not open %s (%s) - trying again without SSL...', [FURL, SysErrorMessage(GetLastError)]), lcError); + FURL := ReplaceRegExpr('^https:', FURL, 'http:'); + UrlHandle := InternetOpenURL(NetHandle, PChar(FURL), nil, 0, INTERNET_FLAG_RELOAD, 0); + end; + if not Assigned(UrlHandle) then begin + raise Exception.CreateFmt(_('Could not open %s (%s)'), [FURL, SysErrorMessage(GetLastError)]); + end; + + // Detect content length + HeadSize := SizeOf(Head); + Reserved := 0; + if HttpQueryInfo(UrlHandle, HTTP_QUERY_CONTENT_LENGTH, @Head, HeadSize, Reserved) then + FContentLength := StrToIntDef(Head, -1) + else + raise Exception.CreateFmt(_('Server did not send required "Content-Length" header: %s'), [FURL]); + + // Check if we got HTTP status 200 + HeadSize := SizeOf(Head); + Reserved := 0; + if HttpQueryInfo(UrlHandle, HTTP_QUERY_STATUS_CODE, @Head, HeadSize, Reserved) then begin + HttpStatus := StrToIntDef(Head, -1); + if HttpStatus <> 200 then + raise Exception.CreateFmt(_('Got HTTP status %d from %s'), [HttpStatus, FURL]); + end; + + // Create local file + if Filename <> '' then begin + AssignFile(LocalFile, FileName); + Rewrite(LocalFile, 1); + DoStore := True; + end; + + // Stream contents + while true do begin + InternetReadFile(UrlHandle, @Buffer, SizeOf(Buffer), BytesInChunk); + // Either store as file or in memory variable + if DoStore then begin + BlockWrite(LocalFile, Buffer, BytesInChunk) + end else begin + SetString(ContentChunk, PAnsiChar(@Buffer[1]), BytesInChunk); + FLastContent := FLastContent + String(ContentChunk); + end; + Inc(FBytesRead, BytesInChunk); + if Assigned(FOnProgress) then + FOnProgress(Self); + if BytesInChunk = 0 then + break; + end; + + finally + if DoStore then + CloseFile(LocalFile); + if Assigned(UrlHandle) then + InternetCloseHandle(UrlHandle); + if Assigned(NetHandle) then + InternetCloseHandle(NetHandle); + end; +end;} + + + +{ TExtStringList } +// taken from https://stackoverflow.com/questions/33893377/can-i-prevent-tstringlist-removing-key-value-pair-when-value-set-to-empty + +{function TExtStringList.GetValue(const Name: string): string; +begin + Result := Self.GetValue(Name); +end;} + + +{procedure TExtStringList.SetValue(const Name, Value: string); +var + I: Integer; +begin + I := IndexOfName(Name); + if I < 0 then I := Add(''); + Put(I, Name + NameValueSeparator + Value); +end;} + + +{ TSqlTranspiler } + +{class function TSqlTranspiler.CreateTable(SQL: String; SourceDb, TargetDb: TDBConnection): String; +begin + Result := SQL; + + if SourceDb.Parameters.IsMySQL(False) and TargetDb.Parameters.IsMariaDB then begin + // Remove COLLATE clause from virtual column definition: + // `tax_status` varchar(255) COLLATE utf8mb4_unicode_ci GENERATED ALWAYS AS (json_unquote(json_extract(`price`,'$.taxStatus'))) VIRTUAL + Result := ReplaceRegExpr('\sCOLLATE\s\w+(\s+GENERATED\s)', Result, '$1', [rroModifierI, rroUseSubstitution]); + end; + +end;} + + +{ TClipboardHelper } + +{function TClipboardHelper.GetTryAsText: String; +var + AttemptsLeft: Integer; + Success: Boolean; + LastError: String; +begin + AttemptsLeft := 5; + Result := ''; + Success := False; + while AttemptsLeft > 0 do begin + Dec(AttemptsLeft); + try + Result := AsText; + Success := True; + Break; + except + // We could also just catch EClipboardException + on E:Exception do begin + LastError := E.Message; + Sleep(100); + end; + end; + end; + if not Success then + MainForm.LogSQL(LastError, lcError); +end;} + +{procedure TClipboardHelper.SetTryAsText(AValue: String); +var + AttemptsLeft: Integer; + Success: Boolean; + LastError: String; +begin + AttemptsLeft := 5; + Success := False; + while AttemptsLeft > 0 do begin + Dec(AttemptsLeft); + try + AsText := AValue; + Success := True; + Break; + except + // We could also just catch EClipboardException + on E:Exception do begin + LastError := E.Message; + Sleep(100); + end; + end; + end; + if not Success then + MainForm.LogSQL(LastError, lcError); +end;} + + +{procedure TWinControlHelper.TrySetFocus; +begin + try + if Enabled + and CanFocus then + SetFocus; + except + on E:EInvalidOperation do + MessageBeep(MB_ICONWARNING); + end; +end;} + + +{ TAppSettings } + +{constructor TAppSettings.Create; +var + rx: TRegExpr; + i: Integer; + DefaultSnippetsDirectory: String; + PortableLockFile: String; + NewFileHandle: THandle; +begin + inherited; + FRegistry := TRegistry.Create; + FReads := 0; + FWrites := 0; + + PortableLockFile := ExtractFilePath(ParamStr(0)) + FPortableLockFileBase; + + // Use filename from command line. If not given, use file in directory of executable. + rx := TRegExpr.Create; + rx.Expression := '^\-\-?psettings\=(.+)$'; + for i:=1 to ParamCount do begin + if rx.Exec(ParamStr(i)) then begin + FSettingsFile := rx.Match[1]; + break; + end; + end; + // Default settings file, if not given per command line + if FSettingsFile = '' then + FSettingsFile := ExtractFilePath(ParamStr(0)) + 'portable_settings.txt'; + // Backwards compatibility: only settings file exists, create lock file in that case + if FileExists(FSettingsFile) and (not FileExists(PortableLockFile)) then begin + NewFileHandle := FileCreate(PortableLockFile); + FileClose(NewFileHandle); + end; + + // Switch to portable mode if lock file exists. File content is ignored. + FPortableMode := FileExists(PortableLockFile); + FPortableModeReadOnly := False; + + if FPortableMode then begin + // Create file if only the lock file exists + if not FileExists(FSettingsFile) then begin + NewFileHandle := FileCreate(FSettingsFile); + FileClose(NewFileHandle); + end; + FBasePath := '\Software\' + APPNAME + ' Portable '+IntToStr(GetCurrentProcessId)+'\'; + try + ImportSettings(FSettingsFile); + except + on E:Exception do + MessageDlg(E.Message, mtError, [mbOK], 0, mbOK); + end; + end else begin + FBasePath := '\Software\' + APPNAME + '\'; + FSettingsFile := ''; + end; + + PrepareRegistry; + + InitSetting(asHiddenColumns, 'HiddenColumns', 0, False, '', True); + InitSetting(asFilter, 'Filter', 0, False, '', True); + InitSetting(asSort, 'Sort', 0, False, '', True); + InitSetting(asDisplayedColumnsSorted, 'DisplayedColumnsSorted', 0, False); + InitSetting(asLastSessions, 'LastSessions', 0, False, ''); + InitSetting(asLastActiveSession, 'LastActiveSession', 0, False, ''); + InitSetting(asAutoReconnect, 'AutoReconnect', 0, False); + InitSetting(asRestoreLastUsedDB, 'RestoreLastUsedDB', 0, True); + InitSetting(asLastUsedDB, 'lastUsedDB', 0, False, '', True); + InitSetting(asTreeBackground, 'TreeBackground', clNone, False, '', True); + 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); + if Screen.Fonts.IndexOf('Consolas') > -1 then + InitSetting(asFontName, 'FontName', 0, False, 'Consolas') + else + InitSetting(asFontName, 'FontName', 0, False, 'Courier New'); + InitSetting(asFontSize, 'FontSize', 9); + InitSetting(asTabWidth, 'TabWidth', 3); + InitSetting(asDataFontName, 'DataFontName', 0, False, 'Tahoma'); + InitSetting(asDataFontSize, 'DataFontSize', 8); + InitSetting(asDataLocalNumberFormat, 'DataLocalNumberFormat', 0, True); + InitSetting(asLowercaseHex, 'LowercaseHex', 0, True); + InitSetting(asHintsOnResultTabs, 'HintsOnResultTabs', 0, True); + InitSetting(asShowRowId, 'ShowRowId', 0, True); + InitSetting(asHightlightSameTextBackground, 'HightlightSameTextBackground', GetThemeColor(clInfoBk)); + InitSetting(asLogsqlnum, 'logsqlnum', 300); + InitSetting(asLogsqlwidth, 'logsqlwidth', 2000); + InitSetting(asSessionLogsDirectory, 'SessionLogsDirectory', 0, False, DirnameUserAppData + 'Sessionlogs\'); + InitSetting(asLogHorizontalScrollbar, 'LogHorizontalScrollbar', 0, False); + InitSetting(asSQLColActiveLine, 'SQLColActiveLine', 0, False, 'clNone'); + InitSetting(asSQLColMatchingBraceForeground, 'SQLColMatchingBraceForeground', 0, False, 'clBlack'); + InitSetting(asSQLColMatchingBraceBackground, 'SQLColMatchingBraceBackground', 0, False, 'clAqua'); + InitSetting(asMaxColWidth, 'MaxColWidth', 300); + InitSetting(asDatagridMaximumRows, 'DatagridMaximumRows', 100000); + InitSetting(asDatagridRowsPerStep, 'DatagridRowsPerStep', 1000); + InitSetting(asGridRowLineCount, 'GridRowLineCount', 1); + InitSetting(asColumnHeaderClick, 'ColumnHeaderClick', 0, True); + InitSetting(asReuseEditorConfiguration, 'ReuseEditorConfiguration', 0, True); + InitSetting(asLogToFile, 'LogToFile', 0, False); + InitSetting(asMainWinMaximized, 'MainWinMaximized', 0, False); + InitSetting(asMainWinLeft, 'MainWinLeft', 100); + InitSetting(asMainWinTop, 'MainWinTop', 100); + InitSetting(asMainWinWidth, 'MainWinWidth', 950); + InitSetting(asMainWinHeight, 'MainWinHeight', 600); + InitSetting(asMainWinOnMonitor, 'MainWinOnMonitor', 1); + InitSetting(asCoolBandIndex, 'CoolBand%sIndex', 0); + InitSetting(asCoolBandBreak, 'CoolBand%sBreak', 0, True); + InitSetting(asCoolBandWidth, 'CoolBand%sWidth', 0); + InitSetting(asToolbarShowCaptions, 'ToolbarShowCaptions', 0, False); + InitSetting(asQuerymemoheight, 'querymemoheight', 100); + InitSetting(asDbtreewidth, 'dbtreewidth', 270); + InitSetting(asDataPreviewHeight, 'DataPreviewHeight', 100); + InitSetting(asDataPreviewEnabled, 'DataPreviewEnabled', 0, False); + InitSetting(asLogHeight, 'sqloutheight', 80); + InitSetting(asQueryhelperswidth, 'queryhelperswidth', 200); + InitSetting(asStopOnErrorsInBatchMode, 'StopOnErrorsInBatchMode', 0, True); + InitSetting(asWrapLongLines, 'WrapLongLines', 0, False); + InitSetting(asCodeFolding, 'CodeFolding', 0, True); + InitSetting(asDisplayBLOBsAsText, 'DisplayBLOBsAsText', 0, True); + InitSetting(asSingleQueries, 'SingleQueries', 0, True); + InitSetting(asMemoEditorWidth, 'MemoEditorWidth', 500); + InitSetting(asMemoEditorHeight, 'MemoEditorHeight', 200); + InitSetting(asMemoEditorMaximized, 'MemoEditorMaximized', 0, False); + InitSetting(asMemoEditorWrap, 'MemoEditorWrap', 0, False); + InitSetting(asMemoEditorHighlighter, 'MemoEditorHighlighter_%s', 0, False, 'General', True); + InitSetting(asMemoEditorAlwaysFormatCode, 'MemoEditorAlwaysFormatCode', 0, False); + InitSetting(asDelimiter, 'Delimiter', 0, False, ';'); + InitSetting(asSQLHelpWindowLeft, 'SQLHelp_WindowLeft', 0); + InitSetting(asSQLHelpWindowTop, 'SQLHelp_WindowTop', 0); + InitSetting(asSQLHelpWindowWidth, 'SQLHelp_WindowWidth', 600); + InitSetting(asSQLHelpWindowHeight, 'SQLHelp_WindowHeight', 400); + InitSetting(asSQLHelpPnlLeftWidth, 'SQLHelp_PnlLeftWidth', 150); + InitSetting(asSQLHelpPnlRightTopHeight, 'SQLHelp_PnlRightTopHeight', 150); + InitSetting(asHost, 'Host', 0, False, '', True); + InitSetting(asUser, 'User', 0, False, '', True); + InitSetting(asPassword, 'Password', 0, False, '', True); + InitSetting(asCleartextPluginEnabled, 'CleartextPluginEnabled', 0, False, '', True); + InitSetting(asWindowsAuth, 'WindowsAuth', 0, False, '', True); + InitSetting(asLoginPrompt, 'LoginPrompt', 0, False, '', True); + InitSetting(asPort, 'Port', 0, False, '', True); + InitSetting(asLibrary, 'Library', 0, False, '', True); // Gets its default in TConnectionParameters.Create + InitSetting(asAllProviders, 'AllProviders', 0, False); + InitSetting(asSSHtunnelActive, 'SSHtunnelActive', -1, False, '', True); + InitSetting(asPlinkExecutable, 'PlinkExecutable', 0, False, 'plink.exe'); // Legacy support with global setting + InitSetting(asSshExecutable, 'SshExecutable', 0, False, '', True); + InitSetting(asSSHtunnelHost, 'SSHtunnelHost', 0, False, '', True); + InitSetting(asSSHtunnelHostPort, 'SSHtunnelHostPort', 22, False, '', True); + InitSetting(asSSHtunnelPort, 'SSHtunnelPort', 0, False, '', True); + InitSetting(asSSHtunnelUser, 'SSHtunnelUser', 0, False, '', True); + InitSetting(asSSHtunnelPassword, 'SSHtunnelPassword', 0, False, '', True); + InitSetting(asSSHtunnelTimeout, 'SSHtunnelTimeout', 4, False, '', True); + InitSetting(asSSHtunnelPrivateKey, 'SSHtunnelPrivateKey', 0, False, '', True); + InitSetting(asSSLActive, 'SSL_Active', 0, False, '', True); + InitSetting(asSSLKey, 'SSL_Key', 0, False, '', True); + InitSetting(asSSLCert, 'SSL_Cert', 0, False, '', True); + InitSetting(asSSLCA, 'SSL_CA', 0, False, '', True); + InitSetting(asSSLCipher, 'SSL_Cipher', 0, False, '', True); + InitSetting(asSSLVerification, 'SSL_Verification', 2, False, '', True); + InitSetting(asSSLWarnUnused, 'SSL_WarnUnused', 0, True); + InitSetting(asNetType, 'NetType', Integer(ntMySQL_TCPIP), False, '', True); + InitSetting(asCompressed, 'Compressed', 0, False, '', True); + InitSetting(asLocalTimeZone, 'LocalTimeZone', 0, False, '', True); + InitSetting(asQueryTimeout, 'QueryTimeout', 30, False, '', True); + InitSetting(asKeepAlive, 'KeepAlive', 20, False, '', True); + InitSetting(asStartupScriptFilename, 'StartupScriptFilename', 0, False, '', True); + InitSetting(asDatabases, 'Databases', 0, False, '', True); + InitSetting(asComment, 'Comment', 0, False, '', True); + InitSetting(asDatabaseFilter, 'DatabaseFilter', 0, False, ''); + InitSetting(asTableFilter, 'TableFilter', 0, False, ''); + InitSetting(asFilterVT, 'FilterVTHistory', 0, False, ''); + InitSetting(asExportSQLCreateDatabases, 'ExportSQL_CreateDatabases', 0, False); + InitSetting(asExportSQLCreateTables, 'ExportSQL_CreateTables', 0, False); + InitSetting(asExportSQLDataHow, 'ExportSQL_DataHow', 0); + InitSetting(asExportSQLDataInsertSize, 'ExportSQL_DataInsertSize', 1024); + InitSetting(asExportSQLFilenames, 'ExportSQL_Filenames', 0, False, ''); + InitSetting(asExportZIPFilenames, 'ExportSQL_ZipFilenames', 0, False, ''); + InitSetting(asExportSQLDirectories, 'ExportSQL_Directories', 0, False, ''); + InitSetting(asExportSQLDatabase, 'ExportSQL_Database', 0, False, ''); + InitSetting(asExportSQLServerDatabase, 'ExportSQL_ServerDatabase', 0, False, ''); + InitSetting(asExportSQLOutput, 'ExportSQL_Output', 0); + InitSetting(asExportSQLAddComments, 'ExportSQLAddComments', 0, True); + InitSetting(asExportSQLRemoveAutoIncrement, 'ExportSQLRemoveAutoIncrement', 0, False); + InitSetting(asExportSQLRemoveDefiner, 'ExportSQLRemoveDefiner', 0, True); + InitSetting(asGridExportWindowWidth, 'GridExportWindowWidth', 400); + InitSetting(asGridExportWindowHeight, 'GridExportWindowHeight', 480); + InitSetting(asGridExportOutputCopy, 'GridExportOutputCopy', 0, True); + InitSetting(asGridExportOutputFile, 'GridExportOutputFile', 0, False); + InitSetting(asGridExportFilename, 'GridExportFilename', 0, False, ''); + InitSetting(asGridExportRecentFiles, 'GridExportRecentFiles', 0, False, ''); + InitSetting(asGridExportEncoding, 'GridExportEncoding', 4); + InitSetting(asGridExportFormat, 'GridExportFormat', 0); + InitSetting(asGridExportSelection, 'GridExportSelection', 1); + InitSetting(asGridExportColumnNames, 'GridExportColumnNames', 0, True); + InitSetting(asGridExportIncludeAutoInc, 'GridExportAutoInc', 0, True); + InitSetting(asGridExportIncludeQuery, 'GridExportIncludeQuery', 0, False); + InitSetting(asGridExportRemoveLinebreaks, 'GridExportRemoveLinebreaks', 0, False); + InitSetting(asGridExportSeparator, 'GridExportSeparator', 0, False, ';'); + InitSetting(asGridExportEncloser, 'GridExportEncloser', 0, False, ''); + InitSetting(asGridExportTerminator, 'GridExportTerminator', 0, False, '\r\n'); + InitSetting(asGridExportNull, 'GridExportNull', 0, False, '\N'); + // Copy to clipboard defaults: + InitSetting(asGridExportClpColumnNames, 'GridExportClpColumnNames', 0, True); + InitSetting(asGridExportClpIncludeAutoInc, 'GridExportClpAutoInc', 0, True); + InitSetting(asGridExportClpRemoveLinebreaks, 'GridExportClpRemoveLinebreaks', 0, False); + InitSetting(asGridExportClpSeparator, 'GridExportClpSeparator', 0, False, ';'); + InitSetting(asGridExportClpEncloser, 'GridExportClpEncloser', 0, False, ''); + InitSetting(asGridExportClpTerminator, 'GridExportClpTerminator', 0, False, '\r\n'); + InitSetting(asGridExportClpNull, 'GridExportClpNull', 0, False, '\N'); + + InitSetting(asCSVImportSeparator, 'CSVSeparatorV2', 0, False, ';'); + InitSetting(asCSVImportEncloser, 'CSVEncloserV2', 0, False, '"'); + InitSetting(asCSVImportTerminator, 'CSVTerminator', 0, False, '\r\n'); + InitSetting(asCSVImportFieldEscaper, 'CSVImportFieldEscaperV2', 0, False, '"'); + InitSetting(asCSVImportWindowWidth, 'CSVImportWindowWidth', 530); + InitSetting(asCSVImportWindowHeight, 'CSVImportWindowHeight', 550); + InitSetting(asCSVImportFilename, 'loadfilename', 0, False, ''); + InitSetting(asCSVImportFieldsEnclosedOptionally, 'CSVImportFieldsEnclosedOptionallyV2', 0, True); + InitSetting(asCSVImportIgnoreLines, 'CSVImportIgnoreLines', 1); + InitSetting(asCSVImportLowPriority, 'CSVImportLowPriority', 0, True); + InitSetting(asCSVImportLocalNumbers, 'CSVImportLocalNumbers', 0, False); + InitSetting(asCSVImportDuplicateHandling, 'CSVImportDuplicateHandling', 2); + InitSetting(asCSVImportParseMethod, 'CSVImportParseMethod', 0); + InitSetting(asCSVKeepDialogOpen, 'CSVKeepDialogOpen', 0, False); + InitSetting(asUpdatecheck, 'Updatecheck', 0, False); + InitSetting(asUpdatecheckBuilds, 'UpdatecheckBuilds', 0, False); + InitSetting(asUpdatecheckInterval, 'UpdatecheckInterval', 3); + InitSetting(asUpdatecheckLastrun, 'UpdatecheckLastrun', 0, False, DateToStr(DateTimeNever)); + InitSetting(asUpdateCheckWindowWidth, 'UpdateCheckWindowWidth', 400); + InitSetting(asUpdateCheckWindowHeight, 'UpdateCheckWindowHeight', 460); + InitSetting(asTableToolsWindowWidth, 'TableTools_WindowWidth', 800); + InitSetting(asTableToolsWindowHeight, 'TableTools_WindowHeight', 420); + InitSetting(asTableToolsTreeWidth, 'TableTools_TreeWidth', 300); + InitSetting(asTableToolsFindTextTab, 'TableToolsFindTextTab', 0); + InitSetting(asTableToolsFindText, 'TableTools_FindText', 0, False, ''); + InitSetting(asTableToolsFindSQL, 'TableToolsFindSQL', 0, False, ''); + InitSetting(asTableToolsDatatype, 'TableTools_Datatype', 0); + InitSetting(asTableToolsFindCaseSensitive, 'TableTools_FindCaseSensitive', 0, False); + InitSetting(asTableToolsFindMatchType, 'TableToolsFindMatchType', 0); + InitSetting(asFileImportWindowWidth, 'FileImport_WindowWidth', 530); + InitSetting(asFileImportWindowHeight, 'FileImport_WindowHeight', 530); + InitSetting(asEditVarWindowWidth, 'EditVar_WindowWidth', 300); + InitSetting(asEditVarWindowHeight, 'EditVar_WindowHeight', 260); + InitSetting(asUsermanagerWindowWidth, 'Usermanager_WindowWidth', 500); + InitSetting(asUsermanagerWindowHeight, 'Usermanager_WindowHeight', 400); + InitSetting(asUsermanagerListWidth, 'Usermanager_ListWidth', 180); + InitSetting(asSelectDBOWindowWidth, 'SelectDBO_WindowWidth', 250); + InitSetting(asSelectDBOWindowHeight, 'SelectDBO_WindowHeight', 350); + InitSetting(asSessionManagerListWidth, 'SessionManager_ListWidth', 220); + InitSetting(asSessionManagerWindowWidth, 'SessionManager_WindowWidth', 700); + InitSetting(asSessionManagerWindowHeight, 'SessionManager_WindowHeight', 490); + InitSetting(asSessionManagerWindowLeft, 'SessionManager_WindowLeft', 50); + InitSetting(asSessionManagerWindowTop, 'SessionManager_WindowTop', 50); + InitSetting(asCopyTableWindowHeight, 'CopyTable_WindowHeight', 340); + InitSetting(asCopyTableWindowWidth, 'CopyTable_WindowWidth', 380); + InitSetting(asCopyTableColumns, 'CopyTable_Columns', 0, True); + InitSetting(asCopyTableKeys, 'CopyTable_Keys', 0, True); + InitSetting(asCopyTableForeignKeys, 'CopyTable_ForeignKeys', 0, True); + InitSetting(asCopyTableData, 'CopyTable_Data', 0, True); + InitSetting(asCopyTableRecentFilter, 'CopyTable_RecentFilter_%s', 0, False, ''); + InitSetting(asServerVersion, 'ServerVersion', 0, False, '', True); + InitSetting(asServerVersionFull, 'ServerVersionFull', 0, False, '', True); + InitSetting(asLastConnect, 'LastConnect', 0, False, DateToStr(DateTimeNever), True); + InitSetting(asConnectCount, 'ConnectCount', 0, False, '', True); + InitSetting(asRefusedCount, 'RefusedCount', 0, False, '', True); + InitSetting(asSessionCreated, 'SessionCreated', 0, False, '', True); + InitSetting(asDoUsageStatistics, 'DoUsageStatistics', 0, False); + InitSetting(asLastUsageStatisticCall, 'LastUsageStatisticCall', 0, False, DateToStr(DateTimeNever)); + InitSetting(asWheelZoom, 'WheelZoom', 0, True); + InitSetting(asDisplayBars, 'DisplayBars', 0, true); + InitSetting(asMySQLBinaries, 'MySQL_Binaries', 0, False, ''); + InitSetting(asSequalSuggestWindowWidth, 'SequalSuggestWindowWidth', 500); + InitSetting(asSequalSuggestWindowHeight, 'SequalSuggestWindowHeight', 400); + InitSetting(asSequalSuggestPrompt, 'SequalSuggestPrompt', 0, False, ''); + InitSetting(asSequalSuggestRecentPrompts, 'SequalSuggestRecentPrompts', 0, False, ''); + InitSetting(asReformatter, 'Reformatter', 0); + InitSetting(asReformatterNoDialog, 'ReformatterNoDialog', 0); + InitSetting(asAlwaysGenerateFilter, 'AlwaysGenerateFilter', 0, False); + InitSetting(asGenerateDataNumRows, 'GenerateDataNumRows', 1000); + InitSetting(asGenerateDataNullAmount, 'GenerateDataNullAmount', 10); + + // Default folder for snippets + if FPortableMode then + DefaultSnippetsDirectory := ExtractFilePath(ParamStr(0)) + else + DefaultSnippetsDirectory := DirnameUserDocuments; + DefaultSnippetsDirectory := DefaultSnippetsDirectory + 'Snippets\'; + InitSetting(asCustomSnippetsDirectory, 'CustomSnippetsDirectory', 0, False, DefaultSnippetsDirectory); + 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); + InitSetting(asTabCloseOnDoubleClick, 'TabCloseOnDoubleClick', 0, True); + InitSetting(asTabCloseOnMiddleClick, 'TabCloseOnMiddleClick', 0, True); + InitSetting(asTabsInMultipleLines, 'TabsInMultipleLines', 0, True); + InitSetting(asTabIconsGrayscaleMode, 'TabIconsGrayscaleMode', 1); + InitSetting(asWarnUnsafeUpdates, 'WarnUnsafeUpdates', 0, True); + InitSetting(asQueryGridLongSortRowNum, 'QueryGridLongSortRowNum', 10000); + InitSetting(asCompletionProposal, 'CompletionProposal', 0, True); + InitSetting(asCompletionProposalInterval, 'CompletionProposalInterval', 500); + InitSetting(asCompletionProposalSearchOnMid, 'CompletionProposalSearchOnMid', 0, True); + InitSetting(asCompletionProposalWidth, 'CompletionProposalWidth', 350); + InitSetting(asCompletionProposalNbLinesInWindow,'CompletionProposalNbLinesInWindow', 12); + InitSetting(asAutoUppercase, 'AutoUppercase', 0, True); + InitSetting(asTabsToSpaces, 'TabsToSpaces', 0, False); + InitSetting(asFilterPanel, 'FilterPanel', 0, True); + InitSetting(asAllowMultipleInstances, 'AllowMultipleInstances', 0, True); + InitSetting(asFindDialogSearchHistory, 'FindDialogSearchHistory', 0, False, ''); + InitSetting(asFindDialogReplaceHistory, 'FindDialogReplaceHistory', 0, False, ''); + InitSetting(asGUIFontName, 'GUIFontName', 0, False, ''); + InitSetting(asGUIFontSize, 'GUIFontSize', 8); + InitSetting(asTheme, 'Theme', 0, False, 'Windows'); + InitSetting(asIconPack, 'IconPack', 0, False, 'Icons8'); + InitSetting(asWebSearchBaseUrl, 'WebSearchBaseUrl', 0, False, 'https://www.ecosia.org/search?q=%query'); + InitSetting(asMaxQueryResults, 'MaxQueryResults', 10); + InitSetting(asLogErrors, 'LogErrors', 0, True); + InitSetting(asLogUserSQL, 'LogUserSQL', 0, True); + InitSetting(asLogSQL, 'LogSQL', 0, True); + InitSetting(asLogScript, 'LogScript', 0, False); + InitSetting(asLogInfos, 'LogInfos', 0, True); + InitSetting(asLogDebug, 'LogDebug', 0, False); + InitSetting(asLogTimestamp, 'LogTimestamp', 0, False); + InitSetting(asFieldColorNumeric, 'FieldColor_Numeric', $00FF0000); + InitSetting(asFieldColorReal, 'FieldColor_Real', $00FF0048); + InitSetting(asFieldColorText, 'FieldColor_Text', $00008000); + InitSetting(asFieldColorBinary, 'FieldColor_Binary', $00800080); + InitSetting(asFieldColorDatetime, 'FieldColor_Datetime', $00000080); + InitSetting(asFieldColorSpatial, 'FieldColor_Spatial', $00808000); + InitSetting(asFieldColorOther, 'FieldColor_Other', $00008080); + InitSetting(asFieldEditorBinary, 'FieldEditor_Binary', 0, True); + InitSetting(asFieldEditorDatetime, 'FieldEditor_Datetime', 0, True); + InitSetting(asFieldEditorDatetimePrefill, 'FieldEditor_Datetime_Prefill', 0, True); + InitSetting(asFieldEditorEnum, 'FieldEditor_Enum', 0, True); + InitSetting(asFieldEditorSet, 'FieldEditor_Set', 0, True); + InitSetting(asFieldNullBackground, 'Field_NullBackground', clNone); + InitSetting(asRowBackgroundEven, 'RowBackgroundEven', clNone); + InitSetting(asRowBackgroundOdd, 'RowBackgroundOdd', clNone); + InitSetting(asGroupTreeObjects, 'GroupTreeObjects', 0, False); + InitSetting(asDisplayObjectSizeColumn, 'DisplayObjectSizeColumn', 0, True); + InitSetting(asActionShortcut1, 'Shortcut1_%s', 0); + InitSetting(asActionShortcut2, 'Shortcut2_%s', 0); + InitSetting(asHighlighterForeground, 'SQL Attr %s Foreground', 0); + InitSetting(asHighlighterBackground, 'SQL Attr %s Background', 0); + InitSetting(asHighlighterStyle, 'SQL Attr %s Style', 0); + InitSetting(asSQLfile, 'SQLFile%s', 0, False, ''); + InitSetting(asListColWidths, 'ColWidths_%s', 0, False, ''); + InitSetting(asListColsVisible, 'ColsVisible_%s', 0, False, ''); + InitSetting(asListColPositions, 'ColPositions_%s', 0, False, ''); + InitSetting(asListColSort, 'ColSort_%s', 0, False, ''); + InitSetting(asSessionFolder, 'Folder', 0, False, '', True); + InitSetting(asRecentFilter, '%s', 0, False, '', True); + InitSetting(asTimestampColumns, 'TimestampColumns', 0, False, '', True); + InitSetting(asDateTimeEditorCursorPos, 'DateTimeEditor_CursorPos_Type%s', 0); + InitSetting(asAppLanguage, 'Language', 0, False, ''); + InitSetting(asAutoExpand, 'AutoExpand', 0, False); + InitSetting(asDoubleClickInsertsNodeText, 'DoubleClickInsertsNodeText', 0, True); + InitSetting(asForeignDropDown, 'ForeignDropDown', 0, True); + InitSetting(asIncrementalSearch, 'IncrementalSearch', 0, True); + InitSetting(asQueryHistoryEnabled, 'QueryHistory', 0, True); + InitSetting(asQueryHistoryKeepDays, 'QueryHistoryKeeypDays', 30); + InitSetting(asColumnSelectorWidth, 'ColumnSelectorWidth', 200, False, ''); + InitSetting(asColumnSelectorHeight, 'ColumnSelectorHeight', 270, False, ''); + InitSetting(asDonatedEmail, 'DonatedEmail', 0, False, ''); + InitSetting(asFavoriteObjects, 'FavoriteObjects', 0, False, '', True); + InitSetting(asFavoriteObjectsOnly, 'FavoriteObjectsOnly', 0, False); // No longer used + InitSetting(asFullTableStatus, 'FullTableStatus', 0, True, '', True); + InitSetting(asLineBreakStyle, 'LineBreakStyle', Integer(lbsWindows)); + InitSetting(asPreferencesWindowWidth, 'PreferencesWindowWidth', 740); + InitSetting(asPreferencesWindowHeight, 'PreferencesWindowHeight', 500); + InitSetting(asFileDialogEncoding, 'FileDialogEncoding_%s', 0); + InitSetting(asThemePreviewWidth, 'ThemePreviewWidth', 300); + InitSetting(asThemePreviewHeight, 'ThemePreviewHeight', 200); + InitSetting(asThemePreviewTop, 'ThemePreviewTop', 300); + InitSetting(asThemePreviewLeft, 'ThemePreviewLeft', 300); + InitSetting(asCreateDbCollation, 'CreateDbCollation', 0, False, ''); + InitSetting(asRealTrailingZeros, 'RealTrailingZeros', 1); + InitSetting(asWebOnceAction, 'WebOnceAction', 0, False, DateToStr(DateTimeNever)); + + // Initialization values + FRestoreTabsInitValue := ReadBool(asRestoreTabs); + +end;} + + +{destructor TAppSettings.Destroy; +var + AllKeys: TStringList; + i: Integer; + Proc: TProcessEntry32; + ProcRuns: Boolean; + SnapShot: THandle; + rx: TRegExpr; +begin + // Export settings into textfile in portable mode. + if FPortableMode then try + try + ExportSettings; + except + // do nothing, even ShowMessage or ErrorDialog would trigger timer events followed by crashes; + end; + FRegistry.CloseKey; + FRegistry.DeleteKey(FBasePath); + + // Remove dead keys from instances which didn't close clean, e.g. because of an AV + SnapShot := CreateToolhelp32Snapshot(TH32CS_SnapProcess, 0); + Proc.dwSize := Sizeof(Proc); + FRegistry.OpenKeyReadOnly('\Software\'); + AllKeys := TStringList.Create; + FRegistry.GetKeyNames(AllKeys); + rx := TRegExpr.Create; + rx.Expression := '^' + QuoteRegExprMetaChars(APPNAME) + ' Portable (\d+)$'; + for i:=0 to AllKeys.Count-1 do begin + if not rx.Exec(AllKeys[i]) then + Continue; + ProcRuns := False; + if Process32First(SnapShot, Proc) then while True do begin + ProcRuns := rx.Match[1] = IntToStr(Proc.th32ProcessID); + if ProcRuns or (not Process32Next(SnapShot, Proc)) then + break; + end; + if not ProcRuns then + FRegistry.DeleteKey(AllKeys[i]); + end; + FRegistry.CloseKey; + CloseHandle(SnapShot); + AllKeys.Free; + rx.Free; + except + on E:Exception do // Prefer ShowMessage, see http://www.heidisql.com/forum.php?t=14001 + ShowMessage('Error: '+E.Message); + end; + FRegistry.Free; + inherited; +end;} + + +{procedure TAppSettings.InitSetting(Index: TAppSettingIndex; Name: String; + DefaultInt: Integer=0; DefaultBool: Boolean=False; DefaultString: String=''; + Session: Boolean=False); +begin + FSettings[Index].Name := Name; + FSettings[Index].Session := Session; + FSettings[Index].DefaultInt := DefaultInt; + FSettings[Index].DefaultBool := DefaultBool; + FSettings[Index].DefaultString := DefaultString; + FSettings[Index].Synced := False; +end;} + + +{procedure TAppSettings.SetSessionPath(Value: String); +begin + // Following calls may want to read or write some session specific setting + if Value <> FSessionPath then begin + FSessionPath := Value; + PrepareRegistry; + end; +end;} + + +{procedure TAppSettings.ResetPath; +begin + SessionPath := ''; +end;} + + +{procedure TAppSettings.StorePath; +begin + FStoredPath := SessionPath; +end;} + +{procedure TAppSettings.RestorePath; +begin + SessionPath := FStoredPath; +end;} + + +{procedure TAppSettings.PrepareRegistry; +var + Folder: String; +begin + // Open the wanted registry path + Folder := FBasePath; + if FSessionPath <> '' then + Folder := Folder + REGKEY_SESSIONS + '\' + FSessionPath; + if '\'+FRegistry.CurrentPath <> Folder then try + FRegistry.OpenKey(Folder, True); + except + on E:Exception do begin + // Recreate exception with a more useful message + E.Message := E.Message + CRLF + CRLF + 'While trying to open registry key "'+Folder+'"'; + raise; + end; + end; +end;} + + +{function TAppSettings.GetValueNames: TStringList; +begin + PrepareRegistry; + Result := TStringList.Create; + FRegistry.GetValueNames(Result); +end;} + + +{function TAppSettings.GetValueName(Index: TAppSettingIndex): String; +begin + Result := FSettings[Index].Name; +end;} + + +{function TAppSettings.GetKeyNames: TStringList; +begin + PrepareRegistry; + Result := TStringList.Create; + FRegistry.GetKeyNames(Result); +end;} + + +{function TAppSettings.DeleteValue(Index: TAppSettingIndex; FormatName: String=''): Boolean; +var + ValueName: String; +begin + PrepareRegistry; + ValueName := GetValueName(Index); + if FormatName <> '' then + ValueName := Format(ValueName, [FormatName]); + Result := FRegistry.DeleteValue(ValueName); + FSettings[Index].Synced := False; +end;} + + +{function TAppSettings.DeleteValue(ValueName: String): Boolean; +begin + Result := FRegistry.DeleteValue(ValueName); +end;} + + +{procedure TAppSettings.DeleteCurrentKey; +var + KeyPath: String; +begin + // Delete the current registry key + // Note that, contrary to the documentation, .DeleteKey is done even when this key has subkeys + PrepareRegistry; + if FSessionPath.IsEmpty then + raise Exception.CreateFmt(_('No path set, won''t delete root key %s'), [FRegistry.CurrentPath]) + else begin + KeyPath := REGKEY_SESSIONS + '\' + FSessionPath; + ResetPath; + FRegistry.DeleteKey(KeyPath); + end; +end;} + + +{procedure TAppSettings.MoveCurrentKey(TargetPath: String); +var + KeyPath: String; +begin + PrepareRegistry; + if FSessionPath.IsEmpty then + raise Exception.CreateFmt(_('No path set, won''t move root key %s'), [FRegistry.CurrentPath]) + else begin + KeyPath := REGKEY_SESSIONS + '\' + FSessionPath; + ResetPath; + FRegistry.MoveKey(KeyPath, TargetPath, True); + end; +end;} + + +{function TAppSettings.ValueExists(Index: TAppSettingIndex): Boolean; +var + ValueName: String; +begin + PrepareRegistry; + ValueName := GetValueName(Index); + Result := FRegistry.ValueExists(ValueName); +end;} + + +{function TAppSettings.SessionPathExists(SessionPath: String): Boolean; +begin + Result := FRegistry.KeyExists(FBasePath + REGKEY_SESSIONS + '\' + SessionPath); +end;} + + +{function TAppSettings.IsEmptyKey: Boolean; +var + TestList: TStringList; +begin + TestList := GetValueNames; + Result := (not FRegistry.HasSubKeys) and (TestList.Count = 0); + TestList.Free; +end;} + + +{function TAppSettings.GetDefaultInt(Index: TAppSettingIndex): Integer; +begin + // Return default integer value + Result := FSettings[Index].DefaultInt; +end;} + + +{function TAppSettings.GetDefaultBool(Index: TAppSettingIndex): Boolean; +begin + // Return default boolean value + Result := FSettings[Index].DefaultBool; +end;} + + +{function TAppSettings.GetDefaultString(Index: TAppSettingIndex): String; +begin + // Return default string value + Result := FSettings[Index].DefaultString; +end;} + + +{procedure TAppSettings.Read(Index: TAppSettingIndex; FormatName: String; + DataType: TAppSettingDataType; var I: Integer; var B: Boolean; var S: String; + DI: Integer; DB: Boolean; DS: String); +var + ValueName: String; +begin + // Read user setting value from registry + I := FSettings[Index].DefaultInt; + B := FSettings[Index].DefaultBool; + S := FSettings[Index].DefaultString; + if DI<>0 then I := DI; + if DB<>False then B := DB; + if DS<>'' then S := DS; + ValueName := FSettings[Index].Name; + if FormatName <> '' then + ValueName := Format(ValueName, [FormatName]); + if FSettings[Index].Session and FSessionPath.IsEmpty then + raise Exception.Create(_('Attempt to read session setting without session path')); + if (not FSettings[Index].Session) and (not FSessionPath.IsEmpty) then + SessionPath := '' + else + PrepareRegistry; + if FSettings[Index].Synced then begin + case DataType of + adInt: I := FSettings[Index].CurrentInt; + adBool: B := FSettings[Index].CurrentBool; + adString: S := FSettings[Index].CurrentString; + else raise Exception.CreateFmt(_(SUnsupportedSettingsDatatype), [FSettings[Index].Name]); + end; + end else if FRegistry.ValueExists(ValueName) then begin + Inc(FReads); + case DataType of + adInt: I := FRegistry.ReadInteger(ValueName); + adBool: B := FRegistry.ReadBool(ValueName); + adString: S := FRegistry.ReadString(ValueName); + else raise Exception.CreateFmt(_(SUnsupportedSettingsDatatype), [FSettings[Index].Name]); + end; + end; + if (FormatName = '') and (FSessionPath = '') then begin + FSettings[Index].Synced := True; + FSettings[Index].CurrentInt := I; + FSettings[Index].CurrentBool := B; + FSettings[Index].CurrentString := S; + end; +end;} + + +{function TAppSettings.ReadInt(Index: TAppSettingIndex; FormatName: String=''; Default: Integer=0): Integer; +var + S: String; + B: Boolean; +begin + Read(Index, FormatName, adInt, Result, B, S, Default, False, ''); +end;} + + +{function TAppSettings.ReadIntDpiAware(Index: TAppSettingIndex; AControl: TControl; FormatName: String=''; Default: Integer=0): Integer; +begin + Result := ReadInt(Index, FormatName, Default); + Result := Round(Result * AControl.ScaleFactor); +end;} + + +{function TAppSettings.ReadBool(Index: TAppSettingIndex; FormatName: String=''; Default: Boolean=False): Boolean; +var + I: Integer; + S: String; +begin + Read(Index, FormatName, adBool, I, Result, S, 0, Default, ''); +end;} + + +{function TAppSettings.ReadString(Index: TAppSettingIndex; FormatName: String=''; Default: String=''): String; +var + I: Integer; + B: Boolean; +begin + Read(Index, FormatName, adString, I, B, Result, 0, False, Default); +end;} + + +{function TAppSettings.ReadString(ValueName: String): String; +begin + PrepareRegistry; + Result := FRegistry.ReadString(ValueName); +end;} + + +{procedure TAppSettings.Write(Index: TAppSettingIndex; FormatName: String; + DataType: TAppSettingDataType; I: Integer; B: Boolean; S: String); +var + ValueName: String; + SameAsCurrent: Boolean; +begin + // Write user setting value to registry + ValueName := FSettings[Index].Name; + if FormatName <> '' then + ValueName := Format(ValueName, [FormatName]); + if FSettings[Index].Session and FSessionPath.IsEmpty then + raise Exception.Create(_('Attempt to write session setting without session path')); + if (not FSettings[Index].Session) and (not FSessionPath.IsEmpty) then + SessionPath := '' + else + PrepareRegistry; + case DataType of + adInt: begin + SameAsCurrent := FSettings[Index].Synced and (I = FSettings[Index].CurrentInt); + if not SameAsCurrent then begin + FRegistry.WriteInteger(ValueName, I); + Inc(FWrites); + end; + FSettings[Index].CurrentInt := I; + end; + adBool: begin + SameAsCurrent := FSettings[Index].Synced and (B = FSettings[Index].CurrentBool); + if not SameAsCurrent then begin + FRegistry.WriteBool(ValueName, B); + Inc(FWrites); + end; + FSettings[Index].CurrentBool := B; + end; + adString: begin + SameAsCurrent := FSettings[Index].Synced and (S = FSettings[Index].CurrentString); + if not SameAsCurrent then begin + FRegistry.WriteString(ValueName, S); + Inc(FWrites); + end; + FSettings[Index].CurrentString := S; + end; + else + raise Exception.CreateFmt(_(SUnsupportedSettingsDatatype), [FSettings[Index].Name]); + end; + if (FormatName = '') and (FSessionPath = '') then + FSettings[Index].Synced := True; +end;} + + +{procedure TAppSettings.WriteInt(Index: TAppSettingIndex; Value: Integer; FormatName: String=''); +begin + Write(Index, FormatName, adInt, Value, False, ''); +end;} + + +{procedure TAppSettings.WriteIntDpiAware(Index: TAppSettingIndex; AControl: TControl; Value: Integer; FormatName: String=''); +begin + Value := Round(Value / AControl.ScaleFactor); + WriteInt(Index, Value, FormatName); +end;} + + +{procedure TAppSettings.WriteBool(Index: TAppSettingIndex; Value: Boolean; FormatName: String=''); +begin + Write(Index, FormatName, adBool, 0, Value, ''); +end;} + + +{procedure TAppSettings.WriteString(Index: TAppSettingIndex; Value: String; FormatName: String=''); +begin + Write(Index, FormatName, adString, 0, False, Value); +end;} + + +{procedure TAppSettings.WriteString(ValueName, Value: String); +begin + PrepareRegistry; + FRegistry.WriteString(ValueName, Value); +end;} + + +{function TAppSettings.GetSessionNames(ParentPath: String; var Folders: TStringList): TStringList; +var + i: Integer; + CurPath: String; +begin + ResetPath; + CurPath := FBasePath + REGKEY_SESSIONS + '\' + ParentPath; + FRegistry.OpenKey(CurPath, False); + Result := TStringList.Create; + FRegistry.GetKeyNames(Result); + for i:=Result.Count-1 downto 0 do begin + // Issue #1111 describes a recursive endless loop, which may be caused by an empty key name here? + if Result[i].IsEmpty then + Continue; + // ... may also be caused by some non accessible key. Check result of .OpenKey before looking for "Folder" value: + if FRegistry.OpenKey(CurPath+'\'+Result[i], False) then begin + if FRegistry.ValueExists(GetValueName(asSessionFolder)) then begin + Folders.Add(Result[i]); + Result.Delete(i); + end; + end; + end; +end;} + + +{procedure TAppSettings.GetSessionPaths(ParentPath: String; var Sessions: TStringList); +var + Folders, Names: TStringList; + i: Integer; +begin + Folders := TStringList.Create; + Names := GetSessionNames(ParentPath, Folders); + for i:=0 to Names.Count-1 do + Sessions.Add(ParentPath+Names[i]); + for i:=0 to Folders.Count-1 do + GetSessionPaths(ParentPath+Folders[i]+'\', Sessions); + Sessions.Sort; + Names.Free; + Folders.Free; +end;} + + +{procedure TAppSettings.ImportSettings(Filename: String); +var + Content, Name, Value, KeyPath: String; + Lines, Segments: TStringList; + i: Integer; + DataType: TRegDataType; +begin + // Load registry settings from file + + if not FileExists(Filename) then begin + raise Exception.CreateFmt('File does not exist: %s', [Filename]); + end; + + Content := ReadTextfile(FileName, UTF8NoBOMEncoding); + Lines := Explode(CRLF, Content); + for i:=0 to Lines.Count-1 do begin + // Each line has 3 segments: reg path | data type | value. Continue if explode finds less or more than 3. + Segments := Explode(DELIMITER, Lines[i]); + if Segments.Count <> 3 then + continue; + KeyPath := FBasePath + ExtractFilePath(Segments[0]); + Name := ExtractFileName(Segments[0]); + DataType := TRegDataType(StrToInt(Segments[1])); + FRegistry.OpenKey(KeyPath, True); + if FRegistry.ValueExists(Name) then + Continue; // Don't touch value if already there + Value := ''; + if Segments.Count >= 3 then + Value := Segments[2]; + case DataType of + rdString: begin + Value := StringReplace(Value, CHR13REPLACEMENT, #13, [rfReplaceAll]); + Value := StringReplace(Value, CHR10REPLACEMENT, #10, [rfReplaceAll]); + FRegistry.WriteString(Name, Value); + end; + rdInteger: + FRegistry.WriteInteger(Name, MakeInt(Value)); + rdBinary, rdUnknown, rdExpandString: + ErrorDialog(Name+' has an unsupported data type.'); + end; + Segments.Free; + end; + Lines.Free; +end;} + + +{function TAppSettings.ExportSettings(Filename: String): Boolean; +var + Content, Value: String; + DataType: TRegDataType; + + procedure ReadKeyToContent(Path: String); + var + Names: TStringList; + i: Integer; + SubPath: String; + begin + // Recursively read values in keys and their subkeys into "content" variable + FRegistry.OpenKey(Path, True); + SubPath := Copy(Path, Length(FBasePath)+1, MaxInt); + Names := TStringList.Create; + FRegistry.GetValueNames(Names); + for i:=0 to Names.Count-1 do begin + DataType := FRegistry.GetDataType(Names[i]); + Content := Content + + SubPath + Names[i] + DELIMITER + + IntToStr(Integer(DataType)) + DELIMITER; + case DataType of + rdString: begin + Value := FRegistry.ReadString(Names[i]); + Value := StringReplace(Value, #13, CHR13REPLACEMENT, [rfReplaceAll]); + Value := StringReplace(Value, #10, CHR10REPLACEMENT, [rfReplaceAll]); + end; + rdInteger: + Value := IntToStr(FRegistry.ReadInteger(Names[i])); + rdBinary, rdUnknown, rdExpandString: + ErrorDialog(Names[i]+' has an unsupported data type.'); + end; + Content := Content + Value + CRLF; + end; + Names.Clear; + FRegistry.GetKeyNames(Names); + for i:=0 to Names.Count-1 do + ReadKeyToContent(Path + Names[i] + '\'); + Names.Free; + end; + +begin + // Save registry settings to file + Content := ''; + ReadKeyToContent(FBasePath); + SaveUnicodeFile(FileName, Content, UTF8NoBOMEncoding); + Result := True; +end;} + + +{function TAppSettings.ExportSettings: Boolean; +begin + Result := False; + if not FPortableModeReadOnly then begin + try + ExportSettings(FSettingsFile); + Result := True; + except + on E:Exception do begin + FPortableModeReadOnly := True; + Raise Exception.Create(E.ClassName + ': ' + E.Message + CRLF + CRLF + + f_('Switching to read-only mode. Settings won''t be saved. Use the command line parameter %s to use a custom file path.', ['--psettings']) + ); + end; + end; + end; +end;} + + +{function TAppSettings.DirnameUserAppData: String; +begin + // User folder for HeidiSQL's data (<user name>\Application Data) + Result := GetShellFolder(FOLDERID_RoamingAppData) + '\' + APPNAME + '\'; + if not DirectoryExists(Result) then begin + ForceDirectories(Result); + 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. +end;} + + +{function TAppSettings.DirnameSnippets: String; +begin + // Folder for snippets + Result := ReadString(asCustomSnippetsDirectory); + if Result.IsEmpty then + Result := GetDefaultString(asCustomSnippetsDirectory); + Result := IncludeTrailingBackslash(Result); + if not DirectoryExists(Result) then begin + ForceDirectories(Result); + end; +end;} + + +{function TAppSettings.DirnameBackups: String; +begin + // Create backup folder if it does not exist and return it + if PortableMode then begin + Result := ExtractFilePath(Application.ExeName) + 'Backups\' + end else begin + Result := DirnameUserAppData + 'Backups\'; + end; + if not DirectoryExists(Result) then begin + ForceDirectories(Result); + end; +end;} + + +{function TAppSettings.DirnameHighlighters: string; +begin + if PortableMode then begin + Result := ExtractFilePath(Application.ExeName) + 'Highlighters\' + end else begin + Result := DirnameUserAppData + 'Highlighters\'; + end; + if not DirectoryExists(Result) then begin + ForceDirectories(Result); + end; +end;} + + + +{ TUTF8NoBOMEncoding } + +{function TUTF8NoBOMEncoding.GetPreamble: TBytes; +begin + SetLength(Result, 0); +end;} + + +initialization + +NumberChars := ['0'..'9', FormatSettings.DecimalSeparator, FormatSettings.ThousandSeparator]; + +LibHandleUser32 := LoadLibrary('User32.dll'); + +//UTF8NoBOMEncoding := TUTF8NoBOMEncoding.Create; + +DateTimeNever := MinDateTime; + +//ConfirmIcon := TIcon.Create; +//ConfirmIcon.LoadFromResourceName(hInstance, 'Z_ICONQUESTION'); + +end. + + diff --git a/source/const.inc b/source/const.inc new file mode 100644 index 00000000..47cb3026 --- /dev/null +++ b/source/const.inc @@ -0,0 +1,106 @@ +// Common constants +const + + // Line breaks + // TODO: use sLineBreak instead + CRLF = #13#10; + LB_UNIX = #10; + LB_MAC = #13; + LB_WIDE = WideChar($2027); + + // Placeholder text for NULL values + TEXT_NULL = '(NULL)'; + + // General things + APPNAME = 'HeidiSQL'; + APPDOMAIN = 'https://www.heidisql.com/'; + REGKEY_SESSIONS = 'Servers'; + REGKEY_QUERYHISTORY = 'QueryHistory'; + REGKEY_RECENTFILTERS = 'RecentFilters'; + // Some unique char, used to separate e.g. selected columns in registry + DELIM = '|'; + CHR10REPLACEMENT = '<}}}>'; + CHR13REPLACEMENT = '<{{{>'; + LINEDELIMITER = '<|||>'; + + COLORSHIFT_NULLFIELDS = 70; // Brightness adjustment to add to normal field colors for NULL values + COLORSHIFT_SORTCOLUMNS = 12; // Brightness adjustment to add to sorted column backgrounds + + // Various iconindexes + ICONINDEX_PRIMARYKEY = 25; + ICONINDEX_FIELD = 42; + ICONINDEX_INDEXKEY = 23; + ICONINDEX_UNIQUEKEY = 24; + ICONINDEX_FULLTEXTKEY = 22; + ICONINDEX_SPATIALKEY = 126; + ICONINDEX_FOREIGNKEY = 136; + ICONINDEX_SERVER = 36; + ICONINDEX_DB = 5; + ICONINDEX_HIGHLIGHTMARKER = 157; + ICONINDEX_TABLE = 14; + ICONINDEX_VIEW = 81; + ICONINDEX_STOREDPROCEDURE = 119; + ICONINDEX_STOREDFUNCTION = 35; + ICONINDEX_TRIGGER = 137; + ICONINDEX_FUNCTION = 13; + ICONINDEX_EVENT = 80; + ICONINDEX_KEYWORD = 25; + + // Size of byte units + {Kibibyte} SIZE_KB = Int64(1024); + {Mebibyte} SIZE_MB = Int64(1048576); + {Gibibyte} SIZE_GB = Int64(1073741824); + {Tebibyte} SIZE_TB = Int64(1099511627776); + {Pebibyte} SIZE_PB = Int64(1125899906842624); + {Exbibyte} SIZE_EB = Int64(1152921504606846976); + + // Size of byte units for formatting purposes + {Kibibyte} FSIZE_KB = Int64(1000); + {Mebibyte} FSIZE_MB = Int64(1024000); + {Gibibyte} FSIZE_GB = Int64(1048576000); + {Tebibyte} FSIZE_TB = Int64(1073741824000); + {Pebibyte} FSIZE_PB = Int64(1099511627776000); + {Exbibyte} FSIZE_EB = Int64(1125899906842624000); + + // Abbreviations of byte unit names + {Bytes} NAME_BYTES = ' B'; + {Kibibyte} NAME_KB = ' KiB'; + {Mebibyte} NAME_MB = ' MiB'; + {Gibibyte} NAME_GB = ' GiB'; + {Tebibyte} NAME_TB = ' TiB'; + {Pebibyte} NAME_PB = ' PiB'; + {Exbibyte} NAME_EB = ' EiB'; + + // Data grid: How many bytes to fetch from data fields that are potentially large. + GRIDMAXDATA: Int64 = 256; + + BACKUP_MAXFILESIZE = 10 * SIZE_MB; + BACKUP_FILEPATTERN: String = 'query-tab-%s.sql'; + + VTREE_NOTLOADED = 0; + VTREE_NOTLOADED_PURGECACHE = 1; + VTREE_LOADED = 2; + + // Modification indicator for TControl.Tag + MODIFIEDFLAG = 10; + + 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.'; + SIdle = 'Idle.'; + SUnsupported = 'Unsupported by this server'; + SUnsupportedSettingsDatatype = 'Unsupported datatype for setting "%s"'; + SNotImplemented = 'Method not implemented for this connection type'; + MsgSQLError: String = 'SQL Error (%d): %s'; + MsgSQLErrorMultiStatements: String = 'SQL Error (%d) in statement #%d: %s'; + 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.'; + FILEFILTER_SQLITEDB = '*.sqlite3;*.sqlite;*.db;*.s3db'; + FILEEXT_SQLITEDB = 'sqlite3'; + PROPOSAL_ITEM_HEIGHT = 18; + // Note the following should be in sync to what MySQL returns from SHOW WARNINGS + SLogPrefixWarning = 'Warning'; + SLogPrefixNote = 'Note'; + SLogPrefixInfo = 'Info'; + diff --git a/source/dbconnection.pas b/source/dbconnection.pas new file mode 100644 index 00000000..a603f20e --- /dev/null +++ b/source/dbconnection.pas @@ -0,0 +1,37 @@ +unit dbconnection; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Generics.Collections, Generics.Defaults; + +type + TDBConnection = class; + + { TDBConnection } + + TDBLogCategory = (lcInfo, lcSQL, lcUserFiredSQL, lcError, lcDebug, lcScript); + TDBLogItem = class(TObject) + public + Category: TDBLogCategory; + LineText: String; + Connection: TDBConnection; + end; + TDBLogItems = TObjectList<TDBLogItem>; + TDBLogEvent = procedure(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil) of object; + TDBEvent = procedure(Connection: TDBConnection; Database: String) of object; + + TDBConnection = class(TComponent) + private + FActive: Boolean; + public + end; + TDBConnectionList = TObjectList<TDBConnection>; + + +implementation + +end. + diff --git a/source/dbstructures.mysql.pas b/source/dbstructures.mysql.pas new file mode 100644 index 00000000..31c38842 --- /dev/null +++ b/source/dbstructures.mysql.pas @@ -0,0 +1,3389 @@ +unit dbstructures.mysql; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, dbstructures; + + +const + // General declarations + MYSQL_ERRMSG_SIZE = 512; + SQLSTATE_LENGTH = 5; + SCRAMBLE_LENGTH = 20; + MYSQL_PORT = 3306; + LOCAL_HOST = 'localhost'; + NAME_LEN = 64; + PROTOCOL_VERSION = 10; + FRM_VER = 6; + + // Field's flags + NOT_NULL_FLAG = 1; + PRI_KEY_FLAG = 2; + UNIQUE_KEY_FLAG = 4; + MULTIPLE_KEY_FLAG = 8; + BLOB_FLAG = 16; + UNSIGNED_FLAG = 32; + ZEROFILL_FLAG = 64; + BINARY_FLAG = 128; + ENUM_FLAG = 256; + AUTO_INCREMENT_FLAG = 512; + TIMESTAMP_FLAG = 1024; + SET_FLAG = 2048; + NO_DEFAULT_VALUE_FLAG = 4096; // Field has no default value + ON_UPDATE_NOW_FLAG = 8192; // If a field is updated it will get the current time value (NOW()) + NUM_FLAG = 32768; // Field is numeric + PART_KEY_FLAG = 16384; // wrong from here on, where do these come from? + GROUP_FLAG = 32768; + UNIQUE_FLAG = 65536; + BINCMP_FLAG = 131072; + + // Client connection options + CLIENT_LONG_PASSWORD: Int64 = 0; // obsolete flag + CLIENT_MYSQL: Int64 = 1; // mysql/old mariadb server/client + CLIENT_FOUND_ROWS: Int64 = 2; // Found instead of affected rows + CLIENT_LONG_FLAG: Int64 = 4; // Get all column flags + CLIENT_CONNECT_WITH_DB: Int64 = 8; // One can specify db on connect + CLIENT_NO_SCHEMA: Int64 = 16; // Don't allow database.table.column + CLIENT_COMPRESS: Int64 = 32; // Can use compression protocol + CLIENT_ODBC: Int64 = 64; // Odbc client + CLIENT_LOCAL_FILES: Int64 = 128; // Can use LOAD DATA LOCAL + CLIENT_IGNORE_SPACE: Int64 = 256; // Ignore spaces before '(' + CLIENT_PROTOCOL_41: Int64 = 512; // New 4.1 protocol + CLIENT_INTERACTIVE: Int64 = 1024; // This is an interactive client + CLIENT_SSL: Int64 = 2048; // Switch to SSL after handshake + CLIENT_IGNORE_SIGPIPE: Int64 = 4096; // IGNORE sigpipes + CLIENT_TRANSACTIONS: Int64 = 8192; // Client knows about transactions + CLIENT_RESERVED: Int64 = 16384; // Old flag for 4.1 protocol + CLIENT_SECURE_CONNECTION: Int64 = 32768; // New 4.1 authentication + CLIENT_MULTI_STATEMENTS: Int64 = 1 Shl 16; // Enable/disable multi-stmt support + CLIENT_MULTI_RESULTS: Int64 = 1 Shl 17; // Enable/disable multi-results + CLIENT_PS_MULTI_RESULTS: Int64 = 1 Shl 18; // Multi-results in PS-protocol + CLIENT_PLUGIN_AUTH: Int64 = 1 Shl 19; // Client supports plugin authentication + CLIENT_CONNECT_ATTRS: Int64 = 1 Shl 20; // Client supports connection attributes + // Enable authentication response packet to be larger than 255 bytes. + CLIENT_PLUGIN_AUTH_LENENC_CLIENT_DATA: Int64 = 1 Shl 21; + // Don't close the connection for a connection with expired password. + CLIENT_CAN_HANDLE_EXPIRED_PASSWORDS: Int64 = 1 Shl 22; + { + Capable of handling server state change information. Its a hint to the + server to include the state change information in Ok packet. + } + CLIENT_SESSION_TRACK: Int64 = 1 Shl 23; + // Client no longer needs EOF packet + CLIENT_DEPRECATE_EOF: Int64 = 1 Shl 24; + CLIENT_PROGRESS_OBSOLETE: Int64 = 1 Shl 29; + CLIENT_SSL_VERIFY_SERVER_CERT: Int64 = 1 Shl 30; + { + It used to be that if mysql_real_connect() failed, it would delete any + options set by the client, unless the CLIENT_REMEMBER_OPTIONS flag was + given. + That behaviour does not appear very useful, and it seems unlikely that + any applications would actually depend on this. So from MariaDB 5.5 we + always preserve any options set in case of failed connect, and this + option is effectively always set. + } + CLIENT_REMEMBER_OPTIONS: Int64 = 1 Shl 31; + + COLLATION_BINARY = 63; + // Equivalent to COLLATION_BINARY, this is what a new driver returns when connected to a pre-4.1 server. + COLLATION_NONE = 0; + + // Relevant MySQL error codes, taken from include/mysql/server/mysqld_error.h + ER_MUST_CHANGE_PASSWORD = 1820; + ER_NO_SUCH_THREAD = 1094; + ER_NONEXISTING_GRANT = 1141; + ER_WRONG_AUTO_KEY = 1075; + +type + PUSED_MEM=^USED_MEM; + USED_MEM = packed record + next: PUSED_MEM; + left: Integer; + size: Integer; + end; + + PERR_PROC = ^ERR_PROC; + ERR_PROC = procedure; + + PMEM_ROOT = ^MEM_ROOT; + MEM_ROOT = packed record + free: PUSED_MEM; + used: PUSED_MEM; + pre_alloc: PUSED_MEM; + min_malloc: Integer; + block_size: Integer; + block_num: Integer; + first_block_usage: Integer; + error_handler: PERR_PROC; + end; + + NET = record + vio: Pointer; + buff: PAnsiChar; + buff_end: PAnsiChar; + write_pos: PAnsiChar; + read_pos: PAnsiChar; + fd: Integer; + max_packet: Cardinal; + max_packet_size: Cardinal; + pkt_nr: Cardinal; + compress_pkt_nr: Cardinal; + write_timeout: Cardinal; + read_timeout: Cardinal; + retry_count: Cardinal; + fcntl: Integer; + compress: Byte; + remain_in_buf: LongInt; + length: LongInt; + buf_length: LongInt; + where_b: LongInt; + return_status: Pointer; + reading_or_writing: Char; + save_char: Char; + no_send_ok: Byte; + last_error: array[1..MYSQL_ERRMSG_SIZE] of Char; + sqlstate: array[1..SQLSTATE_LENGTH + 1] of Char; + last_errno: Cardinal; + error: Char; + query_cache_query: Pointer; + report_error: Byte; + return_errno: Byte; + end; + + PMYSQL_FIELD = ^MYSQL_FIELD; + MYSQL_FIELD = record + name: PAnsiChar; // Name of column + org_name: PAnsiChar; // Name of original column (added after 3.23.58) + table: PAnsiChar; // Table of column if column was a field + org_table: PAnsiChar; // Name of original table (added after 3.23.58 + db: PAnsiChar; // table schema (added after 3.23.58) + catalog: PAnsiChar; // table catalog (added after 3.23.58) + def: PAnsiChar; // Default value (set by mysql_list_fields) + length: LongInt; // Width of column + max_length: LongInt; // Max width of selected set + // added after 3.23.58 + name_length: Cardinal; + org_name_length: Cardinal; + table_length: Cardinal; + org_table_length: Cardinal; + db_length: Cardinal; + catalog_length: Cardinal; + def_length: Cardinal; + //*********************** + flags: Cardinal; // Div flags + decimals: Cardinal; // Number of decimals in field + charsetnr: Cardinal; // char set number (added in 4.1) + _type: Cardinal; // Type of field. Se mysql_com.h for types + end; + + // Added in Oct 2023, to fix usage of mysql_fetch_lengths(). See issue #1863 + PMYSQL_LENGTHS = ^TMYSQL_LENGTHS; + TMYSQL_LENGTHS = array[0..MaxInt div SizeOf(LongWord) - 1] of LongWord; + + MYSQL_ROW = array[0..$ffff] of PAnsiChar; + PMYSQL_ROW = ^MYSQL_ROW; + + PMYSQL_ROWS = ^MYSQL_ROWS; + MYSQL_ROWS = record + next: PMYSQL_ROWS; + data: PMYSQL_ROW; + end; + + MYSQL_DATA = record + Rows: Int64; + Fields: Cardinal; + Data: PMYSQL_ROWS; + Alloc: MEM_ROOT; + end; + PMYSQL_DATA = ^MYSQL_DATA; + + PMYSQL = ^MYSQL; + MYSQL = record + _net: NET; + connector_fd: Pointer; + host: PAnsiChar; + user: PAnsiChar; + passwd: PAnsiChar; + unix_socket: PAnsiChar; + server_version: PAnsiChar; + host_info: PAnsiChar; + info: PAnsiChar; + db: PAnsiChar; + charset: PAnsiChar; + fields: PMYSQL_FIELD; + field_alloc: MEM_ROOT; + affected_rows: Int64; + insert_id: Int64; + extra_info: Int64; + thread_id: LongInt; + packet_length: LongInt; + port: Cardinal; + client_flag: LongInt; + server_capabilities: LongInt; + protocol_version: Cardinal; + field_count: Cardinal; + server_status: Cardinal; + server_language: Cardinal; + warning_count: Cardinal; + options: Cardinal; + status: Byte; + free_me: Byte; + reconnect: Byte; + scramble: array[1..SCRAMBLE_LENGTH+1] of Char; + rpl_pivot: Byte; + master: PMYSQL; + next_slave: PMYSQL; + last_used_slave: PMYSQL; + last_used_con: PMYSQL; + stmts: Pointer; + methods: Pointer; + thd: Pointer; + unbuffered_fetch_owner: PByte; + end; + + MYSQL_RES = record + row_count: Int64; + field_count, current_field: Integer; + fields: PMYSQL_FIELD; + data: PMYSQL_DATA; + data_cursor: PMYSQL_ROWS; + field_alloc: MEM_ROOT; + row: PMYSQL_ROW; // If unbuffered read + current_row: PMYSQL_ROW; // buffer to current row + lengths: PLongInt; // column lengths of current row + handle: PMYSQL; // for unbuffered reads + eof: Byte; // Used my mysql_fetch_row + is_ps: Byte; + end; + PMYSQL_RES = ^MYSQL_RES; + + Tmgci = function: PAnsiChar; stdcall; + TMySQLLib = class(TDbLib) + mysql_affected_rows: function(Handle: PMYSQL): Int64; stdcall; + mysql_character_set_name: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_close: procedure(Handle: PMYSQL); stdcall; + mysql_data_seek: procedure(Result: PMYSQL_RES; Offset: Int64); stdcall; + mysql_errno: function(Handle: PMYSQL): Cardinal; stdcall; + mysql_error: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_fetch_field_direct: function(Result: PMYSQL_RES; FieldNo: Cardinal): PMYSQL_FIELD; stdcall; + mysql_fetch_field: function(Result: PMYSQL_RES): PMYSQL_FIELD; stdcall; + mysql_fetch_lengths: function(Result: PMYSQL_RES): PMYSQL_LENGTHS; stdcall; + mysql_fetch_row: function(Result: PMYSQL_RES): PMYSQL_ROW; stdcall; + mysql_free_result: procedure(Result: PMYSQL_RES); stdcall; + mysql_get_client_info: function: PAnsiChar; stdcall; + mysql_get_server_info: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_init: function(Handle: PMYSQL): PMYSQL; stdcall; + mysql_info: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_num_fields: function(Result: PMYSQL_RES): Integer; stdcall; + mysql_num_rows: function(Result: PMYSQL_RES): Int64; stdcall; + mysql_options: function(Handle: PMYSQL; Option: Integer; arg: PAnsiChar): Integer; stdcall; + mysql_optionsv: function(Handle: PMYSQL; Option: Integer; arg, val: PAnsiChar): Integer; stdcall; + mysql_ping: function(Handle: PMYSQL): Integer; stdcall; + mysql_real_connect: function(Handle: PMYSQL; const Host, User, Passwd, Db: PAnsiChar; Port: Cardinal; const UnixSocket: PAnsiChar; ClientFlag: Cardinal): PMYSQL; stdcall; + mysql_real_query: function(Handle: PMYSQL; const Query: PAnsiChar; Length: Cardinal): Integer; stdcall; + mysql_stat: function(Handle: PMYSQL): PAnsiChar; stdcall; + mysql_store_result: function(Handle: PMYSQL): PMYSQL_RES; stdcall; + mysql_thread_id: function(Handle: PMYSQL): Cardinal; stdcall; + mysql_next_result: function(Handle: PMYSQL): Integer; stdcall; + mysql_set_character_set: function(Handle: PMYSQL; csname: PAnsiChar): Integer; stdcall; + mysql_thread_init: function: Byte; stdcall; + mysql_thread_end: procedure; stdcall; + mysql_warning_count: function(Handle: PMYSQL): Cardinal; stdcall; + const + INVALID_OPT = -1; + MYBOOL_FALSE: Byte = 0; + MYBOOL_TRUE: Byte = 1; + protected + procedure AssignProcedures; override; + public + MYSQL_OPT_LOCAL_INFILE, + MYSQL_OPT_CONNECT_TIMEOUT, + MARIADB_OPT_TLS_VERSION, + MYSQL_OPT_TLS_VERSION, + MYSQL_PLUGIN_DIR, + MYSQL_OPT_SSL_KEY, + MYSQL_OPT_SSL_CERT, + MYSQL_OPT_SSL_CA, + MYSQL_OPT_SSL_CIPHER, + MYSQL_OPT_CONNECT_ATTR_ADD, + MYSQL_ENABLE_CLEARTEXT_PLUGIN, + MYSQL_OPT_SSL_MODE, + MYSQL_OPT_SSL_VERIFY_SERVER_CERT: Integer; + SSL_MODE_DISABLED, + SSL_MODE_PREFERRED, + SSL_MODE_REQUIRED, + SSL_MODE_VERIFY_CA, + SSL_MODE_VERIFY_IDENTITY: Integer; + constructor Create(DllFile_, DefaultDll: String); override; + end; +var + MySQLKeywords: TStringList; + MySQLErrorCodes: TStringList; + + + // MySQL Data Type List and Properties + MySQLDatatypes: array of TDBDatatype; + {MySQLDatatypes: array [0..41] of TDBDatatype = + ( + ( + Index: dbdtUnknown; + NativeTypes: '99999'; + Name: 'UNKNOWN'; + Description: 'Unknown data type'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcOther; + ), + ( + Index: dbdtTinyint; + NativeType: 1; + Name: 'TINYINT'; + Description: 'TINYINT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A very small integer. The signed range is -128 to 127. ' + + 'The unsigned range is 0 to 255.'; + HasLength: True; + RequiresLength: False; + MaxSize: 127; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtSmallint; + NativeType: 2; + Name: 'SMALLINT'; + Description: 'SMALLINT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A small integer. The signed range is -32768 to 32767. ' + + 'The unsigned range is 0 to 65535.'; + HasLength: True; + RequiresLength: False; + MaxSize: 32767; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtMediumint; + NativeType: 9; + Name: 'MEDIUMINT'; + Description: 'MEDIUMINT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A medium-sized integer. The signed range is -8388608 to 8388607. ' + + 'The unsigned range is 0 to 16777215.'; + HasLength: True; + RequiresLength: False; + MaxSize: 8388607; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtInt; + NativeType: 3; + Name: 'INT'; + Description: 'INT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A normal-size integer. The signed range is -2147483648 to 2147483647. ' + + 'The unsigned range is 0 to 4294967295.'; + HasLength: True; + RequiresLength: False; + MaxSize: 2147483647; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtBigint; + NativeType: 8; + Name: 'BIGINT'; + Description: 'BIGINT[(M)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A large integer. The signed range is -9223372036854775808 to ' + + '9223372036854775807. The unsigned range is 0 to 18446744073709551615.'; + HasLength: True; + RequiresLength: False; + MaxSize: 9223372036854775807; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtFloat; + NativeType: 4; + Name: 'FLOAT'; + Description: 'FLOAT[(M,D)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A small (single-precision) floating-point number. Allowable values are '+ + '-3.402823466E+38 to -1.175494351E-38, 0, and 1.175494351E-38 to '+ + '3.402823466E+38. These are the theoretical limits, based on the IEEE '+ + 'standard. The actual range might be slightly smaller depending on your '+ + 'hardware or operating system.'; + HasLength: True; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcReal; + ), + ( + Index: dbdtDouble; + NativeType: 5; + Name: 'DOUBLE'; + Description: 'DOUBLE[(M,D)] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A normal-size (double-precision) floating-point number. Allowable ' + + 'values are -1.7976931348623157E+308 to -2.2250738585072014E-308, 0, and ' + + '2.2250738585072014E-308 to 1.7976931348623157E+308. These are the ' + + 'theoretical limits, based on the IEEE standard. The actual range might ' + + 'be slightly smaller depending on your hardware or operating system.'; + HasLength: True; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcReal; + ), + ( + Index: dbdtDecimal; + NativeType: 246; + Name: 'DECIMAL'; + Description: 'DECIMAL[(M[,D])] [UNSIGNED] [ZEROFILL]' + sLineBreak + + 'A packed "exact" fixed-point number. M is the total number of digits ' + + '(the precision) and D is the number of digits after the decimal point ' + + '(the scale). The decimal point and (for negative numbers) the "-" sign ' + + 'are not counted in M. If D is 0, values have no decimal point or ' + + 'fractional part. The maximum number of digits (M) for DECIMAL is 65. ' + + 'The maximum number of supported decimals (D) is 30. If D is omitted, ' + + 'the default is 0. If M is omitted, the default is 10.'; + HasLength: True; + RequiresLength: True; + MaxSize: 9223372036854775807; + HasBinary: False; + HasDefault: True; + LoadPart: False; + DefLengthSet: '20,6'; + Category: dtcReal; + ), + ( + Index: dbdtDate; + NativeType: 10; + Name: 'DATE'; + Description: 'DATE' + sLineBreak + + 'A date. The supported range is ''1000-01-01'' to ''9999-12-31''. MySQL ' + + 'displays DATE values in ''YYYY-MM-DD'' format, but allows assignment of ' + + 'values to DATE columns using either strings or numbers.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'yyyy-mm-dd'; + Category: dtcTemporal; + ), + ( + Index: dbdtTime; + NativeType: 11; + Name: 'TIME'; + Description: 'TIME' + sLineBreak + + 'A time. The range is ''-838:59:59'' to ''838:59:59''. MySQL displays TIME ' + + 'values in ''HH:MM:SS'' format, but allows assignment of values to TIME ' + + 'columns using either strings or numbers.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'hh:nn:ss'; + Category: dtcTemporal; + ), + ( + Index: dbdtYear; + NativeType: 13; + Name: 'YEAR'; + Description: 'YEAR[(2|4)]' + sLineBreak + + 'A year in two-digit or four-digit format. The default is four-digit ' + + 'format. In four-digit format, the allowable values are 1901 to 2155, ' + + 'and 0000. In two-digit format, the allowable values are 70 to 69, ' + + 'representing years from 1970 to 2069. MySQL displays YEAR values in ' + + 'YYYY format, but allows you to assign values to YEAR columns using ' + + 'either strings or numbers.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'yyyy'; + Category: dtcTemporal; + ), + ( + Index: dbdtDatetime; + NativeType: 12; + Name: 'DATETIME'; + Description: 'DATETIME' + sLineBreak + + 'A date and time combination. The supported range is ''1000-01-01 ' + + '00:00:00'' to ''9999-12-31 23:59:59''. MySQL displays DATETIME values in ' + + '''YYYY-MM-DD HH:MM:SS'' format, but allows assignment of values to ' + + 'DATETIME columns using either strings or numbers.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'yyyy-mm-dd hh:nn:ss'; + Category: dtcTemporal; + ), + ( + Index: dbdtTimestamp; + NativeType: 7; + Name: 'TIMESTAMP'; + Description: 'TIMESTAMP' + sLineBreak + + 'A timestamp. The range is ''1970-01-01 00:00:01'' UTC to ''2038-01-09 ' + + '03:14:07'' UTC. TIMESTAMP values are stored as the number of seconds ' + + 'since the epoch (''1970-01-01 00:00:00'' UTC). A TIMESTAMP cannot ' + + 'represent the value ''1970-01-01 00:00:00'' because that is equivalent to ' + + '0 seconds from the epoch and the value 0 is reserved for representing ' + + '''0000-00-00 00:00:00'', the "zero" TIMESTAMP value.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Format: 'yyyy-mm-dd hh:nn:ss'; + Category: dtcTemporal; + ), + ( + Index: dbdtVarchar; + NativeType: 253; + Name: 'VARCHAR'; + Description: 'VARCHAR(M)' + sLineBreak + + 'A variable-length string. M represents the maximum column length in ' + + 'characters. The range of M is 0 to 65,535. The effective maximum length ' + + 'of a VARCHAR is subject to the maximum row size (65,535 bytes, which is ' + + 'shared among all columns) and the character set used. For example, utf8 ' + + 'characters can require up to three bytes per character, so a VARCHAR ' + + 'column that uses the utf8 character set can be declared to be a maximum ' + + 'of 21,844 characters. ' + sLineBreak + sLineBreak + + '*Note*: MySQL 5.1 follows the standard SQL specification, and does not ' + + 'remove trailing spaces from VARCHAR values.'; + HasLength: True; + RequiresLength: True; + MaxSize: 255; + HasBinary: True; // MySQL-Help says the opposite but it's valid for older versions at least. + HasDefault: True; + LoadPart: True; + DefLengthSet: '50'; + Category: dtcText; + ), + ( + Index: dbdtChar; + NativeType: 254; + Name: 'CHAR'; + Description: 'CHAR[(M)]' + sLineBreak + + 'A fixed-length string that is always right-padded with spaces to the ' + + 'specified length when stored. M represents the column length in ' + + 'characters. The range of M is 0 to 255. If M is omitted, the length is 1.' + sLineBreak + sLineBreak + + '*Note*: Trailing spaces are removed when CHAR values are retrieved ' + + 'unless the PAD_CHAR_TO_FULL_LENGTH SQL mode is enabled.'; + HasLength: True; + RequiresLength: True; + MaxSize: 255; + HasBinary: True; + HasDefault: True; + LoadPart: False; + DefLengthSet: '50'; + Category: dtcText; + ), + ( + Index: dbdtTinytext; + NativeType: 249; + Name: 'TINYTEXT'; + Description: 'TINYTEXT' + sLineBreak + + 'A TEXT column with a maximum length of 255 (2^8 - 1) characters. The ' + + 'effective maximum length is less if the value contains multi-byte ' + + 'characters. Each TINYTEXT value is stored using a one-byte length ' + + 'prefix that indicates the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + MaxSize: 255; + HasBinary: True; + HasDefault: False; + LoadPart: False; + Category: dtcText; + ), + ( + Index: dbdtText; + NativeType: 252; + Name: 'TEXT'; + Description: 'TEXT[(M)]' + sLineBreak + + 'A TEXT column with a maximum length of 65,535 (2^16 - 1) characters. The ' + + 'effective maximum length is less if the value contains multi-byte ' + + 'characters. Each TEXT value is stored using a two-byte length prefix ' + + 'that indicates the number of bytes in the value. ' + sLineBreak + + 'An optional length M can be given for this type. If this is done, MySQL ' + + 'creates the column as the smallest TEXT type large enough to hold ' + + 'values M characters long.'; + HasLength: True; + RequiresLength: False; + MaxSize: 65535; + DefaultSize: 65535; + HasBinary: True; + HasDefault: False; + LoadPart: True; + Category: dtcText; + ), + ( + Index: dbdtMediumtext; + NativeType: 250; + Name: 'MEDIUMTEXT'; + Description: 'MEDIUMTEXT' + sLineBreak + + 'A TEXT column with a maximum length of 16,777,215 (2^24 - 1) characters. ' + + 'The effective maximum length is less if the value contains multi-byte ' + + 'characters. Each MEDIUMTEXT value is stored using a three-byte length ' + + 'prefix that indicates the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + HasBinary: True; + HasDefault: False; + LoadPart: True; + Category: dtcText; + ), + ( + Index: dbdtLongtext; + NativeType: 251; + Name: 'LONGTEXT'; + Description: 'LONGTEXT' + sLineBreak + + 'A TEXT column with a maximum length of 4,294,967,295 or 4GB (2^32 - 1) ' + + 'characters. The effective maximum length is less if the value contains ' + + 'multi-byte characters. The effective maximum length of LONGTEXT columns ' + + 'also depends on the configured maximum packet size in the client/server ' + + 'protocol and available memory. Each LONGTEXT value is stored using a ' + + 'four-byte length prefix that indicates the number of bytes in the ' + + 'value.'; + HasLength: False; + RequiresLength: False; + HasBinary: True; + HasDefault: False; + LoadPart: True; + Category: dtcText; + ), + ( + Index: dbdtJson; + NativeType: 245; + Name: 'JSON'; + Description: 'JSON' + sLineBreak + + 'Documents stored in JSON columns are converted to an internal format that '+ + 'permits quick read access to document elements. When the server later must '+ + 'read a JSON value stored in this binary format, the value need not be parsed '+ + 'from a text representation. The binary format is structured to enable the '+ + 'server to look up subobjects or nested values directly by key or array index '+ + 'without reading all values before or after them in the document.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: True; + Category: dtcText; + ), + ( + Index: dbdtUniqueidentifier; + NativeType: 254; + Name: 'UUID'; + Description: 'UUID' + sLineBreak + + 'The UUID data type is intended for the storage of 128-bit UUID (Universally ' + + 'Unique Identifier) data. See the UUID function page for more details on UUIDs ' + + 'themselves.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcText; + ), + ( + Index: dbdtInet4; + NativeType: 255; + Name: 'INET4'; + Description: 'INET4' + sLineBreak + + 'INET4 is a data type to store IPv4 addresses, as 4-byte binary strings. '+ + 'It was added in MariaDB 10.10.0'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcText; + MinVersion: 10100; + ), + ( + Index: dbdtInet6; + NativeType: 255; + Name: 'INET6'; + Description: 'INET6' + sLineBreak + + 'The INET6 data type is intended for storage of IPv6 addresses, as well as ' + + 'IPv4 addresses assuming conventional mapping of IPv4 addresses into IPv6 ' + + 'addresses. ' + slineBreak + + 'Both short and long IPv6 notation are permitted, according to RFC-5952. '+ + 'It was added in MariaDB 10.5.0'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcText; + MinVersion: 10050; + ), + ( + Index: dbdtBinary; + NativeType: 254; + Name: 'BINARY'; + Description: 'BINARY(M)' + sLineBreak + + 'The BINARY type is similar to the CHAR type, but stores binary byte ' + + 'strings rather than non-binary character strings. M represents the ' + + 'column length in bytes.'; + HasLength: True; + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: False; + DefLengthSet: '50'; + Category: dtcBinary; + ), + ( + Index: dbdtVarbinary; + NativeType: 253; + Name: 'VARBINARY'; + Description: 'VARBINARY(M)' + sLineBreak + + 'The VARBINARY type is similar to the VARCHAR type, but stores binary ' + + 'byte strings rather than non-binary character strings. M represents the ' + + 'maximum column length in bytes.'; + HasLength: True; + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: True; + DefLengthSet: '50'; + Category: dtcBinary; + ), + ( + Index: dbdtTinyblob; + NativeType: 249; + Name: 'TINYBLOB'; + Description: 'TINYBLOB' + sLineBreak + + 'A BLOB column with a maximum length of 255 (2^8 - 1) bytes. Each ' + + 'TINYBLOB value is stored using a one-byte length prefix that indicates ' + + 'the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcBinary; + ), + ( + Index: dbdtBlob; + NativeType: 252; + Name: 'BLOB'; + Description: 'BLOB[(M)]' + sLineBreak + + 'A BLOB column with a maximum length of 65,535 (2^16 - 1) bytes. Each ' + + 'BLOB value is stored using a two-byte length prefix that indicates the ' + + 'number of bytes in the value. ' + sLineBreak + + 'An optional length M can be given for this type. If this is done, MySQL ' + + 'creates the column as the smallest BLOB type large enough to hold ' + + 'values M bytes long.'; + HasLength: True; + RequiresLength: False; + MaxSize: 65535; + DefaultSize: 65535; + HasBinary: False; + HasDefault: False; + LoadPart: True; + Category: dtcBinary; + ), + ( + Index: dbdtMediumblob; + NativeType: 250; + Name: 'MEDIUMBLOB'; + Description: 'MEDIUMBLOB' + sLineBreak + + 'A BLOB column with a maximum length of 16,777,215 (2^24 - 1) bytes. Each ' + + 'MEDIUMBLOB value is stored using a three-byte length prefix that ' + + 'indicates the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: True; + Category: dtcBinary; + ), + ( + Index: dbdtLongblob; + NativeType: 251; + Name: 'LONGBLOB'; + Description: 'LONGBLOB' + sLineBreak + + 'A BLOB column with a maximum length of 4,294,967,295 or 4GB (2^32 - 1) ' + + 'bytes. The effective maximum length of LONGBLOB columns depends on the ' + + 'configured maximum packet size in the client/server protocol and ' + + 'available memory. Each LONGBLOB value is stored using a four-byte ' + + 'length prefix that indicates the number of bytes in the value.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: True; + Category: dtcBinary; + ), + ( + Index: dbdtVector; + NativeType: 253; + Name: 'VECTOR'; + Description: 'VECTOR(N)' + sLineBreak + + 'VECTOR data type with a built-in data validation. N is the number of dimensions ' + + 'that all vector values in the column will have.'; + HasLength: True; + RequiresLength: True; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcBinary; + ), + ( + Index: dbdtEnum; + NativeType: 247; + Name: 'ENUM'; + Description: 'ENUM(''value1'',''value2'',...)' + sLineBreak + + 'An enumeration. A string object that can have only one value, chosen ' + + 'from the list of values ''value1'', ''value2'', ..., NULL or the special '''' ' + + 'error value. An ENUM column can have a maximum of 65,535 distinct ' + + 'values. ENUM values are represented internally as integers.'; + HasLength: True; // Obviously this is not meant as "length", but as "set of values" + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: False; + DefLengthSet: '''Y'',''N'''; + Category: dtcOther; + ), + ( + Index: dbdtSet; + NativeType: 248; + Name: 'SET'; + Description: 'SET(''value1'',''value2'',...)' + sLineBreak + + 'A set. A string object that can have zero or more values, each of which ' + + 'must be chosen from the list of values ''value1'', ''value2'', ... A SET ' + + 'column can have a maximum of 64 members. SET values are represented ' + + 'internally as integers.'; + HasLength: True; // Same as for ENUM + RequiresLength: True; + HasBinary: False; + HasDefault: True; + LoadPart: False; + DefLengthSet: '''Value A'',''Value B'''; + Category: dtcOther; + ), + ( + Index: dbdtBit; + NativeType: 16; + Name: 'BIT'; + Description: 'BIT[(M)]' + sLineBreak + + 'A bit-field type. M indicates the number of bits per value, from 1 to ' + + '64. The default is 1 if M is omitted.'; + HasLength: True; + RequiresLength: False; + HasBinary: False; + HasDefault: True; + LoadPart: False; + Category: dtcInteger; + ), + ( + Index: dbdtPoint; + NativeType: 255; + Name: 'POINT'; + Description: 'POINT(x,y)' + sLineBreak + + 'Constructs a WKB Point using its coordinates.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtLinestring; + NativeType: 255; + Name: 'LINESTRING'; + Description: 'LINESTRING(pt1,pt2,...)' + sLineBreak + + 'Constructs a WKB LineString value from a number of WKB Point arguments. ' + + 'If any argument is not a WKB Point, the return value is NULL. If the ' + + 'number of Point arguments is less than two, the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtPolygon; + NativeType: 255; + Name: 'POLYGON'; + Description: 'POLYGON(ls1,ls2,...)' + sLineBreak + + 'Constructs a WKB Polygon value from a number of WKB LineString ' + + 'arguments. If any argument does not represent the WKB of a LinearRing ' + + '(that is, not a closed and simple LineString) the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtGeometry; + NativeType: 255; + Name: 'GEOMETRY'; + Description: ''; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtMultipoint; + NativeType: 255; + Name: 'MULTIPOINT'; + Description: 'MULTIPOINT(pt1,pt2,...)' + sLineBreak + + 'Constructs a WKB MultiPoint value using WKB Point arguments. If any ' + + 'argument is not a WKB Point, the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtMultilinestring; + NativeType: 255; + Name: 'MULTILINESTRING'; + Description: 'MULTILINESTRING(ls1,ls2,...)' + sLineBreak + + 'Constructs a WKB MultiLineString value using WKB LineString arguments. ' + + 'If any argument is not a WKB LineString, the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtMultipolygon; + NativeType: 255; + Name: 'MULTIPOLYGON'; + Description: 'MULTIPOLYGON(poly1,poly2,...)' + sLineBreak + + 'Constructs a WKB MultiPolygon value from a set of WKB Polygon ' + + 'arguments. If any argument is not a WKB Polygon, the return value is ' + + 'NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ), + ( + Index: dbdtGeometrycollection; + NativeType: 255; + Name: 'GEOMETRYCOLLECTION'; + Description: 'GEOMETRYCOLLECTION(g1,g2,...)' + sLineBreak + + 'Constructs a WKB GeometryCollection. If any argument is not a ' + + 'well-formed WKB representation of a geometry, the return value is NULL.'; + HasLength: False; + RequiresLength: False; + HasBinary: False; + HasDefault: False; + LoadPart: False; + Category: dtcSpatial; + ) + + );} + + + MySQLVariables: array [0..417] of TServerVariable = + ( + ( + Name: 'auto_increment_increment'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'auto_increment_offset'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'autocommit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'automatic_sp_privileges'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'back_log'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'basedir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'big_tables'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'binlog_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'binlog_checksum'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'binlog_direct_non_transactional_updates'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'binlog_format'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'ROW,STATEMENT,MIXED'; + ), + ( + Name: 'binlog_row_image'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'FULL,MINIMAL,NOBLOB'; + ), + ( + Name: 'binlog_stmt_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'bulk_insert_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_client'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_connection'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_database[a]'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_filesystem'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_results'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_server'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'character_set_system'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'character_sets_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'collation_connection'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'collation_database[b]'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'collation_server'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'completion_type'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'NO_CHAIN,CHAIN,RELEASE,0,1,2'; + ), + ( + Name: 'concurrent_insert'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'NEVER,AUTO,ALWAYS,0,1,2'; + ), + ( + Name: 'connect_timeout'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'datadir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'date_format'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'datetime_format'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'debug'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'debug_sync'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'default_storage_engine'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'FEDERATED,MRG_MYISAM,MyISAM,BLACKHOLE,CSV,MEMORY,ARCHIVE,InnoDB'; + ), + ( + Name: 'default_tmp_storage_engine'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'FEDERATED,MRG_MYISAM,MyISAM,BLACKHOLE,CSV,MEMORY,ARCHIVE,InnoDB'; + ), + ( + Name: 'default_week_format'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'delay_key_write'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'ON,OFF,ALL'; + ), + ( + Name: 'delayed_insert_limit'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'delayed_insert_timeout'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'delayed_queue_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'disable_gtid_unsafe_statements'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'div_precision_increment'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'end_markers_in_json'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'engine_condition_pushdown'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'eq_range_index_dive_limit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'error_count'; + IsDynamic: False; + VarScope: vsSession; + ), + ( + Name: 'event_scheduler'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'ON,OFF,DISABLED'; + ), + ( + Name: 'expire_logs_days'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'external_user'; + IsDynamic: False; + VarScope: vsSession; + ), + ( + Name: 'flush'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'flush_time'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'foreign_key_checks'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'ft_boolean_syntax'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'ft_max_word_len'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ft_min_word_len'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ft_query_expansion_limit'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ft_stopword_file'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'general_log'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'general_log_file'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'group_concat_max_len'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'gtid_done'; + IsDynamic: False; + VarScope: vsBoth; + ), + ( + Name: 'gtid_lost'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'gtid_mode'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'gtid_mode'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'gtid_next'; + IsDynamic: True; + VarScope: vsSession; + EnumValues: 'AUTOMATIC,ANONYMOUS'; + ), + ( + Name: 'gtid_owned'; + IsDynamic: False; + VarScope: vsBoth; + ), + ( + Name: 'have_compress'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_crypt'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_csv'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_dynamic_loading'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_geometry'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_innodb'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_ndbcluster'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_openssl'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_partitioning'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_profiling'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_query_cache'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_rtree_keys'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_ssl'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'have_symlink'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'host_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'hostname'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'identity'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'ignore_builtin_innodb'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'init_connect'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'init_file'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'init_slave'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_adaptive_flushing'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_adaptive_hash_index'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_adaptive_max_sleep_delay'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_additional_mem_pool_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_analyze_is_persistent'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_api_enable_binlog'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_api_enable_mdl'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_api_trx_level'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_autoextend_increment'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_autoinc_lock_mode'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_dump_at_shutdown'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_dump_now'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_filename'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_load_abort'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_load_at_startup'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_load_now'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_buffer_pool_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_change_buffer_max_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_change_buffering'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'INSERTS,DELETES,PURGES,CHANGES,ALL,NONE'; + ), + ( + Name: 'innodb_checksum_algorithm'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'INNODB,CRC32,NONE,STRICT_INNODB,STRICT_CRC32,STRICT_NONE'; + ), + ( + Name: 'innodb_checksums'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_commit_concurrency'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_concurrency_tickets'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_data_file_path'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_data_home_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_doublewrite'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_fast_shutdown'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_file_format'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_file_format_check'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_file_format_max'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_file_per_table'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_flush_log_at_trx_commit'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: '0,1,2'; + ), + ( + Name: 'innodb_flush_method'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_flush_neighbors'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_force_load_corrupted'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_force_recovery'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_aux_table'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_enable_stopword'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_max_token_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_min_token_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_num_word_optimize'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_server_stopword_table'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_sort_pll_degree'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_ft_user_stopword_table'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_io_capacity'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_large_prefix'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_lock_wait_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'innodb_locks_unsafe_for_binlog'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_log_buffer_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_log_file_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_log_files_in_group'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_log_group_home_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_lru_scan_depth'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_max_dirty_pages_pct'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_max_purge_lag'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_mirrored_log_groups'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_monitor_disable'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_monitor_enable'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_monitor_reset'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_monitor_reset_all'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_old_blocks_pct'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_old_blocks_time'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_open_files'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_optimize_fulltext_only'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_page_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_print_all_deadlocks'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_purge_batch_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_purge_threads'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_random_read_ahead'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_read_ahead_threshold'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_read_io_threads'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_replication_delay'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_rollback_on_timeout'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_rollback_segments'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_sort_buffer_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_spin_wait_delay'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_stats_method'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'NULLS_EQUAL,NULLS_UNEQUAL,NULLS_IGNORED'; + ), + ( + Name: 'innodb_stats_on_metadata'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_stats_persistent_sample_pages'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_stats_sample_pages'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_stats_transient_sample_pages'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_strict_mode'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'innodb_support_xa'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'innodb_sync_array_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_sync_spin_loops'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_table_locks'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'innodb_thread_concurrency'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_thread_sleep_delay'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_undo_directory'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_undo_logs'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_undo_tablespaces'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_use_native_aio'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_use_sys_malloc'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_version'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'innodb_write_io_threads'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'insert_id'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'interactive_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'join_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'keep_files_on_create'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'key_buffer_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'key_cache_age_threshold'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'key_cache_block_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'key_cache_division_limit'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'language'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'large_files_support'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'large_page_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'large_pages'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'last_insert_id'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'lc_messages'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'lc_messages_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'lc_time_names'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'license'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'local_infile'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'lock_wait_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'locked_in_memory'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_bin'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log_bin_basename'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log_error'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log_output'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_queries_not_using_indexes'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_slave_updates'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'log_slow_queries'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_throttle_queries_not_using_indexes'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'log_warnings'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'long_query_time'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'low_priority_updates'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'lower_case_file_system'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'lower_case_table_names'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'master_info_repository'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'master_verify_checksum'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_allowed_packet'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_binlog_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_binlog_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_binlog_stmt_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_connect_errors'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_connections'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_delayed_threads'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_error_count'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_heap_table_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_insert_delayed_threads'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_join_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_length_for_sort_data'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_prepared_stmt_count'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_relay_log_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'max_seeks_for_key'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_sort_length'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_sp_recursion_depth'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_tmp_tables'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_user_connections'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'max_write_lock_count'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'memlock'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'metadata_locks_cache_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_data_pointer_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_max_sort_file_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_mmap_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_recover_options'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'myisam_repair_threads'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'myisam_sort_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'myisam_stats_method'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'NULLS_EQUAL,NULLS_UNEQUAL,NULLS_IGNORED'; + ), + ( + Name: 'myisam_use_mmap'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'named_pipe'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'net_buffer_length'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'net_read_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'net_retry_count'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'net_write_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'new'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'old'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'old_alter_table'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'old_passwords'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'open_files_limit'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'optimizer_join_cache_level'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_prune_level'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_search_depth'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_switch'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace_features'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace_limit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace_max_mem_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'optimizer_trace_offset'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'have_partitioning'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_accounts_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_digests_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_stages_history_long_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_stages_history_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_statements_history_long_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_statements_history_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_waits_history_long_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_events_waits_history_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_hosts_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_cond_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_cond_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_file_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_file_handles'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_file_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_mutex_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_mutex_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_rwlock_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_rwlock_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_socket_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_socket_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_stage_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_statement_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_table_handles'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_table_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_thread_classes'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_max_thread_instances'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_setup_actors_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_setup_objects_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'performance_schema_users_size'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'pid_file'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'plugin_dir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'port'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'preload_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'profiling'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'profiling_history_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'protocol_version'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'proxy_user'; + IsDynamic: False; + VarScope: vsSession; + ), + ( + Name: 'pseudo_thread_id'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'query_alloc_block_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'query_cache_limit'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'query_cache_min_res_unit'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'query_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'query_cache_type'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: '0,1,2'; + ), + ( + Name: 'query_cache_wlock_invalidate'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'query_prealloc_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'rand_seed1'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'rand_seed2'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'range_alloc_block_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'read_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'read_only'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'read_rnd_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'relay_log_basename'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_index'; + IsDynamic: False; + VarScope: vsBoth; + ), + ( + Name: 'relay_log_index'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_info_file'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_info_repository'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_purge'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_recovery'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'relay_log_space_limit'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'report_host'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'report_password'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'report_port'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'report_user'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_master_enabled'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_master_timeout'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_master_trace_level'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_master_wait_no_slave'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_slave_enabled'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'rpl_semi_sync_slave_trace_level'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'secure_auth'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'secure_file_priv'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'server_id'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'server_uuid'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'shared_memory'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'shared_memory_base_name'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'skip_external_locking'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'skip_name_resolve'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'skip_networking'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'skip_show_database'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'slave_compressed_protocol'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_exec_mode'; + IsDynamic: True; + VarScope: vsGlobal; + EnumValues: 'IDEMPOTENT,STRICT'; + ), + ( + Name: 'slave_load_tmpdir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'slave_net_timeout'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_parallel_workers'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_skip_errors'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'slave_sql_verify_checksum'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_transaction_retries'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slave_type_conversions'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'slow_launch_time'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slow_query_log'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'slow_query_log_file'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'socket'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'sort_buffer_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_auto_is_null'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_big_selects'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_big_tables'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_buffer_result'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_log_bin'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_log_off'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_low_priority_updates'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_max_join_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_mode'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_notes'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_quote_show_create'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_safe_updates'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_select_limit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'sql_slave_skip_counter'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sql_warnings'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'ssl_ca'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_capath'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_cert'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_cipher'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_crl'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_crlpath'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'ssl_key'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'storage_engine'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'FEDERATED,MRG_MYISAM,MyISAM,BLACKHOLE,CSV,MEMORY,ARCHIVE,InnoDB'; + ), + ( + Name: 'stored_program_cache'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_binlog'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_frm'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_master_info'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_relay_log'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'sync_relay_log_info'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'system_time_zone'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'table_definition_cache'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'table_open_cache'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'thread_cache_size'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'thread_concurrency'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'thread_handling'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'thread_stack'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'time_format'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'time_zone'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'timed_mutexes'; + IsDynamic: True; + VarScope: vsGlobal; + ), + ( + Name: 'timestamp'; + IsDynamic: True; + VarScope: vsSession; + ), + ( + Name: 'tmp_table_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'tmpdir'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'transaction_alloc_block_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'transaction_prealloc_size'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'tx_isolation'; + IsDynamic: True; + VarScope: vsBoth; + EnumValues: 'READ-UNCOMMITTED,READ-COMMITTED,REPEATABLE-READ,SERIALIZABLE'; + ), + ( + Name: 'tx_read_only'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'unique_checks'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'updatable_views_with_limit'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'version'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'version_comment'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'version_compile_machine'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'version_compile_os'; + IsDynamic: False; + VarScope: vsGlobal; + ), + ( + Name: 'wait_timeout'; + IsDynamic: True; + VarScope: vsBoth; + ), + ( + Name: 'warning_count'; + IsDynamic: False; + VarScope: vsSession; + ) + + ); + + +implementation + +uses apphelpers; + + +constructor TMySQLLib.Create(DllFile_, DefaultDll: String); +var + BaseDll: String; +begin + inherited; + // MYSQL_OPT_* constants + MYSQL_OPT_CONNECT_TIMEOUT := 0; + MYSQL_OPT_LOCAL_INFILE := 8; + MYSQL_PLUGIN_DIR := 22; + MYSQL_OPT_SSL_KEY := 25; + MYSQL_OPT_SSL_CERT := 26; + MYSQL_OPT_SSL_CA := 27; + MYSQL_OPT_SSL_CIPHER := 29; + MYSQL_OPT_CONNECT_ATTR_ADD := 33; + MYSQL_ENABLE_CLEARTEXT_PLUGIN := 36; + MYSQL_OPT_TLS_VERSION := 41; + MARIADB_OPT_TLS_VERSION := INVALID_OPT; + MYSQL_OPT_SSL_MODE := INVALID_OPT; + MYSQL_OPT_SSL_VERIFY_SERVER_CERT := INVALID_OPT; + // Option values + SSL_MODE_DISABLED := 1; + SSL_MODE_PREFERRED := 2; + SSL_MODE_REQUIRED := 3; + SSL_MODE_VERIFY_CA := 4; + SSL_MODE_VERIFY_IDENTITY := 5; + BaseDll := ExtractFileName(FDllFile); + if BaseDLL.StartsWith('libmariadb', True) then begin + // Differences in libmariadb + MYSQL_OPT_SSL_VERIFY_SERVER_CERT := 21; + MARIADB_OPT_TLS_VERSION := 7005; + end + else if String(mysql_get_client_info).StartsWith('8.') then begin + // Some constants were removed in MySQL 8.0, so the offsets differ + MYSQL_PLUGIN_DIR := 16; + MYSQL_OPT_SSL_KEY := 19; + MYSQL_OPT_SSL_CERT := 20; + MYSQL_OPT_SSL_CA := 21; + MYSQL_OPT_SSL_CIPHER := 23; + MYSQL_OPT_CONNECT_ATTR_ADD := 27; + MYSQL_ENABLE_CLEARTEXT_PLUGIN := 30; + MYSQL_OPT_TLS_VERSION := 34; + MYSQL_OPT_SSL_MODE := 35; + end; +end; + +procedure TMySQLLib.AssignProcedures; +begin + AssignProc(@mysql_affected_rows, 'mysql_affected_rows'); + AssignProc(@mysql_character_set_name, 'mysql_character_set_name'); + AssignProc(@mysql_close, 'mysql_close'); + AssignProc(@mysql_data_seek, 'mysql_data_seek'); + AssignProc(@mysql_errno, 'mysql_errno'); + AssignProc(@mysql_error, 'mysql_error'); + AssignProc(@mysql_fetch_field_direct, 'mysql_fetch_field_direct'); + AssignProc(@mysql_fetch_field, 'mysql_fetch_field'); + AssignProc(@mysql_fetch_lengths, 'mysql_fetch_lengths'); + AssignProc(@mysql_fetch_row, 'mysql_fetch_row'); + AssignProc(@mysql_free_result, 'mysql_free_result'); + AssignProc(@mysql_get_client_info, 'mysql_get_client_info'); + AssignProc(@mysql_get_server_info, 'mysql_get_server_info'); + AssignProc(@mysql_init, 'mysql_init'); + AssignProc(@mysql_info, 'mysql_info'); + AssignProc(@mysql_num_fields, 'mysql_num_fields'); + AssignProc(@mysql_num_rows, 'mysql_num_rows'); + AssignProc(@mysql_ping, 'mysql_ping'); + AssignProc(@mysql_options, 'mysql_options'); + AssignProc(@mysql_optionsv, 'mysql_optionsv', False); + AssignProc(@mysql_real_connect, 'mysql_real_connect'); + AssignProc(@mysql_real_query, 'mysql_real_query'); + AssignProc(@mysql_stat, 'mysql_stat'); + AssignProc(@mysql_store_result, 'mysql_store_result'); + AssignProc(@mysql_thread_id, 'mysql_thread_id'); + AssignProc(@mysql_next_result, 'mysql_next_result'); + AssignProc(@mysql_set_character_set, 'mysql_set_character_set'); + AssignProc(@mysql_thread_init, 'mysql_thread_init'); + AssignProc(@mysql_thread_end, 'mysql_thread_end'); + AssignProc(@mysql_warning_count, 'mysql_warning_count'); +end; + + +initialization + +// Keywords copied from SynHighligherSQL +MySQLKeywords := TStringList.Create; +MySQLKeywords.CommaText := 'ACCESSIBLE,ACCOUNT,ACTION,ACTIVE,ADD,ADMIN,AFTER,AGAINST,AGGREGATE,' + + 'ALGORITHM,ALL,ALTER,ALWAYS,ANALYSE,ANALYZE,AND,ANY,ARRAY,AS,ASC,' + + 'ASENSITIVE,AT,ATTRIBUTE,AUTHENTICATION,AUTOEXTEND_SIZE,AUTO_INCREMENT,' + + 'AVG_ROW_LENGTH,BACKUP,BEFORE,BEGIN,BETWEEN,BINLOG,BIT,BLOCK,BOTH,BUCKETS,' + + 'BULK,BY,CACHE,CALL,CASCADE,CASCADED,CATALOG_NAME,CHAIN,CHALLENGE_RESPONSE,' + + 'CHANGE,CHANGED,CHANNEL,CHARACTER,CHARSET,CHECK,CHECKSUM,CIPHER,' + + 'CLASS_ORIGIN,CLIENT,CLONE,CODE,COLLATE,COLLATION,COLUMN,COLUMNS,' + + 'COLUMN_FORMAT,COLUMN_NAME,COMMENT,COMMIT,COMMITTED,COMPLETION,COMPONENT,' + + 'COMPRESSION,CONCURRENT,CONDITION,CONNECTION,CONSISTENT,CONSTRAINT,' + + 'CONSTRAINT_CATALOG,CONSTRAINT_NAME,CONSTRAINT_SCHEMA,CONTAINS,CONTEXT,' + + 'CONTINUE,CONVERT,CPU,CREATE,CROSS,CUBE,CUME_DIST,CURRENT,CURSOR,' + + 'CURSOR_NAME,DATA,DATABASE,DATABASES,DATAFILE,DAY_HOUR,DAY_MICROSECOND,' + + 'DAY_MINUTE,DAY_SECOND,DEALLOCATE,DEC,DECLARE,DEFAULT,DEFAULT_AUTH,DEFINER,' + + 'DEFINITION,DELAYED,DELAY_KEY_WRITE,DELETE,DENSE_RANK,DESC,DESCRIBE,' + + 'DESCRIPTION,DES_KEY_FILE,DETERMINISTIC,DIAGNOSTICS,DIRECTORY,DISABLE,' + + 'DISCARD,DISTINCT,DISTINCTROW,DIV,DO,DROP,DUAL,DUMPFILE,DUPLICATE,EACH,' + + 'ELSE,ELSEIF,EMPTY,ENABLE,ENCLOSED,ENCRYPTION,END,ENDS,ENFORCED,ENGINE,' + + 'ENGINES,ENGINE_ATTRIBUTE,ERROR,ERRORS,ESCAPE,ESCAPED,EVENT,EVENTS,EVERY,' + + 'EXCEPT,EXCHANGE,EXCLUDE,EXECUTE,EXISTS,EXPANSION,EXPIRE,EXPLAIN,EXPORT,' + + 'EXTENDED,EXTENT_SIZE,FACTOR,FAILED_LOGIN_ATTEMPTS,FALSE,FAST,FAULTS,' + + 'FIELDS,FILE,FILE_BLOCK_SIZE,FILTER,FINISH,FIRST,FIRST_VALUE,FLOAT4,FLOAT8,' + + 'FLUSH,FOLLOWING,FOLLOWS,FOR,FORCE,FOREIGN,FOUND,FROM,FULL,FULLTEXT,' + + 'FUNCTION,GENERAL,GENERATE,GENERATED,GEOMCOLLECTION,GET,' + + 'GET_MASTER_PUBLIC_KEY,GET_SOURCE_PUBLIC_KEY,GLOBAL,GRANT,GRANTS,GROUP,' + + 'GROUPING,GROUPS,GROUP_REPLICATION,GTID_ONLY,HAVING,HELP,HIGH_PRIORITY,' + + 'HISTOGRAM,HISTORY,HOST,HOSTS,HOUR_MICROSECOND,HOUR_MINUTE,HOUR_SECOND,' + + 'IDENTIFIED,IGNORE,IGNORE_SERVER_IDS,IMPORT,IN,INACTIVE,INDEX,INDEXES,' + + 'INFILE,INITIAL,INITIAL_SIZE,INITIATE,INNER,INOUT,INSENSITIVE,INSERT,' + + 'INSERT_METHOD,INSTALL,INSTANCE,INT1,INT2,INT3,INT4,INT8,INTERSECT,INTO,' + + 'INVISIBLE,INVOKER,IO,IO_AFTER_GTIDS,IO_BEFORE_GTIDS,IO_THREAD,IPC,IS,' + + 'ISOLATION,ISSUER,JOIN,JSON,JSON_TABLE,JSON_VALUE,KEY,KEYRING,KEYS,' + + 'KEY_BLOCK_SIZE,KILL,LAG,LANGUAGE,LAST,LAST_VALUE,LATERAL,LEAD,LEADING,' + + 'LEAVES,LESS,LEVEL,LIKE,LIMIT,LINEAR,LINES,LIST,LOAD,LOCAL,LOCK,LOCKED,' + + 'LOCKS,LOGFILE,LOGS,LONG,LOW_PRIORITY,MASTER,MASTER_AUTO_POSITION,' + + 'MASTER_BIND,MASTER_COMPRESSION_ALGORITHMS,MASTER_CONNECT_RETRY,' + + 'MASTER_DELAY,MASTER_HEARTBEAT_PERIOD,MASTER_HOST,MASTER_LOG_FILE,' + + 'MASTER_LOG_POS,MASTER_PASSWORD,MASTER_PORT,MASTER_PUBLIC_KEY_PATH,' + + 'MASTER_RETRY_COUNT,MASTER_SERVER_ID,MASTER_SSL,MASTER_SSL_CA,' + + 'MASTER_SSL_CAPATH,MASTER_SSL_CERT,MASTER_SSL_CIPHER,MASTER_SSL_CRL,' + + 'MASTER_SSL_CRLPATH,MASTER_SSL_KEY,MASTER_SSL_VERIFY_SERVER_CERT,' + + 'MASTER_TLS_CIPHERSUITES,MASTER_TLS_VERSION,MASTER_USER,' + + 'MASTER_ZSTD_COMPRESSION_LEVEL,MATCH,MAXVALUE,MAX_CONNECTIONS_PER_HOUR,' + + 'MAX_QUERIES_PER_HOUR,MAX_ROWS,MAX_SIZE,MAX_UPDATES_PER_HOUR,' + + 'MAX_USER_CONNECTIONS,MEDIUM,MEMBER,MESSAGE_TEXT,MIDDLEINT,MIGRATE,' + + 'MINUTE_MICROSECOND,MINUTE_SECOND,MIN_ROWS,MOD,MODE,MODIFIES,MODIFY,MUTEX,' + + 'MYSQL_ERRNO,NAME,NAMES,NATURAL,NCHAR,NESTED,NETWORK_NAMESPACE,NEVER,NEW,' + + 'NEXT,NO,NODEGROUP,NONE,NOT,NOWAIT,NO_WAIT,NO_WRITE_TO_BINLOG,NTH_VALUE,' + + 'NTILE,NULL,NULLS,NUMBER,NVARCHAR,OF,OFF,OFFSET,OJ,OLD,ON,ONE,ONLY,OPEN,' + + 'OPTIMIZE,OPTIMIZER_COSTS,OPTION,OPTIONAL,OPTIONALLY,OPTIONS,OR,ORDER,' + + 'ORDINALITY,ORGANIZATION,OTHERS,OUT,OUTER,OUTFILE,OVER,OWNER,PACK_KEYS,' + + 'PAGE,PARSER,PARSE_GCOL_EXPR,PARTIAL,PARTITION,PARTITIONING,PARTITIONS,' + + 'PASSWORD_LOCK_TIME,PATH,PERCENT_RANK,PERSIST,PERSIST_ONLY,PHASE,PLUGIN,' + + 'PLUGINS,PLUGIN_DIR,PORT,PRECEDES,PRECEDING,PREPARE,PRESERVE,PREV,PRIMARY,' + + 'PRIVILEGES,PRIVILEGE_CHECKS_USER,PROCEDURE,PROCESS,PROCESSLIST,PROFILE,' + + 'PROFILES,PROXY,PURGE,QUERY,QUICK,RANDOM,RANGE,RANK,READ,READS,READ_ONLY,' + + 'READ_WRITE,REBUILD,RECOVER,RECURSIVE,REDOFILE,REDO_BUFFER_SIZE,REFERENCE,' + + 'REFERENCES,REGEXP,REGISTRATION,RELAY,RELAYLOG,RELAY_LOG_FILE,' + + 'RELAY_LOG_POS,RELAY_THREAD,RELEASE,RELOAD,REMOTE,REMOVE,RENAME,REORGANIZE,' + + 'REPAIR,REPEATABLE,REPLACE,REPLICA,REPLICAS,REPLICATE_DO_DB,' + + 'REPLICATE_DO_TABLE,REPLICATE_IGNORE_DB,REPLICATE_IGNORE_TABLE,' + + 'REPLICATE_REWRITE_DB,REPLICATE_WILD_DO_TABLE,REPLICATE_WILD_IGNORE_TABLE,' + + 'REPLICATION,REQUIRE,REQUIRE_ROW_FORMAT,RESET,RESIGNAL,RESOURCE,RESPECT,' + + 'RESTART,RESTORE,RESTRICT,RESUME,RETAIN,RETURN,RETURNED_SQLSTATE,RETURNING,' + + 'RETURNS,REUSE,REVOKE,RLIKE,ROLE,ROLLBACK,ROLLUP,ROTATE,ROUTINE,ROW,ROWS,' + + 'ROW_FORMAT,ROW_NUMBER,RTREE,SAVEPOINT,SCHEDULE,SCHEMA,SCHEMAS,SCHEMA_NAME,' + + 'SECONDARY,SECONDARY_ENGINE,SECONDARY_ENGINE_ATTRIBUTE,SECONDARY_LOAD,' + + 'SECONDARY_UNLOAD,SECOND_MICROSECOND,SECURITY,SELECT,SENSITIVE,SEPARATOR,' + + 'SERIALIZABLE,SERVER,SESSION,SET,SHARE,SHOW,SHUTDOWN,SIGNAL,SIMPLE,SKIP,' + + 'SLAVE,SLOW,SNAPSHOT,SOCKET,SOME,SONAME,SOUNDS,SOURCE,SOURCE_AUTO_POSITION,' + + 'SOURCE_BIND,SOURCE_COMPRESSION_ALGORITHMS,SOURCE_CONNECT_RETRY,' + + 'SOURCE_DELAY,SOURCE_HEARTBEAT_PERIOD,SOURCE_HOST,SOURCE_LOG_FILE,' + + 'SOURCE_LOG_POS,SOURCE_PASSWORD,SOURCE_PORT,SOURCE_PUBLIC_KEY_PATH,' + + 'SOURCE_RETRY_COUNT,SOURCE_SSL,SOURCE_SSL_CA,SOURCE_SSL_CAPATH,' + + 'SOURCE_SSL_CERT,SOURCE_SSL_CIPHER,SOURCE_SSL_CRL,SOURCE_SSL_CRLPATH,' + + 'SOURCE_SSL_KEY,SOURCE_SSL_VERIFY_SERVER_CERT,SOURCE_TLS_CIPHERSUITES,' + + 'SOURCE_TLS_VERSION,SOURCE_USER,SOURCE_ZSTD_COMPRESSION_LEVEL,SPATIAL,' + + 'SPECIFIC,SQL,SQLEXCEPTION,SQLSTATE,SQLWARNING,SQL_AFTER_GTIDS,' + + 'SQL_AFTER_MTS_GAPS,SQL_BEFORE_GTIDS,SQL_BIG_RESULT,SQL_BUFFER_RESULT,' + + 'SQL_CACHE,SQL_CALC_FOUND_ROWS,SQL_NO_CACHE,SQL_SMALL_RESULT,SQL_THREAD,' + + 'SQL_TSI_DAY,SQL_TSI_HOUR,SQL_TSI_MINUTE,SQL_TSI_MONTH,SQL_TSI_QUARTER,' + + 'SQL_TSI_SECOND,SQL_TSI_WEEK,SQL_TSI_YEAR,SSL,STACKED,START,STARTING,' + + 'STARTS,STATS_AUTO_RECALC,STATS_PERSISTENT,STATS_SAMPLE_PAGES,STATUS,STOP,' + + 'STORAGE,STORED,STRAIGHT_JOIN,STREAM,SUBCLASS_ORIGIN,SUBJECT,SUBPARTITION,' + + 'SUBPARTITIONS,SUPER,SUSPEND,SWAPS,SWITCHES,SYSTEM,TABLE,TABLES,TABLESPACE,' + + 'TABLE_CHECKSUM,TABLE_NAME,TEMPORARY,TERMINATED,THAN,THREAD_PRIORITY,TIES,' + + 'TLS,TO,TRAILING,TRANSACTION,TRIGGER,TRIGGERS,TRUE,TYPE,TYPES,UNBOUNDED,' + + 'UNCOMMITTED,UNDO,UNDOFILE,UNDO_BUFFER_SIZE,UNINSTALL,UNION,UNIQUE,UNKNOWN,' + + 'UNLOCK,UNREGISTER,UPDATE,UPGRADE,URL,USAGE,USE,USER_RESOURCES,USE_FRM,' + + 'USING,VALIDATION,VALUE,VALUES,VARCHARACTER,VARIABLES,VARYING,VCPU,VIEW,' + + 'VIRTUAL,VISIBLE,WAIT,WARNINGS,WHERE,WINDOW,WITH,WITHOUT,WORK,WRAPPER,' + + 'WRITE,X509,XA,XID,XML,XOR,YEAR_MONTH,ZONE,' + // SQL Plus commands: + + 'CLOSE,CONDITION,CONTINUE,CURSOR,DECLARE,DO,EXIT,FETCH,FOUND,GOTO,' + + 'HANDLER,ITERATE,LANGUAGE,LEAVE,LOOP,UNTIL,WHILE'; + +// Error codes copied from perror.exe +MySQLErrorCodes := Explode(',', '0=No error,'+ + '1=Operation not permitted,'+ + '2=No such file or directory,'+ + '3=No such process,'+ + '4=Interrupted function call,'+ + '5=Input/output error,'+ + '6=No such device or address,'+ + '7=Arg list too long,'+ + '8=Exec format error,'+ + '9=Bad file descriptor,'+ + '10=No child processes,'+ + '11=Resource temporarily unavailable,'+ + '12=Not enough space,'+ + '13=Permission denied,'+ + '14=Bad address,'+ + '16=Resource device,'+ + '17=File exists,'+ + '18=Improper link,'+ + '19=No such device,'+ + '20=Not a directory,'+ + '21=Is a directory,'+ + '22=Invalid argument,'+ + '23=Too many open files in system,'+ + '24=Too many open files,'+ + '25=Inappropriate I/O control operation,'+ + '27=File too large,'+ + '28=No space left on device,'+ + '29=Invalid seek,'+ + '30=Read-only file system,'+ + '31=Too many links,'+ + '32=Broken pipe,'+ + '33=Domain error,'+ + '34=Result too large,'+ + '36=Resource deadlock avoided,'+ + '38=Filename too long,'+ + '39=No locks available,'+ + '40=Function not implemented,'+ + '41=Directory not empty,'+ + '42=Illegal byte sequence,'+ + '120=Didn''t find key on read or update,'+ + '121=Duplicate key on write or update,'+ + '123=Someone has changed the row since it was read (while the table was locked to prevent it),'+ + '124=Wrong index given to function,'+ + '126=Index file is crashed,'+ + '127=Record-file is crashed,'+ + '128=Out of memory,'+ + '130=Incorrect file format,'+ + '131=Command not supported by database,'+ + '132=Old database file,'+ + '133=No record read before update,'+ + '134=Record was already deleted (or record file crashed),'+ + '135=No more room in record file,'+ + '136=No more room in index file,'+ + '137=No more records (read after end of file),'+ + '138=Unsupported extension used for table,'+ + '139=Too big row,'+ + '140=Wrong create options,'+ + '141=Duplicate unique key or constraint on write or update,'+ + '142=Unknown character set used,'+ + '143=Conflicting table definitions in sub-tables of MERGE table,'+ + '144=Table is crashed and last repair failed,'+ + '145=Table was marked as crashed and should be repaired,'+ + '146=Lock timed out; Retry transaction,'+ + '147=Lock table is full; Restart program with a larger locktable,'+ + '148=Updates are not allowed under a read only transactions,'+ + '149=Lock deadlock; Retry transaction,'+ + '150=Foreign key constraint is incorrectly formed,'+ + '151=Cannot add a child row,'+ + '152=Cannot delete a parent row'); + + + +end. diff --git a/source/dbstructures.pas b/source/dbstructures.pas new file mode 100644 index 00000000..3217bd22 --- /dev/null +++ b/source/dbstructures.pas @@ -0,0 +1,218 @@ +unit dbstructures; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Graphics; + + +type + + // Column types + TDBDatatypeIndex = (dbdtTinyint, dbdtSmallint, dbdtMediumint, dbdtInt, dbdtUint, dbdtBigint, dbdtSerial, dbdtBigSerial, + dbdtFloat, dbdtDouble, dbdtDecimal, dbdtNumeric, dbdtReal, dbdtDoublePrecision, dbdtMoney, dbdtSmallmoney, + dbdtDate, dbdtTime, dbdtYear, dbdtDatetime, dbdtDatetime2, dbdtDatetimeOffset, dbdtSmalldatetime, dbdtTimestamp, dbdtInterval, + dbdtChar, dbdtNchar, dbdtVarchar, dbdtNvarchar, dbdtTinytext, dbdtText, dbdtCiText, dbdtNtext, dbdtMediumtext, dbdtLongtext, + dbdtJson, dbdtJsonB, dbdtCidr, dbdtInet, dbdtMacaddr, + dbdtBinary, dbdtVarbinary, dbdtTinyblob, dbdtBlob, dbdtMediumblob, dbdtLongblob, dbdtVector, dbdtImage, + dbdtEnum, dbdtSet, dbdtBit, dbdtVarBit, dbdtBool, dbdtRegClass, dbdtRegProc, dbdtUnknown, + dbdtCursor, dbdtSqlvariant, dbdtTable, dbdtUniqueidentifier, dbdtInet4, dbdtInet6, dbdtHierarchyid, dbdtXML, + dbdtPoint, dbdtLinestring, dbdtLineSegment, dbdtPolygon, dbdtGeometry, dbdtBox, dbdtPath, dbdtCircle, dbdtMultipoint, dbdtMultilinestring, dbdtMultipolygon, dbdtGeometrycollection + ); + + // Column type categorization + TDBDatatypeCategoryIndex = (dtcInteger, dtcReal, dtcText, dtcBinary, dtcTemporal, dtcSpatial, dtcOther); + + // Column type structure + TDBDatatype = record + Index: TDBDatatypeIndex; + NativeType: Integer; // MySQL column type constant (e.g. 1 = TINYINT). See include/mysql.h.pp. + NativeTypes: String; // Same as above, but for multiple ids (e.g. PostgreSQL oids). Prefer over NativeType. See GetDatatypeByNativeType. + Name: String; + Names: String; + Description: String; + HasLength: Boolean; // Can have Length- or Set-attribute? + RequiresLength: Boolean; // Must have a Length- or Set-attribute? + MaxSize: Int64; + DefaultSize: Int64; // TEXT and BLOB allow custom length, but we want to leave the default max length away from ALTER TABLE's + HasBinary: Boolean; // Can be binary? + HasDefault: Boolean; // Can have a default value? + LoadPart: Boolean; // Select per SUBSTR() or LEFT() + DefLengthSet: String; // Should be set for types which require a length/set + Format: String; // Used for date/time values when displaying and generating queries + ValueMustMatch: String; + Category: TDBDatatypeCategoryIndex; + MinVersion: Integer; + end; + + // Column type category structure + TDBDatatypeCategory = record + Index: TDBDatatypeCategoryIndex; + Name: String; + Color: TColor; + NullColor: TColor; + end; + + // Server variables + TVarScope = (vsGlobal, vsSession, vsBoth); + TServerVariable = record + Name: String; + IsDynamic: Boolean; + VarScope: TVarScope; + EnumValues: String; + end; + + // Custom exception class for any connection or database related error + EDbError = class(Exception) + private + FErrorCode: Cardinal; + FHint: String; + public + property ErrorCode: Cardinal read FErrorCode; + property Hint: String read FHint; + constructor Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String=''); + end; + + // DLL loading + TDbLib = class(TObject) + const + LIB_PROC_ERROR: Cardinal = 1000; + private + FHandle: TLibHandle; + protected + FDllFile: String; + procedure AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True); + procedure AssignProcedures; virtual; abstract; + public + property Handle: TLibHandle read FHandle; + property DllFile: String read FDllFile; + constructor Create(DllFile_, DefaultDll: String); virtual; + destructor Destroy; override; + end; + + +var + + // Column type categories + DatatypeCategories: array[TDBDatatypeCategoryIndex] of TDBDatatypeCategory = ( + ( + Index: dtcInteger; + Name: 'Integer' + ), + ( + Index: dtcReal; + Name: 'Real' + ), + ( + Index: dtcText; + Name: 'Text' + ), + ( + Index: dtcBinary; + Name: 'Binary' + ), + ( + Index: dtcTemporal; + Name: 'Temporal (time)' + ), + ( + Index: dtcSpatial; + Name: 'Spatial (geometry)' + ), + ( + Index: dtcOther; + Name: 'Other' + ) + ); + + + +implementation + +uses apphelpers; + + + +{ EDbError } + +constructor EDbError.Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String=''); +begin + FErrorCode := ErrorCode_; + FHint := Hint_; + inherited Create(Msg); +end; + + + +{ TDbLib } + +constructor TDbLib.Create(DllFile_, DefaultDll: String); +var + msg, ErrorHint: String; +begin + // Load DLL as is (with or without path) + inherited Create; + FDllFile := DllFile_; + if not FileExists(FDllFile) then begin + msg := f_('File does not exist: %s', [FDllFile]) + + sLineBreak + sLineBreak + + f_('Please launch %s from the directory where you have installed it. Or just reinstall %s.', [APPNAME, APPNAME] + ); + Raise EdbError.Create(msg); + end; + + FHandle := LoadLibrary(FDllFile); + if FHandle = NilHandle then begin + msg := f_('Library %s could not be loaded. Please select a different one.', + [ExtractFileName(FDllFile)] + ); + if GetLastOSError <> 0 then begin + msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]); + end; + if (DefaultDll <> '') and (ExtractFileName(FDllFile) <> DefaultDll) then begin + ErrorHint := f_('You could try the default library %s in your session settings. (Current: %s)', + [DefaultDll, ExtractFileName(FDllFile)] + ); + end else begin + ErrorHint := ''; + end; + Raise EDbError.Create(msg, GetLastOSError, ErrorHint); + end; + + // Dll was loaded, now initialize required procedures + AssignProcedures; +end; + + +destructor TDbLib.Destroy; +begin + if FHandle <> 0 then begin + FreeLibrary(FHandle); + FHandle := 0; + end; + inherited; +end; + + +procedure TDbLib.AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True); +var + msg: String; +begin + // Map library procedure to internal procedure + Proc := GetProcAddress(FHandle, Name); + if Proc = nil then begin + if Mandantory then begin + msg := f_('Library error in %s: Could not find procedure address for "%s"', + [ExtractFileName(FDllFile), Name] + ); + if GetLastOSError <> 0 then + msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]); + Raise EDbError.Create(msg, LIB_PROC_ERROR); + end; + end; +end; + + +end. diff --git a/source/main.lfm b/source/main.lfm new file mode 100644 index 00000000..6937d110 --- /dev/null +++ b/source/main.lfm @@ -0,0 +1,1171 @@ +object MainForm: TMainForm + Left = 585 + Height = 500 + Top = 289 + Width = 998 + Caption = 'MainForm' + ClientHeight = 500 + ClientWidth = 998 + DesignTimePPI = 120 + Menu = MainMenu1 + OnCreate = FormCreate + Position = poMainFormCenter + LCLVersion = '3.8.0.0' + object StatusBar: TStatusBar + Left = 0 + Height = 29 + Top = 471 + Width = 998 + Panels = < + item + Width = 150 + end + item + Width = 110 + end + item + Style = psOwnerDraw + Width = 140 + end + item + Style = psOwnerDraw + Width = 170 + end + item + Width = 170 + end + item + Style = psOwnerDraw + Width = 170 + end + item + Style = psOwnerDraw + Width = 250 + end> + SimplePanel = False + end + object ToolBarMainButtons: TToolBar + Left = 0 + Height = 30 + Top = 0 + Width = 998 + AutoSize = True + Caption = 'ToolBarMainButtons' + Images = ImageListIcons8 + TabOrder = 1 + object ToolButton1: TToolButton + Left = 1 + Top = 2 + Action = actSessionManager + Style = tbsDropDown + end + end + inline SynMemoSQLLog: TSynEdit + Left = 0 + Height = 80 + Top = 391 + Width = 998 + Align = alBottom + Font.Height = -13 + Font.Name = 'Courier New' + Font.Pitch = fpFixed + Font.Quality = fqCleartypeNatural + ParentColor = False + ParentFont = False + TabOrder = 2 + Gutter.Width = 68 + Gutter.MouseActions = <> + RightGutter.Width = 0 + RightGutter.MouseActions = <> + Highlighter = SynSQLSynUsed + Keystrokes = < + item + Command = ecUp + ShortCut = 38 + end + item + Command = ecSelUp + ShortCut = 8230 + end + item + Command = ecScrollUp + ShortCut = 16422 + end + item + Command = ecDown + ShortCut = 40 + end + item + Command = ecSelDown + ShortCut = 8232 + end + item + Command = ecScrollDown + ShortCut = 16424 + end + item + Command = ecLeft + ShortCut = 37 + end + item + Command = ecSelLeft + ShortCut = 8229 + end + item + Command = ecWordLeft + ShortCut = 16421 + end + item + Command = ecSelWordLeft + ShortCut = 24613 + end + item + Command = ecRight + ShortCut = 39 + end + item + Command = ecSelRight + ShortCut = 8231 + end + item + Command = ecWordRight + ShortCut = 16423 + end + item + Command = ecSelWordRight + ShortCut = 24615 + end + item + Command = ecPageDown + ShortCut = 34 + end + item + Command = ecSelPageDown + ShortCut = 8226 + end + item + Command = ecPageBottom + ShortCut = 16418 + end + item + Command = ecSelPageBottom + ShortCut = 24610 + end + item + Command = ecPageUp + ShortCut = 33 + end + item + Command = ecSelPageUp + ShortCut = 8225 + end + item + Command = ecPageTop + ShortCut = 16417 + end + item + Command = ecSelPageTop + ShortCut = 24609 + end + item + Command = ecLineStart + ShortCut = 36 + end + item + Command = ecSelLineStart + ShortCut = 8228 + end + item + Command = ecEditorTop + ShortCut = 16420 + end + item + Command = ecSelEditorTop + ShortCut = 24612 + end + item + Command = ecLineEnd + ShortCut = 35 + end + item + Command = ecSelLineEnd + ShortCut = 8227 + end + item + Command = ecEditorBottom + ShortCut = 16419 + end + item + Command = ecSelEditorBottom + ShortCut = 24611 + end + item + Command = ecToggleMode + ShortCut = 45 + end + item + Command = ecCopy + ShortCut = 16429 + end + item + Command = ecPaste + ShortCut = 8237 + end + item + Command = ecDeleteChar + ShortCut = 46 + end + item + Command = ecCut + ShortCut = 8238 + end + item + Command = ecDeleteLastChar + ShortCut = 8 + end + item + Command = ecDeleteLastChar + ShortCut = 8200 + end + item + Command = ecDeleteLastWord + ShortCut = 16392 + end + item + Command = ecUndo + ShortCut = 32776 + end + item + Command = ecRedo + ShortCut = 40968 + end + item + Command = ecLineBreak + ShortCut = 13 + end + item + Command = ecSelectAll + ShortCut = 16449 + end + item + Command = ecCopy + ShortCut = 16451 + end + item + Command = ecBlockIndent + ShortCut = 24649 + end + item + Command = ecLineBreak + ShortCut = 16461 + end + item + Command = ecInsertLine + ShortCut = 16462 + end + item + Command = ecDeleteWord + ShortCut = 16468 + end + item + Command = ecBlockUnindent + ShortCut = 24661 + end + item + Command = ecPaste + ShortCut = 16470 + end + item + Command = ecCut + ShortCut = 16472 + end + item + Command = ecDeleteLine + ShortCut = 16473 + end + item + Command = ecDeleteEOL + ShortCut = 24665 + end + item + Command = ecUndo + ShortCut = 16474 + end + item + Command = ecRedo + ShortCut = 24666 + end + item + Command = ecGotoMarker0 + ShortCut = 16432 + end + item + Command = ecGotoMarker1 + ShortCut = 16433 + end + item + Command = ecGotoMarker2 + ShortCut = 16434 + end + item + Command = ecGotoMarker3 + ShortCut = 16435 + end + item + Command = ecGotoMarker4 + ShortCut = 16436 + end + item + Command = ecGotoMarker5 + ShortCut = 16437 + end + item + Command = ecGotoMarker6 + ShortCut = 16438 + end + item + Command = ecGotoMarker7 + ShortCut = 16439 + end + item + Command = ecGotoMarker8 + ShortCut = 16440 + end + item + Command = ecGotoMarker9 + ShortCut = 16441 + end + item + Command = ecSetMarker0 + ShortCut = 24624 + end + item + Command = ecSetMarker1 + ShortCut = 24625 + end + item + Command = ecSetMarker2 + ShortCut = 24626 + end + item + Command = ecSetMarker3 + ShortCut = 24627 + end + item + Command = ecSetMarker4 + ShortCut = 24628 + end + item + Command = ecSetMarker5 + ShortCut = 24629 + end + item + Command = ecSetMarker6 + ShortCut = 24630 + end + item + Command = ecSetMarker7 + ShortCut = 24631 + end + item + Command = ecSetMarker8 + ShortCut = 24632 + end + item + Command = ecSetMarker9 + ShortCut = 24633 + end + item + Command = EcFoldLevel1 + ShortCut = 41009 + end + item + Command = EcFoldLevel2 + ShortCut = 41010 + end + item + Command = EcFoldLevel3 + ShortCut = 41011 + end + item + Command = EcFoldLevel4 + ShortCut = 41012 + end + item + Command = EcFoldLevel5 + ShortCut = 41013 + end + item + Command = EcFoldLevel6 + ShortCut = 41014 + end + item + Command = EcFoldLevel7 + ShortCut = 41015 + end + item + Command = EcFoldLevel8 + ShortCut = 41016 + end + item + Command = EcFoldLevel9 + ShortCut = 41017 + end + item + Command = EcFoldLevel0 + ShortCut = 41008 + end + item + Command = EcFoldCurrent + ShortCut = 41005 + end + item + Command = EcUnFoldCurrent + ShortCut = 41003 + end + item + Command = EcToggleMarkupWord + ShortCut = 32845 + end + item + Command = ecNormalSelect + ShortCut = 24654 + end + item + Command = ecColumnSelect + ShortCut = 24643 + end + item + Command = ecLineSelect + ShortCut = 24652 + end + item + Command = ecTab + ShortCut = 9 + end + item + Command = ecShiftTab + ShortCut = 8201 + end + item + Command = ecMatchBracket + ShortCut = 24642 + end + item + Command = ecColSelUp + ShortCut = 40998 + end + item + Command = ecColSelDown + ShortCut = 41000 + end + item + Command = ecColSelLeft + ShortCut = 40997 + end + item + Command = ecColSelRight + ShortCut = 40999 + end + item + Command = ecColSelPageDown + ShortCut = 40994 + end + item + Command = ecColSelPageBottom + ShortCut = 57378 + end + item + Command = ecColSelPageUp + ShortCut = 40993 + end + item + Command = ecColSelPageTop + ShortCut = 57377 + end + item + Command = ecColSelLineStart + ShortCut = 40996 + end + item + Command = ecColSelLineEnd + ShortCut = 40995 + end + item + Command = ecColSelEditorTop + ShortCut = 57380 + end + item + Command = ecColSelEditorBottom + ShortCut = 57379 + end> + MouseActions = <> + MouseTextActions = <> + MouseSelActions = <> + Options = [eoAutoIndent, eoBracketHighlight, eoGroupUndo, eoSmartTabs, eoTabsToSpaces, eoTrimTrailingSpaces] + VisibleSpecialChars = [vscSpace, vscTabAtLast] + ReadOnly = True + RightEdge = 0 + ScrollBars = ssVertical + SelectedColor.BackPriority = 50 + SelectedColor.ForePriority = 50 + SelectedColor.FramePriority = 50 + SelectedColor.BoldPriority = 50 + SelectedColor.ItalicPriority = 50 + SelectedColor.UnderlinePriority = 50 + SelectedColor.StrikeOutPriority = 50 + BracketHighlightStyle = sbhsBoth + BracketMatchColor.Background = clNone + BracketMatchColor.Foreground = clNone + BracketMatchColor.Style = [fsBold] + FoldedCodeColor.Background = clNone + FoldedCodeColor.Foreground = clGray + FoldedCodeColor.FrameColor = clGray + MouseLinkColor.Background = clNone + MouseLinkColor.Foreground = clBlue + LineHighlightColor.Background = clNone + LineHighlightColor.Foreground = clNone + inline SynLeftGutterPartList1: TSynGutterPartList + object SynGutterMarks1: TSynGutterMarks + Width = 30 + MouseActions = <> + end + object SynGutterLineNumber1: TSynGutterLineNumber + Width = 17 + MouseActions = <> + MarkupInfo.Background = clBtnFace + MarkupInfo.Foreground = clNone + DigitCount = 2 + ShowOnlyLineNumbersMultiplesOf = 1 + ZeroStart = False + LeadingZeros = False + end + object SynGutterChanges1: TSynGutterChanges + Width = 5 + MouseActions = <> + ModifiedColor = 59900 + SavedColor = clGreen + end + object SynGutterSeparator1: TSynGutterSeparator + Width = 3 + MouseActions = <> + MarkupInfo.Background = clWhite + MarkupInfo.Foreground = clGray + end + object SynGutterCodeFolding1: TSynGutterCodeFolding + Width = 13 + MouseActions = <> + MarkupInfo.Background = clNone + MarkupInfo.Foreground = clGray + MouseActionsExpanded = <> + MouseActionsCollapsed = <> + end + end + end + object spltTopBottom: TSplitter + Cursor = crVSplit + Left = 0 + Height = 6 + Top = 385 + Width = 998 + Align = alBottom + AutoSnap = False + ResizeAnchor = akBottom + end + object Panel1: TPanel + Left = 0 + Height = 355 + Top = 30 + Width = 998 + Align = alClient + AutoSize = True + BevelOuter = bvNone + ClientHeight = 355 + ClientWidth = 998 + TabOrder = 4 + object pnlLeft: TPanel + Left = 0 + Height = 355 + Top = 0 + Width = 212 + Align = alLeft + BevelOuter = bvNone + ClientHeight = 355 + ClientWidth = 212 + TabOrder = 0 + object pnlPreview: TPanel + Left = 0 + Height = 100 + Top = 255 + Width = 212 + Align = alBottom + BevelOuter = bvNone + TabOrder = 0 + Visible = False + end + object spltPreview: TSplitter + Cursor = crVSplit + Left = 0 + Height = 6 + Top = 249 + Width = 212 + Align = alBottom + ResizeAnchor = akBottom + Visible = False + end + object ToolBarTree: TToolBar + Left = 0 + Top = 0 + Width = 212 + TabOrder = 2 + end + object DBtree: TLazVirtualStringTree + Left = 0 + Height = 217 + Top = 32 + Width = 212 + Align = alClient + DefaultText = 'Node' + Header.AutoSizeIndex = 0 + Header.Columns = <> + Header.MainColumn = -1 + TabOrder = 3 + end + end + object spltDBtree: TSplitter + Left = 212 + Height = 355 + Top = 0 + Width = 6 + end + object Panel2: TPanel + Left = 218 + Height = 355 + Top = 0 + Width = 780 + Align = alClient + BevelOuter = bvNone + ClientHeight = 355 + ClientWidth = 780 + TabOrder = 2 + object pnlFilterVT: TPanel + Left = 0 + Height = 39 + Top = 316 + Width = 780 + Align = alBottom + BevelOuter = bvNone + TabOrder = 0 + end + object PageControlMain: TPageControl + Left = 0 + Height = 316 + Top = 0 + Width = 780 + ActivePage = tabHost + Align = alClient + Images = ImageListIcons8 + TabIndex = 0 + TabOrder = 1 + object tabHost: TTabSheet + Caption = 'Host' + ImageIndex = 1 + end + object tabDatabase: TTabSheet + Caption = 'Database' + end + object tabTable: TTabSheet + Caption = 'Table' + end + object tabData: TTabSheet + Caption = 'Data' + end + object tabQuery: TTabSheet + Caption = 'Query' + end + end + end + end + object MainMenu1: TMainMenu + Images = ImageListIcons8 + Left = 48 + Top = 33 + object MenuItem1: TMenuItem + Caption = 'File' + object MenuItem8: TMenuItem + Action = actExitApplication + end + end + object MenuItem2: TMenuItem + Caption = 'Edit' + end + object MenuItem3: TMenuItem + Caption = 'Search' + end + object MenuItem4: TMenuItem + Caption = 'Query' + end + object MenuItem5: TMenuItem + Caption = 'Tools' + end + object MenuItem6: TMenuItem + Caption = 'Go to' + end + object MenuItem7: TMenuItem + Caption = 'Help' + end + end + object ActionList1: TActionList + Images = ImageListIcons8 + Left = 48 + Top = 120 + object actSessionManager: TAction + Category = 'File' + Caption = 'Session manager' + Hint = 'Display session manager' + ImageIndex = 3 + OnExecute = actSessionManagerExecute + end + object actExitApplication: TAction + Category = 'File' + Caption = 'E&xit' + Hint = 'Exit|Exit application' + ImageIndex = 2 + OnExecute = actExitApplicationExecute + end + object actGotoDbTree: TAction + Category = 'Various' + Caption = 'Database tree' + OnExecute = actGotoDbTreeExecute + ShortCut = 16452 + end + end + object ImageListIcons8: TImageList + Left = 50 + Top = 209 + Bitmap = { + 4C7A0400000010000000100000007C0400000000000078DAC5546D4C535718AE + 09BFFCED7EB022529C20CE820A5591825459290502945A2AB4A032C9C63EE250 + 6CEBC06C88E0BC44C95C6024A8CB5C80586D635089F3839AB8B84FCDB2641831 + 314B9625339898B5B80552DE9DF7B607EE477BEF9565DB499EA4F73DEFF39CF7 + B3168B45A5D56AE7915390BBD4CC34D63A7C5D671A6F9F0A201CBEEEB325CC9E + DAECADB94BB9BE9628971E8D2DAF6AABF7E0AFDB46DB20160A7DEEDF343579D5 + D49FEAE0497FDB7C88F8CCC5E37281BEAA250B7C4DCD962AA5DC28E656D8B758 + 68BE3466F358075CFCE51BB8FBF411049EFC2CA951E8F7FC8EF5C05A71EDFD0F + AEC1D7847FFBC904CF7FDFDDD3F0C9C418CF56723C5267FA5D7DFD18797B127A + 7EBA04C38FEFF07CBB7EBCC8EADA6FF6CCDB9CBE6EB647F4DBF5EDE7AC4FD597 + DD60BAFA218F8F36CC0B7DA88D70C7B97CF777E7587EC5B52E51BE68433EFA70 + F9381BF4DB768361F9877F1816F1D1867775B74EF0E217D66FF0E14DB833F510 + DA897FD9D811166DDF0FC157C47676729CA769EE68646712E78ADA30EFCF1E05 + D8B7B09608FC8DB6127E4DA6B20B22F38C33298CD739DE4B621862514F7E0BEF + 53EC7956FEFC96BEC8FC7AB8F3CB9E25ECFE5870AE24B853A9B6FC1DE84BF7C7 + 22D85F7626495D9C91FDC5FE8EE36FB65605E2FD058079CC4E786BFE18290D3C + 1B8E0DBC9B7DE0DDC9E5703173EFD303CCEB59B0B34C2782FEE372F8A8310B88 + 8F4B8A7FD99D017D6F6A4538E9C9865157862CDFBB7F0D1CDB9325427BDB6638 + DFF2AA2CBFB729137657E48860624AE0C4DE4C59FEFDCE34B8D5B63A26EE913B + 397EE7AE755051BC4984B58356E8685827CB9F3CFE0ADC3F9A161378B7D8F7D7 + 9FAC50F4FE554F060CBCA515E1947B3D5C71CBF72FD8A70129FC97FCD0E92C98 + 1E2A5A34FFAFEBFB6076E20284FA5317F7FE401A84CE6C50FC3EEEEFF3F3E680 + 1484FBDBDCDCAC2AAB3CBACAE6F01BF4FA7C955EAF9741BECA56EB3720877273 + 0C4F1F6FDC1E0AA9533D2695CC494AF114A32F72906BADF31B74E49BD880609A + DC1B25B846F489FA8668CC89445347EDDB82A1581A2C97DCD17730569A2F9EC4 + 14B751C7B9C7380531B3FABAED41CC93D5A735A187D5E0C4873C9A2FE7DDF9D8 + 84FC8806DF9F9BAF5AB310533CBE30DE58F9BC281F734A54C84F8A133FF658A8 + 21E40BFB2BAC5F240EF76BB1F8C2FEC6ED1FF1A11A749E79F92A9C9F97492FE8 + 2E6C5438BF6A417E3B1CFEC252CEFEC4EA914883CC2D777F70075103E350BCBF + 8E85FDFD3F4E4242C2A2B9F5F6F216A6D3CD28D53015E5553247F65FF8C0D33C + B8B7A1FA7DDF17BD61D490E3AD5D9D6CA8B31A0F12FF190288228C1A72DC64F5 + B2A426A771A4BDC51E3E37D0C9E503C621F9FF98B86CB9E79DEA6796D2CDAE37 + 1A8A470F0B34482E5E29BED9985FD9C71C081E7AD71A261AAD44E3324763C654 + A4AF8CC75D93BE5247F3EDEF69FD9368CC59CCB9A8318AB9603DA4DEDE949359 + C5CD35AA11261AAEA67AE388366385418ABF52B33C9DF0A6B91A7D4C6B10EB91 + AC7E2949AEEE4E7BF97BD82382E751FE0CD6036BAA80DB825CD4C0383017AC87 + D279C699543257FFC64EFC93F33731D97C4E + } + BitmapAdv = { + 4C69010000004C7A040000006400000064000000BE2E00000000000078DAED9D + 075454471780E91D0489898205A5837416588AC08262C10A1A8DE68FD12836EC + 1D2CB1A6A8680CD895A231162C88628905C4168DDDD84B127B3489021AA3C9FC + F7BE7D0B88ECB2C07BDB9839E79E3511D9DDF7BDF9A6DD99F7ECD933AD828202 + 958DE397CE68171E3BA275EEE96DFDF34FEF58403484B083708070867083F060 + A325840B8423440B882610D6E79EDE313E79ED82CE9907377555F9BB9E3E7D9A + 79559962AEA5A5D7DA48C7DADFDEAABE9FBD93B59F83D07158BB0E1F883C5AB7 + CA9DDC33323779AC6847D222888D913B9277411C88CC493E0E71868DD3A21DC9 + 05913B92F6C2DF6D879F4B87D759113BA60C6C99F461C790CCB171F07B2321BC + 211A5B04D99A6805AACED7F7F5F5552E0F6708132D2D9D787D9DF75BB9D9BCDF + C72DD8EE5A684F516EF274B8A65BE0DA5E83EBF912A208FE4C6A13F03B5EC1EB + 7FF0FA047EF791881D494B030F0C4E7C7FAF5BBBF7C3DCDC2D626CCCB57CE1F3 + 74AA7B3C8C3FB0D4B58DF1B1B599E7D3DAA6978FB0D9F590BE91B949DFC2B5FA + 09A2A4B6D7BE1AF12FBCDF7D78CDF12BEC3BC926DDA79DCD199FEE36313E5E0D + C2DD8D359D87617D73DD6671423BB7D19D7B47E5242D039F5C802880EBF19702 + 19488B57506FAE423C843FEF0A593F6672D338612B70A599A6F2D0D6D3D5327C + CFC2C836C6B769F4F6A45EC0629728276905BC3E50360FAC979139498720AEC0 + 9FE704AE19E10D9FB59E81A5A9AEA6F1D0D6D5414719BE1FE26A17B523F97FF0 + 7D0BE13E7CA3027542069FA43FC1A16982D40101461F585A01171D75E6616066 + CC7030B77D4FD7DACFDE263A27E943F89E4781C57FAACCA1927AF307D4DF34EF + 39BD7D4D6DADCD0CEB996A9935ACAF563CF4CD8DF5DC3F6DD3F83D5F07CBCED9 + 5343E17B6541FCA34E1CDE6DF793AEC66C4B1EEE3F3ACEAEDDAA316EA64D1B98 + A83A0F7D537DADFA2E1F98D8F71585419F35136232DC5BF7D59843C5288631D0 + 3678BD189235B29FA5ABAD8D65734B95E4A1676AA46DDFDDBF4187AD833F867B + E944A4D8C1FF69100B89BF24AFC5D1391396B45EDAC3CBC2A5B1BE2AF10016BA + 763DC31CA02ECC80CF7A57D318C8887F804B7EE08AC44E961ECDCC5481879EA9 + A15EF3DEE19EF0D9A0DF9AFCB20EB1286D5B701E2170D99001563E2DEA2B9387 + 9E89A1BE435F9110BCB451CDDBEBDA06CEC3DC09481B34CEDADFA191B27868EB + 686B433D7D1FC65013C1552FEB300F9C7739ED35B34F04F42D0D14CD03EB05C3 + C2BD6943185FCF80FAF1BA0EB328574792CE7A26756F8F4C606C6FA2081EC042 + CFE1535130D60BA813B335B10F55CBFED74F6E63BBC484648E4C306A6869CC27 + 0FEC4761DB0D7EDA00318ED68B4A79FC07D7E607B8368F43D247F43269F29E11 + 1F3C707C817DDA88DCE495F09EAFE1FD5ED1EB2F95C96BB68DFF2D387D789C99 + 7D433D2E79E0B8DB215ED0409433E573788F17F49A57ABDF7545B83A31D8DAC9 + 9A331E380782E3EE3A36D6E36C5D253A67E2EEF0AF3AB5E08207CE0DE27C1470 + 3E41AF6D8DE3B97055E2226B81A3556D78E89B1B6A390F086F8C738391F49AD6 + B64DB917B87A703FCB483BED9AF2D0D6D5D6B2F66B6129CA9D3259DDD62D5490 + C735BFF99F06EB591AD5B87E9836B6D26DB373546875E7CC5BEF9C4A3AED9E4D + 3AE4CD24DDF67EC14974DD3B97C4EE9EA9CE4CFE6EB567C246C705EDCD6BC203 + D7F6705D0F586455F7BD7BEE9F47965CD943669EDD44F63C3847F21FFF5CEBD8 + FFF02249BD9CA7EEF5E4379F391FF733B032D3AD2E0F5CEFC635D69A8E333E39 + B488B4DF35837C797E2B3908D7F3F8D31BB58AC22757C9F2AB7B35612E787FCB + B1DDECE5E5813939980782B907B8DE5DDBCFD03E6F06997B7E0B39F0E812E521 + 8EC7DE337B4F366E68A567EED0C8A02A1E981F8539396C1E08276D38B62373CE + 65931FC0399407133F380FE9E01C923E3244160FCC1BC45C35CC8FC29C1C2E3F + 436CDE2C32EBEC66B2EFE1853ACF03AEED03AF19BD46857E377A9DB5BFBDA134 + 1E98C389798398ABC6477E54C7DDB3C8DC735B48C1EF57549A4774EE1412B7EF + 0BD2FD87AFF89C9BDF06F12078F5B0E04A79386B69613E2DFCEC05CC97E4E373 + B4DDF53999F863568DDA7745F040AF46E74E65FA2269977793C59777916EC085 + A73A72135E5F08370D4BD3EA57090F13E0D1CB4788F9FAEC5A382FF75DC2E125 + 64EF83F32AC9035948EAF1A4935924F9A7EF489B9DD3F8E271165E8B8419C392 + B41ABDCB0373FE31CF5C9CDBCC4F3E6DF77D5F91E5D77E50C9F60359F4857AD1 + 79CF1C706A3639F6F43AD9FBF03C19797C7529278E79E01E8A37C17B871F37BC + 686E509107EEBFC09C7FBEBE2FF67BA79FFE1EBEA7EAF5AF703EA15FFE629275 + 339FA45CDCF1D6FB6EBF7B8AFC0F38F1D9FF0D5C36ACD55B3C60048F7B61A07D + 39C5D7BD37F0701AF4772FA85C7F177DF459C1B764DDADC395BEEF9127D7C8AA + EB074847E81FF2C4A344983E6411B6DF121EB847CCEE5A582F114F6B4D38F7B4 + 06BE93AA8D079105DE271BEE1C95F9DEFBA0BD4B3AB58E69FFF818B387EC1D7E + DAECD80786121EB85F0FF788F1C102BFF3C863AB98FBACAA6B8E3F73F0D1CF0A + E3D165CF5CB2F4CADE2A3F173A76FDED42D283BFFEEFBD80D4413E121EB87792 + DDAFC7D97B44B1F7127EE7F5B78FC871FF5F23DF8133BEBEB0BDD231231F3CB0 + FF3DFEC70C78BFAAFB7B38B7300DDA3FAC23D8DE70CCE38FC0D484A1A5F5C3CF + 1EFBB9D7B87C0F9C6F6F0DEDC690C26555D60DECCB6CFBED24F934FF1BA6AF89 + E3F88A7D62BEDA0FFC9C38E759D51815EBC89A1B07613C32977C74603EE773F1 + 81A983D6218F1397CE683B0DE9D02192E3DCDB0105A930BE9A41965CD95DE5BD + 77E8F165E6DE0367965E23C95CBD22FA57BD0F2C20DF818FAAFA9CB9F77E2223 + 8EAD2473CE6DE67CBC1E9A35EA54EC984FF470AF7D4391676BF0551197EFF1BF + 830B493BF0C15770EF55F53D0FFF7E957C0B636111EB38F138651FE33045F0E8 + 5FB018AEF5E92A3FE7965F4F40FB9F4A269ECCE4BC4D0F5A36A45018D54AFBDC + 933BFA11DBA7F6E2FA3B8E39B186195B6D070F49FB7E47C153F89A77FF2CE955 + C1013DF7CF272BAFEF6798A04BF8E4818EFCEAFC36E6F3C8722BAE197C7E7A03 + C9B871A8B47DE4AEBD4DBE3AB47069BD734F6F5B44E4248DE7F277C7EC9ACECC + AF631D39CE5EF3CA62D7FD33A410EAC66229EB7EBD0FA490D5E06C6CE3F73FBA + C8EBF81CFBBD3BC047DFDF91DDF74803FFE2B8BDF39ED95C7F863B0905A9DE78 + 1E08B41D8BB89D17F9922C836B37E5A7EF647EB7D53026C1EB3C001C20D57BEC + 3AE36CE0BBE8522E6F3C708CF4CDCFBB98FE96ACCFBCF65601F4C92F91614796 + 73FD19EE271C4EEB8C67B388C4FB3738FBDD380FF43DF47171BD5BD658031D91 + 73F71489D939BDEA3A073F83731A7CCEB14F3EB996B9970E3DBA2CF573633F10 + FD89F707C79FE1494241DA503C272792E3F9F541854BC94E681F658D7BB13F3B + E1C74C26EF4155D689861E59C6B425EB65F4B5F6C0E7C6366D29F7EEFC03784C + C2338B80C7412E7FF708188F63DBB7BB5C7FB5B2FB6C3070FBFCCC4695E1D1F7 + D037CCBCE7A29F774AFDDCF9D0373FFAE43A53FF397EFF67030B5267E2F951F0 + E7E35CFEEED1C7D7401FF68ACC7527AC3BF8FD471F5FAD323C7A419FAE2DF445 + 66C03D22CBB3C7D8FB89E3F72F4AC84F5D8067788972924E73F9BBC79D48AFB2 + EF8873281F1F4C21894757A80C8F1E3F7CCDF40D65F5438EB1FD45F431D77BDB + 81472A6F3C80058E19A47DAFEF591EC35588C78772F0908C9970ACCE1B0F8ED7 + 3DC69FC860EEA3631A5C3F76F1533F16030F5711C7B93D6398F6E32A3924A3FD + D878E718E99BFF0D338E57151E384F8873BEB3CE6E92B90E834CB6FEFA23E77B + 12603CF805F07082FED53E4EFB57475792FD0F2F91BC7B6765F6AF8640FF7286 + 0AF5AF707E19FB578B615C286BEE13FB57EB6F1572FDFE7F417F772A9EC3293E + FB91CBF1C712667EEE7B19EB1E38FE9878328B8F7E7C8D63D8D1E5CCF8E37B19 + E3A63DF7CF317564C965CEC74D4F81C7183C1315DAF3742E7FF727ECF8FC5B19 + F719F6BDE65DD84E76DCFD89990756360B5C63C2FC1ECCCDCF7F2C7D2D043D55 + 00756426F7F5FA11F0F804CFA78DCC499AC9E5EF8EDFF725590AE36E9C7F9035 + 17947EE310336E1C7C78A9D279E01E139CDFA9EA33630E0A7EE6214738FFCCBF + 0D2A480DC7B38223B6272770BB0E3A9D59E3C3F95D9CBF95F6DD764BEAFE95BD + 707F4E531A0B9C3BC7399E5CA8ABB21C8B7D5D9C73C479E98EBB399FDFBD31F8 + 705A333CB719CF0A66CFA7E5ECF7630E03AEF36DFAE578957D476C4BFA177CAB + 341E9DF6CC66DC899FE7A88C3E3AE62B259FFA8EC9E9E37A7DB0D5FAB167E2E6 + 0C33C033B4F1DC6611C7FB0371AEB0CB9E394C1DA86A6C85F71BCE772B8B07D6 + E7A93FADAF720C8B735758EFD7733F774522B74DFE7960EE7C13717E8943249E + DBCC47DFB162BE5F6581F3D75F5DD8CAE43F28C355D8FFA82A074BD24747AF4D + 01761C7F8ED781A9837E28977FE5CDC55EA8CA72C571AD49D63D57368F7D8E71 + 56143F396732F24B66912FCF6F912307EB3AB37E8C6E8BE73E0FAB283035E1CB + D2FC2B7FFBC691B9494BF85A9BCE843E4955DF17C7581B6E1FE573CF45A5F957 + 634FA433EB7D557D3E6CE3269F5ACB5F0E6F6A4267098F7AC2C626C2834313D9 + FD861CF7EBA7317354F2ECC1C1399695D7F633F9257CD7136C33128FAE247932 + DAB7F2ED1CDE53717BF9D90B12B165E24DF7B15D6C4BF3A903B5B4F09C7FF66C + 795E72CE565CDB27579E2EAE9BAC80FE0BE644F1B1F70239E33E769C63DB79EF + 8C5C9F095D3AF1C74CBEEE8D7F84CB87E6BDB3DF20CCCD1DCFF9E72BBF1DD7BE + E5FDFED8DE60BE39D62BC6D730BEAC6D7D8985F60CEB2A72C6F9427973EDB1CE + 624E09E6F6F1C4E3AFA015438756E46111636BEE57F8E924F139FFDC3FF301E7 + 44B0EF2EEFBEE7636C3FF8AB0BDB985C95E1C75632F9CCD5A933E2BA308BB917 + 66433F15FBE038BE3E2A2307E99D360DFA5D9FF0B3FF03CFFFFC2F7CD784EBF6 + B95176EFEC57F3D5D2B249F7690F2CAEE299B27CDC0B381EC1FE6F75F6734AD6 + 4799FC2BF0188E13705EB8CFC114C6E778BDB15F2D09CCC1C3752564804EFA1A + 786E863129D6B9EABC2FF6A7706E0DC7B53CD58B5FF07CDCE0AD89E95AD32AD9 + 3FD809789CF5E90E2C1E45729C5B5D7EBD07F3978EC9797F32EEFA5DBCDE8039 + 8C38378F6B14C800EB1BD6151CB360AE8E38A6324EC235256483634C6487FD54 + 6471B09A6712605DC67A25DAC14BDFE2298E3B827727EED52AAC7CBF333E1746 + 247E2ED31CBE729C305716C75535DDB77618C6C8B82F0173D2C79DC860C667FD + A12E60E03E27EC33611D4ABDBC9BE4DE3D2D333FB2AA312AEEB1952737AC8671 + 04E2CFE055899F49DB7F8ECFE8C1E7C2E0B348F0F9177CCD6B271E59CEE40354 + 355FA4E890D45B64B10AEA14F60178DA5BFB2AECFBB1A911DB265FF4FDA28FB5 + ACF3329A7613B6C2E7C2C0BF59C257DF1F3D8379FB584FB01F75F8F7AB4A6781 + 6D3CAEA1E1FE2CCCD14327F238FEB9E83CA45DC7E0358963AB3ABFE483484F73 + 7D4B535DFF450981A21D494FF95CFF41B7E37E7B9C6FDF5F8BB34D6A7D7610DC + 0FD8E68F81B1FA97D0FEB7E5777DEC55AB75A3D3EDE284F5BCA7F4785FDEF396 + F0193DF85C183EC6ECA5C18E29DA41DB8B7374585F145957D04F380EC1F1673F + 9CEFC7CFC3F3BC0078E7B2DBB8AEDDAA7BFE153E2F099FD183CF8551C87A29BB + 1FFFDBCB794C3B2CCF1C64CD3988FB4E98A78B6D3F0F7B07A4CE1B86AC1D95D6 + B89BD0AC46E7F5D95A9BE1337A30374851737C5857705C8E5C703F12FA1CF75B + 1CAB613FE9EDBCDB6BCC1813C784384667F601E62A6C2EF94DC4CEC9C7DD6675 + 15D4F4FC447C76153E2F099FD1A3E8F34571FC807B10316F00E755313702C72E + 393046C37BBBAA7E19CE83E1BC13AE4FAE041FCD8171048E45718C88E3200572 + 9078EA5150D6B0910DE2DD6A7CBE283E470C9F5D85FD0165ACA14AE637965CDD + 4376C37810C773D81795672F3BD627741ED60B6C23D04D38DE9E7F713BF9F4D0 + 37BCB71395B92A6CC7D8C576D323746A731E323E470C9F5DC5C533646BDAAE44 + C1F818D75186C2B805E7B370EE7BC7DD53CC9A04EE552F1FF8FF901DF697B0DF + 8AE72AF43990C2F4B1DB2A2FAFE8DFF02D938EBB8D8F73E2E2BC704B375B9BA8 + 9C096922157A064E343B6F1E0FFD65CC99C2C079AB2E7BE7306B1BAA74863BF4 + 536F07CCFF5F77AECE6FC767BAB55EDADD0BFA5AF9BCF67F3533FE146D1E333B + 6854903697CF9B3077B5D50F5835A43378EB3A9B8B42B9C8AC13CCEB8B88EC89 + 1B5A8EEF62C1C7F3582C3D9A99072E1D92004C6E47E6249F12D133C4A59E5709 + F17778F6C41CB7B15D9AF0F9BCA2FA3E2DEA07A4268CF39EF15104F8EB1CBDFE + EFB078225C39ECCBF0EC09792E89B12E8A789E97B5BF838D9EB9B18147528F58 + 78FF93F4ACFD5216BF038B458DA23CED9C06B6F151F4F3EEF03962EE63BBB481 + CFF1038E3FEB727B818E12AE4AFCA251B4979DB29E3F88CF740BCD1CF1193EBB + AAAEB7256C7B91E79410E3ADCCE7A51A35B4320ECE1885E7D1DCADC37DAE17E1 + 5B26E6B88CE8E8AC0ACF13C667BA05678CEC8273C9A2BAF5DC5474C29FC062A3 + EBB8CECD54E979DBF84C37E1EAC41018C7EFC1BD897580C5BF5139C9B7DBAE9F + 34CB6D623C270F41E7FA79F4F84C377C8E9870D5B045F8BC24364FE56F0D6280 + 7D9647383718B175D289902FFB778F8F8FD7E6EAFA71CD4352DEF377B00A593E + B49FE0EBBEC1ADB74FC1B3837ED380B6A5283237F97848E68851E1DB27A67A8C + EFE6C2F575E38B07F3AC8400176D037313ADE049BD2C7CE6F4E907DF673FE671 + AB2107CCD7BC82EB7A1E9FF71434EAE4AFED3CB1B30E1FD78C4F1E6FADFD5A99 + E9E2337A604C3F292A2709F7BA3F50F5FE31BB7FEF22E61EB88DEB1A276D8D55 + 1D79943EEFA5A1A59ECBE0764E5E333E1A15919BBC0DBEEF4DC939FF2AC0E01F + 368713736A8E607E14E6E4601E88A2AE8FA27958D83732085D9D181CBA6EF4BA + 48711D79C1B278A3227D573CF3169F05FC27E6AA617E54C59C1C4DE2513A27E9 + EF6014943E2244B829314D98919814B277C471B66D295142BB8FF5E22FCC33C7 + DC66CCA7C51CCEF279839ACEA3B4E073611A6969E1F32F82970F89102E1FBA28 + 387DC4193CCF9C59C711F795B95A6B91B457AFD93AF918F725E15E18DC7FC1E4 + FC639E79A1F22E87D2795436AE6CFE816140EA20DFC0B4418978867668D6C853 + 7856B02897C903BB2D12EFE1C2BDC07FE01977ECB52D2E17CF58964FD9B1C26F + A2DCE41B61EBC79C8EDC3EE9E780B484BDB87712F7EBE11E3155FAEEC8E3F4E9 + D3CCABAA46FBB17DF482A2C2B4071F5F5C6F507E9AE7C082D4CE780E279EFD08 + 3133213F6DC1C0FCB4343652E1BFE74224E1D92C107D130EA7450C2A4C6DDAF5 + 8BC106FD77CF3551E5EFDABB776F2D4208E7F1DFCB3FCCDEDC3BEE0AE1F2EFBD + E36E1A198FCE3AF071EDF888D7B7768714A5DA1D84F8A128ADF9514D8C927591 + 1BD485C79B5BBB3B028B971045F0D9892606F0B84679501E948766F27896DA9C + 3C5AD4823C58A85EF110E2C9372D348EC7DD147BB276A43B491DE4A956B174B0 + 07C99BE8A2713CAE7EE94086C6FB91CE31812A17B19D84A4ED87A124B6A3F09D + BF8B6F1740BEEEEF4579F01C1DDB07914E6D03814318F14CED4A1CB23F22FE73 + 3B920E5D83290F2544CC476124365648FCBEE848F45E8F23BA643CA9F7CB5012 + 323186F25042B48B0B61EA48F0C4B6C4E0EFB10C8FFAD7069388A15194871242 + 34209274E81C4C5C337A302C304C7F1F417C1774A63C9410D87E77EC104482A6 + B523264F4712C3E2D1A4C185041236BA35E5A1E4BE9560562C71C9FA907117B6 + F17581C7F5AF1CC8989EBEA4576C805AC5C79D0464D1404F8DE3711FC6B95BC6 + B9918CE12DD52AB246B42407A738D3F92B3A7F4579501E9407E54179403C5DDC + 829C9BE3484ECE7052AB3835D389E9ABD3F1876A041D0F2A783C182B246163DA + 9080991D48C49028D2A91DE5A1CCC0F178FBB810D2B667E83B73ED9487E2D73F + 5A7F1C4E9A1CEC4BEAFD3A8C386DE845DAC587501E4A88E8BEE1CCDC95E7926E + A5F3BBE60F8613C1EC58CA43293C22C43CD2BA11BDD7E2F50F8B7B89246016E5 + A1145F75607DF5BF56A4C9A1BEA4C1C504E2B4B12769D72394F250761FABA390 + C4F40E6318D595F6FC97F9F66451822799F2B1B75AC5E79F7893EF47B96BE4FA + C7B85EBEA47747815A45DFCEFE647182E6AD7F608E1FCE3D144E7756AB380271 + 69AE239D4FA4F38994471DE2F1D7B7E236FDE6D70E6A15B720EEA5685E3EF5AF + 0BECC9B2211E64EEA7DE6A155F415F77CB58373AFE50F07C6274BF083A9FA842 + 738B3877D2A95D10E5A1C47A81AF98331A322186787EDB95B41A11FDCE189DF2 + 50503E7577365F34B91DD17F259E4FB4BA3184840F8FA63C9410519F89F3A9DD + 56772F9D6F377B3C9CF8CDEB447928A37EC48730F5035D65796B2893DB6E73B4 + 1FDD6FA0ECB63C56C830F149E9C2B8AAAEE453AB6C3E436721F19DDF99D86FEF + 4D02A7B7AF333CAE7DE54086F7F02371F0FDD4297A760820F33FD3BCF9DD5FE7 + DB9325303E9F0D635E758A2FA06E646BE0F89CCE27521E9407E5A12E3C1E2E6A + 41F64E7661F648A9536C8338365DF3F647FD952A3EC304D740D42DF04C193AFE + A0F9ED7572FDA35D10737646F4A711A46D8F503A3E57620E1C5EFBA8FE91C4E6 + 587F2657D47E5B6F12D32B8CF25046FEEEA7E2FC5D8F657165F3BB0F8713FFB9 + 347F5719D1A64F2BA68EF8CEEB440C5E8E21BAFF8D279677861261723BCA4319 + ED06BBFF23A667287159D783D8EDFE98782DEE4ADA77A3FB3F9499DF1ED52F82 + 585F1EC4AC7F34DDFF096D3F54203A741692D69F86337B09EB4A7FF7C6D70E24 + B98F0FF9ACABBF5AC5A0383FE64C4B4DDD7FFEE30C27B58A931ABAFF9CCE2752 + 1E9407E54179501E9407E54179501E9407E54179501E9407E54179501E9407E5 + 4179501E9407E54179501E9407E5519B285ED282142F7723251941A4385D404A + B24299285EED478A973A521E0AE4C1B058E34F5EEE194AFE399F495E9D5E4A5E + 5FCF25AFAFE5905727169017D95D48F13267CA43513C56B4242FF78D20AF6FE4 + 91D7B7F6BD13FF9CCF202F3675A43C14C403BDF4FAD2FA4A593071338FFC5D30 + 95A923C52BDC280FBE796408C93FE7564BE7716317F9FBE044F09A3DB4250E94 + 07DF3CBE8B82EBBE573A0F8857C7E791E2555EA418DA7BCA833F1ED896BF58DF + 1A9CB45B0E1E3EA4243398F2E0DD5741E49FB3ABA4F3B8BE93FC7D6002E3AAE2 + 654E9407DFFDABE5AEE4E58EBEE49F9F378ABD7573CF5B6DC7AB1F53C069D1B4 + 7FA5C8F120F4795FECF81F78E96BF2EAC86CF2EA542AC462F2777E3229019F15 + 2DA1E34145CF9730E3C2951E4CBF16FB5C251981BCF889F29097873D2981713A + 8E314AD6B7611C852EA33CE87C22E54179501E9407E54179501E9407E5516778 + B40316BF433C80CF5EA489013CCEAA0D8FBB475D4B36769853B2A1C3CC171B3B + 7CAD89F1326FC0783EAEDDE3C78FB576EEDC5965EC3F704977F7EE43DA474FBC + 3138987F43E7F0B1677AF2FCBBBA18FBF69DD4CECBDBAF75F4D86BFD8385F7F5 + 0A8E171BC8F3EFF2F3F399D7AA8AA151335D17AFCDC2660EB36D03A38A47BAF9 + EF6EE51B7EEB23EB0FBA1A68D1F256D1D3B3D676705EEAD8ACD9D4FA4111CF07 + BB079FEAE61D797FA0B5EDC7C655FD5B575757B978E8E89868377598696B69DD + C64C185D1C60EFBEB4B177D8055703A3C63A94C0DB455BDB40AB51A30196F5EA + 85190A5B3DF772F4DFE9EC1971D3C7C0D84EB7B63CB05E200B5BBBF1502F4ABE + 098A2A49081015FF1A105DB45C105574B465D06181B1A9938EB955B05E5DE7A0 + AFDF405B5BDB50AB61A3FE9641E1CFC7018B1E82A8E29B82E8E25DF07AD123EC + B2C8D4DC5BDFC2AA95414D7894396A16B2580C1C8A21FE08882A26F0FB8BE1F5 + 3530392C76D7ED5EF5EBB0BB1847392D756CDA2C191D3505AECF53880778AD20 + 5E41FC1B1055F2B357D04FDD04E1F707BEDFA87277C9E251DE51502F06322C44 + C577591E4FC5EF53B4C1BE25E32E1703235B9DBAEDA881E0A850C3E056CF3AC0 + F5F915E21ACBE305C41BE071D8CD77978B7FD82D5FBCD7E5E55189A390C513F6 + 77578C17E0AE156277150A8CD05D9642BDBAE7A87EE51DF5AB946BF51AAE671E + 70B9E01B72258A71976598812C1E124761BD4016E51D252D2A77571783BAE1A8 + 25E0A8242B7054720547498B8AEE1AD0A0511F63693CB05E607B5199A364F060 + DC2560DCB5CCD63BEC629D7017E3289B044B8B3247FD56CE5144AA4F5877B9FB + E6A1BB7CCABB4BC2A382A31657E1285295BB3C4ADD15A4A7B18E6A58EAA8EE32 + 1C45E4739717B82BD40079E0B8BBBA8EAAC25D6FD05DEE7E7BC27C5BDDEEF9DE + 7B5DF43587C57BACA32657C751B2DD252A75D767E1A2D9C6380782E36ED65109 + F2384A0E776DB46FB9DCD607DD6560ABAD798E0AA98EA364BB4B04EEF2DBCDB8 + CBDBB7ADEE91136F0CE0FA8F0814150BE0F5971AFEEE77DE2B30B2684580A8E8 + 8897EF113F6363471D0B8B205D0D72547C0D1C25B59E044615AF866B9FDFABFF + 8BF7F61FBAA1E3E8B33BB4A9CB121BBFC8E7CBE0EF8B6AD0764875173039DCD2 + 6B4FA87FF0ED1ED6D69DF5D5D6514D27A1A3926AE9A8777C05BFEBB257C8F95E + 7E91F78747B55F6E947FE499AE67C8AD9E6E81E79D05A2A2426C6BD89FAD2D0F + F19831B268A393F30A1BFF808B4E060636DAEAE9A8419616169C38AA7CFCCB5E + A7277E910F6708447FAEE9DAFB9219F6AF2C1B74D5D737B4D576F63BEC0F4C0A + FC238BD6C3CF96F0E52E73F3405DF571D4A77C380AEBC5158887C06256138764 + 63078F55A6EF8C074D9C58772DB5F1E7D75DDD55D95D124735693AB1BCA3EE73 + ECA88FC051236C9A8F3292361E34AD17CC97BBB0FFFC0FB86B9393F34A70D725 + 95765799A382F974D4E7E0A87417DF4D66B2E6AFEA35E82271971FEBAEEFD9BE + 19C7EE3AEA2B765780AE0A3B2A0EAEDD2F1C3BEA51A9A33C579BCA3DDF5EEAAE + 654CBF0B9DC3B6D1DCB9CB5BE2AE4EFA2AE228A7264D27A0A326F3E528FFC8FB + 236D9A8F36AAEE7CBB693D21BAEB43B7C00B4EACBBDE70EFAE55E82E47557017 + 3ACAC666B0C451B1ACA3AEF2EDA8EAAC0F96BACBBFD0CF1FEE67880D1CBB6B25 + BACBBBD45D025D6539EA83324775E3D3518E151C551D1E15DC15D6D465B98D9F + E8F90ABEDC2508BE1D6F6DDD515FB18E4A736AD2643CCF8E7A30CAA6F918A3DA + AE9F97BACB2248D703DD1574C109EAC8111EDCB5D9C96535EBAE46DA8A75D410 + BE1D355D96A36AC243ECAECE15DDB5911F771DF33136760077F9EB2ACE51CFF8 + 72D46CB1A3D698CAF3B9AAC3A3D45DE079A6DFE5FA96BBFEE0D65D7BD15D717C + B84BE2A8C64DC659018B49780FF3E4A8D1B67238AAB63C4C2D02D15D3DDC822E + 9677D73F5CBACB9971D7CFBCB88B7194ED5045382AC3D9A76A47D59607E3AEF7 + D05D36E5DDB5894377BD2C75971F77EEAAE0A8F1E0A8AE3C38EA7199A3D2CDAA + FB196BCAA3A2BB9AB9AE5080BB62F56BEFA8B17C39EA0AEBA831B6CDC71AD5F4 + 73D6968789D85DDD797457B6B3CB1A7497436DDC55E628A101EBA8BB5C3BCA3F + F2E1B49A388A4B1E627775D2D73740771DF1E5C95DABC4EE3ACEB8CBCCCC4FB7 + FA8EEACBBBA31AA3A3BC32CC6A732DB9E0F1B6BBF680BB56A2BB56F2E4AE1070 + 573779DC55E6A831E8A889ACA3EE71ECA8DE8CA35A8C33E2E21A72C9C3C42240 + E22E478EDDF56799BBD2E57697D851C3248EEAC8AFA3369AA91A0F29EEDACC93 + BBBC8D8CECC15DBEBA7238AA0B7F8E4A0247659A7175FDB8E651E62E07D65DAB + F8725721EBAEAEF5EB77D07FC7518D475BF2ECA8B15C394A113C4C2C04E0AEDB + F16E4197F872D71667970C70D765705743EDB71D95C8B7A3A682A332B9729422 + 7888DDD511DCD548DBC5FFA84F3977BDE4D05DABC5EE3AE18DB95D188A729493 + 5796191FD78C4F1EEFB8CB6D356FEE12B67ADE078367478DB36D31DE88CF6BA5 + 081E26E6FEE8AE383EDD1512F6CC15031CD549DD1CA5681E52DC95CDA5BB0244 + 4CEEC735666F23478E82DF75055E1FFB8783A3ECF973943278BCEBAE35E8AE55 + ACBBFEE4E81A12AE1C852C7C02CF7F24087B30AE4993F1868ABA3E8AE66162EE + 2771970397EEE230FE655F9F08C21E260B22FECC7073DB60AAA93CC4EE8AD5D7 + 63DC75CC07E74070DCCDA1BBB870D4EFC06276D3A64946AEAE6B4D14796D94C1 + 4352706E10C774380782E36E25BAABA2A3C6376932C15019D744993C709E16E7 + 06713E2A40B9EEAAE8A84C453A4A557860C1795A9C1BC4F9281C4760DF55C1EE + AAE0A8C9E0A875A6CABA1ECAE62129383728765706BA6BB502DC55D1511394E5 + 2855E481F3B4383788F3510A725779472529D351AAC8030BCED3E2DC20CE47F1 + EC2EA65E08C42C94EE2855E52129382F88735138FFC18EBB39E5011C5E08229F + CF13888AF6B6F43964A64ADF5DE57944F1C32320E2F97CE4E1E94D79482BB896 + 84EB17EC9CF9449C1BE4703EAA7CFCED2F7A9E013C8EB9087EF434306AAE6364 + E6A14B799467D18059D7C3B5245CBF60E7CCEFF2D59E4BE6EAFDA19D72F2FD21 + D823E476AC79FD183DCA43B2AE67A8856BACB8AEC7AE25DDE368CE5C1A8FBFB0 + FF063CB6376FF99D8D9BF0720B3D830FB4EB3A8F4A1CD591C3753DB9DCE5277A + 9E8E739B2E01273D187799B6D4AD8B3CCA1C354C218E92D35D42705707F3FA6D + F4EA1A0FC6514DC65829CA51F2B96BBD8DBB12DDA50C1E2AE02859EECAA8E02E + 1D4DE651E6A8A14A7554F5DCD55A4F5379881D3556E2A8AECA72941CEECA69DE + F27B85BB4B513CCA1CC5EC8599C4E6FCFFC2E1DCE00B36FEE6CE5D458CBB5C03 + 4E81BBECC05DEE3A9AC0438AA37EE372CE3C30E2F93C88F981914519EC5CFD5F + 1CD495923277ED4777B5E7DB5D8AE02176D4382BDCAFC73AEA3E97F951CCF943 + 91457B9910151DE330BFEB5999BB3680BBAEF0EE2E3E79F0EE28F1BA1E3367EE + ED7DC80CC3C7EFA42733570F7D579EDCD552EC2E371D75E251EA289B21CCFE6E + 3E1C255ED77B9884EB1765EB8CCD753CBC7F0876755B8FEB8CE95CB92B40726E + AAA8E830B82B08DCD5D6BC7EB49EBAF04047E11914ACA3BA71EE2866BDFBC104 + 5CD72BBF96646AEAA12B08BE132B08B8D282D3754691B8DF25882CDADEC26323 + BAAB391FEEE29AC75B8E8A783E994F47E17A77656BAC5656317AFAFA1F68FBF8 + 9FF2E0C35DFED867807AE21AF093BBD85DAE3AAAC843ECA8254E786611EBA8A7 + 3C392AB9BCA3A415B1BBF60B5DDDBEB7E1B2DF55A9BBACA2F4548D07E3A8A613 + 58473DE7CB51E32B3A4A5A61DDD5814777E5B4F0D8C4BAEB7D6D55E121715443 + 253A4A5AB1B26A53D15D39FCB9AB998E9149EDDC555B1EACA31CF1EC47FE1D95 + 54E3BD3065EEDA207157093BBEE0D05D0702C15D31E656223D65F1103B6AA2C4 + 51713C38EA31E6FC639E796D729B4D4D5BEAF0E4AE6765EEDA5C6B77D5944705 + 4725B167A2F2E4A8F1865CE4AA29C05D9962779D66DC6568E2A2A3081E0A74D4 + 94DA384ABABBECC4EE72DFC8B7BBDA9855D35D35E1818EC2B3E5F13C73F60CED + FB5C9E15CC3A6A2C3ACAC5258BF3FD172626EE3A02E19DF63CBA6B470B8F6CB1 + BBF4ABE7AEEAF0287354BFF28EE272BFDEE5B71DB591B71C4E2BABD68CBB7CFD + 7F6AC9BA6B074FEE7233306A0AEE72D6E1924799A312D4D251B2DD7540E8E6BE + 09DD95C9A1BB4A5877153AFB1E4477B536B38AD4E38A07E3A86693ADF0B930AC + A31EF0E0A8317C394ABABBDCC05DB7DB0902AEF2E72ECF2D72BBAB2A1EF84CB7 + 728E4AE6D751E37875947477459777D7111EDC952576D7992ADD258B87021D35 + 55918E92E92E9F03416EEE9BF97397DFC1008F905BD1E6F52374ABCB43ECA824 + 2B7CBE1EFB4C371E1D9569A26C1EACBBDAF2E8AE5C7BCFAD32C78C95F1287554 + 23DE1D354B598E92562C2DA358779D7667DD95CBA5BB04A2E7E8AE8296C1A75D + C05DDA46264E3AB278881DB5D4119F8DCBA3A37A018B69CD9A251B69A9683134 + 6CC6BA2B1BDD95C583BB0EBB0A0E0ABC5BDD1299D70FD795C643ECA8E4FAF5C4 + 8EEAC183A31E81A3468B1D9561A2AA3C4C4C5CD15D31E0AEE60165CFDAE0CE5D + 50EF1C7DB736F20CBBDCACBCBB243CCA1CD51F1D35855F478D05476D32D552F1 + 2276D7FB0A70D7197057137097A30EF2D8B7EFA4B683333A6A407947FD5AD71C + 25D35DBE0783DC5A6EB109882E5ACBBAEB3997FD2ED700C65D9101218374F3F2 + F66B356B36151C15C6A7A34681A3D25D5CD24DD48D8789898B8E2018DC1578B5 + B920AAB4DFF59A03773D97B8CBC9771BE32E4FAF70EDA3C75EEB83A306030B2F + E070930F47356E3C462D1C25ADD4B316E9E983E7BD42CEB44426103B3974D74B + 70571A70D9D3BDDF73F38385F7F5DC834F7573F4DFE92C882EDEC57AE605478E + 9AAE8E8E92EA2EE3663AEE8107835C7CB7DAA2BB026AE72EAC67FF05884AEEFB + 86DE1E27087F92D2AE735EBD82E3C506DE91F7077A46DCF481DF7D91F5CC9B5A + 3B2AF4C1487494B3F31A134DE1616CEAACE317713BC637FCAA3DD491C25ABAEB + 3FF6F5B920E2E92241E4F3ED711FDDB1C6FE95B5EDC7C606C676BA1E619745C0 + E46788821ABC8F46394ABABB22C5EE0A2D75D7AE1AB88BA91762167FACB6735A + 58CFD57BA775C5F187B18537BAABABA3FF2EA76AB84BA31D25D55D464DC15D87 + 825CFCB6350677AD93D35D6F3B2AE2698A9D534A3D69E341B3FA61E8AE01E02E + 6FF8DD17E474573947DD1F2176D46A134DE7C1BAAB4D35DD55DE510BD151AE3E + BBAC65CD5F89DDD5ACBCBB0ECB789FF28E9AD9B8F1688D74945477D58F60DCE5 + 1D7AD6BD9CBB5EC9E7A8947AAE3E3BADE59DDF35367FCB5D7915DC55271D25CB + 5D2DC15DAE7EDB2B735799A3C218472D6CEE5CE6287979985985EA83BB3E93E2 + 2E89A31E82A38683A3D6D4054749779713BAABB514779577544A0038CADDF7ED + 7A21EFFA607D9B3E1277459673D7ABB71D35AA4E394A5AB178D75D794CBFAB9C + A3B05EB8FBEEB2AEEDFAB9B1B917B8EBA7AE4E823C2760B20A1CD513587C5E97 + 1D5585BB025DFD721A0744152D651DB5A885F3C27A55FD5B797998598580BBEE + F5F788B889732AF9E0A844B1A3569950026F17235347745734B8AB05D491BD82 + 88278CA3DCA438AA228FFCFC7CE6B5AA088D9E65ECE5DB56B77BBF92FAAD5B2F + 378C8FBF642ACFBFAB8B11143248CFD33B42BBE767C5961DBAE4D58BEF73C75A + 9E7F171B1B4B6F685A68A185165A68A185165A68A185165A68A185165A68D1F0 + B2796D4A2B428836BD12CA2F5BD6A60CC8CE4AF92F3B6BE172CA4435586C59BB + 90605026AAC38232513D169489EAB1A04C548F859807FCDCBA45E1F4AAA9080B + F8797AD5DE2EDB33E73B6C5DB7C84F9ED89231CF89B2E0AF6CCD5C18B7252BE5 + 8D3CD79009FCD9AC945E94050F2CD62DE8B8256BE12BB95948614259D4BE6467 + 2E6A5B2316159850161CD48BAC8551D96B534A6ACC828DAD62CFFD4E59D486C5 + 82302E58948B373086784259D4A02FBA2E4598BD76E1730E5954C9A4AEB3189F + D8B5F1A4E1F1472625C6BB95FFFF9B3216F8437BF1170F2CA432A12CBA369E9C + 18777DF2F078024C1E49986C5D9BE20D2C9EF2C8E21D269445190B492093B479 + E33A413FE8B10258943211B7F194457916929832A6E7EF9B32E7DF50200FA963 + C63AD35E24C65FAB8C0565A2D8327648F78655B1A04C1457A64DEB6E3029316E + 8B3C3C94C9647BE637CD2913D561B275ED7C0F4D6E2F268E8A775027269ACAA3 + 5CDBFD5BF2F06E8EEAC244137954D28F521B269AC643469F562D9868120F5963 + 3D7561A2293CE460A1164C3485075CCF65F25E4FF8D9BBAACA4453784CFBE413 + A3C9C3E3F2D49D8926B51F9AC044D3FA57594B67F9CE9B3EF8A43A32C9CE5AF8 + 5A93E64BC46B49298FB3B352FE9EF779ED99C0DF652B8C0993BF92D24D635860 + 3E60B9753D7562829F155E35E66024CC3DA86CBD5B1D9860FECAE67529311A53 + 2F989C1CE97920AACC8461B17651A4E6B0902F574D1599E03D84F792A6B06073 + 385F54C7D1D5653271E8874EBC3041B78263358645564AA79AE4D32A83C9D4D1 + 3D9FBCC504FA1CD8F7D01C160BE26B93DBAC5426D017C73EB9268DF7AAB5FF42 + C5982CFD7A4C474D5B6BE26A5E42194C260F8F7B9C3C32CE9DF2A04CD48187B2 + 98600E37E5A11A4C98B5E451F1B69487F299681A0B3E7970C904AEFBE64ADA8D + AB9AC6826F1EFC31D14C168AE051132670BDEF4967A2B92C14C5834B26D30675 + 7D5F4B838B22739BB960A2E9654B56CA1D55675271AE5E93CBD6F52976AACC44 + 13FBB4EACB44B3DBEEAA986C5D9BF244E14CA4E612D55D160C8FB50BFBCB7B36 + 0B87FBC91EAF4B9BEBF76ECE1D65A16816F07E7F48D692DECE83A42C145F2F16 + FE959DB550F0D6D8029840DBBD64DCD09E36948502EB05E6126950EE0157253B + 6BC1678A6781F95129ADE8D5AF390BFC39A8474F3870D48BCDEB1644D3AB5F4B + 16EB160DACF5F8449CDBDC8E5EFDDAB3A8F59811586CCD4CE942AF3E772C6ACC + 047389D62DEC4EAF3EF72C68A12C280BCA82B2D0FC82CF50A0E736AB4EC1678C + E0B346280BF5614259A80E13CA4275985016AAC384B2502D2674AE9B165A68A1 + 85165A68A185165A68A185165A68A185165A34BFFC1F558FF11B + } + end + object SynSQLSynUsed: TSynSQLSyn + DefaultFilter = 'SQL Files (*.sql)|*.sql' + Enabled = False + KeyAttri.Foreground = clBlue + SQLDialect = sqlMySQL + Left = 50 + Top = 298 + end +end diff --git a/source/main.pas b/source/main.pas new file mode 100644 index 00000000..58515880 --- /dev/null +++ b/source/main.pas @@ -0,0 +1,15100 @@ +unit main; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Forms, Controls, Graphics, Dialogs, Menus, ActnList, + ComCtrls, ExtCtrls, SynEdit, SynHighlighterSQL, laz.VirtualTrees, + RegExpr, + Generics.Collections, Generics.Defaults, + dbconnection, dbstructures, dbstructures.mysql; + + +type + + // Bind parameters for query tabs + TBindParam = class(TObject) + Name: String; + Value: String; + Keep: Boolean; + end; + TListBindParam = class(TObjectList<TBindParam>) + private + FPairDelimiter, FItemDelimiter: Char; + function GetAsText: String; + procedure SetAsText(Input: String); + public + constructor Create; + procedure CleanToKeep; + property AsText: String read GetAsText write SetAsText; + end; + TBindParamComparer = class(TComparer<TBindParam>) + function Compare(constref Left, Right: TBindParam): Integer; override; + end; + + {// Query tabs and contained components + TQueryTab = class; + TResultTab = class(TObject) + Results: TDBQuery; + Grid: TVirtualStringTree; + FilterText: String; + private + FTabIndex: Integer; + public + constructor Create(AOwner: TQueryTab); + destructor Destroy; override; + property TabIndex: Integer read FTabIndex; + end; + TResultTabs = TObjectList<TResultTab>;} + {TQueryTab = class(TComponent) + const + IdentBackupFilename = 'BackupFilename'; + IdentFilename = 'Filename'; + IdentFileEncoding = 'FileEncoding'; + IdentCaption = 'Caption'; + IdentPid = 'pid'; + IdentEditorHeight = 'EditorHeight'; + IdentHelpersWidth = 'HelpersWidth'; + IdentBindParams = 'BindParams'; + IdentEditorTopLine = 'EditorTopLine'; + IdentTabFocused = 'TabFocused'; + HelperNodeColumns = 0; + HelperNodeFunctions = 1; + HelperNodeKeywords = 2; + HelperNodeSnippets = 3; + HelperNodeHistory = 4; + HelperNodeProfile = 5; + HelperNodeBinding = 6; + private + FMemoFilename: String; + FQueryRunning: Boolean; + FLastChange: TDateTime; + FDirectoryWatchNotficationRunning: Boolean; + FErrorLine: Integer; + FFileEncoding: String; + procedure SetMemoFilename(Value: String); + procedure SetQueryRunning(Value: Boolean); + procedure TimerLastChangeOnTimer(Sender: TObject); + procedure TimerStatusUpdateOnTimer(Sender: TObject); + function GetBindParamsActivated: Boolean; + procedure SetBindParamsActivated(Value: Boolean); + procedure SetErrorLine(Value: Integer); + public + Number: Integer; + Uid: String; + ExecutionThread: TQueryThread; + CloseButton: TSpeedButton; + pnlMemo: TPanel; + Memo: TSynMemo; + pnlHelpers: TPanel; + filterHelpers: TButtonedEdit; + treeHelpers: TVirtualStringTree; + MemoFileRenamed: Boolean; + MemoLineBreaks: TLineBreaks; + DirectoryWatch: TDirectoryWatch; + MemofileModifiedTimer: TTimer; + LastSaveTime: Cardinal; + spltHelpers: TSplitter; + spltQuery: TSplitter; + tabsetQuery: TTabSet; + TabSheet: TTabSheet; + ResultTabs: TResultTabs; + DoProfile: Boolean; + QueryProfile: TDBQuery; + ProfileTime, MaxProfileTime: Extended; + LeftOffsetInMemo: Integer; + HistoryDays: TStringList; + ListBindParams: TListBindParam; + TimerLastChange: TTimer; + TimerStatusUpdate: TTimer; + function GetActiveResultTab: TResultTab; + procedure DirectoryWatchNotify(const Sender: TObject; const Action: TWatchAction; const FileName: string); + procedure DirectoryWatchErrorHandler(const Sender: TObject; const ErrorCode: Integer; const ErrorMessage: string); + procedure MemofileModifiedTimerNotify(Sender: TObject); + function LoadContents(Filepath: String; ReplaceContent: Boolean; Encoding: TEncoding): Boolean; + property BindParamsActivated: Boolean read GetBindParamsActivated write SetBindParamsActivated; + procedure SaveContents(Filename: String; OnlySelection: Boolean); + procedure BackupUnsavedContent; + property ActiveResultTab: TResultTab read GetActiveResultTab; + property MemoFilename: String read FMemoFilename write SetMemoFilename; + function MemoBackupFilename: String; + property QueryRunning: Boolean read FQueryRunning write SetQueryRunning; + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + class function GenerateUid: String; + property ErrorLine: Integer read FErrorLine write SetErrorLine; + property FileEncoding: String read FFileEncoding write FFileEncoding; + end; + TQueryTabList = class(TObjectList<TQueryTab>) + public + function ActiveTab: TQueryTab; + function ActiveMemo: TSynMemo; + function ActiveHelpersTree: TVirtualStringTree; + function HasActiveTab: Boolean; + function TabByNumber(Number: Integer): TQueryTab; + function TabByControl(Control: TWinControl): TQueryTab; + end;} + + {TQueryHistoryItem = class(TObject) + Time: TDateTime; + Database: String; + SQL: String; + Duration: Cardinal; + RegValue: Integer; + end; + TQueryHistory = class(TObjectList<TQueryHistoryItem>) + private + FMaxDuration: Cardinal; + public + constructor Create(SessionPath: String); + property MaxDuration: Cardinal read FMaxDuration; + end; + TQueryHistoryItemComparer = class(TComparer<TQueryHistoryItem>) + function Compare(const Left, Right: TQueryHistoryItem): Integer; override; + end;} + + {ITaskbarList = interface(IUnknown) + [SID_ITaskbarList] + function HrInit: HRESULT; stdcall; + function AddTab(hwnd: HWND): HRESULT; stdcall; + function DeleteTab(hwnd: HWND): HRESULT; stdcall; + function ActivateTab(hwnd: HWND): HRESULT; stdcall; + function SetActiveAlt(hwnd: HWND): HRESULT; stdcall; + end; + ITaskbarList2 = interface(ITaskbarList) + [SID_ITaskbarList2] + function MarkFullscreenWindow(hwnd: HWND; fFullscreen: BOOL): HRESULT; stdcall; + end; + ITaskbarList3 = interface(ITaskbarList2) + [SID_ITaskbarList3] + function SetProgressValue(hwnd: HWND; ullCompleted: ULONGLONG; ullTotal: ULONGLONG): HRESULT; stdcall; + function SetProgressState(hwnd: HWND; tbpFlags: Integer): HRESULT; stdcall; + function RegisterTab(hwndTab: HWND; hwndMDI: HWND): HRESULT; stdcall; + function UnregisterTab(hwndTab: HWND): HRESULT; stdcall; + function SetTabOrder(hwndTab: HWND; hwndInsertBefore: HWND): HRESULT; stdcall; + function SetTabActive(hwndTab: HWND; hwndMDI: HWND; tbatFlags: Integer): HRESULT; stdcall; + function ThumbBarAddButtons(hwnd: HWND; cButtons: UINT; pButton: PThumbButton): HRESULT; stdcall; + function ThumbBarUpdateButtons(hwnd: HWND; cButtons: UINT; pButton: PThumbButton): HRESULT; stdcall; + function ThumbBarSetImageList(hwnd: HWND; himl: HIMAGELIST): HRESULT; stdcall; + function SetOverlayIcon(hwnd: HWND; hIcon: HICON; pszDescription: LPCWSTR): HRESULT; stdcall; + function SetThumbnailTooltip(hwnd: HWND; pszTip: LPCWSTR): HRESULT; stdcall; + function SetThumbnailClip(hwnd: HWND; var prcClip: TRect): HRESULT; stdcall; + end;} + + TMainForm = class(TForm) + actSessionManager: TAction; + ActionList1: TActionList; + actExitApplication: TAction; + ImageListIcons8: TImageList; + DBtree: TLazVirtualStringTree; + MainMenu1: TMainMenu; + MenuItem1: TMenuItem; + MenuItem2: TMenuItem; + MenuItem3: TMenuItem; + MenuItem4: TMenuItem; + MenuItem5: TMenuItem; + MenuItem6: TMenuItem; + MenuItem7: TMenuItem; + MenuItem8: TMenuItem; + PageControlMain: TPageControl; + Panel1: TPanel; + Panel2: TPanel; + pnlPreview: TPanel; + pnlFilterVT: TPanel; + pnlLeft: TPanel; + spltPreview: TSplitter; + spltDBtree: TSplitter; + spltTopBottom: TSplitter; + StatusBar: TStatusBar; + SynMemoSQLLog: TSynEdit; + SynSQLSynUsed: TSynSQLSyn; + tabHost: TTabSheet; + tabDatabase: TTabSheet; + tabTable: TTabSheet; + tabData: TTabSheet; + tabQuery: TTabSheet; + ToolBarTree: TToolBar; + ToolBarMainButtons: TToolBar; + ToolButton1: TToolButton; + //procedure actCreateDBObjectExecute(Sender: TObject); + //procedure menuConnectionsPopup(Sender: TObject); + procedure actExitApplicationExecute(Sender: TObject); + //procedure WMCopyData(var Msg: TWMCopyData); message WM_COPYDATA; + //procedure CMStyleChanged(var Msg: TMessage); message CM_STYLECHANGED; + //procedure FormDestroy(Sender: TObject); + procedure FormCreate(Sender: TObject); + procedure AfterFormCreate; + //procedure FormShow(Sender: TObject); + //procedure FormResize(Sender: TObject); + //procedure AddEditorCommandMenu(const S: string); + //procedure EditorCommandOnClick(Sender: TObject); + //procedure actUserManagerExecute(Sender: TObject); + //procedure actAboutBoxExecute(Sender: TObject); + //procedure actApplyFilterExecute(Sender: TObject); + //procedure actClearEditorExecute(Sender: TObject); + //procedure actTableToolsExecute(Sender: TObject); + //procedure actPrintListExecute(Sender: TObject); + //procedure actCopyTableExecute(Sender: TObject); + //procedure ShowStatusMsg(Msg: String=''; PanelNr: Integer=6); + //procedure actExecuteQueryExecute(Sender: TObject); + //procedure actCreateDatabaseExecute(Sender: TObject); + //procedure actDataCancelChangesExecute(Sender: TObject); + //procedure actExportDataExecute(Sender: TObject); + //procedure actDataPreviewExecute(Sender: TObject); + //procedure UpdatePreviewPanel; + //procedure actInsertFilesExecute(Sender: TObject); + //procedure actDataDeleteExecute(Sender: TObject); + //procedure actDataFirstExecute(Sender: TObject); + //procedure actDataInsertExecute(Sender: TObject); + //procedure actDataLastExecute(Sender: TObject); + //procedure actDataPostChangesExecute(Sender: TObject); + //procedure actDropObjectsExecute(Sender: TObject); + //procedure actEmptyTablesExecute(Sender: TObject); + //procedure actExportSettingsExecute(Sender: TObject); + //procedure actFlushExecute(Sender: TObject); + //procedure actImportCSVExecute(Sender: TObject); + //procedure actImportSettingsExecute(Sender: TObject); + //procedure actLoadSQLExecute(Sender: TObject); + //procedure actNewWindowExecute(Sender: TObject); + procedure actSessionManagerExecute(Sender: TObject); + //procedure actPreferencesExecute(Sender: TObject); + //procedure actQueryFindReplaceExecute(Sender: TObject); + //procedure actQueryStopOnErrorsExecute(Sender: TObject); + //procedure actQueryWordWrapExecute(Sender: TObject); + //procedure actHelpExecute(Sender: TObject); + //procedure actRefreshExecute(Sender: TObject); + //procedure actRemoveFilterExecute(Sender: TObject); + //procedure actSaveSQLExecute(Sender: TObject); + //procedure actSaveSQLAsExecute(Sender: TObject); + //procedure actSetDelimiterExecute(Sender: TObject); + //procedure actSQLhelpExecute(Sender: TObject); + //procedure actUpdateCheckExecute(Sender: TObject); + //procedure actWebbrowse(Sender: TObject); + //procedure popupQueryPopup(Sender: TObject); + //procedure btnDataClick(Sender: TObject); + //procedure ListTablesChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure SynCompletionProposalAfterCodeCompletion(Sender: TObject; + // const Value: String; Shift: TShiftState; Index: Integer; EndToken: Char); + //procedure SynCompletionProposalCodeCompletion(Sender: TObject; + // var Value: String; Shift: TShiftState; Index: Integer; EndToken: Char); + //procedure SynCompletionProposalExecute(Kind: SynCompletionType; + // Sender: TObject; var CurrentInput: String; var x, y: Integer; + // var CanExecute: Boolean); + //procedure PageControlMainChange(Sender: TObject); + //procedure PageControlMainChanging(Sender: TObject; var AllowChange: Boolean); + //procedure PageControlHostChange(Sender: TObject); + //procedure ValidateControls(Sender: TObject); + //procedure ValidateQueryControls(Sender: TObject); + //procedure DataGridBeforePaint(Sender: TBaseVirtualTree; + // TargetCanvas: TCanvas); + procedure LogSQL(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil); + //procedure KillProcess(Sender: TObject); + //procedure TimerHostUptimeTimer(Sender: TObject); + //procedure ListTablesNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; NewText: String); + //procedure TimerConnectedTimer(Sender: TObject); + //procedure QuickFilterClick(Sender: TObject); + //procedure AutoRefreshSetInterval(Sender: TObject); + //procedure AutoRefreshToggle(Sender: TObject); + //procedure SynMemoQueryDragOver(Sender, Source: TObject; X, Y: Integer; + // State: TDragState; var Accept: Boolean); + //procedure SynMemoQueryDragDrop(Sender, Source: TObject; X, Y: Integer); + //procedure SynMemoQueryDropFiles(Sender: TObject; X, Y: Integer; AFiles: TUnicodeStrings); + //procedure popupHostPopup(Sender: TObject); + //procedure popupDBPopup(Sender: TObject); + //procedure popupDataGridPopup(Sender: TObject); + //procedure QFvaluesClick(Sender: TObject); + //procedure DataInsertValueClick(Sender: TObject); + //procedure InsertValue(Sender: TObject); + //procedure actDataSetNullExecute(Sender: TObject); + //procedure AnyGridCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; out EditLink: IVTEditLink); + //procedure AnyGridEditCancelled(Sender: TBaseVirtualTree; Column: TColumnIndex); + //procedure AnyGridEdited(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex); + //procedure AnyGridEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex; var Allowed: Boolean); + //procedure AnyGridFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: + // PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); + //procedure AnyGridGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex; TextType: TVSTTextType; var CellText: String); + //procedure DataGridHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); + //procedure AnyGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); + //procedure AnyGridMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; + // MousePos: TPoint; var Handled: Boolean); + //procedure AnyGridNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex; NewText: String); + //procedure AnyGridPaintText(Sender: TBaseVirtualTree; const TargetCanvas: + // TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); + //procedure menuDeleteSnippetClick(Sender: TObject); + //procedure menuExploreClick(Sender: TObject); + //procedure menuInsertAtCursorClick(Sender: TObject); + //procedure menuLoadSnippetClick(Sender: TObject); + //procedure AnyGridHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); + //procedure AnyGridCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: + // PVirtualNode; Column: TColumnIndex; var Result: Integer); + //procedure AnyGridHeaderDraggedOut(Sender: TVTHeader; Column: TColumnIndex; + // DropPosition: TPoint); + //procedure AnyGridIncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; const SearchText: String; + // var Result: Integer); + //procedure SetMainTab(Page: TTabSheet); + //procedure DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex); + //procedure DBtreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var + // ImageIndex: TImageIndex); + //procedure DBtreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: + // Integer); + //procedure DBtreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: + // TColumnIndex; TextType: TVSTTextType; var CellText: String); + //procedure DBtreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var + // ChildCount: Cardinal); + //procedure DBtreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: + // PVirtualNode; var InitialStates: TVirtualNodeInitStates); + //procedure DBtreePaintText(Sender: TBaseVirtualTree; const TargetCanvas: + // TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); + //procedure editFilterSearchChange(Sender: TObject); + //procedure editFilterSearchEnter(Sender: TObject); + //procedure editFilterSearchExit(Sender: TObject); + //procedure menuLogToFileClick(Sender: TObject); + //procedure menuOpenLogFolderClick(Sender: TObject); + //procedure AnyGridGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var + // HintText: String); + //procedure ListTablesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + // var ContentRect: TRect); + //procedure ListProcessesFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); + //procedure editFilterVTChange(Sender: TObject); + //procedure ListVariablesDblClick(Sender: TObject); + //procedure menuEditVariableClick(Sender: TObject); + //procedure menuTreeCollapseAllClick(Sender: TObject); + //procedure menuTreeExpandAllClick(Sender: TObject); + //procedure SynMemoFilterStatusChange(Sender: TObject; Changes: TSynStatusChanges); + //procedure AnyGridAfterCellPaint(Sender: TBaseVirtualTree; + // TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + // CellRect: TRect); + //procedure menuShowSizeColumnClick(Sender: TObject); + //procedure AnyGridBeforeCellPaint(Sender: TBaseVirtualTree; + // TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + // CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); + //procedure AnyGridMouseUp(Sender: TObject; Button: TMouseButton; + // Shift: TShiftState; X, Y: Integer); + //procedure MainMenuFileClick(Sender: TObject); + //procedure HostListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + //procedure HostListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); + //procedure HostListBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); + //procedure HostListBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + // var ContentRect: TRect); + //procedure ListTablesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); + //procedure ListTablesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; + // Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); + //procedure ListTablesGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); + //procedure ListTablesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + //procedure ListTablesInitNode(Sender: TBaseVirtualTree; ParentNode, + // Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); + //procedure AnyGridAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); + //procedure actFollowForeignKeyExecute(Sender: TObject); + //procedure actCopyOrCutExecute(Sender: TObject); + //procedure actPasteExecute(Sender: TObject); + //procedure actSelectAllExecute(Sender: TObject); + //procedure EnumerateRecentFilters; + //procedure LoadRecentFilter(Sender: TObject); + //procedure ListTablesEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; var Allowed: Boolean); + //procedure DBtreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure ListTablesDblClick(Sender: TObject); + //procedure panelTopDblClick(Sender: TObject); + //procedure PageControlMainMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + //procedure actNewQueryTabExecute(Sender: TObject); + //procedure actCloseQueryTabExecute(Sender: TObject); + //procedure menuCloseQueryTabClick(Sender: TObject); + //procedure CloseQueryTab(PageIndex: Integer); + //procedure CloseButtonOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + //procedure CloseButtonOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); + //function GetMainTabAt(X, Y: Integer): Integer; + //procedure FixQueryTabCloseButtons; + //function GetOrCreateEmptyQueryTab(DoFocus: Boolean): TQueryTab; + //function ActiveSynMemo(AcceptReadOnlyMemo: Boolean): TSynMemo; + //function IsQueryTab(PageIndex: Integer; IncludeFixed: Boolean): Boolean; + //procedure popupMainTabsPopup(Sender: TObject); + //procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); + //procedure actFilterPanelExecute(Sender: TObject); + //procedure TimerFilterVTTimer(Sender: TObject); + //procedure PageControlMainContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); + //procedure menuQueryHelpersGenerateStatementClick(Sender: TObject); + //procedure actSelectInverseExecute(Sender: TObject); + //procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; + // var Handled: Boolean); + //procedure actDataResetSortingExecute(Sender: TObject); + //procedure actReformatSQLExecute(Sender: TObject); + //procedure DBtreeFocusChanging(Sender: TBaseVirtualTree; OldNode, + // NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; + // var Allowed: Boolean); + //procedure actBlobAsTextExecute(Sender: TObject); + //procedure SynMemoQueryReplaceText(Sender: TObject; const ASearch, + // AReplace: string; Line, Column: Integer; var Action: TSynReplaceAction); + //procedure SynMemoQueryPaintTransient(Sender: TObject; Canvas: TCanvas; + // TransientType: TTransientType); + //procedure actQueryFindAgainExecute(Sender: TObject); + //procedure AnyGridScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); + //procedure lblExplainProcessClick(Sender: TObject); + //procedure actDataShowNextExecute(Sender: TObject); + //procedure actDataShowAllExecute(Sender: TObject); + //procedure AnyGridInitNode(Sender: TBaseVirtualTree; ParentNode, + // Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); + //procedure AnyGridFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex); + //procedure ListTablesKeyPress(Sender: TObject; var Key: Char); + //procedure DBtreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure ListDatabasesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); + //procedure ListDatabasesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + //procedure ListDatabasesInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + // var InitialStates: TVirtualNodeInitStates); + //procedure ListDatabasesGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); + //procedure menuFetchDBitemsClick(Sender: TObject); + //procedure ListDatabasesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); + //procedure ListDatabasesDblClick(Sender: TObject); + //procedure actRunRoutinesExecute(Sender: TObject); + //procedure AnyGridGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); + //procedure tabsetQueryClick(Sender: TObject); + //procedure tabsetQueryGetImageIndex(Sender: TObject; TabIndex: Integer; var ImageIndex: Integer); + //procedure tabsetQueryMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + //procedure tabsetQueryMouseLeave(Sender: TObject); + //procedure StatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; const Rect: TRect); + //procedure StatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); + //procedure StatusBarMouseLeave(Sender: TObject); + //procedure AnyGridStartOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); + //procedure AnyGridEndOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); + //procedure actDataPreviewUpdate(Sender: TObject); + //procedure spltPreviewMoved(Sender: TObject); + //procedure actDataSaveBlobToFileExecute(Sender: TObject); + //procedure DataGridColumnResize(Sender: TVTHeader; Column: TColumnIndex); + //procedure treeQueryHelpersGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); + //procedure treeQueryHelpersInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + // var InitialStates: TVirtualNodeInitStates); + //procedure treeQueryHelpersInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; + // var ChildCount: Cardinal); + //procedure treeQueryHelpersGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + // Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); + //procedure treeQueryHelpersBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + // var ContentRect: TRect); + //procedure treeQueryHelpersDblClick(Sender: TObject); + //procedure treeQueryHelpersContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); + //procedure treeQueryHelpersFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure treeQueryHelpersPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); + //procedure treeQueryHelpersFocusChanging(Sender: TBaseVirtualTree; OldNode, + // NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); + //procedure treeQueryHelpersResize(Sender: TObject); + //procedure ApplicationEvents1Deactivate(Sender: TObject); + //procedure actDisconnectExecute(Sender: TObject); + //procedure menuEditObjectClick(Sender: TObject); + //procedure Copylinetonewquerytab1Click(Sender: TObject); + //procedure actLogHorizontalScrollbarExecute(Sender: TObject); + //procedure actBatchInOneGoExecute(Sender: TObject); + //function GetFocusedObjects(Sender: TObject; NodeTypes: TListNodeTypes): TDBObjectList; + //function DBTreeClicked(Sender: TObject): Boolean; + //procedure actCancelOperationExecute(Sender: TObject); + //procedure AnyGridChange(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure actToggleCommentExecute(Sender: TObject); + //procedure DBtreeBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + // Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + // var ContentRect: TRect); + //procedure actLaunchCommandlineExecute(Sender: TObject); + //procedure menuClearQueryHistoryClick(Sender: TObject); + //procedure actGridEditFunctionExecute(Sender: TObject); + //procedure ListVariablesPaintText(Sender: TBaseVirtualTree; + // const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + // TextType: TVSTTextType); + //procedure DBtreeExpanding(Sender: TBaseVirtualTree; Node: PVirtualNode; + // var Allowed: Boolean); + //procedure actGroupObjectsExecute(Sender: TObject); + //procedure popupSqlLogPopup(Sender: TObject); + //procedure menuAutoExpandClick(Sender: TObject); + //procedure pnlLeftResize(Sender: TObject); + //procedure editDatabaseTableFilterChange(Sender: TObject); + //procedure editDatabaseTableFilterLeftButtonClick(Sender: TObject); + //procedure editDatabaseTableFilterMenuClick(Sender: TObject); + //procedure editDatabaseTableFilterExit(Sender: TObject); + //procedure menuClearDataTabFilterClick(Sender: TObject); + //procedure actUnixTimestampColumnExecute(Sender: TObject); + //procedure PopupQueryLoadPopup(Sender: TObject); + //procedure DonateClick(Sender: TObject); + //procedure DBtreeExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode); + //procedure ApplicationDeActivate(Sender: TObject); + //procedure ApplicationShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); + //procedure DBtreeAfterCellPaint(Sender: TBaseVirtualTree; + // TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + // CellRect: TRect); + //procedure actFavoriteObjectsOnlyExecute(Sender: TObject); + //procedure DBtreeMouseUp(Sender: TObject; Button: TMouseButton; + // Shift: TShiftState; X, Y: Integer); + //procedure actFullRefreshExecute(Sender: TObject); + //procedure treeQueryHelpersEditing(Sender: TBaseVirtualTree; + // Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); + //procedure treeQueryHelpersCreateEditor(Sender: TBaseVirtualTree; + // Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); + //procedure treeQueryHelpersNodeClick(Sender: TBaseVirtualTree; + // const HitInfo: THitInfo); + //procedure treeQueryHelpersNewText(Sender: TBaseVirtualTree; + // Node: PVirtualNode; Column: TColumnIndex; NewText: string); + //procedure treeQueryHelpersChecking(Sender: TBaseVirtualTree; + // Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean); + //procedure actPreviousResultExecute(Sender: TObject); + //procedure actNextResultExecute(Sender: TObject); + //procedure actSaveSynMemoToTextfileExecute(Sender: TObject); + //procedure ApplicationEvents1Idle(Sender: TObject; var Done: Boolean); + //procedure buttonedEditClear(Sender: TObject); + //procedure menuDoubleClickInsertsNodeTextClick(Sender: TObject); + //procedure DBtreeDblClick(Sender: TObject); + //procedure editDatabaseTableFilterKeyPress(Sender: TObject; var Key: Char); + procedure actGotoDbTreeExecute(Sender: TObject); + //procedure actGotoFilterExecute(Sender: TObject); + //procedure actGotoTabNumberExecute(Sender: TObject); + //procedure StatusBarClick(Sender: TObject); + //procedure AnySynMemoMouseWheel(Sender: TObject; Shift: TShiftState; + // WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); + //procedure SynMemoQueryKeyPress(Sender: TObject; var Key: Char); + //procedure filterQueryHelpersChange(Sender: TObject); + //procedure TimerStoreTabsTimer(Sender: TObject); + //procedure actGoToQueryResultsExecute(Sender: TObject); + //procedure actGoToDataMultiFilterExecute(Sender: TObject); + //procedure actDataOpenUrlExecute(Sender: TObject); + //procedure ApplicationEvents1ShortCut(var Msg: TWMKey; var Handled: Boolean); + //procedure actDetachDatabaseExecute(Sender: TObject); + //procedure actAttachDatabaseExecute(Sender: TObject); + //procedure actSynEditCompletionProposeExecute(Sender: TObject); + //procedure AnyGridHeaderDrawQueryElements(Sender: TVTHeader; + // var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); + //procedure AnyGridAdvancedHeaderDraw(Sender: TVTHeader; + // var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); + //procedure SynMemoQueryScanForFoldRanges(Sender: TObject; + // FoldRanges: TSynFoldRanges; LinesToScan: TStrings; FromLine, + // ToLine: Integer); + //procedure actCodeFoldingExecute(Sender: TObject); + //procedure actCodeFoldingStartRegionExecute(Sender: TObject); + //procedure actCodeFoldingEndRegionExecute(Sender: TObject); + //procedure actCodeFoldingFoldSelectionExecute(Sender: TObject); + //procedure actConnectionPropertiesExecute(Sender: TObject); + //procedure actRenameQueryTabExecute(Sender: TObject); + //procedure menuRenameQueryTabClick(Sender: TObject); + //procedure SynMemoQueryStatusChange(Sender: TObject; Changes: TSynStatusChanges); + //procedure actCloseAllQueryTabsExecute(Sender: TObject); + //procedure menuCloseRightQueryTabsClick(Sender: TObject); + //procedure popupFilterPopup(Sender: TObject); + //procedure actSynMoveDownExecute(Sender: TObject); + //procedure actSynMoveUpExecute(Sender: TObject); + //procedure actCopyTabsToSpacesExecute(Sender: TObject); + //procedure actCopyUpdate(Sender: TObject); + //procedure FormBeforeMonitorDpiChanged(Sender: TObject; OldDPI, + // NewDPI: Integer); + //procedure menuToggleAllClick(Sender: TObject); + //procedure FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, + // NewDPI: Integer); + //procedure menuCloseTabOnDblClickClick(Sender: TObject); + //procedure TimerRefreshTimer(Sender: TObject); + //procedure SynCompletionProposalChange(Sender: TObject; AIndex: Integer); + //procedure SynMemoQuerySpecialLineColors(Sender: TObject; Line: Integer; + // var Special: Boolean; var FG, BG: TColor); + //procedure SynMemoSQLLogSpecialLineColors(Sender: TObject; Line: Integer; + // var Special: Boolean; var FG, BG: TColor); + //procedure actSequalSuggestExecute(Sender: TObject); + //procedure menuQueryExactRowCountClick(Sender: TObject); + //procedure menuCloseTabOnMiddleClickClick(Sender: TObject); + //procedure TimerCloseTabByButtonTimer(Sender: TObject); + //procedure menuTabsInMultipleLinesClick(Sender: TObject); + //procedure actResetPanelDimensionsExecute(Sender: TObject); + //procedure menuAlwaysGenerateFilterClick(Sender: TObject); + //procedure SynMemoQueryTokenHint(Sender: TObject; Coords: TBufferCoord; + // const Token: string; TokenType: Integer; Attri: TSynHighlighterAttributes; + // var HintText: string); + //procedure actCopyGridNodesExecute(Sender: TObject); + private + // Executable file details + FAppVerMajor: Integer; + FAppVerMinor: Integer; + FAppVerRelease: Integer; + FAppVerRevision: Integer; + FAppVersion: String; + + FLastHintMousepos: TPoint; + FLastHintControlIndex: Integer; + FDelimiter: String; + FLogToFile: Boolean; + FFileNameSessionLog: String; + FFileHandleSessionLog: Textfile; + FLastMouseUpOnPageControl: Cardinal; + FLastTabNumberOnMouseUp: Integer; + FLastMouseDownCloseButton: TObject; + //FJumpList: TJumpList; + //// Filter text per tab for filter panel + //FFilterTextDatabases, + //FFilterTextEditor, + //FFilterTextVariables, + //FFilterTextStatus, + //FFilterTextProcessList, + //FFilterTextCommandStats, + //FFilterTextDatabase, + //FFilterTextData: String; + //FTreeRefreshInProgress: Boolean; + //FRefreshActionDisabledAt: Cardinal; + //FDataGridColumnWidthsCustomized: Boolean; + //FDataGridLastClickedColumnHeader: Integer; + //FDataGridLastClickedColumnLeftPos: Integer; + //FDataGridSortItems: TSortItems; + //FSnippetFilenames: TStringList; + //FConnections: TDBConnectionList; + //FTreeClickHistory: TNodeArray; + //FOperationTicker: Cardinal; + //FOperatingGrid: TBaseVirtualTree; + //FActiveDbObj: TDBObject; + //FActiveObjectGroup: TListNodeType; + //FBtnAddTab: TSpeedButton; + //FDBObjectsMaxSize: Int64; + //FDBObjectsMaxRows: Int64; + //FSearchReplaceDialog: TfrmSearchReplace; + //FCreateDatabaseDialog: TCreateDatabaseForm; + //FTableToolsDialog: TfrmTableTools; + //FGridEditFunctionMode: Boolean; + //FClipboardHasNull: Boolean; + FTimeZoneOffset: Integer; + //FGridCopying: Boolean; + //FGridPasting: Boolean; + //FHasDonatedDatabaseCheck: TThreeStateBoolean; + //FFocusedTables: TDBObjectList; + FLastCaptionChange: Cardinal; + //FListTablesSorted: Boolean; + FLastPortableSettingsSave: Cardinal; + FLastAppSettingsWrites: Integer; + FFormatSettings: TFormatSettings; + FDefaultHintFontName: String; + //FActionList1DefaultCaptions: TStringList; + //FActionList1DefaultHints: TStringList; + //FEditorCommandStrings: TStringList; + //FLastSelWordInEditor: String; + //FMatchingBraceForegroundColor: TColor; + //FMatchingBraceBackgroundColor: TColor; + //FSynEditInOnPaintTransient: Boolean; + //FExactRowCountMode: Boolean; + ////FHelpData: TSimpleKeyValuePairs; + // + //// Host subtabs backend structures + //FHostListResults: TDBQueryList; + //FStatusServerUptime: Integer; + //FProcessListMaxTime: Int64; + //FCommandStatsQueryCount: Int64; + //FCommandStatsServerUptime: Integer; + //FVariableNames, FSessionVars, FGlobalVars: TStringList; + // + procedure SetDelimiter(Value: String); + //procedure DisplayRowCountStats(Sender: TBaseVirtualTree); + //procedure insertFunction(Sender: TObject); + //function GetActiveConnection: TDBConnection; + //function GetActiveDatabase: String; + //function GetCurrentQuery(Tab: TQueryTab): String; + //procedure SetActiveDatabase(db: String; Connection: TDBConnection); + //procedure SetActiveDBObj(Obj: TDBObject); + //procedure ToggleFilterPanel(ForceVisible: Boolean = False); + //procedure EnableDataTab(Enable: Boolean); + //procedure AutoCalcColWidth(Tree: TVirtualStringTree; Column: TColumnIndex); + //procedure PlaceObjectEditor(Obj: TDBObject); + //procedure SetTabCaption(PageIndex: Integer; Text: String); + //function ConfirmTabClose(PageIndex: Integer; AppIsClosing: Boolean): Boolean; + //function ConfirmTabClear(PageIndex: Integer; AppIsClosing: Boolean): Boolean; + //procedure UpdateFilterPanel(Sender: TObject); + //procedure ConnectionReady(Connection: TDBConnection; Database: String); + //procedure DatabaseChanged(Connection: TDBConnection; Database: String); + //procedure ObjectnamesChanged(Connection: TDBConnection; Database: String); + //procedure UpdateLineCharPanel; + //procedure SetSnippetFilenames; + //function TreeClickHistoryPrevious(MayBeNil: Boolean=False): PVirtualNode; + //procedure OperationRunning(Runs: Boolean); + //function RunQueryFiles(Filenames: TStrings; Encoding: TEncoding; ForceRun: Boolean): Boolean; + //function RunQueryFile(Filename: String; Encoding: TEncoding; Conn: TDBConnection; + // ProgressDialog: IProgressDialog; FilesizeSum: Int64; var CurrentPosition: Int64): Boolean; + //procedure SetLogToFile(Value: Boolean); + //procedure StoreLastSessions; + //function HandleUnixTimestampColumn(Sender: TBaseVirtualTree; Column: TColumnIndex): Boolean; + //function InitTabsIniFile: TIniFile; + //procedure StoreTabs; + //function RestoreTabs: Boolean; + //procedure SetHintFontByControl(Control: TWinControl=nil); + public + //QueryTabs: TQueryTabList; + //ActiveObjectEditor: TDBObjectEditor; + //FileEncodings: TStringList; + //ImportSettingsDone: Boolean; + // + //// Data grid related stuff + //DataGridHiddenColumns: TStringList; + //DataGridWantedRowCount: Int64; + //DataGridTable: TDBObject; + //DataGridFocusedCell: TStringList; + //DataGridFocusedNodeIndex: Int64; + //DataGridFocusedColumnName: String; + //DataGridResult: TDBQuery; + //DataGridFullRowMode: Boolean; + //DataLocalNumberFormat: Boolean; + //SelectedTableColumns: TTableColumnList; + //SelectedTableKeys: TTableKeyList; + //SelectedTableForeignKeys: TForeignKeyList; + //SelectedTableTimestampColumns: TStringList; + //FilterPanelManuallyOpened: Boolean; + // + //// Task button interface + //TaskbarList: ITaskbarList; + //TaskbarList2: ITaskbarList2; + //TaskbarList3: ITaskbarList3; + //TaskbarList4: ITaskbarList4; + // + property AppVerRevision: Integer read FAppVerRevision; + property AppVersion: String read FAppVersion; + //property Connections: TDBConnectionList read FConnections; + property Delimiter: String read FDelimiter write SetDelimiter; + //property FocusedTables: TDBObjectList read FFocusedTables; + //function GetAlternatingRowBackground(Node: PVirtualNode): TColor; + //procedure PaintAlternatingRowBackground(TargetCanvas: TCanvas; Node: PVirtualNode; CellRect: TRect); + //procedure PaintColorBar(Value, Max: Extended; TargetCanvas: TCanvas; CellRect: TRect); + //procedure CallSQLHelpWithKeyword( keyword: String ); + //procedure AddOrRemoveFromQueryLoadHistory(Filename: String; AddIt: Boolean; CheckIfFileExists: Boolean); + //procedure popupQueryLoadClick( sender: TObject ); + //procedure PopupQueryLoadRemoveAbsentFiles(Sender: TObject); + //procedure PopupQueryLoadRemoveAllFiles(Sender: TObject); + //procedure SessionConnect(Sender: TObject); + //function InitConnection(Params: TConnectionParameters; ActivateMe: Boolean; var Connection: TDBConnection): Boolean; + //procedure ConnectionsNotify(Sender: TObject; const Item: TDBConnection; Action: TCollectionNotification); + //function ActiveGrid: TVirtualStringTree; + //function GridResult(Grid: TBaseVirtualTree): TDBQuery; + //property ActiveConnection: TDBConnection read GetActiveConnection; + //property ActiveDatabase: String read GetActiveDatabase; + //property ActiveDbObj: TDBObject read FActiveDbObj write SetActiveDBObj; + property LogToFile: Boolean read FLogToFile write FLogToFile; //SetLogToFile; + //procedure RefreshTree(FocusNewObject: TDBObject=nil); + //function GetRootNode(Tree: TBaseVirtualTree; Connection: TDBConnection): PVirtualNode; + //function FindDBObjectNode(Tree: TBaseVirtualTree; Obj: TDBObject): PVirtualNode; + //function FindDBNode(Tree: TBaseVirtualTree; Connection: TDBConnection; db: String): PVirtualNode; + //procedure CalcNullColors; + //procedure HandleDataGridAttributes(RefreshingData: Boolean); + //function GetRegKeyTable: String; + //procedure UpdateEditorTab; + //procedure SetWindowCaption; + //procedure DefaultHandler(var Message); override; + //procedure SetupSynEditors; overload; + //procedure SetupSynEditors(BaseForm: TComponent); overload; + //procedure SetupSynEditor(Editor: TSynMemo); + //function AnyGridEnsureFullRow(Grid: TVirtualStringTree; Node: PVirtualNode): Boolean; + //procedure DataGridEnsureFullRows(Grid: TVirtualStringTree; SelectedOnly: Boolean); + //property DataGridSortItems: TSortItems read FDataGridSortItems write FDataGridSortItems; + //function GetEncodingByName(Name: String): TEncoding; + //function GetEncodingName(Encoding: TEncoding): String; + //function GetCharsetByEncoding(Encoding: TEncoding): String; + //procedure RefreshHelperNode(NodeIndex: Cardinal); + //procedure BeforeQueryExecution(Thread: TQueryThread); + //procedure AfterQueryExecution(Thread: TQueryThread); + //procedure FinishedQueryExecution(Thread: TQueryThread); + //procedure EnableProgress(MaxValue: Integer); + //procedure DisableProgress; + //procedure SetProgressPosition(Value: Integer); + //procedure ProgressStep; + //procedure SetProgressState(State: TProgressbarState); + //procedure TaskDialogHyperLinkClicked(Sender: TObject); + //function HasDonated(ForceCheck: Boolean): TThreeStateBoolean; + //procedure ApplyVTFilter(FromTimer: Boolean); + //procedure ApplyFontToGrids; + //procedure PrepareImageList; + //property ActionList1DefaultCaptions: TStringList read FActionList1DefaultCaptions; + //property ActionList1DefaultHints: TStringList read FActionList1DefaultHints; + //function SelectedTableFocusedColumn: TTableColumn; + //property FormatSettings: TFormatSettings read FFormatSettings; + //property MatchingBraceForegroundColor: TColor read FMatchingBraceForegroundColor write FMatchingBraceForegroundColor; + //property MatchingBraceBackgroundColor: TColor read FMatchingBraceBackgroundColor write FMatchingBraceBackgroundColor; + end; + +var + MainForm: TMainForm; + SecondInstMsgId: Cardinal = 0; + SysLanguage: String; + MainFormCreated: Boolean = False; + MainFormAfterCreateDone: Boolean = False; + PostponedLogItems: TDBLogItems; + +const + CheckedStates = [csCheckedNormal, csCheckedPressed, csMixedNormal, csMixedPressed]; + ErrorLineForeground: TColor = $00000000; + ErrorLineBackground: TColor = $00D2B7FF; + WarningLineForeground: TColor = $00000000; + WarningLineBackground: TColor = $00B7CDFF; + NoteLineForeground: TColor = $00000000; + NoteLineBackground: TColor = $00D3F7FF; + InfoLineForeground: TColor = $00000000; + InfoLineBackground: TColor = $00C6FFEC; + +{$I const.inc} + + +implementation + +uses + FileInfo, winpeimagereader, elfreader, machoreader, apphelpers; + +{$R *.lfm} + +{ TMainForm } + + +{procedure TMainForm.ShowStatusMsg(Msg: String=''; PanelNr: Integer=6); +var + PanelRect: TRect; +begin + // Show message in some statusbar panel + if (PanelNr = 6) and (Msg = '') then + Msg := _(SIdle); + if Msg <> StatusBar.Panels[PanelNr].Text then begin + StatusBar.Panels[PanelNr].Text := Msg; + if (PanelNr = 6) and (not IsWine) then begin + // Immediately repaint this special panel, as it holds critical update messages, + // while avoiding StatusBar.Repaint which refreshes all panels + SendMessage(StatusBar.Handle, SB_GETRECT, PanelNr, Integer(@PanelRect)); + StatusBar.OnDrawPanel(StatusBar, StatusBar.Panels[PanelNr], PanelRect); + InvalidateRect(StatusBar.Handle, PanelRect, False); + // Alternatives: + //RedrawWindow(StatusBar.Handle, @PanelRect, 0, RDW_UPDATENOW); + //UpdateWindow(StatusBar.Handle); + //StatusBar.Repaint; + end; + end; +end;} + + +{procedure TMainForm.StatusBarClick(Sender: TObject); +var + Click: TPoint; + i: Integer; + PanelRect: TRect; +begin + // Handle click events on specific statusbar panels + // Prevent SendMessage on Wine + if IsWine then + Exit; + Click := StatusBar.ScreenToClient(Mouse.CursorPos); + for i:=0 to StatusBar.Panels.Count-1 do begin + SendMessage(StatusBar.Handle, SB_GETRECT, i, Integer(@PanelRect)); + if PtInRect(PanelRect, Click) then begin + // We found the clicked panel + case i of + 3: actConnectionProperties.Execute; + end; + Break; + end; + + end; + +end;} + + +{procedure TMainForm.StatusBarClick(Sender: TObject); +var + Click: TPoint; + i: Integer; + PanelRect: TRect; +begin + // Handle click events on specific statusbar panels + // Prevent SendMessage on Wine + if IsWine then + Exit; + Click := StatusBar.ScreenToClient(Mouse.CursorPos); + for i:=0 to StatusBar.Panels.Count-1 do begin + SendMessage(StatusBar.Handle, SB_GETRECT, i, Integer(@PanelRect)); + if PtInRect(PanelRect, Click) then begin + // We found the clicked panel + case i of + 3: actConnectionProperties.Execute; + end; + Break; + end; + + end; + +end;} + +{procedure TMainForm.StatusBarDrawPanel(StatusBar: TStatusBar; Panel: TStatusPanel; + const Rect: TRect); +var + PanelRect: TRect; + ImageIndex: Integer; + Conn: TDBConnection; +begin + // Refresh one status bar panel, probably with icon + ImageIndex := -1; + case Panel.Index of + 2: ImageIndex := 149; + 3: begin + Conn := ActiveConnection; + if Conn <> nil then + ImageIndex := Conn.Parameters.ImageIndex; + end; + 5: ImageIndex := 190; + 6: begin + if Panel.Text = _(SIdle) then + ImageIndex := 151 // Green dot + else + ImageIndex := 150; // Hourglass + end; + end; + PanelRect := Rect; + StatusBar.Canvas.FillRect(PanelRect); + if ImageIndex > -1 then begin + VirtualImageListMain.Draw(StatusBar.Canvas, PanelRect.Left, PanelRect.Top, ImageIndex, true); + OffsetRect(PanelRect, VirtualImageListMain.Width+2, 0); + end; + DrawText(StatusBar.Canvas.Handle, PChar(Panel.Text), -1, PanelRect, DT_SINGLELINE or DT_VCENTER); +end;} + + +{procedure TMainForm.StatusBarMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +var + MouseP: TPoint; + Bar: TStatusBar; + PanelRect: TRect; + i: Integer; + Infos: TStringList; + HintText: String; + Conn: TDBConnection; +begin + // Display various server, client and connection related details in a hint + if IsWine then + Exit; + if (FLastHintMousepos.X = X) and (FLastHintMousepos.Y = Y) then + Exit; + FLastHintMousepos := Point(X, Y); + MouseP := StatusBar.ClientOrigin; + Inc(MouseP.X, X); + Inc(MouseP.Y, Y); + Bar := Sender as TStatusBar; + for i:=0 to Bar.Panels.Count-1 do begin + SendMessage(Bar.Handle, SB_GETRECT, i, Integer(@PanelRect)); + if PtInRect(PanelRect, FLastHintMousepos) then + break; + end; + if i = FLastHintControlIndex then + Exit; + FLastHintControlIndex := i; + if FLastHintControlIndex = 3 then begin + Conn := ActiveConnection; + if (Conn <> nil) and (not Conn.IsLockedByThread) then begin + Infos := Conn.ConnectionInfo; + HintText := ''; + for i:=0 to Infos.Count-1 do begin + HintText := HintText + Infos.Names[i] + ': ' + StrEllipsis(Infos.ValueFromIndex[i], 200) + CRLF; + end; + BalloonHint1.Description := Trim(HintText); + OffsetRect(PanelRect, Bar.ClientOrigin.X, Bar.ClientOrigin.Y); + BalloonHint1.ShowHint(PanelRect); + end; + end else + Bar.OnMouseLeave(Sender); +end;} + + +{procedure TMainForm.StatusBarMouseLeave(Sender: TObject); +begin + BalloonHint1.HideHint; + FLastHintControlIndex := -1; +end;} + + +procedure TMainForm.actExitApplicationExecute(Sender: TObject); +begin + Close; +end; + +{procedure TMainForm.actFlushExecute(Sender: TObject); +var + FlushWhat: String; +begin + if Sender = actFlushHosts then + FlushWhat := 'HOSTS' + else if Sender = actFlushLogs then + FlushWhat := 'LOGS' + else if Sender = actFlushPrivileges then + FlushWhat := 'PRIVILEGES' + else if Sender = actFlushTables then + FlushWhat := 'TABLES' + else if Sender = actFlushTableswithreadlock then + FlushWhat := 'TABLES WITH READ LOCK' + else if Sender = actFlushStatus then + FlushWhat := 'STATUS' + else + raise Exception.CreateFmt(_('Unhandled sender control: %s'), [(Sender as TControl).Name]); + try + ActiveConnection.Query('FLUSH ' + FlushWhat); + if Sender = actFlushTableswithreadlock then begin + MessageDialog( + _('Tables have been flushed and read lock acquired. Perform backup or snapshot of table data files now. Press OK to unlock when done...'), + mtInformation, [mbOk] + ); + ActiveConnection.Query('UNLOCK TABLES'); + end; + except + on E:EDbError do + ErrorDialog(E.Message); + end; +end;} + + +{procedure TMainForm.actFullRefreshExecute(Sender: TObject); +var + OldFullTableStatusSetting: Boolean; + Conn: TDBConnection; +begin + // Temorarily enable full table status when it's disabled + Conn := ActiveConnection; + OldFullTableStatusSetting := Conn.Parameters.FullTableStatus; + Conn.Parameters.FullTableStatus := True; + actRefresh.Execute; + Conn.Parameters.FullTableStatus := OldFullTableStatusSetting; +end;} + + +procedure TMainForm.actGotoDbTreeExecute(Sender: TObject); +begin + DBtree.SetFocus; +end; + + +{procedure TMainForm.actGotoFilterExecute(Sender: TObject); +begin + editTableFilter.SetFocus; +end;} + + +{procedure TMainForm.actGoToQueryResultsExecute(Sender: TObject); +var + Tab: TQueryTab; + Grid: TVirtualStringTree; +begin + if QueryTabs.HasActiveTab then begin + // Switch between query editor and result grid + Tab := QueryTabs.ActiveTab; + if Tab.Memo.Focused then begin + if Tab.ActiveResultTab <> nil then begin + Grid := Tab.ActiveResultTab.Grid; + Grid.SetFocus; + if Grid.FocusedNode = nil then + SelectNode(Grid, 0); + end else begin + MessageBeep(MB_ICONASTERISK); + end; + end else begin + Tab.Memo.SetFocus; + end; + end else if PageControlMain.ActivePage = tabData then begin + // Switch between data tab filter and result grid + if SynMemoFilter.Focused then begin + DataGrid.SetFocus; + if DataGrid.FocusedNode = nil then + SelectNode(DataGrid, 0); + end else begin + ToggleFilterPanel(True); + SynMemoFilter.TrySetFocus; + end; + end else begin + MessageBeep(MB_ICONASTERISK); + end; +end;} + + +{procedure TMainForm.actGoToDataMultiFilterExecute(Sender: TObject); +begin + // Go to multi column filter generator + if PageControlMain.ActivePage = tabData then begin + ToggleFilterPanel(True); + editFilterSearch.TrySetFocus; + end else begin + MessageBeep(MB_ICONASTERISK); + end; +end;} + + +{procedure TMainForm.actGotoTabNumberExecute(Sender: TObject); +var + i, Visibles, WantedIndex: Integer; +begin + // Set focus on tab by numeric index + WantedIndex := -1; + if Sender = actGotoTab1 then + WantedIndex := 0 + else if Sender = actGotoTab2 then + WantedIndex := 1 + else if Sender = actGotoTab3 then + WantedIndex := 2 + else if Sender = actGotoTab4 then + WantedIndex := 3 + else if Sender = actGotoTab5 then + WantedIndex := 4; + i := 0; + Visibles := 0; + while true do begin + if i >= PageControlMain.PageCount then + Break; + if PageControlMain.Pages[i].TabVisible then begin + if Visibles = WantedIndex then begin + PageControlMain.ActivePageIndex := i; + Break; + end; + Inc(Visibles); + end; + Inc(i); + end; +end;} + + +{procedure TMainForm.actGridEditFunctionExecute(Sender: TObject); +begin + // Insert SQL function in grid + FGridEditFunctionMode := True; + ActiveGrid.EditNode(ActiveGrid.FocusedNode, ActiveGrid.FocusedColumn); +end;} + + +{procedure TMainForm.StoreLastSessions; +var + OpenSessions, SessionPaths, SortedSessions: TStringList; + Connection: TDBConnection; + JumpTask: TJumpTask; + SessionPath: String; + i: Integer; + LastConnect: TDateTime; +begin + // Store names of open sessions + OpenSessions := TStringList.Create; + for Connection in Connections do + OpenSessions.Add(Connection.Parameters.SessionPath); + AppSettings.WriteString(asLastSessions, Implode(DELIM, OpenSessions)); + OpenSessions.Free; + if Assigned(ActiveConnection) then + AppSettings.WriteString(asLastActiveSession, ActiveConnection.Parameters.SessionPath); + + // Recreate Win7 taskbar jump list with sessions used in the last month, ordered by the number of connects + if Assigned(FJumpList) then try + FJumpList.Clear; + SessionPaths := TStringList.Create; + SortedSessions := TStringList.Create; + AppSettings.GetSessionPaths('', SessionPaths); + for SessionPath in SessionPaths do begin + AppSettings.SessionPath := SessionPath; + LastConnect := StrToDateTimeDef(AppSettings.ReadString(asLastConnect), DateTimeNever); + if DaysBetween(LastConnect, Now) <= 30 then + SortedSessions.Values[SessionPath] := IntToStr(AppSettings.ReadInt(asConnectCount)); + end; + SessionPaths.Free; + AppSettings.ResetPath; + SortedSessions.CustomSort(StringListCompareByValue); + for i:=0 to SortedSessions.Count-1 do begin + JumpTask := TJumpTask.Create; + JumpTask.Title := SortedSessions.Names[i]+' ('+FormatNumber(SortedSessions.ValueFromIndex[i], True)+')'; + JumpTask.ApplicationPath := ParamStr(0); + JumpTask.Arguments := '-d="'+SortedSessions.Names[i]+'"'; + JumpTask.CustomCategory := _('Recent sessions'); + FJumpList.JumpItems.Add(JumpTask); + end; + SortedSessions.Free; + // Seems to randomly produce access violations, not only on Wine + // See issue #3428 + FJumpList.Apply; + except + on E:Exception do + LogSQL(E.Message, lcError); + end; +end;} + + +{procedure TMainForm.FormAfterMonitorDpiChanged(Sender: TObject; OldDPI, + NewDPI: Integer); +begin + // DPI settings change finished + FormResize(Sender); +end;} + +{procedure TMainForm.FormBeforeMonitorDpiChanged(Sender: TObject; OldDPI, + NewDPI: Integer); +var + Factor: Extended; +begin + // Moving window to different screen or user changed DPI setting for current screen + Factor := 100 / PixelsPerInchDesigned * NewDPI; + LogSQL(f_('Scaling controls to screen DPI: %d%%', [Round(Factor)])); + //LogSQL('PixelsPerInchDesigned:'+PixelsPerInchDesigned.ToString+' OldDPI:'+OldDPI.ToString+' NewDPI:'+NewDPI.ToString); +end;} + + +{procedure TMainForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean); +var + i: Integer; +begin + // Prompt on modified changes + CanClose := True; + + // Unsaved changes in some query tab? + // Also backups automatically if option is activated + for i:=0 to QueryTabs.Count-1 do begin + CanClose := ConfirmTabClose(i+tabQuery.PageIndex, True); + if not CanClose then + Exit; + end; + // Unsaved modified table, trigger, view or routine? + if Assigned(ActiveObjectEditor) then + CanClose := not (ActiveObjectEditor.DeInit in [mrAbort, mrCancel]); +end;} + +{procedure TMainForm.FormDestroy(Sender: TObject); +begin + // Destroy dialogs + FreeAndNil(FSearchReplaceDialog); + + StoreLastSessions; + + // Store tab setup for the last time, before tabs are destroyed + if TimerStoreTabs.Enabled then begin + TimerStoreTabs.OnTimer(Sender); + end; + + // Some grid editors access the registry - be sure these are gone before freeing AppSettings + QueryTabs.Clear; + DataGrid.EndEditNode; + + // Clearing query and browse data. + FreeAndNil(DataGridResult); + + // Close database connections + Connections.Clear; + + // Save various settings + AppSettings.WriteBool(asStopOnErrorsInBatchMode, actQueryStopOnErrors.Checked); + AppSettings.WriteBool(asDisplayBLOBsAsText, actBlobAsText.Checked); + AppSettings.WriteString(asDelimiter, FDelimiter); + AppSettings.WriteInt(asQuerymemoheight, pnlQueryMemo.Height); + AppSettings.WriteInt(asQueryhelperswidth, pnlQueryHelpers.Width); + AppSettings.WriteInt(asCompletionProposalWidth, SynCompletionProposal.Width); + AppSettings.WriteInt(asCompletionProposalNbLinesInWindow, SynCompletionProposal.NbLinesInWindow); + AppSettings.WriteInt(asDbtreewidth, pnlLeft.width); + AppSettings.WriteBool(asGroupTreeObjects, actGroupObjects.Checked); + AppSettings.WriteInt(asDataPreviewHeight, pnlPreview.Height); + AppSettings.WriteBool(asDataPreviewEnabled, actDataPreview.Checked); + AppSettings.WriteInt(asLogHeight, SynMemoSQLLog.Height); + AppSettings.WriteBool(asFilterPanel, actFilterPanel.Checked); + AppSettings.WriteBool(asWrapLongLines, actQueryWordWrap.Checked); + AppSettings.WriteBool(asCodeFolding, actCodeFolding.Checked); + AppSettings.WriteBool(asSingleQueries, actSingleQueries.Checked); + AppSettings.WriteBool(asLogHorizontalScrollbar, actLogHorizontalScrollbar.Checked); + AppSettings.WriteBool(asMainWinMaximized, WindowState=wsMaximized); + AppSettings.WriteInt(asMainWinOnMonitor, Monitor.MonitorNum); + // Window dimensions are only valid when WindowState is normal. + if WindowState = wsNormal then begin + AppSettings.WriteInt(asMainWinLeft, Left); + AppSettings.WriteInt(asMainWinTop, Top); + AppSettings.WriteIntDpiAware(asMainWinWidth, Self, Width); + AppSettings.WriteIntDpiAware(asMainWinHeight, Self, Height); + end; + SaveListSetup(ListDatabases); + SaveListSetup(ListVariables); + SaveListSetup(ListStatus); + SaveListSetup(ListProcesses); + SaveListSetup(ListCommandStats); + SaveListSetup(ListTables); + + LogToFile := False; + AppSettings.Free; +end;} +procedure TMainForm.FormCreate(Sender: TObject); +var + i, j, MonitorIndex: Integer; + //QueryTab: TQueryTab; + //Action, CopyAsAction: TAction; + //ExportFormat: TGridExportFormat; + VI: TVersionInfo; + CopyAsMenu, CommandMenu: TMenuItem; + //TZI: TTimeZoneInformation; + //dti: TDBDatatypeCategoryIndex; + //EditorCommand: TSynEditorCommand; + CmdCap: String; + Lib: TMySQLLib; + test: String; +begin + {*** + OnCreate Event + Important to set the windowstate here instead of in OnShow + because possible windowstate-switching is done with an animation + if set in Windows. This animation takes some milliseconds + to complete and can be annoying. + } + Caption := APPNAME; + + // Load preferred ImageCollection into VirtualImageList + {PrepareImageList; + + if AppSettings.ReadBool(asToolbarShowCaptions) then begin + for i:=0 to ToolBarMainButtons.ButtonCount-1 do begin + if ToolBarMainButtons.Buttons[i].Style = tbsSeparator then + Continue; + ToolBarMainButtons.Buttons[i].AutoSize := True; + //ToolBarMainButtons.Buttons[i].AutoSize := False; + //ToolBarMainButtons.Buttons[i].Width := 25; + ToolBarMainButtons.Buttons[i].Style := tbsTextButton; + end; + //ToolBarMainButtons.AllowTextButtons := True; + //ToolBarMainButtons.List := True; + ToolBarMainButtons.ShowCaptions := true; + end;} + + {// Translate menu items + menuQueryHelpersGenerateSelect.Caption := f_('Generate %s ...', ['SELECT']); + menuQueryHelpersGenerateInsert.Caption := f_('Generate %s ...', ['INSERT']); + menuQueryHelpersGenerateUpdate.Caption := f_('Generate %s ...', ['UPDATE']); + menuQueryHelpersGenerateDelete.Caption := f_('Generate %s ...', ['DELETE']);} + + {// Translate data type categories + for dti:=Low(DatatypeCategories) to High(DatatypeCategories) do begin + DatatypeCategories[dti].Name := _(DatatypeCategories[dti].Name); + end;} + + // Detect version + try + VI := TVersionInfo.Create; + VI.Load(HINSTANCE); + FAppVerMajor := VI.FixedInfo.FileVersion[0]; + FAppVerMinor := VI.FixedInfo.FileVersion[1]; + FAppVerRelease := VI.FixedInfo.FileVersion[2]; + FAppVerRevision := VI.FixedInfo.FileVersion[3]; + VI.Free; + except + FAppVerMajor := 0; + FAppVerMinor := 0; + FAppVerRelease := 0; + FAppVerRevision := 0; + end; + FAppVersion := Format('%d.%d.%d.%d', [FAppVerMajor, FAppVerMinor, FAppVerRelease, FAppVerRevision]); + + {// Taskbar button interface for Windows 7 + // Possibly fails. See http://www.heidisql.com/forum.php?t=22451 + if CheckWin32Version(6, 1) then + try + TaskbarList := CreateComObject(CLSID_TaskbarList) as ITaskbarList; + TaskbarList.HrInit; + Supports(TaskbarList, IID_ITaskbarList2, TaskbarList2); + Supports(TaskbarList, IID_ITaskbarList3, TaskbarList3); + Supports(TaskbarList, IID_ITaskbarList4, TaskbarList4); + except + on E:EOleSysError do; + end;} + + // Load snippet filenames + {SetSnippetFilenames;} + + // Dynamically create actions and menuitems in "Copy as" context menu + {for ExportFormat:=Low(TGridExportFormat) to High(TGridExportFormat) do begin + CopyAsAction := TAction.Create(ActionList1); + CopyAsAction.ActionList := ActionList1; + CopyAsAction.Category := actExportData.Category; + CopyAsAction.Name := TfrmExportGrid.CopyAsActionPrefix + Integer(ExportFormat).ToString; + CopyAsAction.Caption := TfrmExportGrid.FormatToDescription[ExportFormat]; + CopyAsAction.ImageIndex := TfrmExportGrid.FormatToImageIndex[ExportFormat]; + CopyAsAction.Tag := Integer(ExportFormat); + CopyAsAction.OnExecute := actCopyOrCutExecute; + CopyAsMenu := TMenuItem.Create(popupDataGrid); + CopyAsMenu.Action := CopyAsAction; + menuCopyAs.Add(CopyAsMenu); + end;} + + // Generate submenu with SynEdit commands + {FEditorCommandStrings := TStringList.Create; + SynEditKeyCmds.GetEditorCommandValues(AddEditorCommandMenu); + for i:=0 to FEditorCommandStrings.Count-1 do begin + EditorCommand := ConvertCodeStringToCommand(FEditorCommandStrings[i]); + CommandMenu := TMenuItem.Create(MainMenu1); + CmdCap := FEditorCommandStrings[i]; + CmdCap := Copy(CmdCap, 3, Length(CmdCap)-2); + // Insert spaces before uppercase chars + for j:=Length(CmdCap) downto 1 do begin + if (j > 1) and CmdCap[j].IsUpper then + Insert(' ', CmdCap, j); + end; + CommandMenu.Caption := CmdCap; + for j:=0 to SynMemoQuery.Keystrokes.Count-1 do begin + if SynMemoQuery.Keystrokes[j].Command = EditorCommand then begin + CommandMenu.Caption := CommandMenu.Caption + ' (' + ShortCutToText(SynMemoQuery.Keystrokes[j].ShortCut) + ')'; + Break; + end; + end; + CommandMenu.OnClick := EditorCommandOnClick; + menuEditorCommands.Add(CommandMenu); + end;} + + + {Delimiter := AppSettings.ReadString(asDelimiter);} + + // Define static query tab as first one in our QueryTabs list + {QueryTab := TQueryTab.Create(Self); + QueryTab.TabSheet := tabQuery; + QueryTab.Number := 1; + QueryTab.Uid := TQueryTab.GenerateUid; + QueryTab.pnlMemo := pnlQueryMemo; + QueryTab.pnlHelpers := pnlQueryHelpers; + QueryTab.filterHelpers := filterQueryHelpers; + QueryTab.treeHelpers := treeQueryHelpers; + QueryTab.Memo := SynMemoQuery; + QueryTab.MemoLineBreaks := TLineBreaks(AppSettings.ReadInt(asLineBreakStyle)); + QueryTab.spltHelpers := spltQueryHelpers; + QueryTab.spltQuery := spltQuery; + QueryTab.tabsetQuery := tabsetQuery; + InheritFont(QueryTab.tabsetQuery.Font); + QueryTab.ResultTabs := TResultTabs.Create(True); + + QueryTabs := TQueryTabList.Create(True); + QueryTabs.Add(QueryTab);} + + // Populate generic results for "Host" subtabs + {FHostListResults := TDBQueryList.Create(False); + for i:=0 to PageControlHost.PageCount-1 do begin + FHostListResults.Add(nil); + end;} + + // Enable auto completion in data tab, filter editor + {SynCompletionProposal.AddEditor(SynMemoFilter);} + + // Window position + {Left := AppSettings.ReadInt(asMainWinLeft); + Top := AppSettings.ReadInt(asMainWinTop); + // ... state + if AppSettings.ReadBool(asMainWinMaximized) then + WindowState := wsMaximized; + // ... and monitor placement + MonitorIndex := AppSettings.ReadInt(asMainWinOnMonitor); + MonitorIndex := Max(0, MonitorIndex); + MonitorIndex := Min(Screen.MonitorCount-1, MonitorIndex); + MakeFullyVisible(Screen.Monitors[MonitorIndex]);} + + {actQueryStopOnErrors.Checked := AppSettings.ReadBool(asStopOnErrorsInBatchMode); + actBlobAsText.Checked := AppSettings.ReadBool(asDisplayBLOBsAsText); + actQueryWordWrap.Checked := AppSettings.ReadBool(asWrapLongLines); + if AppSettings.ReadBool(asCodeFolding) and (not actCodeFolding.Checked) then + actCodeFolding.Execute; + actSingleQueries.Checked := AppSettings.ReadBool(asSingleQueries); + actBatchInOneGo.Checked := not AppSettings.ReadBool(asSingleQueries); + actPreferencesLogging.ImageIndex := actPreferences.ImageIndex; + actPreferencesLogging.OnExecute := actPreferences.OnExecute; + actPreferencesData.ImageIndex := actPreferences.ImageIndex; + actPreferencesData.OnExecute := actPreferences.OnExecute; + menuAlwaysGenerateFilter.Checked := AppSettings.ReadBool(asAlwaysGenerateFilter); } + + {pnlQueryMemo.Height := AppSettings.ReadInt(asQuerymemoheight); + pnlQueryHelpers.Width := AppSettings.ReadInt(asQueryhelperswidth); + pnlLeft.Width := AppSettings.ReadInt(asDbtreewidth); + pnlPreview.Height := AppSettings.ReadInt(asDataPreviewHeight); + if AppSettings.ReadBool(asDataPreviewEnabled) then + actDataPreviewExecute(actDataPreview); + SynMemoSQLLog.Height := Max(AppSettings.ReadInt(asLogHeight), spltTopBottom.MinSize); + // Force status bar position to below log memo + StatusBar.Top := SynMemoSQLLog.Top + SynMemoSQLLog.Height; + actDataShowNext.Hint := f_('Show next %s rows ...', [FormatNumber(AppSettings.ReadInt(asDatagridRowsPerStep))]); + actAboutBox.Caption := f_('About %s', [APPNAME+' '+FAppVersion]); + // Activate logging + LogToFile := AppSettings.ReadBool(asLogToFile); + if AppSettings.ReadBool(asLogHorizontalScrollbar) then + actLogHorizontalScrollbar.Execute;} + + {// Data-Font: + ApplyFontToGrids; + // Load color settings + DatatypeCategories[dtcInteger].Color := AppSettings.ReadInt(asFieldColorNumeric); + DatatypeCategories[dtcReal].Color := AppSettings.ReadInt(asFieldColorReal); + DatatypeCategories[dtcText].Color := AppSettings.ReadInt(asFieldColorText); + DatatypeCategories[dtcBinary].Color := AppSettings.ReadInt(asFieldColorBinary); + DatatypeCategories[dtcTemporal].Color := AppSettings.ReadInt(asFieldColorDatetime); + DatatypeCategories[dtcSpatial].Color := AppSettings.ReadInt(asFieldColorSpatial); + DatatypeCategories[dtcOther].Color := AppSettings.ReadInt(asFieldColorOther); + CalcNullColors;} + + {FDataGridSortItems := TSortItems.Create(True);} + + {DataLocalNumberFormat := AppSettings.ReadBool(asDataLocalNumberFormat); + DataGridTable := nil; + FActiveDbObj := nil;} + + {// Database tree options + actGroupObjects.Checked := AppSettings.ReadBool(asGroupTreeObjects); + if AppSettings.ReadBool(asDisplayObjectSizeColumn) then + menuShowSizeColumn.Click; + if AppSettings.ReadBool(asAutoExpand) then + menuAutoExpand.Click; + if AppSettings.ReadBool(asDoubleClickInsertsNodeText) then + menuDoubleClickInsertsNodeText.Click;} + + {// Shortcuts + FActionList1DefaultCaptions := TStringList.Create; + FActionList1DefaultHints := TStringList.Create; + for i:=0 to ActionList1.ActionCount-1 do begin + Action := TAction(ActionList1.Actions[i]); + Action.ShortCut := AppSettings.ReadInt(asActionShortcut1, Action.Name, Action.ShortCut); + FActionList1DefaultCaptions.Insert(i, Action.Caption); + FActionList1DefaultHints.Insert(i, Action.Hint); + end;} + + {// Completion proposal window + // The proposal form gets scaled a second time when it shows its form with Scaled=True. + // We already store and restore the dimensions DPI aware. + SynCompletionProposal.Form.Scaled := False; + SynCompletionProposal.TimerInterval := AppSettings.ReadInt(asCompletionProposalInterval); + SynCompletionProposal.Width := AppSettings.ReadInt(asCompletionProposalWidth); + SynCompletionProposal.NbLinesInWindow := AppSettings.ReadInt(asCompletionProposalNbLinesInWindow);} + + {// Place progressbar on the statusbar + ProgressBarStatus.Parent := StatusBar; + ProgressBarStatus.Visible := False;} + + // SynMemo font, hightlighting and shortcuts + {SetupSynEditors;} + + {PageControlMain.MultiLine := AppSettings.ReadBool(asTabsInMultipleLines); + SetMainTab(tabHost); + FBtnAddTab := TSpeedButton.Create(PageControlMain); + FBtnAddTab.Parent := PageControlMain; + VirtualImageListMain.GetBitmap(actNewQueryTab.ImageIndex, FBtnAddTab.Glyph); + FBtnAddTab.Height := PageControlMain.TabRect(0).Bottom - PageControlMain.TabRect(0).Top - 2; + FBtnAddTab.Width := FBtnAddTab.Height; + FBtnAddTab.Flat := True; + FBtnAddTab.Hint := actNewQueryTab.Hint; + FBtnAddTab.OnClick := actNewQueryTab.OnExecute;} + + {// Filter panel + VirtualImageListMain.GetBitmap(134, btnCloseFilterPanel.Glyph); + if AppSettings.ReadBool(asFilterPanel) then + actFilterPanelExecute(nil); + lblFilterVTInfo.Caption := '';} + + {SelectedTableColumns := TTableColumnList.Create; + SelectedTableKeys := TTableKeyList.Create; + SelectedTableForeignKeys := TForeignKeyList.Create; + SelectedTableTimestampColumns := TStringList.Create;} + + {// Set up connections list + FConnections := TDBConnectionList.Create; + FConnections.OnNotify := ConnectionsNotify;} + + {FTreeRefreshInProgress := False; + FGridCopying := False; + FGridPasting := False;} + + {FileEncodings := Explode(',', _('Auto detect (may fail)')+',ANSI,ASCII,Unicode,Unicode Big Endian,UTF-8,UTF-7,UTF-8-BOM');} + + {// Detect timezone offset in seconds, once + case GetTimeZoneInformation(TZI) of + TIME_ZONE_ID_STANDARD: FTimeZoneOffset := (TZI.Bias + TZI.StandardBias); + TIME_ZONE_ID_DAYLIGHT: FTimeZoneOffset := (TZI.Bias + TZI.DaylightBias); + TIME_ZONE_ID_UNKNOWN: FTimeZoneOffset := TZI.Bias; + else RaiseLastOSError; + end; + FTimeZoneOffset := FTimeZoneOffset * 60;} + + // Set noderoot for query helpers box + {treeQueryHelpers.RootNodeCount := 7;} + + // Initialize taskbar jump list + {if not IsWine then begin + FJumpList := TJumpList.Create; + FJumpList.ApplicationId := APPNAME + IntToStr(GetExecutableBits); + end;} + + FLastCaptionChange := 0; + FLastPortableSettingsSave := 0; + FLastAppSettingsWrites := 0; + //FFormatSettings := TFormatSettings.Create('en-US'); + FDefaultHintFontName := Screen.HintFont.Name; + + // Now we are free to use certain methods, which are otherwise fired too early + MainFormCreated := True; + + // Log some application details - useful when analyzing session logs + LogSQL(f_('App path: "%s"', [Application.ExeName]), lcDebug); + LogSQL(f_('Version: "%s"', [AppVersion]), lcDebug); + //LogSQL(f_('Theme: "%s"', [TStyleManager.ActiveStyle.Name]), lcDebug); + LogSQL(f_('Pixels per inch on current monitor: %d', [Monitor.PixelsPerInch]), lcDebug); + LogSQL(f_('Timezone offset: %d', [FTimeZoneOffset]), lcDebug); + + {Lib := TMySQLLib.Create(ExtractFilePath(Application.ExeName)+'libmariadb.dll', 'libmariadb.dll'); + try + test := Lib.mysql_get_client_info; + LogSQL(test); + //ShowMessage(String(Lib.mysql_get_client_info)); + except on E:Exception do + ShowMessage('Wrong error: '+E.Message); + end;} +end; + + +procedure TMainForm.AfterFormCreate; +{var + LastSessions, FileNames: TStringlist; + Connection: TDBConnection; + LoadedParams, ConnectionParams: TConnectionParameters; + LastUpdatecheck, LastStatsCall, LastConnect: TDateTime; + UpdatecheckInterval, i: Integer; + LastActiveSession, Environment, RunFrom: String; + frm : TfrmUpdateCheck; + StatsCall: THttpDownload; + SessionPaths: TStringlist; + DlgResult: TModalResult; + Tab: TQueryTab; + SessionManager: TConnForm;} +begin + {// Check for connection parameters on commandline or show connections form. + if AppSettings.ReadBool(asUpdatecheck) then begin + // Do an updatecheck if checked in settings + LastUpdatecheck := StrToDateTimeDef(AppSettings.ReadString(asUpdatecheckLastrun), DateTimeNever); + UpdatecheckInterval := AppSettings.ReadInt(asUpdatecheckInterval); + if DaysBetween(Now, LastUpdatecheck) >= UpdatecheckInterval then begin + frm := TfrmUpdateCheck.Create(Self); + frm.btnCancel.Caption := _('Skip'); + try + frm.ReadCheckFile; + // Show the dialog if release is available, or - when wanted - build checks are activated + if (AppSettings.ReadBool(asUpdatecheckBuilds) and frm.btnBuild.Enabled) + or frm.LinkLabelRelease.Enabled then begin + frm.ShowModal; + end; + except + on E:Exception do + LogSQL(f_('Error when checking for updates: %s', [E.Message])); + end; + frm.Free; // FormClose has no caFree, as it may not have been called + end; + end;} + + {// Get all session names + SessionPaths := TStringList.Create; + AppSettings.GetSessionPaths('', SessionPaths);} + + {// Probably hide image + FHasDonatedDatabaseCheck := nbUnset; + ToolBarDonate.Visible := HasDonated(True) <> nbTrue;} + + {// Call user statistics if checked in settings + if AppSettings.ReadBool(asDoUsageStatistics) then begin + LastStatsCall := StrToDateTimeDef(AppSettings.ReadString(asLastUsageStatisticCall), DateTimeNever); + if DaysBetween(Now, LastStatsCall) >= 30 then begin + // Report used app version, bits, and theme name (so we find mostly unused ones for removal) + // Also report environment: WinDesktop, WinUWP or Wine + + if IsWine then Environment := 'Wine' + else if AppSettings.PortableMode then Environment := 'WinDesktopPortable' + else Environment := 'WinDesktop'; + + StatsCall := THttpDownload.Create(Self); + StatsCall.URL := APPDOMAIN + 'savestats.php?c=' + IntToStr(FAppVerRevision) + + '&bits=' + IntToStr(GetExecutableBits) + + '&thm=' + EncodeURLParam(TStyleManager.ActiveStyle.Name) + + '&env=' + EncodeURLParam(Environment) + + '&winver=' + EncodeURLParam(IntToStr(Win32MajorVersion)+'.'+IntToStr(Win32MinorVersion)); + // Enumerate actively used server versions + for i:=0 to SessionPaths.Count-1 do begin + AppSettings.SessionPath := SessionPaths[i]; + LastConnect := StrToDateTimeDef(AppSettings.ReadString(asLastConnect), DateTimeNever); + if LastConnect > LastStatsCall then begin + StatsCall.URL := StatsCall.URL + '&s[]=' + IntToStr(AppSettings.ReadInt(asNetType)) + '-' + IntToStr(AppSettings.ReadInt(asServerVersion)); + end; + end; + AppSettings.ResetPath; + try + StatsCall.SendRequest(''); + AppSettings.WriteString(asLastUsageStatisticCall, DateTimeToStr(Now)); + except + // Silently ignore it when the url could not be called over the network. + end; + FreeAndNil(StatsCall); + end; + end;} + + {ConnectionParams := nil; + RunFrom := ''; + ParseCommandLine(GetCommandLine, ConnectionParams, FileNames, RunFrom); + + // Delete scheduled task from previous + if RunFrom = 'scheduler' then begin + DeleteRestartTask; + if HasDonated(False) <> nbTrue then begin + apphelpers.ShellExec(APPDOMAIN + 'after-updatecheck?rev=' + AppVerRevision.ToString); + end; + end; + + if ConnectionParams <> nil then begin + // Minimal parameter for command line mode is hostname + try + InitConnection(ConnectionParams, True, Connection); + except on E:Exception do + ErrorDialog(E.Message); + end; + end else if AppSettings.ReadBool(asAutoReconnect) then begin + // Auto connection via preference setting + // Do not autoconnect if we're in commandline mode and the connection was not successful + LastSessions := Explode(DELIM, AppSettings.ReadString(asLastSessions)); + LastActiveSession := AppSettings.ReadString(asLastActiveSession); + for i:=LastSessions.Count-1 downto 0 do begin + if SessionPaths.IndexOf(LastSessions[i]) = -1 then + LastSessions.Delete(i); + end; + if LastSessions.Count > 0 then begin + if LastSessions.IndexOf(LastActiveSession) = -1 then + LastActiveSession := LastSessions[0]; + for i:=0 to LastSessions.Count-1 do begin + try + LoadedParams := TConnectionParameters.Create(LastSessions[i]); + InitConnection(LoadedParams, LastActiveSession=LastSessions[i], Connection); + except on E:Exception do + ErrorDialog(E.Message); + end; + end; + end; + end;} + + {// Display session manager + if Connections.Count = 0 then begin + // Cannot be done in OnCreate because we need ready forms here: + SessionManager := TConnForm.Create(Self); + DlgResult := mrCancel; + try + DlgResult := SessionManager.ShowModal; + SessionManager.Free; + except + // Work around VCL bug: Suppress access violation in TCustomForm.IsFormSizeStored + // when closing dialog via Alt+F4 + end; + if DlgResult = mrCancel then begin + Free; + Exit; + end; + end;} + + {// Restore backup'ed query tabs + if AppSettings.RestoreTabsInitValue then begin + TimerStoreTabs.Enabled := RestoreTabs; + end;} + + {// Load SQL file(s) by command line + if not RunQueryFiles(FileNames, nil, false) then begin + for i:=0 to FileNames.Count-1 do begin + Tab := GetOrCreateEmptyQueryTab(False); + Tab.LoadContents(FileNames[i], True, nil); + if i = FileNames.Count-1 then + SetMainTab(Tab.TabSheet); + end; + end;} + + MainFormAfterCreateDone := True; +end; + + +{function TMainForm.InitTabsIniFile: TIniFile; +var + WaitingSince: UInt64; + Attempts: Integer; + TabsIniFilename: String; +begin + // Try to open tabs.ini for writing or reading + // Taking multiple application instances into account + if AppSettings.PortableMode then + TabsIniFilename := ExtractFilePath(Application.ExeName) + 'tabs.ini' + else + TabsIniFilename := AppSettings.DirnameUserAppData + 'tabs.ini'; + WaitingSince := GetTickCount64; + Attempts := 0; + while not FileIsWritable(TabsIniFilename) do begin + if GetTickCount64 - WaitingSince > 3000 then + Raise Exception.Create(f_('Could not open file %s', [TabsIniFilename])); + Sleep(200); + Inc(Attempts); + end; + if Attempts > 0 then begin + LogSQL(Format('Had to wait %d ms before opening %s', [GetTickCount64 - WaitingSince, TabsIniFilename]), lcDebug); + end; + // Catch errors when file cannot be created + if not FileExists(TabsIniFilename) then begin + SaveUnicodeFile(TabsIniFilename, '', UTF8NoBOMEncoding); + end; + Result := TIniFile.Create(TabsIniFilename); +end;} + + +{procedure TMainForm.StoreTabs; +var + Tab: TQueryTab; + Section, TabCaption: String; + Sections: TStringList; + TabsIni: TIniFile; + SectionTabExists: Boolean; + pid: Cardinal; +begin + // Store query tab unsaved contents and setup, in tabs.ini + + try + TabsIni := InitTabsIniFile; + + for Tab in QueryTabs do begin + Tab.BackupUnsavedContent; + Section := Tab.Uid; + + // Avoid writing the tabs.ini file if nothing was effectively changed + TabCaption := Tab.TabSheet.Caption; + TabCaption := TabCaption.Trim([' ','*']); + if ExecRegExpr('^'+QuoteRegExprMetaChars(_('Query')+' #')+'\d+$', TabCaption) then + TabCaption := ''; + if TabsIni.ReadString(Section, TQueryTab.IdentBackupFilename, '') <> Tab.MemoBackupFilename then + TabsIni.WriteString(Section, TQueryTab.IdentBackupFilename, Tab.MemoBackupFilename); + if TabsIni.ReadString(Section, TQueryTab.IdentFilename, '') <> Tab.MemoFilename then + TabsIni.WriteString(Section, TQueryTab.IdentFilename, Tab.MemoFilename); + if TabsIni.ReadString(Section, TQueryTab.IdentCaption, '') <> TabCaption then + TabsIni.WriteString(Section, TQueryTab.IdentCaption, TabCaption); + if TabsIni.ReadInteger(Section, TQueryTab.IdentPid, 0) <> Integer(GetCurrentProcessId) then + TabsIni.WriteInteger(Section, TQueryTab.IdentPid, Integer(GetCurrentProcessId)); + if TabsIni.ReadInteger(Section, TQueryTab.IdentEditorHeight, 0) <> Tab.pnlMemo.Height then + TabsIni.WriteInteger(Section, TQueryTab.IdentEditorHeight, Tab.pnlMemo.Height); + if TabsIni.ReadInteger(Section, TQueryTab.IdentHelpersWidth, 0) <> Tab.pnlHelpers.Width then + TabsIni.WriteInteger(Section, TQueryTab.IdentHelpersWidth, Tab.pnlHelpers.Width); + if TabsIni.ReadString(Section, TQueryTab.IdentBindParams, '') <> Tab.ListBindParams.AsText then + TabsIni.WriteString(Section, TQueryTab.IdentBindParams, Tab.ListBindParams.AsText); + if TabsIni.ReadInteger(Section, TQueryTab.IdentEditorTopLine, 1) <> Tab.Memo.TopLine then + TabsIni.WriteInteger(Section, TQueryTab.IdentEditorTopLine, Tab.Memo.TopLine); + if TabsIni.ReadBool(Section, TQueryTab.IdentTabFocused, False) <> (Tab.TabSheet = Tab.TabSheet.PageControl.ActivePage) then + TabsIni.WriteBool(Section, TQueryTab.IdentTabFocused, (Tab.TabSheet = Tab.TabSheet.PageControl.ActivePage)); + if TabsIni.ReadString(Section, TQueryTab.IdentFileEncoding, 'UTF-8') <> Tab.FileEncoding then + TabsIni.WriteString(Section, TQueryTab.IdentFileEncoding, Tab.FileEncoding); + end; + + // Tabs with deleted backup files don't get restored anyway. But a section from a closed user loaded tab + // still needs to be erased. Otherwise it's loaded on next app start again. + Sections := TStringList.Create; + TabsIni.ReadSections(Sections); + for Section in Sections do begin + // Loop through local tabs + SectionTabExists := False; + for Tab in QueryTabs do begin + if Tab.Uid = Section then begin + SectionTabExists := True; + Break; + end; + end; + // Delete tab section if tab was closed and section belongs to this app instance + pid := Cardinal(TabsIni.ReadInteger(Section, TQueryTab.IdentPid, 0)); + if (not SectionTabExists) and (pid = GetCurrentProcessId) then begin + TabsIni.EraseSection(Section); + end; + end; + + // Close file + TabsIni.Free; + except + on E:Exception do begin + TimerStoreTabs.Enabled := False; + ErrorDialog(_('Storing tab setup failed'), + 'Tabs won''t be stored in this session.' + CRLF + CRLF + + E.Message + CRLF + CRLF + + SysErrorMessage(GetLastError) + ); + end; + end; +end;} + + +{function TMainForm.RestoreTabs: Boolean; +var + Tab: TQueryTab; + Sections, SlowTabs: TStringList; + Section, Filename, BackupFilename, TabCaption: String; + TabsIni: TIniFile; + pid: Cardinal; + EditorHeight, HelpersWidth, EditorTopLine: Integer; + BindParams: String; + TabFocused: Boolean; + TabLoadStart, TabLoadTime: UInt64; + Encoding: TEncoding; +const + SlowLoadMilliseconds = 5000; + + procedure CheckSlowTabLoad(CurTab: TQueryTab); + begin + TabLoadTime := GetTickCount64 - TabLoadStart; + if TabLoadTime > SlowLoadMilliseconds then begin + SlowTabs.Add('• ' + Trim(Tab.TabSheet.Caption) + ' (' + FormatTimeNumber(TabLoadTime / 1000, True) + ')'); + end; + end; +begin + // Restore query tab setup from tabs.ini + Result := True; + + try + TabsIni := InitTabsIniFile; + LogSQL('Restoring tab setup from '+TabsIni.FileName, lcDebug); + + Sections := TStringList.Create; + TabsIni.ReadSections(Sections); + SlowTabs := TStringList.Create; + + for Section in Sections do begin + TabLoadStart := GetTickCount64; + + Filename := TabsIni.ReadString(Section, TQueryTab.IdentFilename, ''); + BackupFilename := TabsIni.ReadString(Section, TQueryTab.IdentBackupFilename, ''); + TabCaption := TabsIni.ReadString(Section, TQueryTab.IdentCaption, ''); + pid := Cardinal(TabsIni.ReadInteger(Section, TQueryTab.IdentPid, 0)); + EditorHeight := TabsIni.ReadInteger(Section, TQueryTab.IdentEditorHeight, 0); + HelpersWidth := TabsIni.ReadInteger(Section, TQueryTab.IdentHelpersWidth, 0); + BindParams := TabsIni.ReadString(Section, TQueryTab.IdentBindParams, ''); + EditorTopLine := TabsIni.ReadInteger(Section, TQueryTab.IdentEditorTopLine, 1); + TabFocused := TabsIni.ReadBool(Section, TQueryTab.IdentTabFocused, False); + Encoding := GetEncodingByName(TabsIni.ReadString(Section, TQueryTab.IdentFileEncoding, 'UTF-8')); + + // Don't restore this tab if it belongs to a different running Heidi process + if (pid > 0) and (pid <> GetCurrentProcessId) and ProcessExists(pid, APPNAME) then begin + LogSQL(IfThen(BackupFilename.IsEmpty, Filename, BackupFilename)+' loaded in process #'+pid.ToString); + Continue; + end; + + // Either we have a backup file, or a user stored file. + // Both of them may not exist. + if not BackupFilename.IsEmpty then begin + if FileExists(BackupFilename) then begin + Tab := GetOrCreateEmptyQueryTab(False); + Tab.Uid := Section; + Tab.LoadContents(BackupFilename, True, Encoding); + Tab.MemoFilename := Filename; + Tab.Memo.Modified := True; + if not TabCaption.IsEmpty then + SetTabCaption(Tab.TabSheet.PageIndex, TabCaption); + if EditorHeight > 50 then + Tab.pnlMemo.Height := EditorHeight; + // Causes sporadic long-waiters: + //if HelpersWidth > 50 then + // Tab.pnlHelpers.Width := HelpersWidth; + Tab.ListBindParams.AsText := BindParams; + Tab.BindParamsActivated := Tab.ListBindParams.Count > 0; + Tab.Memo.TopLine := EditorTopLine; + if TabFocused then + SetMainTab(Tab.TabSheet); + CheckSlowTabLoad(Tab); + end else begin + // Remove tab section if backup file is gone or inaccessible for some reason + TabsIni.EraseSection(Section); + end; + end else if not Filename.IsEmpty then begin + if FileExists(Filename) then begin + Tab := GetOrCreateEmptyQueryTab(False); + Tab.Uid := Section; + Tab.LoadContents(Filename, True, Encoding); + Tab.MemoFilename := Filename; + if not TabCaption.IsEmpty then + SetTabCaption(Tab.TabSheet.PageIndex, TabCaption); + if EditorHeight > 50 then + Tab.pnlMemo.Height := EditorHeight; + // Causes sporadic long-waiters: + //if HelpersWidth > 50 then + // Tab.pnlHelpers.Width := HelpersWidth; + Tab.ListBindParams.AsText := BindParams; + Tab.BindParamsActivated := Tab.ListBindParams.Count > 0; + Tab.Memo.TopLine := EditorTopLine; + if TabFocused then + SetMainTab(Tab.TabSheet); + CheckSlowTabLoad(Tab); + end else begin + // Remove tab section if user stored file was deleted by user + TabsIni.EraseSection(Section); + end; + end; + + end; + + Sections.Free; + // Close file + TabsIni.Free; + + // Warn user about tabs which were loading slow + if SlowTabs.Count > 0 then begin + MessageDialog( + f_('%d tab(s) took longer than expected to restore. Closing and reopening these should fix that: %s', + [SlowTabs.Count, sLineBreak + sLineBreak + SlowTabs.Text]), + mtWarning, [mbOk]); + end; + SlowTabs.Free; + + except + on E:Exception do begin + Result := False; + ErrorDialog(_('Restoring tab setup failed'), + 'Tabs won''t be stored in this session.' + CRLF + CRLF + + E.Message + CRLF + CRLF + + SysErrorMessage(GetLastError) + ); + end; + end; +end;} + + +{procedure TMainForm.SetHintFontByControl(Control: TWinControl=nil); +var + UseFontName: String; +begin + // Set hint font name to match the underlying control + if Assigned(Control) and (Control is TSynMemo) then + UseFontName := TSynMemo(Control).Font.Name + else + UseFontName := FDefaultHintFontName; + if Screen.HintFont.Name <> UseFontName then + Screen.HintFont.Name := UseFontName; +end;} + + +{procedure TMainForm.TimerStoreTabsTimer(Sender: TObject); +begin + // Backup unsaved content every 10 seconds + StoreTabs; +end;} + + +procedure TMainForm.actSessionManagerExecute(Sender: TObject); +//var + //Dialog: TConnForm; +begin + //Dialog := TConnForm.Create(Self); + //Dialog.ShowModal; + //Dialog.Free; + ShowMessage('Showing session manager...'); +end; + +{procedure TMainForm.actDisconnectExecute(Sender: TObject); +var + Connection: TDBConnection; + Node: PVirtualNode; + DlgResult: Integer; + Dialog: TConnForm; +begin + // Disconnect active connection. If it's the last, exit application + Connection := ActiveConnection; + // Find and remove connection node from tree + Node := GetRootNode(DBtree, Connection); + DBTree.DeleteNode(Node); + FConnections.Remove(Connection); + // TODO: focus last session? + SelectNode(DBtree, GetNextNode(DBtree, nil)); + if FConnections.Count = 0 then begin + Dialog := TConnForm.Create(Self); + DlgResult := Dialog.ShowModal; + Dialog.Free; + if DlgResult = mrCancel then + actExitApplication.Execute; + end; +end;} + + +{procedure TMainForm.ConnectionsNotify(Sender: TObject; const Item: TDBConnection; Action: TCollectionNotification); +var + Results: TDBQuery; + Tab: TQueryTab; + ResultTab: TResultTab; + i: Integer; + Keys, NamesInKey: TStringList; + rx: TRegExpr; + ForceDeleteTableKey: Boolean; +begin + // Connection removed or added + case Action of + cnRemoved, cnExtracted: begin + // Post pending UPDATE and release current table with result + Results := GridResult(DataGrid); + if Assigned(Results) then begin + if Results.Modified then + actDataPostChangesExecute(DataGrid); + if DataGridResult = Results then begin + FreeAndNil(DataGridResult); + DataGridTable := nil; + end; + end; + + // Remove result sets which may cause AVs when disconnected + for Tab in QueryTabs do begin + if Assigned(Tab.QueryProfile) and (Tab.QueryProfile.Connection = Item) then + FreeAndNil(Tab.QueryProfile); + for ResultTab in Tab.ResultTabs do begin + if ResultTab.Results.Connection = Item then begin + Tab.ResultTabs.Clear; + Tab.tabsetQuery.Tabs.Clear; + break; + end; + end; + end; + for i:=0 to FHostListResults.Count-1 do begin + if (FHostListResults[i] <> nil) and (FHostListResults[i].Connection = Item) then begin + FHostListResults[i].Free; + FHostListResults[i] := nil; + end; + end; + + // Remove table keys if unwanted or empty + ForceDeleteTableKey := not AppSettings.ReadBool(asReuseEditorConfiguration); + AppSettings.SessionPath := Item.Parameters.SessionPath; + Keys := AppSettings.GetKeyNames; + rx := TRegExpr.Create; + rx.Expression := '.+'+QuoteRegExprMetaChars(DELIM)+'.+'; + for i:=0 to Keys.Count-1 do begin + if rx.Exec(Keys[i]) then begin + AppSettings.SessionPath := Item.Parameters.SessionPath + '\' + Keys[i]; + NamesInKey := AppSettings.GetValueNames; + if (NamesInKey.Count = 0) or ForceDeleteTableKey then begin + AppSettings.DeleteCurrentKey; + end; + end; + end; + rx.Free; + + FreeAndNil(ActiveObjectEditor); + RefreshHelperNode(TQueryTab.HelperNodeProfile); + RefreshHelperNode(TQueryTab.HelperNodeColumns); + + // Last chance to access connection related properties before disconnecting + + // Disconnect + Item.Active := False; + end; + + // New connection + cnAdded: DBTree.InsertNode(DBTree.GetLastChild(nil), amInsertAfter); + end; +end;} + + +{procedure TMainForm.actCreateDatabaseExecute(Sender: TObject); +begin + // Create database: + FCreateDatabaseDialog := TCreateDatabaseForm.Create(Self); + FCreateDatabaseDialog.ShowModal; + FreeAndNil(FCreateDatabaseDialog); +end;} + + +{procedure TMainForm.actImportCSVExecute(Sender: TObject); +var + Dialog: Tloaddataform; +begin + // Import Textfile + Dialog := Tloaddataform.Create(Self); + Dialog.ShowModal; + Dialog.Free; +end;} + +{procedure TMainForm.actPreferencesExecute(Sender: TObject); +begin + // Preferences + frmPreferences := TfrmPreferences.Create(Self); + if Sender = actPreferencesLogging then + frmPreferences.pagecontrolMain.ActivePage := frmPreferences.tabLogging + else if Sender = actPreferencesData then + frmPreferences.pagecontrolMain.ActivePage := frmPreferences.tabGridFormatting; + frmPreferences.ShowModal; + frmPreferences.Free; + frmPreferences := nil; // Important in SetupSynEditors +end;} + +{procedure TMainForm.actHelpExecute(Sender: TObject); +begin + // Display help document + Help(Sender, ''); +end;} + +{procedure TMainForm.FormResize(Sender: TObject); +var + PanelRect: TRect; + w0, w1, w2, w3, w4, w5, w6: Integer; + + function CalcPanelWidth(SampleText: String; MaxPercentage: Integer): Integer; + var + MaxPixels: Integer; + begin + MaxPixels := StatusBar.Canvas.TextWidth(SampleText) + VirtualImageListMain.Width + 20; + Result := Round(Min(MaxPixels, Width / 100 * MaxPercentage)); + end; +begin + // Exit early when user pressed "Cancel" on connection dialog + if csDestroying in ComponentState then + Exit; + // No need to resize anything if main window is minimized (= not visible) + if WindowState = wsMinimized then + Exit; + + // Super intelligent calculation of status bar panel width + w1 := CalcPanelWidth('r10 : c10 (10 KiB)', 10); + w2 := CalcPanelWidth('Connected: 1 day, 00:00 h', 10); + w3 := CalcPanelWidth('MariaDB or MySQL 5.7.6', 15); + w4 := CalcPanelWidth('Uptime: 13 days, 00:00 h', 15); + w5 := CalcPanelWidth('Server time: 20:00 ', 10); + w6 := CalcPanelWidth('DummyDummyDummyDummyDummy', 20); + w0 := StatusBar.Width - w1 - w2 - w3 - w4 - w5 - w6; + //logsql(format('IconWidth:%d 0:%d 1:%d 2:%d 3:%d 4:%d 5:%d 6:%d', [VirtualImageListMain.Width, w0, w1, w2, w3, w4, w5, w6])); + StatusBar.Panels[0].Width := w0; + StatusBar.Panels[1].Width := w1; + StatusBar.Panels[2].Width := w2; + StatusBar.Panels[3].Width := w3; + StatusBar.Panels[4].Width := w4; + StatusBar.Panels[5].Width := w5; + StatusBar.Panels[6].Width := w6; + + // Retreive the rectancle of the statuspanel (in our case the fifth panel) + if not IsWine then begin + SendMessage(StatusBar.Handle, SB_GETRECT, 5, Integer(@PanelRect)); + // Position the progressbar over the panel on the statusbar + ProgressBarStatus.SetBounds( + PanelRect.Left, + PanelRect.Top, + PanelRect.Right-PanelRect.Left, + PanelRect.Bottom-PanelRect.Top + ); + end; + + lblDataTop.Width := pnlDataTop.Width - tlbDataButtons.Width - 10; + FixQueryTabCloseButtons; + + // Right aligned button + // Do not set ToolBar.Align to alRight. See issue #1967 + if ToolBarDonate.Visible then begin + //ToolBarDonate.Width := ToolBarDonate.Buttons[0].Width; + ToolBarDonate.Left := ControlBarMain.Width - ToolBarDonate.Width; + //ToolBarDonate.Buttons[0].Height := ToolBarMainButtons.Buttons[0].Height; + end; + +end;} + +{procedure TMainForm.FormShow(Sender: TObject); +begin + // Window dimensions + if WindowState <> wsMaximized then begin + Width := AppSettings.ReadIntDpiAware(asMainWinWidth, Self); + Height := AppSettings.ReadIntDpiAware(asMainWinHeight, Self); + end; + + LogSQL(f_('Scaling controls to screen DPI: %d%%', [Round(ScaleFactor*100)])); + if TStyleManager.IsCustomStyleActive and (ScaleFactor<>1) then begin + LogSQL(f_('Caution: Style "%s" selected and non-default DPI factor - be aware that some styles appear broken with high DPI settings!', [TStyleManager.ActiveStyle.Name])); + end; + + + // Restore width of columns of all VirtualTrees + RestoreListSetup(ListDatabases); + RestoreListSetup(ListVariables); + RestoreListSetup(ListStatus); + RestoreListSetup(ListProcesses); + RestoreListSetup(ListCommandStats); + RestoreListSetup(ListTables); + + // Fix node height on Virtual Trees for current DPI settings + FixVT(DBTree); + FixVT(ListDatabases); + FixVT(ListVariables); + FixVT(ListStatus); + FixVT(ListProcesses); + FixVT(ListCommandStats); + FixVT(ListTables); + FixVT(treeQueryHelpers); + + // Manually set focus to tree - otherwise the database filter as the first + // control catches focus on startup, which is ugly. + if DBtree.CanFocus then + DBtree.SetFocus; + + // Apply resize event and call it once here in OnShow, when the form has its final dimensions + OnResize := FormResize; + OnResize(Sender); + + // Simulated link label, has non inherited blue font color + lblExplainProcess.Font.Color := clBlue; + + // Call once after all query tabs were created: + ValidateControls(Sender); +end;} + +{procedure TMainForm.AddEditorCommandMenu(const S: string); +begin + FEditorCommandStrings.Add(S); +end;} + +{procedure TMainForm.EditorCommandOnClick(Sender: TObject); +var + EditorCommand: TSynEditorCommand; + Editor: TSynMemo; +begin + EditorCommand := IndexToEditorCommand(TMenuItem(Sender).MenuIndex); + Editor := ActiveSynMemo(False); + if Assigned(Editor) then begin + Editor.BeginUndoBlock; + Editor.ExecuteCommand(EditorCommand, #0, nil); + Editor.EndUndoBlock; + end; +end;} + +{procedure TMainForm.actUserManagerExecute(Sender: TObject); +var + Dialog: TUserManagerForm; +begin + Dialog := TUserManagerForm.Create(Self); + Dialog.ShowModal; + Dialog.Free; +end;} + +{procedure TMainForm.actAboutBoxExecute(Sender: TObject); +var + Box: TAboutBox; +begin + // Info-Box + Box := TAboutBox.Create(Self); + Box.ShowModal; + Box.Free; +end;} + +{procedure TMainForm.actClearEditorExecute(Sender: TObject); +var + m: TSynMemo; +begin + if Sender = actClearQueryEditor then begin + m := QueryTabs.ActiveMemo + end else if Sender = actClearQueryLog then begin + m := SynMemoSQLLog; + m.Gutter.LineNumberStart := m.Gutter.LineNumberStart + m.Lines.Count; + end else begin + m := SynMemoFilter; + editFilterSearch.Clear; + end; + m.SelectAll; + m.SelText := ''; + m.SelStart := 0; + m.SelEnd := 0; + if Sender = actClearQueryEditor then begin + QueryTabs.ActiveTab.MemoFilename := ''; + QueryTabs.ActiveTab.Memo.Modified := False; + QueryTabs.ActiveTab.Uid := ''; + end; + if m = SynMemoFilter then begin + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); + end; +end;} + + +{procedure TMainForm.menuClearDataTabFilterClick(Sender: TObject); +begin + // Same as "Clear filter" button, but *before* the data tab is activated + AppSettings.SessionPath := GetRegKeyTable; + if AppSettings.ValueExists(asFilter) then begin + AppSettings.DeleteValue(asFilter); + LogSQL(f_('Data filter for %s deleted', [ActiveDbObj.Name]), lcInfo); + end; + if AppSettings.ValueExists(asSort) then begin + AppSettings.DeleteValue(asSort); + LogSQL(f_('Sort order for %s deleted', [ActiveDbObj.Name]), lcInfo); + end; +end;} + + +{procedure TMainForm.actTableToolsExecute(Sender: TObject); +var + Node: PVirtualNode; + DBObj: PDBObject; +begin + // Show table tools dialog + FTableToolsDialog := TfrmTableTools.Create(Self); + FTableToolsDialog.PreSelectObjects.Clear; + if DBTreeClicked(Sender) then + FTableToolsDialog.PreSelectObjects.Add(ActiveDbObj) + else begin + Node := GetNextNode(ListTables, nil, True); + while Assigned(Node) do begin + DBObj := ListTables.GetNodeData(Node); + FTableToolsDialog.PreSelectObjects.Add(DBObj^); + Node := GetNextNode(ListTables, Node, True); + end; + end; + if Sender = actMaintenance then + FTableToolsDialog.ToolMode := tmMaintenance + else if Sender = actFindTextOnServer then + FTableToolsDialog.ToolMode := tmFind + else if Sender = actExportTables then + FTableToolsDialog.ToolMode := tmSQLExport + else if Sender = actBulkTableEdit then + FTableToolsDialog.ToolMode := tmBulkTableEdit + else if Sender = actGenerateData then + FTableToolsDialog.ToolMode := tmGenerateData; + FTableToolsDialog.ShowModal; + FreeAndNil(FTableToolsDialog); +end;} + + +{procedure TMainForm.actUnixTimestampColumnExecute(Sender: TObject); +var + i: Integer; + FocusedColumnName: String; + GridColumn: TVirtualTreeColumn; +begin + // Mark focused column as UNIX timestamp column + AppSettings.SessionPath := GetRegKeyTable; + GridColumn := DataGrid.Header.Columns[DataGrid.FocusedColumn]; + FocusedColumnName := GridColumn.Text; + i := SelectedTableTimestampColumns.IndexOf(FocusedColumnName); + if i > -1 then + SelectedTableTimestampColumns.Delete(i); + if (Sender as TAction).Checked then begin + SelectedTableTimestampColumns.Add(FocusedColumnName); + if GridColumn.ImageIndex = -1 then + GridColumn.ImageIndex := 149; + end else begin + if GridColumn.ImageIndex = 149 then + GridColumn.ImageIndex := -1; + end; + if SelectedTableTimestampColumns.Count > 0 then + AppSettings.WriteString(asTimestampColumns, SelectedTableTimestampColumns.Text) + else if AppSettings.ValueExists(asTimestampColumns) then + AppSettings.DeleteValue(asTimestampColumns); + + AppSettings.ResetPath; + DataGrid.Invalidate; +end;} + + +{function TMainForm.HandleUnixTimestampColumn(Sender: TBaseVirtualTree; Column: TColumnIndex): Boolean; +var + ResultCol: Integer; +begin + // Shorthand for various places where we would normally have to add all these conditions + ResultCol := Column - 1; + Result := (Sender = DataGrid) + and (ResultCol > NoColumn) + and (DataGridResult <> nil) + and (DataGridResult.DataType(ResultCol).Category in [dtcInteger, dtcReal]) + and (SelectedTableTimestampColumns.IndexOf(DataGrid.Header.Columns[Column].Text) > -1); +end;} + + +{** + Edit view +} +{procedure TMainForm.actPrintListExecute(Sender: TObject); +var + f: TForm; +begin + // Print contents of a list or grid + f := TPrintlistForm.Create(Self); + f.ShowModal; + FreeAndNil(f); +end;} + + +{procedure TMainForm.actCopyTableExecute(Sender: TObject); +var + Dialog: TCopyTableForm; +begin + // copy table + Dialog := TCopyTableForm.Create(Self); + Dialog.ShowModal; + Dialog.Free; +end;} + + +{procedure TMainForm.actCopyTabsToSpacesExecute(Sender: TObject); +begin + // issue #1285: copy text with tabs converted to spaces + actCopyOrCutExecute(Sender); + Clipboard.TryAsText := StringReplace(Clipboard.TryAsText, #9, ' ', [rfReplaceAll]); +end;} + +{procedure TMainForm.actCopyUpdate(Sender: TObject); +begin + actCopyTabsToSpaces.Enabled := actCopy.Enabled; +end;} + +{procedure TMainForm.menuConnectionsPopup(Sender: TObject); +var + i: integer; + item: TMenuItem; + SessionPaths: TStringList; + Connection: TDBConnection; +begin + // Delete dynamically added connection menu items. + menuConnections.Items.Clear; + + // "Session manager" and "New window" items + item := TMenuItem.Create(menuConnections); + item.Action := actSessionManager; + item.Default := True; + menuConnections.Items.Add(item); + item := TMenuItem.Create(menuConnections); + item.Action := actNewWindow; + menuConnections.Items.Add(item); + item := TMenuItem.Create(menuConnections); + item.Caption := '-'; + menuConnections.Items.Add(item); + + // All sessions + SessionPaths := TStringList.Create; + AppSettings.GetSessionPaths('', SessionPaths); + for i:=0 to SessionPaths.Count-1 do begin + item := TMenuItem.Create(menuConnections); + item.Caption := EscapeHotkeyPrefix(SessionPaths[i]); + item.OnClick := SessionConnect; + for Connection in Connections do begin + if SessionPaths[i] = Connection.Parameters.SessionPath then begin + item.Checked := True; + break; + end; + end; + menuConnections.Items.Add(item); + end; + +end;} + + +{procedure TMainForm.MainMenuFileClick(Sender: TObject); +var + Item: TMenuItem; + i: Integer; + SessionPaths: TStringList; + Connection: TDBConnection; +begin + // Add all sessions to submenu + menuConnectTo.Clear; + SessionPaths := TStringList.Create; + AppSettings.GetSessionPaths('', SessionPaths); + for i:=0 to SessionPaths.Count-1 do begin + Item := TMenuItem.Create(menuConnectTo); + Item.Caption := EscapeHotkeyPrefix(SessionPaths[i]); + Item.OnClick := SessionConnect; + for Connection in Connections do begin + if SessionPaths[i] = Connection.Parameters.SessionPath then begin + Item.Checked := True; + break; + end; + end; + menuConnectTo.Add(Item); + end; +end;} + + +{procedure TMainForm.actWebbrowse(Sender: TObject); +begin + // Browse to URL (hint) + ShellExec( TAction(Sender).Hint ); +end;} + + +{procedure TMainForm.DonateClick(Sender: TObject); +var + Dialog: TWinControl; + place: String; +begin + // Click on one of the various donate buttons + if Sender is TWinControl then begin + Dialog := GetParentFormOrFrame(TWinControl(Sender)); + end else begin + Dialog := Self; + end; + if Dialog = nil then + ErrorDialog(f_('Could not determine parent form of this %s', [Sender.ClassName])) + else begin + place := LowerCase(Dialog.UnitName); + ShellExec(APPDOMAIN + 'donatebutton.php?place=' + EncodeURLParam(place)); + end; +end;} + + +{procedure TMainForm.actExportSettingsExecute(Sender: TObject); +var + Dialog: TSaveDialog; +begin + // Export settings to .txt file + Dialog := TSaveDialog.Create(Self); + Dialog.Title := f_('Export %s settings to file ...', [APPNAME]); + Dialog.DefaultExt := 'txt'; + Dialog.Filter := _('Text files')+' (*.txt)|*.txt|'+_('All files')+' (*.*)|*.*'; + Dialog.Options := Dialog.Options + [ofOverwritePrompt]; + if Dialog.Execute then try + AppSettings.ExportSettings(Dialog.FileName); + MessageDialog(f_('Settings successfully exported to %s', [Dialog.FileName]), mtInformation, [mbOK]); + except + on E:Exception do + ErrorDialog(E.Message); + end; + Dialog.Free; +end;} + + +{procedure TMainForm.actImportSettingsExecute(Sender: TObject); +var + Dialog: TOpenDialog; +begin + // Import settings from .txt or .reg file + Dialog := TOpenDialog.Create(Self); + Dialog.Title := f_('Import %s settings from file ...', [APPNAME]); + Dialog.Filter := _('Text files')+' (*.txt)|*.txt|'+_('Registry dump, deprecated')+' (*.reg)|*.reg|'+_('All files')+' (*.*)|*.*'; + ImportSettingsDone := False; + if Dialog.Execute then try + if LowerCase(ExtractFileExt(Dialog.FileName)) = 'reg' then + ShellExec('regedit.exe', '', '"'+Dialog.FileName+'"') + else begin + AppSettings.ImportSettings(Dialog.FileName); + MessageDialog(f_('Settings successfully restored from %s', [Dialog.FileName]), mtInformation, [mbOK]); + end; + ImportSettingsDone := True; + except + on E:Exception do + ErrorDialog(E.Message); + end; + Dialog.Free; +end;} + + +{function TMainForm.GetCurrentQuery(Tab: TQueryTab): String; +var + BatchAll: TSQLBatch; + Query, PrevQuery: TSQLSentence; +begin + // Return SQL query on cursor position + Result := ''; + BatchAll := TSQLBatch.Create; + BatchAll.SQL := Tab.Memo.Text; + PrevQuery := nil; + for Query in BatchAll do begin + if (Tab.Memo.SelStart >= Query.LeftOffset-1) and (Tab.Memo.SelStart < Query.RightOffset) then begin + Result := Query.SQL; + Tab.LeftOffsetInMemo := Query.LeftOffset; + break; + end; + PrevQuery := Query; + end; + // Prefer query left to the current one, if current one contains no text + if Trim(Result).IsEmpty and Assigned(PrevQuery) then begin + Result := PrevQuery.SQL; + Tab.LeftOffsetInMemo := PrevQuery.LeftOffset; + end; + BatchAll.Free; +end;} + + +{procedure TMainForm.actExecuteQueryExecute(Sender: TObject); +var + ProfileNode: PVirtualNode; + Batch: TSQLBatch; + Tab: TQueryTab; + BindParam: Integer; + NewSQL, msg, Command, SQLNoComments, CurrentQuery: String; + Query: TSQLSentence; + rx: TRegExpr; + ContainsUnsafeQueries, DoExecute: Boolean; +begin + Tab := QueryTabs.ActiveTab; + OperationRunning(True); + DoExecute := True; + + ShowStatusMsg(_('Splitting SQL queries ...')); + Batch := TSQLBatch.Create; + if Sender = actExecuteSelection then begin + Batch.SQL := Tab.Memo.SelText; + Tab.LeftOffsetInMemo := Tab.Memo.SelStart; + end else if Sender = actExecuteCurrentQuery then begin + Batch.SQL := GetCurrentQuery(Tab); + end else if Sender = actExplainCurrentQuery then begin + CurrentQuery := GetCurrentQuery(Tab); + if CurrentQuery.Trim.IsEmpty then begin + ErrorDialog(_('Current query is empty'), _('Please move the cursor inside the query you want to use.')); + DoExecute := False; + end else begin + Batch.SQL := 'EXPLAIN ' + CurrentQuery; + end; + end else begin + Batch.SQL := Tab.Memo.Text; + Tab.LeftOffsetInMemo := 0; + end; + + // Check if there is bind parameters + if (tab.ListBindParams.Count > 0) and DoExecute then begin + NewSQL := Batch.SQL; + // Replace all parameters by their values + // by descending to avoid having problems with similar variables name (eg test & test1) + for BindParam := tab.ListBindParams.Count-1 downto 0 do begin + // Do the Replace only if there is a value + if Length(tab.ListBindParams.Items[BindParam].Value)>0 then begin + NewSQL := StringReplace(NewSQL, + tab.ListBindParams.Items[BindParam].Name, + tab.ListBindParams.Items[BindParam].Value, + [rfReplaceAll]); + end; + end; + + Batch.SQL := NewSQL; + end; + + if AppSettings.ReadBool(asWarnUnsafeUpdates) and DoExecute then begin + ShowStatusMsg(_('Checking queries for unsafe UPDATEs/DELETEs ...')); + rx := TRegExpr.Create; + rx.ModifierI := True; + rx.Expression := '\sWHERE\s'; + ContainsUnsafeQueries := False; + for Query in Batch do begin + SQLNoComments := Query.SQLWithoutComments; + Command := UpperCase(getFirstWord(SQLNoComments)); + if ((Command = 'UPDATE') or (Command = 'DELETE')) and (not rx.Exec(SQLNoComments)) then begin + ContainsUnsafeQueries := True; + Break; + end; + end; + rx.Free; + if ContainsUnsafeQueries then begin + msg := _('Your query contains UPDATEs and/or DELETEs without a WHERE clause. Please confirm that you know what you''re doing.'); + DoExecute := MessageDialog(_('Run unsafe queries without a WHERE clause?'), msg, mtConfirmation, [mbYes, mbNo], asWarnUnsafeUpdates) = mrYes; + end; + end; + + + if DoExecute then begin + Screen.Cursor := crHourGlass; + EnableProgress(Batch.Count); + Tab.ResultTabs.Clear; + Tab.tabsetQuery.Tabs.Clear; + FreeAndNil(Tab.QueryProfile); + ProfileNode := FindNode(Tab.treeHelpers, TQueryTab.HelperNodeProfile, nil); + Tab.DoProfile := Assigned(ProfileNode) and (Tab.treeHelpers.CheckState[ProfileNode] in CheckedStates); + if Tab.DoProfile then try + ActiveConnection.Query('SET profiling=1'); + except + on E:EDbError do begin + ErrorDialog(f_('Query profiling requires %s or later, and the server must not be configured with %s.', ['MySQL 5.0.37', '--disable-profiling']), E.Message); + Tab.DoProfile := False; + end; + end; + + // Start the execution thread + Screen.Cursor := crAppStart; + ActiveConnection.Ping(True); // Prevents SynEdit paint exceptions if connection was killed outside + Tab.QueryRunning := True; + Tab.ExecutionThread := TQueryThread.Create(ActiveConnection, Batch, Tab.Number); + end; + + ValidateQueryControls(Sender); +end;} + + + +{procedure TMainForm.BeforeQueryExecution(Thread: TQueryThread); +begin + // Update GUI stuff + SetProgressPosition(Thread.BatchPosition); +end;} + + +{procedure TMainForm.AfterQueryExecution(Thread: TQueryThread); +var + Tab: TQueryTab; + NewTab: TResultTab; + col: TVirtualTreeColumn; + TabCaption, TabCaptions, BatchHead: String; + TabCaptionsList: TStringList; + TabsetColor: TColor; + Results: TDBQuery; + i, HeaderPadding, HeaderLineBreaks: Integer; +begin + // Single query or query packet has finished + + ShowStatusMsg(_('Setting up result grid(s) ...')); + Tab := QueryTabs.TabByNumber(Thread.TabNumber); + + // Use session color on result tabs + TabsetColor := Thread.Connection.Parameters.SessionColor; + if TabsetColor <> clNone then begin + Tab.tabsetQuery.SelectedColor := TabsetColor; + Tab.tabsetQuery.UnselectedColor := ColorAdjustLuma(TabsetColor, 20, False); + end + else begin + Tab.tabsetQuery.SelectedColor := clWindow; + Tab.tabsetQuery.UnselectedColor := clBtnFace; + end; + + // Get tab caption list from comment, similar to a name:xyz in a single query + BatchHead := Copy(Thread.Batch.SQL, 1, SIZE_KB); + TabCaptions := RegExprGetMatch('--\s+names\:\s*([^\r\n]+)', BatchHead, 1, False, True); + TabCaptionsList := Explode(',', TabCaptions); + LogSQL('TabCaptionsList: '+TabCaptionsList.CommaText, lcDebug); + // Create result tabs + for Results in Thread.Connection.GetLastResults do begin + NewTab := TResultTab.Create(Tab); + Tab.ResultTabs.Add(NewTab); + NewTab.Results := Results; + try + TabCaption := NewTab.Results.ResultName; + if TabCaption.IsEmpty and (TabCaptionsList.Count > NewTab.TabIndex) then + TabCaption := TabCaptionsList[NewTab.TabIndex]; + if TabCaption.IsEmpty then + TabCaption := NewTab.Results.TableName; + except + on E:EDbError do begin + TabCaption := _('Result')+' #'+IntToStr(NewTab.TabIndex+1); + end; + end; + TabCaption := Trim(TabCaption); + TabCaption := TabCaption + ' (' + FormatNumber(Results.RecordCount) + 'r × ' + FormatNumber(Results.ColumnCount) + 'c)'; + Tab.tabsetQuery.Tabs.Add(TabCaption); + NewTab.Grid.Name := Format('Tab%dGrid%d', [Tab.Number, NewTab.TabIndex+1]); + + NewTab.Grid.BeginUpdate; + NewTab.Grid.Header.Options := NewTab.Grid.Header.Options + [hoVisible]; + NewTab.Grid.Header.Columns.BeginUpdate; + NewTab.Grid.Header.Columns.Clear; + HeaderLineBreaks := 0; + HeaderPadding := NewTab.Grid.Header.Height - GetTextHeight(NewTab.Grid.Font); + col := NewTab.Grid.Header.Columns.Add; + col.CaptionAlignment := taRightJustify; + col.Alignment := taRightJustify; + col.Options := col.Options + [coFixed]- [coAllowClick, coAllowFocus, coEditable, coResizable]; + if not AppSettings.ReadBool(asShowRowId) then + col.Options := col.Options - [coVisible]; + col.Text := '#'; + for i:=0 to NewTab.Results.ColumnCount-1 do begin + col := NewTab.Grid.Header.Columns.Add; + col.Text := NewTab.Results.ColumnNames[i]; + if NewTab.Results.DataType(i).Category in [dtcInteger, dtcReal] then + col.Alignment := taRightJustify; + if NewTab.Results.ColIsPrimaryKeyPart(i) then + col.ImageIndex := ICONINDEX_PRIMARYKEY + else if NewTab.Results.ColIsUniqueKeyPart(i) then + col.ImageIndex := ICONINDEX_UNIQUEKEY + else if NewTab.Results.ColIsKeyPart(i) then + col.ImageIndex := ICONINDEX_INDEXKEY; + HeaderLineBreaks := Max(HeaderLineBreaks, col.text.CountChar(#10)); + end; + NewTab.Grid.Header.Columns.EndUpdate; + NewTab.Grid.Header.Height := GetTextHeight(NewTab.Grid.Font) * (HeaderLineBreaks+1) + HeaderPadding; + NewTab.Grid.RootNodeCount := NewTab.Results.RecordCount; + NewTab.Grid.EndUpdate; + for i:=0 to NewTab.Grid.Header.Columns.Count-1 do + AutoCalcColWidth(NewTab.Grid, i); + if Tab.tabsetQuery.TabIndex = -1 then + Tab.tabsetQuery.TabIndex := 0; + end; + ShowStatusMsg; +end;} + + +{procedure TMainForm.FinishedQueryExecution(Thread: TQueryThread); +var + Tab: TQueryTab; + MetaInfo, ErroneousSQL, RegName: String; + ProfileAllTime: Extended; + ProfileNode: PVirtualNode; + History: TQueryHistory; + HistoryItem: TQueryHistoryItem; + HistoryNum, RegItemsSize, KeepDays: Integer; + DoDelete, ValueFound: Boolean; + MinDate: TDateTime; + + procedure GoToErrorPos(Err: String); + var + rx: TRegExpr; + SelStart, ErrorPos: Integer; + ErrorCoord: TBufferCoord; + begin + // Try to set memo cursor to the relevant position + if Tab.LeftOffsetInMemo > 0 then + SelStart := Tab.LeftOffsetInMemo-1 + else + SelStart := Thread.Batch[Thread.BatchPosition].LeftOffset-1; + + // Extract erroneous portion of SQL out of error message + ErroneousSQL := ''; + rx := TRegExpr.Create; + rx.Expression := 'for the right syntax to use near ''(.+)'' at line (\d+)'; + if rx.Exec(Err) then + ErroneousSQL := rx.Match[1]; + rx.Expression := 'Duplicate entry ''([^'']+)'''; + if rx.Exec(Err) then + ErroneousSQL := rx.Match[1]; + rx.Free; + + if ErroneousSQL <> '' then begin + // Examine 1M of memo text at given offset + ErrorPos := Pos(ErroneousSQL, Copy(Tab.Memo.Text, SelStart, SIZE_MB)); + if ErrorPos > 0 then begin + Inc(SelStart, ErrorPos-1); + Tab.Memo.SelLength := 0; + Tab.Memo.SelStart := SelStart; + ErrorCoord := Tab.Memo.CharIndexToRowCol(SelStart); + Tab.ErrorLine := ErrorCoord.Line; + end; + end; + end; + +begin + // Find right query tab + Tab := QueryTabs.TabByNumber(Thread.TabNumber); + + // Error handling + if not Thread.ErrorMessage.IsEmpty then begin + SetProgressState(pbsError); + GoToErrorPos(Thread.ErrorMessage); + ErrorDialog(Thread.ErrorMessage); + end; + + // Gather meta info for logging + MetaInfo := _('Affected rows')+': '+FormatNumber(Thread.RowsAffected)+ + ' '+_('Found rows')+': '+FormatNumber(Thread.RowsFound)+ + ' '+_('Warnings')+': '+FormatNumber(Thread.WarningCount)+ + ' '+_('Duration for')+' ' + FormatNumber(Thread.BatchPosition); + if Thread.BatchPosition < Thread.Batch.Count then + MetaInfo := MetaInfo + ' ' + _('of') + ' ' + FormatNumber(Thread.Batch.Count); + if Thread.Batch.Count = 1 then + MetaInfo := MetaInfo + ' ' + _('query') + else + MetaInfo := MetaInfo + ' ' + _('queries'); + if Thread.QueryTime < 60*1000 then + MetaInfo := MetaInfo + ': '+FormatNumber(Thread.QueryTime/1000, 3) +' ' + _('sec.') + else + MetaInfo := MetaInfo + ': '+FormatTimeNumber(Thread.QueryTime/1000, True); + if Thread.QueryNetTime > 0 then + MetaInfo := MetaInfo + ' (+ '+FormatNumber(Thread.QueryNetTime/1000, 3) +' ' + _('sec.') + ' ' + _('network') + ')'; + LogSQL(MetaInfo); + + // Display query profile + if Tab.DoProfile then begin + Tab.QueryProfile := Thread.Connection.GetResults('SHOW PROFILE'); + Tab.ProfileTime := 0; + Tab.MaxProfileTime := 0; + while not Tab.QueryProfile.Eof do begin + ProfileAllTime := MakeFloat(Tab.QueryProfile.Col(1)); + Tab.ProfileTime := Tab.ProfileTime + ProfileAllTime; + Tab.MaxProfileTime := Max(Time, Tab.MaxProfileTime); + Tab.QueryProfile.Next; + end; + ProfileNode := FindNode(Tab.treeHelpers, TQueryTab.HelperNodeProfile, nil); + Tab.treeHelpers.ReinitNode(ProfileNode, True); + Tab.treeHelpers.InvalidateChildren(ProfileNode, True); + Thread.Connection.Query('SET profiling=0'); + end; + + // Store successful query packet in history if it's not a batch. + // Assume that a bunch of up to 5 queries is not a batch. + AppSettings.ResetPath; + if AppSettings.ReadBool(asQueryHistoryEnabled) + and Thread.ErrorMessage.IsEmpty + and (Thread.Batch.Count <= 5) + and (Thread.Batch.Size <= SIZE_MB) + then begin + ShowStatusMsg(_('Updating query history ...')); + KeepDays := AppSettings.ReadInt(asQueryHistoryKeepDays); + + // Load all items so we can clean up + History := TQueryHistory.Create(Thread.Connection.Parameters.SessionPath); + + // Find lowest unused item number + HistoryNum := 0; + while True do begin + Inc(HistoryNum); + RegName := IntToStr(HistoryNum); + ValueFound := False; + for HistoryItem in History do begin + if HistoryItem.RegValue = HistoryNum then begin + ValueFound := True; + Break; + end; + end; + if not ValueFound then + break; + end; + + // Delete identical history items to avoid spam + // Delete old items + // Delete items which exceed a max datasize barrier + AppSettings.SessionPath := Thread.Connection.Parameters.SessionPath + '\' + REGKEY_QUERYHISTORY; + MinDate := IncDay(Now, -KeepDays); + RegItemsSize := Thread.Batch.Size; + for HistoryItem in History do begin + Inc(RegItemsSize, Length(HistoryItem.SQL)); + DoDelete := (HistoryItem.SQL = Thread.Batch.SQL) + or (HistoryItem.Time < MinDate) + or (RegItemsSize > SIZE_MB); + if DoDelete then + AppSettings.DeleteValue(IntToStr(HistoryItem.RegValue)); + end; + History.Free; + + // Store history item and closing registry key to ensure writing has finished + try + AppSettings.WriteString(RegName, DateTimeToStr(Now) + DELIM + + Thread.Connection.Database + DELIM + + IntToStr(Thread.QueryTime+Thread.QueryNetTime) + DELIM + + Thread.Batch.SQL); + except + // Silence sporadic boring write errors. See http://www.heidisql.com/forum.php?t=13088 + on E:ERegistryException do + LogSQL(f_('Error when updating query history: %s', [E.Message]), lcError); + end; + + RefreshHelperNode(TQueryTab.HelperNodeHistory); + end; + + // Clean up + DisableProgress; + Tab.QueryRunning := False; + ValidateControls(Thread); + OperationRunning(False); + Screen.Cursor := crDefault; + ShowStatusMsg; +end;} + + +{procedure TMainForm.tabsetQueryClick(Sender: TObject); +var + QueryTab: TQueryTab; + i: Integer; +begin + // Result tab clicked / changed + Screen.Cursor := crHourGlass; + QueryTab := nil; + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i].tabsetQuery = Sender then begin + QueryTab := QueryTabs[i]; + break; + end; + end; + for i:=0 to QueryTab.ResultTabs.Count-1 do + QueryTab.ResultTabs[i].Grid.Hide; + if QueryTab.ActiveResultTab <> nil then begin + QueryTab.ActiveResultTab.Grid.Show; + // Reset filter if filter panel was disabled + UpdateFilterPanel(Sender); + end; + // Ensure controls are in a valid state + ValidateControls(Sender); + Screen.Cursor := crDefault; + ShowStatusMsg; +end;} + + +{procedure TMainForm.tabsetQueryGetImageIndex(Sender: TObject; TabIndex: Integer; + var ImageIndex: Integer); +begin + // Give result tabs of editable results a table icon + try + QueryTabs.ActiveTab.ResultTabs[TabIndex].Results.TableName; + ImageIndex := 14; + except + ImageIndex := -1; + end; +end;} + + +{procedure TMainForm.actExportDataExecute(Sender: TObject); +var + ExportDialog: TfrmExportGrid; +begin + // Save data in current dataset into various text file formats + ExportDialog := TfrmExportGrid.Create(Self); + ExportDialog.Grid := ActiveGrid; + ExportDialog.ShowModal; + ExportDialog.Free; +end;} + + +{procedure TMainForm.actDataPreviewUpdate(Sender: TObject); +var + Grid: TVirtualStringTree; +begin + // Enable or disable ImageView action + Grid := ActiveGrid; + (Sender as TAction).Enabled := (Grid <> nil) + and (Grid.FocusedColumn <> NoColumn) + and (GridResult(Grid).DataType(Grid.FocusedColumn-1).Category = dtcBinary) +end;} + + +{procedure TMainForm.actDataPreviewExecute(Sender: TObject); +var + MakeVisible: Boolean; +begin + // Show or hide preview area + actDataPreview.Checked := not actDataPreview.Checked; + MakeVisible := actDataPreview.Checked; + pnlPreview.Visible := MakeVisible; + spltPreview.Visible := MakeVisible; + if MakeVisible then + UpdatePreviewPanel; +end;} + + +{procedure TMainForm.UpdatePreviewPanel; +var + Grid: TVirtualStringTree; + Results: TDBQuery; + RowNum: PInt64; + ImgType: String; + Content, Header: AnsiString; + ContentStream: TMemoryStream; + StrLen, ResultCol: Integer; + Graphic: TGraphic; +begin + // Load BLOB contents into preview area + Grid := ActiveGrid; + Results := GridResult(Grid); + if not Assigned(Results) then + Exit; + ResultCol := Grid.FocusedColumn -1; + if ResultCol < 0 then + Exit; + Screen.Cursor := crHourGlass; + try + ShowStatusMsg(_('Loading contents into image viewer ...')); + lblPreviewTitle.Caption := _('Loading ...'); + lblPreviewTitle.Repaint; + imgPreview.Picture := nil; + AnyGridEnsureFullRow(Grid, Grid.FocusedNode); + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; + + Content := AnsiString(Results.Col(ResultCol)); + StrLen := Results.ColumnLengths(ResultCol); + ContentStream := TMemoryStream.Create; + ContentStream.Write(Content[1], StrLen); + ContentStream.Position := 0; + Graphic := nil; + ContentStream.Position := 0; + ImgType := 'UnknownType'; + Header := Copy(Content, 1, 50); + if Copy(Header, 7, 4) = 'JFIF' then begin + ImgType := 'JPEG'; + Graphic := TJPEGImage.Create; + end else if Copy(Header, 1, 3) = 'GIF' then begin + ImgType := 'GIF'; + Graphic := TGIFImage.Create; + end else if Copy(Header, 1, 2) = 'BM' then begin + ImgType := 'BMP'; + Graphic := TBitmap.Create; + end else if Copy(Header, 2, 3) = 'PNG' then begin + ImgType := 'PNG'; + Graphic := TPngImage.Create; + end; + if Assigned(Graphic) then begin + try + Graphic.LoadFromStream(ContentStream); + imgPreview.Picture.Graphic := Graphic; + lblPreviewTitle.Caption := ImgType+': '+ + IntToStr(Graphic.Width)+' x '+IntToStr(Graphic.Height)+' pixels, 100%, '+ + FormatByteNumber(StrLen); + spltPreview.OnMoved(spltPreview); + except + on E:Exception do + lblPreviewTitle.Caption := ImgType+': ' + E.Message + ' ('+E.ClassName+')'; + end; + FreeAndNil(ContentStream); + end else + lblPreviewTitle.Caption := f_('No image detected, %s', [FormatByteNumber(StrLen)]); + finally + lblPreviewTitle.Hint := lblPreviewTitle.Caption; + ShowStatusMsg; + Screen.Cursor := crDefault; + end; +end;} + + +{procedure TMainForm.pnlLeftResize(Sender: TObject); +var + WidthAvail: Integer; +begin + WidthAvail := editDatabaseFilter.Parent.Width - btnTreeFavorites.Width; + editDatabaseFilter.Left := 0; + editDatabaseFilter.Width := (WidthAvail div 2) - 1; + editTableFilter.Width := editDatabaseFilter.Width; + editTableFilter.Left := editDatabaseFilter.Width + 1; + btnTreeFavorites.Left := editTableFilter.Left + editTableFilter.Width + 1; + spltPreview.OnMoved(Sender); +end;} + + +{procedure TMainForm.spltPreviewMoved(Sender: TObject); +var + rx: TRegExpr; + ZoomFactorW, ZoomFactorH: Integer; +begin + // Do not overscale image so it's never zoomed to more than 100% + if (imgPreview.Picture.Graphic = nil) or (imgPreview.Picture.Graphic.Empty) then + Exit; + imgPreview.Stretch := (imgPreview.Picture.Width > imgPreview.Width) or (imgPreview.Picture.Height > imgPreview.Height); + ZoomFactorW := Trunc(Min(imgPreview.Picture.Width, imgPreview.Width) / imgPreview.Picture.Width * 100); + ZoomFactorH := Trunc(Min(imgPreview.Picture.Height, imgPreview.Height) / imgPreview.Picture.Height * 100); + rx := TRegExpr.Create; + rx.Expression := '(\D)(\d+%)';} + //lblPreviewTitle.Caption := rx.Replace(lblPreviewTitle.Caption, '${1}'+IntToStr(Min(ZoomFactorH, ZoomFactorW))+'%', true); + {lblPreviewTitle.Hint := lblPreviewTitle.Caption; + rx.Free; +end;} + + +{procedure TMainForm.actDataSaveBlobToFileExecute(Sender: TObject); +var + Grid: TVirtualStringTree; + Results: TDBQuery; + RowNum: PInt64; + Content: AnsiString; + FileStream: TFileStream; + StrLen: Integer; + Dialog: TSaveDialog; +begin + // Save BLOB to local file + Grid := ActiveGrid; + Results := GridResult(Grid); + Dialog := TSaveDialog.Create(Self); + Dialog.Filter := _('All files')+' (*.*)|*.*'; + Dialog.FileName := Results.ColumnOrgNames[Grid.FocusedColumn-1]; + if not (Results.DataType(Grid.FocusedColumn-1).Category in [dtcBinary, dtcSpatial]) then + Dialog.FileName := Dialog.FileName + '.txt'; + if Dialog.Execute then begin + Screen.Cursor := crHourGlass; + AnyGridEnsureFullRow(Grid, Grid.FocusedNode); + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; + if Results.DataType(Grid.FocusedColumn-1).Category in [dtcBinary, dtcSpatial] then + Content := AnsiString(Results.Col(Grid.FocusedColumn-1)) + else + Content := Utf8Encode(Results.Col(Grid.FocusedColumn-1)); + StrLen := Length(Content); + try + FileStream := TFileStream.Create(Dialog.FileName, fmCreate or fmOpenWrite); + FileStream.Write(Content[1], StrLen); + except on E:Exception do + ErrorDialog(E.Message); + end; + FreeAndNil(FileStream); + Screen.Cursor := crDefault; + end; + Dialog.Free; +end;} + + +{procedure TMainForm.actInsertFilesExecute(Sender: TObject); +var + Dialog: TfrmInsertFiles; +begin + Dialog := TfrmInsertFiles.Create(Self); + Dialog.ShowModal; + Dialog.Free; +end;} + +// Drop Table(s) +{procedure TMainForm.actDropObjectsExecute(Sender: TObject); +var + msg, db: String; + Node: PVirtualNode; + Obj: PDBObject; + DBObject: TDBObject; + ObjectList: TDBObjectList; + Editor: TDBObjectEditor; + Conn: TDBConnection; +begin + Conn := ActiveConnection; + + ObjectList := TDBobjectList.Create(TDBObjectDropComparer.Create, False); + + if DBTreeClicked(Sender) then begin + // drop table selected in tree view. + DBObject := ActiveDBObj; + case DBObject.NodeType of + lntDb: begin + if MessageDialog(f_('Drop Database "%s"?', [DBObject.Database]), f_('WARNING: You will lose all objects in database %s!', [DBObject.Database]), mtCriticalConfirmation, [mbok,mbcancel]) <> mrok then + Abort; + try + db := DBObject.Database; + Node := FindDBNode(DBtree, Conn, db); + SetActiveDatabase('', Conn); + Conn.Query(Conn.GetSQLSpecifity(spDatabaseDrop, [Conn.QuoteIdent(db)])); + DBtree.DeleteNode(Node); + Conn.ClearDbObjects(db); + Conn.RefreshAllDatabases; + InvalidateVT(ListDatabases, VTREE_NOTLOADED_PURGECACHE, False); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + Exit; + end; + lntTable..lntEvent: ObjectList.Add(ActiveDBObj); + end; + end else begin + // Invoked from database tab + Node := GetNextNode(ListTables, nil, True); + while Assigned(Node) do begin + Obj := ListTables.GetNodeData(Node); + ObjectList.Add(Obj^); + Node := GetNextNode(ListTables, Node, True); + end; + end; + + // Fix actions temporarily enabled for popup menu. + ValidateControls(Sender); + + // Safety stop to avoid firing DROP TABLE without tablenames + if ObjectList.Count = 0 then + Exit; + + // Ask user for confirmation to drop selected objects + ObjectList.Sort; + msg := ''; + for DBObject in ObjectList do + msg := msg + DBObject.Name + ', '; + Delete(msg, Length(msg)-1, 2); + if MessageDialog(f_('Drop %d object(s) in database "%s"?', [ObjectList.Count, Conn.Database]), msg, mtCriticalConfirmation, [mbok,mbcancel]) = mrOk then begin + try + // Disable foreign key checks to avoid SQL errors + if Conn.Has(frForeignKeyChecksVar) then + Conn.Query('SET @OLD_FOREIGN_KEY_CHECKS=@@FOREIGN_KEY_CHECKS, FOREIGN_KEY_CHECKS=0'); + // Compose and run DROP [TABLE|VIEW|...] queries + Editor := ActiveObjectEditor; + for DBObject in ObjectList do begin + DBObject.Drop; + if Assigned(Editor) and Editor.Modified and Editor.DBObject.IsSameAs(DBObject) then + Editor.Modified := False; + end; + if Conn.Has(frForeignKeyChecksVar) then + Conn.Query('SET FOREIGN_KEY_CHECKS=@OLD_FOREIGN_KEY_CHECKS'); + // Refresh ListTables + dbtree so the dropped tables are gone: + Conn.ClearDbObjects(ActiveDatabase); + RefreshTree; + SetActiveDatabase(Conn.Database, Conn); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + ObjectList.Free; + end; +end;} + + +{procedure TMainForm.actLaunchCommandlineExecute(Sender: TObject); +var + path, p, log, cmd: String; + sep: Char; + Conn: TDBConnection; +begin + // Launch mysql.exe + Conn := ActiveConnection; + if not Conn.Parameters.IsAnyMySQL then + ErrorDialog(_('Command line only works on MySQL connections.')) + else begin + if IsWine then begin + cmd := 'mysql'; + sep := '/'; + end else begin + cmd := 'mysql.exe'; + sep := '\'; + end; + path := AppSettings.ReadString(asMySQLBinaries); + if (Length(path)>0) and (path[Length(path)] <> sep) then + path := path + sep; + if not FileExists(path+cmd, true) then begin + ErrorDialog(f_('You need to tell %s where your MySQL binaries reside, in %s > %s > %s.', [APPNAME, _('Tools'), _('Preferences'), _('General')])+ + CRLF+CRLF+f_('Current setting is: "%s"', [path])); + end else begin + p := ''; + if IsWine then begin + p := ' -e '+path+cmd; + path := ''; + cmd := '$TERM'; + end; + + log := path + cmd + p + Conn.Parameters.GetExternalCliArguments(Conn, nbTrue); + LogSQL(f_('Launching command line: %s', [log]), lcInfo); + + p := p + Conn.Parameters.GetExternalCliArguments(Conn, nbFalse); + ShellExec(cmd, path, p); + end; + end; +end;} + + +// Load SQL-file, make sure that SheetQuery is activated +{procedure TMainForm.actLoadSQLExecute(Sender: TObject); +var + i, ProceedResult: Integer; + Dialog: TExtFileOpenDialog; + Encoding: TEncoding; + Tab: TQueryTab; +begin + AppSettings.ResetPath; + Dialog := TExtFileOpenDialog.Create(Self); + Dialog.Options := Dialog.Options + [fdoAllowMultiSelect]; + Dialog.AddFileType('*.sql', _('SQL files')); + Dialog.AddFileType('*.*', _('All files')); + Dialog.DefaultExtension := 'sql'; + Dialog.Encodings.Assign(FileEncodings); + Dialog.EncodingIndex := AppSettings.ReadInt(asFileDialogEncoding, Self.Name); + if Dialog.Execute then begin + Encoding := GetEncodingByName(Dialog.Encodings[Dialog.EncodingIndex]); + if Encoding = nil then begin + ProceedResult := MessageDialog(_('Really auto-detect file encoding?') + SLineBreak + SLineBreak + + _('Auto detecting the encoding of a file is highly discouraged. You may experience data loss if the detection fails.') + SLineBreak + SLineBreak + + _('To avoid this message select the correct encoding before pressing Open.'), + mtConfirmation, [mbYes, mbCancel]); + end else begin + ProceedResult := mrYes; + end; + + if ProceedResult = mrYes then begin + if not RunQueryFiles(Dialog.Files, Encoding, Sender=actRunSQL) then begin + for i:=0 to Dialog.Files.Count-1 do begin + Tab := GetOrCreateEmptyQueryTab(False); + Tab.LoadContents(Dialog.Files[i], True, Encoding); + if i = Dialog.Files.Count-1 then + SetMainTab(Tab.TabSheet); + end; + end; + end; + AppSettings.WriteInt(asFileDialogEncoding, Dialog.EncodingIndex, Self.Name); + end; + Dialog.Free; +end;} + + +{function TMainForm.RunQueryFiles(Filenames: TStrings; Encoding: TEncoding; ForceRun: Boolean): Boolean; +var + i, FilesProcessed: Integer; + Filesize, FilesizeSum, CurrentPosition: Int64; + StartTime: UInt64; + msgtext: String; + AbsentFiles, PopupFileList: TStringList; + DoRunFiles: Boolean; + Dialog: TTaskDialog; + Btn: TTaskDialogButtonItem; + DialogResult: TModalResult; + Conn: TDBConnection; + ProgressDialog: IProgressDialog; + Dummy: Pointer; + TimeElapsed: Double; + RunSuccess: Boolean; +const + RunFileSize = 5*SIZE_MB; +begin + // Ask for execution when loading big files, or return false + Result := False; + + // Remove non existant files + AbsentFiles := TStringList.Create; + for i:=Filenames.Count-1 downto 0 do begin + if not FileExists(Filenames[i]) then begin + AbsentFiles.Add(Filenames[i]); + Filenames.Delete(i); + end; + end; + // Check if one or more files are large + DoRunFiles := ForceRun; + PopupFileList := TStringList.Create; + FilesizeSum := 0; + for i:=0 to Filenames.Count-1 do begin + FileSize := _GetFileSize(Filenames[i]); + Inc(FilesizeSum, Filesize); + PopupFileList.Add(ExtractFilename(Filenames[i]) + ' (' + FormatByteNumber(FileSize) + ')'); + DoRunFiles := DoRunFiles or (FileSize > RunFileSize); + end; + + if DoRunFiles then begin + if ForceRun then begin + // Don't ask, just run files + DialogResult := mrYes; + end else if (Win32MajorVersion >= 6) and StyleServices.Enabled then begin + Dialog := TTaskDialog.Create(Self); + Dialog.Caption := _('Opening large files'); + Dialog.Text := f_('Selected files have a size of %s', [FormatByteNumber(FilesizeSum, 1)]); + Dialog.ExpandButtonCaption := _('File list'); + Dialog.ExpandedText := PopupFileList.Text; + Dialog.Flags := [tfUseCommandLinks, tfExpandFooterArea]; + Dialog.CommonButtons := []; + Dialog.MainIcon := tdiWarning; + Btn := TTaskDialogButtonItem(Dialog.Buttons.Add); + Btn.Caption := _('Run file(s) directly'); + Btn.CommandLinkHint := _('... without loading into the editor'); + Btn.ModalResult := mrYes; + Btn := TTaskDialogButtonItem(Dialog.Buttons.Add); + Btn.Caption := _('Load file(s) into the editor'); + Btn.CommandLinkHint := _('Can cause large memory usage'); + Btn.ModalResult := mrNo; + Btn := TTaskDialogButtonItem(Dialog.Buttons.Add); + Btn.Caption := _('Cancel'); + Btn.ModalResult := mrCancel; + Dialog.Execute; + DialogResult := Dialog.ModalResult; + Dialog.Free; + end else begin + msgtext := f_('One or more of the selected files are larger than %s:', [FormatByteNumber(RunFileSize, 0)]) + CRLF + + Implode(CRLF, PopupFileList) + CRLF + CRLF + + _('Just run these files to avoid loading them into the query-editor (= memory)?') + CRLF + CRLF + + _('Press') + CRLF + + _(' [Yes] to run file(s) without loading it into the editor') + CRLF + + _(' [No] to load file(s) into the query editor') + CRLF + + _(' [Cancel] to cancel file opening.'); + DialogResult := MessageDialog(_('Execute query file(s)?'), msgtext, mtWarning, [mbYes, mbNo, mbCancel]); + end; + + case DialogResult of + mrYes: begin + Result := True; + // progress start + ProgressDialog := CreateComObject(CLSID_ProgressDialog) as IProgressDialog; + Dummy := nil; + CurrentPosition := 0; + FilesProcessed := 0; + StartTime := GetTickCount64; + Conn := ActiveConnection; + RunSuccess := False; + // PROGDLG_MODAL was used previously, but somehow that focuses some other application + ProgressDialog.StartProgressDialog(Handle, nil, PROGDLG_NOMINIMIZE or PROGDLG_AUTOTIME, Dummy); + for i:=0 to Filenames.Count-1 do begin + RunSuccess := RunQueryFile(Filenames[i], Encoding, Conn, ProgressDialog, FilesizeSum, CurrentPosition); + // Add filename to history menu + if Pos(AppSettings.DirnameSnippets, Filenames[i]) = 0 then + MainForm.AddOrRemoveFromQueryLoadHistory(Filenames[i], True, True); + Inc(FilesProcessed); + if not RunSuccess then + Break; + end; + // progress end + ProgressDialog.StopProgressDialog; + TimeElapsed := GetTickCount64 - StartTime; + LogSQL(f_('%s file(s) processed, in %s', [FormatNumber(FilesProcessed), FormatTimeNumber(TimeElapsed/1000, True)])); + if RunSuccess then + MessageBeep(MB_OK) + else + MessageBeep(MB_ICONERROR); + end; + mrNo: Result := False; + mrCancel: Result := True; + end; + end; + + if AbsentFiles.Count > 0 then + ErrorDialog(_('Could not load file(s):'), AbsentFiles.Text); + AbsentFiles.Free; + PopupFileList.Free; +end;} + + +{function TMainForm.RunQueryFile(FileName: String; Encoding: TEncoding; Conn: TDBConnection; + ProgressDialog: IProgressDialog; FilesizeSum: Int64; var CurrentPosition: Int64): Boolean; +var + Dummy: Pointer; + Stream: TFileStream; + Lines, LinesRemain, ErrorNotice: String; + Filesize, QueryCount, ErrorCount, RowsAffected: Int64; + Queries: TSQLBatch; + i: Integer; + + procedure StopProgress; + var + MessageText: String; + begin + ProgressDialog.SetLine(1, PChar(_('Clean up ...')), False, Dummy); + Queries.Free; + try + Stream.Free; + except; // Eat error when stream wasn't yet created properly + end; + // BringToFront; // Not sure why I added this initially, but it steals focus from other applications + if ProgressDialog.HasUserCancelled then + MessageText := 'File "%s" partially executed, with %s queries and %s affected rows' + else + MessageText := 'File "%s" executed, with %s queries and %s affected rows'; + LogSQL(f_(MessageText, [ExtractFileName(FileName), FormatNumber(QueryCount), FormatNumber(RowsAffected)])); + end; + +begin + // Import single SQL file and display progress dialog + ProgressDialog.SetTitle(PChar(f_('Importing file %s', [ExtractFileName(FileName)]))); + Dummy := nil; + + Result := True; + Lines := ''; + ErrorNotice := ''; + QueryCount := 0; + ErrorCount := 0; + RowsAffected := 0; + LinesRemain := ''; + Queries := TSQLBatch.Create; + + try + // Start file operations + Filesize := _GetFileSize(FileName); + + OpenTextfile(FileName, Stream, Encoding); + while Stream.Position < Stream.Size do begin + if ProgressDialog.HasUserCancelled then + Break; + + // Read lines from SQL file until buffer reaches a limit of some MB + // This strategy performs vastly better than looping through each line + ProgressDialog.SetLine(1, PChar(_('Reading next chunk from file...')), False, Dummy); + Lines := ReadTextfileChunk(Stream, Encoding, 20*SIZE_MB); + + // Split buffer into single queries + ProgressDialog.SetLine(1, PChar(_('Splitting queries...')), False, Dummy); + Queries.SQL := LinesRemain + Lines; + Lines := ''; + LinesRemain := ''; + + // Execute detected queries + for i:=0 to Queries.Count-1 do begin + if ProgressDialog.HasUserCancelled then + Break; + // Last line has to be processed in next loop if end of file is not reached + if (i = Queries.Count-1) and (Stream.Position < Stream.Size) then begin + LinesRemain := Queries[i].SQL; + Break; + end; + Inc(QueryCount); + Inc(CurrentPosition, Encoding.GetByteCount(Queries[i].SQL)); + if ErrorCount > 0 then + ErrorNotice := '(' + FormatNumber(ErrorCount) + ' ' + _('Errors') + ')'; + ProgressDialog.SetLine(1, + PChar(f_('Processing query #%s. %s', [FormatNumber(QueryCount), ErrorNotice])), + False, + Dummy + ); + ProgressDialog.SetLine(2, + PChar(f_('Position in file: %s / %s. Affected rows: %s.', [FormatByteNumber(CurrentPosition), FormatByteNumber(Filesize), FormatNumber(RowsAffected)])), + False, + Dummy + ); + ProgressDialog.SetProgress64(CurrentPosition, FilesizeSum); + + // Execute single query + // Break or don't break loop, depending on the state of "Stop on errors" button + try + Conn.Query(Queries[i].SQL, False, lcScript); + RowsAffected := RowsAffected + Conn.RowsAffected; + Conn.ShowWarnings; + except + on E:Exception do begin + if actQueryStopOnErrors.Checked then + raise + else + Inc(ErrorCount); + end; + end; + + end; + end; + if ProgressDialog.HasUserCancelled then begin + LogSQL(_('Cancelled by user')); + Result := False; + end; + StopProgress; + if ErrorCount > 0 then begin + ErrorDialog(_('Errors'), + f_('%s%% of your file has been processed, but there were %s errors when executing %s queries. Please check the SQL log panel for messages.', + [FormatNumber(100/FileSize*CurrentPosition, 0), FormatNumber(ErrorCount), FormatNumber(QueryCount)]) + ); + end; + + except + on E:Exception do begin + if (E is EFileStreamError) + or (E is EEncodingError) + or (E is EReadError) + then begin + StopProgress; + Result := False; + ErrorDialog(f_('Error while reading file "%s"', [FileName]), E.Message); + AddOrRemoveFromQueryLoadHistory(FileName, False, True); + end + else if E is EDbError then begin + StopProgress; + Result := False; + ErrorDialog(E.Message + CRLF + CRLF + + f_('Notice: You can disable the "%s" option to ignore such errors', [actQueryStopOnErrors.Caption]) + ); + end + else begin + raise; + end; + end; + end; +end;} + + +{procedure TMainForm.SessionConnect(Sender: TObject); +var + SessionPath: String; + Connection: TDBConnection; + Params: TConnectionParameters; + Node, SessionNode: PVirtualNode; + DBObj: PDBObject; + i: Integer; +begin + // Click on quick-session menu item: + SessionPath := StripHotkey((Sender as TMenuItem).Caption); + Node := nil; + // Probably wanted session was clicked before: navigate to last node + for i:=High(FTreeClickHistory) downto Low(FTreeClickHistory) do begin + if FTreeClickHistory[i] <> nil then begin + DBObj := DBtree.GetNodeData(FTreeClickHistory[i]); + if DBObj = nil then // Session disconnected + Break; + if DBObj.Connection.Parameters.SessionPath = SessionPath then begin + Node := FTreeClickHistory[i]; + break; + end; + end; + end; + if not Assigned(Node) then begin + // Wanted session was not clicked yet but probably connected: navigate to root node + SessionNode := DBtree.GetFirstChild(nil); + while Assigned(SessionNode) do begin + DBObj := DBtree.GetNodeData(SessionNode); + if DBObj.Connection.Parameters.SessionPath = SessionPath then begin + Node := SessionNode; + end; + SessionNode := DBtree.GetNextSibling(SessionNode); + end; + end; + // Finally we have a node if session is already connected + if Assigned(Node) then + SelectNode(DBtree, Node) + else begin + Params := TConnectionParameters.Create(SessionPath); + InitConnection(Params, True, Connection); + end; +end;} + + +{** + Receive connection parameters and create a connection tree node + Paremeters are either sent by connection-form or by commandline. +} +{function TMainform.InitConnection(Params: TConnectionParameters; ActivateMe: Boolean; var Connection: TDBConnection): Boolean; +var + RestoreLastActiveDatabase: Boolean; + StartupScript, LastActiveDatabase: String; + StartupBatch: TSQLBatch; + Query: TSQLSentence; + SessionNode, DBNode: PVirtualNode; +begin + Connection := Params.CreateConnection(Self); + Connection.OnLog := LogSQL; + Connection.OnConnected := ConnectionReady; + Connection.OnDatabaseChanged := DatabaseChanged; + Connection.OnObjectnamesChanged := ObjectnamesChanged; + try + Connection.Active := True; + // We have a connection + Result := True; + FConnections.Add(Connection); + + if AppSettings.SessionPathExists(Params.SessionPath) then begin + // Save "connected" counter + AppSettings.SessionPath := Params.SessionPath; + AppSettings.WriteInt(asConnectCount, AppSettings.ReadInt(asConnectCount)+1); + // Save server version + AppSettings.WriteInt(asServerVersion, Connection.ServerVersionInt); + AppSettings.WriteString(asLastConnect, DateTimeToStr(Now)); + end; + + if ActivateMe then begin + // Set focus on last uses db. If not wanted or db is gone, go to root node at least + RestoreLastActiveDatabase := AppSettings.ReadBool(asRestoreLastUsedDB); + AppSettings.SessionPath := Params.SessionPath; + LastActiveDatabase := AppSettings.ReadString(asLastUsedDB); + if RestoreLastActiveDatabase + and (Connection.AllDatabases.IndexOf(LastActiveDatabase) >- 1) + and (Connection.GetLockedTableCount(LastActiveDatabase) = 0) + then begin + SetActiveDatabase(LastActiveDatabase, Connection); + DBNode := FindDBNode(DBtree, Connection, LastActiveDatabase); + if Assigned(DBNode) then + DBtree.Expanded[DBNode] := True; + end else begin + SessionNode := GetRootNode(DBtree, Connection); + SelectNode(DBtree, SessionNode); + DBtree.Expanded[SessionNode] := True; + end; + end; + + // Process startup script + StartupScript := Trim(Connection.Parameters.StartupScriptFilename); + if StartupScript <> '' then begin + StartupScript := ExpandFileName(StartupScript); + if not FileExists(StartupScript) then + ErrorDialog(f_('Startup script file not found: %s', [StartupScript])) + else begin + StartupBatch := TSQLBatch.Create; + StartupBatch.SQL := ReadTextfile(StartupScript, nil); + for Query in StartupBatch do try + Connection.Query(Query.SQL); + except + // Suppress popup, errors get logged into SQL log + end; + StartupBatch.Free; + end; + end; + + if Params.WantSSL and not Connection.IsSSL then begin + MessageDialog(_('SSL not used.'), + _('Your SSL settings were not accepted by the server, or the server does not support any SSL configuration.'), + mtWarning, + [mbOK], + asSSLWarnUnused + ); + end; + + // Apply favorite object paths + AppSettings.SessionPath := Params.SessionPath; + Connection.Favorites.Text := AppSettings.ReadString(asFavoriteObjects); + actFavoriteObjectsOnly.Checked := False; + + // Tree node filtering needs a hit once when connected + editDatabaseTableFilterChange(Self); + + except + on E:EDbError do begin + MessageDialog(_('Connection failed'), E.Message, mtError, [mbOK], asUnused, E.Hint); + // attempt failed + if AppSettings.SessionPathExists(Params.SessionPath) then begin + // Save "refused" counter + AppSettings.SessionPath := Params.SessionPath; + AppSettings.WriteInt(asRefusedCount, AppSettings.ReadInt(asRefusedCount)+1); + end; + Result := False; + FreeAndNil(Connection); + end; + end; + + StoreLastSessions; + ValidateControls(Connection); + ShowStatusMsg; +end;} + + +{procedure TMainForm.actDataDeleteExecute(Sender: TObject); +var + Grid: TVirtualStringTree; + Node, FocusAfterDelete: PVirtualNode; + RowNum: PInt64; + Results: TDBQuery; + Nodes: TNodeArray; + i: Integer; +begin + // Delete row(s) + Grid := ActiveGrid; + Results := GridResult(Grid); + if Grid.SelectedCount = 0 then + ErrorDialog(_('No rows selected'), _('Please select one or more rows to delete them.')) + else try + Results.CheckEditable; + if MessageDialog(f_('Delete %s row(s)?', [FormatNumber(Grid.SelectedCount)]), + mtConfirmation, [mbOK, mbCancel]) = mrOK then begin + FocusAfterDelete := nil; + EnableProgress(Grid.SelectedCount); + Node := GetNextNode(Grid, nil, True); + while Assigned(Node) do begin + RowNum := Grid.GetNodeData(Node); + ShowStatusMsg(f_('Deleting row #%s of %s ...', [FormatNumber(ProgressBarStatus.Position+1), FormatNumber(ProgressBarStatus.Max)])); + Results.RecNo := RowNum^; + Results.DeleteRow; + ProgressStep; + SetLength(Nodes, Length(Nodes)+1); + Nodes[Length(Nodes)-1] := Node; + FocusAfterDelete := Node; + Node := GetNextNode(Grid, Node, True); + end; + ShowStatusMsg(_('Clean up ...')); + if Assigned(FocusAfterDelete) then + FocusAfterDelete := Grid.GetNext(FocusAfterDelete); + // Remove nodes and select some nearby node + Grid.BeginUpdate; + for i:=Low(Nodes) to High(Nodes) do + Grid.DeleteNode(Nodes[i]); + Grid.EndUpdate; + if not Assigned(FocusAfterDelete) then + FocusAfterDelete := Grid.GetLast; + if Assigned(FocusAfterDelete) then + SelectNode(Grid, FocusAfterDelete); + DisplayRowCountStats(Grid); + ValidateControls(Sender); + end; + except on E:EDbError do begin + SetProgressState(pbsError); + ErrorDialog(_('Grid editing error'), E.Message); + end; + end; + DisableProgress; + ShowStatusMsg(); +end;} + + +{procedure TMainForm.actUpdateCheckExecute(Sender: TObject); +var + frm : TfrmUpdateCheck; +begin + frm := TfrmUpdateCheck.Create(Self); + frm.ShowModal; + frm.Free; // FormClose has no caFree, as it may not have been called +end;} + + +{procedure TMainForm.actCreateDBObjectExecute(Sender: TObject); +var + Obj: TDBObject; + a: TAction; +begin + // Create a new table, view, etc. + FFocusedTables := GetFocusedObjects(Sender, [lntTable]); + tabEditor.TabVisible := True; + SetMainTab(tabEditor); + a := Sender as TAction; + Obj := TDBObject.Create(ActiveConnection); + Obj.Database := ActiveDatabase; + if a = actCreateTable then Obj.NodeType := lntTable + else if a = actCreateView then Obj.NodeType := lntView + else if a = actCreateProcedure then Obj.NodeType := lntProcedure + else if a = actCreateTrigger then Obj.NodeType := lntTrigger + else if a = actCreateEvent then Obj.NodeType := lntEvent + else if a = actCreateFunction then Obj.NodeType := lntFunction; + + PlaceObjectEditor(Obj); +end;} + + +{procedure TMainForm.actEmptyTablesExecute(Sender: TObject); +var + TableOrView: TDBObject; + Objects: TDBObjectList; + Names, QueryDisableChecks, QueryEnableChecks: String; + Conn: TDBConnection; + Dialog: TTaskDialog; + DialogResult: TModalResult; + DisableForeignKeyChecks: Boolean; +begin + // Delete rows from selected tables and views + + // See issue #3166 + if (not DBtree.Focused) and (not ListTables.Focused) then + Exit; + + Objects := GetFocusedObjects(Sender, [lntTable, lntView]); + for TableOrView in Objects do begin + Names := Names + TableOrView.Name + ', '; + end; + Delete(Names, Length(Names)-1, 2); + + if Objects.Count = 0 then + ErrorDialog(_('No table(s) selected.')) + else begin + Conn := ActiveConnection; + QueryDisableChecks := Conn.GetSQLSpecifity(spDisableForeignKeyChecks); + QueryEnableChecks := Conn.GetSQLSpecifity(spEnableForeignKeyChecks); + if (Win32MajorVersion >= 6) and StyleServices.Enabled then begin + Dialog := TTaskDialog.Create(Self); + Dialog.Text := f_('Empty %d table(s) and/or view(s)?', [Objects.count]); + Dialog.CommonButtons := [tcbOk, tcbCancel]; + Dialog.Flags := Dialog.Flags + [tfUseHiconMain]; + Dialog.CustomMainIcon := ConfirmIcon; + if not QueryDisableChecks.IsEmpty then + Dialog.VerificationText := _('Disable foreign key checks'); + Dialog.Execute; + DialogResult := Dialog.ModalResult; + DisableForeignKeyChecks := tfVerificationFlagChecked in Dialog.Flags; + Dialog.Free; + end else begin + DialogResult := MessageDialog(f_('Empty %d table(s) and/or view(s)?', [Objects.count]), Names, mtConfirmation, [mbOk, mbCancel]); + DisableForeignKeyChecks := False; + end; + if DialogResult = mrOk then begin + Screen.Cursor := crHourglass; + EnableProgress(Objects.Count); + try + if DisableForeignKeyChecks and (not QueryDisableChecks.IsEmpty) then + Conn.Query(QueryDisableChecks); + try + for TableOrView in Objects do begin + Conn.Query(Conn.GetSQLSpecifity(spEmptyTable) + TableOrView.QuotedName); + ProgressStep; + end; + actRefresh.Execute; + except + on E:EDbError do begin + SetProgressState(pbsError); + ErrorDialog(E.Message); + end; + end; + if DisableForeignKeyChecks and (not QueryEnableChecks.IsEmpty) then + Conn.Query(QueryEnableChecks); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + Objects.Free; + DisableProgress; + Screen.Cursor := crDefault; + end; + end; +end;} + + +{procedure TMainForm.actBatchInOneGoExecute(Sender: TObject); +begin + // +end;} + + +{function TMainForm.DBTreeClicked(Sender: TObject): Boolean; +begin + // Find out if user rightclicked in tree or in database tab, + // which is a bit complex, so outsourced here. + Result := DBTree.Focused + or (PageControlMain.ActivePage <> tabDatabase) + or (PopupComponent(Sender) = DBtree); +end;} + + +{function TMainForm.GetFocusedObjects(Sender: TObject; NodeTypes: TListNodeTypes): TDBObjectList; +var + Node: PVirtualNode; + pObj: PDBObject; +begin + // Return list of selected database objects in current area + Result := TDBObjectList.Create(False); + + if DBTreeClicked(Sender) then begin + if ActiveDbObj.NodeType in NodeTypes then + Result.Add(ActiveDbObj); + end else begin + Node := GetNextNode(ListTables, nil, True); + while Assigned(Node) do begin + pObj := ListTables.GetNodeData(Node); + if pObj.NodeType in NodeTypes then + Result.Add(pObj^); + Node := GetNextNode(ListTables, Node, True); + end; + end; +end;} + + +{procedure TMainForm.actRunRoutinesExecute(Sender: TObject); +var + Tab: TQueryTab; + Query, ParamValues, ParamValue: String; + Params: TStringList; + Obj: TDBObject; + Objects: TDBObjectList; + Parameters: TRoutineParamList; + Param: TRoutineParam; + Cancelled: Boolean; +begin + // Run stored function(s) or procedure(s) + Objects := GetFocusedObjects(Sender, [lntProcedure, lntFunction]); + + if Objects.Count = 0 then + ErrorDialog(_('No stored procedure selected.'), _('Please select one or more stored function(s) or routine(s).')); + + for Obj in Objects do begin + actNewQueryTab.Execute; + Tab := QueryTabs[MainForm.QueryTabs.Count-1]; + case Obj.Connection.Parameters.NetTypeGroup of + ngMySQL: + case Obj.NodeType of + lntProcedure: Query := 'CALL '; + lntFunction: Query := 'SELECT '; + end; + ngMSSQL: + Query := 'EXEC '; + ngPgSQL: + Query := 'SELECT '; + else + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(Obj.Connection.Parameters.NetType)]); + end; + Parameters := TRoutineParamList.Create; + Obj.Connection.ParseRoutineStructure(Obj, Parameters); + Query := Query + Obj.QuotedName; + Cancelled := False; + Params := TStringList.Create; + for Param in Parameters do begin + ParamValue := ''; + if not InputQuery(Obj.Name, _('Parameter')+' "'+Param.Name+'" ('+Param.Datatype+')', ParamValue) then begin + Cancelled := True; + Break; + end; + ParamValue := Obj.Connection.EscapeString(ParamValue); + Params.Add(ParamValue); + end; + if not Cancelled then begin + Parameters.Free; + ParamValues := ''; + case Obj.Connection.Parameters.NetTypeGroup of + ngMySQL, ngPgSQL: + ParamValues := '(' + Implode(', ', Params) + ')'; + ngMSSQL: + ParamValues := ' ' + Implode(' ', Params); + else + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(Obj.Connection.Parameters.NetType)]); + end; + Query := Query + ParamValues; + Tab.Memo.Text := Query; + actExecuteQueryExecute(Sender); + end; + // Also cancel the whole loop over multiple procedures + if Cancelled then + Break; + end; +end;} + + +{procedure TMainForm.actNewWindowExecute(Sender: TObject); +begin + ShellExec( ExtractFileName(paramstr(0)), ExtractFilePath(paramstr(0)) ); +end;} + + +{procedure TMainForm.actQueryFindReplaceExecute(Sender: TObject); +var + OldDataLocalNumberFormat: Boolean; +begin + // Display search + replace dialog + if not Assigned(FSearchReplaceDialog) then + FSearchReplaceDialog := TfrmSearchReplace.Create(Self); + if FSearchReplaceDialog.Visible then + Exit; + FSearchReplaceDialog.chkReplace.Checked := Sender = actQueryReplace; + if (ActiveSynMemo(False) <> nil) or (ActiveGrid <> nil) then begin + OldDataLocalNumberFormat := DataLocalNumberFormat; + DataLocalNumberFormat := False; + FSearchReplaceDialog.ShowModal; + DataLocalNumberFormat := OldDataLocalNumberFormat; + ValidateControls(Sender); + end; +end;} + + +{procedure TMainForm.actQueryFindAgainExecute(Sender: TObject); +var + NeedDialog: Boolean; + Editor: TSynMemo; + Grid: TVirtualStringTree; + OldDataLocalNumberFormat: Boolean; +begin + // F3 - search or replace again, using previous settings + NeedDialog := not Assigned(FSearchReplaceDialog); + if Assigned(FSearchReplaceDialog) then begin + NeedDialog := NeedDialog or ((FSearchReplaceDialog.Grid = nil) and (FSearchReplaceDialog.Editor = nil)); + Editor := ActiveSynMemo(False); + Grid := ActiveGrid; + NeedDialog := NeedDialog or ((Grid = nil) and (Editor = nil)); + if (Editor <> nil) and (Editor.Focused) then + NeedDialog := NeedDialog or (FSearchReplaceDialog.Editor<>Editor); + if (Grid <> nil) and (Grid.Focused) then + NeedDialog := NeedDialog or (FSearchReplaceDialog.Grid<>Grid); + end; + + if NeedDialog then + actQueryFindReplaceExecute(Sender) + else begin + OldDataLocalNumberFormat := DataLocalNumberFormat; + DataLocalNumberFormat := False; + Exclude(FSearchReplaceDialog.Options, ssoEntireScope); + FSearchReplaceDialog.DoSearchReplace(Sender); + DataLocalNumberFormat := OldDataLocalNumberFormat; + end; +end;} + + +{procedure TMainForm.SynMemoQueryReplaceText(Sender: TObject; const ASearch, + AReplace: string; Line, Column: Integer; var Action: TSynReplaceAction); +begin + // Fires when "Replace all" in search dialog was pressed with activated "Prompt on replace" + case MessageDialog(f_('Replace this occurrence of "%s"?', [StrEllipsis(ASearch, 100)]), mtConfirmation, [mbYes, mbYesToAll, mbNo, mbCancel]) of + mrYes: Action := raReplace; + mrYesToAll: Action := raReplaceAll; + mrNo: Action := raSkip; + mrCancel: Action := raCancel; + end; +end;} + + +{procedure TMainForm.actRefreshExecute(Sender: TObject); +var + tab1, tab2: TTabSheet; + List: TVirtualStringTree; + OldDbObject: TDBObject; +begin + // Refresh + // Force data tab update when appropriate. + // Disable refresh action and re-enable in ApplicationOnIdle event + tab1 := PageControlMain.ActivePage; + actRefresh.Enabled := False; + FRefreshActionDisabledAt := GetTickCount; + if ActiveControl = DBtree then + RefreshTree + else if tab1 = tabHost then begin + tab2 := PageControlHost.ActivePage; + if tab2 = tabDatabases then + List := ListDatabases + else if tab2 = tabVariables then + List := ListVariables + else if tab2 = tabStatus then + List := ListStatus + else if tab2 = tabProcessList then + List := ListProcesses + else + List := ListCommandStats; + InvalidateVT(List, VTREE_NOTLOADED_PURGECACHE, True); + end else if tab1 = tabDatabase then begin + OldDbObject := TDBObject.Create(FActiveDbObj.Connection); + OldDbObject.Assign(FActiveDbObj); + RefreshTree(OldDbObject); + end else if tab1 = tabEditor then begin + RefreshTree; + end else if tab1 = tabData then + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); +end;} + + +{procedure TMainForm.actSQLhelpExecute(Sender: TObject); +var + keyword: String; + Tree: TVirtualStringTree; + SynMemo: TSynMemo; +begin + // Call SQL Help from various places + keyword := ''; + + // Query-Tab + if ActiveControl is TSynMemo then begin + SynMemo := TSynMemo(ActiveControl); + keyword := SynMemo.WordAtCursor; + if keyword.IsEmpty then begin + keyword := SynMemo.SelText; + end; + end + + // Data-Tab + else if (PageControlMain.ActivePage = tabData) + and Assigned(DataGrid.FocusedNode) then begin + keyword := SelectedTableFocusedColumn.DataType.Name; + + end else if ActiveControl = QueryTabs.ActiveHelpersTree then begin + // Makes only sense if one of the nodes "SQL fn" or "SQL kw" was selected + Tree := QueryTabs.ActiveHelpersTree; + if Assigned(Tree.FocusedNode) + and (Tree.GetNodeLevel(Tree.FocusedNode)=1) + and (Tree.FocusedNode.Parent.Index in [TQueryTab.HelperNodeFunctions, TQueryTab.HelperNodeKeywords]) then + keyword := Tree.Text[Tree.FocusedNode, 0]; + end; + + // Clean existing paranthesis, fx: char(64) + if Pos( '(', keyword ) > 0 then + keyword := Copy( keyword, 1, Pos( '(', keyword )-1 ); + + // Show the window + CallSQLHelpWithKeyword( keyword ); +end;} + + +{procedure TMainForm.actSynEditCompletionProposeExecute(Sender: TObject); +begin + // Show completion proposal explicitely, without the use of its own ShortCut property, + // to support a customized shortcut, see + SynCompletionProposal.Editor := ActiveSynMemo(False); + if Screen.ActiveControl is TCustomSynEdit then + SynCompletionProposal.ActivateCompletion + else + MessageBeep(MB_ICONEXCLAMATION); +end;} + +{procedure TMainForm.actSynMoveDownExecute(Sender: TObject); +var + Editor: TSynMemo; +begin + // Move line of text one down + Editor := ActiveSynMemo(False); + if Assigned(Editor) and (Editor.CaretY < Editor.Lines.Count) then begin + //Logsql('Editor.CaretY:'+Editor.CaretY.ToString+' Editor.Lines.Count:'+Editor.Lines.Count.ToString); + Editor.Lines.Exchange(Editor.CaretY-1, Editor.CaretY); + Editor.CaretY := Editor.CaretY + 1; + // OnStatusChanged implicitly fired here + if Assigned(Editor.OnChange) then + Editor.OnChange(Editor); + Editor.Repaint; + end else begin + MessageBeep(MB_ICONERROR); + end; +end;} + +{procedure TMainForm.actSynMoveUpExecute(Sender: TObject); +var + Editor: TSynMemo; +begin + // Move line of text one up + Editor := ActiveSynMemo(False); + if Assigned(Editor) and (Editor.CaretY >= 2) then begin + Editor.Lines.Exchange(Editor.CaretY-1, Editor.CaretY-2); + Editor.CaretY := Editor.CaretY - 1; + // OnStatusChanged implicitly fired here + if Assigned(Editor.OnChange) then + Editor.OnChange(Editor); + Editor.Repaint; + end else begin + MessageBeep(MB_ICONERROR); + end; +end;} + +{*** + Show SQL Help window directly using a keyword + @param String SQL-keyword + @see FieldeditForm.btnDatatypeHelp +} +{procedure TMainform.CallSQLHelpWithKeyword( keyword: String ); +begin + if FActiveDbObj.Connection.Has(frHelpKeyword) then begin + if not Assigned(SqlHelpDialog) then + SqlHelpDialog := TfrmSQLhelp.Create(Self); + SqlHelpDialog.Show; + SqlHelpDialog.Keyword := keyword; + end else + ErrorDialog(_('SQL help not available.'), f_('HELP <keyword> requires %s or newer.', ['MySQL 4.1'])); +end;} + + +{procedure TMainForm.actSaveSynMemoToTextfileExecute(Sender: TObject); +var + Comp: TComponent; + Memo: TSynMemo; + Dialog: TExtFileSaveDialog; +begin + // Save to textfile, from any TSynMemo (SQL log, "CREATE code" tab in editor, ...) + Memo := nil; + // Try to find memo from menu item's popup component, and if that fails, check ActiveControl. + // See #353 + Comp := PopupComponent(Sender); + if Comp is TSynMemo then + Memo := Comp as TSynMemo + else if ActiveControl is TSynMemo then + Memo := ActiveControl as TSynMemo; + if Assigned(Memo) then begin + Dialog := TExtFileSaveDialog.Create(Self); + Dialog.Options := Dialog.Options + [fdoOverWritePrompt]; + Dialog.AddFileType('*.sql', _('SQL files')); + Dialog.AddFileType('*.*', _('All files')); + Dialog.DefaultExtension := 'sql'; + Dialog.LineBreakIndex := TLineBreaks(AppSettings.ReadInt(asLineBreakStyle)); + if Dialog.Execute then begin + Screen.Cursor := crHourGlass; + SaveUnicodeFile( + Dialog.FileName, + Implode(GetLineBreak(Dialog.LineBreakIndex), Memo.Lines), + UTF8NoBOMEncoding + ); + Screen.Cursor := crDefault; + end; + end else begin + ErrorDialog(f_('No SQL editor focused. ActiveControl is %s', [ActiveControl.Name])); + end; +end;} + + +{procedure TMainForm.actSaveSQLAsExecute(Sender: TObject); +var + i: Integer; + CanSave: TModalResult; + OnlySelection: Boolean; + Dialog: TExtFileSaveDialog; + QueryTab: TQueryTab; + DefaultFilename: String; +begin + // Save SQL + CanSave := mrNo; + QueryTab := QueryTabs.ActiveTab; + Dialog := TExtFileSaveDialog.Create(Self); + if QueryTab.MemoFilename.IsEmpty then + DefaultFilename := QueryTab.TabSheet.Caption + else + DefaultFilename := ExtractFileName(QueryTab.MemoFilename); + DefaultFilename := DefaultFilename.Trim([' ', '*']); + Dialog.FileName := ValidFilename(DefaultFilename); + Dialog.Options := Dialog.Options + [fdoOverwritePrompt]; + if (Sender = actSaveSQLSnippet) or (Sender = actSaveSQLSelectionSnippet) then begin + Dialog.DefaultFolder := AppSettings.DirnameSnippets; + Dialog.Options := Dialog.Options + [fdoNoChangeDir]; + Dialog.Title := _('Save snippet'); + end; + Dialog.AddFileType('*.sql', _('SQL files')); + Dialog.AddFileType('*.*', _('All files')); + Dialog.DefaultExtension := 'sql'; + Dialog.LineBreakIndex := QueryTab.MemoLineBreaks; + while (CanSave = mrNo) and Dialog.Execute do begin + // Save complete content or just the selected text, + // depending on the tag of calling control + CanSave := mrYes; + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i].MemoFilename = Dialog.FileName then begin + CanSave := MessageDialog(f_('Overwrite "%s"?', [Dialog.FileName]), f_('This file is already open in query tab #%d.', [QueryTabs[i].Number]), + mtWarning, [mbYes, mbNo, mbCancel]); + break; + end; + end; + end; + if CanSave = mrYes then begin + OnlySelection := (Sender = actSaveSQLselection) or (Sender = actSaveSQLSelectionSnippet); + QueryTab.MemoLineBreaks := Dialog.LineBreakIndex; + QueryTab.SaveContents(Dialog.FileName, OnlySelection); + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i] = QueryTab then + continue; + if QueryTabs[i].MemoFilename = Dialog.FileName then + QueryTabs[i].Memo.Modified := True; + end; + ValidateQueryControls(Sender); + SetSnippetFilenames; + end; + Dialog.Free; +end;} + + +{procedure TMainForm.actSaveSQLExecute(Sender: TObject); +var + i: Integer; + ObjEditor: TDBObjectEditor; + Handled: Boolean; +begin + Handled := False; + if QueryTabs.HasActiveTab then begin + // Save SQL tab contents to file + if QueryTabs.ActiveTab.MemoFilename <> '' then begin + QueryTabs.ActiveTab.SaveContents(QueryTabs.ActiveTab.MemoFilename, False); + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i] = QueryTabs.ActiveTab then + continue; + if QueryTabs[i].MemoFilename = QueryTabs.ActiveTab.MemoFilename then + QueryTabs[i].Memo.Modified := True; + end; + ValidateQueryControls(Sender); + end else + actSaveSQLAsExecute(Sender); + Handled := True; + end + else if PageControlMain.ActivePage = tabEditor then begin + // Save table, procedure, etc. + ObjEditor := ActiveObjectEditor; + if Assigned(ObjEditor) and ObjEditor.Modified then begin + ObjEditor.ApplyModifications; + Handled := True; + end; + end; + if not Handled then begin + MessageBeep(MB_ICONASTERISK); + end; + +end;} + + +{procedure TMainForm.actQueryStopOnErrorsExecute(Sender: TObject); +begin + // Weird fix: dummy routine to avoid the sending action getting disabled +end;} + + +{procedure TMainForm.actQueryWordWrapExecute(Sender: TObject); +begin + // SetupSynEditors applies all customizations to any SynEditor + if (Sender as TAction).Checked then + actCodeFolding.Checked := False; + SetupSynEditors; +end;} + + +{procedure TMainForm.actCodeFoldingExecute(Sender: TObject); +begin + // Activates code folding + // Wordwrap does not work in conjunction with code folding. + // See https://github.com/SynEdit/SynEdit/blob/master/CodeFolding.md + if (Sender as TAction).Checked then + actQueryWordWrap.Checked := False; + SetupSynEditors; +end;} + + +{procedure TMainForm.actCodeFoldingStartRegionExecute(Sender: TObject); +var + Memo: TSynMemo; +begin + // Insert #region + if not actCodeFolding.Checked then + actCodeFolding.Execute; + Memo := ActiveSynMemo(False); + Memo.InsertLine(Memo.CaretXY, Memo.CaretXY, '#region ', True); +end;} + + +{procedure TMainForm.actConnectionPropertiesExecute(Sender: TObject); +var + Conn: TDBConnection; + i: Integer; + Infos: TStringList; + InfoText: String; +begin + Conn := ActiveConnection; + if Conn <> nil then begin + Infos := Conn.ConnectionInfo; + InfoText := ''; + for i:=0 to Infos.Count-1 do begin + InfoText := InfoText + Infos.Names[i] + ': ' + Infos.ValueFromIndex[i] + sLineBreak; + end; + MessageDialog(Trim(InfoText), mtInformation, [mbOK]); + end; +end;} + + +{procedure TMainForm.actCodeFoldingEndRegionExecute(Sender: TObject); +var + Memo: TSynMemo; +begin + // Insert #endregion + if not actCodeFolding.Checked then + actCodeFolding.Execute; + Memo := ActiveSynMemo(False); + Memo.InsertLine(Memo.CaretXY, Memo.CaretXY, '#endregion ', True); +end;} + + +{procedure TMainForm.actCodeFoldingFoldSelectionExecute(Sender: TObject); +var + Memo: TSynMemo; + AfterText: String; +begin + // Wrap selected text in region/endregion + if not actCodeFolding.Checked then + actCodeFolding.Execute; + Memo := ActiveSynMemo(False); + AfterText := IfThen(Memo.SelText.EndsWith(sLineBreak), '', sLineBreak); + Memo.SelText := '#region ' + sLineBreak + Memo.SelText + AfterText + '#endregion' + sLineBreak; +end;} + + +{procedure TMainForm.PopupQueryLoadPopup(Sender: TObject); +var + i, j: Integer; + Item, SnippetsFolder: TMenuItem; + Filename: String; +begin + // Fill the popupQueryLoad menu + popupQueryLoad.Items.Clear; + + // Apply shared system image list + popupQueryLoad.Images := GetSystemImageList; + + // Snippets + SetSnippetFilenames; + SnippetsFolder := TMenuItem.Create(popupQueryLoad); + SnippetsFolder.Caption := _('Snippets'); + popupQueryLoad.Items.Add(SnippetsFolder); + for i:=0 to FSnippetFilenames.Count-1 do begin + Item := TMenuItem.Create(SnippetsFolder); + Item.Caption := FSnippetFilenames[i]; + Item.OnClick := popupQueryLoadClick; + SnippetsFolder.Add(Item); + end; + + // Separator + Item := TMenuItem.Create(popupQueryLoad); + Item.Caption := '-'; + popupQueryLoad.Items.Add(Item); + + // Recent files + j := 0; + for i:=0 to 19 do begin + Filename := AppSettings.ReadString(asSQLfile, IntToStr(i)); + if Filename = '' then + continue; + Inc(j); + Item := TMenuItem.Create( popupQueryLoad ); + Item.Caption := IntToStr(j) + ' ' + Filename; + Item.OnClick := popupQueryLoadClick; + Item.ImageIndex := GetSystemImageIndex(Filename); + popupQueryLoad.Items.Add(Item); + end; + + // Separator + "Remove absent files" + Item := TMenuItem.Create(popupQueryLoad); + Item.Caption := '-'; + popupQueryLoad.Items.Add(Item); + + Item := TMenuItem.Create(popupQueryLoad); + Item.Caption := _('Remove absent files'); + Item.OnClick := PopupQueryLoadRemoveAbsentFiles; + popupQueryLoad.Items.Add(Item); + + Item := TMenuItem.Create(popupQueryLoad); + Item.Caption := _('Clear file list'); + Item.OnClick := PopupQueryLoadRemoveAllFiles; + popupQueryLoad.Items.Add(Item); +end;} + + +{procedure TMainform.PopupQueryLoadRemoveAbsentFiles(Sender: TObject); +begin + AddOrRemoveFromQueryLoadHistory('', False, True); +end;} + + +{procedure TMainform.PopupQueryLoadRemoveAllFiles(Sender: TObject); +var + i: Integer; +begin + for i:=0 to 20 do begin + if not AppSettings.DeleteValue(asSQLfile, IntToStr(i)) then + break; + end; +end;} + + +{procedure TMainform.popupQueryLoadClick(Sender: TObject); +var + Filename: String; + FileList: TStringList; + p: Integer; + Tab: TQueryTab; +begin + // Click on the popupQueryLoad + Filename := (Sender as TMenuItem).Caption; + Filename := StripHotkey(Filename); + if Pos('\', Filename) = 0 then // assuming we load a snippet + Filename := AppSettings.DirnameSnippets + Filename + '.sql' + else begin // assuming we load a file from the recent-list + p := Pos(' ', Filename) + 1; + filename := Copy(Filename, p, Length(Filename)); + end; + FileList := TStringList.Create; + FileList.Add(Filename); + if not RunQueryFiles(FileList, nil, false) then begin + Tab := GetOrCreateEmptyQueryTab(True); + Tab.LoadContents(Filename, True, nil); + end; + FileList.Free; +end;} + + +{procedure TMainform.AddOrRemoveFromQueryLoadHistory(Filename: String; AddIt: Boolean; CheckIfFileExists: Boolean); +var + i: Integer; + newfilelist: TStringList; + savedfilename: String; +begin + // Add or remove filename to/from history, avoiding duplicates + + newfilelist := TStringList.create; + AppSettings.ResetPath; + + // Add new filename + if AddIt then + newfilelist.Add( filename ); + + // Add all other filenames + for i:=0 to 20 do begin + savedfilename := AppSettings.ReadString(asSQLfile, IntToStr(i)); + if savedfilename.IsEmpty then + Break; + AppSettings.DeleteValue(asSQLfile, IntToStr(i)); + if CheckIfFileExists and (not FileExists( savedfilename )) then + continue; + if (savedfilename <> filename) and (newfilelist.IndexOf(savedfilename)=-1) then + newfilelist.add( savedfilename ); + end; + + // Save new list + for i := 0 to newfilelist.Count-1 do begin + if i >= 20 then + break; + AppSettings.WriteString(asSQLfile, newfilelist[i], IntToStr(i)); + end; +end;} + + +{** + Change default delimiter for SQL execution +} +{procedure TMainForm.actSetDelimiterExecute(Sender: TObject); +var + newVal: String; + ok: Boolean; +begin + // Use a while loop to redisplay the input dialog after setting an invalid value + ok := False; + while not ok do begin + newVal := delimiter; + if InputQuery(_('Set delimiter'), _('SQL statement delimiter (default is ";"):'), newVal) then try + // Set new value + Delimiter := newVal; + ok := True; + except on E:Exception do + ErrorDialog(E.Message); + end else // Cancel clicked + ok := True; + end; +end;} + + +{** + Sets the Delimiter property plus updates the hint on actSetDelimiter +} +procedure TMainForm.SetDelimiter(Value: String); +var + rx: TRegExpr; + Msg: String; +begin + Value := Trim(Value); + Msg := ''; + if Value = '' then + Msg := _('Empty value.') + else begin + rx := TRegExpr.Create; + rx.Expression := '(/\*|--|#|\''|\"|`)'; + if rx.Exec(Value) then + Msg := _('Start-of-comment tokens or string literal markers are not allowed.') + end; + if Msg <> '' then begin + Msg := f_('Error setting delimiter to "%s": %s', [Value, Msg]); + LogSQL(Msg, lcError); + //ErrorDialog(Msg); + end else begin + FDelimiter := Value; + LogSQL(f_('Delimiter changed to %s', [FDelimiter]), lcInfo); + //actSetDelimiter.Hint := actSetDelimiter.Caption + ' (' + _('current value:') + ' ' + FDelimiter + ')'; + end; +end; + + +{procedure TMainForm.actApplyFilterExecute(Sender: TObject); +var + i: Integer; + Filters: TStringList; + val: String; +begin + // If filter box is empty but filter generator box has text, most users expect + // the filter to be auto generated on button click + if ((SynMemoFilter.GetTextLen = 0) or menuAlwaysGenerateFilter.Checked) + and (editFilterSearch.Text <> '') + and (Sender is TAction) + and ((Sender as TAction).ActionComponent = btnFilterApply) + then begin + editFilterSearchChange(editFilterSearch); + end; + + if SynMemoFilter.GetTextLen > 0 then begin + // Recreate recent filters list + Filters := TStringList.Create; + Filters.Add(Trim(SynMemoFilter.Text)); + AppSettings.SessionPath := GetRegKeyTable+'\'+REGKEY_RECENTFILTERS; + // Add old filters + for i:=1 to 20 do begin + val := AppSettings.ReadString(asRecentFilter, IntToStr(i)); + if val.IsEmpty then + Continue; + if Filters.IndexOf(val) = -1 then + Filters.Add(val); + AppSettings.DeleteValue(asRecentFilter, IntToStr(i)); + end; + for i:=0 to Filters.Count-1 do + AppSettings.WriteString(asRecentFilter, Filters[i], IntToStr(i+1)); + FreeAndNil(Filters); + AppSettings.ResetPath; + end; + // Keep current column widths on "Quick filter" clicks, don't keep them on "Apply filter" clicks + if (Sender is TMenuItem) and ((Sender as TMenuItem).GetParentMenu = popupDataGrid) then begin + FDataGridColumnWidthsCustomized := True; + end else + FDataGridColumnWidthsCustomized := False; + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); +end;} + + +{procedure TMainForm.actDataFirstExecute(Sender: TObject); +var + Node: PVirtualNode; +begin + Node := GetNextNode(ActiveGrid, nil); + if Assigned(Node) then + SelectNode(ActiveGrid, Node); + ValidateControls(Sender); +end;} + + +{procedure TMainForm.actDataInsertExecute(Sender: TObject); +var + DupeNode, NewNode: PVirtualNode; + Grid: TVirtualStringTree; + Results: TDBQuery; + RowNum: Int64; + DupeNum: PInt64; + Col, ResultCol: Integer; + Value: String; + IsNull, AllowNewNode: Boolean; +begin + Grid := ActiveGrid; + Results := GridResult(Grid); + // Pre-test if changing node focus is allowed, in cases where current row modifications throw some SQL error when posting + AllowNewNode := False; + Grid.OnFocusChanging(Grid, Grid.FocusedNode, nil, Grid.FocusedColumn, Grid.FocusedColumn, AllowNewNode); + if not AllowNewNode then + exit; + try + Results.CheckEditable; + DupeNode := nil; + if (Sender = actDataDuplicateRowWithoutKeys) or (Sender = actDataDuplicateRowWithKeys) then + DupeNode := Grid.FocusedNode; + RowNum := Results.InsertRow; + NewNode := Grid.InsertNode(Grid.FocusedNode, amInsertAfter, PInt64(RowNum)); + SelectNode(Grid, NewNode); + if Assigned(DupeNode) then begin + // Copy values from source row, ensure we have whole cell data + DupeNum := Grid.GetNodeData(DupeNode); + AnyGridEnsureFullRow(Grid, DupeNode); + for Col:=0 to Grid.Header.Columns.Count-1 do begin + ResultCol := Col - 1; + if not (coVisible in Grid.Header.Columns[Col].Options) then + continue; // Ignore invisible key column + if ResultCol < 0 then + Continue; // Ignore static row id column + if Results.ColIsPrimaryKeyPart(ResultCol) and (Sender = actDataDuplicateRowWithoutKeys) then + continue; // Empty value for primary key column + if Results.ColIsVirtual(ResultCol) then + continue; // Don't copy virtual column value + Results.RecNo := DupeNum^; + Value := Results.Col(ResultCol); + IsNull := Results.IsNull(ResultCol); + Results.RecNo := RowNum; + Results.SetCol(ResultCol, Value, IsNull, False); + end; + end; + except on E:EDbError do + ErrorDialog(_('Grid editing error'), E.Message); + end; +end;} + + +{procedure TMainForm.actDataLastExecute(Sender: TObject); +var + Node: PVirtualNode; + Grid: TVirtualStringTree; +begin + Grid := ActiveGrid; + // Be sure to have all rows + if (Grid = DataGrid) and (DatagridWantedRowCount < AppSettings.ReadInt(asDatagridMaximumRows)) then + actDataShowAll.Execute; + Node := Grid.GetLast; + if Assigned(Node) then + SelectNode(Grid, Node); + ValidateControls(Sender); +end;} + + +{procedure TMainForm.actDataOpenUrlExecute(Sender: TObject); +var + Grid: TVirtualStringTree; +begin + // Open grid cell url in web browser + Grid := ActiveGrid; + ShellExec(Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]); +end;} + + +{procedure TMainForm.actDataPostChangesExecute(Sender: TObject); +var + Grid: TVirtualStringTree; + Results: TDBQuery; +begin + if Sender is TVirtualStringTree then + Grid := Sender as TVirtualStringTree + else + Grid := ActiveGrid; + Results := GridResult(Grid); + Results.SaveModifications; + // Node needs a repaint to remove red triangles + if Assigned(Grid.FocusedNode) then + Grid.InvalidateNode(Grid.FocusedNode); + DisplayRowCountStats(Grid); +end;} + +{procedure TMainForm.actRemoveFilterExecute(Sender: TObject); +begin + actClearFilterEditor.Execute; + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); +end;} + + +{procedure TMainForm.actDataCancelChangesExecute(Sender: TObject); +var + Grid: TVirtualStringTree; + Results: TDBQuery; + RowNum: PInt64; + Node, FocNode: PVirtualNode; +begin + // Cancel INSERT or UPDATE mode + Grid := ActiveGrid; + Node := Grid.FocusedNode; + if Assigned(Node) then begin + Results := GridResult(Grid); + RowNum := Grid.GetNodeData(Node); + Results.RecNo := RowNum^; + Results.DiscardModifications; + if Results.Inserted then begin + FocNode := Grid.GetPreviousSibling(Node); + Grid.DeleteNode(Node); + SelectNode(Grid, FocNode); + end else + Grid.InvalidateNode(Node); + ValidateControls(Sender); + end; +end;} + + +{** + Add a SQL-command or comment to SynMemoSQLLog +} +procedure TMainForm.LogSQL(Msg: String; Category: TDBLogCategory=lcInfo; Connection: TDBConnection=nil); +var + snip, IsSQL: Boolean; + Len, i, MaxLineWidth: Integer; + Sess, OldSettingsPath: String; + LogIt: Boolean; + LogItem: TDBLogItem; +begin + //OldSettingsPath := AppSettings.SessionPath; + LogItem := TDBLogItem.Create; + LogItem.Category := Category; + if false then // AppSettings.ReadBool(asLogTimestamp) then + LogItem.LineText := '['+FormatDateTime('hh:nn:ss.zzz', Now)+'] '+ Msg + else + LogItem.LineText := Msg; + LogItem.Connection := Connection; + PostponedLogItems.Add(LogItem); + + if not MainFormCreated then + Exit; + if csDestroying in ComponentState then + Exit; + + for LogItem in PostponedLogItems do begin + + // Log only wanted events + {case LogItem.Category of + lcError: LogIt := AppSettings.ReadBool(asLogErrors); + lcUserFiredSQL: LogIt := AppSettings.ReadBool(asLogUserSQL); + lcSQL: LogIt := AppSettings.ReadBool(asLogSQL); + lcScript: LogIt := AppSettings.ReadBool(asLogScript); + lcInfo: LogIt := AppSettings.ReadBool(asLogInfos); + lcDebug: LogIt := AppSettings.ReadBool(asLogDebug); + else LogIt := False; + end;} + LogIt := True; + + if LogIt then begin + // Shorten very long messages + Msg := LogItem.LineText; + Len := Length(Msg); + MaxLineWidth := 0; // AppSettings.ReadInt(asLogsqlwidth); + snip := (MaxLineWidth > 0) and (Len > MaxLineWidth); + IsSQL := LogItem.Category in [lcSQL, lcUserFiredSQL]; + if snip then begin + Msg := + Copy(Msg, 0, MaxLineWidth) + + '/* '+f_('large SQL query (%s), snipped at %s characters', [Len.ToString, MaxLineWidth.ToString]) + ' */'; + end else if (not snip) and IsSQL then + Msg := Msg + Delimiter; + if not IsSQL then + Msg := '/* ' + Msg + ' */'; + + SynMemoSQLLog.Lines.Add(Msg); + + // Delete first line(s) in SQL log and adjust LineNumberStart in gutter + {i := 0; + while SynMemoSQLLog.Lines.Count > AppSettings.ReadInt(asLogsqlnum) do begin + SynMemoSQLLog.Lines.Delete(0); + Inc(i); + end; + // Increase first displayed number in gutter so it doesn't lie about the log entries + if i > 0 then + SynMemoSQLLog.Gutter.LineNumberStart := SynMemoSQLLog.Gutter.LineNumberStart + i;} + + // Scroll to last line and repaint + SynMemoSQLLog.CaretY := SynMemoSQLLog.Lines.Count; + // Causes access violations on a reconnected session firing a user-query: + // SynMemoSQLLog.Repaint; + // SynMemoSQLLog.Update; + // See TDBConnection.Log and TQueryThread.LogFromThread + // See https://github.com/HeidiSQL/HeidiSQL/issues/57 + + // Log to file? + if FLogToFile then + try + Sess := ''; + //if LogItem.Connection <> nil then + // Sess := LogItem.Connection.Parameters.SessionPath; + WriteLn(FFileHandleSessionLog, Format('/* %s [%s] */ %s', [DateTimeToStr(Now), Sess, msg])); + except + on E:Exception do begin + LogToFile := False; + //AppSettings.WriteBool(asLogToFile, False); + //ErrorDialog(_('Error writing to session log file.'), E.Message+CRLF+_('Filename')+': '+FFileNameSessionLog+CRLF+CRLF+_('Logging is disabled now.')); + end; + end; + end; + end; + PostponedLogItems.Clear; + + // Restore possibly overwritten session path + //AppSettings.SessionPath := OldSettingsPath; +end; + + +{procedure TMainForm.actDataShowNextExecute(Sender: TObject); +var + OldRowCount: Int64; +begin + // Show next X rows in datagrid + OldRowCount := DatagridWantedRowCount; + Inc(DatagridWantedRowCount, AppSettings.ReadInt(asDatagridRowsPerStep)); + DataGridWantedRowCount := Min(DataGridWantedRowCount, AppSettings.ReadInt(asDatagridMaximumRows)); + InvalidateVT(DataGrid, VTREE_NOTLOADED, True); + SelectNode(DataGrid, OldRowCount); +end;} + + +{procedure TMainForm.actAttachDatabaseExecute(Sender: TObject); +var + Selector: TOpenDialog; + OldFiles, NewFiles: TStringList; + i: Integer; + Conn: TDBConnection; + DbAlias: String; +begin + // Attach new or existing SQLite database file + Selector := TOpenDialog.Create(Self); + //Selector.InitialDir := ?; + Selector.Filter := 'SQLite databases ('+FILEFILTER_SQLITEDB+')|'+FILEFILTER_SQLITEDB+'|'+_('All files')+' (*.*)|*.*'; + Selector.Options := Selector.Options - [ofFileMustExist]; + Selector.Options := Selector.Options + [ofAllowMultiSelect]; + Selector.DefaultExt := FILEEXT_SQLITEDB; + if Selector.Execute then begin + Conn := ActiveConnection; + OldFiles := Explode(DELIM, Conn.Parameters.Hostname); + NewFiles := TStringList.Create; + NewFiles.Assign(Selector.Files); + try + for i:=0 to NewFiles.Count-1 do begin + // Remove path if it's the application directory + if ExtractFilePath(NewFiles[i]) = ExtractFilePath(Application.ExeName) then + NewFiles[i] := ExtractFileName(NewFiles[i]); + if OldFiles.IndexOf(NewFiles[i]) = -1 then begin + OldFiles.Add(NewFiles[i]); + DbAlias := TPath.GetFileNameWithoutExtension(NewFiles[i]); + Conn.Query('ATTACH DATABASE '+Conn.EscapeString(NewFiles[i])+' AS '+Conn.QuoteIdent(DbAlias)); + end; + end; + AppSettings.SessionPath := Conn.Parameters.SessionPath; + AppSettings.WriteString(asHost, Implode(DELIM, OldFiles)); + RefreshTree; + except + on E:EDbError do begin + ErrorDialog(E.Message); + end; + end; + end; +end;} + +{procedure TMainForm.actDetachDatabaseExecute(Sender: TObject); +var + Obj: TDBObject; + OldFiles: TStringList; + i: Integer; + DbAlias: String; +begin + // Detach previously attached SQLite database file + Obj := ActiveDBObj; + if Obj.NodeType <> lntDb then + Exit; + if MessageDialog( + f_('Detach database "%s" from "%s" session?', [Obj.Database, Obj.Connection.Parameters.SessionPath]) + + CRLF + CRLF + _('Note: The database file will not get deleted.'), + mtConfirmation, + [mbYes, mbNo]) <> mrYes then + Exit; + try + Obj.Connection.Query('DETACH DATABASE '+Obj.Connection.QuoteIdent(Obj.Database)); + OldFiles := Explode(DELIM, Obj.Connection.Parameters.Hostname); + for i:=0 to OldFiles.Count-1 do begin + DbAlias := TPath.GetFileNameWithoutExtension(OldFiles[i]); + if DbAlias = Obj.Database then begin + OldFiles.Delete(i); + Break; + end; + end; + AppSettings.SessionPath := Obj.Connection.Parameters.SessionPath; + AppSettings.WriteString(asHost, Implode(DELIM, OldFiles)); + RefreshTree; + except + on E:EDbError do begin + ErrorDialog(E.Message); + end; + end; +end;} + + +{procedure TMainForm.actDataShowAllExecute(Sender: TObject); +begin + // Remove LIMIT clause + DatagridWantedRowCount := AppSettings.ReadInt(asDatagridMaximumRows); + InvalidateVT(DataGrid, VTREE_NOTLOADED, True); +end;} + + +{function TMainForm.AnyGridEnsureFullRow(Grid: TVirtualStringTree; Node: PVirtualNode): Boolean; +var + RowNum: PInt64; + Data: TDBQuery; +begin + // Load remaining data on a partially loaded row in data grid + Result := True; + if (Grid = DataGrid) and Assigned(Node) then begin + RowNum := Grid.GetNodeData(Node); + Data := GridResult(Grid); + Data.RecNo := RowNum^; + Result := Data.EnsureFullRow(False); + end; +end;} + + +{procedure TMainForm.DataGridEnsureFullRows(Grid: TVirtualStringTree; SelectedOnly: Boolean); +var + Node: PVirtualNode; + Results: TDBQuery; + RowNum: PInt64; +begin + // Load remaining data of all grid rows + Results := GridResult(Grid); + Node := GetNextNode(Grid, nil, SelectedOnly); + while Assigned(Node) do begin + RowNum := Grid.GetNodeData(Node); + Results.RecNo := RowNum^; + if not Results.HasFullData then begin + DataGridFullRowMode := True; + InvalidateVT(Grid, VTREE_NOTLOADED_PURGECACHE, True); + break; + end; + Node := GetNextNode(Grid, Node, SelectedOnly); + end; +end;} + + +{procedure TMainForm.AnyGridHeaderDrawQueryElements(Sender: TVTHeader; + var PaintInfo: THeaderPaintInfo; var Elements: THeaderPaintElements); +begin + // Tell the tree we want to paint most of the column header things ourselves + // Only called when Header.OwnerDraw is True + Elements := [hpeHeaderGlyph, hpeText, hpeOverlay]; +end;} + + +{procedure TMainForm.AnyGridAdvancedHeaderDraw(Sender: TVTHeader; + var PaintInfo: THeaderPaintInfo; const Elements: THeaderPaintElements); +var + PaintArea, TextArea, IconArea, SortArea: TRect; + SortText, ColCaption: String; + TextSpace, ColSortIndex, NumCharTop: Integer; + ColSortDirection: VirtualTrees.TSortDirection; + Size: TSize; + DC: HDC; + DrawFormat: Cardinal; +const + NumSortChars: Array of Char = ['¹','²','³','⁴','⁵','⁶','⁷','⁸','⁹','⁺']; + + procedure GetSortIndex(Column: TVirtualTreeColumn; var SortIndex: Integer; var SortDirection: VirtualTrees.TSortDirection); + var + SortItem: TSortItem; + begin + SortIndex := -1; + if Column.Owner.Header.Treeview = DataGrid then begin + // Data grid supports multiple sorted columns + SortItem := FDataGridSortItems.FindByColumn(PaintInfo.Column.Text); + if Assigned(SortItem) then begin + SortIndex := FDataGridSortItems.IndexOf(SortItem); + if SortItem.Order = sioAscending then + SortDirection := sdAscending + else + SortDirection := sdDescending; + end; + + end else begin + // We're in a query grid, supporting a single sorted column + if Column.Owner.Header.SortColumn = Column.Index then begin + SortIndex := 0; + SortDirection := Column.Owner.Header.SortDirection; + end; + end; + end; + +begin + // Paint specified elements on column header + + PaintArea := PaintInfo.PaintRectangle; + PaintArea.Inflate(-PaintInfo.Column.Margin, 0); + DC := PaintInfo.TargetCanvas.Handle; + + // Draw column name. Code taken from TVirtualTreeColumns.DrawButtonText and modified for our needs + if hpeText in Elements then begin + ColCaption := PaintInfo.Column.Text; + // Leave space for icons + TextArea := PaintArea; + if PaintInfo.Column.ImageIndex > -1 then + Dec(TextArea.Right, Sender.Images.Width); + GetSortIndex(PaintInfo.Column, ColSortIndex, ColSortDirection); + if ColSortIndex > -1 then + Dec(TextArea.Right, Sender.Images.Width); + + if not (coWrapCaption in PaintInfo.Column.Options) then begin + // Do we need to shorten the caption due to limited space? + GetTextExtentPoint32W(DC, PWideChar(ColCaption), Length(ColCaption), Size); + TextSpace := TextArea.Right - TextArea.Left; + if TextSpace < Size.cx then + ColCaption := VirtualTrees.Utils.ShortenString(DC, ColCaption, TextSpace); + end; + + SetBkMode(DC, TRANSPARENT); + SetTextColor(DC, ColorToRGB(clWindowText)); + DrawFormat := DT_TOP or DT_NOPREFIX or DT_LEFT; + DrawTextW(DC, PWideChar(ColCaption), Length(ColCaption), TextArea, DrawFormat); + end; + + // Draw image, if any + if (hpeHeaderGlyph in Elements) and (PaintInfo.Column.ImageIndex > -1) then begin + IconArea := PaintArea; + Inc(IconArea.Left, IconArea.Width - Sender.Images.Width); + GetSortIndex(PaintInfo.Column, ColSortIndex, ColSortDirection); + if ColSortIndex > -1 then + Dec(IconArea.Left, Sender.Images.Width); + Sender.Images.Draw(PaintInfo.TargetCanvas, IconArea.Left, IconArea.Top, PaintInfo.Column.ImageIndex); + end; + + // Paint sort icon and number + if hpeOverlay in Elements then begin + SortArea := PaintArea; + GetSortIndex(PaintInfo.Column, ColSortIndex, ColSortDirection); + if ColSortIndex > -1 then begin + Inc(SortArea.Left, SortArea.Width - Sender.Images.Width); + // Prepare default font size, also if user selected a bigger one for the grid - we reserved a 16x16 space. + // Font.Height + Font.Size must be set with these values to get this working, larger or smaller Size/Height + // result in wrong size for multiple sort columns. + PaintInfo.TargetCanvas.Font.Height := -11; + PaintInfo.TargetCanvas.Font.Size := 10; + if ColSortDirection = sdAscending then begin + // This is a bit wrong - but the "Ubuntu" font doesn't have the triangle character, + // which seems available on many Windows fonts only. See #1090 + SortText := IfThen(IsWine, '↑', '▲'); + NumCharTop := 0; + end else begin + SortText := IfThen(IsWine, '↓', '▼'); + NumCharTop := 5; + end; + // Paint arrow: + PaintInfo.TargetCanvas.TextOut(SortArea.Left, SortArea.Top, SortText); + // ... and superscript number right besides: + SortText := IfThen(ColSortIndex<9, NumSortChars[ColSortIndex], NumSortChars[9]); + PaintInfo.TargetCanvas.TextOut(SortArea.Left+9, SortArea.Top+NumCharTop, SortText); + end; + end; +end;} + + +{procedure TMainForm.DataGridBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); +var + vt: TVirtualStringTree; + Select, FixedFilter: String; + RefreshingData, IsKeyColumn, NeedFullColumns: Boolean; + i, ColWidth, VisibleColumns, MaximumRows, FullColumnCount: Integer; + ColMaxLen, Offset: Int64; + ColWidths, WantedColumnOrgnames: TStringList; + KeyCols, WantedColumns: TTableColumnList; + c, ColumnInKey: TTableColumn; + OldScrollOffset: TPoint; + DBObj: TDBObject; + rx: TRegExpr; + OldCursor: TBufferCoord; + Col: TVirtualTreeColumn; + + procedure InitColumn(idx: Integer; TblCol: TTableColumn); + var + k: Integer; + begin + col := vt.Header.Columns.Add; + col.Text := TblCol.Name; + col.Hint := TblCol.Comment; + col.Options := col.Options + [coSmartResize]; + if DatagridHiddenColumns.IndexOf(TblCol.Name) > -1 then + col.Options := col.Options - [coVisible]; + // Column header icon + for k:=0 to SelectedTableKeys.Count-1 do begin + if SelectedTableKeys[k].Columns.IndexOf(TblCol.Name) > -1 then begin + col.ImageIndex := SelectedTableKeys[k].ImageIndex; + break; + end; + end; + if col.ImageIndex = -1 then begin + if SelectedTableTimestampColumns.IndexOf(TblCol.Name) > -1 then + col.ImageIndex := 149; + end; + + // Text alignment in grid cells + col.Alignment := taLeftJustify; + if DataGridResult.DataType(idx).Category in [dtcInteger, dtcReal] then + col.Alignment := taRightJustify; + end; + +begin + // Load data into data tab grid + vt := Sender as TVirtualStringTree; + if vt.Tag = VTREE_LOADED then + Exit; + DBObj := ActiveDbObj; + if DBObj = nil then + Exit; + Screen.Cursor := crHourglass; + DBObj.Connection.Ping(True); + + if SelectedTableColumns.Count = 0 then begin + EnableDataTab(False); + end else begin + EnableDataTab(True); + + // Indicates whether the current table data is just refreshed or if we're in another table + // ... or maybe in a table/database with the same name on a different server + RefreshingData := DBObj.IsSameAs(DataGridTable); + + // Load last view settings + HandleDataGridAttributes(RefreshingData); + OldScrollOffset := DataGrid.OffsetXY; + + // Remember old column widths if customized + ColWidths := TStringList.Create; + if not RefreshingData then + FDataGridColumnWidthsCustomized := False; + if FDataGridColumnWidthsCustomized then begin + for i:=0 to vt.Header.Columns.Count-1 do + ColWidths.Values[vt.Header.Columns[i].Text] := IntToStr(vt.Header.Columns[i].Width); + end; + + DataGridTable := DBObj; + + Select := ''; + // Ensure key columns are included to enable editing + KeyCols := DBObj.Connection.GetKeyColumns(SelectedTableColumns, SelectedTableKeys); + WantedColumns := TTableColumnList.Create(False); + WantedColumnOrgnames := TStringList.Create; + FullColumnCount := 0; + // If any column has INVISIBLE attribute: + NeedFullColumns := False; + for i:=0 to SelectedTableColumns.Count-1 do begin + c := SelectedTableColumns[i]; + ColumnInKey := KeyCols.FindByName(c.Name); + IsKeyColumn := Assigned(ColumnInKey); + ColMaxLen := StrToInt64Def(c.LengthSet, 0); + if (DatagridHiddenColumns.IndexOf(c.Name) = -1) + or (IsKeyColumn) + or (KeyCols.Count = 0) + then begin + if not DataGridFullRowMode + and (KeyCols.Count > 0) // We need a sufficient key to be able to load remaining row data + and (c.DataType.LoadPart) + and (not IsKeyColumn) // We need full length of any key column, so DataGridLoadFullRow() has the chance to fetch the right row + and ((ColMaxLen > GRIDMAXDATA) or (ColMaxLen = 0)) // No need to blow SQL with LEFT() if column is shorter anyway + then begin + Select := Select + DBObj.Connection.GetSQLSpecifity(spFuncLeft, [c.CastAsText, GRIDMAXDATA]) + ', '; + end else if DBObj.Connection.Parameters.IsAnyMSSQL and (c.DataType.Index=dbdtTimestamp) then begin + Select := Select + ' CAST(' + DBObj.Connection.QuoteIdent(c.Name) + ' AS INT), '; + end else if DBObj.Connection.Parameters.IsAnyMSSQL and (c.DataType.Index=dbdtHierarchyid) then begin + Select := Select + ' CAST(' + DBObj.Connection.QuoteIdent(c.Name) + ' AS NVARCHAR('+IntToStr(GRIDMAXDATA)+')), '; + end else begin + Select := Select + ' ' + DBObj.Connection.QuoteIdent(c.Name) + ', '; + Inc(FullColumnCount); + end; + WantedColumns.Add(c); + WantedColumnOrgnames.Add(c.Name); + NeedFullColumns := NeedFullColumns or c.Invisible; + end; + end; + // Cut last comma + Delete(Select, Length(Select)-1, 2); + + // Shorten the whole query if all columns are involved + if (FullColumnCount = SelectedTableColumns.Count) and (not NeedFullColumns) then + Select := '*'; + + // Include db name for cases in which dbtree is switching databases and pending updates are in process + Select := Select + ' FROM '+DBObj.QuotedDbAndTableName; + + // Append WHERE clause, and gracefully allow superfluous WHERE from user input + // Also, don't add a "WHERE ..." when the filter contains comments only + if Length(Trim(TSQLBatch.GetSQLWithoutComments(SynMemoFilter.Text))) > 0 then begin + rx := TRegExpr.Create; + rx.ModifierI := True; + rx.Expression := '^\s*WHERE\s+'; + FixedFilter := rx.Replace(SynMemoFilter.Text, ''); + if FixedFilter <> SynMemoFilter.Text then begin + OldCursor := SynMemoFilter.CaretXY; + SynMemoFilter.Text := FixedFilter; + SynMemoFilter.CaretXY := OldCursor; + end; + rx.Free; + Select := Select + ' WHERE ' + SynMemoFilter.Text + CRLF; + tbtnDataFilter.ImageIndex := 108; + end else + tbtnDataFilter.ImageIndex := 107; + SynMemoFilter.OnStatusChange(SynMemoFilter, []); + + // Append ORDER clause + if FDataGridSortItems.Count > 0 then begin + Select := Select + ' ORDER BY ' + FDataGridSortItems.ComposeOrderClause(DBObj.Connection); + tbtnDataSorting.ImageIndex := 108; + tbtnDataSorting.Caption := _('Sorting') + ' ('+IntToStr(FDataGridSortItems.Count)+')'; + end else begin + tbtnDataSorting.ImageIndex := 107; + tbtnDataSorting.Caption := _('Sorting'); + end; + + // Append LIMIT clause + Offset := 0; + if RefreshingData and (vt.Tag <> VTREE_NOTLOADED_PURGECACHE) then begin + case DBObj.Connection.Parameters.NetTypeGroup of + ngMSSQL: Offset := 0; // Does not support offset in all server versions + ngMySQL, ngPgSQL, ngSQLite: Offset := DataGridResult.RecordCount; + else raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(DBObj.Connection.Parameters.NetType)]); + end; + end; + Select := DBObj.Connection.ApplyLimitClause('SELECT', Select, DatagridWantedRowCount-Offset, Offset); + + vt.BeginUpdate; + vt.Header.Columns.Clear; + vt.Clear; + + try + ShowStatusMsg(_('Fetching rows ...')); + // Result object must be of the right vendor type + if not RefreshingData then begin + FreeAndNil(DataGridResult); + DataGridResult := DBObj.Connection.Parameters.CreateQuery(DBObj.Connection); + end; + DataGridResult.DBObject := DBObj; + DataGridResult.SQL := Trim(Select); + DataGridResult.Execute(Offset > 0); + DataGridResult.ColumnOrgNames := WantedColumnOrgnames; + try + DataGridResult.PrepareEditing; + except on E:EDbError do // Do not annoy user with popup when accessing tables in information_schema + LogSQL(_('Data in this table will be read-only.')); + end; + + editFilterVT.Clear; + TimerFilterVT.OnTimer(Sender); + + // Assign new data + vt.RootNodeCount := DataGridResult.RecordCount; + + // Set up grid column headers + ShowStatusMsg(_('Setting up columns ...')); + VisibleColumns := 0; + Col := vt.Header.Columns.Add; + Col.CaptionAlignment := taRightJustify; + Col.Alignment := taRightJustify; + Col.Options := col.Options + [coFixed]- [coAllowClick, coAllowFocus, coEditable, coResizable]; + if not AppSettings.ReadBool(asShowRowId) then + Col.Options := col.Options - [coVisible]; + Col.Text := '#'; + for i:=0 to WantedColumns.Count-1 do begin + InitColumn(i, WantedColumns[i]); + if coVisible in vt.Header.Columns[i+1].Options then + Inc(VisibleColumns); + end; + + // Signal for the user if we hide some columns + if VisibleColumns = SelectedTableColumns.Count then + tbtnDataColumns.ImageIndex := 107 + else + tbtnDataColumns.ImageIndex := 108; + tbtnDataColumns.Caption := _('Columns') + ' ('+IntToStr(VisibleColumns)+'/'+IntToStr(SelectedTableColumns.Count)+')'; + + // Autoset or restore column width + for i:=0 to vt.Header.Columns.Count-1 do begin + ColWidth := 0; + if RefreshingData then + ColWidth := StrToIntDef(ColWidths.Values[vt.Header.Columns[i].Text], ColWidth); + if ColWidth > 0 then + vt.Header.Columns[i].Width := ColWidth + else + AutoCalcColWidth(vt, i); + end; + + except + // Wrong WHERE clause in most cases + on E:EDbError do + ErrorDialog(E.Message); + end; + + vt.EndUpdate; + ApplyFontToGrids; + + // Do not steel filter while writing filters + if not SynMemoFilter.Focused then + vt.TrySetFocus; + + DataGridFocusedNodeIndex := Min(DataGridFocusedNodeIndex, Int64(vt.RootNodeCount)-1); + SelectNode(vt, DataGridFocusedNodeIndex); + for i:=0 to vt.Header.Columns.Count-1 do begin + if vt.Header.Columns[i].Text = DataGridFocusedColumnName then begin + vt.FocusedColumn := i; + break; + end; + end; + if RefreshingData then begin + + if (FDataGridLastClickedColumnHeader >= 0) and (FDataGridLastClickedColumnHeader < vt.Header.Columns.Count) then begin // See issue #3309 + // Horizontal offset based on the left side of a just sorted column + OldScrollOffset.X := -(vt.Header.Columns[FDataGridLastClickedColumnHeader].Left - vt.OffsetX - FDataGridLastClickedColumnLeftPos); + // logsql('Fixing x-offset to '+OldScrollOffset.X.ToString + + // ', FDataGridLastClickedColumnHeader:'+FDataGridLastClickedColumnHeader.ToString + + // ', FDataGridLastClickedColumnLeftPos: '+FDataGridLastClickedColumnLeftPos.ToString + + // ', vt.Header.Columns[FDataGridLastClickedColumnHeader].Left: '+vt.Header.Columns[FDataGridLastClickedColumnHeader].Left.ToString + // ); + end; + + vt.OffsetXY := OldScrollOffset; + end; + + // Reset remembered data for last clicked column header + FDataGridLastClickedColumnHeader := NoColumn; + FDataGridLastClickedColumnLeftPos := -1; + + vt.Header.Invalidate(nil); + vt.UpdateScrollBars(True); + ValidateControls(Sender); + DisplayRowCountStats(vt); + MaximumRows := AppSettings.ReadInt(asDatagridMaximumRows); + actDataShowNext.Enabled := (vt.RootNodeCount = DatagridWantedRowCount) and (DatagridWantedRowCount < MaximumRows); + actDataShowAll.Enabled := actDataShowNext.Enabled; + EnumerateRecentFilters; + ColWidths.Free; + if Integer(vt.RootNodeCount) = MaximumRows then + LogSQL(f_('Browsing is currently limited to a maximum of %s rows. To see more rows, increase this maximum in %s > %s > %s.', [FormatNumber(MaximumRows), _('Tools'), _('Preferences'), _('Data')]), lcInfo); + end; + vt.Tag := VTREE_LOADED; + DataGridFullRowMode := False; + Screen.Cursor := crDefault; + ShowStatusMsg; +end;} + + +{procedure TMainForm.DataGridColumnResize(Sender: TVTHeader; Column: TColumnIndex); +begin + // Remember current table after last column resizing so we can auto size them as long as this did not happen + if not TBaseVirtualTree(Sender.Treeview).IsUpdating then + FDataGridColumnWidthsCustomized := True; +end;} + + +{*** + Calculate + display total rowcount and found rows matching to filter + in data-tab +} +{procedure TMainForm.DisplayRowCountStats(Sender: TBaseVirtualTree); +var + DBObject: TDBObject; + ObjInCache: PDBObject; + IsFiltered, IsLimited: Boolean; + cap: String; + RowsTotal: Int64; +begin + if Sender <> DataGrid then + Exit; // Only data tab has a top label + + DBObject := ActiveDbObj; + if DBObject = nil then // Some cases have no object, don't let them crash + Exit; + + cap := ActiveDatabase + '.' + DBObject.Name; + IsLimited := DataGridWantedRowCount <= Datagrid.RootNodeCount; + IsFiltered := SynMemoFilter.GetTextLen > 0; + if DBObject.NodeType = lntTable then begin + if (not IsLimited) and (not IsFiltered) then begin + RowsTotal := DataGrid.RootNodeCount; // No need to fetch via SHOW TABLE STATUS + DBObject.RowsAreExact := True; + menuQueryExactRowCount.Enabled := False; + end + else begin + Screen.Cursor := crHourGlass; + if (not DBObject.RowsAreExact) or FExactRowCountMode then + RowsTotal := DBObject.RowCount(True, FExactRowCountMode) + else + RowsTotal := DBObject.Rows; + Screen.Cursor := crDefault; + menuQueryExactRowCount.Enabled := True; + end; + if RowsTotal > -1 then begin + cap := cap + ': ' + FormatNumber(RowsTotal) + ' ' + _('rows total'); + if DBObject.Engine = 'InnoDB' then begin + if DBObject.RowsAreExact then + cap := cap + ' ('+_('exact')+')' + else + cap := cap + ' ('+_('approximately')+')'; + end; + // Display either LIMIT or WHERE effect, not both at the same time + if IsLimited then + cap := cap + ', '+_('limited to') + ' ' + FormatNumber(Datagrid.RootNodeCount) + else if IsFiltered then begin + if Datagrid.RootNodeCount = RowsTotal then + cap := cap + ', '+_('all rows match to filter') + else + cap := cap + ', ' + FormatNumber(Datagrid.RootNodeCount) + ' '+_('rows match to filter'); + end; + // Update cached object reference with new row count, which may enable "Data" option + // in table copy dialog. See issue #666 + if Assigned(DBtree.FocusedNode) then begin + ObjInCache := DBtree.GetNodeData(DBtree.FocusedNode); + if Assigned(ObjInCache) and ObjInCache.IsSameAs(DBObject) then begin + ObjInCache.Rows := RowsTotal; + ObjInCache.RowsAreExact := DBObject.RowsAreExact; + end; + end; + end; + end; + lblDataTop.Caption := cap; + lblDataTop.Hint := cap; + FExactRowCountMode := False; +end;} + + +{procedure TMainForm.menuQueryExactRowCountClick(Sender: TObject); +begin + // Activate exact row count mode and let DisplayRowCountStats do the rest + // See https://www.heidisql.com/forum.php?t=41310 + FExactRowCountMode := True; + DisplayRowCountStats(DataGrid); +end;} + + +{procedure TMainForm.AnyGridInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); +var + Idx: PInt64; +begin + // Display multiline grid rows + // Mark all nodes as multiline capable. Fixes painting issues with long lines. (?) + // See issue #1897 and https://www.heidisql.com/forum.php?t=41502 + // Laggy performance with large grid contents (?) + if AppSettings.ReadInt(asGridRowLineCount) = 1 then + Exclude(Node.States, vsMultiLine) + else + Include(Node.States, vsMultiLine); + Sender.NodeHeight[Node] := TVirtualStringTree(Sender).DefaultNodeHeight; + // Node may have data already, if added via InsertRow + if not (vsOnFreeNodeCallRequired in Node.States) then begin + Idx := Sender.GetNodeData(Node); + Idx^ := Node.Index; + end; +end;} + + +{procedure TMainForm.AnyGridGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); +begin + NodeDataSize := SizeOf(Int64); +end;} + + +{*** + Occurs when active tab has changed. +} +{procedure TMainForm.PageControlMainChange(Sender: TObject); +var + tab: TTabSheet; +begin + // Protect from crash when pressing ctrl+tab before main form is displayed + // See #574 + if not Self.Visible then + Exit; + + tab := PageControlMain.ActivePage; + // Query helpers need a hit here, since RefreshHelperNode now only does its update on the active tab + // See https://www.heidisql.com/forum.php?t=37961 + RefreshHelperNode(TQueryTab.HelperNodeColumns); + RefreshHelperNode(TQueryTab.HelperNodeSnippets); + RefreshHelperNode(TQueryTab.HelperNodeHistory); + + // Move focus to relevant controls in order for them to receive keyboard events. + // Do this only if the user clicked the new tab. Not on automatic tab changes. + if Sender = PageControlMain then begin + if tab = tabHost then + PageControlHostChange(Sender) + else if tab = tabDatabase then + ListTables.TrySetFocus + else if tab = tabData then begin + DataGrid.TrySetFocus; + end else if IsQueryTab(tab.PageIndex, True) then begin + QueryTabs.ActiveMemo.TrySetFocus; + QueryTabs.ActiveMemo.WordWrap := actQueryWordWrap.Checked; + SynMemoQueryStatusChange(QueryTabs.ActiveMemo, [scCaretX]); + end; + end; + + // Filter panel has one text per tab, which we need to update + UpdateFilterPanel(Sender); + + // Ensure controls are in a valid state + ValidateControls(Sender); + FixQueryTabCloseButtons; +end;} + + +{procedure TMainForm.PageControlMainChanging(Sender: TObject; var AllowChange: Boolean); +begin + // Leave editing mode on tab changes so the editor does not stay somewhere + if (ActiveGridEditor <> nil) + and Assigned(ActiveGridEditor.Tree) + and ActiveGridEditor.Tree.IsEditing then begin + LogSQL('Cancelling tree edit mode on '+ActiveGridEditor.Tree.Name, lcDebug); + ActiveGridEditor.Tree.CancelEditNode; + end; +end;} + + +{procedure TMainForm.PageControlHostChange(Sender: TObject); +var + tab: TTabSheet; + list: TBaseVirtualTree; +begin + tab := PageControlHost.ActivePage; + if tab = tabDatabases then list := ListDatabases + else if tab = tabVariables then list := ListVariables + else if tab = tabStatus then list := ListStatus + else if tab = tabProcesslist then list := ListProcesses + else if tab = tabCommandStats then list := ListCommandStats + else Exit; // Silence compiler warning + list.TrySetFocus; + UpdateFilterPanel(Sender); + PageControlTabHighlight(PageControlHost); +end;} + + +{procedure TMainForm.ListTablesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); +var + i, NumObj: Integer; + Obj: TDBObject; + Objects: TDBObjectList; + NumObjects: TStringList; + Msg: String; + vt: TVirtualStringTree; + Conn: TDBConnection; + ScrollOffset: TPoint; +begin + // DB-Properties + vt := Sender as TVirtualStringTree; + if vt.Tag = VTREE_LOADED then + Exit; + LogSQL('ListTablesBeforePaint', lcDebug); + Screen.Cursor := crHourGlass; + Conn := ActiveConnection; + ScrollOffset := vt.OffsetXY; + vt.BeginUpdate; + vt.Clear; + Msg := ''; + if Conn <> nil then begin + ShowStatusMsg(f_('Displaying objects from "%s" ...', [Conn.Database])); + Objects := Conn.GetDBObjects(Conn.Database, vt.Tag = VTREE_NOTLOADED_PURGECACHE, FActiveObjectGroup); + vt.RootNodeCount := Objects.Count; + + NumObjects := TStringList.Create; + FDBObjectsMaxSize := 1; + FDBObjectsMaxRows := 1; + for i:=0 to Objects.Count-1 do begin + Obj := Objects[i]; + NumObj := StrToIntDef(NumObjects.Values[Obj.ObjType], 0); + Inc(NumObj); + NumObjects.Values[Obj.ObjType] := IntToStr(NumObj); + if Obj.Size > FDBObjectsMaxSize then FDBObjectsMaxSize := Obj.Size; + if Obj.Rows > FDBObjectsMaxRows then FDBObjectsMaxRows := Obj.Rows; + end; + Msg := Conn.Database + ': ' + FormatNumber(Objects.Count) + ' '; + if NumObjects.Count = 1 then + Msg := Msg + LowerCase(NumObjects.Names[0]) + else + Msg := Msg + 'object'; + if Objects.Count <> 1 then Msg := Msg + 's'; + if (NumObjects.Count > 1) and (Objects.Count > 0) then begin + Msg := Msg + ' ('; + for i:=0 to NumObjects.Count-1 do begin + NumObj := StrToIntDef(NumObjects.ValueFromIndex[i], 0); + if NumObj = 0 then + Continue; + Msg := Msg + FormatNumber(NumObj) + ' ' + LowerCase(NumObjects.Names[i]); + if NumObj <> 1 then Msg := Msg + 's'; + Msg := Msg + ', '; + end; + Delete(Msg, Length(Msg)-1, 2); + Msg := Msg + ')'; + end; + end; + vt.OffsetXY := ScrollOffset; + vt.EndUpdate; + vt.Tag := VTREE_LOADED; + FListTablesSorted := False; + ShowStatusMsg(Msg, 0); + ShowStatusMsg; + ValidateControls(Self); + Screen.Cursor := crDefault; +end;} + + +{procedure TMainForm.ListTablesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); +var + Obj: PDBObject; +begin + if Column <> (Sender as TVirtualStringTree).Header.MainColumn then + Exit; + Obj := Sender.GetNodeData(Node); + case Kind of + ikNormal, ikSelected: + ImageIndex := Obj.ImageIndex; + ikOverlay: + ImageIndex := Obj.OverlayImageIndex; + end; +end;} + + +{procedure TMainForm.ListTablesGetNodeDataSize(Sender: TBaseVirtualTree; + var NodeDataSize: Integer); +begin + NodeDataSize := SizeOf(TDBObject); +end;} + + +{procedure TMainForm.ListTablesGetText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; + var CellText: string); +var + Obj: PDBObject; +begin + Obj := Sender.GetNodeData(Node); + CellText := ''; + case Column of + 0: begin + if Obj.Schema <> '' then + CellText := Obj.Schema + '.' + Obj.Name + else + CellText := Obj.Name; + if Sender.IsEditing and (Node = Sender.FocusedNode) then + CellText := Obj.Name; + end; + 1: if Obj.Rows > -1 then CellText := FormatNumber(Obj.Rows); + 2: if Obj.Size > -1 then CellText := FormatByteNumber(Obj.Size); + 3: CellText := DateTimeToStrDef(Obj.Created, ''); + 4: CellText := DateTimeToStrDef(Obj.Updated, ''); + 5: CellText := Obj.Engine; + 6: CellText := Obj.Comment; + 7: if Obj.Version > -1 then CellText := IntToStr(Obj.Version); + 8: CellText := Obj.RowFormat; + 9: if Obj.AvgRowLen > -1 then CellText := FormatByteNumber(Obj.AvgRowLen); + 10: if Obj.MaxDataLen > -1 then CellText := FormatByteNumber(Obj.MaxDataLen); + 11: if Obj.IndexLen > -1 then CellText := FormatByteNumber(Obj.IndexLen); + 12: if Obj.DataFree > -1 then CellText := FormatByteNumber(Obj.DataFree); + 13: if Obj.AutoInc > -1 then CellText := FormatNumber(Obj.AutoInc); + 14: if Obj.LastChecked <> 0 then CellText := DateTimeToStr(Obj.LastChecked); + 15: CellText := Obj.Collation; + 16: if Obj.Checksum > -1 then CellText := IntToStr(Obj.Checksum); + 17: CellText := Obj.CreateOptions; + 18: CellText := Obj.ObjType; + end; +end;} + + +{procedure TMainForm.ListTablesInitNode(Sender: TBaseVirtualTree; ParentNode, + Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); +var + Obj: PDBObject; + Objects: TDBObjectList; + Conn: TDBConnection; +begin + Conn := ActiveConnection; + Obj := Sender.GetNodeData(Node); + if (Conn <> nil) and (not Conn.Database.IsEmpty) then begin + Objects := Conn.GetDBObjects(Conn.Database, False, FActiveObjectGroup); + Obj^ := Objects[Node.Index]; + end else begin + Obj^ := nil; + LogSQL('InitNode on '+Sender.Name+' failed, due to no connection or no database set. Database: "'+Conn.Database+'"', lcDebug); + end; +end;} + + + +{*** + Selection in ListTables is changing +} +{procedure TMainForm.ListTablesChange(Sender: TBaseVirtualTree; Node: + PVirtualNode); +var + Msg: String; +begin + ValidateControls(Sender); + if ListTables.SelectedCount > 1 then + Msg := _('Selected') + ': ' + FormatNumber(ListTables.SelectedCount) + else + Msg := ''; + ShowStatusMsg(Msg, 1) +end;} + + +{*** + Enable/disable various buttons and menu items. + Invoked when + - active sheet changes + - highlighted database changes + ... +} +{procedure TMainForm.ValidateControls(Sender: TObject); +var + inDataTab, inDataOrQueryTab, inDataOrQueryTabNotEmpty, inGrid: Boolean; + HasConnection, GridHasChanges, EnableTimestamp: Boolean; + Grid: TVirtualStringTree; + inSynMemo, inSynMemoEditable: Boolean; + Results: TDBQuery; + RowNum: PInt64; + CellText: String; + Conn: TDBConnection; + ResultCol: Integer; +begin + // When adding some new TAction here, be sure to apply this procedure to its OnUpdate event + + Grid := ActiveGrid; + Conn := ActiveConnection; + HasConnection := Conn <> nil; + Results := nil; + GridHasChanges := False; + EnableTimestamp := False; + CellText := ''; + if HasConnection and Assigned(Grid) then begin + Results := GridResult(Grid); + ResultCol := Grid.FocusedColumn -1; + if (Results<>nil) and Assigned(Grid.FocusedNode) then begin + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; + GridHasChanges := Results.Modified or Results.Inserted; + if ResultCol > NoColumn then begin + EnableTimestamp := Results.DataType(ResultCol).Category in [dtcInteger, dtcReal]; + CellText := Results.Col(ResultCol, True); + end; + end; + end; + inDataTab := Grid = DataGrid; + inDataOrQueryTab := inDataTab or QueryTabs.HasActiveTab; + inDataOrQueryTabNotEmpty := inDataOrQueryTab and Assigned(Grid) and (Grid.RootNodeCount > 0); + inGrid := Assigned(Grid) and (ActiveControl = Grid); + + actFullRefresh.Enabled := HasConnection and (PageControlMain.ActivePage = tabDatabase); + actDataInsert.Enabled := HasConnection and inGrid and Assigned(Results); + actDataDuplicateRowWithoutKeys.Enabled := HasConnection and inGrid and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actDataDuplicateRowWithKeys.Enabled := actDataDuplicateRowWithoutKeys.Enabled; + actDataDelete.Enabled := HasConnection and inGrid and (Grid.SelectedCount > 0); + actDataFirst.Enabled := HasConnection and inDataOrQueryTabNotEmpty and inGrid; + actDataLast.Enabled := HasConnection and inDataOrQueryTabNotEmpty and inGrid; + actDataPostChanges.Enabled := HasConnection and GridHasChanges; + actDataCancelChanges.Enabled := HasConnection and GridHasChanges; + actDataSaveBlobToFile.Enabled := HasConnection and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actGridEditFunction.Enabled := HasConnection and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actDataPreview.Enabled := HasConnection and inDataOrQueryTabNotEmpty and Assigned(Grid.FocusedNode); + actDataOpenUrl.Enabled := (Length(CellText)<SIZE_MB) and ExecRegExpr('^(https?://[^\s]+|www\.\w\S+)$', CellText); + actUnixTimestampColumn.Enabled := HasConnection and inDataTab and EnableTimestamp; + actUnixTimestampColumn.Checked := inDataTab and HandleUnixTimestampColumn(Grid, Grid.FocusedColumn); + actPreviousResult.Enabled := HasConnection and QueryTabs.HasActiveTab and Assigned(QueryTabs.ActiveTab.ActiveResultTab); + actNextResult.Enabled := actPreviousResult.Enabled; + + // Activate export-options if we're in any list control + actExportData.Enabled := HasConnection; + actDataSetNull.Enabled := HasConnection and inDataOrQueryTab and Assigned(Results) and Assigned(Grid.FocusedNode); + + // Help only supported on regular MySQL and MariaDB servers + actSQLHelp.Enabled := HasConnection; + + inSynMemo := ActiveSynMemo(True) <> nil; + inSynMemoEditable := inSynMemo and (not ActiveSynMemo(True).ReadOnly); + actSaveSynMemoToTextfile.Enabled := inSynMemo; + actToggleComment.Enabled := inSynMemoEditable; + if inSynMemo then begin + actCut.Enabled := inSynMemoEditable; + actPaste.Enabled := inSynMemoEditable; + end else begin + actCut.Enabled := True; + actPaste.Enabled := True; + end; + + ValidateQueryControls(Sender); + UpdateLineCharPanel; + PageControlTabHighlight(PageControlMain); +end;} + + +{procedure TMainForm.ValidateQueryControls(Sender: TObject); +var + NotEmpty, HasSelection, HasConnection: Boolean; + Tab: TQueryTab; + cap: String; + InQueryTab, InEditorTab: Boolean; + Conn: TDBConnection; +begin + // Enable/disable TActions, according to the current window/connection state + + // Prevent superfluous calls while setting up query tabs + if not MainFormAfterCreateDone then + Exit; + + for Tab in QueryTabs do begin + cap := Trim(Tab.TabSheet.Caption); + if cap[Length(cap)] = '*' then + cap := Copy(cap, 1, Length(cap)-1); + if Tab.Memo.Modified then + cap := cap + '*'; + if Tab.TabSheet.Caption <> cap then + SetTabCaption(Tab.TabSheet.PageIndex, cap); + end; + InQueryTab := QueryTabs.HasActiveTab; + InEditorTab := PageControlMain.ActivePage = tabEditor; + Tab := QueryTabs.ActiveTab; + NotEmpty := InQueryTab and (Tab.Memo.GetTextLen > 0); + HasSelection := InQueryTab and Tab.Memo.SelAvail; + Conn := ActiveConnection; + HasConnection := Conn <> nil; + actExecuteQuery.Enabled := HasConnection and InQueryTab and NotEmpty and (not Tab.QueryRunning); + actExecuteSelection.Enabled := HasConnection and InQueryTab and HasSelection and (not Tab.QueryRunning); + actExecuteCurrentQuery.Enabled := actExecuteQuery.Enabled; + actExplainCurrentQuery.Enabled := actExecuteQuery.Enabled and (Conn.Parameters.NetTypeGroup in [ngMySQL, ngPgSQL, ngSQLite]); + actSaveSQLAs.Enabled := InQueryTab and NotEmpty; + actSaveSQL.Enabled := (actSaveSQLAs.Enabled and Tab.Memo.Modified) or InEditorTab; + actSaveSQLselection.Enabled := InQueryTab and HasSelection; + actSaveSQLSnippet.Enabled := InQueryTab and NotEmpty; + actSaveSQLSelectionSnippet.Enabled := InQueryTab and HasSelection; + actClearQueryEditor.Enabled := InQueryTab; + actSetDelimiter.Enabled := InQueryTab; + actCloseQueryTab.Enabled := IsQueryTab(PageControlMain.ActivePageIndex, False); + actCloseAllQueryTabs.Enabled := QueryTabs.Count > 1; + actCodeFoldingStartRegion.Enabled := InQueryTab; + actCodeFoldingEndRegion.Enabled := InQueryTab; + actCodeFoldingFoldSelection.Enabled := HasSelection; + if InQueryTab then begin + if HasConnection and (Conn.Parameters.SessionColor <> clNone) then begin + Tab.Memo.Gutter.Color := Conn.Parameters.SessionColor; + end + else begin + Tab.Memo.Gutter.Color := clBtnFace; + end; + end; + +end;} + + +{procedure TMainForm.KillProcess(Sender: TObject); +var + t: Boolean; + pid: Int64; + Node: PVirtualNode; + Conn: TDBConnection; +begin + t := TimerRefresh.Enabled; + TimerRefresh.Enabled := false; // prevent av (ListProcesses.selected...) + Conn := ActiveConnection; + if MessageDialog('Kill '+IntToStr(ListProcesses.SelectedCount)+' Process(es)?', mtConfirmation, [mbok,mbcancel]) = mrok then + begin + Node := GetNextNode(ListProcesses, nil, True); + while Assigned(Node) do begin + pid := StrToInt64Def(ListProcesses.Text[Node, ListProcesses.Header.MainColumn], 0); + // Don't kill own process + if pid = Conn.ThreadId then + LogSQL(f_('Ignoring own process id #%d when trying to kill it.', [pid])) + else try + Conn.Query(Conn.GetSQLSpecifity(spKillProcess, [pid])); + except + on E:EDbError do begin + if Conn.LastErrorCode <> ER_NO_SUCH_THREAD then + if MessageDialog(E.Message, mtError, [mbOK, mbAbort]) = mrAbort then + break; + end; + end; + Node := GetNextNode(ListProcesses, Node, True); + end; + InvalidateVT(ListProcesses, VTREE_NOTLOADED, True); + end; + TimerRefresh.Enabled := t; // re-enable autorefresh timer +end;} + + +{procedure TMainForm.SynCompletionProposalChange(Sender: TObject; + AIndex: Integer); +var + Proposal: TSynCompletionProposal; + SelectedFuncName: String; + SQLFunc: TSQLFunction; +begin + Proposal := Sender as TSynCompletionProposal; + if (AIndex >= 0) and (AIndex < Proposal.ItemList.Count) then begin + Proposal.Title := Proposal.InsertItem(AIndex); + // Show function description in hint panel + ShowStatusMsg('', 0);} + //SelectedFuncName := RegExprGetMatch('}function\\column\{\}\\color\{\w+\}([^\\]+)\\', Proposal.DisplayItem(AIndex), 1); + {if not SelectedFuncName.IsEmpty then begin + for SQLFunc in ActiveConnection.SQLFunctions do begin + if SQLFunc.Name.ToUpper = SelectedFuncName.ToUpper then begin + ShowStatusMsg(SQLFunc.Description.Replace(SLineBreak, ' '), 0); + Break; + end; + end; + end; + end; +end;} + + +{ Proposal about to insert a String into synmemo } +{procedure TMainForm.SynCompletionProposalCodeCompletion(Sender: TObject; + var Value: String; Shift: TShiftState; Index: Integer; EndToken: Char); +var + Proposal: TSynCompletionProposal; + rx: TRegExpr; + ImageIndex, f: Integer; + FunctionDeclaration: String; +begin + Proposal := Sender as TSynCompletionProposal; + // Surround identifiers with backticks if it is a column, table, routine, db + rx := TRegExpr.Create;} + //rx.Expression := '\\image\{(\d+)\}'; + {if rx.Exec(Proposal.ItemList[Index]) then begin + ImageIndex := MakeInt(rx.Match[1]); + if not (ImageIndex in [ICONINDEX_KEYWORD, ICONINDEX_FUNCTION, 113]) then begin + FunctionDeclaration := ''; + f := Pos('(', Value); + if f > 0 then begin + FunctionDeclaration := Copy(Value, f, Length(Value)); + Delete(Value, f, Length(Value)); + end; + + rx.Expression := '^(['+QuoteRegExprMetaChars(ActiveConnection.QuoteChars)+'])(.*)$'; + if rx.Exec(Value) then begin + // Left character of identifier is already a quote: user wants to force quoting. + // Seperate that left quote character away from what gets now quoted automatically, and force quoting + Value := ActiveConnection.QuoteIdent(rx.Match[2], True) + FunctionDeclaration; + end else begin + // Identifier without left quote - quote when required + Value := ActiveConnection.QuoteIdent(Value, False) + FunctionDeclaration; + end; + end; + end; + rx.Free; + Proposal.Form.CurrentEditor.UndoList.AddGroupBreak; + // Hide hint text added in .OnChange event + ShowStatusMsg('', 0); +end;} + + +{procedure TMainForm.SynCompletionProposalAfterCodeCompletion(Sender: TObject; + const Value: String; Shift: TShiftState; Index: Integer; EndToken: Char); +var + Proposal: TSynCompletionProposal; +begin + Proposal := Sender as TSynCompletionProposal; + Proposal.Form.CurrentEditor.UndoList.AddGroupBreak; + // Explicitly set focus again to work around a bug in Ultramon, see issue #2396 + Proposal.Form.CurrentEditor.SetFocus; +end;} + + +{ Proposal-Combobox pops up } +{procedure TMainForm.SynCompletionProposalExecute(Kind: SynCompletionType; + Sender: TObject; var CurrentInput: String; var x, y: Integer; + var CanExecute: Boolean); +var + i, j, ImageIndex, ColumnsInList: Integer; + Results: TDBQuery; + DBObjects: TDBObjectList; + CurrentQuery, TableClauses, TableName, LeftPart, Token1, Token2, Token3, Token, Ident: String; + Tables: TStringList; + rx: TRegExpr; + Start, TokenTypeInt: Integer; + Attri: TSynHighlighterAttributes; + Proposal: TSynCompletionProposal; + Editor: TCustomSynEdit; + Queries: TSQLBatch; + Query: TSQLSentence; + Conn: TDBConnection; + RoutineEditor: TfrmRoutineEditor; + Param: TRoutineParam; + DisplayText: String; + SQLFunc: TSQLFunction; + + procedure AddTable(Obj: TDBObject); + var + FunctionDeclaration: String; + FuncParams: TRoutineParamList; + FuncParam: TRoutineParam; + begin + // Append routine parameter declaration + FunctionDeclaration := ''; + if Obj.NodeType in [lntProcedure, lntFunction] then begin + FuncParams := TRoutineParamList.Create(True); + Obj.Connection.ParseRoutineStructure(Obj, FuncParams); + for FuncParam in FuncParams do begin + FunctionDeclaration := FunctionDeclaration + FuncParam.Name + ', '; + end; + if FunctionDeclaration <> '' then begin + Delete(FunctionDeclaration, Length(FunctionDeclaration)-1, 2); + FunctionDeclaration := '(' + FunctionDeclaration + ')'; + end; + FuncParams.Free; + end; + + DisplayText := SynCompletionProposalPrettyText(Obj.ImageIndex, _(LowerCase(Obj.ObjType)), Obj.Name, FunctionDeclaration); + Proposal.AddItem(DisplayText, Obj.Name+FunctionDeclaration); + end; + + procedure AddColumns(const LeftToken: String); + var + dbname, tblname: String; + Columns: TTableColumnList; + Col: TTableColumn; + Keys: TTableKeyList; + Key: TTableKey; + Obj: TDBObject; + ColumnIcon: Integer; + begin + dbname := ''; + tblname := LeftToken; + if Pos('.', tblname) > -1 then begin + dbname := Copy(tblname, 0, Pos('.', tblname)-1); + tblname := Copy(tblname, Pos('.', tblname)+1, Length(tblname)); + end; + // db and table name may already be quoted + if dbname = '' then + dbname := Conn.Database; + dbname := Conn.DeQuoteIdent(dbname); + tblname := Conn.DeQuoteIdent(tblname); + DBObjects := Conn.GetDBObjects(dbname); + for Obj in DBObjects do begin + if (Obj.Name.ToLowerInvariant = tblname.ToLowerInvariant) and (Obj.NodeType in [lntTable, lntView]) then begin + Columns := Obj.TableColumns; + Keys := Obj.TableKeys; + for Col in Columns do begin + // Detect index icon, if any + ColumnIcon := ICONINDEX_FIELD; + for Key in Keys do begin + if Key.Columns.Contains(Col.Name) then begin + ColumnIcon := Key.ImageIndex; + Break; + end; + end; + // Put formatted text and icon into proposal + DisplayText := SynCompletionProposalPrettyText(ColumnIcon, LowerCase(Col.DataType.Name), Col.Name, Col.Comment, DatatypeCategories[Col.DataType.Category].NullColor); + if CurrentInput.StartsWith(Conn.QuoteChar) then + Proposal.AddItem(DisplayText, Conn.QuoteChar + Col.Name) + else + Proposal.AddItem(DisplayText, Col.Name); + Inc(ColumnsInList); + end; + Columns.Free; + break; + end; + end; + end; + +begin + Proposal := Sender as TSynCompletionProposal; + Proposal.Font.Assign(Font); + Proposal.TitleFont.Size := Proposal.Font.Size; + Proposal.ItemHeight := ScaleSize(PROPOSAL_ITEM_HEIGHT); + Proposal.ClearList; + Proposal.Columns[0].ColumnWidth := ScaleSize(100); // Kind of random value, but fits well + Proposal.Columns[1].ColumnWidth := ScaleSize(100); + Conn := ActiveConnection; + Editor := Proposal.Form.CurrentEditor; + Editor.GetHighlighterAttriAtRowColEx(Editor.PrevWordPos, Token, TokenTypeInt, Start, Attri); + CanExecute := AppSettings.ReadBool(asCompletionProposal) and + (not (TtkTokenKind(TokenTypeInt) in [SynHighlighterSQL.tkString, SynHighlighterSQL.tkComment])); + if not CanExecute then + Exit; + + // Work around for issue #2640. See ApplicationDeActivate + Proposal.Form.Enabled := True; + + rx := TRegExpr.Create; + + // Find token1.token2.token3, while cursor is somewhere in token3 + Ident := '[^\s,=\.]'; + rx.Expression := '(('+Ident+'+)\.)?('+Ident+'+)\.('+Ident+'*)$'; + LeftPart := Copy(Editor.LineText, 1, Editor.CaretX-1); + if rx.Exec(LeftPart) then begin + Token1 := Conn.DeQuoteIdent(rx.Match[2]); + Token2 := Conn.DeQuoteIdent(rx.Match[3]); + Token3 := Conn.DeQuoteIdent(rx.Match[4]); + end; + + // Server variables, s'il vous plait? + rx.Expression := '^@@(SESSION|GLOBAL)$'; + rx.ModifierI := True; + if rx.Exec(Token2) then begin + try + Results := Conn.GetResults('SHOW '+UpperCase(rx.Match[1])+' VARIABLES'); + while not Results.Eof do begin + DisplayText := SynCompletionProposalPrettyText(ICONINDEX_PRIMARYKEY, _('Variable'), Results.Col(0), StringReplace(Results.Col(1), '\', '\\', [rfReplaceAll])); + Proposal.AddItem(DisplayText, Results.Col(0)); + Results.Next; + end; + except + // Just log error in sql log, do not disturb user while typing + end; + end else begin + // Get column names into the proposal pulldown + // when we write sql like "SELECT t.|col FROM table [AS] t" + // Current limitation: Identifiers (masked or not) containing + // spaces are not detected correctly. + + // 1. find currently edited sql query around the cursor position in synmemo + if Editor = SynMemoFilter then begin + // Make sure the below regexp can find structure + CurrentQuery := 'SELECT * FROM '+ActiveDbObj.QuotedName+' WHERE ' + Editor.Text; + end else begin + // In a query tab + Queries := TSQLBatch.Create; + Queries.SQL := Editor.Text; + for Query in Queries do begin + if (Query.LeftOffset <= Editor.SelStart) and (Editor.SelStart < Query.RightOffset) then begin + CurrentQuery := Query.SQLWithoutComments; + Break; + end; + end; + Queries.Free; + end; + + // 2. Parse FROM clause, detect relevant table/view, probably aliased + rx.ModifierG := True; + rx.ModifierI := True; + rx.Expression := '\b(FROM|INTO|UPDATE)\s+(IGNORE\s+)?(.+)(WHERE|HAVING|ORDER|GROUP)?'; + if rx.Exec(CurrentQuery) then begin + TableClauses := rx.Match[3]; + // Ensure tables in JOIN clause(s) are splitted by comma + TableClauses := ReplaceRegExpr('\sJOIN\s', TableClauses, ',', [rroModifierI]); + // Remove surrounding parentheses + TableClauses := StringReplace(TableClauses, '(', ' ', [rfReplaceAll]); + TableClauses := StringReplace(TableClauses, ')', ' ', [rfReplaceAll]); + // Split table clauses by commas + Tables := TStringList.Create; + Tables.Delimiter := ','; + Tables.StrictDelimiter := true; + Tables.DelimitedText := TableClauses; + rx.Expression := '(\S+)\s+(AS\s+)?(\S+)'; + + for i := 0 to Tables.Count - 1 do begin + // If the just typed word equals the alias of this table or the + // tablename itself, set tablename var and break loop + if rx.Exec(Tables[i]) then while true do begin + if Token2 = Conn.DeQuoteIdent(rx.Match[3]) then begin + TableName := rx.Match[1]; + break; + end; + if not rx.ExecNext then + break; + end; + if TableName <> '' then + break; + end; + end; + + ColumnsInList := 0; + if TableName <> '' then + AddColumns(TableName) + else if Token1 <> '' then + AddColumns(Conn.QuoteIdent(Token1, False)+'.'+Conn.QuoteIdent(Token2, False)) + else if Token2 <> '' then + AddColumns(Conn.QuoteIdent(Token2, False)); + + if Token1 = '' then begin + i := Conn.AllDatabases.IndexOf(Token2); + if i > -1 then begin + // Tables from specific database + Screen.Cursor := crHourGlass; + DBObjects := Conn.GetDBObjects(Conn.AllDatabases[i]); + Conn.PrefetchCreateCode(DBObjects); + for j:=0 to DBObjects.Count-1 do + AddTable(DBObjects[j]); + Conn.PurgePrefetchResults; + Screen.Cursor := crDefault; + end; + end; + + if Token2 = '' then begin + + // Column names from selected table, in data filter memo. + // For query memo only if no columns were added from left side table. + if ColumnsInList = 0 then begin + // Avoid usage of .QuotedName so we don't get the schema in it, see https://www.heidisql.com/forum.php?t=35411 + AddColumns(Conn.QuoteIdent(ActiveDbObj.Name)); + end; + + // All databases + for i:=0 to Conn.AllDatabases.Count-1 do begin + DisplayText := SynCompletionProposalPrettyText(ICONINDEX_DB, _('database'), Conn.AllDatabases[i], ''); + Proposal.AddItem(DisplayText, Conn.AllDatabases[i]); + end; + + // Tables from current db + if Conn.Database <> '' then begin + DBObjects := Conn.GetDBObjects(Conn.Database); + Conn.PrefetchCreateCode(DBObjects); + for j:=0 to DBObjects.Count-1 do + AddTable(DBObjects[j]); + Conn.PurgePrefetchResults; + if Token1 <> '' then // assume that we have already a dbname in memo + Proposal.Position := Conn.AllDatabases.Count; + end; + + // Functions + for SQLFunc in Conn.SQLFunctions do begin + DisplayText := SynCompletionProposalPrettyText(ICONINDEX_FUNCTION, _('function'), SQLFunc.Name, SQLFunc.Declaration); + Proposal.AddItem(DisplayText, SQLFunc.Name + SQLFunc.Declaration); + end; + + + // Keywords + for i:=0 to MySQLKeywords.Count-1 do begin + DisplayText := SynCompletionProposalPrettyText(ICONINDEX_KEYWORD, _('keyword'), MySQLKeywords[i], ''); + Proposal.AddItem(DisplayText, MySQLKeywords[i]); + end; + + // Procedure params + if GetParentFormOrFrame(Editor) is TfrmRoutineEditor then begin + RoutineEditor := GetParentFormOrFrame(Editor) as TfrmRoutineEditor; + for Param in RoutineEditor.Parameters do begin + if Param.Context = 'IN' then ImageIndex := 120 + else if Param.Context = 'OUT' then ImageIndex := 121 + else if Param.Context = 'INOUT' then ImageIndex := 122 + else ImageIndex := -1; + DisplayText := SynCompletionProposalPrettyText(ImageIndex, Param.Datatype, Param.Name, ''); + Proposal.AddItem(DisplayText, Param.Name); + end; + end; + + end; + + end; + rx.Free; + +end;} + + +{procedure TMainForm.SynMemoQueryScanForFoldRanges(Sender: TObject; + FoldRanges: TSynFoldRanges; LinesToScan: TStrings; FromLine, ToLine: Integer); +var + Line: Integer; + LineText: String; +begin + // Code folding detection based on keywords in beginning of lines + for Line:=FromLine to ToLine do begin + LineText := LinesToScan[Line].TrimLeft; + if LineText.StartsWith('#region', True) then + FoldRanges.StartFoldRange(Line+1, FoldRegionType) + else if LineText.StartsWith('#endregion', True) then + FoldRanges.StopFoldRange(Line+1, FoldRegionType) + else + FoldRanges.NoFoldInfo(Line+1); + end; +end;} + + +{procedure TMainForm.SynMemoQuerySpecialLineColors(Sender: TObject; + Line: Integer; var Special: Boolean; var FG, BG: TColor); +var + Edit: TSynMemo; + Tab: TQueryTab; +begin + // Paint error line with red background + Edit := Sender as TSynMemo; + Tab := QueryTabs.TabByControl(Edit); + if Tab <> QueryTabs.ActiveTab then + Exit; + if Line = Tab.ErrorLine then begin + Special := True; + FG := ErrorLineForeground; + BG := ErrorLineBackground; + end; +end;} + + +{procedure TMainForm.SynMemoSQLLogSpecialLineColors(Sender: TObject; + Line: Integer; var Special: Boolean; var FG, BG: TColor); +var + Edit: TSynMemo; + LineText, Search: String; +begin + // Paint error line with red background, or warning in orange + Edit := Sender as TSynMemo; + LineText := Copy(Edit.Lines[Line-1], 1, 100); + Search := _(MsgSQLError); + Search := Copy(Search, 1, Pos('%', Search)-1); + //Logsql(LineText+' ::: '+Search); + if LineText.Contains(Search) then begin + Special := True; + FG := ErrorLineForeground; + BG := ErrorLineBackground; + end + else if LineText.Contains(_(SLogPrefixWarning)+':') then begin + Special := True; + FG := WarningLineForeground; + BG := WarningLineBackground; + end + else if LineText.Contains(_(SLogPrefixNote)+':') then begin + Special := True; + FG := NoteLineForeground; + BG := NoteLineBackground; + end + else if LineText.Contains(_(SLogPrefixInfo)+':') then begin + Special := True; + FG := InfoLineForeground; + BG := InfoLineBackground; + end; +end;} + + +{procedure TMainForm.SynMemoQueryStatusChange(Sender: TObject; Changes: TSynStatusChanges); +var + Edit: TSynMemo; + Tab: TQueryTab; + ContentOrCursor: Boolean; +begin + if not MainFormAfterCreateDone then + Exit; + + Edit := Sender as TSynMemo; + Tab := QueryTabs.TabByControl(Edit); + if Tab <> QueryTabs.ActiveTab then + Exit; + + ContentOrCursor := (scCaretX in Changes) or (scCaretY in Changes) or (scModified in Changes); + if ContentOrCursor then begin + // Disable error marker + Tab.ErrorLine := -1; + + // Check if bind param detection is enabled for text size <1M + // Uncheck checkbox if it's bigger + // Code moved back from TQueryTab.MemoOnChange here + Tab.TimerLastChange.Enabled := False; + Tab.FLastChange := Now; + Tab.TimerLastChange.Enabled := True; + + // Don't ask for saving empty contents. See issue #614 + if Edit.GetTextLen = 0 then begin + Tab.MemoFilename := ''; + Tab.Memo.Modified := False; + end; + + // Update various controls + ValidateQueryControls(Sender); + + UpdateLineCharPanel; + end; +end;} + + +{procedure TMainForm.SynMemoQueryTokenHint(Sender: TObject; Coords: TBufferCoord; + const Token: string; TokenType: Integer; Attri: TSynHighlighterAttributes; + var HintText: string); +var + SQLFunc: TSQLFunction; + Conn: TDBConnection; + AllObjects: TDBObjectList; + Obj: TDBObject; + i, ColumnNameChars: Integer; + Column: TTableColumn; + Parameters: TRoutineParamList; + Params: TStringList; + Param: TRoutineParam; +begin + // Activate hint for SQL function in query editors + Conn := ActiveConnection; + if Assigned(Conn) then begin + case TtkTokenKind(TokenType) of + + SynHighlighterSQL.tkFunction: begin + for SQLFunc in ActiveConnection.SQLFunctions do begin + if SQLFunc.Name.ToUpper = Token.ToUpper then begin + HintText := SQLFunc.Name + SQLFunc.Declaration + sLineBreak + sLineBreak + SQLFunc.Description; + Break; + end; + end; + end; + + SynHighlighterSQL.tkTableName: begin + // Show some details from table listing cache + if (not Conn.IsLockedByThread) and Conn.DbObjectsCached(Conn.Database) then begin + AllObjects := Conn.GetDBObjects(Conn.Database); + for Obj in AllObjects do begin + if (Obj.NodeType = lntTable) and (Obj.Name.ToLower = Token.ToLower) then begin + HintText := _(Obj.ObjType) + ' ' + Obj.Name + ':' + sLineBreak + + _('Rows') + ': ' + FormatNumber(Obj.Rows) + sLineBreak + + _('Size') + ': ' + FormatByteNumber(Obj.DataLen + Obj.IndexLen) + SLineBreak; + ColumnNameChars := 0; + for Column in Obj.TableColumns do begin + ColumnNameChars := Max(ColumnNameChars, Length(Column.Name)); + end; + for Column in Obj.TableColumns do begin + HintText := HintText + Format('%s%'+ColumnNameChars.ToString+'s: %s', [SLineBreak, Column.Name, Column.FullDataType]); + end; + + Break; + end; + end; + end; + end; + + SynHighlighterSQL.tkProcName: begin + // Show routine parameters, comment and body + if (not Conn.IsLockedByThread) and Conn.DbObjectsCached(Conn.Database) then begin + AllObjects := Conn.GetDBObjects(Conn.Database); + for Obj in AllObjects do begin + if (Obj.NodeType in [lntFunction, lntProcedure]) and (Obj.Name.ToLower = Token.ToLower) then begin + Parameters := TRoutineParamList.Create; + Conn.ParseRoutineStructure(Obj, Parameters); + HintText := _(Obj.ObjType) + ' ' + Obj.Name; + Params := TStringList.Create; + for Param in Parameters do begin + Params.Add(Param.Name + ' ['+Param.Datatype+']'); + end; + HintText := HintText + '(' + Implode(', ', Params) + ')' + sLineBreak + sLineBreak; + Params.Free; + if not Obj.Returns.IsEmpty then + HintText := HintText + 'Returns: ' + Obj.Returns + sLineBreak + sLineBreak; + if not Obj.Comment.IsEmpty then + HintText := HintText + Obj.Comment + sLineBreak + sLineBreak; + if not Obj.Body.IsEmpty then + HintText := HintText + StrEllipsis(Obj.Body, SIZE_KB); + HintText := Trim(HintText); + Break; + end; + end; + end; + end; + + SynHighlighterSQL.tkDatatype: begin + for i:=Low(Conn.Datatypes) to High(Conn.Datatypes) do begin + if Conn.Datatypes[i].Name.ToLower = Token.ToLower then begin + HintText := WrapText(Conn.Datatypes[i].Description, 100); + Break; + end; + end; + end; + + SynHighlighterSQL.tkString: begin + HintText := _('String:') + ' ' + FormatByteNumber(Length(Token)); + end; + + end; + end; +end;} + +{procedure TMainForm.TimerHostUptimeTimer(Sender: TObject); +var + Conn: TDBConnection; + Uptime: Integer; + ServerNow: TDateTime; + ServerNowStr: String; +begin + // Display server uptime and current date time + Conn := ActiveConnection; + if Assigned(Conn) then begin + Uptime := Conn.ServerUptime; + if Uptime >= 0 then + ShowStatusMsg(_('Uptime')+': '+FormatTimeNumber(Conn.ServerUptime, False), 4) + else + ShowStatusMsg(_('Uptime')+': '+_('unknown'), 4); + + ServerNow := Conn.ServerNow; + if ServerNow >= 0 then begin + DateTimeToString(ServerNowStr, 't', ServerNow); + ShowStatusMsg(f_('Server time: %s', [ServerNowStr]), 5) + end else + ShowStatusMsg(f_('Server time: %s', [_('unknown')]), 5); + end else begin + ShowStatusMsg('', 4); + end; + +end;} + + +{procedure TMainForm.TimerRefreshTimer(Sender: TObject); +begin + // Auto-refreshing grid or list. Only if main form is active, to prevent issues like #669 + if Screen.ActiveForm = Self then + actRefresh.Execute; +end;} + + +{procedure TMainForm.ListTablesEditing(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); +var + Obj: PDBObject; +begin + // Tables and views can be renamed, routines cannot + if Assigned(Node) then begin + Obj := Sender.GetNodeData(Node); + Allowed := Obj.NodeType in [lntTable, lntView]; + end; +end;} + + +{*** + Rename table after checking the new name for invalid characters +} +{procedure TMainForm.ListTablesNewText(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; NewText: String); +var + Obj: PDBObject; + sql: String; +begin + // Fetch data from node + Obj := Sender.GetNodeData(Node); + + // Try to rename, on any error abort and don't rename ListItem + try + // rename table + case Obj.NodeType of + lntTable: + sql := Obj.Connection.GetSQLSpecifity(spRenameTable); + lntView: + sql := Obj.Connection.GetSQLSpecifity(spRenameView); + else + raise EDbError.Create('Cannot rename '+Obj.ObjType); + end; + + sql := Format(sql, [Obj.QuotedName(True, False), Obj.Connection.QuoteIdent(NewText)]); + Obj.Connection.Query(sql); + + if SynSQLSynUsed.TableNames.IndexOf( NewText ) = -1 then begin + SynSQLSynUsed.TableNames.Add(NewText); + end; + // Update nodedata + Obj.Name := NewText; + Obj.UnloadDetails; + // Now the active tree db has to be updated. But calling RefreshTreeDB here causes an AV + // so we do it manually here + DBTree.InvalidateChildren(FindDBNode(DBtree, Obj.Connection, Obj.Database), True); + except + on E:EDbError do + ErrorDialog(E.Message); + end; +end;} + + +{procedure TMainForm.TimerConnectedTimer(Sender: TObject); +var + ConnectedTime: Integer; + Conn: TDBConnection; +begin + Conn := ActiveConnection; + if (Conn <> nil) and Conn.Active then begin + // Calculate and display connection-time. Also, on any connect or reconnect, update server version panel. + ConnectedTime := Conn.ConnectionUptime; + ShowStatusMsg(_('Connected')+': ' + FormatTimeNumber(ConnectedTime, False), 2); + end else begin + ShowStatusMsg(_('Disconnected'), 2); + end; +end;} + + +{procedure TMainForm.Copylinetonewquerytab1Click(Sender: TObject); +var + Tab: TQueryTab; + LineText: String; +begin + // Create new query tab with current line in SQL log. This is for lazy mouse users. + if actNewQueryTab.Execute then begin + Tab := QueryTabs[MainForm.QueryTabs.Count-1]; + LineText := SynMemoSQLLog.LineText; + if AppSettings.ReadBool(asLogTimestamp) then + LineText := ReplaceRegExpr('^\s*\[[^\]]+\]\s', LineText, ''); + Tab.Memo.Text := LineText; + end; +end;} + + +{procedure TMainForm.QuickFilterClick(Sender: TObject); +var + Filter, Val, Col: String; + TableCol: TTableColumn; + Act: TAction; + Item: TMenuItem; + Conn: TDBConnection; + ShiftKeyPressed: Boolean; +begin + // Set filter for "where..."-clause + if (PageControlMain.ActivePage <> tabData) or (DataGrid.FocusedColumn = NoColumn) then + Exit; + + Filter := ''; + Conn := ActiveConnection; + ShiftKeyPressed := KeyPressed(VK_SHIFT); + + if Sender is TAction then begin + // Normal case for most quick filters + Act := Sender as TAction; + if ExecRegExpr('Prompt\d+$', Act.Name) then begin + // Item needs prompt + TableCol := SelectedTableFocusedColumn; + Col := Conn.QuoteIdent(TableCol.Name, False); + + if (TableCol.DataType.Index = dbdtJson) + and (Conn.Parameters.NetTypeGroup = ngPgSQL) then begin + Col := Col + '::text'; + end; + Val := DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn]; + if InputQuery(_('Specify filter-value...'), Act.Caption, Val) then begin + if Act = actQuickFilterPrompt1 then + Filter := Col + ' = ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt2 then + Filter := Col + ' != ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt3 then + Filter := Col + ' > ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt4 then + Filter := Col + ' < ' + Conn.EscapeString(Val, TableCol.DataType) + else if Act = actQuickFilterPrompt5 then + Filter := Conn.GetSQLSpecifity(spLikeCompare, [Col, Conn.EscapeString('%'+Val+'%', TableCol.DataType)]); + end; + end + else begin + Filter := Act.Hint; + end; + end + else if Sender is TMenuItem then begin + // Sender is one of the subitems in "More values" menu + Item := Sender as TMenuItem; + Filter := Item.Hint; + end; + + if Filter <> '' then begin + if ExecRegExpr('\s+LIKE\s+''', Filter) then + Filter := Filter + Conn.LikeClauseTail; + + SynMemoFilter.UndoList.AddGroupBreak; + SynMemoFilter.SelectAll; + if ShiftKeyPressed + and (Pos(Filter, SynMemoFilter.Text) = 0) and (Pos(SynMemoFilter.Text, Filter) = 0) + and (not SynMemoFilter.Text.Trim.IsEmpty) + then begin + SynMemoFilter.SelText := SynMemoFilter.Text + ' AND ' + Filter + end else begin + SynMemoFilter.SelText := Filter; + end; + ToggleFilterPanel(True); + actApplyFilterExecute(Sender); + end; +end;} + + +{procedure TMainForm.popupQueryPopup(Sender: TObject); +var + SQLFuncs: TSQLFunctionList; + i, j: Integer; + miGroup, miFunction: TMenuItem; +begin + // Sets cursor into memo and activates TAction(s) like paste + QueryTabs.ActiveMemo.SetFocus; + // Create function menu items in popup menu + menuQueryInsertFunction.Clear; + SQLFuncs := ActiveConnection.SQLFunctions; + for i:=0 to SQLFuncs.Categories.Count-1 do begin + // Create a menu item which gets subitems later + miGroup := TMenuItem.Create(popupQuery); + miGroup.Caption := SQLFuncs.Categories[i]; + menuQueryInsertFunction.Add(miGroup); + for j:=0 to SQLFuncs.Count-1 do begin + if SQLFuncs[j].Category <> SQLFuncs.Categories[i] then + Continue; + miFunction := TMenuItem.Create(popupQuery); + miFunction.Caption := SQLFuncs[j].Name; + miFunction.ImageIndex := 13; + // Prevent generating a hotkey + miFunction.Caption := StringReplace(miFunction.Caption, '&', '&&', [rfReplaceAll]); + // Prevent generating a seperator line + if miFunction.Caption = '-' then + miFunction.Caption := '&-'; + miFunction.Hint := SQLFuncs[j].Name + SQLFuncs[j].Declaration + ' - ' + StrEllipsis(SQLFuncs[j].Description, 200); + // Prevent generating a seperator for ShortHint and LongHint + miFunction.Hint := StringReplace( miFunction.Hint, '|', '¦', [rfReplaceAll] ); + miFunction.Tag := j; + // Place menuitem on menu + miFunction.OnClick := insertFunction; + miGroup.Add(miFunction); + end; + end; +end;} + + +{procedure TMainForm.popupSqlLogPopup(Sender: TObject); +begin + // Update popupMenu items + menuLogToFile.Checked := FLogToFile; + menuOpenLogFolder.Enabled := FLogToFile; +end;} + + +{procedure TMainForm.AutoRefreshSetInterval(Sender: TObject); +var + SecondsStr: String; + Seconds: Extended; +begin + // set interval for autorefresh-timer + SecondsStr := FloatToStr(TimerRefresh.interval div 1000); + if InputQuery(_('Auto refresh'),_('Refresh list every ... second(s):'), SecondsStr) then begin + Seconds := StrToFloatDef(SecondsStr, 0); + if Seconds > 0 then begin + TimerRefresh.Interval := Trunc(Seconds * 1000); + TimerRefresh.Enabled := true; + menuAutoRefresh.Checked := true; + end + else + ErrorDialog(f_('Seconds must be between 0 and %d.', [maxint])); + end; +end;} + +{procedure TMainForm.AutoRefreshToggle(Sender: TObject); +begin + // enable autorefresh-timer + TimerRefresh.Enabled := not TimerRefresh.Enabled; + menuAutoRefresh.Checked := TimerRefresh.Enabled; +end;} + +{procedure TMainForm.SynMemoQueryDragOver(Sender, Source: TObject; X, + Y: Integer; State: TDragState; var Accept: Boolean); +var + src : TControl; + Memo: TSynMemo; + H: TVirtualStringTree; +begin + // dragging an object over the query-memo + Memo := QueryTabs.ActiveMemo; + src := Source as TControl; + // Accepting drag's from the same editor, from DBTree and from QueryHelpers + H := QueryTabs.ActiveHelpersTree; + Accept := (src = DBtree) or ((src = H) and Assigned(H.FocusedNode) and (H.GetNodeLevel(H.FocusedNode) in [1,2])); + // set x-position of cursor + Memo.CaretX := (x - Memo.Gutter.Width) div Memo.CharWidth - 1 + Memo.LeftChar; + // set y-position of cursor + Memo.CaretY := y div Memo.LineHeight + Memo.TopLine; + if not Memo.Focused then + Memo.SetFocus; +end;} + + +{procedure TMainForm.SynMemoQueryDragDrop(Sender, Source: TObject; X, + Y: Integer); +var + src : TControl; + Text, ItemText: String; + ShiftPressed: Boolean; + Tree: TVirtualStringTree; + Node: PVirtualNode; + History: TQueryHistory; +begin + // dropping a tree node or listbox item into the query-memo + QueryTabs.ActiveMemo.UndoList.AddGroupBreak; + src := Source as TControl; + Text := ''; + ShiftPressed := KeyPressed(VK_SHIFT); + Tree := QueryTabs.ActiveHelpersTree; + // Check for allowed controls as source has already + // been performed in OnDragOver. So, only do typecasting here. + if src = DBtree then begin + // Insert table or database name. If a table is dropped and Shift is pressed, prepend the db name. + case ActiveDbObj.NodeType of + lntDb: Text := ActiveDbObj.QuotedDatabase(False); + lntTable..lntEvent: begin + if ShiftPressed then + Text := ActiveDbObj.QuotedDatabase(False) + '.'; + Text := Text + ActiveDbObj.QuotedName(False); + end; + end; + end else if src = Tree then begin + case Tree.GetNodeLevel(Tree.FocusedNode) of + 1: + case Tree.FocusedNode.Parent.Index of + TQueryTab.HelperNodeSnippets: + Text := ReadTextFile(AppSettings.DirnameSnippets + Tree.Text[Tree.FocusedNode, 0] + '.sql', nil); + TQueryTab.HelperNodeHistory: + Text := ''; + else begin + Node := Tree.GetFirstChild(Tree.FocusedNode.Parent); + while Assigned(Node) do begin + if Tree.Selected[Node] then begin + ItemText := Tree.Text[Node, 0]; + if Node.Parent.Index = TQueryTab.HelperNodeColumns then + ItemText := ActiveConnection.QuoteIdent(ItemText, False); // Quote column names + if ShiftPressed then + Text := Text + ItemText + ',' + CRLF + else + Text := Text + ItemText + ', '; + end; + Node := Tree.GetNextSibling(Node); + end; + Delete(Text, Length(Text)-1, 2); + end; + end; + 2: + case Tree.FocusedNode.Parent.Parent.Index of + TQueryTab.HelperNodeHistory: begin + History := QueryTabs.ActiveTab.HistoryDays.Objects[Tree.FocusedNode.Parent.Index] as TQueryHistory; + Text := History[Tree.FocusedNode.Index].SQL; + end; + end; + end; + end else + raise Exception.Create(_('Unspecified source control in drag''n drop operation!')); + + if Text <> '' then begin + QueryTabs.ActiveMemo.SelText := Text; + QueryTabs.ActiveMemo.UndoList.AddGroupBreak; + // Requires to set focus, as doubleclick actions also call this procedure + QueryTabs.ActiveMemo.SetFocus; + end; +end;} + + + +{procedure TMainForm.SynMemoQueryDropFiles(Sender: TObject; X, Y: Integer; + AFiles: TUnicodeStrings); +var + i: Integer; + Tab: TQueryTab; +begin + // One or more files from explorer or somewhere else was dropped onto the + // query-memo - load their contents into seperate tabs + if not RunQueryFiles(AFiles, nil, False) then begin + for i:=0 to AFiles.Count-1 do begin + Tab := GetOrCreateEmptyQueryTab(True); + Tab.LoadContents(AFiles[i], False, nil); + end; + end; +end;} + + +{procedure TMainForm.SynMemoQueryKeyPress(Sender: TObject; var Key: Char); +var + Editor: TSynMemo; + Token, Replacement: String; + Attri: TSynHighlighterAttributes; + OldCaretXY, StartOfTokenRowCol, EndOfTokenRowCol, CurrentRowCol: TBufferCoord; + TokenTypeInt, Start, CurrentCharIndex: Integer; + //OldSelStart, OldSelEnd: Integer; + LineWithToken: String; + TableIndex, ProcIndex: Integer; + OldOnChange: TNotifyEvent; +const + WordChars = ['A'..'Z', 'a'..'z', '_']; + IgnoreChars = [#8]; // Backspace, and probably more which should not trigger uppercase +begin + // Uppercase reserved words, functions and data types + if CharInSet(Key, WordChars) or CharInSet(Key, IgnoreChars) then + Exit; + if not AppSettings.ReadBool(asAutoUppercase) then + Exit; + Editor := Sender as TSynMemo; + CurrentCharIndex := Editor.RowColToCharIndex(Editor.CaretXY); + // Go one left on trailing line feed, after which PrevWordPos doesn't work + Dec(CurrentCharIndex, 1); + CurrentRowCol := Editor.CharIndexToRowCol(CurrentCharIndex); + StartOfTokenRowCol := Editor.PrevWordPosEx(CurrentRowCol); + Editor.GetHighlighterAttriAtRowColEx(StartOfTokenRowCol, Token, TokenTypeInt, Start, Attri); + Replacement := UpperCase(Token); + + // Check if token is preceded by a dot, so it is most probably a table, column or some alias + LineWithToken := Editor.Lines[StartOfTokenRowCol.Line-1]; + if (StartOfTokenRowCol.Char > 1) and (LineWithToken[StartOfTokenRowCol.Char-1] = '.') then begin + Exit; + end; + + // Auto-fix case of known database objects + TableIndex := SynSQLSynUsed.TableNames.IndexOf(Token); + ProcIndex := SynSQLSynUsed.ProcNames.IndexOf(Token); + if TableIndex > -1 then begin + Replacement := SynSQLSynUsed.TableNames[TableIndex]; + end else if ProcIndex > -1 then begin + Replacement := SynSQLSynUsed.ProcNames[ProcIndex]; + end else if not (TtkTokenKind(TokenTypeInt) in [tkDatatype, tkFunction, tkKey]) then begin + // Only uppercase certain types of keywords + Exit; + end; + + if Token <> Replacement then begin + OldCaretXY := Editor.CaretXY; + //OldSelStart := Editor.SelStart; + //OldSelEnd := Editor.SelEnd; + + EndOfTokenRowCol := Editor.WordEndEx(StartOfTokenRowCol); + OldOnChange := Editor.OnChange; + Editor.OnChange := nil; + Editor.InsertBlock(StartOfTokenRowCol, EndOfTokenRowCol, PWideChar(Replacement), True); + Editor.OnChange := OldOnChange; + + Editor.CaretXY := OldCaretXY; + //Editor.SelStart := OldSelStart; // breaks at least some undo steps + //Editor.SelEnd := OldSelEnd; + end; + +end;} + + +{procedure TMainForm.AnySynMemoMouseWheel(Sender: TObject; Shift: TShiftState; + WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean); +var + Editor: TSynEdit; + NewFontSize: Integer; +begin + // Change font size with MouseWheel + // TODO: broken in high-dpi mode, just zooms in + if KeyPressed(VK_CONTROL) and AppSettings.ReadBool(asWheelZoom) then begin + Editor := TSynEdit(Sender); + NewFontSize := Editor.Font.Size; + if WheelDelta > 0 then + Inc(NewFontSize) + else + Dec(NewFontSize); + NewFontSize := Max(NewFontSize, 1); + AppSettings.ResetPath; + AppSettings.WriteInt(asFontSize, NewFontSize); + Editor.Font.Size := NewFontSize; + SetupSynEditors; + Handled := True; + end else begin + Handled := False; + end; +end;} + + +{procedure TMainForm.SynMemoQueryPaintTransient(Sender: TObject; Canvas: TCanvas; TransientType: TTransientType); +var + Editor : TSynEdit; + BufCrd: TBufferCoord; + Pix: TPoint; + DisCrd: TDisplayCoord; + Pnt: TPoint; + S: String; + I, SearchPos, CharIndex: Integer; + Attri: TSynHighlighterAttributes; + SelStart: Integer; + TmpCharA, TmpCharB: Char; + rx: TRegExpr; + SelWord, Line: String; +const} + //BracketChars: TSysCharSet = ['{','[','(','<','}',']',')','>']; + //OpenChars: Array of Char = ['{','[','(','<']; + //CloseChars: Array of Char = ['}',']',')','>']; + { + function CharToPixels(P: TBufferCoord): TPoint; + begin + Result := Editor.RowColumnToPixels(Editor.BufferToDisplayPos(P)); + end; +begin + if not MainFormCreated then + Exit; + if (FMatchingBraceBackgroundColor = clNone) and (FMatchingBraceForegroundColor = clNone) then + Exit; + if FSynEditInOnPaintTransient then + Exit; + FSynEditInOnPaintTransient := True; + + Editor := TSynEdit(Sender); + // Check for Editor.GetTextLen causes some endless loop in SynEdit. + // But not due to activated WordWrap. Must be some interlocked WM_GETTEXTLENGTH message, or an undefined text length. + //if Editor.GetTextLen > 5*SIZE_MB then + // Exit; + + // Highlight matching words, if selected text is a (small) word + if Editor.SelLength < Editor.CharsInWindow then begin + SelWord := Editor.SelText; + BufCrd := Editor.CaretXY; + CharIndex := Editor.RowColToCharIndex(BufCrd); + // Ensure GetWordAtRowCol finds the word by moving Char to the left of the selection + BufCrd.Char := Max(0, BufCrd.Char - (CharIndex - Editor.SelStart)); + if SelWord <> FLastSelWordInEditor then + Editor.Invalidate; // causes lots of additional implicit calls to OnPaintTransient + FLastSelWordInEditor := SelWord; + if (not SelWord.IsEmpty) and (SelWord = Editor.GetWordAtRowCol(BufCrd)) then begin + rx := TRegExpr.Create; + rx.Expression := '\b(' + QuoteRegExprMetaChars(SelWord) + ')\b'; + rx.ModifierI := True; + // Note: TopLine is wrong when lines are soft-wrapped, so we use RowToLine + for i:=Editor.RowToLine(Editor.TopLine) to Editor.RowToLine(Editor.TopLine + Editor.LinesInWindow) do begin + Line := Editor.Lines[i-1]; + if rx.Exec(Line) then while True do begin + SearchPos := rx.MatchPos[1]; + BufCrd := BufferCoord(SearchPos, i); + DisCrd := Editor.BufferToDisplayPos(BufCrd); + Pnt := Editor.RowColumnToPixels(DisCrd); + if (not Editor.IsPointInSelection(BufCrd)) // Found match is not the selection itself + and Editor.GetHighlighterAttriAtRowCol(BufCrd, SelWord, Attri) + then begin + //logsql(SelWord+': '+Attri.FriendlyName); + Canvas.Font.Size := Editor.Font.Size; + Canvas.Font.Style := Attri.Style; + // Todo: check if we need to handle TransientType ttAfter and ttBefore + Canvas.Font.Color:= FMatchingBraceForegroundColor; + Canvas.Brush.Color:= FMatchingBraceBackgroundColor; + if Canvas.Font.Color = clNone then + Canvas.Font.Color := Editor.Font.Color; + if Canvas.Brush.Color = clNone then + Canvas.Brush.Color := Editor.Color; + Canvas.TextOut(Pnt.X, Pnt.Y, rx.Match[1]); + end; + if not rx.ExecNext then + Break; + end; + end; + rx.Free; + end; + end; + + // Highlight matching brackets, only without selection + if not Editor.SelAvail then begin + + BufCrd := Editor.CaretXY; + SelStart := Editor.SelStart; + + if (SelStart > 0) and (SelStart <= Editor.GetTextLen) then + TmpCharA := Editor.Text[SelStart] + else + TmpCharA := #0; + + if (SelStart >= 0) and (SelStart < Editor.GetTextLen) then + TmpCharB := Editor.Text[SelStart + 1] + else + TmpCharB := #0; + + if CharInSet(TmpCharA, BracketChars) or CharInSet(TmpCharB, BracketChars) then begin + S := TmpCharB; + if not CharInSet(TmpCharB, BracketChars) then begin + BufCrd.Char := BufCrd.Char - 1; + S := TmpCharA; + end; + + if Editor.GetHighlighterAttriAtRowCol(BufCrd, S, Attri) and (Attri.FriendlyName = SYNS_FriendlyAttrSymbol) then + begin + + for i:=Low(OpenChars) to High(OpenChars) do begin + if (S = OpenChars[i]) or (S = CloseChars[i]) then begin + Pix := CharToPixels(BufCrd); + + Canvas.Brush.Style := bsSolid; + Canvas.Font.Assign(Editor.Font); + Canvas.Font.Style := Attri.Style; + + if (TransientType = ttAfter) then begin + Canvas.Font.Color := MatchingBraceForegroundColor; + Canvas.Brush.Color := MatchingBraceBackgroundColor; + end else begin + Canvas.Font.Color := Attri.Foreground; + Canvas.Brush.Color := Attri.Background; + end; + if Canvas.Font.Color = clNone then + Canvas.Font.Color := Editor.Font.Color; + if Canvas.Brush.Color = clNone then + Canvas.Brush.Color := Editor.Color; + + Canvas.TextOut(Pix.X, Pix.Y, S); + BufCrd := Editor.GetMatchingBracketEx(BufCrd); + + if (BufCrd.Char > 0) and (BufCrd.Line > 0) then begin + Pix := CharToPixels(BufCrd); + if Pix.X > Editor.Gutter.Width then begin + if S = OpenChars[i] then + Canvas.TextOut(Pix.X, Pix.Y, CloseChars[i]) + else + Canvas.TextOut(Pix.X, Pix.Y, OpenChars[i]); + end; + end; + + end; + end; + Canvas.Brush.Style := bsSolid; + end; + end; + end; + + // Release event handler + FSynEditInOnPaintTransient := False; +end;} + + +{procedure TMainForm.popupHostPopup(Sender: TObject); +begin + menuFetchDBitems.Enabled := (PageControlHost.ActivePage = tabDatabases) and (ListDatabases.SelectedCount > 0); + Kill1.Enabled := (PageControlHost.ActivePage = tabProcessList) and (ListProcesses.SelectedCount > 0); + menuEditVariable.Enabled := False; + if ActiveConnection.Has(frEditVariables) then + menuEditVariable.Enabled := (PageControlHost.ActivePage = tabVariables) and Assigned(ListVariables.FocusedNode) + else + menuEditVariable.Hint := _(SUnsupported); +end;} + + +{procedure TMainForm.popupDBPopup(Sender: TObject); +var + Obj: PDBObject; + HasFocus, IsDb, IsObject: Boolean; + Conn: TDBConnection; +begin + // DBtree and ListTables both use popupDB as menu + if PopupComponent(Sender) = DBtree then begin + Obj := DBTree.GetNodeData(DBTree.FocusedNode); + IsDb := Obj.NodeType = lntDb; + IsObject := Obj.NodeType in [lntTable..lntEvent]; + actCreateDatabase.Enabled := (Obj.NodeType = lntNone) + and (Obj.Connection.Parameters.NetTypeGroup in [ngMySQL, ngMSSQL, ngPgSQL]); + actConnectionProperties.Enabled := Obj.NodeType = lntNone; + actAttachDatabase.Visible := Obj.Connection.Parameters.IsAnySQLite; + actAttachDatabase.Enabled := actAttachDatabase.Visible and (Obj.NodeType = lntNone); + actCreateTable.Enabled := IsDb or IsObject or (Obj.GroupType = lntTable); + actCreateView.Enabled := IsDb or IsObject or (Obj.GroupType = lntView); + actCreateProcedure.Enabled := IsDb or IsObject or (Obj.GroupType in [lntFunction, lntProcedure]); + actCreateFunction.Enabled := actCreateProcedure.Enabled; + actCreateTrigger.Enabled := IsDb or IsObject or (Obj.GroupType = lntTrigger); + actCreateEvent.Enabled := IsDb or IsObject or (Obj.GroupType = lntEvent); + actDropObjects.Enabled := IsObject or + (IsDb and not Obj.Connection.Parameters.IsAnySQLite); + actDetachDatabase.Visible := Obj.Connection.Parameters.IsAnySQLite; + actDetachDatabase.Enabled := actDetachDatabase.Visible and (Obj.NodeType = lntDb); + actCopyTable.Enabled := Obj.NodeType in [lntTable, lntView]; + actEmptyTables.Enabled := Obj.NodeType in [lntTable, lntView]; + actRunRoutines.Enabled := Obj.NodeType in [lntProcedure, lntFunction]; + menuClearDataTabFilter.Enabled := Obj.NodeType in [lntTable, lntView]; + menuEditObject.Enabled := IsDb or IsObject; + // Enable certain items which are valid only here + menuTreeExpandAll.Enabled := True; + menuTreeCollapseAll.Enabled := True; + menuTreeOptions.Enabled := True; + end else begin + HasFocus := Assigned(ListTables.FocusedNode); + actCreateDatabase.Enabled := False; + actConnectionProperties.Enabled := False; + actAttachDatabase.Visible := False; + actCreateTable.Enabled := True; + actCreateView.Enabled := True; + actCreateProcedure.Enabled := True; + actCreateFunction.Enabled := True; + actCreateTrigger.Enabled := True; + actCreateEvent.Enabled := True; + actDropObjects.Enabled := ListTables.SelectedCount > 0; + actDetachDatabase.Visible := False; + actEmptyTables.Enabled := True; + actRunRoutines.Enabled := True; + menuClearDataTabFilter.Enabled := False; + menuEditObject.Enabled := HasFocus; + actCopyTable.Enabled := False; + if HasFocus then begin + Obj := ListTables.GetNodeData(ListTables.FocusedNode); + actCopyTable.Enabled := Obj.NodeType in [lntTable, lntView]; + end; + menuTreeExpandAll.Enabled := False; + menuTreeCollapseAll.Enabled := False; + menuTreeOptions.Enabled := False; + end; + Conn := ActiveConnection; + if (Conn <> nil) and (Conn.Parameters.IsAnyMySQL) then begin + actCreateView.Enabled := actCreateView.Enabled and Conn.Has(frCreateView); + actCreateProcedure.Enabled := actCreateProcedure.Enabled and Conn.Has(frCreateProcedure); + actCreateFunction.Enabled := actCreateFunction.Enabled and Conn.Has(frCreateFunction); + actCreateTrigger.Enabled := actCreateTrigger.Enabled and Conn.Has(frCreateTrigger); + actCreateEvent.Enabled := actCreateEvent.Enabled and Conn.Has(frCreateEvent); + end; +end;} + + +{procedure TMainForm.popupFilterPopup(Sender: TObject); +var + SQLFuncs: TSQLFunctionList; + i, j: Integer; + miGroup, miFunction: TMenuItem; +begin + // Create function menu items in popup menu + menuFilterInsertFunction.Clear; + SQLFuncs := ActiveConnection.SQLFunctions; + for i:=0 to SQLFuncs.Categories.Count-1 do begin + // Create a menu item which gets subitems later + miGroup := TMenuItem.Create(popupFilter); + miGroup.Caption := SQLFuncs.Categories[i]; + menuFilterInsertFunction.Add(miGroup); + for j:=0 to SQLFuncs.Count-1 do begin + if SQLFuncs[j].Category <> SQLFuncs.Categories[i] then + Continue; + miFunction := TMenuItem.Create(popupFilter); + miFunction.Caption := SQLFuncs[j].Name; + miFunction.ImageIndex := 13; + // Prevent generating a hotkey + miFunction.Caption := StringReplace(miFunction.Caption, '&', '&&', [rfReplaceAll]); + // Prevent generating a seperator line + if miFunction.Caption = '-' then + miFunction.Caption := '&-'; + miFunction.Hint := SQLFuncs[j].Name + SQLFuncs[j].Declaration + ' - ' + StrEllipsis(SQLFuncs[j].Description, 200); + // Prevent generating a seperator for ShortHint and LongHint + miFunction.Hint := StringReplace( miFunction.Hint, '|', '¦', [rfReplaceAll] ); + miFunction.Tag := j; + // Place menuitem on menu + miFunction.OnClick := insertFunction; + miGroup.Add(miFunction); + end; + end; +end;} + + +{procedure TMainForm.popupDataGridPopup(Sender: TObject); +var + Grid: TVirtualStringTree; + Results: TDBQuery; + i: Integer; + Col, Value, FocusedColumnName: String; + CellFocused, InDataGrid, HasNullValue, HasNotNullValue: Boolean; + RowNumber: PInt64; + Node: PVirtualNode; + OldDataLocalNumberFormat: Boolean; + IncludedValues: TStringList; + Act: TAction; + Datatype: TDBDatatype; + ForeignKey: TForeignKey; +const + CLPBRD : String = 'CLIPBOARD'; +begin + // Manipulate quick filter menuitems + Grid := ActiveGrid; + // Make sure ValidateControls detects the grid as focused, which is not the case when + // it has 0 nodes, even with TreeOptions.SelectionOptions.RightclickSelect enabled + Grid.SetFocus; + CellFocused := Assigned(Grid.FocusedNode) and (Grid.FocusedColumn > 0); + InDataGrid := Grid = DataGrid; + DataInsertValue.Enabled := CellFocused; + QFvalues.Enabled := CellFocused; + menuQuickFilter.Enabled := InDataGrid; + actDataResetSorting.Enabled := InDataGrid; + menuSQLHelpData.Enabled := InDataGrid; + Refresh3.Enabled := InDataGrid; + actGridEditFunction.Enabled := CellFocused; + + if not CellFocused then + Exit; + Results := GridResult(Grid); + + Datatype := Results.DataType(Grid.FocusedColumn-1); + Col := Results.Connection.QuoteIdent(Results.ColumnOrgNames[Grid.FocusedColumn-1], False); + if InDataGrid + and (Datatype.Index = dbdtJson) + and Results.Connection.Parameters.IsAnyPostgreSQL then begin + Col := Col + '::text'; + end; + + // Block 1: WHERE col IN ([focused cell values]) + actQuickFilterFocused1.Hint := ''; + actQuickFilterFocused2.Hint := ''; + actQuickFilterFocused3.Hint := ''; + actQuickFilterFocused4.Hint := ''; + actQuickFilterFocused5.Hint := ''; + actQuickFilterFocused6.Hint := ''; + actQuickFilterFocused7.Hint := ''; + Node := Grid.GetFirstSelected; + HasNullValue := False; + HasNotNullValue := False; + OldDataLocalNumberFormat := DataLocalNumberFormat; + DataLocalNumberFormat := False; + IncludedValues := TStringList.Create; + while Assigned(Node) do begin + AnyGridEnsureFullRow(Grid, Node); + RowNumber := Grid.GetNodeData(Node); + Results.RecNo := RowNumber^; + if Results.IsNull(Grid.FocusedColumn-1) then + HasNullValue := True + else begin + HasNotNullValue := True; + Value := Grid.Text[Node, Grid.FocusedColumn]; + if IncludedValues.IndexOf(Value) = -1 then begin + actQuickFilterFocused1.Hint := actQuickFilterFocused1.Hint + Results.Connection.EscapeString(Value, Datatype) + ', '; + actQuickFilterFocused2.Hint := actQuickFilterFocused2.Hint + Results.Connection.EscapeString(Value, Datatype) + ', '; + actQuickFilterFocused3.Hint := actQuickFilterFocused3.Hint + + Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''' + Results.Connection.EscapeString(Value, True, False) + '%''']) + + ' OR '; + actQuickFilterFocused4.Hint := actQuickFilterFocused4.Hint + + Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '''']) + + ' OR '; + actQuickFilterFocused5.Hint := actQuickFilterFocused5.Hint + + Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '%''']) + + ' OR '; + actQuickFilterFocused6.Hint := actQuickFilterFocused6.Hint + Col + ' > ' + Results.Connection.EscapeString(Value, Datatype) + ' OR '; + actQuickFilterFocused7.Hint := actQuickFilterFocused7.Hint + Col + ' < ' + Results.Connection.EscapeString(Value, Datatype) + ' OR '; + IncludedValues.Add(Value); + end; + end; + Node := Grid.GetNextSelected(Node); + if Length(actQuickFilterFocused1.Hint) > SIZE_MB then + Break; + end; + DataLocalNumberFormat := OldDataLocalNumberFormat; + if HasNotNullValue then begin + actQuickFilterFocused1.Hint := Col + ' IN (' + Copy(actQuickFilterFocused1.Hint, 1, Length(actQuickFilterFocused1.Hint)-2) + ')'; + actQuickFilterFocused2.Hint := Col + ' NOT IN (' + Copy(actQuickFilterFocused2.Hint, 1, Length(actQuickFilterFocused2.Hint)-2) + ')'; + actQuickFilterFocused3.Hint := Copy(actQuickFilterFocused3.Hint, 1, Length(actQuickFilterFocused3.Hint)-4); + actQuickFilterFocused4.Hint := Copy(actQuickFilterFocused4.Hint, 1, Length(actQuickFilterFocused4.Hint)-4); + actQuickFilterFocused5.Hint := Copy(actQuickFilterFocused5.Hint, 1, Length(actQuickFilterFocused5.Hint)-4); + actQuickFilterFocused6.Hint := Copy(actQuickFilterFocused6.Hint, 1, Length(actQuickFilterFocused6.Hint)-4); + actQuickFilterFocused7.Hint := Copy(actQuickFilterFocused7.Hint, 1, Length(actQuickFilterFocused7.Hint)-4); + end; + if HasNullValue then begin + if HasNotNullValue then begin + actQuickFilterFocused1.Hint := actQuickFilterFocused1.Hint + ' OR '; + actQuickFilterFocused2.Hint := actQuickFilterFocused2.Hint + ' AND '; + actQuickFilterFocused3.Hint := actQuickFilterFocused3.Hint + ' OR '; + actQuickFilterFocused4.Hint := actQuickFilterFocused4.Hint + ' OR '; + actQuickFilterFocused5.Hint := actQuickFilterFocused5.Hint + ' OR '; + actQuickFilterFocused6.Hint := actQuickFilterFocused6.Hint + ' OR '; + actQuickFilterFocused7.Hint := actQuickFilterFocused7.Hint + ' OR '; + end; + actQuickFilterFocused1.Hint := actQuickFilterFocused1.Hint + Col + ' IS NULL'; + actQuickFilterFocused2.Hint := actQuickFilterFocused2.Hint + Col + ' IS NOT NULL'; + actQuickFilterFocused3.Hint := actQuickFilterFocused3.Hint + Col + ' IS NULL'; + actQuickFilterFocused4.Hint := actQuickFilterFocused4.Hint + Col + ' IS NULL'; + actQuickFilterFocused5.Hint := actQuickFilterFocused5.Hint + Col + ' IS NULL'; + actQuickFilterFocused6.Hint := actQuickFilterFocused6.Hint + Col + ' IS NULL'; + actQuickFilterFocused7.Hint := actQuickFilterFocused7.Hint + Col + ' IS NULL'; + end; + actQuickFilterFocused1.Visible := HasNotNullValue or HasNullValue; + actQuickFilterFocused2.Visible := HasNotNullValue or HasNullValue; + actQuickFilterFocused3.Visible := HasNotNullValue; + actQuickFilterFocused4.Visible := HasNotNullValue; + actQuickFilterFocused5.Visible := HasNotNullValue; + actQuickFilterFocused6.Visible := HasNotNullValue; + actQuickFilterFocused7.Visible := HasNotNullValue; + IncludedValues.Free; + + // Block 2: WHERE col = [ask user for value] + actQuickFilterPrompt1.Hint := Col + ' = "..."'; + actQuickFilterPrompt2.Hint := Col + ' != "..."'; + actQuickFilterPrompt3.Hint := Col + ' > "..."'; + actQuickFilterPrompt4.Hint := Col + ' < "..."'; + actQuickFilterPrompt5.Hint := Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '"%...%"']); + actQuickFilterNull.Hint := Col + ' IS NULL'; + actQuickFilterNotNull.Hint := Col + ' IS NOT NULL'; + + // Block 3: WHERE col = [clipboard content] + Value := Trim(Clipboard.TryAsText); + if Length(Value) < SIZE_KB then begin + actQuickFilterClipboard1.Enabled := true; + actQuickFilterClipboard1.Hint := Col + ' = ' + Results.Connection.EscapeString(Value, Datatype); + actQuickFilterClipboard2.Enabled := true; + actQuickFilterClipboard2.Hint := Col + ' != ' + Results.Connection.EscapeString(Value, Datatype); + actQuickFilterClipboard3.Enabled := true; + actQuickFilterClipboard3.Hint := Col + ' > ' + Results.Connection.EscapeString(Value, Datatype); + actQuickFilterClipboard4.Enabled := true; + actQuickFilterClipboard4.Hint := Col + ' < ' + Results.Connection.EscapeString(Value, Datatype); + actQuickFilterClipboard5.Enabled := true; + actQuickFilterClipboard5.Hint := Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '''%' + Results.Connection.EscapeString(Value, True, False) + '%''']); + actQuickFilterClipboard6.Enabled := true; + actQuickFilterClipboard6.Hint := Col + ' IN (' + Value + ')'; + end else begin + actQuickFilterClipboard1.Enabled := false; + actQuickFilterClipboard1.Hint := Col + ' = ' + CLPBRD; + actQuickFilterClipboard2.Enabled := false; + actQuickFilterClipboard2.Hint := Col + ' != ' + CLPBRD; + actQuickFilterClipboard3.Enabled := false; + actQuickFilterClipboard3.Hint := Col + ' > ' + CLPBRD; + actQuickFilterClipboard4.Enabled := false; + actQuickFilterClipboard4.Hint := Col + ' < ' + CLPBRD; + actQuickFilterClipboard5.Enabled := false; + actQuickFilterClipboard5.Hint := Results.Connection.GetSQLSpecifity(spLikeCompare, [Col, '%' + CLPBRD + '%']); + actQuickFilterClipboard6.Enabled := false; + actQuickFilterClipboard6.Hint := Col + ' IN (' + CLPBRD + ')'; + end; + + // Set captions from hints + for i:=0 to menuQuickFilter.Count-1 do begin + if menuQuickFilter[i].Action = nil then + Continue; + Act := menuQuickFilter[i].Action as TAction; + // Stop here + if Act = actRemoveFilter then + Break; + if not Act.Hint.IsEmpty then + Act.Caption := StrEllipsis(Act.Hint, 100); + end; + + actFollowForeignKey.Enabled := False; + if (InDataGrid) then begin + FocusedColumnName := Results.ColumnOrgNames[Grid.FocusedColumn-1]; + //find foreign key for current column + for ForeignKey in ActiveDBObj.TableForeignKeys do begin + i := ForeignKey.Columns.IndexOf(FocusedColumnName); + if i > -1 then begin + actFollowForeignKey.Enabled := True; + break; + end; + end; + end; +end;} + + +{procedure TMainForm.QFvaluesClick(Sender: TObject); +var + Data: TDBQuery; + DbObj: TDBObject; + Conn: TDBConnection; + ColIdx, ResultCol: Integer; + ColName, Query: String; + ColType: TDBDatatype; + TableCol: TTableColumn; + Item: TMenuItem; + i: Integer; + MaxSize: Int64; + ValueList: TStringList; + ColumnHasIndex: Boolean; +begin + // Create a list of distinct column values in selected table + for i:=QFvalues.Count-1 downto 1 do + QFvalues.Delete(i); + QFvalues[0].Caption := ''; + QFvalues[0].Hint := ''; + QFvalues[0].OnClick := nil; + ColIdx := DataGrid.FocusedColumn; + ResultCol := ColIdx - 1; + if ColIdx = NoColumn then + Exit; + ColName := DataGridResult.ColumnOrgNames[ResultCol]; + ColType := DataGridResult.DataType(ResultCol); + ShowStatusMsg(_('Fetching distinct values ...')); + DbObj := ActiveDbObj; + Conn := DbObj.Connection; + MaxSize := SIZE_GB; + ColumnHasIndex := DataGridResult.ColIsKeyPart(ResultCol) + or DataGridResult.ColIsUniqueKeyPart(ResultCol) + or DataGridResult.ColIsPrimaryKeyPart(ResultCol); + if ColumnHasIndex then begin + MaxSize := MaxSize * 5; + end; + try + if DbObj.Size > MaxSize then + raise Exception.Create(f_('Table too large (>%s), avoiding long running SELECT query', [FormatByteNumber(MaxSize)])); + Query := Conn.QuoteIdent(ColName)+', COUNT(*) AS c FROM '+DbObj.QuotedName; + if SynMemoFilter.Text <> '' then + Query := Query + ' WHERE ' + SynMemoFilter.Text + CRLF; + Query := Query + ' GROUP BY '+Conn.QuoteIdent(ColName)+' ORDER BY c DESC, '+Conn.QuoteIdent(ColName); + Data := Conn.GetResults(Conn.ApplyLimitClause('SELECT', Query, 30, 0)); + for i:=0 to Data.RecordCount-1 do begin + if QFvalues.Count > i then + Item := QFvalues[i] + else begin + Item := TMenuItem.Create(QFvalues); + QFvalues.Add(Item); + end; + if Data.IsNull(ColName) then + Item.Hint := Conn.QuoteIdent(ColName)+' IS NULL' + else if ColType.Category in [dtcBinary, dtcSpatial] then + Item.Hint := Conn.QuoteIdent(ColName)+'='+Data.HexValue(0, False) + else + Item.Hint := Conn.QuoteIdent(ColName)+'='+Conn.EscapeString(Data.Col(ColName)); + Item.Caption := StrEllipsis(Item.Hint, 100) + ' (' + FormatNumber(Data.Col('c')) + ')'; + if SynMemoFilter.Text <> '' then begin + if Pos(Item.Hint, SynMemoFilter.Text) > 0 then + Item.Hint := SynMemoFilter.Text + else + Item.Hint := SynMemoFilter.Text + ' AND ' + Item.Hint; + end; + Item.OnClick := QuickFilterClick; + Data.Next; + end; + except + on E:Exception do begin + // Table is too large for the above SELECT query, or the query failed, due to an error in its filter or so + // Get ENUM/SET values instead if possible + QFvalues[0].Caption := StrEllipsis(E.Message, 100); + QFvalues[0].Hint := E.Message; + for TableCol in SelectedTableColumns do begin + if (TableCol.Name = ColName) and (TableCol.DataType.Index in [dbdtEnum, dbdtSet]) then begin + ValueList := TableCol.ValueList; + for i:=0 to ValueList.Count-1 do begin + if QFvalues.Count > i+1 then + Item := QFvalues[i+1] + else begin + Item := TMenuItem.Create(QFvalues); + QFvalues.Add(Item); + end; + Item.Hint := Conn.QuoteIdent(ColName)+'='+Conn.EscapeString(ValueList[i]); + Item.Caption := StrEllipsis(Item.Hint, 100); + Item.OnClick := QuickFilterClick; + end; + Break; + end; + end; + end; + end; + ShowStatusMsg; +end;} + + +{procedure TMainForm.DataInsertValueClick(Sender: TObject); +var + LocalTime, UtcTime: TDateTime; + y, m, d, h, i, s, ms: Word; + Uid: TGuid; + DateTimeSQL, StrUid: String; + UnixTimestamp, UtcUnixTimestamp: Int64; + SystemTime: TSystemTime; + ColNum: TColumnIndex; + Col: TTableColumn; + Conn: TDBConnection; +const + FrmDateTime = '%s: %.4d-%.2d-%.2d %.2d:%.2d:%.2d'; + FrmDate = '%s: %.4d-%.2d-%.2d'; + FrmTime = '%s: %.2d:%.2d:%.2d'; + FrmYear = '%s: %.4d'; + FrmUnixTs = '%s: %d'; +begin + // Local and UTC date/time menu items + Conn := ActiveConnection; + DateTimeSQL := 'SELECT ' + Conn.GetSQLSpecifity(spFuncNow); + LocalTime := Conn.ParseDateTime(Conn.GetVar(DateTimeSQL)); + DecodeDateTime(LocalTime, y, m, d, h, i, s, ms); + DataDateTime.Caption := Format(FrmDateTime, [_('Date and time'), y,m,d,h,i,s]); + DataDate.Caption := Format(FrmDate, [_('Date'), y,m,d]); + DataTime.Caption := Format(FrmTime, [_('Time'), h,i,s]); + DataYear.Caption := Format(FrmYear, [_('Year'), y]); + GetSystemTime(SystemTime); + UnixTimestamp := DateTimeToUnix(SystemTimeToDateTime(SystemTime)); + DataUnixTimestamp.Caption := Format(FrmUnixTs, [_('UNIX Timestamp'), UnixTimestamp]); + + UtcTime := IncSecond(LocalTime, FTimeZoneOffset); + DecodeDateTime(UtcTime, y, m, d, h, i, s, ms); + DataUtcDateTime.Caption := Format(FrmDateTime, ['UTC '+_('Date and time'), y,m,d,h,i,s]); + DataUtcDate.Caption := Format(FrmDate, ['UTC '+_('Date'), y,m,d]); + DataUtcTime.Caption := Format(FrmTime, ['UTC '+_('Time'), h,i,s]); + UtcUnixTimestamp := UnixTimestamp + FTimeZoneOffset; + DataUtcUnixTimestamp.Caption := Format(FrmUnixTs, ['UTC '+_('UNIX Timestamp'), UtcUnixTimestamp]); + + CreateGuid(Uid); + StrUid := GuidToString(Uid); + DataGUID.Caption := _('GUID') + ': ' + StrUid; + DataGUIDwobraces.Caption := _('GUID without braces') + ': ' + Copy(StrUid, 2, Length(StrUid)-2); + DataGUIDlowercase.Caption := _('GUID lowercase') + ': ' + StrUid.ToLower; + DataGUIDlowercaseWobraces.Caption := _('GUID lowercase without braces') + ': ' + Copy(StrUid, 2, Length(StrUid)-2).ToLower; + + ColNum := DataGrid.FocusedColumn; + DataDefaultValue.Caption := _('Default value')+': ?'; + DataDefaultValue.Enabled := False; + if ColNum <> NOCOLUMN then begin + for Col in SelectedTableColumns do begin + if (Col.Name = DataGrid.Header.Columns[ColNum].Text) and (Col.DefaultType = cdtText) then begin + DataDefaultValue.Caption := _('Default value')+': '+Col.DefaultText; + DataDefaultValue.Enabled := True; + break; + end; + end; + end; +end;} + + +{procedure TMainForm.InsertValue(Sender: TObject); +var + d: String; + p: Integer; + Grid: TVirtualStringTree; +begin + // Insert date/time-value into table + d := StripHotkey((Sender as TMenuItem).Caption); + p := Pos(':', d); + if p > 0 then + d := Trim(Copy(d, p+1, MaxInt)); + Grid := ActiveGrid; + try + Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := d; + except on E:EDbError do + ErrorDialog(E.Message); + end; +end;} + + +{function TMainForm.GetRootNode(Tree: TBaseVirtualTree; Connection: TDBConnection): PVirtualNode; +var + SessionNode: PVirtualNode; + SessionObj: PDBObject; +begin + Result := nil; + SessionNode := Tree.GetFirstChild(nil); + while Assigned(SessionNode) do begin + SessionObj := Tree.GetNodeData(SessionNode); + if SessionObj.Connection = Connection then begin + Result := SessionNode; + break; + end; + SessionNode := Tree.GetNextSibling(SessionNode); + end; +end;} + + +{function TMainForm.GetActiveConnection: TDBConnection; +begin + Result := nil; + if Assigned(FActiveDBObj) and (FActiveDbObj <> nil) then + Result := FActiveDbObj.Connection; +end;} + + +{function TMainForm.GetActiveDatabase: String; +begin + // Find currently selected database in active connection + Result := ''; + if (not (csDestroying in ComponentState)) + and Assigned(FActiveDBObj) + and Assigned(FActiveDBObj.Connection) then + Result := FActiveDBObj.Connection.Database; +end;} + + +{procedure TMainForm.SetActiveDatabase(db: String; Connection: TDBConnection); +var + SessionNode, DBNode: PVirtualNode; + DBObj: PDBObject; +begin + // Set focus on the wanted db node + LogSQL('SetActiveDatabase('+db+')', lcDebug); + SessionNode := GetRootNode(DBtree, Connection); + if db = '' then + SelectNode(DBtree, SessionNode) + else begin + DBNode := DBtree.GetFirstChild(SessionNode); + while Assigned(DBNode) do begin + DBObj := DBtree.GetNodeData(DBNode); + if DBObj.Database = db then begin + if DBNode <> DBtree.FocusedNode then + SelectNode(DBtree, DBNode); + break; + end; + DBNode := DBtree.GetNextSibling(DBNode); + end; + end; +end;} + + +{procedure TMainForm.SetActiveDBObj(Obj: TDBObject); +var + FoundNode: PVirtualNode; +begin + // Find right table/view/... node in tree and select it, implicitely call OnFocusChanged + LogSQL('SetActiveDBObj('+Obj.Name+')', lcDebug); + FoundNode := FindDBObjectNode(DBtree, Obj); + if Assigned(FoundNode) then + SelectNode(DBTree, FoundNode) + else + LogSQL(f_('Table node "%s" not found in tree.', [Obj.Name]), lcError); +end;} + + +{function TMainForm.FindDBObjectNode(Tree: TBaseVirtualTree; Obj: TDBObject): PVirtualNode; +var + DbNode, ObjectNode, GroupedNode: PVirtualNode; + DbObj, ObjectObj, GroupedObj: PDBObject; +begin + Result := nil; + DbNode := Tree.GetFirstChild(GetRootNode(Tree, Obj.Connection)); + while Assigned(DbNode) do begin + // Search in database nodes + DbObj := Tree.GetNodeData(DbNode); + if DBObj.IsSameAs(Obj) then begin + Result := DBNode; + break; + end; + + // Search in table/view/... nodes + if DbObj.Database = Obj.Database then begin + ObjectNode := Tree.GetFirstChild(DbNode); + while Assigned(ObjectNode) do begin + ObjectObj := Tree.GetNodeData(ObjectNode); + if ObjectObj.IsSameAs(Obj) then begin + Result := ObjectNode; + break; + end; + + // Search in grouped table/view/... nodes + GroupedNode := Tree.GetFirstChild(ObjectNode); + while Assigned(GroupedNode) do begin + GroupedObj := Tree.GetNodeData(GroupedNode); + if GroupedObj.IsSameAs(Obj) then begin + Result := GroupedNode; + break; + end; + GroupedNode := Tree.GetNextSibling(GroupedNode); + end; + + ObjectNode := Tree.GetNextSibling(ObjectNode); + end; + break; + end; + DbNode := Tree.GetNextSibling(DbNode); + end; +end;} + + +{** + Column selection for datagrid +} +{procedure TMainForm.btnDataClick(Sender: TObject); +var + btn : TToolButton; + frm : TForm; +begin + btn := (Sender as TToolButton); + + if (btn = tbtnDataColumns) or (btn = tbtnDataSorting) then begin + // Create desired form for SELECT and ORDER buttons + btn.Down := not btn.Down; + if not btn.Down then Exit; + if btn = tbtnDataColumns then + frm := TfrmColumnSelection.Create(self) + else if btn = tbtnDataSorting then + frm := TfrmDataSorting.Create(self) + else + frm := TForm.Create(self); // Dummy fallback, should never get created + // Position new form relative to btn's position + frm.Top := btn.ClientOrigin.Y + btn.Height; + frm.Left := btn.ClientOrigin.X + btn.Width - frm.Width; + // Display form + frm.Show; + end else if btn = tbtnDataFilter then begin + // Unhide inline filter panel + ToggleFilterPanel; + FilterPanelManuallyOpened := pnlFilter.Visible; + if FilterPanelManuallyOpened then + SynMemoFilter.SetFocus; + end; +end;} + + +{procedure TMainForm.filterQueryHelpersChange(Sender: TObject); +begin + // Filter nodes in query helpers + FilterNodesByEdit(Sender as TButtonedEdit, QueryTabs.ActiveHelpersTree); +end;} + + +{procedure TMainForm.tabsetQueryMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); +var + idx, i: Integer; + Tabs: TTabSet; + Rect: TRect; + Org: TPoint; + QueryTab: TQueryTab; + ResultTab: TResultTab; + HintSQL: TStringList; +begin + // Display some hint with row/col count + SQL when mouse hovers over result tab + if (FLastHintMousepos.X = x) and (FLastHintMousepos.Y = Y) then + Exit; + FLastHintMousepos := Point(X, Y); + Tabs := Sender as TTabSet; + idx := Tabs.ItemAtPos(Point(X, Y), True); + if (idx = -1) or (idx = FLastHintControlIndex) then + Exit; + FLastHintControlIndex := idx; + // Check if user wants these balloon hints + if not AppSettings.ReadBool(asHintsOnResultTabs) then + Exit; + QueryTab := QueryTabs.ActiveTab; + if idx >= QueryTab.ResultTabs.Count then + Exit; + + // Make SQL readable for the tooltip balloon. WrapText() is unsuitable here. + // See issue #2014 + // Also, wee need to work around the awful looking balloon text: + // http://qc.embarcadero.com/wc/qcmain.aspx?d=73771 + ResultTab := QueryTab.ResultTabs[idx]; + HintSQL := TStringList.Create; + HintSQL.Text := Trim(ResultTab.Results.SQL); + for i:=0 to HintSQL.Count-1 do begin + HintSQL[i] := StrEllipsis(HintSQL[i], 100); + HintSQL[i] := StringReplace(HintSQL[i], #9, ' ', [rfReplaceAll]); + end; + BalloonHint1.Description := FormatNumber(ResultTab.Results.ColumnCount) + ' columns × ' + + FormatNumber(ResultTab.Results.RecordCount) + ' rows' + CRLF + CRLF + + Trim(StrEllipsis(HintSQL.Text, SIZE_KB)); + Rect := Tabs.ItemRect(idx); + Org := Tabs.ClientOrigin; + OffsetRect(Rect, Org.X, Org.Y); + BalloonHint1.ShowHint(Rect); +end;} + + +{procedure TMainForm.tabsetQueryMouseLeave(Sender: TObject); +begin + // BalloonHint.HideAfter is -1, so it will stay forever if we wouldn't hide it at some point + BalloonHint1.HideHint; + FLastHintControlIndex := -1; +end;} + + +{** + Insert function name from popupmenu to query memo +} +{procedure TMainForm.insertFunction(Sender: TObject); +var + f : String; + sm : TSynMemo; + Conn: TDBConnection; +begin + // Detect which memo is focused + if SynMemoFilter.Focused then + sm := SynMemoFilter + else + sm := QueryTabs.ActiveMemo; + // Restore function name from tag + Conn := ActiveConnection; + f := Conn.SQLFunctions[TControl(Sender).tag].Name + + Conn.SQLFunctions[TControl(Sender).tag].Declaration; + sm.UndoList.AddGroupBreak; + sm.SelText := f; + sm.UndoList.AddGroupBreak; + if not SynMemoFilter.Focused then + ValidateQueryControls(Sender); +end;} + + +{** + Delete a snippet file +} +{procedure TMainForm.menuDeleteSnippetClick(Sender: TObject); +var + snippetfile : String; +begin + // Don't do anything if no item was selected + if not Assigned(QueryTabs.ActiveHelpersTree.FocusedNode) then + Exit; + + snippetfile := AppSettings.DirnameSnippets + QueryTabs.ActiveHelpersTree.Text[QueryTabs.ActiveHelpersTree.FocusedNode, 0] + '.sql'; + if MessageDialog(_('Delete snippet file?'), snippetfile, mtConfirmation, [mbOk, mbCancel]) = mrOk then + begin + Screen.Cursor := crHourGlass; + if DeleteFileWithUndo(snippetfile) then begin + // Refresh list with snippets + SetSnippetFilenames; + end else begin + Screen.Cursor := crDefault; + ErrorDialog(f_('Failed deleting %s', [snippetfile])); + end; + Screen.Cursor := crDefault; + end; +end;} + + +{procedure TMainForm.menuDoubleClickInsertsNodeTextClick(Sender: TObject); +var + Item: TMenuItem; +begin + // Activate doubleclick node feature + Item := Sender as TMenuItem; + Item.Checked := not Item.Checked; + AppSettings.ResetPath; + AppSettings.WriteBool(asDoubleClickInsertsNodeText, Item.Checked); +end;} + +{** + Load snippet at cursor +} +{procedure TMainForm.menuInsertAtCursorClick(Sender: TObject); +var + Tree: TVirtualStringTree; + Tab: TQueryTab; +begin + Tree := QueryTabs.ActiveHelpersTree; + Tab := QueryTabs.ActiveTab; + Tab.Memo.DragDrop(Tree, Tab.Memo.CaretX, Tab.Memo.CaretY); +end;} + + +{** + Load snippet and replace content +} +{procedure TMainForm.menuLoadSnippetClick(Sender: TObject); +begin + QueryTabs.ActiveTab.LoadContents(AppSettings.DirnameSnippets + QueryTabs.ActiveHelpersTree.Text[QueryTabs.ActiveHelpersTree.FocusedNode, 0] + '.sql', True, nil); +end;} + + +{** + Open snippets-directory in Explorer +} +{procedure TMainForm.menuExploreClick(Sender: TObject); +begin + ShellExec('', AppSettings.DirnameSnippets); +end;} + + +{procedure TMainForm.menuClearQueryHistoryClick(Sender: TObject); +var + Values: TStringList; + PathToDelete: String; +begin + // Clear query history items in registry + // Take care of MessageDialog, probably changing the current SessionPath + PathToDelete := ActiveConnection.Parameters.SessionPath + '\' + REGKEY_QUERYHISTORY; + AppSettings.SessionPath := PathToDelete; + Values := AppSettings.GetValueNames; + if MessageDialog(_('Clear query history?'), f_('%s history items will be deleted.', [FormatNumber(Values.Count)]), mtConfirmation, [mbYes, mbNo]) = mrYes then begin + Screen.Cursor := crHourglass; + AppSettings.SessionPath := PathToDelete; + AppSettings.DeleteCurrentKey; + RefreshHelperNode(TQueryTab.HelperNodeHistory); + Screen.Cursor := crDefault; + end; + Values.Free; + AppSettings.ResetPath; +end;} + + +{procedure TMainForm.menuFetchDBitemsClick(Sender: TObject); +var + Node: PVirtualNode; + db: String; + Conn: TDBConnection; +begin + // Fill db object cache of selected databases + try + Screen.Cursor := crHourglass; + Node := GetNextNode(ListDatabases, nil, True); + Conn := ActiveConnection; + while Assigned(Node) do begin + db := ListDatabases.Text[Node, 0]; + Conn.GetDBObjects(db, True); + ListDatabases.RepaintNode(Node); + DBtree.RepaintNode(FindDBNode(DBtree, Conn, db)); + Node := GetNextNode(ListDatabases, Node, True); + end; + finally + Screen.Cursor := crDefault; + end; +end;} + + +{** + A column header of a VirtualStringTree was clicked: + Toggle the sort direction +} +{procedure TMainForm.AnyGridHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); +var + ConfirmResult: Integer; + MsgStr: String; + LongSortRowNum: Cardinal; +begin + // Don't call sorting procedure on right click + // Some list-headers have a contextmenu which should popup then. + if HitInfo.Button = mbRight then + Exit; + // Beginning with VT's r181, this proc is also called when doubleclicking-to-autofit + // Seems buggy in VT as this suddenly calls it with Column=-1 in those cases. + // See also issue #1150 + if HitInfo.Column = NoColumn then + Exit; + if Sender.Columns[HitInfo.Column].CheckBox then + Exit; + // Header click disabled + if not AppSettings.ReadBool(asColumnHeaderClick) then + Exit; + // Large query result sorting takes too long, see #293 + LongSortRowNum := AppSettings.ReadInt(asQueryGridLongSortRowNum); + if TVirtualStringTree(Sender.Treeview).RootNodeCount > LongSortRowNum then begin + MsgStr := f_('Sort operation on grid containing more than %d rows can take longer. Do you want to wait for it?', [LongSortRowNum]); + ConfirmResult := MessageDialog('Wait longer for sorting?', MsgStr, mtConfirmation, [mbYes, mbNo]); + if ConfirmResult <> mrYes then + Exit; + end; + + if (Sender.SortColumn <> HitInfo.Column) or (Sender.SortDirection = sdDescending) then begin + Sender.SortDirection := sdAscending; + end else if Sender.SortDirection = sdAscending then begin + Sender.SortDirection := sdDescending; + end; + Screen.Cursor := crHourglass; + Sender.SortColumn := HitInfo.Column; + TBaseVirtualTree(Sender.Treeview).SortTree( HitInfo.Column, Sender.SortDirection ); + Screen.Cursor := crDefault; +end;} + + +{** + Sorting a column of a VirtualTree by comparing two cells +} +{procedure TMainForm.AnyGridCompareNodes(Sender: TBaseVirtualTree; Node1, + Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); +var + VT: TVirtualStringTree; +begin + VT := Sender as TVirtualStringTree; + if Assigned(Node1) and Assigned(Node2) then + Result := CompareAnyNode(VT.Text[Node1, Column], VT.Text[Node2, Column]); +end;} + + +{** + VirtualTree was painted. Adjust background color of sorted column. +} +{procedure TMainForm.AnyGridAfterPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas); +var + i: Integer; + h: TVTHeader; + NewColor: TColor; +begin + h := (Sender as TVirtualStringTree).Header; + for i:=0 to h.Columns.Count-1 do begin + NewColor := GetThemeColor(clWindow); + if h.SortColumn = i then + NewColor := ColorAdjustBrightness(NewColor, COLORSHIFT_SORTCOLUMNS); + h.Columns[i].Color := NewColor; + end; +end;} + + +{** + Start writing logfile. + Called either in FormShow or after closing preferences dialog +} +{procedure TMainForm.SetLogToFile(Value: Boolean); +var + LogfilePattern, LogDir: String; + i : Integer; +begin + if Value = FLogToFile then + Exit; + + if Value then begin + // Ensure directory exists + LogDir := AppSettings.ReadString(asSessionLogsDirectory); + LogDir := IncludeTrailingPathDelimiter(LogDir); + ForceDirectories(LogDir); + + // Determine free filename + LogfilePattern := '%.6u.log'; + i := 1; + FFileNameSessionLog := LogDir + ValidFilename(Format(LogfilePattern, [i])); + while FileExists(FFileNameSessionLog) do begin + inc(i); + FFileNameSessionLog := LogDir + ValidFilename(Format(LogfilePattern, [i])); + end; + + // Create file handle for writing + AssignFile( FFileHandleSessionLog, FFileNameSessionLog );} + //{$I-} // Supress errors + //if FileExists(FFileNameSessionLog) then + // Append(FFileHandleSessionLog) + //else + // Rewrite(FFileHandleSessionLog); + //{$I+} + {if IOResult <> 0 then begin + AppSettings.WriteBool(asLogToFile, False); + ErrorDialog(_('Error opening session log file'), FFileNameSessionLog+CRLF+CRLF+_('Logging is disabled now.')); + end else begin + FLogToFile := Value; + LogSQL(f_('Writing to session log file now: %s', [FFileNameSessionLog])); + end; + end else begin} + //{$I-} // Supress errors + //CloseFile(FFileHandleSessionLog); + //{$I+} + {// Reset IOResult so later checks in ActivateFileLogging doesn't get an old value + IOResult; + FLogToFile := Value; + LogSQL(_('Writing to session log file disabled now')); + end; +end;} + + +{** + Display tooltips in VirtualTrees. Imitates default behaviour of TListView. +} +{procedure TMainForm.AnyGridGetHint(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; var LineBreakStyle: + TVTTooltipLineBreakStyle; var HintText: String); +var + Tree: TVirtualStringTree; + NewHint: String; + Conn: TDBConnection; + ValIsNumber: Boolean; +begin + // Disable tooltips on Wine, as they prevent users from clicking + editing clipped cells + if IsWine then + Exit; + + Tree := TVirtualStringTree(Sender); + + if Tree = QueryTabs.ActiveHelpersTree then begin + Conn := ActiveConnection; + case Sender.GetNodeLevel(Node) of + 1: case Node.Parent.Index of + TQueryTab.HelperNodeFunctions: begin + NewHint := Conn.SQLFunctions[Node.Index].Name + Conn.SQLFunctions[Node.Index].Declaration + + ':' + sLineBreak + Conn.SQLFunctions[Node.Index].Description; + if not NewHint.IsEmpty then begin + HintText := NewHint; + end; + end; + end; + end; + end; + + if HintText.IsEmpty then begin + try + ValIsNumber := IntToStr(MakeInt(Tree.Text[Node, Column])) = Tree.Text[Node, Column]; + except + ValIsNumber := False; + end; + if ValIsNumber then + HintText := FormatNumber(Tree.Text[Node, Column]) + else + HintText := StrEllipsis(Tree.Text[Node, Column], SIZE_KB); + end; + // See http://www.heidisql.com/forum.php?t=20458#p20548 + if Sender = DBtree then + LineBreakStyle := hlbForceSingleLine + else + LineBreakStyle := hlbForceMultiLine; +end;} + + +{procedure TMainForm.actLogHorizontalScrollbarExecute(Sender: TObject); +begin + // Toggle visibility of horizontal scrollbar + if TAction(Sender).Checked then + SynMemoSQLLog.ScrollBars := ssBoth + else + SynMemoSQLLog.ScrollBars := ssVertical; +end;} + + +{** + Enable/disable file logging by popupmenuclick +} +{procedure TMainForm.menuLogToFileClick(Sender: TObject); +begin + LogToFile := not LogToFile; + // Save option + AppSettings.ResetPath; + AppSettings.WriteBool(asLogToFile, LogToFile); +end;} + + +{** + Open folder with session logs +} +{procedure TMainForm.menuOpenLogFolderClick(Sender: TObject); +begin + ShellExec('', AppSettings.ReadString(asSessionLogsDirectory)); +end;} + + +{** + A header column of a VirtualTree was "dragged out", which means: + dragged down or up, not to the left or right. + We imitate the behaviour of various applications (fx Outlook) and + hide this dragged column +} +{procedure TMainForm.AnyGridHeaderDraggedOut(Sender: TVTHeader; Column: + TColumnIndex; DropPosition: TPoint); +var + Remaining: TColumnsArray; +begin + // Hide the draggedout column, if it's not the last one + // See also menuToggleAllClick, where hiding all is restricted through the poAllowHideAll option + Remaining := Sender.Columns.GetVisibleColumns; + if Length(Remaining) > 1 then + Sender.Columns[Column].Options := Sender.Columns[Column].Options - [coVisible]; + // Dynamic arrays are free'd when their scope ends, so this should not be required: + SetLength(Remaining, 0); +end;} + + +{procedure TMainForm.AnyGridIncrementalSearch(Sender: TBaseVirtualTree; Node: PVirtualNode; + const SearchText: String; var Result: Integer); +var + CellText: String; + VT: TVirtualStringTree; +begin + // Override VT's default incremental search behaviour. Make it case insensitive. + VT := Sender as TVirtualStringTree; + if VT.FocusedColumn = NoColumn then + Exit; + CellText := VT.Text[Node, VT.FocusedColumn]; + Result := StrLIComp(PChar(CellText), PChar(SearchText), Length(SearchText)); +end;} + + +{procedure TMainForm.ListTablesBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + var ContentRect: TRect); +var + Obj: PDBObject; +begin + PaintAlternatingRowBackground(TargetCanvas, Node, CellRect); + + // Only paint bar in rows + size column + if Column in [1, 2] then begin + Obj := Sender.GetNodeData(Node); + case Column of + 1: PaintColorBar(Obj.Rows, FDBObjectsMaxRows, TargetCanvas, CellRect); + 2: PaintColorBar(Obj.Size, FDBObjectsMaxSize, TargetCanvas, CellRect); + end; + end; +end;} + + +{function TMainForm.GetAlternatingRowBackground(Node: PVirtualNode): TColor; +var + clEven, clOdd: TColor; + isEven: Boolean; +begin + // Alternating row background. See issue #139 + Result := clNone; + clEven := AppSettings.ReadInt(asRowBackgroundEven); + clOdd := AppSettings.ReadInt(asRowBackgroundOdd); + isEven := Node.Index mod 2 = 0; + if IsEven and (clEven <> clNone) then + Result := clEven + else if (not IsEven) and (clOdd <> clNone) then + Result := clOdd; +end;} + + +{procedure TMainForm.PaintAlternatingRowBackground(TargetCanvas: TCanvas; Node: PVirtualNode; CellRect: TRect); +var + BgColor: TColor; +begin + // Apply color + BgColor := GetAlternatingRowBackground(Node); + if BgColor <> clNone then begin + TargetCanvas.Brush.Color := BgColor; + TargetCanvas.FillRect(CellRect); + end; +end;} + + +{procedure TMainForm.PaintColorBar(Value, Max: Extended; TargetCanvas: TCanvas; CellRect: TRect); +var + BarWidth, CellWidth: Integer; +begin + if not AppSettings.ReadBool(asDisplayBars) then + Exit; + + // Add minimal margin to cell edges + InflateRect(CellRect, -1, -1); + CellWidth := CellRect.Right - CellRect.Left; + + // Avoid division by zero, when max is 0 - very rare case but reported in issue #2196. + if (Value > 0) and (Max > 0) then begin + BarWidth := Round(CellWidth / Max * Value); + TargetCanvas.Brush.Color := ColorAdjustBrightness(TargetCanvas.Brush.Color, 20); + TargetCanvas.Pen.Color := ColorAdjustBrightness(TargetCanvas.Brush.Color, -40); + TargetCanvas.RoundRect(CellRect.Left, CellRect.Top, CellRect.Left+BarWidth, CellRect.Bottom, 2, 2); + end; +end;} + + +{** + A row in the process list was selected. Fill SynMemoProcessView with + the SQL of that row. +} +{procedure TMainForm.ListProcessesFocusChanged(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex); +var + NodeFocused, EnableControls: Boolean; + SQL: String; +begin + NodeFocused := Assigned(Node); + SQL := ''; + if NodeFocused then begin + SQL := ListProcesses.Text[Node, 7]; + end; + EnableControls := not SQL.IsEmpty; + if EnableControls then begin + SynMemoProcessView.Highlighter := SynSQLSynUsed; + SynMemoProcessView.Text := ListProcesses.Text[Node, 7]; + SynMemoProcessView.Color := clWindow; + end else begin + SynMemoProcessView.Highlighter := nil; + SynMemoProcessView.Text := _('Please select a process with a running query'); + SynMemoProcessView.Color := clBtnFace; + end; + + SynMemoProcessView.Enabled := EnableControls; + pnlProcessView.Enabled := EnableControls; + lblExplainProcess.Enabled := EnableControls and ActiveConnection.Parameters.IsAnyMySQL; + menuExplainProcess.Enabled := lblExplainProcess.Enabled; +end;} + + +{*** + Apply a filter to a Virtual Tree. +} +{procedure TMainForm.editFilterVTChange(Sender: TObject); +begin + // Reset typing timer + TimerFilterVT.Enabled := False; + TimerFilterVT.Enabled := True; + editFilterVT.RightButton.Visible := editFilterVT.Text <> ''; +end;} + + +{procedure TMainForm.editDatabaseTableFilterKeyPress(Sender: TObject; var Key: Char); +begin + if Key = #27 then + (Sender as TButtonedEdit).OnRightButtonClick(Sender); +end;} + + +{procedure TMainForm.TimerFilterVTTimer(Sender: TObject); +begin + // Disable timer to avoid filtering in a loop + TimerFilterVT.Enabled := False; + + // Code moved into this procedure in order to call it by different way + ApplyVTFilter(True); +end;} + + +{procedure TMainForm.ApplyVTFilter(FromTimer: Boolean); +var + Node: PVirtualNode; + VT: TVirtualStringTree; + i: Integer; + match: Boolean; + tab: TTabSheet; + VisibleCount: Cardinal; + CellText: String; + rx: TRegExpr; + OldDataLocalNumberFormat: Boolean; + OldImageIndex: Integer; +begin + // Find the correct VirtualTree that shall be filtered + tab := PageControlMain.ActivePage; + if tab = tabHost then + tab := PageControlHost.ActivePage; + VT := nil; + if tab = tabDatabases then begin + VT := ListDatabases; + FFilterTextDatabases := editFilterVT.Text; + end else if tab = tabVariables then begin + VT := ListVariables; + FFilterTextVariables := editFilterVT.Text; + end else if tab = tabStatus then begin + VT := ListStatus; + FFilterTextStatus := editFilterVT.Text; + end else if tab = tabProcesslist then begin + VT := ListProcesses; + FFilterTextProcessList := editFilterVT.Text; + end else if tab = tabCommandStats then begin + VT := ListCommandStats; + FFilterTextCommandStats := editFilterVT.Text; + end else if tab = tabDatabase then begin + VT := ListTables; + FFilterTextDatabase := editFilterVT.Text; + end else if tab = tabEditor then begin + if ActiveObjectEditor is TfrmTableEditor then + VT := TfrmTableEditor(ActiveObjectEditor).listColumns; + FFilterTextEditor := editFilterVT.Text; + end else if tab = tabData then begin + VT := DataGrid; + FFilterTextData := editFilterVT.Text; + end else if QueryTabs.HasActiveTab and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then begin + VT := ActiveGrid; + QueryTabs.ActiveTab.ActiveResultTab.FilterText := editFilterVT.Text; + end; + if not Assigned(VT) then + Exit; + // Loop through all nodes and hide non matching + Node := VT.GetFirst; + rx := TRegExpr.Create; + rx.ModifierI := True; + rx.Expression := editFilterVT.Text; + if rx.Expression <> '' then try + rx.Exec('abc'); + except + on E:ERegExpr do begin + LogSQL('Filter text is not a valid regular expression: "'+rx.Expression+'"', lcError); + rx.Expression := ''; + end; + end; + VisibleCount := 0; + OldDataLocalNumberFormat := DataLocalNumberFormat; + DataLocalNumberFormat := False; + // Display hour glass instead of X icon + OldImageIndex := editFilterVT.RightButton.ImageIndex; + editFilterVT.RightButton.ImageIndex := 150; + editFilterVT.Repaint; + + VT.BeginUpdate; + while Assigned(Node) do begin + // Don't filter anything if the filter text is empty + match := rx.Expression = ''; + // Search for given text in node's captions + if not match then for i := 0 to VT.Header.Columns.Count - 1 do begin + CellText := VT.Text[Node, i]; + match := rx.Exec(CellText); + if match then + break; + end; + VT.IsVisible[Node] := match; + if match then + inc(VisibleCount); + Node := VT.GetNext(Node); + end; + VT.EndUpdate; + if rx.Expression <> '' then begin + lblFilterVTInfo.Caption := f_('%0:d out of %1:d matching. %2:d hidden.', [VisibleCount, VT.RootNodeCount, VT.RootNodeCount - VisibleCount]); + end else + lblFilterVTInfo.Caption := ''; + + if FromTimer then + VT.Invalidate + else + InvalidateVT(VT, VTREE_LOADED, true); + DataLocalNumberFormat := OldDataLocalNumberFormat; + editFilterVT.RightButton.ImageIndex := OldImageIndex; + rx.Free; +end;} + + +{procedure TMainForm.ApplyFontToGrids; +var + QueryTab: TQueryTab; + ResultTab: TResultTab; + Grid: TVirtualStringTree; + IncrementalSearchActive: Boolean; + AllGrids: TObjectList<TVirtualStringTree>; +begin + // Apply changed settings to all existing data and query grids + LogSQL('Apply grid settings...', lcDebug); + AllGrids := TObjectList<TVirtualStringTree>.Create(False); + IncrementalSearchActive := AppSettings.ReadBool(asIncrementalSearch); + AllGrids.Add(DataGrid); // Data tab grid + AllGrids.Add(QueryGrid); // Mother query grid + for QueryTab in QueryTabs do begin // Query tab child grids + for ResultTab in QueryTab.ResultTabs do begin + AllGrids.Add(ResultTab.Grid); + end; + end; + for Grid in AllGrids do begin + Grid.Font.Name := AppSettings.ReadString(asDataFontName); + Grid.Font.Size := AppSettings.ReadInt(asDataFontSize); + FixVT(Grid, AppSettings.ReadInt(asGridRowLineCount)); + if IncrementalSearchActive then + Grid.IncrementalSearch := isInitializedOnly + else + Grid.IncrementalSearch := isNone; + end; + AllGrids.Free; +end;} + + +{procedure TMainForm.PrepareImageList; +var + IconPack: String; + WantedImageCollection: TComponent; +begin + // Load preferred ImageCollection into VirtualImageList + VirtualImageListMain.Clear; + IconPack := AppSettings.ReadString(asIconPack); + WantedImageCollection := FindComponent('ImageCollection' + IconPack); + if (WantedImageCollection <> nil) and (WantedImageCollection is TImageCollection) then begin + VirtualImageListMain.ImageCollection := WantedImageCollection as TImageCollection; + end else begin + VirtualImageListMain.ImageCollection := ImageCollectionIcons8; + end; + // Add all normal color icons from collection to virtual image list + VirtualImageListMain.Add('', 0, VirtualImageListMain.ImageCollection.Count-1); + // Add all icons again in disabled/grayscale mode, used in TExtForm.PageControlTabHighlight + VirtualImageListMain.AddDisabled('', 0, VirtualImageListMain.ImageCollection.Count-1); +end;} + + +{procedure TMainForm.ListVariablesDblClick(Sender: TObject); +begin + menuEditVariable.Click; +end;} + + +{procedure TMainForm.ListVariablesPaintText(Sender: TBaseVirtualTree; + const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + TextType: TVSTTextType); +var + Idx: PInt64; + i, tmp: Integer; + VarName, SessionVal, GlobalVal: String; + dcat: TDBDatatypeCategoryIndex; + vt: TVirtualStringTree; +begin + vt := Sender as TVirtualStringTree; + Idx := Sender.GetNodeData(Node); + VarName := FVariableNames[Idx^]; + tmp := -1; + for i:=Low(MySQLVariables) to High(MySQLVariables) do begin + if MySQLVariables[i].Name = VarName then begin + tmp := i; + break; + end; + end; + if (tmp=-1) or (not MySQLVariables[tmp].IsDynamic) then begin + // Gray out whole row if the variable is either unknown or not editable + TargetCanvas.Font.Color := GetThemeColor(clGrayText) + end else if Column in [1, 2] then begin + SessionVal := vt.Text[Node, 1]; + GlobalVal := vt.Text[Node, 2]; + if IsInt(SessionVal) or IsInt(GlobalVal) then + dcat := dtcInteger + else if (tmp > -1) and ((MySQLVariables[tmp].EnumValues <> '') or (Pos(UpperCase(SessionVal), 'ON,OFF,0,1,YES,NO')>0)) then + dcat := dtcOther + else + dcat := dtcText; + TargetCanvas.Font.Color := DatatypeCategories[dcat].Color; + end; +end;} + + +{procedure TMainForm.HostListGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); +var + Results: TDBQuery; + Idx: PInt64; + IsIdle: Boolean; +begin + if (Column <> (Sender as TVirtualStringTree).Header.MainColumn) then + exit; + if Sender = ListProcesses then begin + Idx := Sender.GetNodeData(Node); + Results := GridResult(Sender); + Results.RecNo := Idx^; + case Kind of + ikNormal, ikSelected: begin + case Results.Connection.Parameters.NetTypeGroup of + ngMySQL: IsIdle := Results.Col('Info', True) = ''; + ngMSSQL: IsIdle := (Results.Col(6, True) <> 'running') and (Results.Col(6, True) <> 'runnable'); + else IsIdle := False; + end; + if IsIdle then begin + if MakeInt(Results.Col(5, True)) < 60 then + ImageIndex := 151 // Idle, same icon as in lower right status panel + else + ImageIndex := 167 // Long idle thread + end else + ImageIndex := actExecuteQuery.ImageIndex; // Running query + end; + ikOverlay: begin + if IntToStr(Results.Connection.ThreadId) = Results.Col(0, True) then + ImageIndex := 168; // Indicate users own thread id + if CompareText(Results.Col(4, True), 'Killed') = 0 then + ImageIndex := 158; // Broken + end; + else; + end; + end else begin + case Kind of + ikNormal, ikSelected: ImageIndex := 25; + else; + end; + end; +end;} + + +{procedure TMainForm.HostListGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +var + Idx: PInt64; + Results: TDBQuery; + ValIsBytes, ValIsNumber: Boolean; + ValCount, CommandCount: Int64; + tmpval: Double; +begin + Idx := Sender.GetNodeData(Node); + Results := GridResult(Sender); + // See issue #3416 + if (Results = nil) and (Sender <> ListVariables) then + Exit; + if Results <> nil then + Results.RecNo := Idx^; + + if (Sender = ListStatus) and (Column in [1,2,3]) then begin + CellText := Results.Col(1); + + // Detect value type + try + ValIsNumber := IntToStr(MakeInt(CellText)) = CellText; + except + ValIsNumber := False; + end; + ValIsBytes := ValIsNumber and (Copy(Results.Col(0), 1, 6) = 'Bytes_'); + + // Calculate average values ... + case Column of + 1: begin // Format numeric or byte values + if ValIsBytes then + CellText := FormatByteNumber(CellText) + else if ValIsNumber then + CellText := FormatNumber(CellText); + end; + 2,3: begin // ... per hour/second + if ValIsNumber then begin + ValCount := MakeInt(CellText); + tmpval := ValCount / (FStatusServerUptime / 60 / 60); + if Column = 3 then + tmpval := tmpval / 60 / 60; + if ValIsBytes then + CellText := FormatByteNumber(Trunc(tmpval)) + else if ValIsNumber then + CellText := FormatNumber(tmpval, 1); + end else + CellText := ''; + end; + end; + + end else if Sender = ListCommandStats then begin + CommandCount := MakeInt(Results.Col(1)); + case Column of + 0: begin // Strip "Com_" + CellText := Results.Col(Column); + if CellText.StartsWith('Com_', True) then + CellText := Copy(CellText, 5, Length(CellText)); + CellText := StringReplace(CellText, '_', ' ', [rfReplaceAll] ); + end; + 1: begin // Total Frequency + CellText := FormatNumber(CommandCount); + end; + 2: begin // Average per hour + tmpval := CommandCount / (FCommandStatsServerUptime / 60 / 60); + CellText := FormatNumber(tmpval, 1); + end; + 3: begin // Average per second + tmpval := CommandCount / FCommandStatsServerUptime; + CellText := FormatNumber(tmpval, 1); + end; + 4: begin // Percentage. Take care of division by zero errors and Int64's + tmpval := 100 / Max(FCommandStatsQueryCount, 1) * Max(CommandCount, 1); + CellText := FormatNumber(tmpval, 1) + ' %'; + end; + end; + + end else if Sender = ListVariables then begin + try + case Column of + 0: CellText := FVariableNames[Idx^]; + 1: CellText := FSessionVars.Values[FVariableNames[Idx^]]; + 2: CellText := FGlobalVars.Values[FVariableNames[Idx^]]; + end; + except + CellText := ''; + end; + + end else begin + // Values directly from a query result + CellText := StrEllipsis(Results.Col(Column, True), SIZE_KB*50); + end; +end;} + + +{** + Edit a server variable +} +{procedure TMainForm.menuEditVariableClick(Sender: TObject); +var + Dialog: TfrmEditVariable; +begin + Dialog := TfrmEditVariable.Create(Self); + try + try + Dialog.VarName := ListVariables.Text[ListVariables.FocusedNode, 0]; + Dialog.VarValue := ListVariables.Text[ListVariables.FocusedNode, 1]; + // Refresh list node + if Dialog.ShowModal = mrOK then + InvalidateVT(ListVariables, VTREE_NOTLOADED, False); + except + on E:EVariableError do + ErrorDialog(E.Message); + end; + finally + Dialog.Free; + end; +end;} + + +{procedure TMainForm.DBtreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); +begin + // Set pointer size of bound TDBObjects + NodeDataSize := SizeOf(TDBObject); +end;} + + +{** + Set text of a treenode before it gets displayed or fetched in any way +} +{procedure TMainForm.DBtreeGetText(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: String); +var + DBObjects: TDBObjectList; + DBObj: PDBObject; + i: Integer; + Bytes: Int64; + AllListsCached: Boolean; +begin + DBObj := Sender.GetNodeData(Node); + case Column of + 0: case DBObj.NodeType of + lntNone: CellText := DBObj.Connection.Parameters.SessionPath; + lntDb: CellText := DBObj.Database; + lntGroup: begin + CellText := DBObj.Name; + if Sender.ChildrenInitialized[Node] then + CellText := CellText + ' (' + FormatNumber(Sender.ChildCount[Node]) + ')'; + end; + lntTable..lntEvent: try + if (DBObj.Schema <> '') and (DBObj.Connection.Parameters.NetTypeGroup = ngMSSQL) then + CellText := DBObj.Schema + '.' + DBObj.Name + else + CellText := DBObj.Name; + except + CellText := DBObj.Name; + end; + lntColumn: CellText := DBObj.Column; + end; + 1: if DBObj.Connection.Active then case DBObj.NodeType of + // Calculate and display the sum of all table sizes in ALL dbs if all table lists are cached + lntNone: begin + AllListsCached := true; + for i:=0 to DBObj.Connection.AllDatabases.Count-1 do begin + if not DBObj.Connection.DbObjectsCached(DBObj.Connection.AllDatabases[i]) then begin + AllListsCached := false; + break; + end; + end; + // Will be also set to a negative value by GetTableSize and results of SHOW TABLES + Bytes := -1; + if AllListsCached then begin + Bytes := 0; + for i:=0 to DBObj.Connection.AllDatabases.Count-1 do begin + DBObjects := DBObj.Connection.GetDBObjects(DBObj.Connection.AllDatabases[i]); + Inc(Bytes, DBObjects.DataSize); + end; + end; + if Bytes >= 0 then CellText := FormatByteNumber(Bytes) + else CellText := ''; + end; + // Calculate and display the sum of all table sizes in ONE db, if the list is already cached. + lntDb: begin + if not DBObj.Connection.DbObjectsCached(DBObj.Database) then + CellText := '' + else begin + DBObjects := DBObj.Connection.GetDBObjects(DBObj.Database); + CellText := FormatByteNumber(DBObjects.DataSize); + end; + end; + lntTable: begin + if DBObj.Size >= 0 then + CellText := FormatByteNumber(DBObj.Size) + else + CellText := ''; + end + else CellText := ''; // Applies for views/procs/... which have no size + end; + end; +end;} + + +{** + Set icon of a treenode before it gets displayed +} +{procedure TMainForm.DBtreeGetImageIndex(Sender: TBaseVirtualTree; Node: + PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: + Boolean; var ImageIndex: TImageIndex); +var + DBObj: PDBObject; +begin + if Column > 0 then + Exit; + DBObj := Sender.GetNodeData(Node); + case Kind of + ikNormal, ikSelected: begin + ImageIndex := DBObj.ImageIndex; + Ghosted := (DBObj.NodeType = lntNone) and (not DBObj.Connection.Active); + Ghosted := Ghosted or ((DBObj.NodeType = lntDB) + and (not DBObj.Connection.DbObjectsCached(DBObj.Database)) + ); + Ghosted := Ghosted or ((DBObj.NodeType = lntGroup) + and Sender.ChildrenInitialized[Node] + and (Sender.ChildCount[Node] = 0) + ); + Ghosted := Ghosted or ((DBObj.NodeType in [lntTable..lntEvent]) + and (not DBObj.WasSelected) + ); + end; + ikOverlay: + ImageIndex := DBObj.OverlayImageIndex; + end; +end;} + + +{** + Set childcount of an expanding treenode +} +{procedure TMainForm.DBtreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); +var + DBObj: PDBObject; + Columns: TTableColumnList; + DBObjects: TDBObjectList; +begin + DBObj := Sender.GetNodeData(Node); + case DBObj.NodeType of + // Session node expanding + lntNone: begin + Screen.Cursor := crHourglass; + ShowStatusMsg(_('Reading Databases...')); + if Sender.Tag = VTREE_NOTLOADED_PURGECACHE then + DBObj.Connection.RefreshAllDatabases; + ShowStatusMsg; + Sender.Tag := VTREE_LOADED; + InvalidateVT(ListDatabases, VTREE_NOTLOADED, True); + ChildCount := DBObj.Connection.AllDatabases.Count; + Screen.Cursor := crDefault; + end; + // DB node expanding + lntDb: begin + if actGroupObjects.Checked then begin + // Just tables, views, etc. + ChildCount := 6; + end else begin + ShowStatusMsg(_('Reading objects ...')); + Screen.Cursor := crHourglass; + try + ChildCount := DBObj.Connection.GetDBObjects(DBObj.Connection.AllDatabases[Node.Index]).Count; + finally + ShowStatusMsg; + Screen.Cursor := crDefault; + end; + end; + end; + lntGroup: begin + ChildCount := 0; + DBObjects := DBObj.Connection.GetDBObjects(DBObj.Database, False, DBObj.GroupType); + ChildCount := DBObjects.Count; + end; + lntTable: + if GetParentFormOrFrame(Sender) is TfrmSelectDBObject then begin + Columns := DBObj.TableColumns; + ChildCount := Columns.Count; + end; + end; +end;} + + +{** + Set initial options of a treenode and bind DBobject to node which holds the relevant + connection object, probably its database and probably its table/view/... specific properties +} +{procedure TMainForm.DBtreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: + PVirtualNode; var InitialStates: TVirtualNodeInitStates); +var + Item, ParentObj: PDBObject; + DBObjects: TDBObjectList; + Columns: TTableColumnList; +begin + Item := Sender.GetNodeData(Node); + if (not Assigned(ParentNode)) or (ParentNode = nil) then begin + Item^ := TDBObject.Create(FConnections[Node.Index]); + // Ensure plus sign is visible for root (and dbs, see below) + Include(InitialStates, ivsHasChildren); + end else begin + ParentObj := Sender.GetNodeData(ParentNode); + case ParentObj.NodeType of + lntNone: begin + Item^ := TDBObject.Create(ParentObj.Connection); + Item.NodeType := lntDb; + Item.Database := Item.Connection.AllDatabases[Node.Index]; + Include(InitialStates, ivsHasChildren); + end; + lntDb: begin + if actGroupObjects.Checked then begin + Item^ := TDBObject.Create(ParentObj.Connection); + Item.NodeType := lntGroup; + case Node.Index of + 0: begin Item.GroupType := lntTable; Item.Name := _('Tables'); end; + 1: begin Item.GroupType := lntView; Item.Name := _('Views'); end; + 2: begin Item.GroupType := lntProcedure; Item.Name := _('Procedures'); end; + 3: begin Item.GroupType := lntFunction; Item.Name := _('Functions'); end; + 4: begin Item.GroupType := lntTrigger; Item.Name := _('Triggers'); end; + 5: begin Item.GroupType := lntEvent; Item.Name := _('Events'); end; + end; + Item.Database := ParentObj.Database; + InitialStates := InitialStates + [ivsHasChildren]; + end else begin + DBObjects := ParentObj.Connection.GetDBObjects(ParentObj.Database); + Item^ := DBObjects[Node.Index]; + if (GetParentFormOrFrame(Sender) is TfrmSelectDBObject) and (Item.NodeType = lntTable) then + Include(InitialStates, ivsHasChildren); + end; + end; + lntGroup: begin + DBObjects := ParentObj.Connection.GetDBObjects(ParentObj.Database, False, ParentObj.GroupType); + Item^ := DBObjects[Node.Index]; + if (GetParentFormOrFrame(Sender) is TfrmSelectDBObject) and (Item.NodeType = lntTable) then + Include(InitialStates, ivsHasChildren); + end; + lntTable: begin + Item^ := TDBObject.Create(ParentObj.Connection); + Item.NodeType := lntColumn; + Columns := ParentObj.TableColumns; + Item.Database := ParentObj.Database; + Item.Name := ParentObj.Name; + Item.Column := Columns[Node.Index].Name; + end; + end; + end; +end;} + + +{** + Selection in database tree has changed +} +{procedure TMainForm.DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); +var + DBObj, PrevDBObj, ParentDBObj: PDBObject; + MainTabToActivate: TTabSheet; + EnteringSession: Boolean; +begin + // Set wanted main tab and call SetMainTab later, when all lists have been invalidated + MainTabToActivate := nil; + PrevDBObj := nil; + ParentDBObj := nil; + + if Assigned(Node) then begin + LogSQL('DBtreeFocusChanged, Node level: '+IntToStr(Sender.GetNodeLevel(Node))+', FTreeRefreshInProgress: '+IntToStr(Integer(FTreeRefreshInProgress)), lcDebug); + + // Post pending UPDATE + if (DataGridResult<>nil) and DataGridResult.Modified then + actDataPostChangesExecute(DataGrid); + + DBObj := Sender.GetNodeData(Node); + DBObj.WasSelected := True; + FActiveDbObj := TDBObject.Create(DBObj.Connection); + FActiveDbObj.Assign(DBObj^); + if Assigned(Node.Parent) and (DBtree.GetNodeLevel(Node) > 0) then + ParentDBObj := Sender.GetNodeData(Node.Parent); + + case FActiveDbObj.NodeType of + lntNone: begin + if (not DBtree.Dragging) and (not QueryTabs.HasActiveTab) then + MainTabToActivate := tabHost; + FActiveDbObj.Connection.Database := ''; + end; + lntDb, lntGroup: begin + // Selecting a database can cause an SQL error if the db was deleted from outside. Select previous node in that case. + try + FActiveDbObj.Connection.Database := FActiveDbObj.Database; + except on E:EDbError do begin + ErrorDialog(E.Message); + SelectNode(DBtree, TreeClickHistoryPrevious); + Exit; + end; + end; + if (not DBtree.Dragging) and (not QueryTabs.HasActiveTab) then + MainTabToActivate := tabDatabase; + FActiveObjectGroup := FActiveDbObj.GroupType; + end; + lntTable..lntEvent: begin + try + FActiveDbObj.Connection.Database := FActiveDbObj.Database; + except on E:EDbError do begin + ErrorDialog(E.Message); + SelectNode(DBtree, TreeClickHistoryPrevious); + Exit; + end; + end; + + // Retrieve columns of current table or view. Mainly used in datagrid. + SelectedTableColumns.Clear; + SelectedTableKeys.Clear; + SelectedTableForeignKeys.Clear; + AppSettings.SessionPath := GetRegKeyTable; + SelectedTableTimestampColumns.Text := AppSettings.ReadString(asTimestampColumns); + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); + try + if FActiveDbObj.NodeType in [lntTable, lntView] then begin + SelectedTableColumns := FActiveDbObj.TableColumns; + try + SelectedTableKeys := FActiveDbObj.TableKeys; + except // No show stopper, happening when a view references a renamed table column, see #1130 + on E:EDbError do + ErrorDialog(_('This view probably contains an error in its code.')+sLineBreak+sLineBreak+E.Message); + end; + SelectedTableForeignKeys := FActiveDbObj.TableForeignKeys; + end; + PlaceObjectEditor(FActiveDbObj); + // When a table is clicked in the tree, and the current + // tab is a Host or Database tab, switch to showing table columns. + if (PagecontrolMain.ActivePage = tabHost) or (PagecontrolMain.ActivePage = tabDatabase) then + MainTabToActivate := tabEditor; + if DataGrid.Tag = VTREE_LOADED then + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); + // Update the list of columns + RefreshHelperNode(TQueryTab.HelperNodeColumns); + except on E:EDbError do + ErrorDialog(E.Message); + end; + + if Assigned(ParentDBObj) then + FActiveObjectGroup := ParentDBObj.GroupType; + end; + end; + + if TreeClickHistoryPrevious(True) <> nil then + PrevDBObj := Sender.GetNodeData(TreeClickHistoryPrevious(True)); + + // When clicked node is from a different connection than before, do session specific stuff here: + try + EnteringSession := (FActiveDbObj <> nil) + and ((PrevDBObj = nil) or (PrevDBObj.Connection <> FActiveDbObj.Connection)); + except + on E:EAccessViolation do begin + LogSQL(E.ClassName+' while moving focus in tree.', lcError); + EnteringSession := True; + end; + end; + if EnteringSession then begin + LogSQL(f_('Entering session "%s"', [FActiveDbObj.Connection.Parameters.SessionPath]), lcInfo); + RefreshHelperNode(TQueryTab.HelperNodeHistory); + RefreshHelperNode(TQueryTab.HelperNodeProfile); + case FActiveDbObj.Connection.Parameters.NetTypeGroup of + ngMySQL: + SynSQLSynUsed.SQLDialect := sqlMySQL; + ngMSSQL: + SynSQLSynUsed.SQLDialect := sqlMSSQL2K; + ngPgSQL: + SynSQLSynUsed.SQLDialect := sqlPostgres; + ngSQLite: + SynSQLSynUsed.SQLDialect := sqlStandard; + ngInterbase: + SynSQLSynUsed.SQLDialect := sqlInterbase6; + else + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(FActiveDbObj.Connection.Parameters.NetType)]); + end; + // Extend predefined MySQLFunctions from SynHighlighterSQL with our own functions list + SynSQLSynUsed.FunctionNames.BeginUpdate; + SynSQLSynUsed.FunctionNames.Clear; + SynSQLSynUsed.FunctionNames.AddStrings(FActiveDbObj.Connection.SQLFunctions.Names); + SynSQLSynUsed.FunctionNames.EndUpdate; + end; + + if (FActiveDbObj <> nil) + and (FActiveDbObj.NodeType <> lntNone) + and ( + (PrevDBObj = nil) + or (PrevDBObj.Connection <> FActiveDbObj.Connection) + or (PrevDBObj.Database <> FActiveDbObj.Database) + or (PrevDBObj.GroupType <> FActiveObjectGroup) + ) then + InvalidateVT(ListTables, VTREE_NOTLOADED, True); + if FActiveDbObj.NodeType = lntGroup then + InvalidateVT(ListTables, VTREE_NOTLOADED, True); + + SetTabCaption(tabHost.PageIndex, FActiveDbObj.Connection.Parameters.SessionName); + SetTabCaption(tabDatabase.PageIndex, _('Database')+': '+FActiveDbObj.Connection.Database); + ShowStatusMsg(FActiveDbObj.Connection.Parameters.NetTypeName(False)+' '+FActiveDbObj.Connection.ServerVersionStr, 3); + end else begin + LogSQL('DBtreeFocusChanged without node.', lcDebug); + FreeAndNil(FActiveDbObj); + tabHost.Caption := _('Host'); + tabDatabase.Caption := _('Database'); + // Clear server version panel + ShowStatusMsg('', 3); + end; + + if (FActiveDbObj = nil) or (PrevDBObj = nil) or (PrevDBObj.Connection <> FActiveDbObj.Connection) then begin + TimerConnected.OnTimer(Sender); + TimerHostUptime.OnTimer(Sender); + InvalidateVT(ListDatabases, VTREE_NOTLOADED, False); + InvalidateVT(ListVariables, VTREE_NOTLOADED, False); + InvalidateVT(ListStatus, VTREE_NOTLOADED, False); + InvalidateVT(ListProcesses, VTREE_NOTLOADED, False); + InvalidateVT(ListCommandstats, VTREE_NOTLOADED, False); + InvalidateVT(ListTables, VTREE_NOTLOADED, False); + ValidateQueryControls(Self); + end; + + // Make wanted tab visible before activating, to avoid unset tab on Wine + if Assigned(MainTabToActivate) then + MainTabToActivate.TabVisible := True; + if not FTreeRefreshInProgress then begin + SetMainTab(MainTabToActivate); + tabDatabase.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType <> lntNone); + tabEditor.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType in [lntTable..lntEvent]); + tabData.TabVisible := (FActiveDbObj <> nil) and (FActiveDbObj.NodeType in [lntTable, lntView]); + end; + + // Store click history item + SetLength(FTreeClickHistory, Length(FTreeClickHistory)+1); + FTreeClickHistory[Length(FTreeClickHistory)-1] := Node; + + DBTree.InvalidateColumn(0); + FixQueryTabCloseButtons; + SetWindowCaption; +end;} + + +{procedure TMainForm.DBtreeFocusChanging(Sender: TBaseVirtualTree; OldNode, + NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; + var Allowed: Boolean); +begin + // Check if some editor has unsaved changes + if Assigned(ActiveObjectEditor) and Assigned(NewNode) and (NewNode <> OldNode) and (not FTreeRefreshInProgress) then begin + Allowed := not (ActiveObjectEditor.DeInit in [mrAbort, mrCancel]); + DBTree.Selected[DBTree.FocusedNode] := not Allowed; + end else + Allowed := NewNode <> OldNode; +end;} + + +{procedure TMainForm.DBtreeFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); +var +// DBObj: PDBObject; + i: Integer; +begin + // Keep track of the previously selected tree node's state, to avoid AVs in OnFocusChanged() + for i:=0 to Length(FTreeClickHistory)-1 do begin + if Node = FTreeClickHistory[i] then + FTreeClickHistory[i] := nil; + end; + // TODO: Free object if its host or db. Tables/views/... already get freed in Connection.ClearDBObjects + // does not work here when table is focused, for some reason: + // DBObj := Sender.GetNodeData(Node); + // if Assigned(DBObj^) and (DBObj.NodeType in [lntNone, lntDb]) then + // logsql('freeing node: type #'+inttostr(integer(dbobj.NodeType))+' name: '+dbobj.database); + // FreeAndNil(DBObj^); + // end; +end;} + + +{function TMainForm.TreeClickHistoryPrevious(MayBeNil: Boolean=False): PVirtualNode; +var + i: Integer; +begin + // Navigate to previous or next existant clicked node + Result := nil; + for i:=High(FTreeClickHistory) downto Low(FTreeClickHistory) do begin + if MayBeNil or (FTreeClickHistory[i] <> nil) then begin + Result := FTreeClickHistory[i]; + break; + end; + end; +end;} + + +{procedure TMainForm.ConnectionReady(Connection: TDBConnection; Database: String); +begin + // Manually trigger changed focused tree node, to display the right server vendor + // and version. Also required on reconnects. + DBtree.OnFocusChanged(DBtree, DBtree.FocusedNode, DBtree.FocusedColumn); +end;} + + +{procedure TMainForm.DatabaseChanged(Connection: TDBConnection; Database: String); +begin + // Immediately force db icons to repaint, so the user sees the active db state + DBtree.Repaint; + + // Clear Filter issue 3466 + FFilterTextDatabase := ''; + + if QueryTabs.ActiveHelpersTree <> nil then + QueryTabs.ActiveHelpersTree.Invalidate; +end;} + + +{procedure TMainForm.ObjectnamesChanged(Connection: TDBConnection; Database: String); +var + DBObjects: TDBObjectList; + Obj: TDBObject; + TableNames, ProcNames: TStringList; +begin + // Tell SQL highlighter about names of tables and procedures in selected database + if (ActiveConnection <> Connection) or (Database <> Connection.Database) then + Exit; + SynSQLSynUsed.TableNames.Clear; + SynSQLSynUsed.ProcNames.Clear; + if Connection.DbObjectsCached(Database) then begin + DBObjects := Connection.GetDBObjects(Database); + TableNames := TStringList.Create; + TableNames.BeginUpdate; + ProcNames := TStringList.Create; + ProcNames.BeginUpdate; + for Obj in DBObjects do begin + case Obj.NodeType of + lntTable, lntView: begin + // Slow highlighter enhanced by uschuster. See http://www.heidisql.com/forum.php?t=16307 + // ... and here: https://github.com/SynEdit/SynEdit/issues/28 + TableNames.Add(Obj.Name); + end; + lntProcedure, lntFunction: begin + ProcNames.Add(Obj.Name); + end; + end; + end; + TableNames.EndUpdate; + ProcNames.EndUpdate; + SynSQLSynUsed.TableNames.Text := TableNames.Text; + SynSQLSynUsed.ProcNames.Text := ProcNames.Text; + TableNames.Free; + ProcNames.Free; + end; +end;} + + +{procedure TMainForm.DBtreeDblClick(Sender: TObject); +var + DBObj: PDBObject; + m: TSynMemo; +begin + // Paste DB or table name into query window on treeview double click. + if AppSettings.ReadBool(asDoubleClickInsertsNodeText) and QueryTabs.HasActiveTab and Assigned(DBtree.FocusedNode) then begin + DBObj := DBtree.GetNodeData(DBtree.FocusedNode); + if DBObj.NodeType in [lntDb, lntTable..lntEvent] then begin + m := QueryTabs.ActiveMemo; + m.DragDrop(Sender, m.CaretX, m.CaretY); + end; + end; +end;} + + +{procedure TMainForm.DBtreeExpanded(Sender: TBaseVirtualTree; + Node: PVirtualNode); +begin + // Table and database filter both need initialized children + Sender.ReinitChildren(Node, False); + editDatabaseTableFilterChange(Self); +end;} + + +{procedure TMainForm.DBtreeExpanding(Sender: TBaseVirtualTree; + Node: PVirtualNode; var Allowed: Boolean); +var + DBObj: PDBObject; + GNode: PVirtualNode; +begin + // Auto-init children of sibling groups + DBObj := Sender.GetNodeData(Node); + if DBObj.NodeType = lntGroup then begin + GNode := Sender.GetFirstChild(Node.Parent); + while Assigned(GNode) do begin + if not Sender.ChildrenInitialized[GNode] then begin + Sender.ReinitChildren(GNode, False); + end; + GNode := Sender.GetNextSibling(GNode); + end; + end; +end;} + + +{procedure TMainForm.DBtreePaintText(Sender: TBaseVirtualTree; const + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: + TVSTTextType); +var + DBObj: PDBObject; + WalkNode: PVirtualNode; +begin + // Grey out non-current connection nodes, and rather unimportant "Size" column + DBObj := Sender.GetNodeData(Node); + if DBObj.Connection <> ActiveConnection then + TargetCanvas.Font.Color := clGrayText + else if (Column = 1) and (DBObj.NodeType in [lntTable..lntEvent]) then + TargetCanvas.Font.Color := clGrayText; + + // Set bold text if painted node is in focused path + if (Column = Sender.Header.MainColumn) then begin + WalkNode := Sender.FocusedNode; + while Assigned(WalkNode) do begin + if WalkNode = Node then begin + TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]; + Break; + end; + try + // This crashes in some situations, which I could never reproduce. + // See uploaded crash reports and issue #1270. + WalkNode := Sender.NodeParent[WalkNode]; + except + on E:EAccessViolation do begin + LogSQL('DBtreePaintText, NodeParent: '+E.Message, lcError); + Break; + end; + end; + end; + end; +end;} + + +{** + Refresh the whole tree +} +{procedure TMainForm.RefreshTree(FocusNewObject: TDBObject=nil); +var + DBNode: PVirtualNode; + OnlyDBNode, Expanded: Boolean; + SessNode: PVirtualNode; +begin + // This refreshes exactly one session node and all its db and table nodes. + // Also, tries to focus the previous focused object, if present. + + // Object editors call RefreshTree in order to make a just created object visible: + OnlyDBNode := FocusNewObject <> nil; + + // Remember currently selected object + if FocusNewObject = nil then begin + FocusNewObject := TDBObject.Create(ActiveConnection); + if FActiveDbObj <> nil then + FocusNewObject.Assign(FActiveDbObj); + end; + + // ReInit tree population + FTreeRefreshInProgress := True; + SelectNode(DBtree, nil); + try + if not OnlyDBNode then begin + FocusNewObject.Connection.ClearAllDbObjects; + FocusNewObject.Connection.RefreshAllDatabases; + SessNode := GetRootNode(DBtree, FocusNewObject.Connection); + if Assigned(SessNode) then begin + Expanded := DBtree.Expanded[SessNode]; + DBtree.ResetNode(SessNode); + DBtree.Expanded[SessNode] := Expanded; + end; + end else begin + FocusNewObject.Connection.ClearDbObjects(FocusNewObject.Database); + DBNode := FindDbNode(DBtree, FocusNewObject.Connection, FocusNewObject.Database); + if Assigned(DBNode) then + DBtree.ResetNode(DBNode); + end; + + // Reselect active or new database if present. Could have been deleted or renamed. + try + if FocusNewObject.NodeType in [lntTable..lntEvent] then + ActiveDBObj := FocusNewObject; + if not Assigned(DBtree.FocusedNode) then + SetActiveDatabase(FocusNewObject.Database, FocusNewObject.Connection); + if not Assigned(DBtree.FocusedNode) then + SetActiveDatabase('', FocusNewObject.Connection); + except + end; + if not Assigned(DBtree.FocusedNode) then + raise Exception.Create(_('Could not find node to focus.')); + + finally + FTreeRefreshInProgress := False; + // Tree node filtering needs a hit in special cases, e.g. after a db was dropped + if editDatabaseFilter.Text <> '' then + editDatabaseFilter.OnChange(editDatabaseFilter); + if editTableFilter.Text <> '' then + editTableFilter.OnChange(editTableFilter); + if editFilterVT.Text <> '' then + ApplyVTFilter(False); + end; +end;} + + +{** + Find a database node in the tree by passing its name +} +{function TMainForm.FindDBNode(Tree: TBaseVirtualTree; Connection: TDBConnection; db: String): PVirtualNode; +var + DBObj: PDBObject; + n, DBNode: PVirtualNode; +begin + Result := nil; + n := GetRootNode(Tree, Connection); + DBNode := Tree.GetFirstChild(n); + while Assigned(DBNode) do begin + DBObj := Tree.GetNodeData(DBNode); + if DBObj.Database = db then begin + Result := DBNode; + Break; + end; + DBNode := Tree.GetNextSibling(DBNode); + end; +end;} + + +{** + Expand all db nodes +} +{procedure TMainForm.menuTreeExpandAllClick(Sender: TObject); +begin + DBtree.FullExpand; + DBtree.ScrollIntoView(DBtree.FocusedNode, False); +end;} + +{** + Collapse all db nodes +} +{procedure TMainForm.menuToggleAllClick(Sender: TObject); +var + Grid: TVirtualStringTree; + Col: TColumnIndex; + VisibleColCount: Integer; + DoHide, AllowHideAll: Boolean; +begin + // Toggle visibility of all columns in list + // Always leave one column visible, synced with poAllowHideAll from popupListHeader.Options + // Logsql(PopupComponent(Sender).Name+': '+PopupComponent(Sender).ClassName); + Grid := PopupComponent(Sender) as TVirtualStringTree; + + VisibleColCount := 0; + Col := Grid.Header.Columns.GetFirstColumn; + while Col > NoColumn do begin + if coVisible in Grid.Header.Columns[Col].Options then + Inc(VisibleColCount); + Col := Grid.Header.Columns.GetNextColumn(Col); + end; + DoHide := VisibleColCount = Grid.Header.Columns.Count; + AllowHideAll := poAllowHideAll in popupListHeader.Options; + + Col := Grid.Header.Columns.GetFirstColumn; + while Col > NoColumn do begin + if DoHide and ((Col <> Grid.Header.Columns.GetFirstColumn) or AllowHideAll) then + Grid.Header.Columns[Col].Options := Grid.Header.Columns[Col].Options - [coVisible] + else + Grid.Header.Columns[Col].Options := Grid.Header.Columns[Col].Options + [coVisible]; + Col := Grid.Header.Columns.GetNextColumn(Col); + end; + +end;} + +{procedure TMainForm.menuTreeCollapseAllClick(Sender: TObject); +var + n: PVirtualNode; + i: Integer; +begin + n := DBtree.GetFirstChild(DBtree.GetFirst); + for i := 0 to DBtree.GetFirst.ChildCount - 1 do begin + DBtree.FullCollapse(n); + n := DBtree.GetNextSibling(n); + end; + DBtree.ScrollIntoView(DBtree.FocusedNode, False); +end;} + + +{procedure TMainForm.editFilterSearchChange(Sender: TObject); +var + Clause, Line, Condition: String; + Conditions: TStringList; + i: Integer; + ed: TEdit; + Conn: TDBConnection; + rx: TRegExpr; +begin + ed := TEdit(Sender); + Clause := ''; + if ed.Text <> '' then begin + + Conn := ActiveConnection; + rx := TRegExpr.Create; + rx.ModifierI := True; + Conditions := TStringList.Create; + for i:=0 to SelectedTableColumns.Count-1 do begin + // The normal case: do a LIKE comparison + Condition := '''%' + Conn.EscapeString(ed.Text, True, False)+'%'''; + Condition := Conn.GetSQLSpecifity(spLikeCompare, [SelectedTableColumns[i].CastAsText, Condition]); + if not SelectedTableColumns[i].DataType.ValueMustMatch.IsEmpty then begin + // Use an exact comparison for some PostgreSQL data types to overcome SQL errors, e.g. UUID, INT etc. + // Also, prevent other errors by matching the value against a certain regular expression. + // If it does not match, leave this column away. + // See http://www.heidisql.com/forum.php?t=20953 + rx.Expression := SelectedTableColumns[i].DataType.ValueMustMatch; + if rx.Exec(ed.Text) then + Condition := Conn.QuoteIdent(SelectedTableColumns[i].Name) + '=' + Conn.EscapeString(ed.Text) + else + Condition := ''; + end; + if not Condition.IsEmpty then + Conditions.Add(Condition); + end; + rx.Free; + + Line := ''; + for i:=0 to Conditions.Count-1 do begin + if i > 0 then + Conditions[i] := ' OR ' + Conditions[i]; + // Add linebreak near right window edge + if (not Line.IsEmpty) and (Length(Line + Conditions[i]) >= SynMemoFilter.CharsInWindow-5) then begin + Clause := Clause + Line + sLineBreak; + Line := ''; + end; + Line := Line + Conditions[i]; + end; + Clause := Clause + Line + Conn.LikeClauseTail; + + end; + SynMemoFilter.UndoList.AddGroupBreak; + SynMemoFilter.SelectAll; + SynMemoFilter.SelText := Clause; +end;} + + +{procedure TMainForm.SynMemoFilterStatusChange(Sender: TObject; Changes: TSynStatusChanges); +var + TextHeight: Integer; + LineCount: Integer; + PanelHeight: Integer; +const + MinDisplayLineCount = 2; + MaxDisplayLineCount = 8; +begin + actClearFilterEditor.Enabled := (Sender as TSynMemo).GetTextLen > 0; + + LineCount := SynMemoFilter.DisplayLineCount; + LineCount := Min(LineCount, MaxDisplayLineCount); + LineCount := Max(LineCount, MinDisplayLineCount); + TextHeight := LineCount * SynMemoFilter.LineHeight + 10; + PanelHeight := pnlFilter.Height + (TextHeight - SynMemoFilter.Height); + PanelHeight := Max(PanelHeight, btnFilterApply.Top + btnFilterApply.Height + 5); + if PanelHeight <> pnlFilter.Height then + pnlFilter.Height := PanelHeight; +end;} + + +{procedure TMainForm.ToggleFilterPanel(ForceVisible: Boolean = False); +var + ShowIt: Boolean; +begin + ShowIt := ForceVisible or (not pnlFilter.Visible); + tbtnDataFilter.Down := ShowIt; + pnlFilter.Visible := ShowIt; +end;} + + +{procedure TMainForm.EnableDataTab(Enable: Boolean); +begin + // Disable data grid to prevent accessing results of disconnected sessions + // Also, no data for routines + DataGrid.Enabled := Enable; + pnlDataTop.Enabled := Enable; + pnlFilter.Enabled := Enable; + if Enable then + lblSorryNoData.Parent := tabData + else + lblSorryNoData.Parent := DataGrid; +end;} + + +{procedure TMainForm.editFilterSearchEnter(Sender: TObject); +begin + // Enables triggering apply button with Enter + btnFilterApply.Default := True; +end;} + + +{procedure TMainForm.editFilterSearchExit(Sender: TObject); +begin + btnFilterApply.Default := False; +end;} + + + +{** + A grid cell fetches its text content +} +{procedure TMainForm.AnyGridGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +var + EditingAndFocused, IsScientific: Boolean; + RowNumber: PInt64; + Results: TDBQuery; + Timestamp: Int64; + DotPos, i, NumZeros, NumDecimals, KeepDecimals: Integer; + ResultCol: Integer; +begin + if Column = -1 then + Exit; + if TextType <> ttNormal then + Exit; + ResultCol := Column - 1; + if ResultCol < 0 then begin + CellText := (Node.Index +1).ToString; + Exit; + end; + + EditingAndFocused := Sender.IsEditing and (Node = Sender.FocusedNode) and (Column = Sender.FocusedColumn); + Results := GridResult(Sender); + if (Results = nil) or (not Results.Connection.Active) then begin + EnableDataTab(False); + Exit; + end; + // Happens in some crashes, see issue #2462 + if ResultCol >= Results.ColumnCount then + Exit; + + RowNumber := Sender.GetNodeData(Node); + Results.RecNo := RowNumber^; + if Results.IsNull(ResultCol) and (not EditingAndFocused) then + CellText := TEXT_NULL + else begin + case Results.DataType(ResultCol).Category of + dtcInteger, dtcReal: begin + // This is a bit crappy... + // UNIX timestamps get *copied* as integers, but *displayed* and *edited* as date/time values. + // Normal integers are *copied* and *edited* as raw numbers, but probably *displayed* as formatted numbers. + if FGridCopying then begin + CellText := Results.Col(ResultCol); + end else if HandleUnixTimestampColumn(Sender, Column) then begin + try + Timestamp := Trunc(StrToFloat(Results.Col(ResultCol), FFormatSettings)); + Dec(Timestamp, FTimeZoneOffset); + CellText := DateTimeToStr(UnixToDateTime(Timestamp)); + except + // EConvertError in StrToFloat or EInvalidOp in Trunc or... + on E:Exception do begin + CellText := Results.Col(ResultCol); + LogSQL('Error when calculating Unix timestamp from "'+CellText+'": '+E.Message, lcError); + end; + end; + end else begin + CellText := Results.Col(ResultCol); + + // Keep only wanted number of trailing zeros after decimal separator + // Bug fixed: Do not cut trailing zeros in scientific values like 2.0e30 => 2.0e3 + if (Results.DataType(ResultCol).Category = dtcReal) and (AppSettings.ReadInt(asRealTrailingZeros) >= 0) then begin + DotPos := Pos('.', CellText); + IsScientific := ContainsText(CellText, 'e'); + if (not IsScientific) and (DotPos > 0) then begin + NumZeros := 0; + NumDecimals := 0; + for i:=DotPos+1 to Length(CellText) do begin + Inc(NumDecimals); + if CellText[i] = '0' then + Inc(NumZeros) + else + NumZeros := 0; + end; + KeepDecimals := Max(NumDecimals - NumZeros, AppSettings.ReadInt(asRealTrailingZeros)); + CellText := Copy(CellText, 1, Length(CellText) - (NumDecimals - KeepDecimals)); + if CellText[Length(CellText)] = '.' then + CellText := Copy(CellText, 1, Length(CellText)-1); + end; + end; + + if DataLocalNumberFormat and (not EditingAndFocused) then + CellText := FormatNumber(CellText, True); + end; + end; + dtcBinary, dtcSpatial: begin + if actBlobAsText.Checked then + CellText := Results.Col(ResultCol) + else + CellText := Results.HexValue(ResultCol, False); + end; + else begin + CellText := Results.Col(ResultCol); + if (Length(CellText) = GRIDMAXDATA) and (not Results.HasFullData) and (Sender = DataGrid) then + CellText := CellText + ' [...]'; + end; + end; + end; +end;} + + +{procedure TMainForm.CalcNullColors; +var + dtc: TDBDatatypeCategoryIndex; + h, l, s: Word; +begin + for dtc:=Low(DatatypeCategories) to High(DatatypeCategories) do begin + ColorRGBToHLS(DatatypeCategories[dtc].Color, h, l, s); + Inc(l, COLORSHIFT_NULLFIELDS); + s := Max(0, s-2*COLORSHIFT_NULLFIELDS); + DatatypeCategories[dtc].NullColor := ColorHLSToRGB(h, l, s); + end; +end;} + + +{** + Cell in data- or query grid gets painted. Colorize font. This procedure is + called extremely often for repainting the grid cells. Keep it highly optimized. +} +{procedure TMainForm.AnyGridPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); +var + cl: TColor; + r: TDBQuery; + RowNumber: PInt64; + ResultCol: Integer; +begin + if Column = NoColumn then + Exit; + ResultCol := Column - 1; + if ResultCol < 0 then begin + TargetCanvas.Font.Color := clGrayText; + //TargetCanvas.Font.Style := [TFontStyle.fsItalic]; + Exit; + end; + + r := GridResult(Sender); + RowNumber := Sender.GetNodeData(Node); + r.RecNo := RowNumber^; + + // Make primary key columns bold + if r.ColIsPrimaryKeyPart(ResultCol) then + TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]; + + // Do not apply any color on a selected, highlighted cell to keep readability + if (vsSelected in Node.States) and (Node = Sender.FocusedNode) and (Column = Sender.FocusedColumn) then + cl := GetThemeColor(clHighlightText) + else if r.IsNull(ResultCol) then + cl := DatatypeCategories[r.DataType(ResultCol).Category].NullColor + else + cl := DatatypeCategories[r.DataType(ResultCol).Category].Color; + TargetCanvas.Font.Color := cl; +end;} + + +{procedure TMainForm.AnyGridAfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); +var + Results: TDBQuery; + RowNum: PInt64; + ResultCol: Integer; +begin + // Don't waist time + if Column = NoColumn then + Exit; + ResultCol := Column - 1; + if ResultCol < 0 then + Exit; + // Paint a red triangle at the top left corner of the cell + Results := GridResult(Sender); + RowNum := Sender.GetNodeData(Node); + Results.RecNo := RowNum^; + if Results.Modified(ResultCol) then + VirtualImageListMain.Draw(TargetCanvas, CellRect.Left, CellRect.Top, 111); +end;} + + +{** + Header column in datagrid clicked. + Left button: handle ORDER BY + Right button: show column selection box +} +{procedure TMainForm.DataGridHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); +var + frm: TForm; + ColName: String; + SortItem: TSortItem; + SortOrder: TSortItemOrder; +begin + if HitInfo.Column = NoColumn then + Exit; + if HitInfo.Button = mbLeft then begin + // Header click disabled + if not AppSettings.ReadBool(asColumnHeaderClick) then + Exit; + ColName := Sender.Columns[HitInfo.Column].Text; + // Add a new order column after a columns title has been clicked + // Check if order column is already existant + SortItem := FDataGridSortItems.FindByColumn(ColName); + if Assigned(SortItem) then begin + // AddOrderCol is already in the list. Switch its direction: + // ASC > DESC > [delete col] + if SortItem.Order = sioAscending then + SortItem.Order := sioDescending + else + FDataGridSortItems.Remove(SortItem); + end + else begin + if KeyPressed(VK_SHIFT) then + SortOrder := sioDescending + else + SortOrder := sioAscending; + FDataGridSortItems.AddNew(ColName, SortOrder); + LogSQL('Created sorting for column '+ColName+'/'+Integer(SortOrder).ToString+' in TMainForm.DataGridHeaderClick', lcDebug); + end; + + // Refresh grid, and remember X scroll offset, so the just clicked column is still at the same place. + FDataGridLastClickedColumnHeader := HitInfo.Column; + FDataGridLastClickedColumnLeftPos := Sender.Columns[HitInfo.Column].Left; + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); + + end else begin + frm := TfrmColumnSelection.Create(Self); + // Position new form relative to btn's position + frm.Top := HitInfo.Y + DataGrid.ClientOrigin.Y - Integer(DataGrid.Header.Height); + frm.Left := HitInfo.X + DataGrid.ClientOrigin.X; + // Display form + frm.Show; + end; +end;} + + +{procedure TMainForm.actDataSetNullExecute(Sender: TObject); +var + RowNum: PInt64; + Grid: TVirtualStringTree; + Results: TDBQuery; +begin + // Set cell to NULL value + Grid := ActiveGrid; + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results := GridResult(Grid); + Results.RecNo := RowNum^; + try + Results.SetCol(Grid.FocusedColumn-1, '', True, False); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + Grid.RepaintNode(Grid.FocusedNode); + ValidateControls(Sender); +end;} + + +{procedure TMainForm.AnyGridMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; + MousePos: TPoint; var Handled: Boolean); +var + VT: TVirtualStringTree; + Node: PVirtualNode; + NewFontSize: Integer; +begin + VT := Sender as TVirtualStringTree; + if ssAlt in Shift then begin + // Advance to next or previous grid node on Shift+MouseWheel + if Assigned(VT.FocusedNode) then begin + if WheelDelta > 0 then + Node := VT.FocusedNode.PrevSibling + else + Node := VT.FocusedNode.NextSibling; + if Assigned(Node) then begin + SelectNode(VT, Node); + Handled := True; + end; + end; + end else if KeyPressed(VK_CONTROL) then begin + // Change font size with MouseWheel + if AppSettings.ReadBool(asWheelZoom) then begin + NewFontSize := VT.Font.Size; + if WheelDelta > 0 then + Inc(NewFontSize) + else + Dec(NewFontSize); + NewFontSize := Max(NewFontSize, 1); + AppSettings.ResetPath; + AppSettings.WriteInt(asDataFontSize, NewFontSize); + ApplyFontToGrids; + end; + end else if ssShift in Shift then begin + // Horizontal scrolling with Alt+Mousewheel + VT.OffsetX := VT.OffsetX + WheelDelta; + Handled := True; + end; +end;} + + +{** + Content of a grid cell was modified +} +{procedure TMainForm.AnyGridNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: String); +var + Results: TDBQuery; + RowNum: PInt64; + Timestamp: Int64; + IsNull: Boolean; + ResultCol: Integer; +begin + Results := GridResult(Sender); + if not Results.IsEditable then + Exit; + ResultCol := Column - 1; + RowNum := Sender.GetNodeData(Node); + Results.RecNo := RowNum^; + try + if (not FGridEditFunctionMode) and (Results.DataType(ResultCol).Category in [dtcInteger, dtcReal]) then begin + if HandleUnixTimestampColumn(Sender, Column) then begin + Timestamp := DateTimeToUnix(StrToDateTime(NewText)); + Inc(Timestamp, FTimeZoneOffset); + NewText := IntToStr(Timestamp) + end else + NewText := NewText; + end; + FClipboardHasNull := FClipboardHasNull and (Clipboard.TryAsText = ''); + IsNull := FGridPasting and FClipboardHasNull; + Results.SetCol(ResultCol, NewText, IsNull, FGridEditFunctionMode); + except + on E:EDbError do + ErrorDialog(E.Message); + end; + FGridEditFunctionMode := False; + ValidateControls(Sender); +end;} + + +{** + DataGrid: node and/or column focus is about to change. See if we allow that. +} +{procedure TMainForm.AnyGridFocusChanging(Sender: TBaseVirtualTree; OldNode, + NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: + Boolean); +var + Results: TDBQuery; + RowNum: PInt64; +begin + // Detect changed focus and update row + Allowed := True; + Results := GridResult(Sender); + if Assigned(OldNode) and (OldNode <> NewNode) then begin + RowNum := Sender.GetNodeData(OldNode); + Results.RecNo := RowNum^; + if Results.Modified then begin + Allowed := Results.SaveModifications; + DisplayRowCountStats(Sender); + end else if Results.Inserted then begin + if NewNode <> nil then begin + Results.DiscardModifications; + Sender.DeleteNode(OldNode); + end else begin + Allowed := False; + end; + end; + end; +end;} + + +{procedure TMainForm.AnyGridFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex); +begin + ValidateControls(Sender); + if Assigned(Node) and pnlPreview.Visible then + UpdatePreviewPanel; + // Vtree does not focus cell after tab pressing. See issue #3139. + // Most probably a missing thing / bug in TBaseVirtualTree.SetFocusedNodeAndColumn + Sender.ScrollIntoView(Sender.FocusedNode, False, True); + // Required for highlighting fields with same text + Sender.Invalidate; +end;} + + +{procedure TMainForm.AnyGridChange(Sender: TBaseVirtualTree; Node: PVirtualNode); +begin + // Ensure "delete row" button state is valid, see issue #624 + ValidateControls(Sender); + UpdateLineCharPanel; +end;} + + +{procedure TMainForm.AnyGridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); +var + g: TVirtualStringTree; +begin + g := TVirtualStringTree(Sender); + case Key of + VK_HOME: begin + g.FocusedColumn := g.Header.Columns.GetFirstVisibleColumn(True); + if ssCtrl in Shift then begin + // VT itself focuses the first node since v7.0 + end else + Key := 0; + end; + VK_END: begin + g.FocusedColumn := g.Header.Columns.GetLastVisibleColumn(True); + if ssCtrl in Shift then begin + if g = DataGrid then + actDataShowAll.Execute; + // VT itself focuses the last node since v7.0 + end else begin + Key := 0; + end; + end; + VK_RETURN: if Assigned(g.FocusedNode) then g.EditNode(g.FocusedNode, g.FocusedColumn); + VK_DOWN: if g.FocusedNode = g.GetLast then actDataInsertExecute(actDataInsert); + VK_NEXT: if (g = DataGrid) and (g.FocusedNode = g.GetLast) then actDataShowNext.Execute; + end; +end;} + + +{procedure TMainForm.AnyGridEditing(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); +begin + Allowed := False; + try + if not AnyGridEnsureFullRow(Sender as TVirtualStringTree, Node) then + ErrorDialog(_('Could not load full row data.')) + else begin + Allowed := True; + // Move Esc shortcut from "Cancel row editing" to "Cancel cell editing" + actDataCancelChanges.ShortCut := 0; + actDataPostChanges.ShortCut := 0; + end; + except on E:EDbError do + ErrorDialog(_('Grid editing error'), E.Message); + end; +end;} + +{procedure TMainForm.AnyGridEdited(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex); +begin + // Reassign Esc to "Cancel row editing" action + if ([tsEditing, tsEditPending] * Sender.TreeStates) = [] then begin + actDataCancelChanges.ShortCut := TextToShortcut('Esc'); + actDataPostChanges.ShortCut := TextToShortcut('Ctrl+Enter'); + end; +end;} + +{procedure TMainForm.AnyGridEditCancelled(Sender: TBaseVirtualTree; Column: + TColumnIndex); +begin + // Reassign Esc to "Cancel row editing" action + actDataCancelChanges.ShortCut := TextToShortcut('Esc'); + actDataPostChanges.ShortCut := TextToShortcut('Ctrl+Enter'); +end;} + +{procedure TMainForm.AnyGridCreateEditor(Sender: TBaseVirtualTree; Node: + PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); +const + ForeignItemsLimit: Integer = 10000; +var + VT: TVirtualStringTree; + HexEditor: THexEditorLink; + DateTimeEditor: TDateTimeEditorLink; + EnumEditor: TEnumEditorLink; + SetEditor: TSetEditorLink; + InplaceEditor: TInplaceEditorLink; + TypeCat: TDBDatatypeCategoryIndex; + ForeignKey: TForeignKey; + TblColumn: TTableColumn; + idx, MicroSecondsPrecision: Integer; + KeyCol, TextCol, SQL, NowText: String; + Columns: TTableColumnList; + ForeignResults, Results: TDBQuery; + Conn: TDBConnection; + RowNum: PInt64; + RefObj: TDBObject; + AllowEdit, DisplayHex: Boolean; + SQLFunc: TSQLFunction; + ResultCol: Integer; +begin + VT := Sender as TVirtualStringTree; + Results := GridResult(VT); + RowNum := VT.GetNodeData(Node); + Results.RecNo := RowNum^; + ResultCol := Column - 1; + Conn := Results.Connection; + // Allow editing, or leave readonly mode + AllowEdit := Results.IsEditable; + TblColumn := Results.ColAttributes(ResultCol); + + // Find foreign key values + if AppSettings.ReadBool(asForeignDropDown) and (Sender = DataGrid) then begin + for ForeignKey in SelectedTableForeignKeys do begin + idx := ForeignKey.Columns.IndexOf(DataGrid.Header.Columns[Column].Text); + if idx > -1 then try + // Find the first text column if available and use that for displaying in the pulldown instead of using meaningless id numbers + RefObj := ForeignKey.ReferenceTableObj; + if not Assigned(RefObj) then + Continue; + + TextCol := ''; + Columns := RefObj.TableColumns; + for TblColumn in Columns do begin + if (TblColumn.DataType.Category = dtcText) and (TblColumn.Name <> ForeignKey.ForeignColumns[idx]) then begin + TextCol := TblColumn.Name; + break; + end; + end; + + KeyCol := Conn.QuoteIdent(ForeignKey.ForeignColumns[idx]); + if TextCol <> '' then begin + SQL := KeyCol+', ' + Conn.GetSQLSpecifity(spFuncLeft, [Conn.QuoteIdent(TextCol), 256])+ + ' FROM ' + RefObj.QuotedDbAndTableName + + ' GROUP BY '+KeyCol+', '+Conn.QuoteIdent(TextCol)+ // MSSQL complains if the text columns is not grouped + ' ORDER BY '+Conn.QuoteIdent(TextCol); + end else begin + SQL := KeyCol+ + ' FROM ' + RefObj.QuotedDbAndTableName + + ' GROUP BY '+KeyCol+ + ' ORDER BY '+KeyCol; + end; + SQL := Conn.ApplyLimitClause('SELECT', SQL, ForeignItemsLimit, 0); + + ForeignResults := Conn.GetResults(SQL); + if ForeignResults.RecordCount < ForeignItemsLimit then begin + EnumEditor := TEnumEditorLink.Create(VT, AllowEdit, TblColumn); + EditLink := EnumEditor; + DisplayHex := (not actBlobAsText.Checked) and (ForeignResults.DataType(0).Category in [dtcBinary, dtcSpatial]); + while not ForeignResults.Eof do begin + if DisplayHex then + EnumEditor.ValueList.Add(ForeignResults.HexValue(0)) + else + EnumEditor.ValueList.Add(ForeignResults.Col(0)); + if TextCol <> '' then begin + if DisplayHex then + EnumEditor.DisplayList.Add(ForeignResults.HexValue(0)+': '+ForeignResults.Col(1)) + else + EnumEditor.DisplayList.Add(ForeignResults.Col(0)+': '+ForeignResults.Col(1)); + end; + ForeignResults.Next; + end; + end else begin + LogSQL(f_('Connected table has too many rows. Foreign key drop-down is limited to %d items.', [ForeignItemsLimit]), lcInfo); + end; + ForeignResults.Free; + break; + except on E:EDbError do + // Error gets logged, do nothing more here. All other exception types raise please. + end; + end; + end; + + FGridEditFunctionMode := FGridEditFunctionMode or Results.IsFunction(ResultCol); + if FGridEditFunctionMode then begin + EnumEditor := TEnumEditorLink.Create(VT, AllowEdit, TblColumn); + for SQLFunc in Conn.SQLFunctions do + EnumEditor.ValueList.Add(SQLFunc.Name + SQLFunc.Declaration); + EnumEditor.AllowCustomText := True; + EditLink := EnumEditor; + end; + + TypeCat := Results.DataType(ResultCol).Category; + + if Assigned(EditLink) then + // Editor was created above, do nothing now + else if (Results.DataType(ResultCol).Index in [dbdtEnum, dbdtBool]) and AppSettings.ReadBool(asFieldEditorEnum) then begin + EnumEditor := TEnumEditorLink.Create(VT, AllowEdit, TblColumn); + EnumEditor.ValueList := Results.ValueList(ResultCol); + EditLink := EnumEditor; + end else if (TypeCat = dtcText) or ((TypeCat in [dtcBinary, dtcSpatial]) and actBlobAsText.Checked) then begin + InplaceEditor := TInplaceEditorLink.Create(VT, AllowEdit, TblColumn); + InplaceEditor.MaxLength := Results.MaxLength(ResultCol); + InplaceEditor.TitleText := Results.ColumnOrgNames[ResultCol]; + InplaceEditor.ButtonVisible := True; + EditLink := InplaceEditor; + end else if (TypeCat in [dtcBinary, dtcSpatial]) and AppSettings.ReadBool(asFieldEditorBinary) then begin + HexEditor := THexEditorLink.Create(VT, AllowEdit, TblColumn); + HexEditor.MaxLength := Results.MaxLength(ResultCol); + HexEditor.TitleText := Results.ColumnOrgNames[ResultCol]; + EditLink := HexEditor; + end else if (TypeCat = dtcTemporal) + and AppSettings.ReadBool(asFieldEditorDatetime) + and Assigned(TblColumn) // Editor crashes without a column object (on joins), see #1024 + then begin + // Ensure date/time editor starts with a non-empty text value + if (Results.Col(ResultCol) = '') and AppSettings.ReadBool(asFieldEditorDatetimePrefill) then begin + case Results.DataType(ResultCol).Index of + dbdtDate: NowText := DateToStr(Now); + dbdtTime: NowText := TimeToStr(Now); + // Add this case to prevent error with datatype year and sql_mode STRICT_TRANS_TABLES + // who absolutly want year and not date time + // http://www.heidisql.com/forum.php?t=14728 + dbdtYear: NowText := FormatDateTime('yyyy',Now); + else NowText := DateTimeToStr(Now); + end; + MicroSecondsPrecision := MakeInt(Results.ColAttributes(ResultCol).LengthSet); + // Don't generate MicroSecond when DataType is Year + if (MicroSecondsPrecision > 0) and (Results.DataType(ResultCol).Index <> dbdtYear ) then + NowText := NowText + '.' + StringOfChar('0', MicroSecondsPrecision); + VT.Text[Node, Column] := NowText; + end; + DateTimeEditor := TDateTimeEditorLink.Create(VT, AllowEdit, TblColumn); + EditLink := DateTimeEditor; + end else if AppSettings.ReadBool(asFieldEditorDatetime) + and HandleUnixTimestampColumn(Sender, Column) + and Assigned(TblColumn) // see above + then begin + DateTimeEditor := TDateTimeEditorLink.Create(VT, AllowEdit, TblColumn); + EditLink := DateTimeEditor; + end else if (Results.DataType(ResultCol).Index = dbdtSet) and AppSettings.ReadBool(asFieldEditorSet) then begin + SetEditor := TSetEditorLink.Create(VT, AllowEdit, TblColumn); + SetEditor.ValueList := Results.ValueList(ResultCol); + EditLink := SetEditor; + end else begin + InplaceEditor := TInplaceEditorLink.Create(VT, AllowEdit, TblColumn); + InplaceEditor.ButtonVisible := False; + EditLink := InplaceEditor; + end; + Sender.FocusedNode := Node; + Sender.FocusedColumn := Column; +end;} + + +{procedure TMainForm.menuShowSizeColumnClick(Sender: TObject); +var + Item: TMenuItem; +begin + if coVisible in DBtree.Header.Columns[1].Options then + DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options - [coVisible] + else + DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options + [coVisible]; + Item := Sender as TMenuItem; + Item.Checked := coVisible in DBtree.Header.Columns[1].Options; + AppSettings.ResetPath; + AppSettings.WriteBool(asDisplayObjectSizeColumn, Item.Checked); +end;} + + +{procedure TMainForm.menuAlwaysGenerateFilterClick(Sender: TObject); +begin + // Store setting for toggled filter generation + AppSettings.WriteBool(asAlwaysGenerateFilter, menuAlwaysGenerateFilter.Checked); +end;} + +{procedure TMainForm.menuAutoExpandClick(Sender: TObject); +var + Item: TMenuItem; +begin + // Activate expand on click tree feature + if toAutoExpand in DBtree.TreeOptions.AutoOptions then + DBtree.TreeOptions.AutoOptions := DBtree.TreeOptions.AutoOptions - [toAutoExpand] + else + DBtree.TreeOptions.AutoOptions := DBtree.TreeOptions.AutoOptions + [toAutoExpand]; + Item := Sender as TMenuItem; + Item.Checked := toAutoExpand in DBtree.TreeOptions.AutoOptions; + AppSettings.ResetPath; + AppSettings.WriteBool(asAutoExpand, Item.Checked); +end;} + + +{procedure TMainForm.actGroupObjectsExecute(Sender: TObject); +begin + // Group tree objects by type + RefreshTree(nil); +end;} + + +{procedure TMainForm.AutoCalcColWidth(Tree: TVirtualStringTree; Column: TColumnIndex); +var + Node: PVirtualNode; + i, ColTextWidth, ContentTextWidth: Integer; + Rect: TRect; + Col: TVirtualTreeColumn; +begin + // Find optimal default width for columns. Needs to be done late, after the SQL + // composing to enable text width calculation based on actual table content + // Weird: Fixes first time calculation always based on Tahoma/8pt font + Tree.Canvas.Font := Tree.Font; + Col := Tree.Header.Columns[Column]; + if not (coVisible in Col.Options) then + Exit; + ColTextWidth := Tree.Canvas.TextWidth(Col.Text); + // Add space for sort glyph + if Col.ImageIndex > -1 then + ColTextWidth := ColTextWidth + 20; + Node := Tree.GetFirstVisible; + // Go backwards 50 nodes from focused one if tree was scrolled + i := 0; + if Assigned(Tree.FocusedNode) then begin + Node := Tree.FocusedNode; + while Assigned(Node) do begin + inc(i); + if (Node = Tree.GetFirst) or (i > 50) then + break; + Node := Tree.GetPreviousVisible(Node); + end; + end; + i := 0; + while Assigned(Node) do begin + // Note: this causes the node to load, an exception can propagate + // here if the query or connection dies. + Rect := Tree.GetDisplayRect(Node, Column, True, True); + ContentTextWidth := Rect.Right - Rect.Left; + //if vsMultiLine in Node.States then + // ContentTextWidth := Max(ContentTextWidth, Tree.Canvas.TextWidth(Tree.Text[Node, Column])); + ColTextWidth := Max(ColTextWidth, ContentTextWidth); + inc(i); + if i > 100 then break; + // GetDisplayRect may have implicitely taken the node away. + // Strange that Node keeps being assigned though, probably a timing issue. + if Tree.RootNodeCount = 0 then break; + Node := Tree.GetNextVisible(Node); + end; + // text margins and minimal extra space + ColTextWidth := ColTextWidth + Tree.TextMargin*2 + 20; + ColTextWidth := Min(ColTextWidth, AppSettings.ReadInt(asMaxColWidth)); + Col.Width := ColTextWidth; +end;} + + +{procedure TMainForm.AnyGridBeforeCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); +var + r: TDBQuery; + cl, clNull, clSameData: TColor; + RowNumber: PInt64; + FocusedIsNull, CurrentIsNull: Boolean; + FieldText, FocusedFieldText: String; + VT: TVirtualStringTree; + ResultCol: Integer; +begin + if Column = -1 then + Exit; + ResultCol := Column -1; + + r := GridResult(Sender); + if (r=nil) or (not r.Connection.Active) then begin + // This event (BeforeCellPaint) is the very first one to notice a broken connection + Sender.Enabled := False; + Exit; + end; + + if ResultCol < 0 then begin + if r.Connection.Parameters.SessionColor <> AppSettings.GetDefaultInt(asTreeBackground) then + TargetCanvas.Brush.Color := r.Connection.Parameters.SessionColor + else + TargetCanvas.Brush.Color := clBtnFace; + TargetCanvas.FillRect(CellRect); + Exit; + end; + + VT := Sender as TVirtualStringTree; + RowNumber := Sender.GetNodeData(Node); + r.RecNo := RowNumber^; + + cl := GetAlternatingRowBackground(Node); + + if (vsSelected in Node.States) and (Node = Sender.FocusedNode) and (Column = Sender.FocusedColumn) then begin + // Focused cell + cl := GetThemeColor(clHighlight) + end else if vsSelected in Node.States then begin + // Selected but not focused cell + if VT.Color > ColorAdjustBrightness(clWhite, -29) then + cl := ColorAdjustBrightness(VT.Color, -29) + else + cl := ColorAdjustBrightness(VT.Color, 29); + end else if r.IsNull(ResultCol) then begin + // Cell with NULL value + clNull := AppSettings.ReadInt(asFieldNullBackground); + if clNull <> clNone then + cl := clNull; + end; + if cl <> clNone then begin + TargetCanvas.Brush.Color := cl; + TargetCanvas.FillRect(CellRect); + end; + + // Probably display background color on fields with same text + // Result pointer gets moved to the focused node.. careful! + if (Sender.FocusedNode <> nil) and (Sender.FocusedColumn > 0) then begin + if ((Node <> Sender.FocusedNode) and (Column = Sender.FocusedColumn)) + or ((Node = Sender.FocusedNode) and (Column <> Sender.FocusedColumn)) then begin + clSameData := AppSettings.ReadInt(asHightlightSameTextBackground); + if clSameData <> clNone then begin + FieldText := r.Col(ResultCol); + CurrentIsNull := r.IsNull(ResultCol); + RowNumber := Sender.GetNodeData(Sender.FocusedNode); + r.RecNo := RowNumber^; // moving result cursor + FocusedFieldText := r.Col(Sender.FocusedColumn-1); + FocusedIsNull := r.IsNull(Sender.FocusedColumn-1); + if (CompareText(FieldText, FocusedFieldText) = 0) and (CurrentIsNull = FocusedIsNull) then begin + TargetCanvas.Brush.Color := clSameData; + TargetCanvas.FillRect(CellRect); + end; + end; + end; + end; + +end;} + + +{procedure TMainForm.HandleDataGridAttributes(RefreshingData: Boolean); +var + rx: TRegExpr; + i: Integer; + Sort, KeyName, FocusedCol, CellFocus, Filter: String; + SortItem: TSortItem; +begin + actDataResetSorting.Enabled := False; + // Clear filter, column names and sort structure if gr + if not Assigned(DataGridHiddenColumns) then begin + DataGridHiddenColumns := TStringList.Create; + DataGridHiddenColumns.Delimiter := DELIM; + DataGridHiddenColumns.StrictDelimiter := True; + end; + if not Assigned(DataGridFocusedCell) then + DataGridFocusedCell := TStringList.Create; + // Remember focused node and column for selected table + if Assigned(DataGrid.FocusedNode) + and (ActiveConnection <> nil) + and (DataGridTable <> nil) + and Assigned(DataGridTable) + then begin + try + KeyName := DataGridTable.QuotedDatabase+'.'+DataGridTable.QuotedName; + FocusedCol := ''; + if DataGrid.FocusedColumn > NoColumn then + FocusedCol := DataGrid.Header.Columns[DataGrid.FocusedColumn].Text; + DataGridFocusedCell.Values[KeyName] := IntToStr(DataGrid.FocusedNode.Index) + DELIM + FocusedCol; + except + on E:EAccessViolation do begin + LogSQL('HandleDataGridAttributes: '+E.Message, lcError); + end; + end; + end; + DataGridFocusedNodeIndex := 0; + DataGridFocusedColumnName := ''; + KeyName := ActiveDbObj.QuotedDatabase+'.'+ActiveDbObj.QuotedName; + CellFocus := DataGridFocusedCell.Values[KeyName]; + if CellFocus <> '' then begin + DataGridFocusedNodeIndex := MakeInt(Explode(DELIM, CellFocus)[0]); + DataGridFocusedColumnName := Explode(DELIM, CellFocus)[1]; + end; + if not RefreshingData then begin + DataGridHiddenColumns.Clear; + SynMemoFilter.Clear; + FDataGridSortItems.Clear; + DataGridWantedRowCount := 0; + while DataGridFocusedNodeIndex >= DataGridWantedRowCount do + Inc(DataGridWantedRowCount, AppSettings.ReadInt(asDatagridRowsPerStep)); + end else begin + // Save current attributes if grid gets refreshed + AppSettings.SessionPath := GetRegKeyTable; + if DataGridHiddenColumns.Count > 0 then + AppSettings.WriteString(asHiddenColumns, DataGridHiddenColumns.DelimitedText) + else if AppSettings.ValueExists(asHiddenColumns) then + AppSettings.DeleteValue(asHiddenColumns); + + if SynMemoFilter.GetTextLen > 0 then + AppSettings.WriteString(asFilter, SynMemoFilter.Text) + else if AppSettings.ValueExists(asFilter) then + AppSettings.DeleteValue(asFilter); + + Sort := ''; + for SortItem in FDataGridSortItems do begin + Sort := Sort + IntToStr(Integer(SortItem.Order)) + '_' + SortItem.Column + DELIM; + end; + if Sort <> '' then + AppSettings.WriteString(asSort, Sort) + else if AppSettings.ValueExists(asSort) then + AppSettings.DeleteValue(asSort); + end; + + // Auto remove registry spam if table folder is empty + if AppSettings.SessionPathExists(GetRegKeyTable) then begin + AppSettings.SessionPath := GetRegKeyTable; + if AppSettings.IsEmptyKey then + AppSettings.DeleteCurrentKey; + end; + + // Do nothing if table was not filtered yet + if not AppSettings.SessionPathExists(GetRegKeyTable) then + Exit; + + // Columns + if AppSettings.ValueExists(asHiddenColumns) then + DataGridHiddenColumns.DelimitedText := AppSettings.ReadString(asHiddenColumns); + + // Set filter, without changing cursor position + if AppSettings.ValueExists(asFilter) then begin + Filter := AppSettings.ReadString(asFilter); + if SynMemoFilter.Text <> Filter then begin + SynMemoFilter.Text := Filter; + SynMemoFilter.Modified := True; + end; + if SynMemoFilter.GetTextLen > 0 then + ToggleFilterPanel(True); + end; + + // Sort + if AppSettings.ValueExists(asSort) then begin + FDataGridSortItems.Clear; + rx := TRegExpr.Create; + rx.Expression := '\b(\d)_(.+)\'+DELIM; + rx.ModifierG := False; + if rx.Exec(AppSettings.ReadString(asSort)) then while true do begin + // Check if column exists, could be renamed or deleted + for i:=0 to SelectedTableColumns.Count-1 do begin + if SelectedTableColumns[i].Name = rx.Match[2] then begin + SortItem := FDataGridSortItems.AddNew; + SortItem.Column := rx.Match[2]; + SortItem.Order := TSortItemOrder(StrToIntDef(rx.Match[1], 0)); + LogSQL('Restored sorting for column '+SortItem.Column+'/'+Integer(SortItem.Order).ToString+' in TMainForm.HandleDataGridAttributes', lcDebug); + Break; + end; + end; + if not rx.ExecNext then + break; + end; + actDataResetSorting.Enabled := FDataGridSortItems.Count > 0; + end; + + AppSettings.ResetPath; +end;} + + +{function TMainForm.GetRegKeyTable: String; +begin + // Return the slightly complex registry path to \Servers\CustomFolder\ActiveServer\curdb|curtable + Result := ActiveDbObj.Connection.Parameters.SessionPath + '\' + + ActiveDatabase + DELIM + ActiveDbObj.Name; +end;} + + +{procedure TMainForm.AnyGridMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + Grid: TVirtualStringTree; + Hit: THitInfo; + Results: TDBQuery; +begin + // Detect mouse hit in grid whitespace and apply changes. + Grid := Sender as TVirtualStringTree; + if not Assigned(Grid.FocusedNode) then + Exit; + Grid.GetHitTestInfoAt(X, Y, False, Hit); + if (Hit.HitNode = nil) or (Hit.HitColumn = NoColumn) or (Hit.HitColumn = InvalidColumn) then begin + Results := GridResult(Grid); + if Results.Modified then begin + Results.SaveModifications; + DisplayRowCountStats(Grid); + end; + end; +end;} + + +{procedure TMainForm.ListDatabasesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); +var + vt: TVirtualStringTree; + i: Integer; + Conn: TDBConnection; +begin + // Invalidate list of databases, before (re)painting + vt := Sender as TVirtualStringTree; + if vt.Tag = VTREE_LOADED then + Exit; + Conn := ActiveConnection; + Screen.Cursor := crHourglass; + vt.Clear; + if Conn <> nil then begin + if vt.Tag = VTREE_NOTLOADED_PURGECACHE then begin + for i:=0 to Conn.AllDatabases.Count-1 do begin + if Conn.DbObjectsCached(Conn.AllDatabases[i]) then begin + if Conn.AllDatabases[i] = ActiveDatabase then + RefreshTree + else + Conn.GetDBObjects(Conn.AllDatabases[i], True); + end; + end; + end; + vt.RootNodeCount := Conn.AllDatabases.Count; + end; + tabDatabases.Caption := _('Databases') + ' ('+FormatNumber(vt.RootNodeCount)+')'; + vt.Tag := VTREE_LOADED; + Screen.Cursor := crDefault; +end;} + + +{procedure TMainForm.ListDatabasesDblClick(Sender: TObject); +begin + // Select database on doubleclick + // TODO: Have DBObjects bound to ListDatabases, so we can sort nodes without breaking references + if Assigned(ListDatabases.FocusedNode) then + SetActiveDatabase(ListDatabases.Text[ListDatabases.FocusedNode, 0], ActiveConnection); +end;} + + +{procedure TMainForm.ListDatabasesGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); +var + db: String; + Conn: TDBConnection; +begin + // Return icon index for databases. Ghosted if db objects not yet in cache. + if Column <> (Sender as TVirtualStringTree).Header.MainColumn then + Exit; + Conn := ActiveConnection; + db := ListDatabases.Text[Node, 0]; + case Kind of + ikNormal, ikSelected: ImageIndex := ICONINDEX_DB; + ikOverlay: if db = Conn.Database then ImageIndex := ICONINDEX_HIGHLIGHTMARKER; + end; + Ghosted := not Conn.DbObjectsCached(db); +end;} + + +{procedure TMainForm.ListDatabasesGetNodeDataSize(Sender: TBaseVirtualTree; + var NodeDataSize: Integer); +begin + // Tell VirtualTree we're using a simple integer as data + NodeDataSize := SizeOf(Int64); +end;} + + +{procedure TMainForm.ListDatabasesInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; + var InitialStates: TVirtualNodeInitStates); +var + Idx: PInt; +begin + // Integers mapped to the node's index so nodes can be sorted without losing their database name + Idx := Sender.GetNodeData(Node); + Idx^ := Node.Index; +end;} + + +{procedure TMainForm.ListDatabasesGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +var + Idx: PInt; + Objects: TDBObjectList; + DBname: String; + Conn: TDBConnection; + + function GetItemCount(ItemType: TListNodeType): String; + var + c: Integer; + o: TDBObject; + begin + if Objects <> nil then begin + c := 0; + for o in Objects do begin + if (ItemType = lntNone) or (o.NodeType = ItemType) then + Inc(c); + end; + Result := FormatNumber(c); + end else + Result := ''; + end; + +begin + // Return text for database columns + Idx := Sender.GetNodeData(Node); + + Conn := ActiveConnection; + if Idx^ < Conn.AllDatabases.Count then begin + DBname := Conn.AllDatabases[Idx^]; + end else begin + // Probably a database were dropped shortly before. + DBname := ''; + end; + if Conn.DbObjectsCached(DBname) then + Objects := Conn.GetDBObjects(DBname) + else + Objects := nil; + CellText := ''; + case Column of + 0: CellText := DBname; + 1: if Assigned(Objects) then CellText := FormatByteNumber(Objects.DataSize); + 2: CellText := GetItemCount(lntNone); + 3: if Assigned(Objects) and (Objects.LastUpdate > 0) then CellText := DateTimeToStr(Objects.LastUpdate); + 4: CellText := GetItemCount(lntTable); + 5: CellText := GetItemCount(lntView); + 6: CellText := GetItemCount(lntFunction); + 7: CellText := GetItemCount(lntProcedure); + 8: CellText := GetItemCount(lntTrigger); + 9: CellText := GetItemCount(lntEvent); + 10: if Assigned(Objects) then CellText := Objects.Collation; + end; + +end;} + + +{procedure TMainForm.HostListBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); +var + vt: TVirtualStringTree; + OldOffset: TPoint; + Conn: TDBConnection; + Tab: TTabSheet; + Results, Variables: TDBQuery; + i: Integer; + SelectedCaptions: TStringList; + IS_objects: TDBObjectList; + Obj: TDBObject; + ProcessColumns: TTableColumnList; + Columns, FocusedCaption, CleanTabCaption: String; + Col: TVirtualTreeColumn; + LeaveEnabled: Boolean; + ActiveNetType: String; +begin + // Display server variables + vt := Sender as TVirtualStringTree; + if vt.Tag = VTREE_LOADED then + Exit; + Tab := vt.Parent as TTabSheet; + Conn := ActiveConnection; + + // Status + command statistics only available in MySQL, most others also not available in SQLite + LeaveEnabled := False; + ActiveNetType := _('unknown'); + if Conn <> nil then begin + if vt = ListDatabases then + LeaveEnabled := True + else if vt = ListVariables then + LeaveEnabled := Conn.Parameters.NetTypeGroup in [ngMySQL, ngMSSQL, ngPgSQL] + else if vt = ListStatus then + LeaveEnabled := Conn.Parameters.NetTypeGroup in [ngMySQL] + else if vt = ListProcesses then + LeaveEnabled := Conn.Parameters.NetTypeGroup in [ngMySQL, ngMSSQL, ngPgSQL] + else if vt = ListCommandStats then + LeaveEnabled := Conn.Parameters.NetTypeGroup in [ngMySQL]; + ActiveNetType := Conn.Parameters.NetTypeName(False); + end; + if not LeaveEnabled then begin + vt.Clear; + vt.EmptyListMessage := f_('Not available on %s', [ActiveNetType]); + vt.Tag := VTREE_LOADED; + Exit; + end; + + SelectedCaptions := TStringList.Create; + GetVTSelection(vt, SelectedCaptions, FocusedCaption); + SelectNode(vt, nil); + vt.BeginUpdate; + OldOffset := vt.OffsetXY; + vt.Clear; + Screen.Cursor := crHourglass; + + if Conn <> nil then try + Results := GridResult(vt); + if Results <> nil then + FreeAndNil(Results); + if vt = ListVariables then begin + // Do not use FHostListResults on Variables tab, as we cannot query + // session and global variables in one query + Results := nil; + FreeAndNil(FVariableNames); + FreeAndNil(FSessionVars); + FreeAndNil(FGlobalVars); + FVariableNames := TStringList.Create; + FVariableNames.Duplicates := dupIgnore; + FVariableNames.Sorted := True; + FSessionVars := TStringList.Create; + FGlobalVars := TStringList.Create; + Variables := Conn.GetResults(Conn.GetSQLSpecifity(spSessionVariables)); + while not Variables.Eof do begin + FVariableNames.Add(Variables.Col(0)); + FSessionVars.Values[Variables.Col(0)] := Variables.Col(1); + Variables.Next; + end; + Variables.Free; + Variables := Conn.GetResults(Conn.GetSQLSpecifity(spGlobalVariables)); + while not Variables.Eof do begin + FVariableNames.Add(Variables.Col(0)); + FGlobalVars.Values[Variables.Col(0)] := Variables.Col(1); + Variables.Next; + end; + Variables.Free; + vt.RootNodeCount := FVariableNames.Count; + end else if vt = ListStatus then begin + Results := Conn.GetResults(Conn.GetSQLSpecifity(spGlobalStatus)); + FStatusServerUptime := Conn.ServerUptime; + end else if vt = ListProcesses then begin + case Conn.Parameters.NetTypeGroup of + ngMySQL: begin + if Conn.InformationSchemaObjects.IndexOf('PROCESSLIST') > -1 then begin + // Minimize network traffic on newer servers by fetching only first KB of SQL query in "Info" column + Columns := Conn.QuoteIdent('ID')+', '+ + Conn.QuoteIdent('USER')+', '+ + Conn.QuoteIdent('HOST')+', '+ + Conn.QuoteIdent('DB')+', '+ + Conn.QuoteIdent('COMMAND')+', '+ + Conn.QuoteIdent('TIME')+', '+ + Conn.QuoteIdent('STATE')+', '+ + 'LEFT('+Conn.QuoteIdent('INFO')+', '+IntToStr(SIZE_KB*50)+') AS '+Conn.QuoteIdent('Info'); + // Get additional column names into SELECT query and ListProcesses tree + IS_objects := Conn.GetDBObjects(Conn.InfSch); + for Obj in IS_objects do begin + if Obj.Name = 'PROCESSLIST' then begin + ProcessColumns := Obj.TableColumns; + for i:=8 to ProcessColumns.Count-1 do begin + Columns := Columns + ', '+Conn.QuoteIdent(ProcessColumns[i].Name); + if ListProcesses.Header.Columns.Count <= i then + Col := ListProcesses.Header.Columns.Add + else + Col := ListProcesses.Header.Columns[i]; + Col.Options := Col.Options + [coVisible]; + Col.Text := ProcessColumns[i].Name; + end; + // Hide unused tree columns + for i:=ListProcesses.Header.Columns.Count-1 downto ProcessColumns.Count do + ListProcesses.Header.Columns[i].Options := ListProcesses.Header.Columns[i].Options - [coVisible]; + ProcessColumns.Free; + break; + end; + end; + Results := Conn.GetResults('SELECT '+Columns+' FROM '+ + Conn.QuoteIdent(Conn.InfSch)+'.'+Conn.QuoteIdent('PROCESSLIST')); + end else begin + // Older servers fetch the whole query length, but at least we cut them off below, so a high memory usage is just a peak + Results := Conn.GetResults('SHOW FULL PROCESSLIST'); + end; + end; + ngMSSQL: begin + Results := Conn.GetResults('SELECT '+ + Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('spid')+ + ', RTRIM('+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('loginame')+') AS '+Conn.QuoteIdent('loginname')+ + ', RTRIM('+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('hostname')+') AS '+Conn.QuoteIdent('hostname')+ + ', '+Conn.QuoteIdent('d')+'.'+Conn.QuoteIdent('name')+ + ', '+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('cmd')+ + ', '+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('waittime')+ + ', RTRIM('+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('status')+'), '+ + 'NULL AS '+Conn.QuoteIdent('Info')+' '+ + 'FROM '+Conn.QuoteIdent('sys')+'.'+Conn.QuoteIdent('sysprocesses')+' AS '+Conn.QuoteIdent('p')+ + ', '+Conn.GetSQLSpecifity(spDatabaseTable)+' AS '+Conn.QuoteIdent('d')+ + ' WHERE '+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('dbid')+'='+Conn.QuoteIdent('d')+'.'+Conn.GetSQLSpecifity(spDatabaseTableId) + ); + end; + ngPgSQL: begin + Results := Conn.GetResults('SELECT '+ + Conn.QuoteIdent('pid')+ + ', '+Conn.QuoteIdent('usename')+ + ', '+Conn.QuoteIdent('client_addr')+ + ', '+Conn.QuoteIdent('datname')+ + ', application_name '+ + ', EXTRACT(EPOCH FROM CURRENT_TIMESTAMP - '+Conn.QuoteIdent('query_start')+')::INTEGER'+ + ', '+Conn.QuoteIdent('state')+ + ', '+Conn.QuoteIdent('query')+ + ' FROM '+Conn.QuoteIdent('pg_stat_activity') + ); + end; + else begin + raise Exception.CreateFmt(_(MsgUnhandledNetType), [Integer(Conn.Parameters.NetType)]); + end; + end; + FProcessListMaxTime := 1; + for i:=0 to Results.RecordCount-1 do begin + FProcessListMaxTime := Max(FProcessListMaxTime, MakeInt(Results.Col(5))); + Results.Next; + end; + end else if vt = ListCommandStats then begin + Results := Conn.GetResults(Conn.GetSQLSpecifity(spCommandsCounters)); + FCommandStatsServerUptime := Conn.ServerUptime; + FCommandStatsQueryCount := 0; + while not Results.Eof do begin + Inc(FCommandStatsQueryCount, MakeInt(Results.Col(1))); + Results.Next; + end; + end; + + FHostListResults[Tab.PageIndex] := Results; + if Results <> nil then + vt.RootNodeCount := Results.RecordCount; + vt.OffsetXY := OldOffset; + except + on E:Exception do ErrorDialog(E.Message); + end; + + Screen.Cursor := crDefault; + // Apply or reset filter + editFilterVTChange(Sender); + vt.EndUpdate; + vt.Tag := VTREE_LOADED; + // Display number of listed values on tab + CleanTabCaption := RegExprGetMatch('^([^\(]+)', Tab.Caption, 1); + Tab.Caption := CleanTabCaption.Trim + ' (' + IntToStr(vt.RootNodeCount) + ')'; + // Restore selection + SetVTSelection(vt, SelectedCaptions, FocusedCaption); +end;} + + +{procedure TMainForm.HostListBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + var ContentRect: TRect); +var + vt: TVirtualStringTree; + Val, Max: Extended; + LoopNode: PVirtualNode; + SessionVal, GlobalVal: String; +begin + PaintAlternatingRowBackground(TargetCanvas, Node, CellRect); + vt := Sender as TVirtualStringTree; + + if (Column in [1,2,4..9]) and (vt = ListDatabases) then begin + // Find out maximum value in column + LoopNode := vt.GetFirst; + Max := 1; + while Assigned(LoopNode) do begin + Val := MakeFloat(vt.Text[LoopNode, Column]); + if Val > Max then + Max := Val; + LoopNode := vt.GetNext(LoopNode); + end; + PaintColorBar(MakeFloat(vt.Text[Node, Column]), Max, TargetCanvas, CellRect); + end; + + // Highlight cell if session variable is different to global variable + if (Column = 1) and (vt = ListVariables) then begin + SessionVal := vt.Text[Node, 1]; + GlobalVal := vt.Text[Node, 2]; + if SessionVal <> GlobalVal then begin + TargetCanvas.Brush.Color := clWebBlanchedAlmond; + TargetCanvas.Pen.Color := TargetCanvas.Brush.Color; + TargetCanvas.Rectangle(CellRect); + end; + end; + + // Nothing special on Status tab + + if (Column = 5) and (vt = ListProcesses) then begin + PaintColorBar(MakeFloat(vt.Text[Node, Column]), FProcessListMaxTime, TargetCanvas, CellRect); + end; + + if (Column = 4) and (vt = ListCommandStats) then begin + // Only paint bar in percentage column + PaintColorBar(MakeFloat(vt.Text[Node, Column]), 100, TargetCanvas, CellRect); + end; +end;} + + +{procedure TMainForm.actFollowForeignKeyExecute(Sender: TObject); +var + Results: TDBQuery; + RowNum: PInt64; + FocusedColumnName, ForeignColumnName, ReferenceTable: String; + ForeignKey: TForeignKey; + i: Integer; + DBObj: TDBObject; + Datatype: TDBDatatype; + DbObjects: TDBObjectList; + Filter: String; + Conn: TDBConnection; +begin + Results := GridResult(DataGrid); + RowNum := DataGrid.GetNodeData(DataGrid.FocusedNode); + Results.RecNo := RowNum^; + FocusedColumnName := Results.ColumnOrgNames[DataGrid.FocusedColumn-1]; + Conn := Results.Connection; + + // find foreign key for current column + for ForeignKey in ActiveDBObj.TableForeignKeys do begin + i := ForeignKey.Columns.IndexOf(FocusedColumnName); + if i > -1 then begin + ForeignColumnName := ForeignKey.ForeignColumns[i]; + ReferenceTable := ForeignKey.ReferenceTable; + break; + end; + end; + if ForeignColumnName = '' then begin + LogSQL(f_('Foreign key not found for column "%s"', [FocusedColumnName]), lcInfo); + Exit; + end; + Datatype := Results.DataType(DataGrid.FocusedColumn-1); + // filter to show only rows linked by the foreign key + if DataType.Category in [dtcBinary, dtcSpatial] then + Filter := Conn.QuoteIdent(ForeignColumnName)+'='+Results.HexValue(DataGrid.FocusedColumn-1) + else + Filter := Conn.QuoteIdent(ForeignColumnName)+'='+Conn.EscapeString(Results.Col(DataGrid.FocusedColumn-1)); + + // Jumping to ReferenceTable. Caution, this invalidates the above used Results + DbObjects := Conn.GetDBObjects(ActiveDatabase); + for DBObj in DbObjects do begin + if DBObj.Database + '.' + DBObj.Name = ReferenceTable then begin + ActiveDBObj := DBObj; + Break; + end; + end; + + SynMemoFilter.Text := Filter; + ToggleFilterPanel(True); + actApplyFilter.Execute; + // SynMemoFilter will be cleared and set value of asFilter (in HandleDataGridAttributes from DataGridBeforePaint) + AppSettings.SessionPath := GetRegKeyTable; + AppSettings.WriteString(asFilter, Filter); +end;} + + +{procedure TMainForm.actCopyGridNodesExecute(Sender: TObject); +var + SenderControl: TComponent; + SenderName: String; + Grid: TVirtualStringTree; + Header, Body, Line, Data: String; + Separator, Encloser, Terminator: String; + Node: PVirtualNode; + Col: TColumnIndex; + Indent, NodesCopied: Integer; + IsFirstCol: Boolean; +begin + // Copy tree nodes as CSV, from any VirtualTree, not only from data or result grids + // See issue #2083 + SenderControl := PopupComponent(Sender); + if SenderControl=nil then + SenderControl := Screen.ActiveControl; + + if not (SenderControl is TVirtualStringTree) then begin + if SenderControl=nil then + SenderName := 'nil' + else + SenderName := SenderControl.Name; + ErrorDialog(f_('No listing or tree focused. ActiveControl is %s', [SenderName])); + Exit; + end; + + Screen.Cursor := crHourGlass; + Grid := TVirtualStringTree(SenderControl); + // Grid.CopyToClipboard; // Does nothing (?) + + Separator := #9; + Encloser := ''; + Terminator := SLineBreak; + + Header := ''; + Col := Grid.Header.Columns.GetFirstVisibleColumn(True); + IsFirstCol := True; + while Col > NoColumn do begin + Data := Grid.Header.Columns[Col].Text; + //Data := StringReplace(Data, Encloser, Encloser+Encloser, [rfReplaceAll]); + if not IsFirstCol then + Header := Header + Separator; + IsFirstCol := False; + //Header := Header + Encloser + Data + Encloser; + Header := Header + Data; + Col := Grid.Header.Columns.GetNextVisibleColumn(Col); + end; + Header := Header + Terminator; + + Body := ''; + NodesCopied := 0; + Node := Grid.GetFirstInitialized; + while Assigned(Node) do begin + if Grid.IsVisible[Node] then begin + IsFirstCol := True; + Line := ''; + + // One empty cell for each indentation level + for Indent := 1 to Grid.GetNodeLevel(Node) do begin + if not IsFirstCol then + Line := Line + Separator; + IsFirstCol := False; + //Line := Line + Encloser + Encloser; + end; + + // Add data cells + Col := Grid.Header.Columns.GetFirstVisibleColumn(True); + while Col > NoColumn do begin + Data := Grid.Text[Node, Col]; + //Data := StringReplace(Data, Encloser, Encloser+Encloser, [rfReplaceAll]); + if not IsFirstCol then + Line := Line + Separator; + IsFirstCol := False; + //Line := Line + Encloser + Data + Encloser; + Line := Line + Data; + Col := Grid.Header.Columns.GetNextVisibleColumn(Col); + end; + + Body := Body + Line + Terminator; + Inc(NodesCopied); + end; + Node := Grid.GetNextInitialized(Node); + end; + + Clipboard.TryAsText := Header + Body; + + Screen.Cursor := crDefault; + LogSQL(f_('%s: %s lines copied to clipboard', [SLogPrefixInfo, FormatNumber(NodesCopied)]), lcInfo); + MessageBeep(MB_ICONASTERISK); +end;} + +{procedure TMainForm.actCopyOrCutExecute(Sender: TObject); +var + CurrentControl: TWinControl; + SendingControl: TComponent; + SenderName, TextCopy: String; + Edit: TCustomEdit; + Combo: TCustomComboBox; + Grid: TVirtualStringTree; + SynMemo: TSynMemo; + DoCut, DoCopyRows: Boolean; + IsResultGrid, HasNulls: Boolean; + ClpFormat: Word; + ClpData: THandle; + APalette: HPalette; + Exporter: TSynExporterRTF; + Results: TDBQuery; + RowNum: PInt64; + ExportDialog: TfrmExportGrid; +begin + // Copy text from a focused control to clipboard + CurrentControl := Screen.ActiveControl; + SendingControl := TAction(Sender).ActionComponent; + SenderName := TAction(Sender).Name; + DoCut := Sender = actCut; + DoCopyRows := SenderName.StartsWith(TfrmExportGrid.CopyAsActionPrefix); + FClipboardHasNull := False; + Screen.Cursor := crHourglass; + try + if SendingControl = btnPreviewCopy then begin + if (imgPreview.Picture.Graphic <> nil) and (not imgPreview.Picture.Graphic.Empty) then begin + imgPreview.Picture.SaveToClipBoardFormat(ClpFormat, ClpData, APalette); + ClipBoard.SetAsHandle(ClpFormat, ClpData); + end; + end else if CurrentControl is TCustomEdit then begin + Edit := TCustomEdit(CurrentControl); + if Edit.SelLength > 0 then begin + if DoCut then Edit.CutToClipboard + else Edit.CopyToClipboard; + end; + end else if CurrentControl is TCustomComboBox then begin + Combo := TCustomComboBox(CurrentControl); + if Combo.SelLength > 0 then begin + Clipboard.TryAsText := Combo.SelText; + if DoCut then Combo.SelText := ''; + end; + end else if CurrentControl is TVirtualStringTree then begin + Grid := CurrentControl as TVirtualStringTree; + if Assigned(Grid.FocusedNode) then begin + IsResultGrid := Grid = ActiveGrid; + FGridCopying := True; + if IsResultGrid then begin + if DoCopyRows then begin + ExportDialog := TfrmExportGrid.Create(Sender as TAction); + ExportDialog.Grid := Grid; + ExportDialog.btnOK.Click; + ExportDialog.Free; + end else begin + // Handle NULL values in grids, see issue #3171 + AnyGridEnsureFullRow(Grid, Grid.FocusedNode); + Results := GridResult(Grid); + RowNum := Grid.GetNodeData(Grid.FocusedNode); + Results.RecNo := RowNum^; + if Results.IsNull(Grid.FocusedColumn-1) then begin + Clipboard.TryAsText := ''; + FClipboardHasNull := True; + end else begin + TextCopy := Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]; + RemoveNullChars(TextCopy, HasNulls); + Clipboard.TryAsText := TextCopy; + end; + if DoCut then + Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := ''; + end; + end else begin + TextCopy := Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]; + RemoveNullChars(TextCopy, HasNulls); + Clipboard.TryAsText := TextCopy; + end; + FGridCopying := False; + end; + end else if CurrentControl is TSynMemo then begin + SynMemo := CurrentControl as TSynMemo; + if SynMemo.SelAvail then begin + // Create both text and RTF clipboard format, so rich text applications can paste highlighted SQL + Clipboard.Open; + Clipboard.TryAsText := SynMemo.SelText; + Exporter := TSynExporterRTF.Create(Self); + Exporter.Highlighter := SynMemo.Highlighter; + Exporter.ExportAll(Explode(CRLF, SynMemo.SelText)); + if DoCut then SynMemo.CutToClipboard + else SynMemo.CopyToClipboard; + Exporter.CopyToClipboard; + Clipboard.Close; + Exporter.Free; + end; + end else begin + raise Exception.Create('Unhandled control in clipboard action: '+IfThen(Assigned(CurrentControl), CurrentControl.Name, 'nil')); + end; + except + on E:Exception do begin + LogSQL(E.ClassName + ': ' + E.Message); + MessageBeep(MB_ICONASTERISK); + end; + end; + Screen.Cursor := crDefault; +end;} + + +{procedure TMainForm.actPasteExecute(Sender: TObject); +var + Control: TWinControl; + Edit: TCustomEdit; + Combo: TComboBox; + Grid: TVirtualStringTree; + SynMemo: TSynMemo; + Success: Boolean; +begin + // Paste text into the focused control + Success := False; + Control := Screen.ActiveControl; + if not Clipboard.HasFormat(CF_TEXT) then begin + // Do nothing, we cannot paste a picture or so + end else if Control is TCustomEdit then begin + Edit := TCustomEdit(Control); + if not Edit.ReadOnly then begin + Edit.PasteFromClipboard; + Success := True; + end; + end else if Control is TComboBox then begin + Combo := TComboBox(Control); + if Combo.Style = csDropDown then begin + Combo.SelText := Clipboard.TryAsText; + Success := True; + end; + end else if Control is TVirtualStringTree then begin + Grid := Control as TVirtualStringTree; + if Assigned(Grid.FocusedNode) and (Grid = ActiveGrid) then begin + FGridPasting := True; + Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := Clipboard.TryAsText; + Success := True; + FGridPasting := False; + end; + end else if Control is TSynMemo then begin + SynMemo := TSynMemo(Control); + if not SynMemo.ReadOnly then begin + try + SynMemo.PasteFromClipboard; + Success := True; + SynMemo.Modified := True; + except on E:Exception do + ErrorDialog(E.Message); + end; + end; + end; + if not Success then + MessageBeep(MB_ICONASTERISK); +end;} + + +{procedure TMainForm.actSequalSuggestExecute(Sender: TObject); +var + SequalSuggestForm: TSequalSuggestForm; +begin + // Show Sequal Suggest dialog + SequalSuggestForm := TSequalSuggestForm.Create(Self); + SequalSuggestForm.ShowModal; +end;} + +{procedure TMainForm.actSelectAllExecute(Sender: TObject); +var + Control: TWinControl; + Grid: TVirtualStringTree; + ListBox: TListBox; + Success: Boolean; +begin + // Select all items, text or whatever + Success := False; + Control := Screen.ActiveControl; + if Control is TCustomEdit then begin + TCustomEdit(Control).SelectAll; + Success := True; + end else if Control is TVirtualStringTree then begin + Grid := TVirtualStringTree(Control); + if toMultiSelect in Grid.TreeOptions.SelectionOptions then begin + Grid.SelectAll(False); + Success := True; + end; + end else if Control is TSynMemo then begin + TSynMemo(Control).SelectAll; + Success := True; + end else if Control is TListBox then begin + ListBox := TListBox(Control); + if ListBox.MultiSelect then begin + ListBox.SelectAll; + Success := True; + end; + end; + if not Success then + MessageBeep(MB_ICONASTERISK); +end;} + + +{procedure TMainForm.actSelectInverseExecute(Sender: TObject); +var + Control: TWinControl; + Grid: TVirtualStringTree; + ListBox: TListBox; + Success: Boolean; + i: Integer; +begin + // Invert selection in grids or listboxes + Success := False; + Control := Screen.ActiveControl; + if Control is TVirtualStringTree then begin + Grid := TVirtualStringTree(Control); + if toMultiSelect in Grid.TreeOptions.SelectionOptions then begin + Grid.InvertSelection(False); + Success := True; + end; + end else if Control is TListBox then begin + ListBox := TListBox(Control); + if ListBox.MultiSelect then begin + for i:=0 to ListBox.Count-1 do + ListBox.Selected[i] := not ListBox.Selected[i]; + Success := True; + end; + end; + if not Success then + MessageBeep(MB_ICONASTERISK); +end;} + + +{procedure TMainForm.EnumerateRecentFilters; +var + i: Integer; + item: TMenuItem; + rx: TRegExpr; + capt, Path: String; +begin + // Reset menu and combobox + menuRecentFilters.Enabled := False; + for i := menuRecentFilters.Count - 1 downto 0 do + menuRecentFilters.Delete(i); + comboRecentFilters.Items.Clear; + // Enumerate recent filters from registry + Path := GetRegKeyTable+'\'+REGKEY_RECENTFILTERS; + if AppSettings.SessionPathExists(Path) then begin + AppSettings.SessionPath := Path; + rx := TRegExpr.Create; + rx.Expression := '\s+'; + for i:=1 to 20 do begin + // Previously introduced bugs stored some other settings here, see issue #2127 + item := TMenuItem.Create(popupFilter); + capt := AppSettings.ReadString(asRecentFilter, IntToStr(i)); + if capt.IsEmpty then + Break; + capt := rx.Replace(capt, ' ', True); + item.Hint := capt; + item.Caption := StrEllipsis(capt, 50); + item.Tag := i; + item.OnClick := LoadRecentFilter; + menuRecentFilters.Add(item); + comboRecentFilters.Items.Add(capt); + end; + FreeAndNil(rx); + AppSettings.ResetPath; + menuRecentFilters.Enabled := menuRecentFilters.Count > 0; + end; + comboRecentFilters.Visible := comboRecentFilters.Items.Count > 0; + lblRecentFilters.Visible := comboRecentFilters.Visible; + SynMemoFilter.Height := pnlFilter.Height - 3; + SynMemoFilter.Top := comboRecentFilters.Top; + if comboRecentFilters.Visible then begin + SynMemoFilter.Height := SynMemoFilter.Height - comboRecentFilters.Height; + SynMemoFilter.Top := SynMemoFilter.Top + comboRecentFilters.Height; + comboRecentFilters.ItemIndex := 0; + end; +end;} + + +{procedure TMainForm.LoadRecentFilter(Sender: TObject); +var + key: Integer; + Path: String; +begin + // Event handler for both dynamic popup menu items and filter combobox + if Sender is TMenuItem then + key := (Sender as TMenuItem).Tag + else + key := (Sender as TComboBox).ItemIndex+1; + Path := GetRegKeyTable+'\'+REGKEY_RECENTFILTERS; + if AppSettings.SessionPathExists(Path) then begin + AppSettings.SessionPath := Path; + SynMemoFilter.UndoList.AddGroupBreak; + SynMemoFilter.BeginUpdate; + SynMemoFilter.SelectAll; + SynMemoFilter.SelText := AppSettings.ReadString(asRecentFilter, IntToStr(key)); + SynMemoFilter.EndUpdate; + AppSettings.ResetPath; + end; +end;} + + +{procedure TMainForm.PlaceObjectEditor(Obj: TDBObject); +var + EditorClass: TDBObjectEditorClass; +begin + // Place the relevant editor frame onto the editor tab, hide all others + if FTreeRefreshInProgress and Assigned(ActiveObjectEditor) then begin + ActiveObjectEditor.Init(Obj); + UpdateFilterPanel(Self); + end else begin + if Assigned(ActiveObjectEditor) and (Obj.NodeType <> ActiveObjectEditor.DBObject.NodeType) then + FreeAndNil(ActiveObjectEditor); + case Obj.NodeType of + lntTable: EditorClass := TfrmTableEditor; + lntView: EditorClass := TfrmView; + lntProcedure, lntFunction: EditorClass := TfrmRoutineEditor; + lntTrigger: EditorClass := TfrmTriggerEditor; + lntEvent: EditorClass := TfrmEventEditor; + else Exit; + end; + if not Assigned(ActiveObjectEditor) then begin + ActiveObjectEditor := EditorClass.Create(tabEditor); + ActiveObjectEditor.Parent := tabEditor; + SetupSynEditors(ActiveObjectEditor); + end; + ActiveObjectEditor.Init(Obj); + buttonedEditClear(editFilterVT); + end; +end;} + + +{procedure TMainForm.UpdateEditorTab; +var + Cap: String; +begin + tabEditor.ImageIndex := ActiveObjectEditor.DBObject.ImageIndex; + // Reset to grayscale if in background: + PageControlTabHighlight(PageControlMain); + Cap := _(ActiveObjectEditor.DBObject.ObjType)+': '; + if ActiveObjectEditor.DBObject.Name = '' then + Cap := Cap + '['+_('Untitled')+']' + else + Cap := Cap + ActiveObjectEditor.DBObject.Name; + SetTabCaption(tabEditor.PageIndex, Cap); +end;} + + +{procedure TMainForm.menuEditObjectClick(Sender: TObject); +var + Obj: PDBObject; +begin + if ListTables.Focused then begin + // Got here from ListTables.OnDblClick or ListTables's context menu item "Edit" + Obj := ListTables.GetNodeData(ListTables.FocusedNode); + if not Obj.IsSameAs(ActiveDbObj) then + ActiveDBObj := Obj^; + SetMainTab(tabEditor); + end else begin + Obj := DBtree.GetNodeData(DBtree.FocusedNode); + case Obj.NodeType of + lntDb: begin + FCreateDatabaseDialog := TCreateDatabaseForm.Create(Self); + FCreateDatabaseDialog.modifyDB := ActiveDatabase; + if FCreateDatabaseDialog.ShowModal = mrOk then + RefreshTree; + FreeAndNil(FCreateDatabaseDialog); + end; + lntTable..lntEvent: + SetMainTab(tabEditor); + end; + end; +end;} + + +{procedure TMainForm.ListTablesKeyPress(Sender: TObject; var Key: Char); +begin + // Open object editor on pressing Enter + if Ord(Key) = VK_RETURN then + ListTables.OnDblClick(Sender); +end;} + + +{procedure TMainForm.ListTablesDblClick(Sender: TObject); +var + Obj: PDBObject; + vt: TVirtualStringTree; +begin + // DoubleClick: Display editor + vt := Sender as TVirtualStringTree; + if Assigned(vt.FocusedNode) then begin + Obj := vt.GetNodeData(vt.FocusedNode); + ActiveDBObj := Obj^; + // Normally the editor tab is active now, but not when same node was focused before + SetMainTab(tabEditor); + end; +end;} + + +{procedure TMainForm.actNewQueryTabExecute(Sender: TObject); +var + i: Integer; + QueryTab, OldTab: TQueryTab; + HelperColumn: TVirtualTreeColumn; +begin + i := QueryTabs[QueryTabs.Count-1].Number + 1; + OldTab := QueryTabs.ActiveTab; + + QueryTabs.Add(TQueryTab.Create(Self)); + QueryTab := QueryTabs[QueryTabs.Count-1]; + QueryTab.Number := i; + QueryTab.Uid := TQueryTab.GenerateUid; + + QueryTab.TabSheet := TTabSheet.Create(PageControlMain); + QueryTab.TabSheet.Name := tabQuery.Name + i.ToString; + QueryTab.TabSheet.PageControl := PageControlMain; + QueryTab.TabSheet.ImageIndex := tabQuery.ImageIndex; + + QueryTab.CloseButton := TSpeedButton.Create(QueryTab.TabSheet); + QueryTab.CloseButton.Parent := PageControlMain; + QueryTab.CloseButton.Width := 16; + QueryTab.CloseButton.Height := 16; + QueryTab.CloseButton.Flat := True; + VirtualImageListMain.GetBitmap(134, QueryTab.CloseButton.Glyph); + QueryTab.CloseButton.OnMouseDown := CloseButtonOnMouseDown; + QueryTab.CloseButton.OnMouseUp := CloseButtonOnMouseUp; + SetTabCaption(QueryTab.TabSheet.PageIndex, ''); + + // Dumb code which replicates all controls from tabQuery + QueryTab.pnlMemo := TPanel.Create(QueryTab.TabSheet); + QueryTab.pnlMemo.Name := pnlQueryMemo.Name + i.ToString; + QueryTab.pnlMemo.Parent := QueryTab.TabSheet; + QueryTab.pnlMemo.BevelOuter := pnlQueryMemo.BevelOuter; + QueryTab.pnlMemo.Align := pnlQueryMemo.Align; + if Assigned(OldTab) then + QueryTab.pnlMemo.Height := OldTab.pnlMemo.Height + else + QueryTab.pnlMemo.Height := AppSettings.GetDefaultInt(asQuerymemoheight); + QueryTab.pnlMemo.Constraints := pnlQueryMemo.Constraints; + + QueryTab.Memo := TSynMemo.Create(QueryTab.pnlMemo); + QueryTab.Memo.Name := SynMemoQuery.Name + i.ToString; + QueryTab.Memo.Text := ''; + QueryTab.Memo.Parent := QueryTab.pnlMemo; + QueryTab.Memo.Align := SynMemoQuery.Align; + QueryTab.Memo.Constraints := SynMemoQuery.Constraints; + QueryTab.Memo.HintMode := SynMemoQuery.HintMode; + QueryTab.Memo.Left := SynMemoQuery.Left; + QueryTab.Memo.Options := SynMemoQuery.Options; + QueryTab.Memo.PopupMenu := SynMemoQuery.PopupMenu; + QueryTab.Memo.TabWidth := SynMemoQuery.TabWidth; + QueryTab.Memo.RightEdge := SynMemoQuery.RightEdge; + QueryTab.Memo.WantTabs := SynMemoQuery.WantTabs; + QueryTab.Memo.Highlighter := SynMemoQuery.Highlighter; + QueryTab.Memo.Gutter.Assign(SynMemoQuery.Gutter); + QueryTab.Memo.Font.Assign(SynMemoQuery.Font); + QueryTab.Memo.ActiveLineColor := SynMemoQuery.ActiveLineColor; + QueryTab.Memo.OnStatusChange := SynMemoQuery.OnStatusChange; + QueryTab.Memo.OnSpecialLineColors := SynMemoQuery.OnSpecialLineColors; + QueryTab.Memo.OnDragDrop := SynMemoQuery.OnDragDrop; + QueryTab.Memo.OnDragOver := SynMemoQuery.OnDragOver; + QueryTab.Memo.OnDropFiles := SynMemoQuery.OnDropFiles; + QueryTab.Memo.OnKeyPress := SynMemoQuery.OnKeyPress; + QueryTab.Memo.OnMouseWheel := SynMemoQuery.OnMouseWheel; + QueryTab.Memo.OnReplaceText := SynMemoQuery.OnReplaceText; + QueryTab.Memo.OnPaintTransient := SynMemoQuery.OnPaintTransient; + QueryTab.Memo.OnTokenHint := SynMemoQuery.OnTokenHint; + QueryTab.MemoLineBreaks := TLineBreaks(AppSettings.ReadInt(asLineBreakStyle)); + SynCompletionProposal.AddEditor(QueryTab.Memo); + + QueryTab.spltHelpers := TSplitter.Create(QueryTab.pnlMemo); + QueryTab.spltHelpers.Parent := QueryTab.pnlMemo; + QueryTab.spltHelpers.Align := spltQueryHelpers.Align; + QueryTab.spltHelpers.Left := spltQueryHelpers.Left; + QueryTab.spltHelpers.Cursor := spltQueryHelpers.Cursor; + QueryTab.spltHelpers.ResizeStyle := spltQueryHelpers.ResizeStyle; + QueryTab.spltHelpers.Width := spltQueryHelpers.Width; + + QueryTab.pnlHelpers := TPanel.Create(QueryTab.pnlMemo); + QueryTab.pnlHelpers.Name := pnlQueryHelpers.Name + i.ToString; + QueryTab.pnlHelpers.Parent := QueryTab.pnlMemo; + QueryTab.pnlHelpers.Align := pnlQueryHelpers.Align; + QueryTab.pnlHelpers.Constraints := pnlQueryHelpers.Constraints; + QueryTab.pnlHelpers.BevelOuter := pnlQueryHelpers.BevelOuter; + QueryTab.pnlHelpers.Left := pnlQueryHelpers.Left; + if Assigned(OldTab) then + QueryTab.pnlHelpers.Width := OldTab.pnlHelpers.Width + else + QueryTab.pnlHelpers.Width := AppSettings.GetDefaultInt(asQueryhelperswidth); + + QueryTab.filterHelpers := TButtonedEdit.Create(QueryTab.pnlHelpers); + QueryTab.filterHelpers.Name := filterQueryHelpers.Name + i.ToString; + QueryTab.filterHelpers.Text := ''; + QueryTab.filterHelpers.Parent := QueryTab.pnlHelpers; + QueryTab.filterHelpers.Align := filterQueryHelpers.Align; + QueryTab.filterHelpers.TextHint := filterQueryHelpers.TextHint; + QueryTab.filterHelpers.Images := filterQueryHelpers.Images; + QueryTab.filterHelpers.LeftButton.Visible := filterQueryHelpers.LeftButton.Visible; + QueryTab.filterHelpers.LeftButton.ImageIndex := filterQueryHelpers.LeftButton.ImageIndex; + QueryTab.filterHelpers.RightButton.Visible := filterQueryHelpers.RightButton.Visible; + QueryTab.filterHelpers.RightButton.ImageIndex := filterQueryHelpers.RightButton.ImageIndex; + QueryTab.filterHelpers.OnChange := filterQueryHelpers.OnChange; + QueryTab.filterHelpers.OnRightButtonClick := filterQueryHelpers.OnRightButtonClick; + + QueryTab.treeHelpers := TVirtualStringTree.Create(QueryTab.pnlHelpers); + QueryTab.treeHelpers.Name := treeQueryHelpers.Name + i.ToString; + QueryTab.treeHelpers.Parent := QueryTab.pnlHelpers; + QueryTab.treeHelpers.Align := treeQueryHelpers.Align; + QueryTab.treeHelpers.Left := treeQueryHelpers.Left; + QueryTab.treeHelpers.Constraints.MinWidth := treeQueryHelpers.Constraints.MinWidth; + QueryTab.treeHelpers.PopupMenu := treeQueryHelpers.PopupMenu; + QueryTab.treeHelpers.Images := treeQueryHelpers.Images; + QueryTab.treeHelpers.DragMode := treeQueryHelpers.DragMode; + QueryTab.treeHelpers.DragType := treeQueryHelpers.DragType; + QueryTab.treeHelpers.OnBeforeCellPaint := treeQueryHelpers.OnBeforeCellPaint; + QueryTab.treeHelpers.OnChecking := treeQueryHelpers.OnChecking; + QueryTab.treeHelpers.OnContextPopup := treeQueryHelpers.OnContextPopup; + QueryTab.treeHelpers.OnCreateEditor := treeQueryHelpers.OnCreateEditor; + QueryTab.treeHelpers.OnDblClick := treeQueryHelpers.OnDblClick; + QueryTab.treeHelpers.OnEditing := treeQueryHelpers.OnEditing; + QueryTab.treeHelpers.OnFreeNode := treeQueryHelpers.OnFreeNode; + QueryTab.treeHelpers.OnGetImageIndex := treeQueryHelpers.OnGetImageIndex; + QueryTab.treeHelpers.OnGetText := treeQueryHelpers.OnGetText; + QueryTab.treeHelpers.OnInitChildren := treeQueryHelpers.OnInitChildren; + QueryTab.treeHelpers.OnInitNode := treeQueryHelpers.OnInitNode; + QueryTab.treeHelpers.OnNewText := treeQueryHelpers.OnNewText; + QueryTab.treeHelpers.OnNodeClick := treeQueryHelpers.OnNodeClick; + QueryTab.treeHelpers.OnPaintText := treeQueryHelpers.OnPaintText; + QueryTab.treeHelpers.OnResize := treeQueryHelpers.OnResize; + for i:=0 to treeQueryHelpers.Header.Columns.Count-1 do begin + HelperColumn := QueryTab.treeHelpers.Header.Columns.Add; + HelperColumn.Text := treeQueryHelpers.Header.Columns[i].Text; + HelperColumn.Width := treeQueryHelpers.Header.Columns[i].Width; + end; + QueryTab.treeHelpers.TreeOptions := treeQueryHelpers.TreeOptions; + QueryTab.treeHelpers.Header.Options := treeQueryHelpers.Header.Options; + QueryTab.treeHelpers.Header.AutoSizeIndex := treeQueryHelpers.Header.AutoSizeIndex; + QueryTab.treeHelpers.IncrementalSearch := treeQueryHelpers.IncrementalSearch; + QueryTab.treeHelpers.RootNodeCount := treeQueryHelpers.RootNodeCount; + QueryTab.treeHelpers.TextMargin := treeQueryHelpers.TextMargin; + FixVT(QueryTab.treeHelpers); + + QueryTab.spltQuery := TSplitter.Create(QueryTab.TabSheet); + QueryTab.spltQuery.Parent := QueryTab.TabSheet; + QueryTab.spltQuery.Top := spltQuery.Top; // Important to get it below the editor, not above. See #439 + QueryTab.spltQuery.Align := spltQuery.Align; + QueryTab.spltQuery.Height := spltQuery.Height; + QueryTab.spltQuery.Cursor := spltQuery.Cursor; + QueryTab.spltQuery.ResizeStyle := spltQuery.ResizeStyle; + QueryTab.spltQuery.AutoSnap := spltQuery.AutoSnap; + + QueryTab.ResultTabs := TResultTabs.Create(True); + + QueryTab.tabsetQuery := TTabSet.Create(QueryTab.TabSheet); + QueryTab.tabsetQuery.Name := tabsetQuery.Name + i.ToString; + QueryTab.tabsetQuery.Parent := QueryTab.TabSheet; + // Prevent various problems with alignment of controls. See http://www.heidisql.com/forum.php?t=18924 + QueryTab.tabsetQuery.Top := QueryTab.spltQuery.Top + QueryTab.spltQuery.Height; + QueryTab.tabsetQuery.Align := tabsetQuery.Align; + QueryTab.tabsetQuery.Font.Assign(tabsetQuery.Font); + QueryTab.tabsetQuery.Images := tabsetQuery.Images; + QueryTab.tabsetQuery.Style := tabsetQuery.Style; + QueryTab.tabsetQuery.TabHeight := tabsetQuery.TabHeight; + QueryTab.tabsetQuery.Height := tabsetQuery.Height; + QueryTab.tabsetQuery.TabPosition := tabsetQuery.TabPosition; + QueryTab.tabsetQuery.SoftTop := tabsetQuery.SoftTop; + QueryTab.tabsetQuery.DitherBackground := tabsetQuery.DitherBackground; + QueryTab.tabsetQuery.SelectedColor := tabsetQuery.SelectedColor; + QueryTab.tabsetQuery.UnselectedColor := tabsetQuery.UnselectedColor; + QueryTab.tabsetQuery.OnClick := tabsetQuery.OnClick; + QueryTab.tabsetQuery.OnGetImageIndex := tabsetQuery.OnGetImageIndex; + QueryTab.tabsetQuery.OnMouseMove := tabsetQuery.OnMouseMove; + QueryTab.tabsetQuery.OnMouseLeave := tabsetQuery.OnMouseLeave; + + SetupSynEditor(QueryTab.Memo); + + // Show new tab + if Sender <> actNewQueryTabNofocus then begin + SetMainTab(QueryTab.TabSheet); + QueryTab.Memo.TrySetFocus; + end; +end;} + + +{procedure TMainForm.panelTopDblClick(Sender: TObject); +var + aRect: TRect; + aPoint: TPoint; +begin + // Catch doubleclick on PageControlMain's underlying panel, which gets fired + // when user clicks right besides the visible tabs + aPoint := PageControlMain.ClientOrigin; + aRect := Rect(aPoint.X, aPoint.Y, aPoint.X + PageControlMain.Width, aPoint.Y + PageControlMain.Height - tabQuery.Height); + GetCursorPos(aPoint); + if PtInRect(aRect, aPoint) then + actNewQueryTab.Execute; +end;} + + +{procedure TMainForm.actCloseQueryTabExecute(Sender: TObject); +begin + // Close active query tab by main action + CloseQueryTab(PageControlMain.ActivePageIndex); +end;} + + +{procedure TMainForm.menuCloseQueryTabClick(Sender: TObject); +var + aPoint: TPoint; +begin + // Close query tab by menu item + aPoint := PageControlMain.ScreenToClient(popupMainTabs.PopupPoint); + CloseQueryTab(GetMainTabAt(aPoint.X, aPoint.Y)); +end;} + + +{procedure TMainForm.menuCloseRightQueryTabsClick(Sender: TObject); +var + aPoint: TPoint; + i, PageIndexClick: Integer; +begin + // Close tabs to the right + aPoint := PageControlMain.ScreenToClient(popupMainTabs.PopupPoint); + PageIndexClick := GetMainTabAt(aPoint.X, aPoint.Y); + if PageIndexClick > -1 then begin + for i:=PageControlMain.PageCount-1 downto PageIndexClick+1 do begin + CloseQueryTab(PageControlMain.Pages[i].PageIndex); + end; + end; +end;} + + +{procedure TMainForm.menuCloseTabOnDblClickClick(Sender: TObject); +begin + AppSettings.WriteBool(asTabCloseOnDoubleClick, menuCloseTabOnDblClick.Checked); +end;} + + +{procedure TMainForm.menuCloseTabOnMiddleClickClick(Sender: TObject); +begin + AppSettings.WriteBool(asTabCloseOnMiddleClick, menuCloseTabOnMiddleClick.Checked); +end;} + +{procedure TMainForm.menuTabsInMultipleLinesClick(Sender: TObject); +begin + AppSettings.WriteBool(asTabsInMultipleLines, menuTabsInMultipleLines.Checked); + PageControlMain.MultiLine := menuTabsInMultipleLines.Checked; +end;} + +{procedure TMainForm.actCloseAllQueryTabsExecute(Sender: TObject); +var + i: Integer; +begin + // Close all tabs + for i:=PageControlMain.PageCount-1 downto tabQuery.PageIndex do begin + CloseQueryTab(PageControlMain.Pages[i].PageIndex); + end; +end;} + + +{procedure TMainForm.actRenameQueryTabExecute(Sender: TObject); +var + aPoint: TPoint; + PageIndex: Integer; + NewCaption: String; +begin + // Rename query tab + if Sender = menuRenameQueryTab then begin + aPoint := PageControlMain.ScreenToClient(popupMainTabs.PopupPoint); + PageIndex := GetMainTabAt(aPoint.X, aPoint.Y); + end else begin + PageIndex := PageControlMain.ActivePageIndex; + end; + if not IsQueryTab(PageIndex, True) then begin + // Action may have been triggered through shortcut, and active tab is not a query tab + MessageBeep(MB_ICONASTERISK); + end else begin + NewCaption := PageControlMain.Pages[PageIndex].Caption; + NewCaption := NewCaption.Trim([' ', '*']); + if InputQuery(actRenameQueryTab.Caption, _('Enter new name'), NewCaption) then begin + SetTabCaption(PageIndex, NewCaption); + ValidateQueryControls(Sender); + end; + end; +end;} + + +{procedure TMainForm.actResetPanelDimensionsExecute(Sender: TObject); +var + Tab: TQueryTab; +begin + // Reset probably overlapping panels to their default dimensions + pnlLeft.Width := AppSettings.GetDefaultInt(asDbtreewidth); + SynMemoSQLLog.Height := AppSettings.GetDefaultInt(asLogHeight); + for Tab in QueryTabs do begin + Tab.pnlMemo.Height := AppSettings.GetDefaultInt(asQuerymemoheight); + Tab.pnlHelpers.Width := AppSettings.GetDefaultInt(asQueryhelperswidth); + end; + if pnlPreview.Visible then begin + pnlPreview.Height := AppSettings.GetDefaultInt(asDataPreviewHeight); + end; + AppSettings.DeleteValue(asCompletionProposalWidth); + AppSettings.DeleteValue(asCompletionProposalNbLinesInWindow); + SynCompletionProposal.Width := AppSettings.ReadInt(asCompletionProposalWidth); + SynCompletionProposal.NbLinesInWindow := AppSettings.ReadInt(asCompletionProposalNbLinesInWindow); +end;} + +{procedure TMainForm.menuRenameQueryTabClick(Sender: TObject); +begin + // Rename tab by click on menu item (not by shortcut!) + actRenameQueryTabExecute(Sender); +end;} + + +{procedure TMainForm.popupMainTabsPopup(Sender: TObject); +var + aPoint: TPoint; + PageIndexClick: Integer; +begin + // Detect if there is a tab under mouse position + aPoint := PageControlMain.ScreenToClient(popupMainTabs.PopupPoint); + PageIndexClick := GetMainTabAt(aPoint.X, aPoint.Y); + menuCloseQueryTab.ImageIndex := actCloseQueryTab.ImageIndex; + menuCloseQueryTab.Caption := actCloseQueryTab.Caption; + menuCloseQueryTab.Enabled := IsQueryTab(PageIndexClick, False); + menuCloseRightQueryTabs.Enabled := (QueryTabs.Count > 0) and (PageIndexClick < QueryTabs.Last.TabSheet.PageIndex) and (PageIndexClick > -1); + menuRenameQueryTab.ImageIndex := actRenameQueryTab.ImageIndex; + menuRenameQueryTab.Caption := actRenameQueryTab.Caption; + menuRenameQueryTab.Enabled := IsQueryTab(PageIndexClick, True); + menuCloseTabOnDblClick.Checked := AppSettings.ReadBool(asTabCloseOnDoubleClick); + menuCloseTabOnMiddleClick.Checked := AppSettings.ReadBool(asTabCloseOnMiddleClick); + menuTabsInMultipleLines.Checked := AppSettings.ReadBool(asTabsInMultipleLines) +end;} + + +{procedure TMainForm.CloseQueryTab(PageIndex: Integer); +var + NewPageIndex: Integer; + Grid: TVirtualStringTree; +begin + // Special case: the very first tab gets cleared but not closed + if PageIndex = tabQuery.PageIndex then begin + if ConfirmTabClear(PageIndex, False) then + actClearQueryEditor.Execute; + end; + if not IsQueryTab(PageIndex, False) then + Exit; + // Cancel cell editor if active, preventing crash. See issue #2040 + Grid := ActiveGrid; + if Assigned(Grid) and Grid.IsEditing then + Grid.CancelEditNode; + // Ask user if query content shall be saved to disk + if not ConfirmTabClose(PageIndex, False) then + Exit; + // Block too quick further close actions, fix issue #1496. Action gets enabled again in PageControlMainChange/ValidateQueryControls + actCloseQueryTab.Enabled := False; + // Work around bugs in ComCtrls.TPageControl.RemovePage + NewPageIndex := PageControlMain.ActivePageIndex; + if NewPageIndex >= PageIndex then + Dec(NewPageIndex); + // Avoid excessive flicker: + LockWindowUpdate(PageControlMain.Handle); + PageControlMain.Pages[PageIndex].Free; + QueryTabs.Delete(PageIndex-tabQuery.PageIndex); + PageControlMain.ActivePageIndex := NewPageIndex; + FixQueryTabCloseButtons; + LockWindowUpdate(0); + PageControlMain.OnChange(PageControlMain); +end;} + + +{procedure TMainForm.actFavoriteObjectsOnlyExecute(Sender: TObject); +begin + // Click on "tree favorites" main button + editDatabaseTableFilterChange(Sender); + if actFavoriteObjectsOnly.Checked then + actFavoriteObjectsOnly.ImageIndex := 112 + else + actFavoriteObjectsOnly.ImageIndex := 113; +end;} + + +{procedure TMainForm.buttonedEditClear(Sender: TObject); +begin + // Click on "clear" button of any TButtonedEdit control + TButtonedEdit(Sender).Clear; +end;} + + +{procedure TMainForm.editDatabaseTableFilterChange(Sender: TObject); +var + Node: PVirtualNode; + Obj: PDBObject; + rxdb, rxtable: TRegExpr; + NodeMatches: Boolean; + Errors: TStringList; +begin + // Immediately apply database filter + LogSQL('editDatabaseTableFilterChange', lcDebug); + + rxdb := TRegExpr.Create; + rxdb.ModifierI := True; + rxdb.Expression := '('+StringReplace(editDatabaseFilter.Text, ';', '|', [rfReplaceAll])+')'; + rxtable := TRegExpr.Create; + rxtable.ModifierI := True; + rxtable.Expression := '('+StringReplace(editTableFilter.Text, ';', '|', [rfReplaceAll])+')'; + + Errors := TStringList.Create; + + DBtree.BeginUpdate; + Node := DBtree.GetFirst; + while Assigned(Node) do begin + Obj := DBtree.GetNodeData(Node); + NodeMatches := True; + try + case Obj.NodeType of + lntDb: begin + // Match against database filter + if editDatabaseFilter.Text <> '' then + NodeMatches := rxdb.Exec(DBtree.Text[Node, 0]); + end; + lntTable..lntEvent: begin + // Match against table filter + if editTableFilter.Text <> '' then + NodeMatches := rxtable.Exec(DBtree.Text[Node, 0]); + if actFavoriteObjectsOnly.Checked then + // Hide non-favorite object path + NodeMatches := NodeMatches and (Obj.Connection.Favorites.IndexOf(Obj.Path) > -1); + end; + end; + except + on E:Exception do begin + // Log regex errors, but avoid duplicate messages + if Errors.IndexOf(E.Message) = -1 then begin + LogSQL(E.Message); + Errors.Add(E.Message); + end; + end; + end; + DBtree.IsVisible[Node] := NodeMatches; + + Node := DBtree.GetNextInitialized(Node); + end; + DBtree.EndUpdate; + // Fix scroll height of the tree. See issue #2063 and #2002 + DBtree.Repaint; + + rxdb.Free; + rxtable.Free; + + editDatabaseFilter.RightButton.Visible := editDatabaseFilter.Text <> ''; + editTableFilter.RightButton.Visible := editTableFilter.Text <> ''; +end;} + + +{procedure TMainForm.editDatabaseTableFilterLeftButtonClick(Sender: TObject); +var + Menu: TPopupMenu; + Item: TMenuItem; + P: TPoint; + Edit: TButtonedEdit; + History: TStringList; + ItemText: String; + Setting: TAppSettingIndex; +begin + // Create right menu with filter history + Edit := Sender as TButtonedEdit; + Menu := TPopupMenu.Create(Edit); + Menu.AutoHotkeys := maManual; + Menu.Images := VirtualImageListMain; + AppSettings.SessionPath := ''; + if Edit = editDatabaseFilter then + Setting := asDatabaseFilter + else if Edit = editTableFilter then + Setting := asTableFilter + else if Edit = editFilterVT then + Setting := asFilterVT + else + raise Exception.CreateFmt(MsgUnhandledControl, ['editDatabaseTableFilterLeftButtonClick']); + History := TStringList.Create; + History.Text := AppSettings.ReadString(Setting); + for ItemText in History do begin + Item := TMenuItem.Create(Menu); + Item.Caption := ItemText; + Item.OnClick := editDatabaseTableFilterMenuClick; + Item.Tag := 0; + Item.Checked := ItemText = Edit.Text; + Menu.Items.Add(Item); + end; + History.Free; + + Item := TMenuItem.Create(Menu); + Item.Caption := _('Clear'); + Item.ImageIndex := 193; + Item.OnClick := editDatabaseTableFilterMenuClick; + Item.Tag := 1; + Item.Enabled := Edit.Text <> ''; + Menu.Items.Add(Item); + + Item := TMenuItem.Create(Menu); + Item.Caption := _('Empty recent filters'); + Item.ImageIndex := 26; + Item.OnClick := editDatabaseTableFilterMenuClick; + Item.Tag := 2; + Item.Enabled := Menu.Items.Count > 1; + Menu.Items.Add(Item); + + P := Edit.ClientToScreen(Edit.ClientRect.TopLeft); + Menu.Popup(p.X, p.Y+16); +end;} + + +{procedure TMainForm.editDatabaseTableFilterMenuClick(Sender: TObject); +var + Menu: TPopupMenu; + Item: TMenuItem; + Edit: TButtonedEdit; + Setting: TAppSettingIndex; +begin + // Insert text from filter history menu + Item := Sender as TMenuItem; + Menu := Item.Owner as TPopupMenu; + Edit := Menu.Owner as TButtonedEdit; + if Edit = editDatabaseFilter then + Setting := asDatabaseFilter + else if Edit = editTableFilter then + Setting := asTableFilter + else if Edit = editFilterVT then + Setting := asFilterVT + else + raise Exception.CreateFmt(MsgUnhandledControl, ['editDatabaseTableFilterMenuClick']); + case Item.Tag of + 0: Edit.Text := Item.Caption; + 1: Edit.Clear; + 2: AppSettings.DeleteValue(Setting); + end; + Menu.Free; +end;} + + +{procedure TMainForm.editDatabaseTableFilterExit(Sender: TObject); +var + History: TStringList; + Edit: TButtonedEdit; + i: Integer; + Setting: TAppSettingIndex; +begin + // Add (move) custom filter text to (in) drop down history, if not empty + Edit := Sender as TButtonedEdit; + AppSettings.SessionPath := ''; + if Edit = editDatabaseFilter then + Setting := asDatabaseFilter + else if Edit = editTableFilter then + Setting := asTableFilter + else if Edit = editFilterVT then + Setting := asFilterVT + else + raise Exception.CreateFmt(MsgUnhandledControl, ['editDatabaseTableFilterExit']); + History := TStringList.Create; + History.Text := AppSettings.ReadString(Setting); + i := History.IndexOf(Edit.Text); + if i > -1 then + History.Delete(i); + History.Insert(0, Edit.Text); + for i:=History.Count-1 downto 0 do begin + if (i >= 20) or (Trim(History[i]) = '') then + History.Delete(i); + end; + AppSettings.WriteString(Setting, History.Text); + History.Free; +end;} + + +{procedure TMainForm.CloseButtonOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + FLastMouseDownCloseButton := Sender; +end;} + + +{procedure TMainForm.CloseButtonOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +begin + // Click on "Close" button of Query tab + if Button <> mbLeft then + Exit; + // Between MousDown and MouseUp it is possible that the focused tab has switched. As we simulate a mouse-click + // here, we must check if also the MouseDown event was fired on this particular button. See issue #1469. + if (Sender <> FLastMouseDownCloseButton) then + Exit; + // Prevent EAccessViolation in TControl.GetClientWidth, see issue #1640 + TimerCloseTabByButton.Enabled := True; +end;} + + +{procedure TMainForm.TimerCloseTabByButtonTimer(Sender: TObject); +var + i: Integer; +begin + // Asynchronous timer for mousedown event on query tab close button + TimerCloseTabByButton.Enabled := False; + for i:=0 to QueryTabs.Count-1 do begin + if QueryTabs[i].CloseButton = FLastMouseDownCloseButton then begin + CloseQueryTab(QueryTabs[i].TabSheet.PageIndex); + break; + end; + end; +end;} + + +{procedure TMainForm.PageControlMainMouseUp(Sender: TObject; + Button: TMouseButton; Shift: TShiftState; X, Y: Integer); +var + CurTickcount: Cardinal; + TabNumber: Integer; +begin + // Handle click event on poor PageControl tabs in lack of an OnClick + case Button of + mbLeft: begin + // Simulate doubleclick on tab to close it + if AppSettings.ReadBool(asTabCloseOnDoubleClick) then begin + CurTickcount := GetTickCount; + TabNumber := GetMainTabAt(X, Y); + if (TabNumber = FLastTabNumberOnMouseUp) + and (CurTickcount - FLastMouseUpOnPageControl <= GetDoubleClickTime) then begin + CloseQueryTab(TabNumber); + end else begin + FLastMouseUpOnPageControl := CurTickcount; + FLastTabNumberOnMouseUp := TabNumber; + end; + end; + end; + + mbMiddle: begin + // Middle click on tab + if AppSettings.ReadBool(asTabCloseOnMiddleClick) then begin + TabNumber := GetMainTabAt(X, Y); + CloseQueryTab(TabNumber); + end; + end; + end; + +end;} + + +{function TMainForm.GetMainTabAt(X, Y: Integer): Integer; +var + i: Integer; +begin + // Return page index of main tab by coordinates + Result := PageControlMain.IndexOfTabAt(X, Y); + for i:=0 to PageControlMain.PageCount-1 do begin + if (i<=Result) and (not PageControlMain.Pages[i].TabVisible) then + Inc(Result); + end; +end;} + + +{procedure TMainForm.FixQueryTabCloseButtons; +var + i, PageIndex, VisiblePageIndex: Integer; + Rect: TRect; + btn: TSpeedButton; +begin + // Fix positions of "Close" buttons on Query tabs + // Avoid AV on Startup, when Mainform.OnResize is called once or twice implicitely. + if not Assigned(FBtnAddTab) then + Exit; + for PageIndex:=tabQuery.PageIndex+1 to PageControlMain.PageCount-1 do begin + VisiblePageIndex := PageIndex; + for i:=0 to PageControlMain.PageCount-1 do begin + if (i<=VisiblePageIndex) and (not PageControlMain.Pages[i].TabVisible) then + Dec(VisiblePageIndex); + end; + Rect := PageControlMain.TabRect(VisiblePageIndex); + btn := QueryTabs[PageIndex-tabQuery.PageIndex].CloseButton; + btn.Top := Rect.Top + 2; + btn.Left := Rect.Right - 19; + end; + // Set position of "Add tab" button + VisiblePageIndex := PageControlMain.PageCount-1; + for i:=0 to PageControlMain.PageCount-1 do begin + if not PageControlMain.Pages[i].TabVisible then + Dec(VisiblePageIndex); + end; + Rect := PageControlMain.TabRect(VisiblePageIndex); + FBtnAddTab.Top := Rect.Top; + FBtnAddTab.Left := Rect.Right + 5; +end;} + + +{function TMainForm.GetOrCreateEmptyQueryTab(DoFocus: Boolean): TQueryTab; +var + i: Integer; +begin + // Return either a) current query tab if one is active + // or b) the first empty one + // or c) create a new one + // Result should never be nil, unlike in QueryTabs.ActiveTab + Result := nil; + // Search empty tab + for i:=0 to QueryTabs.Count-1 do begin + if (QueryTabs[i].MemoFilename='') and (QueryTabs[i].Memo.GetTextLen=0) then begin + Result := QueryTabs[i]; + if DoFocus then + SetMainTab(Result.TabSheet); + Break; + end; + end; + // Create new tab + if Result = nil then begin + if DoFocus then + actNewQueryTabExecute(actNewQueryTab) + else + actNewQueryTabExecute(actNewQueryTabNofocus); + Result := QueryTabs[QueryTabs.Count-1]; + end; +end;} + + +{function TMainForm.ActiveSynMemo(AcceptReadOnlyMemo: Boolean): TSynMemo; +var + Control: TWinControl; +begin + Result := nil; + Control := Screen.ActiveControl; + if Control is TCustomSynEdit then begin + Result := Control as TSynMemo; + // We have a few readonly-SynMemos which we'll ignore here + if (not AcceptReadOnlyMemo) and Result.ReadOnly then + Result := nil; + end; + if (not Assigned(Result)) and QueryTabs.HasActiveTab then + Result := QueryTabs.ActiveMemo; + if (not Assigned(Result)) and (Screen.ActiveForm is TfrmTextEditor) then begin + Result := TfrmTextEditor(Screen.ActiveForm).MemoText; + end; + +end;} + + +{function TMainForm.ActiveGrid: TVirtualStringTree; +begin + // Return current data or query grid, if main form is active + Result := nil; + if Screen.ActiveForm <> Self then + Exit; + if PageControlMain.ActivePage = tabData then + Result := DataGrid + else if (QueryTabs.ActiveTab <> nil) and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then + Result := QueryTabs.ActiveTab.ActiveResultTab.Grid; +end;} + + +{function TMainForm.GridResult(Grid: TBaseVirtualTree): TDBQuery; +var + QueryTab: TQueryTab; + CurrentTab: TTabSheet; + ResultTab: TResultTab; +begin + // All grids (data- and query-grids, also host subtabs) are placed directly on a TTabSheet + Result := nil; + if Grid = DataGrid then begin + if DataGridResult<>nil then + Result := DataGridResult; + end else if Assigned(Grid) then begin + CurrentTab := Grid.Parent as TTabSheet; + if CurrentTab.Parent = PageControlHost then + Result := FHostListResults[CurrentTab.PageIndex] + else for QueryTab in QueryTabs do begin + if QueryTab.TabSheet = CurrentTab then begin + for ResultTab in QueryTab.ResultTabs do begin + if ResultTab.Grid = Grid then begin + Result := ResultTab.Results; + break; + end; + end; + end; + end; + end; +end;} + + +{function TMainForm.IsQueryTab(PageIndex: Integer; IncludeFixed: Boolean): Boolean; +var + Min: Integer; +begin + // Find out if the given main tab is a query tab + Min := tabQuery.PageIndex+1; + if IncludeFixed then Dec(Min); + Result := PageIndex >= Min; +end;} + +{procedure TMainForm.SetWindowCaption; +var + Cap: String; +begin + // Set window caption and taskbar text + Cap := DBtree.Path(DBtree.FocusedNode, 0, '\') + ' - ' + APPNAME; + if AppSettings.PortableMode then + Cap := Cap + ' Portable'; + Cap := Cap + ' ' + FAppVersion; + Caption := Cap; + Application.Title := Cap; +end;} + + +{procedure TMainForm.SetMainTab(Page: TTabSheet); +begin + // Safely switch main tab + if (Page <> nil) and (not FTreeRefreshInProgress) then begin + PagecontrolMain.ActivePage := Page; + PageControlMain.OnChange(Page); + end; +end;} + + +{procedure TMainForm.SetTabCaption(PageIndex: Integer; Text: String); +var + Tab: TQueryTab; +begin + // The current tab can be closed already if we're here after CloseQueryTab() + if PageIndex >= PageControlMain.PageCount then + Exit; + // Some cases pass -1 which triggers a "List index out of bounds" in below cast + if PageIndex = -1 then + Exit; + // Escape hotkey accelerator in name of session, database or table + Text := EscapeHotkeyPrefix(Text); + Text := StrEllipsis(Text, 70); + // Special case if passed text is empty: Reset query tab caption to "Query #123" + if (PageIndex = tabQuery.PageIndex) and (Text = '') then + Text := _('Query'); + if IsQueryTab(PageIndex, False) then begin + if Text = '' then begin + for Tab in QueryTabs do begin + if Tab.TabSheet = PageControlMain.Pages[PageIndex] then begin + Text := _('Query')+' #'+IntToStr(Tab.Number); + break; + end; + end; + end; + // Leave space for close button on closable query tabs + Text := Text + ' '; + end; + PageControlMain.Pages[PageIndex].Caption := Text; + FixQueryTabCloseButtons; +end;} + + +{function TMainForm.ConfirmTabClose(PageIndex: Integer; AppIsClosing: Boolean): Boolean; +var + Tab: TQueryTab; +begin + Tab := QueryTabs[PageIndex-tabQuery.PageIndex]; + if Tab.QueryRunning then begin + LogSQL(_('Cannot close tab with running query. Please wait until query has finished.')); + Result := False; + end else if not Tab.Memo.Modified then begin + Result := True; + end else begin + Result := ConfirmTabClear(PageIndex, AppIsClosing); + end; +end;} + + +{function TMainForm.ConfirmTabClear(PageIndex: Integer; AppIsClosing: Boolean): Boolean; +var + msg: String; + Tab: TQueryTab; + Dialog: TExtFileSaveDialog; + MsgButtons: TMsgDlgButtons; +begin + Tab := QueryTabs[PageIndex-tabQuery.PageIndex]; + + // Unhide tabsheet so the user sees the memo content. + // If the dialog is suppressed anyway, the user does not need to see the text, and we avoid + // storing this as the focused tab + if AppSettings.ReadBool(asPromptSaveFileOnTabClose) then begin + Tab.TabSheet.PageControl.ActivePage := Tab.TabSheet; + end; + + // Prompt for saving unsaved contents + if Tab.MemoFilename <> '' then + msg := f_('Save changes to file %s ?', [Tab.MemoFilename]) + else + msg := f_('Save content of tab "%s"?', [Trim(Tab.TabSheet.Caption)]); + if AppSettings.RestoreTabsInitValue and AppIsClosing then begin + msg := msg + CRLF + CRLF + _('Your code is saved anyway, as auto-restoring is activated.'); + end; + + if FConnections.Count > 0 then + MsgButtons := [mbYes, mbNo, mbCancel] + else + MsgButtons := [mbYes, mbNo]; + + case MessageDialog(_('Modified query'), msg, mtConfirmation, MsgButtons, asPromptSaveFileOnTabClose) of + mrNo: Result := True; + mrYes: begin + if Tab.MemoFilename <> '' then begin + Tab.SaveContents(Tab.MemoFilename, False); + Result := True; + end + else begin + Dialog := TExtFileSaveDialog.Create(Self); + Dialog.Options := Dialog.Options + [fdoOverwritePrompt]; + Dialog.AddFileType('*.sql', _('SQL files')); + Dialog.AddFileType('*.*', _('All files')); + Dialog.DefaultExtension := 'sql'; + Dialog.LineBreakIndex := Tab.MemoLineBreaks; + if Dialog.Execute then begin + Tab.SaveContents(Dialog.FileName, False); + Tab.MemoLineBreaks := Dialog.LineBreakIndex; + end; + // The save dialog can be cancelled. + Result := not Tab.Memo.Modified; + Dialog.Free; + end; + end; + else Result := False; + end; + + // Auto-backup logic + if AppSettings.RestoreTabsInitValue then begin + if AppIsClosing then begin + // Do last backup before app closes + Tab.BackupUnsavedContent; + end else begin + // Delete backup file if tab is closed by user, intentionally + if (not Tab.MemoBackupFilename.IsEmpty) and FileExists(Tab.MemoBackupFilename) then begin + if not DeleteFileWithUndo(Tab.MemoBackupFilename) then begin + ErrorDialog(f_('Backup file could not be deleted: %s', [Tab.MemoBackupFilename])); + end; + end; + end; + end; + + if (not Result) and (FConnections.Count = 0) then begin + // Upper right "X" button clicked, or save dialog cancelled + Result := True; + end; + + ValidateControls(Self); +end;} + + +{procedure TMainForm.actFilterPanelExecute(Sender: TObject); +begin + // (De-)activate or focus filter panel + if Sender <> actFilterPanel then + actFilterPanel.Checked := not actFilterPanel.Checked; + pnlFilterVT.Visible := actFilterPanel.Checked; + // On startup, we cannot SetFocus, throws exceptons. Call with nil in that special case - see FormCreate + if pnlFilterVT.Visible and editFilterVT.CanFocus and (Sender <> nil) then + editFilterVT.SetFocus; + UpdateFilterPanel(Sender); +end;} + + +{procedure TMainForm.UpdateFilterPanel(Sender: TObject); +var + tab: TTabSheet; + f: String; +begin + // Called when active tab changes + pnlFilterVT.Enabled := (PageControlMain.ActivePage <> tabEditor) or (ActiveObjectEditor is TfrmTableEditor); + lblFilterVT.Enabled := pnlFilterVT.Enabled; + editFilterVT.Enabled := pnlFilterVT.Enabled; + lblFilterVTInfo.Enabled := pnlFilterVT.Enabled; + if pnlFilterVT.Enabled then + editFilterVT.Color := GetThemeColor(clWindow) + else + editFilterVT.Color := GetThemeColor(clBtnFace); + + tab := PageControlMain.ActivePage; + if tab = tabHost then + tab := PageControlHost.ActivePage; + if not pnlFilterVT.Visible then begin + if editFilterVT.Text <> '' then + editFilterVT.Text := '' + else + editFilterVTChange(Sender); + end else begin + if tab = tabDatabases then f := FFilterTextDatabases + else if tab = tabVariables then f := FFilterTextVariables + else if tab = tabStatus then f := FFilterTextStatus + else if tab = tabProcesslist then f := FFilterTextProcessList + else if tab = tabCommandStats then f := FFilterTextCommandStats + else if tab = tabDatabase then f := FFilterTextDatabase + else if tab = tabEditor then f := FFilterTextEditor + else if tab = tabData then f := FFilterTextData + else if QueryTabs.HasActiveTab and (QueryTabs.ActiveTab.ActiveResultTab <> nil) then f := QueryTabs.ActiveTab.ActiveResultTab.FilterText; + if editFilterVT.Text <> f then + editFilterVT.Text := f + else + editFilterVTChange(Sender); + end; +end;} + + +{procedure TMainform.SetupSynEditors; +var + i, j: Integer; + Editors: TObjectList; + BaseEditor: TSynMemo; + KeyStroke: TSynEditKeyStroke; + Attri: TSynHighlighterAttributes; + Shortcut1, Shortcut2: TShortcut; +begin + // Setup all known TSynMemo's + // This version includes global settings for keyboard shortcut, highlighting and completion proposal + Editors := TObjectList.Create(False); + BaseEditor := SynMemoQuery; + for i:=0 to QueryTabs.Count-1 do + Editors.Add(QueryTabs[i].Memo); + Editors.Add(SynMemoFilter); + Editors.Add(SynMemoProcessView); + Editors.Add(SynMemoSQLLog); + if Assigned(ActiveObjectEditor) then + FindComponentInstances(ActiveObjectEditor, TSynMemo, Editors); + if Assigned(frmPreferences) then + Editors.Add(frmPreferences.SynMemoSQLSample); + if Assigned(FCreateDatabaseDialog) then + Editors.Add(FCreateDatabaseDialog.SynMemoCreateCode); + if SqlHelpDialog <> nil then begin + Editors.Add(SqlHelpDialog.memoDescription); + Editors.Add(SqlHelpDialog.MemoExample); + end; + if Assigned(FTableToolsDialog) then + Editors.Add(FTableToolsDialog.SynMemoFindText); + if Assigned(frmCsvDetector) then + Editors.Add(frmCsvDetector.SynMemoCreateTable); + + if AppSettings.ReadBool(asTabsToSpaces) then + BaseEditor.Options := BaseEditor.Options + [eoTabsToSpaces] + else + BaseEditor.Options := BaseEditor.Options - [eoTabsToSpaces]; + FMatchingBraceForegroundColor := StringToColor(AppSettings.ReadString(asSQLColMatchingBraceForeground)); + FMatchingBraceBackgroundColor := StringToColor(AppSettings.ReadString(asSQLColMatchingBraceBackground)); + FSynEditInOnPaintTransient := False; + + // Shortcuts + for j:=0 to BaseEditor.Keystrokes.Count-1 do begin + KeyStroke := BaseEditor.Keystrokes[j]; + Shortcut1 := AppSettings.ReadInt(asActionShortcut1, EditorCommandToCodeString(Keystroke.Command)); + Shortcut2 := AppSettings.ReadInt(asActionShortcut2, EditorCommandToCodeString(Keystroke.Command)); + try + if Shortcut1<>0 then + Keystroke.ShortCut := Shortcut1; + if Shortcut2<>0 then + Keystroke.ShortCut2 := Shortcut2; + except + on E:ESynKeyError do begin + LogSQL(f_('Could not apply SynEdit keystroke shortcut "%s" (or secondary: "%s") to %s. %s. Please go to %s > %s > %s to change this settings.', + [ + ShortCutToText(Shortcut1), + ShortCutToText(Shortcut2), + EditorCommandToCodeString(Keystroke.Command), + E.Message, + _('Tools'), + _('Preferences'), + _('Shortcuts') + ]), + lcError); + end; + end; + end; + // Apply events and options to all known editors + for i:=0 to Editors.Count-1 do begin + SetupSynEditor(Editors[i] as TSynMemo); + end; + Editors.Free; + // Highlighting + for i:=0 to SynSQLSynUsed.AttrCount - 1 do begin + Attri := SynSQLSynUsed.Attribute[i]; + Attri.Foreground := AppSettings.ReadInt(asHighlighterForeground, Attri.Name, Attri.Foreground); + Attri.Background := AppSettings.ReadInt(asHighlighterBackground, Attri.Name, Attri.Background); + // IntegerStyle gathers all font styles (bold, italic, ...) in one number + Attri.IntegerStyle := AppSettings.ReadInt(asHighlighterStyle, Attri.Name, Attri.IntegerStyle); + end; + // Completion proposal + if AppSettings.ReadBool(asCompletionProposalSearchOnMid) then + SynCompletionProposal.Options := SynCompletionProposal.Options + [scoLimitToMatchedTextAnywhere] + else + SynCompletionProposal.Options := SynCompletionProposal.Options - [scoLimitToMatchedTextAnywhere]; +end;} + + +{procedure TMainForm.SetupSynEditors(BaseForm: TComponent); +var + Editors: TObjectList; + i: Integer; +begin + // Restore font, highlighter and shortcuts for all TSynMemo's in given base form + Editors := TObjectList.Create(False); + FindComponentInstances(BaseForm, TSynMemo, Editors); + for i:=0 to Editors.Count-1 do begin + SetupSynEditor(Editors[i] as TSynMemo); + end; + Editors.Free; +end;} + + +{procedure TMainForm.SetupSynEditor(Editor: TSynMemo); +var + BaseEditor: TSynMemo; +begin + LogSQL('Setting up TSynMemo "'+Editor.Name+'"', lcDebug); + BaseEditor := SynMemoQuery; + Editor.Color := GetThemeColor(clWindow); + Editor.ScrollHintColor := GetThemeColor(clInfoBk); + Editor.Font.Name := AppSettings.ReadString(asFontName); + Editor.Font.Size := AppSettings.ReadInt(asFontSize); + Editor.Gutter.BorderColor := GetThemeColor(clWindow); + Editor.Gutter.Font.Name := Editor.Font.Name; + Editor.Gutter.Font.Size := Editor.Font.Size; + Editor.Gutter.Font.Color := BaseEditor.Gutter.Font.Color; + Editor.Gutter.AutoSize := BaseEditor.Gutter.AutoSize; + Editor.Gutter.DigitCount := BaseEditor.Gutter.DigitCount; + Editor.Gutter.LeftOffset := BaseEditor.Gutter.LeftOffset; + Editor.Gutter.RightOffset := BaseEditor.Gutter.RightOffset; + Editor.Gutter.ShowLineNumbers := BaseEditor.Gutter.ShowLineNumbers; + if Editor <> SynMemoSQLLog then begin + Editor.WordWrap := actQueryWordWrap.Checked; + // Assignment of OnScanForFoldRanges event is required for UseCodeFolding + Editor.OnScanForFoldRanges := BaseEditor.OnScanForFoldRanges; + Editor.UseCodeFolding := actCodeFolding.Checked; + end; + Editor.ActiveLineColor := StringToColor(AppSettings.ReadString(asSQLColActiveLine)); + Editor.Options := BaseEditor.Options; + if Editor = SynMemoSQLLog then + Editor.Options := Editor.Options + [eoRightMouseMovesCursor]; + Editor.TabWidth := AppSettings.ReadInt(asTabWidth); + Editor.MaxScrollWidth := BaseEditor.MaxScrollWidth; + Editor.WantTabs := BaseEditor.WantTabs; + Editor.HintMode := BaseEditor.HintMode; + Editor.OnKeyPress := BaseEditor.OnKeyPress; + Editor.OnMouseWheel := BaseEditor.OnMouseWheel; + Editor.OnTokenHint := BaseEditor.OnTokenHint; + if Editor <> SynMemoSQLLog then begin + Editor.OnPaintTransient := BaseEditor.OnPaintTransient; + end; + // Don't reapply shortcuts to base editor again, see issue 1600 + if Editor <> BaseEditor then begin + Editor.Keystrokes := BaseEditor.KeyStrokes; + end; +end;} + + +{procedure TMainForm.actReformatSQLExecute(Sender: TObject); +var + m: TCustomSynEdit; + CursorPosStart, CursorPosEnd: Integer; + Done: Boolean; +begin + // Reformat SQL query + m := ActiveSynMemo(False); + if not Assigned(m) then begin + ErrorDialog(_('Cannot reformat'), _('Please select a non-readonly SQL editor first.')); + Exit; + end; + CursorPosStart := m.SelStart; + CursorPosEnd := m.SelEnd; + if not m.SelAvail then + m.SelectAll; + if m.SelLength = 0 then + ErrorDialog(_('Cannot reformat'), _('The current editor is empty.')) + else begin + frmReformatter := TfrmReformatter.Create(Self); + frmReformatter.InputCode := m.SelText; + if AppSettings.ReadInt(asReformatterNoDialog) <> 0 then begin + frmReformatter.btnOkClick(Self); + Done := True; + end + else begin + Done := frmReformatter.ShowModal = mrOk; + end; + if Done then begin + Screen.Cursor := crHourglass; + m.UndoList.AddGroupBreak; + m.SelText := frmReformatter.OutputCode; + m.SelStart := CursorPosStart; + if CursorPosEnd > CursorPosStart then + m.SelEnd := CursorPosStart + Length(frmReformatter.OutputCode); + m.UndoList.AddGroupBreak; + Screen.Cursor := crDefault; + end; + frmReformatter.Free; + end; +end;} + + +{procedure TMainForm.PageControlMainContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); +var + ClickPoint: TPoint; + TabsHeight: Integer; +begin + // Activate tab popup menu only when clicked on tabs area. + TabsHeight := (FBtnAddTab.Height+2) * PageControlMain.RowCount; + if MousePos.Y <= TabsHeight then begin + ClickPoint := PageControlMain.ClientToScreen(MousePos); + popupMainTabs.Popup(ClickPoint.X, ClickPoint.Y); + Handled := True; + end else + Handled := False; +end;} + + +{procedure TMainForm.menuQueryHelpersGenerateStatementClick(Sender: TObject); +var + MenuItem: TMenuItem; + sql, Val, WhereClause: String; + i, idx: Integer; + ColumnNames, DefaultValues: TStringList; + KeyColumns: TTableColumnList; + Column: TTableColumn; + Tree: TVirtualStringTree; + Node: PVirtualNode; +begin + // Generate SELECT, INSERT, UPDATE or DELETE query using selected columns + MenuItem := (Sender as TMenuItem); + ColumnNames := TStringList.Create; + DefaultValues := TStringList.Create; + Tree := QueryTabs.ActiveHelpersTree; + Node := Tree.GetFirstChild(FindNode(Tree, TQueryTab.HelperNodeColumns, nil)); + while Assigned(Node) do begin + if Tree.Selected[Node] then begin + Column := SelectedTableColumns[Node.Index]; + ColumnNames.Add(Column.Connection.QuoteIdent(Tree.Text[Node, 0], False)); + case Column.DataType.Category of + dtcInteger, dtcReal: Val := '0'; + dtcText, dtcOther: begin + Val := Column.Connection.EscapeString(Column.DefaultText); + if Column.DefaultType in [cdtNull] then + Val := Column.Connection.EscapeString('') + else + Val := Column.Connection.EscapeString(Column.DefaultText); + end; + dtcTemporal: Val := 'NOW()'; + else Val := 'NULL'; + end; + if Column.DefaultType = cdtAutoInc then + Val := 'NULL'; + DefaultValues.Add(Val); + end; + Node := Tree.GetNextSibling(Node); + end; + KeyColumns := ActiveConnection.GetKeyColumns(SelectedTableColumns, SelectedTableKeys); + WhereClause := ''; + for i:=0 to KeyColumns.Count-1 do begin + idx := ColumnNames.IndexOf(ActiveConnection.QuoteIdent(KeyColumns[i].Name, False)); + if idx > -1 then begin + if WhereClause <> '' then + WhereClause := WhereClause + ' AND '; + WhereClause := WhereClause + ActiveConnection.QuoteIdent(KeyColumns[i].Name, False)+'='+DefaultValues[idx]; + end; + end; + + + if MenuItem = menuQueryHelpersGenerateSelect then begin + sql := 'SELECT ' + Implode(', ', ColumnNames) + SLineBreak + + CodeIndent + 'FROM '+ActiveDbObj.QuotedName(False); + + end else if MenuItem = menuQueryHelpersGenerateInsert then begin + sql := 'INSERT INTO ' + ActiveDbObj.QuotedName(False) + SLineBreak + + CodeIndent + '(' + Implode(', ', ColumnNames) + ')' + SLineBreak + + CodeIndent + 'VALUES (' + Implode(', ', DefaultValues) + ')'; + + end else if MenuItem = menuQueryHelpersGenerateUpdate then begin + sql := 'UPDATE ' + ActiveDbObj.QuotedName(False) + SLineBreak + CodeIndent + 'SET' + SLineBreak; + if ColumnNames.Count > 0 then begin + for i:=0 to ColumnNames.Count-1 do begin + sql := sql + CodeIndent(2) + ColumnNames[i] + '=' + DefaultValues[i] + ',' + SLineBreak; + end; + Delete(sql, Length(sql)-2, 1); + end else + sql := sql + CodeIndent(2) + '??? # No column names selected!' + SLineBreak; + sql := sql + CodeIndent + 'WHERE ' + WhereClause; + + end else if MenuItem = menuQueryHelpersGenerateDelete then begin + sql := 'DELETE FROM '+ActiveDbObj.QuotedName(False)+' WHERE ' + WhereClause; + + end; + QueryTabs.ActiveMemo.UndoList.AddGroupBreak; + QueryTabs.ActiveMemo.SelText := sql; +end;} + + +{procedure TMainForm.DBtreeAfterCellPaint(Sender: TBaseVirtualTree; + TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; + CellRect: TRect); +var + Obj: PDBObject; +begin + // Paint favorite icon on table node + if Column <> 0 then + Exit; + Obj := Sender.GetNodeData(Node); + if Obj.NodeType in [lntTable..lntEvent] then begin + if Obj.Connection.Favorites.IndexOf(Obj.Path) > -1 then + VirtualImageListMain.Draw(TargetCanvas, CellRect.Left, CellRect.Top, 168) + else if Node = Sender.HotNode then + VirtualImageListMain.Draw(TargetCanvas, CellRect.Left, CellRect.Top, 183); + end; +end;} + + +{procedure TMainForm.DBtreeMouseUp(Sender: TObject; Button: TMouseButton; + Shift: TShiftState; X, Y: Integer); +var + Obj: PDBObject; + Node: PVirtualNode; + idx: Integer; +begin + // Watch out for clicks on favorite icon + // Add or remove object path from favorite list on click + Node := DBtree.GetNodeAt(X, Y); + if (Button = mbLeft) and (X < VirtualImageListMain.Width) and Assigned(Node) then begin + Obj := DBtree.GetNodeData(Node); + if Obj.NodeType in [lntTable..lntEvent] then begin + idx := Obj.Connection.Favorites.IndexOf(Obj.Path); + if idx > -1 then + Obj.Connection.Favorites.Delete(idx) + else + Obj.Connection.Favorites.Add(Obj.Path); + DBtree.RepaintNode(Node); + AppSettings.SessionPath := Obj.Connection.Parameters.SessionPath; + AppSettings.WriteString(asFavoriteObjects, Obj.Connection.Favorites.Text); + end; + end; +end;} + + +{procedure TMainForm.DBtreeBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + var ContentRect: TRect); +var + DBObj: PDBObject; + AllObjects: TDBObjectList; +begin + if CellPaintMode=cpmPaint then try + DBObj := Sender.GetNodeData(Node); + if DbObj.Connection.Parameters.SessionColor <> AppSettings.GetDefaultInt(asTreeBackground) then begin + TargetCanvas.Brush.Color := DbObj.Connection.Parameters.SessionColor; + TargetCanvas.FillRect(CellRect); + end; + if (Column=1) and DBObj.Connection.DbObjectsCached(DBObj.Database) then begin + AllObjects := DBObj.Connection.GetDBObjects(DBObj.Database); + PaintColorBar(DBObj.Size, AllObjects.LargestObjectSize, TargetCanvas, CellRect); + end; + except; // Silence sporadic EAccessViolation when reading DbObj.Connection.Parameters, found in uploaded reports + end; +end;} + + +{procedure TMainForm.DBtreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode); +var + VT: TVirtualStringTree; +begin + // Resize "Size" column in dbtree to hold widest possible byte numbers without cutting text + VT := Sender as TVirtualStringTree; + if (VT.Header.Columns.Count >= 2) and (coVisible in VT.Header.Columns[1].Options) then + VT.Header.Columns[1].Width := TextWidth(VT.Canvas, FormatByteNumber(SIZE_MB*100)) + VT.TextMargin*2 + 8; +end;} + + +{procedure TMainForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; + var Handled: Boolean); +var + Control: TWinControl; + VT: TBaseVirtualTree; + PageControl: TPageControl; +begin + // Wheel scrolling only works in component which has focus. Help out by doing that by hand at least for any VirtualTree. + // See http://www.delphipraxis.net/viewtopic.php?p=1113607 + // TODO: Does not work when a SynMemo has focus, probably related to the broken solution of this issue: + // http://sourceforge.net/tracker/index.php?func=detail&aid=1574059&group_id=3221&atid=103221 + Control := FindVCLWindow(MousePos); + if (Control is TBaseVirtualTree) and (not Control.Focused) and PtInRect(Control.ClientRect, Control.ScreenToClient(MousePos)) then begin + VT := Control as TBaseVirtualTree; + VT.OffsetY := VT.OffsetY + (WheelDelta div 2); // Don't know why, but WheelDelta is twice as big as it normally appears + VT.UpdateScrollBars(True); + Handled := True; + end else if Control is TPageControl then begin + // Scroll tabs horizontally per mouse wheel + PageControl := Control as TPageControl; + if PageControl.MultiLine then begin + Handled := False; + end + else begin + PageControl.ScrollTabs(WheelDelta div WHEEL_DELTA); + if PageControl = PageControlMain then + FixQueryTabCloseButtons; + Handled := True; + end; + end else + Handled := False; +end;} + + +{procedure TMainForm.actDataResetSortingExecute(Sender: TObject); +begin + FDataGridSortItems.Clear; + InvalidateVT(DataGrid, VTREE_NOTLOADED_PURGECACHE, False); +end;} + + +{procedure TMainForm.WMCopyData(var Msg: TWMCopyData); +var + i: Integer; + Connection: TDBConnection; + Tab: TQueryTab; + ConnectionParams: TConnectionParameters; + FileNames: TStringList; + RunFrom: String; +begin + // Probably a second instance is posting its command line parameters here + if (Msg.CopyDataStruct.dwData = SecondInstMsgId) and (SecondInstMsgId <> 0) then begin + LogSQL(f_('Preventing second application instance - disabled in %s > %s > %s.', [_('Tools'), _('Preferences'), _('General')]), lcInfo); + ConnectionParams := nil; + ParseCommandLine(ParamBlobToStr(Msg.CopyDataStruct.lpData), ConnectionParams, FileNames, RunFrom); + if not RunQueryFiles(FileNames, nil, False) then begin + for i:=0 to FileNames.Count-1 do begin + Tab := GetOrCreateEmptyQueryTab(True); + Tab.LoadContents(FileNames[i], True, nil); + end; + end; + if ConnectionParams <> nil then + InitConnection(ConnectionParams, True, Connection); + end else + // Not the right message id + inherited; +end;} + + +{procedure TMainForm.CMStyleChanged(var Msg: TMessage); +begin + // Style theme applied, e.g. via preferences dialog + // Ensure SynMemo's have fitting colors + SetupSynEditors; +end;} + + +{procedure TMainForm.DefaultHandler(var Message); +begin + if TMessage(Message).Msg = SecondInstMsgId then begin + // A second instance asked for our handle. Post that into its message queue. + PostThreadMessage(TMessage(Message).WParam, SecondInstMsgId, Handle, 0); + end else + // Otherwise do what would happen without this overridden procedure + inherited; +end;} + + +{procedure TMainForm.actBlobAsTextExecute(Sender: TObject); +begin + // Activate displaying BLOBs as text data, ignoring possible weird effects in grid updates/inserts + DataGrid.InvalidateChildren(nil, True); +end;} + + +{procedure TMainForm.AnyGridScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); +begin + // A tree gets scrolled only when the mouse is over it - see FormMouseWheel + // Our home brewn cell editors do not reposition when the underlying tree scrolls. + // To avoid confusion, terminate editors then. + if Sender.IsEditing and (DeltaX=0) then + Sender.EndEditNode; +end;} + + +{procedure TMainForm.lblExplainProcessClick(Sender: TObject); +var + Tab: TQueryTab; + UsedDatabase: String; +begin + // Click on "Explain" link label, in process viewer + actNewQueryTabExecute(Sender); + Tab := QueryTabs[QueryTabs.Count-1]; + UsedDatabase := listProcesses.Text[listProcesses.FocusedNode, 3]; + if not UsedDatabase.IsEmpty then begin + Tab.Memo.Lines.Add('USE ' + ActiveConnection.QuoteIdent(UsedDatabase) + ';'); + end; + Tab.Memo.Lines.Add('EXPLAIN' + sLineBreak + SynMemoProcessView.Text + ';'); + Tab.TabSheet.Show; + actExecuteQueryExecute(Sender); +end;} + + +{procedure TMainForm.UpdateLineCharPanel; +var + x, y: Int64; + Grid: TVirtualStringTree; + AppendMsg: String; +begin + // Fill panel with "Line:Char" + x := -1; + y := -1; + AppendMsg := ''; + Grid := ActiveGrid; + if Assigned(Grid) and Grid.Focused then begin + if Assigned(Grid.FocusedNode) then + y := Grid.FocusedNode.Index+1; + x := Grid.FocusedColumn+1; + if Grid.SelectedCount > 1 then + AppendMsg := ' ('+FormatNumber(Grid.SelectedCount)+' sel)'; + end else if QueryTabs.HasActiveTab and QueryTabs.ActiveMemo.Focused then begin + x := QueryTabs.ActiveMemo.CaretX; + y := QueryTabs.ActiveMemo.CaretY; + AppendMsg := ' ('+FormatByteNumber(QueryTabs.ActiveMemo.GetTextLen)+')'; + end; + if (x > -1) and (y > -1) then begin + ShowStatusMsg('r'+FormatNumber(y)+' : c'+FormatNumber(x) + AppendMsg, 1) + end else + ShowStatusMsg('', 1); +end;} + +{procedure TMainForm.AnyGridStartOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); +begin + // Display status message on long running sort operations + if not MainFormCreated then begin + // Do nothing before form is not ready to process messages, what OperationRunning silently does. + // See issue #665 + Exit; + end; + if OperationKind = okSortTree then begin + ShowStatusMsg(_('Sorting grid nodes ...')); + FOperatingGrid := Sender; + OperationRunning(True); + end; +end;} + + +{procedure TMainForm.AnyGridEndOperation(Sender: TBaseVirtualTree; OperationKind: TVTOperationKind); +begin + // Reset status message after long running operations + if OperationKind = okSortTree then begin + ShowStatusMsg; + FOperatingGrid := nil; + OperationRunning(False); + end; +end;} + + +{procedure TMainForm.actCancelOperationExecute(Sender: TObject); +var + Killer: TDBConnection; + KillCommand: String; + Tab: TQueryTab; +begin + // Stop current operation (sorting grid or running user queries) + if FOperatingGrid <> nil then begin + FOperatingGrid.CancelOperation; + LogSQL(_('Sorting cancelled.')); + end; + for Tab in QueryTabs do begin + if Tab.QueryRunning then begin + Tab.ExecutionThread.Aborted := True; + Killer := ActiveConnection.Parameters.CreateConnection(Self); + Killer.Parameters := ActiveConnection.Parameters; + Killer.LogPrefix := _('Helper connection'); + Killer.OnLog := LogSQL; + try + Killer.Active := True; + KillCommand := Killer.GetSQLSpecifity(spKillQuery, [ActiveConnection.ThreadId]); + Killer.Query(KillCommand); + except + on E:EDbError do begin + MessageDialog(E.Message, mtError, [mbOK]); + end; + end; + Killer.Active := False; + Killer.Free; + end; + end; +end;} + + +{procedure TMainForm.OperationRunning(Runs: Boolean); +begin + if actCancelOperation.Enabled <> Runs then begin + actCancelOperation.ImageIndex := 159; + actCancelOperation.Enabled := Runs; + FOperationTicker := IfThen(Runs, GetTickCount, 0); + Application.ProcessMessages; + end else if Runs then begin + if (GetTickCount-FOperationTicker) > 250 then begin + // Signalize running operation + if actCancelOperation.ImageIndex = 159 then + actCancelOperation.ImageIndex := 160 + else + actCancelOperation.ImageIndex := 159; + Application.ProcessMessages; + FOperationTicker := GetTickCount; + end; + end; +end;} + + +{function TMainForm.GetEncodingByName(Name: String): TEncoding; +begin + Result := nil; + case FileEncodings.IndexOf(Name) of + 1: Result := TEncoding.Default; + 2: Result := TEncoding.GetEncoding(437); + 3: Result := TEncoding.Unicode; + 4: Result := TEncoding.BigEndianUnicode; + 5: Result := UTF8NoBOMEncoding; + 6: Result := TEncoding.UTF7; + 7: Result := TEncoding.UTF8; + end; +end;} + + +{function TMainForm.GetEncodingName(Encoding: TEncoding): String; +var + idx: Integer; +begin + if Encoding = TEncoding.Default then idx := 1 + else if (Encoding <> nil) and (Encoding.CodePage = 437) then idx := 2 + else if Encoding = TEncoding.Unicode then idx := 3 + else if Encoding = TEncoding.BigEndianUnicode then idx := 4 + else if Encoding = UTF8NoBOMEncoding then idx := 5 + else if Encoding = TEncoding.UTF7 then idx := 6 + else if Encoding = TEncoding.UTF8 then idx := 7 + else idx := 0; + Result := FileEncodings[idx]; +end;} + + +{function TMainForm.GetCharsetByEncoding(Encoding: TEncoding): String; +begin + Result := ''; + if Encoding = TEncoding.Default then begin + // Listing taken from http://forge.mysql.com/worklog/task.php?id=1349 + case GetACP of + 437: Result := 'cp850'; + 850: Result := 'cp850'; + 852: Result := 'cp852'; + 858: Result := 'cp850'; + 866: Result := 'cp866'; + 874: Result := 'tis620'; + 932: Result := 'cp932'; + 936: Result := 'gbk'; + 949: Result := 'euckr'; + 959: Result := 'big5'; + 1200: Result := 'utf16le'; + 1201: Result := 'utf16'; + 1250: Result := 'latin2'; + 1251: Result := 'cp1251'; + 1252: Result := 'latin1'; + 1253: Result := 'greek'; + 1254: Result := 'latin5'; + 1255: Result := 'hebrew'; + 1256: Result := 'cp1256'; + 1257: Result := 'cp1257'; + 10000: Result := 'macroman'; + 10001: Result := 'sjis'; + 10002: Result := 'big5'; + 10008: Result := 'gb2312'; + 10021: Result := 'tis620'; + 10029: Result := 'macce'; + 12001: Result := 'utf32'; + 20107: Result := 'swe7'; + 20127: Result := 'ascii'; + 20866: Result := 'koi8r'; + 20932: Result := 'ujis'; + 20936: Result := 'gb2312'; + 20949: Result := 'euckr'; + 21866: Result := 'koi8u'; + 28591: Result := 'latin1'; + 28592: Result := 'latin2'; + 28597: Result := 'greek'; + 28598: Result := 'hebrew'; + 28599: Result := 'latin5'; + 28603: Result := 'latin7'; + 28605: Result := 'latin9'; + 38598: Result := 'hebrew'; + 51932: Result := 'ujis'; + 51936: Result := 'gb2312'; + 51949: Result := 'euckr'; + 51950: Result := 'big5'; + 54936: Result := 'gb18030'; + 65001: Result := 'utf8'; + end; + end else if (Encoding <> nil) and (Encoding.CodePage = 437) then + Result := 'ascii' + else if Encoding = TEncoding.Unicode then + Result := 'utf16le' + else if Encoding = TEncoding.BigEndianUnicode then + Result := 'utf16' + else if Encoding = UTF8NoBOMEncoding then + Result := 'utf8' + else if Encoding = TEncoding.UTF7 then + Result := 'utf7' + else if Encoding = TEncoding.UTF8 then + Result := 'utf8' + // Auto-detection not supported here +end;} + + +{procedure TMainForm.treeQueryHelpersBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; + var ContentRect: TRect); +var + Tab: TQueryTab; + History: TQueryHistory; +begin + // Paint green value bar in cell + if (Node.Parent.Index=TQueryTab.HelperNodeProfile) + and (Column=1) + and (Sender.GetNodeLevel(Node)=1) + then begin + Tab := QueryTabs.TabByControl(Sender); + if Tab <> nil then begin + Tab.QueryProfile.RecNo := Node.Index; + PaintColorBar(MakeFloat(Tab.QueryProfile.Col(Column)), Tab.MaxProfileTime, TargetCanvas, CellRect); + end; + end; + if (Sender.GetNodeLevel(Node)=2) + and (Column=1) + and (Node.Parent.Parent.Index=TQueryTab.HelperNodeHistory) then begin + Tab := QueryTabs.TabByControl(Sender); + if Tab <> nil then begin + History := Tab.HistoryDays.Objects[Node.Parent.Index] as TQueryHistory; + PaintColorBar(History[Node.Index].Duration, History.MaxDuration, TargetCanvas, CellRect); + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; + Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); +var + History: TQueryHistory; + Tab: TQueryTab; +begin + // Paint text in datatype's color + if (Node.Parent.Index=TQueryTab.HelperNodeColumns) + and (Column=1) + and (Sender.GetNodeLevel(Node)=1) + and (ActiveDbObj.NodeType in [lntView, lntTable]) + then begin + TargetCanvas.Font.Color := DatatypeCategories[SelectedTableColumns[Node.Index].DataType.Category].Color; + end; + if (Sender.GetNodeLevel(Node)=2) + and (Node.Parent.Parent.Index=TQueryTab.HelperNodeHistory) + and (ActiveConnection <> nil) then begin + Tab := QueryTabs.TabByControl(Sender); + if Tab <> nil then begin + History := Tab.HistoryDays.Objects[Node.Parent.Index] as TQueryHistory; + if ActiveConnection.Database <> History[Node.Index].Database then + TargetCanvas.Font.Color := GetThemeColor(clGrayText); + end; + end; + + // If there is no value for bind variable, the font style is Italic and Underline + if (Sender.GetNodeLevel(Node)=1) + and (Column=1) + and (Node.Parent.Index=TQueryTab.HelperNodeBinding) then begin + Tab := QueryTabs.TabByControl(Sender); + if StrLen(PChar(Tab.ListBindParams.Items[Node.Index].Value)) = 0 then + TargetCanvas.Font.Style := [fsItalic]+[fsUnderline]; + + TargetCanvas.Font.Color := GetThemeColor(clGrayText); + + end; + +end;} + + +{procedure TMainForm.treeQueryHelpersResize(Sender: TObject); +var + Tree: TVirtualStringTree; +begin + // Resizing query helpers box: Keep second column at a minimum width. + Tree := Sender as TVirtualStringTree; + if Tree.Header.Columns.Count >= 2 then begin + // See https://github.com/HeidiSQL/HeidiSQL/issues/466 + // Column count may be 0 in an early stage of creating a new query tab + Tree.Header.Columns[1].Width := Max(Tree.Width div 3, 100); + end; +end;} + + +{procedure TMainForm.treeQueryHelpersDblClick(Sender: TObject); +var + m: TSynMemo; +begin + m := QueryTabs.ActiveMemo; + m.DragDrop(Sender, m.CaretX, m.CaretY); +end;} + + +{procedure TMainForm.treeQueryHelpersEditing(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); +begin + // If current column is value of Bind Param, we allow editing + if (Column = 1) + and (Sender.FocusedNode.Parent.Index = TQueryTab.HelperNodeBinding) then begin + Allowed := True; + end +end;} + + +{procedure TMainForm.treeQueryHelpersFocusChanging(Sender: TBaseVirtualTree; OldNode, + NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); +var + Tree: TVirtualStringTree; +begin + // Disable multi selection when snippet node is focused + Tree := Sender as TVirtualStringTree; + if not Assigned(NewNode) then + Exit; + if (Tree.GetNodeLevel(NewNode) = 0) or + (NewNode.Parent.Index=TQueryTab.HelperNodeSnippets) + then begin + Tree.ClearSelection; + Tree.TreeOptions.SelectionOptions := Tree.TreeOptions.SelectionOptions - [toMultiSelect] + end else + Tree.TreeOptions.SelectionOptions := Tree.TreeOptions.SelectionOptions + [toMultiSelect]; +end;} + + +{procedure TMainForm.treeQueryHelpersFreeNode(Sender: TBaseVirtualTree; + Node: PVirtualNode); +var + Tab: TQueryTab; +begin + // Free some memory, taken by probably big SQL query history items + if (Sender.GetNodeLevel(Node)=1) + and (Node.Parent.Index = TQueryTab.HelperNodeHistory) then begin + Tab := QueryTabs.TabByControl(Sender); + if Tab <> nil then begin + Tab.HistoryDays.Objects[Node.Index].Free; + Tab.HistoryDays.Delete(Node.Index); + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; + Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: TImageIndex); +begin + // Query helpers tree fetching node icon index + if not (Kind in [ikNormal, ikSelected]) then + Exit; + if Column <> 0 then + Exit; + case Sender.GetNodeLevel(Node) of + 0: case Node.Index of + TQueryTab.HelperNodeColumns: if (ActiveDbObj <> nil) and (ActiveDbObj.NodeType <> lntNone) then + ImageIndex := ActiveDbObj.ImageIndex + else + ImageIndex := 14; + TQueryTab.HelperNodeFunctions: ImageIndex := 13; + TQueryTab.HelperNodeKeywords: ImageIndex := 25; + TQueryTab.HelperNodeSnippets: ImageIndex := 51; + TQueryTab.HelperNodeHistory: ImageIndex := 149; + TQueryTab.HelperNodeProfile: ImageIndex := 145; + TQueryTab.HelperNodeBinding: ImageIndex := 119; + end; + 1: case Node.Parent.Index of + TQueryTab.HelperNodeColumns: ImageIndex := 42; + TQueryTab.HelperNodeFunctions: ImageIndex := 13; + TQueryTab.HelperNodeKeywords: ImageIndex := 25; + TQueryTab.HelperNodeSnippets: ImageIndex := 68; + TQueryTab.HelperNodeHistory: ImageIndex := 80; + TQueryTab.HelperNodeProfile: ImageIndex := 145; + TQueryTab.HelperNodeBinding: ImageIndex := 42; + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; + Column: TColumnIndex; TextType: TVSTTextType; var CellText: string); +var + History: TQueryHistory; + Tab: TQueryTab; + Conn: TDBConnection; +begin + // Query helpers tree fetching node text + CellText := ''; + Tab := QueryTabs.TabByControl(Sender); + case Column of + 0: case Sender.GetNodeLevel(Node) of + 0: case Node.Index of + TQueryTab.HelperNodeColumns: begin + CellText := _('Columns'); + if ActiveDbObj <> nil then case ActiveDbObj.NodeType of + lntProcedure, lntFunction: CellText := f_('Parameters in %s', [ActiveDbObj.Name]); + lntTable, lntView: CellText := f_('Columns in %s', [ActiveDbObj.Name]); + end; + end; + TQueryTab.HelperNodeFunctions: CellText := _('SQL functions'); + TQueryTab.HelperNodeKeywords: CellText := _('SQL keywords'); + TQueryTab.HelperNodeSnippets: CellText := _('Snippets'); + TQueryTab.HelperNodeHistory: CellText := _('Query history'); + TQueryTab.HelperNodeProfile: begin + CellText := _('Query profile'); + if Assigned(Tab.QueryProfile) then + CellText := CellText + ' ('+FormatNumber(Tab.ProfileTime, 6)+'s)'; + end; + TQueryTab.HelperNodeBinding: begin + CellText := _('Bind parameters'); + if(Tab.BindParamsActivated) then + CellText := CellText + ' ('+FormatNumber(Tab.ListBindParams.Count)+')'; + end; + end; + 1: case Node.Parent.Index of + TQueryTab.HelperNodeColumns: begin + if ActiveDbObj <> nil then case ActiveDbObj.NodeType of + lntTable, lntView: + if SelectedTableColumns.Count > Integer(Node.Index) then + CellText := SelectedTableColumns[Node.Index].Name; + lntFunction, lntProcedure: + if Assigned(ActiveObjectEditor) then + CellText := TfrmRoutineEditor(ActiveObjectEditor).Parameters[Node.Index].Name; + end; + end; + TQueryTab.HelperNodeFunctions: begin + Conn := ActiveConnection; + if (Conn <> nil) and (Conn.SQLFunctions.Count > Integer(Node.Index)) then + CellText := Conn.SQLFunctions[Node.Index].Name; + end; + TQueryTab.HelperNodeKeywords: CellText := MySQLKeywords[Node.Index]; + TQueryTab.HelperNodeSnippets: CellText := IfThen(Node.Index < Cardinal(FSnippetFilenames.Count), FSnippetFilenames[Node.Index], ''); + TQueryTab.HelperNodeHistory: begin + CellText := Tab.HistoryDays[Node.Index]; + if CellText = DateToStr(Today) then + CellText := CellText + ', '+_('today') + else if CellText = DateToStr(Yesterday) then + CellText := CellText + ', '+_('yesterday'); + end; + TQueryTab.HelperNodeProfile: begin + if Assigned(Tab.QueryProfile) then begin + Tab.QueryProfile.RecNo := Node.Index; + CellText := Tab.QueryProfile.Col(Column); + end; + end; + TQueryTab.HelperNodeBinding: CellText := Tab.ListBindParams[Node.Index].Name; + end; + 2: case Node.Parent.Parent.Index of + TQueryTab.HelperNodeHistory: begin + History := Tab.HistoryDays.Objects[Node.Parent.Index] as TQueryHistory; + CellText := Copy(TimeToStr(History[Node.Index].Time), 1, 5)+': '+History[Node.Index].SQL; + end + else CellText := ''; // unused + end; + end; + 1: case Sender.GetNodeLevel(Node) of + 0: CellText := ''; + 1: case Node.Parent.Index of + TQueryTab.HelperNodeColumns: begin + if (ActiveDbObj <> nil) + and (ActiveDbObj.NodeType in [lntTable, lntView]) + and (SelectedTableColumns.Count > Integer(Node.Index)) then begin + CellText := SelectedTableColumns[Node.Index].DataType.Name; + end; + end; + TQueryTab.HelperNodeFunctions: begin + Conn := ActiveConnection; + if (Conn <> nil) and (Conn.SQLFunctions.Count > Integer(Node.Index)) then + CellText := Conn.SQLFunctions[Node.Index].Declaration; + end; + TQueryTab.HelperNodeProfile: begin + if Assigned(Tab.QueryProfile) then begin + Tab.QueryProfile.RecNo := Node.Index; + CellText := FormatNumber(Tab.QueryProfile.Col(Column))+'s'; + end; + end; + TQueryTab.HelperNodeBinding: begin + // If value is empty, display MsgBindParamNoValue + if StrLen(PChar(Tab.ListBindParams[Node.Index].Value))>0 then + CellText := Tab.ListBindParams[Node.Index].Value + else + CellText := _('Set value'); + end; + else CellText := ''; + end; + 2: case Node.Parent.Parent.Index of + TQueryTab.HelperNodeHistory: begin + History := Tab.HistoryDays.Objects[Node.Parent.Index] as TQueryHistory; + CellText := FormatNumber(History[Node.Index].Duration / 1000, 3)+'s'; + end; + end; + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersInitNode(Sender: TBaseVirtualTree; ParentNode, + Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); +begin + // Query helpers tree asking if plus/minus button should be displayed + case Sender.GetNodeLevel(Node) of + 0: begin + Include(InitialStates, ivsHasChildren); + if Node.Index = TQueryTab.HelperNodeProfile then + Node.CheckType := ctCheckbox; + if Node.Index = TQueryTab.HelperNodeBinding then + Node.CheckType := ctCheckbox; + end; + 1: begin + AppSettings.ResetPath; + if (Node.Parent.Index = TQueryTab.HelperNodeHistory) and AppSettings.ReadBool(asQueryHistoryEnabled) then + Include(InitialStates, ivsHasChildren); + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersNewText(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; NewText: string); +var + Tree: TVirtualStringTree; + QueryTab: TQueryTab; +begin + Tree:= Sender as TVirtualStringTree; + QueryTab := QueryTabs.ActiveTab; + + // Save new param value + QueryTab.ListBindParams.Items[Sender.FocusedNode.Index].Value := NewText; + + Tree.RepaintNode(Node); +end;} + + +{procedure TMainForm.treeQueryHelpersNodeClick(Sender: TBaseVirtualTree; + const HitInfo: THitInfo); +var + Tree: TVirtualStringTree; +begin + Tree := Sender as TVirtualStringTree; + // If the column is clicked a parameter value, it goes directly into the edit mode + if (HitInfo.HitNode.Parent.Index = TQueryTab.HelperNodeBinding) and (HitInfo.HitColumn = 1) then + Tree.EditNode(Sender.FocusedNode,Sender.FocusedColumn); +end;} + + +{procedure TMainForm.treeQueryHelpersInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; + var ChildCount: Cardinal); +var + QueryDay: String; + History: TQueryHistory; + Item: TQueryHistoryItem; + Tab: TQueryTab; + i: Integer; + Conn: TDBConnection; +begin + Tab := QueryTabs.TabByControl(Sender); + Conn := ActiveConnection; + case Sender.GetNodeLevel(Node) of + 0: case Node.Index of + TQueryTab.HelperNodeColumns: begin + ChildCount := 0; + if ActiveDbObj <> nil then case ActiveDbObj.NodeType of + lntTable, lntView: + ChildCount := SelectedTableColumns.Count; + lntFunction, lntProcedure: + if Assigned(ActiveObjectEditor) then + ChildCount := TfrmRoutineEditor(ActiveObjectEditor).Parameters.Count + else + ChildCount := 0; + end; + end; + TQueryTab.HelperNodeFunctions: ChildCount := ActiveConnection.SQLFunctions.Count; + TQueryTab.HelperNodeKeywords: ChildCount := MySQLKeywords.Count; + TQueryTab.HelperNodeSnippets: ChildCount := FSnippetFilenames.Count; + TQueryTab.HelperNodeHistory: begin + AppSettings.ResetPath; + if AppSettings.ReadBool(asQueryHistoryEnabled) and (Conn <> nil) then begin + // Find all unique days in history + if not Assigned(Tab.HistoryDays) then + Tab.HistoryDays := TStringList.Create; + Tab.HistoryDays.Clear; + History := TQueryHistory.Create(Conn.Parameters.SessionPath); + for Item in History do begin + QueryDay := DateToStr(Item.Time); + if Tab.HistoryDays.IndexOf(QueryDay) = -1 then + Tab.HistoryDays.Add(QueryDay); + end; + History.Free; + Tab.HistoryDays.CustomSort(StringListCompareAnythingDesc); + ChildCount := Tab.HistoryDays.Count; + end; + end; + TQueryTab.HelperNodeProfile: if not Assigned(Tab.QueryProfile) then ChildCount := 0 + else ChildCount := Tab.QueryProfile.RecordCount; + TQueryTab.HelperNodeBinding: ChildCount := Tab.ListBindParams.Count; + end; + 1: case Node.Parent.Index of + TQueryTab.HelperNodeHistory: begin + if Conn <> nil then begin + History := TQueryHistory.Create(Conn.Parameters.SessionPath); + Tab.HistoryDays.Objects[Node.Index] := History; + for i:=History.Count-1 downto 0 do begin + QueryDay := DateToStr(History[i].Time); + if QueryDay <> Tab.HistoryDays[Node.Index] then + History.Delete(i); + end; + ChildCount := History.Count; + end; + end; + else ChildCount := 0; + end; + end; +end;} + + +{procedure TMainForm.SetSnippetFilenames; +var + Files: TStringDynArray; + Snip: String; + i: Integer; +begin + // Refreshing list of snippet file names needs to refresh helper node too + if not Assigned(FSnippetFilenames) then + FSnippetFilenames := TStringList.Create; + FSnippetFilenames.Clear; + try + Files := TDirectory.GetFiles(AppSettings.DirnameSnippets, '*.sql'); + for i:=0 to Length(Files)-1 do begin + Snip := ExtractFilename(Files[i]); + Snip := Copy(Snip, 1, Length(Snip)-4); + FSnippetFilenames.Add(snip); + end; + FSnippetFilenames.Sort; + except + on E:Exception do begin + LogSQL(f_('Error with snippets directory: %s', [E.Message]), lcError); + end; + end; + RefreshHelperNode(TQueryTab.HelperNodeSnippets); +end;} + + +{procedure TMainForm.treeQueryHelpersChecking(Sender: TBaseVirtualTree; + Node: PVirtualNode; var NewState: TCheckState; var Allowed: Boolean); +var + Tab: TQueryTab; + Tree: TVirtualStringTree; +begin + Tree := Sender as TVirtualStringTree; + Tab := QueryTabs.TabByControl(Sender); + + case Sender.GetNodeLevel(Node) of + + 0: case Node.Index of + TQueryTab.HelperNodeBinding: begin + // Disallow checkbox clicking on "Bind parameters" when text too big + if NewState in CheckedStates then begin + if Tab.Memo.GetTextLen < SIZE_MB then begin + Allowed := True; + Tab.TimerLastChange.Enabled := False; + Tab.TimerLastChange.Enabled := True; + LogSQL('Bind parameters enabled', lcDebug); + end + else begin + Allowed := False; + MessageDialog(_('The query is too long to enable detection of bind parameters'), mtError, [mbOK]); + end; + end + else begin + Allowed := True; + Tab.ListBindParams.Clear; + NewState := csUncheckedNormal; + Tree.ResetNode(Node); + LogSQL('Bind parameters disabled', lcDebug); + end; + end; + end; + + end; + +end;} + + +{procedure TMainForm.treeQueryHelpersContextPopup(Sender: TObject; MousePos: TPoint; + var Handled: Boolean); +var + Tree: TVirtualStringTree; +begin + Tree := Sender as TVirtualStringTree; + menuQueryHelpersGenerateSelect.Enabled := False; + menuQueryHelpersGenerateInsert.Enabled := False; + menuQueryHelpersGenerateUpdate.Enabled := False; + menuQueryHelpersGenerateDelete.Enabled := False; + menuInsertAtCursor.Enabled := False; + menuLoadSnippet.Enabled := False; + menuDeleteSnippet.Enabled := False; + menuExplore.Enabled := False; + menuHelp.Enabled := False; + menuClearQueryHistory.Enabled := False; + + case Tree.GetNodeLevel(Tree.FocusedNode) of + 0: ; + 1: case Tree.FocusedNode.Parent.Index of + TQueryTab.HelperNodeColumns: begin + if ActiveDbObj.NodeType in [lntTable, lntView] then begin + menuQueryHelpersGenerateSelect.Enabled := True; + menuQueryHelpersGenerateInsert.Enabled := True; + menuQueryHelpersGenerateUpdate.Enabled := True; + menuQueryHelpersGenerateDelete.Enabled := True; + menuInsertAtCursor.Enabled := True; + end; + end; + TQueryTab.HelperNodeFunctions: begin + menuHelp.Enabled := True; + menuInsertAtCursor.Enabled := True; + end; + TQueryTab.HelperNodeKeywords: begin + menuHelp.Enabled := True; + menuInsertAtCursor.Enabled := True; + end; + TQueryTab.HelperNodeSnippets: begin + menuDeleteSnippet.Enabled := True; + menuInsertAtCursor.Enabled := True; + menuLoadSnippet.Enabled := True; + menuExplore.Enabled := True; + end; + TQueryTab.HelperNodeProfile: begin // Query profile + + end; + TQueryTab.HelperNodeHistory: + menuClearQueryHistory.Enabled := True; + end; + 2: case Tree.FocusedNode.Parent.Parent.Index of + TQueryTab.HelperNodeHistory: begin + menuClearQueryHistory.Enabled := True; + menuInsertAtCursor.Enabled := True; + end; + end; + end; +end;} + + +{procedure TMainForm.treeQueryHelpersCreateEditor(Sender: TBaseVirtualTree; + Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); +var + InplaceEditor: TInplaceEditorLink; + VT: TVirtualStringTree; +begin + VT := Sender as TVirtualStringTree; + InplaceEditor := TInplaceEditorLink.Create(VT, True, nil); + InplaceEditor.ButtonVisible := true; + EditLink := InplaceEditor; +end;} + + +{procedure TMainForm.RefreshHelperNode(NodeIndex: Cardinal); +var + Tab: TQueryTab; + Node, Child: PVirtualNode; + OldStates: TVirtualNodeStates; + OldCheckState: TCheckState; + ExpandedChildren: TStringList; + Conn: TDBConnection; +begin + if not Assigned(QueryTabs) then + Exit; + Conn := ActiveConnection; + Tab := QueryTabs.ActiveTab; + if Tab = nil then + Exit; + Node := FindNode(Tab.treeHelpers, NodeIndex, nil); + // Store node + children states + OldStates := Node.States; + OldCheckState := Node.CheckState; + ExpandedChildren := TStringList.Create; + Child := Tab.treeHelpers.GetFirstChild(Node); + while Assigned(Child) do begin + if vsExpanded in Child.States then + ExpandedChildren.Add(IntToStr(Child.Index)); + Child := Tab.treeHelpers.GetNextSibling(Child); + end; + // Keep scroll offset + Tab.treeHelpers.BeginUpdate; + // Remove children and grandchildren + Tab.treeHelpers.ResetNode(Node); + // Restore old node + children states + Tab.treeHelpers.CheckState[Node] := OldCheckState; + Tab.treeHelpers.Expanded[Node] := vsExpanded in OldStates; + // Disable profiling when not on MySQL + if (NodeIndex = TQueryTab.HelperNodeProfile) and (Conn <> nil) and (not Conn.Parameters.IsAnyMySQL) then begin + Tab.treeHelpers.CheckState[Node] := csUncheckedNormal; + end; + // Do not check expansion state of children unless the parent node is expanded, to avoid + // initializing children when not required. Accesses registry items when doing so. + if Tab.treeHelpers.Expanded[Node] then begin + Child := Tab.treeHelpers.GetFirstChild(Node); + while Assigned(Child) do begin + Tab.treeHelpers.Expanded[Child] := ExpandedChildren.IndexOf(IntToStr(Child.Index)) > -1; + Child := Tab.treeHelpers.GetNextSibling(Child); + end; + end; + ExpandedChildren.Free; + Tab.treeHelpers.EndUpdate; +end;} + + +{procedure TMainForm.ApplicationEvents1Deactivate(Sender: TObject); +begin + // Force result tab balloon hint to disappear. Does not do so when mouse was moved too fast. + tabsetQueryMouseLeave(Sender); +end;} + + +{procedure TMainForm.ApplicationEvents1Idle(Sender: TObject; var Done: Boolean); +begin + if AppSettings.PortableMode + and (not AppSettings.PortableModeReadOnly) + and (FLastPortableSettingsSave < GetTickCount-60000) then begin + try + if AppSettings.Writes > FLastAppSettingsWrites then begin + if AppSettings.ExportSettings then + LogSQL(f_('Portable settings file written, with %d changes.', [AppSettings.Writes-FLastAppSettingsWrites]), lcDebug); + end; + FLastAppSettingsWrites := AppSettings.Writes; + FLastPortableSettingsSave := GetTickCount; + except + on E:Exception do + ErrorDialog(E.Message); + end; + Done := True; + end; + + // Sort list tables in idle time, so ListTables.TreeOptions.AutoSort does not crash the list + // when dropping a right-clicked database + if (PageControlMain.ActivePage = tabDatabase) and (not FListTablesSorted) then begin + ListTables.SortTree(ListTables.Header.SortColumn, ListTables.Header.SortDirection); + FListTablesSorted := True; + Done := True; + end; + + // Re-enable refresh action when application is idle + if (not actRefresh.Enabled) and (FRefreshActionDisabledAt < (GetTickCount - 1000)) then + begin + actRefresh.Enabled := True; + Done := True; + end; + +end;} + + +{procedure TMainForm.ApplicationEvents1ShortCut(var Msg: TWMKey; + var Handled: Boolean); +var + SendingControl: TComponent; + LastStart: Integer; + Edit: TCustomEdit; + Combo: TComboBox; + rx: TRegExpr; + TextMatches: Boolean; + PressedShortcut: TShortCut; + Act: TContainedAction; +begin + // Support for Ctrl+Backspace shortcut in edit + combobox controls + //LogSQL(msg.CharCode.ToString); + Handled := False; + if (Msg.CharCode = VK_BACK) and KeyPressed(VK_CONTROL) then begin + SendingControl := Screen.ActiveControl; + rx := TRegExpr.Create; + rx.Expression := '\b\W*\w+\W*$'; + if SendingControl is TCustomEdit then begin + Edit := TCustomEdit(SendingControl); + LastStart := Edit.SelStart; + TextMatches := rx.Exec(Copy(Edit.Text, 1, LastStart)); + if TextMatches then begin + Edit.SelStart := rx.MatchPos[0]-1; + Edit.SelLength := LastStart - Edit.SelStart; + // wParam=1 supports undo, in contrast to setting Edit.SelText + if IsWine then + Edit.SelText := '' + else + SendMessage(Edit.Handle, EM_REPLACESEL, 1, LongInt(PChar(''))); + end; + Handled := True; + end + else if SendingControl is TComboBox then begin + Combo := TComboBox(SendingControl); + LastStart := Combo.SelStart; + TextMatches := rx.Exec(Copy(Combo.Text, 1, LastStart)); + if TextMatches then begin + Combo.SelStart := rx.MatchPos[0]-1; + Combo.SelLength := LastStart - Combo.SelStart; + Combo.SelText := ''; + end; + Handled := True; + end; + LogSQL('Caught Ctrl+Backspace shortcut in '+SendingControl.ClassName+ + ', expression "'+rx.Expression+'" matched: '+TextMatches.ToInteger.ToString, + lcDebug); + rx.Free; + + end else begin + // Listen to certain shortcut(s) in other forms than mainform, which do not listen to ActionList + PressedShortcut := ShortCut(Msg.CharCode, KeyDataToShiftState(Msg.KeyData)); + for Act in ActionList1 do begin + if (Act = actSynEditCompletionPropose) + or (Act = actQueryFind) // Support find/replace on grid text editor + or (Act = actQueryFindAgain) + or (Act = actQueryReplace) + then begin + + if PressedShortcut = Act.ShortCut then begin + Act.Execute; + Handled := True; + Break; + end; + + end; + end; + + end; +end;} + +{procedure TMainForm.ApplicationDeActivate(Sender: TObject); +begin + // Prevent completion window from showing up after Alt-Tab. See issue #2640 + // and issue #3342 + // Does not work for some reason in TApplicationEvents.OnDeactivate + // Triggers an EAccessViolation when changing some VCL styles + try + SynCompletionProposal.Form.Enabled := False; + except + on E:EAccessViolation do + LogSQL(E.Message, lcError); + end; + // Gets activated again in SynCompletionProposalExecute +end;} + + +{procedure TMainForm.ApplicationShowHint(var HintStr: string; var CanShow: Boolean; var HintInfo: THintInfo); +var + MainTabIndex, QueryTabIndex, NewHideTimeout: integer; + pt: TPoint; + Conn: TDBConnection; + Editor: TSynMemo; +begin + if HintInfo.HintControl = PageControlMain then begin + // Show full filename in tab hint. See issue #3527 + // Code taken from http://www.delphipraxis.net/97988-tabsheet-hint-funktioniert-nicht.html + pt := PageControlMain.ScreenToClient(Mouse.CursorPos); + MainTabIndex := GetMainTabAt(pt.X, pt.Y); + QueryTabIndex := MainTabIndex - tabQuery.PageIndex; + if (QueryTabIndex >= 0) and (QueryTabIndex < QueryTabs.Count) then begin + HintStr := QueryTabs[QueryTabIndex].MemoFilename; + end + else if MainTabIndex = tabHost.TabIndex then begin + Conn := ActiveConnection; + HintStr := Conn.Parameters.Hostname; + if Conn.Parameters.IsAnySQLite then + HintStr := StringReplace(HintStr, DELIM, SLineBreak, [rfReplaceAll]); + end; + HintInfo.ReshowTimeout := 1000; + SetHintFontByControl; + end + else if HintInfo.HintControl is TSynMemo then begin + // Token hint displaying through SynEdit's OnTokenHint event + Editor := TSynMemo(HintInfo.HintControl); + SetHintFontByControl(Editor); + NewHideTimeout := Min(Length(HintStr) * 100, 60*1000); + if NewHideTimeout > HintInfo.HideTimeout then + HintInfo.HideTimeout := NewHideTimeout; + end + else begin + // Probably reset hint font + SetHintFontByControl; + end; +end;} + + +{procedure TMainForm.actToggleCommentExecute(Sender: TObject); +var + Editor: TSynMemo; + rx: TRegExpr; + Sel: TStringList; + i: Integer; + IsComment: Boolean; +begin + // Un/comment selected SQL + Editor := ActiveSynMemo(False); + Editor.UndoList.AddGroupBreak; + rx := TRegExpr.Create; + rx.Expression := '^(\s*)(\-\- |#)?(.*)$'; + if not Editor.SelAvail then begin + rx.Exec(Editor.LineText); + if rx.MatchLen[2] > 0 then begin + Editor.LineText := rx.Match[1] + rx.Match[3]; + Editor.CaretX := Editor.CaretX - rx.MatchLen[2]; + end else begin + Editor.LineText := '-- '+Editor.LineText; + Editor.CaretX := Editor.CaretX + 3; + end; + end else begin + Sel := Explode(CRLF, Editor.SelText); + IsComment := False; + for i:=0 to Sel.Count-1 do begin + rx.Exec(Sel[i]); + if i = 0 then + IsComment := rx.MatchLen[2] > 0; + if IsComment then + Sel[i] := rx.Match[1] + rx.Match[3] + else + Sel[i] := '-- '+Sel[i]; + end; + Editor.SelText := Implode(CRLF, Sel); + if Assigned(Editor.OnStatusChange) then + Editor.OnStatusChange(Editor, [scCaretX]); + end; +end;} + + +{procedure TMainForm.EnableProgress(MaxValue: Integer); +begin + // Initialize progres bar and button + SetProgressState(pbsNormal); + ProgressBarStatus.Visible := True and (not IsWine); + SetProgressPosition(0); + ProgressBarStatus.Max := MaxValue; +end;} + + +{procedure TMainForm.DisableProgress; +begin + // Hide global progress bar + SetProgressPosition(0); + ProgressBarStatus.Hide; + if Assigned(TaskBarList3) then + TaskBarList3.SetProgressState(Handle, 0); +end;} + + +{procedure TMainForm.SetProgressPosition(Value: Integer); +begin + // Advance progress bar and task progress position + try + ProgressBarStatus.Position := Value; + except + // Silence "Floating point division by zero." - see https://www.heidisql.com/forum.php?t=26218 + on E:EZeroDivide do; + end; + ProgressBarStatus.Repaint; + if Assigned(TaskBarList3) then + TaskBarList3.SetProgressValue(Handle, Value, ProgressBarStatus.Max); +end;} + + +{procedure TMainForm.ProgressStep; +begin + SetProgressPosition(ProgressBarStatus.Position+1); +end;} + + +{procedure TMainForm.SetProgressState(State: TProgressbarState); +var + Flag: Integer; +begin + // Set error or pause state in progress bar or task button + ProgressBarStatus.State := State; + ProgressBarStatus.Repaint; + if Assigned(TaskBarList3) then begin + case State of + pbsNormal: Flag := 2; + pbsError: Flag := 4; + pbsPaused: Flag := 8; + else Flag := 0; + end; + TaskBarList3.SetProgressState(Handle, Flag); + end; +end;} + + +{procedure TMainForm.TaskDialogHyperLinkClicked(Sender: TObject); +begin + // Used by hyperlinks in helpers.MessageDialog() + if Sender is TTaskDialog then + ShellExec(TTaskDialog(Sender).URL); +end;} + + +{function TMainForm.HasDonated(ForceCheck: Boolean): TThreeStateBoolean; +var + Email, CheckResult: String; + rx: TRegExpr; + CheckWebpage: THttpDownload; +begin + Screen.Cursor := crHourGlass; + if (FHasDonatedDatabaseCheck = nbUnset) or (ForceCheck) then begin + Email := AppSettings.ReadString(asDonatedEmail); + if Email = '' then begin + // Nothing to check, we know this is not valid + FHasDonatedDatabaseCheck := nbFalse; + end else begin + // Check heidisql.com/hasdonated.php?email=... + // FHasDonatedDatabaseCheck + // = 0 : No check yet done + // = 1 : Not a donor + // = 2 : Valid donor + rx := TRegExpr.Create; + CheckWebpage := THttpDownload.Create(MainForm); + CheckWebpage.URL := APPDOMAIN + 'hasdonated.php?email='+EncodeURLParam(Email); + try + CheckWebpage.SendRequest(''); + CheckResult := CheckWebpage.LastContent; + LogSQL('HTTP response: "'+CheckResult+'"', lcDebug); + rx.Expression := '^\d'; + if rx.Exec(CheckResult) then begin + if CheckResult = '0' then + FHasDonatedDatabaseCheck := nbFalse + else + FHasDonatedDatabaseCheck := nbTrue; + end; + except + on E:Exception do begin + LogSQL(E.Message + sLineBreak + 'HTTP response: "'+CheckResult+'"', lcError); + FHasDonatedDatabaseCheck := nbUnset; // Could have been set before, when ForceCheck=true + end; + end; + CheckWebpage.Free; + rx.Free; + end; + end; + Result := FHasDonatedDatabaseCheck; + Screen.Cursor := crDefault; +end;} + + +{procedure TMainForm.actPreviousResultExecute(Sender: TObject); +var + Tab: TQueryTab; +begin + // Go back to the result tab left to the active one + Tab := QueryTabs.ActiveTab; + if Tab <> nil then begin + if Tab.tabsetQuery.TabIndex > 0 then + Tab.tabsetQuery.SelectNext(False) + else + MessageBeep(MB_ICONEXCLAMATION); + end; +end;} + + +{procedure TMainForm.actNextResultExecute(Sender: TObject); +var + Tab: TQueryTab; +begin + // Advance to the next result tab + Tab := QueryTabs.ActiveTab; + if Tab <> nil then begin + if Tab.tabsetQuery.TabIndex < Tab.tabsetQuery.Tabs.Count-1 then + Tab.tabsetQuery.SelectNext(True) + else + MessageBeep(MB_ICONEXCLAMATION); + end; +end;} + + +{function TMainForm.SelectedTableFocusedColumn: TTableColumn; +var + Col: TTableColumn; +begin + // Return column object of focused data grid column. + // DataGrid columns can be deselected by user, but SelectedTableColumns has all of them, + // so we cannot access them by their 0-based number. Instead, search by name/caption. + Result := nil; + for Col in SelectedTableColumns do begin + if Col.Name = DataGrid.Header.Columns[DataGrid.FocusedColumn].Text then begin + Result := Col; + Break; + end; + end; +end;} + + + + +{ TQueryTab } + + +{constructor TQueryTab.Create; +begin + // Creation of a new main query tab + DirectoryWatch := TDirectoryWatch.Create; + DirectoryWatch.WatchSubTree := False; + DirectoryWatch.OnNotify := DirectoryWatchNotify; + DirectoryWatch.OnError := DirectoryWatchErrorHandler; + // Do not trigger useless file deletion messages, see issue #2948 + DirectoryWatch.WatchActions := DirectoryWatch.WatchActions - [waRemoved]; + // Do not trigger file access. See https://www.heidisql.com/forum.php?t=15500 + DirectoryWatch.WatchOptions := DirectoryWatch.WatchOptions - [woLastAccess]; + // Timer which postpones calling waModified event code until buffers have been saved + MemofileModifiedTimer := TTimer.Create(Memo); + MemofileModifiedTimer.Interval := 1000; + MemofileModifiedTimer.Enabled := False; + MemofileModifiedTimer.OnTimer := MemofileModifiedTimerNotify; + LastSaveTime := 0; + FLastChange := 0; + TimerLastChange := TTimer.Create(Self); + TimerLastChange.Enabled := True; + TimerLastChange.OnTimer := TimerLastChangeOnTimer; + // Contain 2 columns of String : Params & Values + ListBindParams := TListBindParam.Create; + // Update status bar every second while query runs + TimerStatusUpdate := TTimer.Create(Self); + TimerStatusUpdate.Enabled := False; + TimerStatusUpdate.Interval := 100; + TimerStatusUpdate.OnTimer := TimerStatusUpdateOnTimer; + FFileEncoding := 'UTF-8'; +end;} + + +{destructor TQueryTab.Destroy; +begin + ResultTabs.Clear; + DirectoryWatch.Free; + ListBindParams.Free; + TimerLastChange.Free; + TimerStatusUpdate.Free; +end;} + + +{function TQueryTab.GetActiveResultTab: TResultTab; +var + idx: Integer; +begin + Result := nil; + idx := tabsetQuery.TabIndex; + if (idx > -1) and (idx < ResultTabs.Count) then + Result := ResultTabs[idx]; +end;} + + +{procedure TQueryTab.DirectoryWatchNotify(const Sender: TObject; const Action: TWatchAction; const FileName: string); +var + IsCurrentFile: Boolean; +begin + // Notification about file changes in loaded file's directory + + if FDirectoryWatchNotficationRunning then + Exit; + FDirectoryWatchNotficationRunning := True; + + IsCurrentFile := DirectoryWatch.Directory + FileName = MemoFilename; + case Action of + waRemoved: + if IsCurrentFile + and (MessageDialog(_('Close file and query tab?'), f_('File was deleted from outside: %s', [MemoFilename]), mtConfirmation, [mbYes, mbCancel]) = mrYes) then begin + Mainform.actClearQueryEditor.Execute; + if Mainform.IsQueryTab(TabSheet.PageIndex, False) then + Mainform.CloseQueryTab(TabSheet.PageIndex); + end; + + waModified: + if IsCurrentFile and (LastSaveTime < GetTickCount-MemofileModifiedTimer.Interval) then begin + MemofileModifiedTimer.Enabled := False; + MemofileModifiedTimer.Enabled := True; + end; + + waRenamedOld: + if IsCurrentFile then + MemoFileRenamed := True; + + waRenamedNew: + if (not IsCurrentFile) and (MemoFilename <> '') and MemoFileRenamed then begin + MemoFilename := DirectoryWatch.Directory + FileName; + MemoFileRenamed := False; + end; + + end; + FDirectoryWatchNotficationRunning := False; +end;} + + +{procedure TQueryTab.DirectoryWatchErrorHandler(const Sender: TObject; const ErrorCode: Integer; const ErrorMessage: string); +begin + MainForm.LogSQL(Format('File watcher (%d): %s', [ErrorCode, ErrorMessage]), lcError); +end;} + + +{procedure TQueryTab.MemofileModifiedTimerNotify(Sender: TObject); +var + OldTopLine: Integer; + OldCursor: TBufferCoord; +begin + (Sender as TTimer).Enabled := False; + if FDirectoryWatchNotficationRunning then + Exit; + FDirectoryWatchNotficationRunning := True; + if MessageDialog(_('Reload file?'), f_('File was modified from outside: %s', [MemoFilename]), mtConfirmation, [mbYes, mbCancel]) = mrYes then begin + OldCursor := Memo.CaretXY; + OldTopLine := Memo.TopLine; + LoadContents(MemoFilename, True, nil); + Memo.CaretXY := OldCursor; + Memo.TopLine := OldTopLine; + end; + FDirectoryWatchNotficationRunning := False; +end;} + + +{function TQueryTab.LoadContents(Filepath: String; ReplaceContent: Boolean; Encoding: TEncoding): Boolean; +var + Content: String; + Filesize: Int64; + LineBreaks: TLineBreaks; + LoadSuccess: Boolean; +begin + // Load file and add that to the undo-history of SynEdit. + // Normally we would do a simple SynMemo.Lines.LoadFromFile but + // this would prevent SynEdit from adding this step to the undo-history + // so we have to do it by replacing the SelText property + Result := False; + Screen.Cursor := crHourGlass; + Filesize := _GetFileSize(Filepath); + LoadSuccess := False; + MainForm.LogSQL(f_('Loading file "%s" (%s) into query tab #%d', [Filepath, FormatByteNumber(Filesize), Number]), lcInfo); + try + Content := ReadTextfile(Filepath, Encoding); + LoadSuccess := True; + except on E:Exception do + // File does not exist, is locked or broken + ErrorDialog(E.message + sLineBreak + sLineBreak + Filepath); + end; + + if LoadSuccess then begin + if Pos(AppSettings.DirnameSnippets, Filepath) = 0 then + MainForm.AddOrRemoveFromQueryLoadHistory(Filepath, True, True); + Memo.UndoList.AddGroupBreak; + LineBreaks := ScanLineBreaks(Content); + if ReplaceContent then begin + Memo.Clear; + MemoLineBreaks := LineBreaks; + end else begin + if (MemoLineBreaks <> lbsNone) and (MemoLineBreaks <> LineBreaks) then + MemoLineBreaks := lbsMixed + else + MemoLineBreaks := LineBreaks; + end; + if MemoLineBreaks = lbsMixed then + MessageDialog(_('This file contains mixed linebreaks. They have been converted to Windows linebreaks (CR+LF).'), mtInformation, [mbOK]); + + if ReplaceContent then + Memo.Text := Content + else + Memo.SelText := Content; + Memo.SelStart := Memo.SelEnd; + Memo.Modified := False; + MemoFilename := Filepath; + FileEncoding := MainForm.GetEncodingName(Encoding); + //showmessage(FileEncoding); + Result := True; + end; + + Screen.Cursor := crDefault; +end;} + + +{procedure TQueryTab.SaveContents(Filename: String; OnlySelection: Boolean); +var + Text, LB, FileDir: String; +begin + Screen.Cursor := crHourGlass; + MainForm.ShowStatusMsg(_('Saving file ...')); + if OnlySelection then + Text := Memo.SelText + else + Text := Memo.Text; + LB := GetLineBreak(MemoLineBreaks); + if LB <> CRLF then + Text := StringReplace(Text, CRLF, LB, [rfReplaceAll]); + try + FileDir := ExtractFilePath(Filename); + if not DirectoryExists(FileDir) then + ForceDirectories(FileDir); + SaveUnicodeFile(Filename, Text, MainForm.GetEncodingByName(FFileEncoding)); + MemoFilename := Filename; + Memo.Modified := False; + LastSaveTime := GetTickCount; + Screen.Cursor := crDefault; + except + on E:Exception do begin + Screen.Cursor := crDefault; + ErrorDialog(E.Message); + end; + end; + MainForm.ShowStatusMsg; +end;} + + +{class function TQueryTab.GenerateUid: String; +begin + // Generate fresh unique id for a new tab + // Keep it readable by using the date with milliseconds + DateTimeToString(Result, 'yyyy-mm-dd_hh-nn-ss-zzz', Now); +end;} + + +{function TQueryTab.MemoBackupFilename: String; +begin + // Return filename for auto-backup feature + if (MemoFilename <> '') and (not Memo.Modified) then begin + Result := ''; + end else begin + Result := IncludeTrailingBackslash(AppSettings.DirnameBackups) + + ValidFilename(Format(BACKUP_FILEPATTERN, [Uid])) + ; + end; +end;} + + +{procedure TQueryTab.BackupUnsavedContent; +var + LastFileBackup: TDateTime; +begin + // Fired before closing application, and also timer controlled + + // Check if content is a user stored file and if it has modified content: + if MemoBackupFilename.IsEmpty then + Exit; + + // Check if existing backup file is up-to-date: + if FileExists(MemoBackupFilename) then begin + FileAge(MemoBackupFilename, LastFileBackup); + if LastFileBackup > FLastChange then + Exit; + end; + + if Memo.GetTextLen = 0 then begin + // If memo is empty, remove backup file + if FileExists(MemoBackupFilename) then begin + if not DeleteFile(MemoBackupFilename) then begin + MainForm.LogSQL('Could not remove empty backup file "'+MemoBackupFilename+'"', lcError); + end; + end; + end else begin + if Memo.GetTextLen < SIZE_MB*10 then begin + MainForm.LogSQL('Saving backup file to "'+MemoBackupFilename+'"...', lcDebug); + MainForm.ShowStatusMsg(_('Saving backup file...')); + SaveUnicodeFile(MemoBackupFilename, Memo.Text, UTF8NoBOMEncoding); + end else begin + MainForm.LogSQL('Unsaved tab contents too large (> 10M) for creating a backup.', lcDebug); + end; + end; + MainForm.ShowStatusMsg(''); +end;} + + +{function TQueryTab.GetBindParamsActivated: Boolean; +var + Node: PVirtualNode; +begin + // Return state of bind params checkbox + Result := False; + Node := FindNode(treeHelpers, TQueryTab.HelperNodeBinding, nil); + if Assigned(Node) then + Result := treeHelpers.CheckState[Node] in CheckedStates; +end;} + + +{procedure TQueryTab.SetBindParamsActivated(Value: Boolean); +var + Node: PVirtualNode; +begin + // Check bind params checkbox + Node := FindNode(treeHelpers, TQueryTab.HelperNodeBinding, nil); + if Value then + treeHelpers.CheckState[Node] := csCheckedNormal + else + treeHelpers.CheckState[Node] := csUncheckedNormal; +end;} + + +{procedure TQueryTab.SetErrorLine(Value: Integer); +begin + if Value <> FErrorLine then begin + FErrorLine := Value; + Memo.Repaint; + end; +end;} + + +{procedure TQueryTab.SetMemoFilename(Value: String); +begin + FMemoFilename := Value; + MainForm.SetTabCaption(TabSheet.PageIndex, ExtractFilename(FMemoFilename)); + MainForm.ValidateQueryControls(Self); + if (FMemoFilename <> '') and FileExists(FMemoFilename) then begin + DirectoryWatch.Directory := ExtractFilePath(FMemoFilename); + DirectoryWatch.Start; + end else + DirectoryWatch.Stop; +end;} + + +{procedure TQueryTab.SetQueryRunning(Value: Boolean); +begin + // Marker for query tab that it is currently executing and waiting for a query + FQueryRunning := Value; + TimerStatusUpdate.Enabled := Value; +end;} + + +{procedure TQueryTab.TimerLastChangeOnTimer(Sender: TObject); +var + rx: TRegExpr; + BindParam: TBindParam; + ParamCountBefore: Integer; + Node : PVirtualNode; + ParamName: String; + ParamFound: Boolean; +begin + TimerLastChange.Enabled := False; + + if not BindParamsActivated then + Exit; + if Memo.GetTextLen > SIZE_MB then begin + MessageDialog(_('The query is too long to enable detection of bind parameters'), mtError, [mbOK]); + Node := FindNode(treeHelpers, TQueryTab.HelperNodeBinding, nil); + treeHelpers.CheckState[Node] := csUncheckedNormal; + Exit; + end; + + MainForm.LogSQL('Bind parameter detection...', lcInfo); + ParamCountBefore := ListBindParams.Count; + + // Check current Query memo to find all parameters with regular expression ( :params ) + rx := TRegExpr.Create; + // Can't use (?<!\w):\w+ with actuall unit so this is an other solution + // Don't use ^:\w+|\W:[^\W:]\w+ because it detect IP v6 + rx.Expression := '([^:\w]|^):\w+'; + if rx.Exec(Memo.Text) then while true do begin + + // Don't get first char if it's not ':' because RegEx contain \W (A non-word character) before ':' + ParamName := Copy(rx.Match[0], Pos(':',rx.Match[0]), Length(rx.Match[0])-Pos(':',rx.Match[0])+1); + + // Check if parameter already exists + ParamFound := False; + for BindParam in ListBindParams do begin + if BindParam.Name = ParamName then begin + BindParam.Keep := True; + ParamFound := True; + end; + end; + + // If not exists, prepare and add new TBindParam + if not ParamFound then begin + BindParam := TBindParam.Create; + BindParam.Name := ParamName; + BindParam.Value := ''; + BindParam.Keep := True; + ListBindParams.Add(BindParam); + end; + + // Try to find next parameter + if not rx.ExecNext then + break; + end; + + rx.Free; + + // Sort list ascending + ListBindParams.Sort; + // Delete all parameters where variable is to False + ListBindParams.CleanToKeep; + + // Refresh bind param tree node, so it displays its children. Expand it when it has params for the first time. + MainForm.RefreshHelperNode(TQueryTab.HelperNodeBinding); + if (ParamCountBefore=0) and (ListBindParams.Count>0) then begin + Node := FindNode(treeHelpers, TQueryTab.HelperNodeBinding, nil); + treeHelpers.Expanded[Node] := True; + end; + + MainForm.LogSQL(IntToStr(ListBindParams.Count) + ' bind parameters found.', lcDebug); +end;} + + +{procedure TQueryTab.TimerStatusUpdateOnTimer(Sender: TObject); +var + Msg, ElapsedMsg: String; + Elapsed: Int64; +begin + // Update status bar every second with elapsed time + Msg := _('query')+' #' + FormatNumber(ExecutionThread.BatchPosition+1); + if ExecutionThread.QueriesInPacket > 1 then + Msg := f_('queries #%s to #%s', [FormatNumber(ExecutionThread.BatchPosition+1), FormatNumber(ExecutionThread.BatchPosition+ExecutionThread.QueriesInPacket)]); + try + Elapsed := MilliSecondsBetween(ExecutionThread.QueryStartedAt, Now); + ElapsedMsg := FormatTimeNumber(Elapsed/1000, True); + MainForm.ShowStatusMsg(ElapsedMsg + ': ' + f_('Executing %s of %s ...', [Msg, FormatNumber(ExecutionThread.Batch.Count)])); + except; + // Some crashes here, probably when accessing the no longer running thread. + // See https://www.heidisql.com/forum.php?t=25418#p25484 + // See issue https://github.com/HeidiSQL/HeidiSQL/issues/490 + end; +end;} + + +{ TQueryTabList } + +{function TQueryTabList.ActiveTab: TQueryTab; +var + idx: Integer; + FixedTab: TQueryTab; +begin + // Return active tab + Result := nil; + if Self.Count < 1 then + Exit; + FixedTab := Self[0]; + idx := FixedTab.TabSheet.PageControl.ActivePageIndex - FixedTab.TabSheet.PageIndex; + if (idx >= 0) and (idx < Self.Count) then + Result := Self[idx]; +end;} + + +{function TQueryTabList.HasActiveTab: Boolean; +begin + Result := ActiveTab <> nil; +end;} + + +{function TQueryTabList.ActiveMemo: TSynMemo; +var + Tab: TQueryTab; +begin + // Return current query memo + Result := nil; + Tab := ActiveTab; + if Assigned(Tab) then + Result := Tab.Memo; +end;} + + +{function TQueryTabList.ActiveHelpersTree: TVirtualStringTree; +var + Tab: TQueryTab; +begin + // Return current query helpers tree + Result := nil; + Tab := ActiveTab; + if Assigned(Tab) then + Result := Tab.treeHelpers; +end;} + + +{function TQueryTabList.TabByNumber(Number: Integer): TQueryTab; +var + Tab: TQueryTab; +begin + // Find right query tab + Result := nil; + for Tab in Self do begin + if Tab.Number = Number then begin + Result := Tab; + break; + end; + end; +end;} + + +{function TQueryTabList.TabByControl(Control: TWinControl): TQueryTab; +var + Tab: TQueryTab; +begin + // Find query tab where passed control resides + // Supports only most important controls in the upper area, excluding tab close button and result grid + Result := nil; + for Tab in Self do begin + if (Control = Tab.TabSheet) + or (Control = Tab.pnlMemo) or (Control = Tab.Memo) + or (Control = Tab.pnlHelpers) or (Control = Tab.filterHelpers) or (Control = Tab.treeHelpers) + or (Control = Tab.tabsetQuery) + then begin + Result := Tab; + Break; + end; + end; +end;} + + + + + +{ TResultTab } + +{constructor TResultTab.Create(AOwner: TQueryTab); +var + QueryTab: TQueryTab; + OrgGrid: TVirtualStringTree; +begin + inherited Create; + QueryTab := AOwner; + OrgGrid := Mainform.QueryGrid; + Grid := TVirtualStringTree.Create(QueryTab.TabSheet); + Grid.Parent := QueryTab.TabSheet; + Grid.Tag := OrgGrid.Tag; + Grid.BorderStyle := OrgGrid.BorderStyle; + Grid.Align := OrgGrid.Align; + Grid.Visible := False; + Grid.TreeOptions := OrgGrid.TreeOptions; + Grid.PopupMenu := OrgGrid.PopupMenu; + Grid.LineStyle := OrgGrid.LineStyle; + Grid.EditDelay := OrgGrid.EditDelay; + Grid.Font.Assign(OrgGrid.Font); + Grid.Header.Options := OrgGrid.Header.Options; + Grid.Header.PopupMenu := OrgGrid.Header.PopupMenu; + Grid.Header.ParentFont := OrgGrid.Header.ParentFont; + Grid.Header.Images := OrgGrid.Header.Images; + Grid.WantTabs := OrgGrid.WantTabs; + Grid.AutoScrollDelay := OrgGrid.AutoScrollDelay; + // Apply events - keep in alphabetical order for overview reasons + Grid.OnAdvancedHeaderDraw := OrgGrid.OnAdvancedHeaderDraw; + Grid.OnAfterCellPaint := OrgGrid.OnAfterCellPaint; + Grid.OnAfterPaint := OrgGrid.OnAfterPaint; + Grid.OnBeforeCellPaint := OrgGrid.OnBeforeCellPaint; + Grid.OnChange := OrgGrid.OnChange; + Grid.OnCreateEditor := OrgGrid.OnCreateEditor; + Grid.OnCompareNodes := OrgGrid.OnCompareNodes; + Grid.OnEditCancelled := OrgGrid.OnEditCancelled; + Grid.OnEdited := OrgGrid.OnEdited; + Grid.OnEditing := OrgGrid.OnEditing; + Grid.OnEndOperation := OrgGrid.OnEndOperation; + Grid.OnEnter := OrgGrid.OnEnter; + Grid.OnExit := OrgGrid.OnExit; + Grid.OnFocusChanged := OrgGrid.OnFocusChanged; + Grid.OnFocusChanging := OrgGrid.OnFocusChanging; + Grid.OnGetNodeDataSize := OrgGrid.OnGetNodeDataSize; + Grid.OnGetText := OrgGrid.OnGetText; + Grid.OnHeaderClick := OrgGrid.OnHeaderClick; + Grid.OnHeaderDrawQueryElements := OrgGrid.OnHeaderDrawQueryElements; + Grid.OnInitNode := OrgGrid.OnInitNode; + Grid.OnKeyDown := OrgGrid.OnKeyDown; + Grid.OnMouseUp := OrgGrid.OnMouseUp; + Grid.OnMouseWheel := OrgGrid.OnMouseWheel; + Grid.OnNewText := OrgGrid.OnNewText; + Grid.OnPaintText := OrgGrid.OnPaintText; + Grid.OnStartOperation := OrgGrid.OnStartOperation; + FixVT(Grid, AppSettings.ReadInt(asGridRowLineCount)); + FTabIndex := QueryTab.ResultTabs.Count; // Will be 0 for the first one, even if we're already creating the first one here! +end;} + +{destructor TResultTab.Destroy; +begin + Results.Free; + Grid.EndEditNode; + // The grid itself is owned by the parent tabsheet, free it only if the tabsheet is not being closed + if not (csDestroying in Grid.ComponentState) then + Grid.Free; + inherited; +end;} + + +{ TQueryHistory } + +{constructor TQueryHistory.Create(SessionPath: String); +var + ValueNames: TStringList; + i, j, p: Integer; + Raw: String; + Item: TQueryHistoryItem; +begin + inherited Create(TQueryHistoryItemComparer.Create, True); + AppSettings.SessionPath := SessionPath + '\' + REGKEY_QUERYHISTORY; + ValueNames := AppSettings.GetValueNames; + for i:=0 to ValueNames.Count-1 do begin + j := StrToIntDef(ValueNames[i], -1); + // Prevent from running into serious errors when registry has some non-numeric value + if j<>-1 then begin + Item := TQueryHistoryItem.Create; + try + Item.RegValue := j; + Raw := AppSettings.ReadString(ValueNames[i]); + p := Pos(DELIM, Raw); + Item.Time := StrToDateTime(Copy(Raw, 1, p-1)); + System.Delete(Raw, 1, p); + p := Pos(DELIM, Raw); + Item.Database := Copy(Raw, 1, p-1); + System.Delete(Raw, 1, p); + p := Pos(DELIM, Raw); + Item.Duration := StrToIntDef(Copy(Raw, 1, p-1), 0); + FMaxDuration := Max(FMaxDuration, Item.Duration); + Item.SQL := Copy(Raw, p+1, Length(Raw)); + Add(Item); + except + on E:Exception do begin + MainForm.LogSQL(E.ClassName+': '+E.Message+' Sessionpath: '+AppSettings.SessionPath+' Valuename: '+ValueNames[i]+' Raw: '+Raw, lcDebug); + Item.Free; + Break; + end; + end; + end; + end; + // Sort by date + Sort; + ValueNames.Free; + AppSettings.ResetPath; +end;} + + +{function TQueryHistoryItemComparer.Compare(const Left, Right: TQueryHistoryItem): Integer; +begin + // Simple sort method for a TDBObjectList + if Left.Time > Right.Time then + Result := -1 + else if Left.Time = Right.Time then + Result := 0 + else + Result := 1; +end;} + + +{ TListBindParam } + +constructor TListBindParam.Create; +begin + inherited Create(TBindParamComparer.Create); + FPairDelimiter := '|'; + FItemDelimiter := '~'; +end; + + +procedure TListBindParam.CleanToKeep; +var + Index: Integer; +begin + // Check for each parameter if there is to be deleted + for Index:=Count-1 downto 0 do begin + if Items[Index].Keep = False then + Self.Delete(Index); + end; + + // Set False all items for the next call + for Index:=0 to Count-1 do begin + Items[Index].Keep := False; + end; +end; + + +function TListBindParam.GetAsText: String; +var + Param: TBindParam; + Lines: TStringList; +begin + // Return params as storable text + Lines := TStringList.Create; + for Param in Self do begin + Lines.Add(Param.Name + FPairDelimiter + Param.Value); + end; + Result := Implode(FItemDelimiter, Lines); + Lines.Free; +end; + +procedure TListBindParam.SetAsText(Input: String); +var + Param: TBindParam; + Lines, Pair: TStringList; + Line: String; +begin + // Restore params from text + // See #689 + Lines := Explode(FItemDelimiter, Input); + for Line in Lines do begin + Pair := Explode(FPairDelimiter, Line); + if Pair.Count >= 2 then begin + Param := TBindParam.Create; + Param.Name := Pair[0]; + Param.Value := Pair[1]; + Add(Param); + end; + Pair.Free; + end; + Lines.Free; +end; + + +{ TBindParamComparer } + +function TBindParamComparer.Compare(constref Left, Right: TBindParam): Integer; +begin + // Simple sort method for a TDBObjectList + Result := CompareText(Left.Name, Right.Name); +end; + +end. + +