unit Main; // ------------------------------------- // Main-window // ------------------------------------- {$I compilers.inc} interface uses Synchronization, Communication, Windows, SysUtils, Classes, Graphics, Forms, Controls, Menus, StdCtrls, Dialogs, Buttons, Messages, ExtCtrls, ComCtrls, StdActns, ActnList, ImgList, ShellApi, ToolWin, Clipbrd, db, SynMemo, synedit, SynEditTypes, ZDataSet, ZSqlProcessor, HeidiComp, sqlhelp, MysqlQueryThread, VirtualTrees, DateUtils, PngImageList, OptimizeTables, View, Usermanager, SelectDBObject, Widestrings, ShlObj, SynEditMiscClasses, SynEditSearch, SynCompletionProposal, ZSqlMonitor, SynEditHighlighter, SynHighlighterSQL, TntStdCtrls, Tabs, SynUnicode, mysqlconn, EditVar, helpers, queryprogress, mysqlquery, createdatabase, table_editor, SynRegExpr, WideStrUtils, ZDbcLogging, ExtActns, CommCtrl, routine_editor, options; const // The InnoDB folks are raging over the lack of count(*) support // in the storage engine. To avoid count(*), the first of these // constants decide how many rows the data area should estimate // in any table. The second value decides how many percent above the // number of seen (or simulated) rows the scrollbar should project. SIMULATE_INITIAL_ROWS = 10000; SIMULATE_MORE_ROWS = 20; type TMainForm = class(TForm) MainMenu1: TMainMenu; File1: TMenuItem; FileNewItem: TMenuItem; Help1: TMenuItem; N1: TMenuItem; FileExitItem: TMenuItem; menuAbout: TMenuItem; Edit1: TMenuItem; CopyItem: TMenuItem; PasteItem: TMenuItem; StatusBar: TStatusBar; ActionList1: TActionList; actCopy: TAction; actPaste: TAction; actNewWindow: TAction; actExitApplication: TAction; Extra1: TMenuItem; FlushUserPrivileges1: TMenuItem; MenuCopyCSV: TMenuItem; MenuRefresh1: TMenuItem; MenuExport: TMenuItem; N5: TMenuItem; MenuImportTextFile: TMenuItem; Flush1: TMenuItem; MenuFlushLogs: TMenuItem; MenuFlushHosts: TMenuItem; MenuFlushTables: TMenuItem; MenuFlushTableswithreadlock: TMenuItem; MenuFlushStatus: TMenuItem; N6: TMenuItem; MenuUserManager: TMenuItem; MenuPreferences: TMenuItem; N7a: TMenuItem; menuReadme: TMenuItem; actUserManager: TAction; actAboutBox: TAction; actMaintenance: TAction; menuMaintenance: TMenuItem; ImExport1: TMenuItem; CopyContentsasHTMLTable1: TMenuItem; actCopyAsHTML: TAction; actCopyAsCSV: TAction; menuWebsite: TMenuItem; N9: TMenuItem; N11: TMenuItem; actPrintList: TAction; actCopyTable: TAction; ControlBar1: TControlBar; ToolBarStandard: TToolBar; ToolButton9: TToolButton; tlbSep1: TToolButton; ToolButton5: TToolButton; ToolButton6: TToolButton; ToolButton12: TToolButton; tlbSep2: TToolButton; ButtonRefresh: TToolButton; ButtonImportTextfile: TToolButton; ButtonExport: TToolButton; ButtonUserManager: TToolButton; ToolBarData: TToolBar; actUndo: TEditUndo; ToolButton14: TToolButton; actExecuteQuery: TAction; actExecuteSelection: TAction; SaveDialog2: TSaveDialog; ExportSettings1: TMenuItem; Importsettings1: TMenuItem; OpenDialog2: TOpenDialog; menuSupportForum: TMenuItem; actCopyAsXML: TAction; actExportData: TAction; Exportdata1: TMenuItem; CopyasXMLdata1: TMenuItem; actExecuteLine: TAction; actHTMLview: TAction; actInsertFiles: TAction; InsertfilesintoBLOBfields1: TMenuItem; actExportTables: TAction; actDropObjects: TAction; actLoadSQL: TAction; ImportSQL1: TMenuItem; menuConnections: TPopupMenu; menuWindow: TMenuItem; miFake: TMenuItem; menuBugtracker: TMenuItem; menuFeaturetracker: TMenuItem; menuDownload: TMenuItem; btnSQLHelp: TToolButton; menuSQLHelp1: TMenuItem; N8a: TMenuItem; Import1: TMenuItem; tlbSep6: TToolButton; menuUpdateCheck: TMenuItem; PngImageListMain: TPngImageList; actCreateView: TAction; ToolButton3: TToolButton; actDataFirst: TAction; actDataLast: TAction; actDataInsert: TAction; actDataDelete: TAction; actDataPostChanges: TAction; ToolButton4: TToolButton; ToolButton7: TToolButton; ToolButton8: TToolButton; ToolButton10: TToolButton; actCreateTable: TAction; actEmptyTables: TAction; actCreateDatabase: TAction; actSQLhelp: TAction; actRefresh: TAction; actImportCSV: TAction; actCut: TAction; Cut1: TMenuItem; actExportSettings: TAction; actImportSettings: TAction; actSelectTreeBackground: TAction; actPreferences: TAction; actFlushHosts: TAction; actFlushLogs: TAction; actFlushPrivileges: TAction; actFlushTables: TAction; actFlushTableswithreadlock: TAction; actFlushStatus: TAction; actUpdateCheck: TAction; actWebMainsite: TAction; actWebDownloadpage: TAction; actWebForum: TAction; actWebBugtracker: TAction; actWebFeaturetracker: TAction; actReadme: TAction; actSaveSQL: TAction; actSaveSQLselection: TAction; actSaveSQLSnippet: TAction; actSaveSQLSelectionSnippet: TAction; actClearQueryEditor: TAction; actClearFilterEditor: TAction; actApplyFilter: TAction; actQueryStopOnErrors: TAction; actQueryWordWrap: TAction; actQueryFind: TAction; actQueryReplace: TAction; FindDialogQuery: TFindDialog; ReplaceDialogQuery: TReplaceDialog; ToolBarQuery: TToolBar; btnExecuteQuery: TToolButton; btnExecuteSelection: TToolButton; btnLoadSQL: TToolButton; btnSaveSQL: TToolButton; btnSaveSQLSnippet: TToolButton; btnQueryFind: TToolButton; btnQueryReplace: TToolButton; btnStopOnErrors: TToolButton; btnQueryWordwrap: TToolButton; PopupQueryLoad: TPopupMenu; btnExecuteLine: TToolButton; actSetDelimiter: TAction; btnSetDelimiter: TToolButton; actDataCancelChanges: TAction; ToolButton1: TToolButton; actRemoveFilter: TAction; actCopyAsSQL: TAction; CopyAsSQLdata: TMenuItem; panelTop: TPanel; DBtree: TVirtualStringTree; Splitter1: TSplitter; PageControlMain: TPageControl; tabData: TTabSheet; tabDatabase: TTabSheet; splitterTopBottom: TSplitter; tabQuery: TTabSheet; popupDB: TPopupMenu; menuRefreshDB: TMenuItem; tabHost: TTabSheet; PageControlHost: TPageControl; tabVariables: TTabSheet; tabProcessList: TTabSheet; ListVariables: TVirtualStringTree; ListProcesses: TVirtualStringTree; popupHost: TPopupMenu; Kill1: TMenuItem; ListTables: TVirtualStringTree; Refresh1: TMenuItem; pnlDataTop: TPanel; pnlQueryMemo: TPanel; SynSQLSyn1: TSynSQLSyn; SynMemoQuery: TSynMemo; spltQuery: TSplitter; OpenDialog1: TOpenDialog; TimerHostUptime: TTimer; N5a: TMenuItem; popupDataGrid: TPopupMenu; Refresh3: TMenuItem; popupResultGrid: TPopupMenu; Copyrecords1: TMenuItem; CopyasCSVData1: TMenuItem; N9a: TMenuItem; LabelResultinfo: TLabel; TimerConnected: TTimer; N12: TMenuItem; popupSqlLog: TPopupMenu; Clear2: TMenuItem; Copy1: TMenuItem; N15: TMenuItem; N17: TMenuItem; CopycontentsasHTML1: TMenuItem; CopycontentsasHTML2: TMenuItem; Copy3: TMenuItem; Paste2: TMenuItem; N4a: TMenuItem; DataGrid: TVirtualStringTree; QueryGrid: TVirtualStringTree; Copytableas1: TMenuItem; Delete1: TMenuItem; N6a: TMenuItem; QF1: TMenuItem; QF2: TMenuItem; QuickFilter1: TMenuItem; QF3: TMenuItem; QF4: TMenuItem; N7: TMenuItem; DropFilter1: TMenuItem; PrintList2: TMenuItem; N1a: TMenuItem; SynMemoFilter: TSynMemo; MenuAutoupdate: TMenuItem; TimerRefresh: TTimer; Set1: TMenuItem; EnableAutoRefresh: TMenuItem; DisableAutoRefresh: TMenuItem; Saveastextfile1: TMenuItem; QF7: TMenuItem; QF5: TMenuItem; QF6: TMenuItem; QF8: TMenuItem; QF10: TMenuItem; QF11: TMenuItem; QF9: TMenuItem; QF12: TMenuItem; CopyasXMLdata3: TMenuItem; CopyasXMLdata2: TMenuItem; Exportdata3: TMenuItem; Exportdata2: TMenuItem; SaveDialogExportData: TSaveDialog; N11a: TMenuItem; Copy4: TMenuItem; N14: TMenuItem; DataInsertDateTime: TMenuItem; DataTimestamp: TMenuItem; DataDateTime: TMenuItem; DataTime: TMenuItem; DataDate: TMenuItem; DataYear: TMenuItem; ViewasHTML1: TMenuItem; HTMLview1: TMenuItem; InsertfilesintoBLOBfields3: TMenuItem; N19: TMenuItem; setNULL1: TMenuItem; ZSQLMonitor1: TZSQLMonitor; menuExporttables: TMenuItem; popupDbGridHeader: TPopupMenu; SynCompletionProposal1: TSynCompletionProposal; OpenDialogSQLFile: TOpenDialog; SaveDialogSQLFile: TSaveDialog; SynEditSearch1: TSynEditSearch; tabCommandStats: TTabSheet; ListCommandStats: TVirtualStringTree; QF13: TMenuItem; QF14: TMenuItem; QF15: TMenuItem; QF16: TMenuItem; QF17: TMenuItem; QF18: TMenuItem; QF19: TMenuItem; N21: TMenuItem; pnlQueryHelpers: TPanel; tabsetQueryHelpers: TTabSet; lboxQueryHelpers: TTnTListBox; popupQuery: TPopupMenu; MenuRun: TMenuItem; MenuRunSelection: TMenuItem; MenuRunLine: TMenuItem; MenuItem1: TMenuItem; menucopy: TMenuItem; menupaste: TMenuItem; menuload: TMenuItem; menusave: TMenuItem; menuclear: TMenuItem; MenuFind: TMenuItem; MenuReplace: TMenuItem; MenuItem2: TMenuItem; lblDataTop: TTNTLabel; spltQueryHelpers: TSplitter; N22: TMenuItem; N23: TMenuItem; menuSaveSelectionToFile: TMenuItem; menuSaveAsSnippet: TMenuItem; menuSaveSelectionAsSnippet: TMenuItem; popupQueryHelpers: TPopupMenu; menuDeleteSnippet: TMenuItem; menuHelp: TMenuItem; menuLoadSnippet: TMenuItem; menuInsertSnippetAtCursor: TMenuItem; menuExplore: TMenuItem; menuSQLhelp2: TMenuItem; N24: TMenuItem; menuSQLhelpData: TMenuItem; menuLogToFile: TMenuItem; menuOpenLogFolder: TMenuItem; tabStatus: TTabSheet; ListStatus: TVirtualStringTree; Splitter3: TSplitter; pnlProcessViewBox: TPanel; pnlProcessView: TPanel; SynMemoProcessView: TSynMemo; pnlFilterVT: TPanel; editFilterVT: TEdit; lblFilterVT: TLabel; lblFilterVTInfo: TLabel; menuEditVariable: TMenuItem; menuTreeExpandAll: TMenuItem; menuTreeCollapseAll: TMenuItem; tlbDataButtons: TToolBar; tbtnDataSorting: TToolButton; tbtnDataColumns: TToolButton; tbtnDataFilter: TToolButton; pnlFilter: TPanel; btnFilterApply: TButton; lblTableFilter: TLabel; editFilterSearch: TEdit; btnFilterClear: TButton; popupFilter: TPopupMenu; menuFilterCopy: TMenuItem; menuFilterPaste: TMenuItem; N8: TMenuItem; menuFilterApply: TMenuItem; menuFilterClear: TMenuItem; N20: TMenuItem; SynMemoSQLLog: TSynMemo; Insert1: TMenuItem; Cancelediting1: TMenuItem; DataPost1: TMenuItem; menuShowSizeColumn: TMenuItem; tbtnDataView: TToolButton; popupDataView: TPopupMenu; menuViewSave: TMenuItem; N25: TMenuItem; menuViewDefault: TMenuItem; CopygriddataasSQL1: TMenuItem; CopygriddataasSQL2: TMenuItem; menuSelectBGColor: TMenuItem; actPreviousTab: TPreviousTab; actNextTab: TNextTab; Nexttab1: TMenuItem; Previoustab1: TMenuItem; menuConnectTo: TMenuItem; actSelectAll: TAction; actSelectAll1: TMenuItem; N13: TMenuItem; ProgressBarStatus: TProgressBar; menuRecentFilters: TMenuItem; comboRecentFilters: TTntComboBox; lblRecentFilters: TLabel; Copy2: TMenuItem; N26: TMenuItem; actSessionManager: TAction; Sessionmanager1: TMenuItem; actCreateRoutine: TAction; btnExit: TToolButton; lblSorryNoData: TLabel; menuPrint: TMenuItem; menuEditObject: TMenuItem; menuCreateObject: TMenuItem; menuDeleteObject: TMenuItem; menuMaintenance2: TMenuItem; menuEmptyTables: TMenuItem; actEditObject: TAction; menuCreateDB: TMenuItem; menuCreateTable: TMenuItem; menuCreateTableCopy: TMenuItem; menuCreateView: TMenuItem; menuCreateRoutine: TMenuItem; tabEditor: TTabSheet; procedure refreshMonitorConfig; procedure loadWindowConfig; procedure saveWindowConfig; procedure setDefaultWindowConfig; procedure actCreateTableExecute(Sender: TObject); procedure actCreateViewExecute(Sender: TObject); procedure menuWindowClick(Sender: TObject); procedure focusWindow(Sender: TObject); procedure menuConnectionsPopup(Sender: TObject); procedure actExitApplicationExecute(Sender: TObject); procedure DisplayChange(var msg: TMessage); message WM_DISPLAYCHANGE; procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormCreate(Sender: TObject); procedure Startup; procedure DoAfterConnect; procedure DoDisconnect; procedure FormResize(Sender: TObject); procedure actUserManagerExecute(Sender: TObject); procedure actAboutBoxExecute(Sender: TObject); procedure actApplyFilterExecute(Sender: TObject); procedure actClearEditorExecute(Sender: TObject); procedure actMaintenanceExecute(Sender: TObject); procedure actCopyAsHTMLExecute(Sender: TObject); procedure actCopyAsCSVExecute(Sender: TObject); procedure actPrintListExecute(Sender: TObject); procedure actCopyTableExecute(Sender: TObject); procedure showstatus(msg: string=''; panel: Integer=6); function mask(str: WideString) : WideString; procedure actExecuteQueryExecute(Sender: TObject); procedure actExecuteSelectionExecute(Sender: TObject); procedure actCopyAsXMLExecute(Sender: TObject); procedure actCreateDatabaseExecute(Sender: TObject); procedure actDataCancelChangesExecute(Sender: TObject); procedure actExportDataExecute(Sender: TObject); procedure actExecuteLineExecute(Sender: TObject); procedure actHTMLviewExecute(Sender: TObject); procedure actInsertFilesExecute(Sender: TObject); procedure actExportTablesExecute(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 actQueryFindExecute(Sender: TObject); procedure actQueryReplaceExecute(Sender: TObject); procedure actQueryStopOnErrorsExecute(Sender: TObject); procedure actQueryWordWrapExecute(Sender: TObject); procedure actReadmeExecute(Sender: TObject); procedure actRefreshExecute(Sender: TObject); procedure actRemoveFilterExecute(Sender: TObject); procedure actSaveSQLExecute(Sender: TObject); procedure actSaveSQLSnippetExecute(Sender: TObject); procedure actSetDelimiterExecute(Sender: TObject); procedure actSQLhelpExecute(Sender: TObject); procedure actUpdateCheckExecute(Sender: TObject); procedure actWebbrowse(Sender: TObject); function ExecuteRemoteQuery(sender: THandle; query: string): TDataSet; procedure ExecuteRemoteNonQuery(sender: THandle; query: string); procedure FindDialogQueryFind(Sender: TObject); procedure HandleWMComplete(var msg: TMessage); message WM_COMPLETED; procedure HandleWMCopyData(var msg: TWMCopyData); message WM_COPYDATA; procedure HandleWMProcessLog(var msg: TMessage); message WM_PROCESSLOG; procedure HandleWMRefill(var msg: TMessage); message WM_REFILL_SPAREBUF; procedure ReplaceDialogQueryFind(Sender: TObject); procedure ReplaceDialogQueryReplace(Sender: TObject); procedure actCopyAsSQLExecute(Sender: TObject); procedure actSelectTreeBackgroundExecute(Sender: TObject); procedure popupQueryPopup(Sender: TObject); procedure lboxQueryHelpersClick(Sender: TObject); procedure lboxQueryHelpersDblClick(Sender: TObject); procedure tabsetQueryHelpersChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); procedure btnDataClick(Sender: TObject); procedure ListTablesChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure SynCompletionProposal1AfterCodeCompletion(Sender: TObject; const Value: WideString; Shift: TShiftState; Index: Integer; EndToken: WideChar); procedure SynCompletionProposal1CodeCompletion(Sender: TObject; var Value: WideString; Shift: TShiftState; Index: Integer; EndToken: WideChar); procedure SynCompletionProposal1Execute(Kind: SynCompletionType; Sender: TObject; var CurrentInput: WideString; var x, y: Integer; var CanExecute: Boolean); procedure PageControlMainChange(Sender: TObject); procedure PageControlHostChange(Sender: TObject); procedure ValidateControls(Sender: TObject); procedure ValidateQueryControls(Sender: TObject); procedure RefreshQueryHelpers; function FieldContent(ds: TDataSet; ColName: WideString): WideString; procedure LoadDatabaseProperties(db: WideString); procedure ShowHost; procedure ShowDatabase(db: WideString); procedure ShowDBProperties(db: WideString); function EnsureFullWidth(Grid: TBaseVirtualTree; Column: TColumnIndex; Node: PVirtualNode): Boolean; procedure EnsureNodeLoaded(Sender: TBaseVirtualTree; Node: PVirtualNode; WhereClause: WideString); procedure EnsureChunkLoaded(Sender: TBaseVirtualTree; Node: PVirtualNode; FullWidth: Boolean = False); procedure DiscardNodeData(Sender: TVirtualStringTree; Node: PVirtualNode); procedure viewdata(Sender: TObject); procedure LogSQL(msg: WideString = ''; comment: Boolean = true ); procedure CheckUptime; procedure KillProcess(Sender: TObject); procedure ExecSQLClick(Sender: TObject; Selection: Boolean = false; CurrentLine: Boolean=false); procedure SynMemoQueryStatusChange(Sender: TObject; Changes: TSynStatusChanges); procedure TimerHostUptimeTimer(Sender: TObject); procedure FormActivate(Sender: TObject); procedure ListTablesNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: WideString); procedure TimerConnectedTimer(Sender: TObject); procedure Clear2Click(Sender: TObject); procedure QuickFilterClick(Sender: TObject); procedure popupResultGridPopup(Sender: TObject); procedure Autoupdate1Click(Sender: TObject); procedure EnableAutoRefreshClick(Sender: TObject); procedure DisableAutoRefreshClick(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 Saveastextfile1Click(Sender: TObject); procedure popupDBPopup(Sender: TObject); procedure SaveDialogExportDataTypeChange(Sender: TObject); procedure popupDataGridPopup(Sender: TObject); procedure InsertDate(Sender: TObject); procedure setNULL1Click(Sender: TObject); function GetNamedVar( SQLQuery: WideString; x: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false ) : WideString; function GetVar( SQLQuery: WideString; x: Integer = 0; HandleErrors: Boolean = false; DisplayErrors: Boolean = false ) : WideString; function GetResults( SQLQuery: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false; ForceDialog: Boolean = false): TDataSet; function GetCol( SQLQuery: WideString; x: Integer = 0; HandleErrors: Boolean = false; DisplayErrors: Boolean = false ) : WideStrings.TWideStringList; procedure ZSQLMonitor1LogTrace(Sender: TObject; Event: TZLoggingEvent); procedure MenuTablelistColumnsClick(Sender: TObject); procedure CancelQuery; procedure CheckConnection(); procedure QueryLoad( filename: String; ReplaceContent: Boolean = true ); procedure ExecuteNonQuery(SQLQuery: String); function ExecuteQuery(query: String): TDataSet; function CreateOrGetRemoteQueryTab(sender: THandle): THandle; procedure DataGridChange(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure DataGridCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); procedure DataGridEditCancelled(Sender: TBaseVirtualTree; Column: TColumnIndex); procedure DataGridEdited(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure DataGridEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); procedure DataGridFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); procedure GridGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); procedure DataGridHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); procedure GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure DataGridNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: WideString); procedure GridPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); procedure menuDeleteSnippetClick(Sender: TObject); procedure menuExploreClick(Sender: TObject); procedure menuInsertSnippetAtCursorClick(Sender: TObject); procedure menuLoadSnippetClick(Sender: TObject); procedure RunAsyncPost(ds: TDeferDataSet); procedure vstGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); procedure vstInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); procedure vstFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure vstGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); procedure vstGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); procedure vstHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); procedure vstCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); procedure vstHeaderDraggedOut(Sender: TVTHeader; Column: TColumnIndex; DropPosition: TPoint); procedure DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure DBtreeDblClick(Sender: TObject); procedure DBtreeGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); procedure DBtreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); procedure DBtreeGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); 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 vstGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: WideString); procedure ProcessSqlLog; procedure ListCommandStatsBeforeCellPaint(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 SynMemoFilterChange(Sender: TObject); procedure DataGridAfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); procedure menuShowSizeColumnClick(Sender: TObject); procedure DataGridColumnResize(Sender: TVTHeader; Column: TColumnIndex); procedure GridBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); procedure popupDataViewPopup(Sender: TObject); procedure menuViewDefaultClick(Sender: TObject); procedure menuViewSaveClick(Sender: TObject); procedure QueryGridFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); procedure pnlQueryHelpersCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); procedure pnlQueryMemoCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); procedure DataGridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure File1Click(Sender: TObject); procedure ListVariablesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); procedure ListStatusBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); procedure ListProcessesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); procedure ListCommandStatsBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); procedure vstAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); procedure actCopyOrCutExecute(Sender: TObject); procedure actPasteExecute(Sender: TObject); procedure actSelectAllExecute(Sender: TObject); procedure EnumerateRecentFilters; procedure LoadRecentFilter(Sender: TObject); procedure actCreateRoutineExecute(Sender: TObject); procedure DataGridScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); procedure ListTablesEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); procedure DBtreeExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode); procedure actEditObjectExecute(Sender: TObject); procedure ListTablesDblClick(Sender: TObject); private ReachedEOT : Boolean; FDelimiter: String; ServerUptime : Integer; time_connected : Cardinal; viewingdata : Boolean; FMysqlConn : TMysqlConn; FConn : TOpenConnProf; QueryRunningInterlock : Integer; UserQueryFired : Boolean; UserQueryFiring : Boolean; CachedTableLists : WideStrings.TWideStringList; QueryHelpersSelectedItems : Array[0..3] of Array of Integer; EditVariableForm : TfrmEditVariable; FileNameSessionLog : String; FileHandleSessionLog : Textfile; SqlMessages : TWideStringList; SqlMessagesLock : TRtlCriticalSection; dsShowEngines, dsHaveEngines, dsCollations : TDataset; FilterPanelManuallyOpened : Boolean; winName : String; FSelectedTableColumns, FSelectedTableKeys : TDataset; DataGridDB, DataGridTable : WideString; PrevTableColWidths : WideStrings.TWideStringList; DataGridHasChanges : Boolean; InformationSchemaTables : TWideStringlist; QueryMemoLineBreaks : TLineBreaks; function GetParamValue(const paramChar: Char; const paramName: string; var curIdx: Byte; out paramValue: string): Boolean; procedure SetDelimiter(Value: String); function GetQueryRunning: Boolean; procedure SetQueryRunning(running: Boolean); function GetActiveGrid: TVirtualStringTree; function GetActiveData: PGridResult; procedure WaitForQueryCompletion(WaitForm: TfrmQueryProgress; query: TMySqlQuery; ForceDialog: Boolean); function RunThreadedQuery(AQuery: WideString; ForceDialog: Boolean): TMysqlQuery; procedure DisplayRowCountStats(MatchingRows: Int64 = -1); procedure insertFunction(Sender: TObject); function GetActiveDatabase: WideString; function GetSelectedTable: TListNode; procedure SetSelectedDatabase(db: WideString); procedure SelectDBObject(Text: WideString; NodeType: TListNodeType); procedure SetVisibleListColumns( List: TVirtualStringTree; Columns: WideStrings.TWideStringList ); function GetTableSize(ds: TDataSet): Int64; procedure ToggleFilterPanel(ForceVisible: Boolean = False); function GetSelectedTableColumns: TDataset; function GetSelectedTableKeys: TDataset; procedure AutoCalcColWidths(Tree: TVirtualStringTree; PrevLayout: Widestrings.TWideStringlist = nil); procedure PlaceObjectEditor(Which: TListNodeType); public cancelling: Boolean; virtualDesktopName: string; MaintenanceForm: TOptimize; ViewEditor: TfrmView; UserManagerForm: TUserManagerForm; SelectDBObjectForm: TfrmSelectDBObject; SQLHelpForm: TfrmSQLhelp; RoutineEditor: TfrmRoutineEditor; OptionsForm: Toptionsform; DatabasesWanted, Databases : Widestrings.TWideStringList; TemporaryDatabase : WideString; dataselected : Boolean; editing : Boolean; mysql_version : Integer; SessionName : String; VTRowDataListVariables, VTRowDataListStatus, VTRowDataListProcesses, VTRowDataListCommandStats, VTRowDataListTables : TVTreeDataArray; FProgressForm : TFrmQueryProgress; // Variables set by preferences dialog prefRememberFilters : Boolean; prefLogsqlnum, prefLogSqlWidth, prefMaxColWidth, prefMaxTotalRows : Integer; prefCSVSeparator, prefCSVEncloser, prefCSVTerminator : String[10]; prefLogToFile, prefEnableBinaryEditor, prefEnableDatetimeEditor, prefEnableEnumEditor, prefEnableSetEditor, prefEnableNullBG : Boolean; prefFieldColorNumeric, prefFieldColorText, prefFieldColorBinary, prefFieldColorDatetime, prefFieldColorEnum, prefFieldColorSet, prefNullColorNumeric, prefNullColorText, prefNullColorBinary, prefNullColorDatetime, prefNullColorEnum, prefNullColorSet, prefNullColorDefault, prefNullBG : TColor; CreateDatabaseForm : TCreateDatabaseForm; TableEditor : TfrmTableEditor; FDataGridResult, FQueryGridResult : TGridResult; FDataGridSelect : WideStrings.TWideStringList; FDataGridSort : TOrderColArray; DataGridCurrentSelect, DataGridCurrentFullSelect, DataGridCurrentFrom, DataGridCurrentFilter, DataGridCurrentSort : WideString; property Delimiter: String read FDelimiter write SetDelimiter; procedure CallSQLHelpWithKeyword( keyword: String ); procedure AddOrRemoveFromQueryLoadHistory( filename: String; AddIt: Boolean = true; CheckIfFileExists: Boolean = true ); procedure popupQueryLoadClick( sender: TObject ); procedure FillPopupQueryLoad; procedure PopupQueryLoadRemoveAbsentFiles( sender: TObject ); procedure SessionConnect(Sender: TObject); function InitConnection(parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parSortDatabases: WideString): Boolean; //procedure HandleQueryNotification(ASender : TMysqlQuery; AEvent : Integer); function ExecUpdateQuery(sql: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false): Int64; function ExecSelectQuery(sql: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false; ForceDialog: Boolean = false): TDataSet; procedure ExecUseQuery(db: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false); property FQueryRunning: Boolean read GetQueryRunning write SetQueryRunning; property ActiveGrid: TVirtualStringTree read GetActiveGrid; property ActiveData: PGridResult read GetActiveData; property MysqlConn : TMysqlConn read FMysqlConn; property Conn : TOpenConnProf read FConn; property ActiveDatabase : WideString read GetActiveDatabase write SetSelectedDatabase; property SelectedTable : TListNode read GetSelectedTable; function FetchActiveDbTableList: TDataSet; function RefreshActiveDbTableList: TDataSet; function FetchDbTableList(db: WideString): TDataSet; function RefreshDbTableList(db: WideString): TDataSet; procedure ClearDbTableList(db: WideString); function DbTableListCachedAndValid(db: WideString): Boolean; procedure ClearAllTableLists; procedure EnsureDatabase; procedure TestVTreeDataArray( P: PVTreeDataArray ); function GetVTreeDataArray( VT: TBaseVirtualTree ): PVTreeDataArray; procedure ActivateFileLogging; procedure DeactivateFileLogging; procedure TrimSQLLog; procedure TableEnginesCombo(var Combobox: TCombobox); function GetTreeNodeType(Node: PVirtualNode): TListNodeType; function GetFocusedTreeNodeType: TListNodeType; procedure RefreshTree(DoResetTableCache: Boolean; SelectDatabase: WideString = ''); procedure RefreshTreeDB(db: WideString); function FindDBNode(db: WideString): PVirtualNode; function GridPostUpdate(Sender: TBaseVirtualTree): Boolean; function GridPostInsert(Sender: TBaseVirtualTree): Boolean; function GridPostDelete(Sender: TBaseVirtualTree): Boolean; function DataGridPostUpdateOrInsert(Node: PVirtualNode): Boolean; procedure GridFinalizeEditing(Sender: TBaseVirtualTree); function GetWhereClause(Row: PGridRow; Columns: PGridColumns): WideString; function GetKeyColumns: WideStrings.TWideStringlist; function CheckUniqueKeyClause: Boolean; procedure DataGridInsertRow; procedure DataGridCancel(Sender: TObject); property SelectedTableColumns: TDataset read GetSelectedTableColumns write FSelectedTableColumns; property SelectedTableKeys: TDataset read GetSelectedTableKeys write FSelectedTableKeys; procedure CalcNullColors; procedure FillDataViewPopup; procedure GetDataViews(List: TStrings); procedure DataViewClick(Sender: TObject); procedure LoadDataView(ViewName: String); function GetRegKeyTable: String; procedure SaveListSetup( List: TVirtualStringTree ); procedure RestoreListSetup( List: TVirtualStringTree ); function GetCollations(Items: TWideStrings = nil): TDataset; procedure SetEditorTabCaption(Editor: TFrame; ObjName: WideString); procedure ResetSelectedTableStuff; end; procedure InheritFont(AFont: TFont); var MainForm : TMainForm; AppVersion : String = 'x.y'; AppRevision : String = '$Rev$'; FullAppVersion : String; DirnameCommonAppData, DirnameUserAppData, DIRNAME_SNIPPETS, DirnameSessionLogs : String; const discname = 'not connected'; ICON_MYSELF_CONNECTED = 38; ICON_MYSELF_DISCONNECTED = -1; ICON_OTHER_CONNECTED = 36; ICON_OTHER_DISCONNECTED = -1; {$I const.inc} type TMyKey = record Name : String; _type : String; Columns : TWideStringList; SubParts : TWideStringList; end; type // Represents errors already "handled" (shown to user), // which can thus safely be ignored. THandledSQLError = class(Exception) end; implementation uses About, connections, exportsql, loaddata, printlist, copytable, insertfiles, Threading, mysql_structures, UpdateCheck, uVistaFuncs, runsqlfile, column_selection, data_sorting, grideditlinks, dataviewsave; type PMethod = ^TMethod; {$R *.DFM} procedure InheritFont(AFont: TFont); begin AFont.Name := Mainform.Font.Name; AFont.Size := Mainform.Font.Size; end; procedure TMainForm.HandleWMComplete(var msg: TMessage); begin HandleWMCompleteMessage(msg); end; procedure TMainForm.HandleWMCopyData(var msg: TWMCopyData); begin HandleWMCopyDataMessage(msg); end; procedure TMainForm.HandleWMProcessLog(var msg: TMessage); begin ProcessSqlLog; end; function TMainForm.ExecuteRemoteQuery(sender: THandle; query: string): TDataSet; //var //tab: THandle; begin // tab := TMDIChild(ActiveMDIChild).CreateOrGetRemoteQueryTab(sender); // TQueryTab(tab).AddText(query); // tab.ExecOrQueueQuery(query); result := ExecuteQuery(query); end; procedure TMainForm.ExecuteRemoteNonQuery(sender: THandle; query: string); //var //tab: THandle; begin // tab := TMDIChild(ActiveMDIChild).CreateOrGetRemoteQueryTab(sender); // TQueryTab(tab).AddText(query); // tab.ExecOrQueueQuery(query); ExecuteNonQuery(query); end; procedure TMainForm.showstatus(msg: string=''; panel: Integer=6); begin // show Message in statusbar StatusBar.Panels[panel].Text := msg; StatusBar.Repaint; end; procedure TMainForm.refreshMonitorConfig; var Screen: TScreen; Monitor: TMonitor; Name: String; i: Integer; begin debug('main: Refresh monitor configuration.'); // Monitors are enumerated when a TScreen is constructed; // so we have to construct a new TScreen. Screen := TScreen.Create(nil); Name := ''; virtualDesktopName := 'WindowPos_'; try for i := 1 to Screen.MonitorCount do begin Monitor := Screen.Monitors[i - 1]; Name := Name + IntToStr(Monitor.Left) + 'x_' + IntToStr(Monitor.Top) + 'y_' + IntToStr(Monitor.Width) + 'w_' + IntToStr(Monitor.Height) + 'h' ; end; virtualDesktopName := virtualDesktopName + Name; finally Screen.Free; end; end; procedure TMainForm.saveWindowConfig; var ws: String; begin OpenRegistry; with MainReg do begin if OpenKey(REGPATH + virtualDesktopName + '\', True) then begin // Convert set to string. if WindowState = wsNormal then ws := 'Normal' else if WindowState = wsMinimized then ws := 'Minimized' else if WindowState = wsMaximized then ws := 'Maximized'; // Set WindowState to normal to put the correct restore bounds in // Left, Top, Width and Height; the call is processed immediately. WindowState := wsNormal; // Write out the results. WriteString(REGNAME_WINDOWSTATE, ws); WriteInteger(REGNAME_WINDOWLEFT, Left); WriteInteger(REGNAME_WINDOWTOP, Top); WriteInteger(REGNAME_WINDOWWIDTH, Width); WriteInteger(REGNAME_WINDOWHEIGHT, Height); end; end; end; procedure TMainForm.loadWindowConfig; var ws: String; begin // Called on application start or when monitor configuration has changed. OpenRegistry; with MainReg do begin if not OpenKey(REGPATH + virtualDesktopName + '\', False) then begin // Switch to default configuration if nothing was stored. setDefaultWindowConfig; end else begin // If found, load stored configuration for MainForm. Left := ReadInteger(REGNAME_WINDOWLEFT); Top := ReadInteger(REGNAME_WINDOWTOP); Width := ReadInteger(REGNAME_WINDOWWIDTH); Height := ReadInteger(REGNAME_WINDOWHEIGHT); ws := ReadString(REGNAME_WINDOWSTATE); if ws = 'Normal' then WindowState := wsNormal else if ws = 'Minimized' then WindowState := wsMinimized else if ws = 'Maximized' then WindowState := wsMaximized; end; end; end; procedure TMainForm.setDefaultWindowConfig; begin // If there are any default adjustments for the main form // when no window config is found, they should go here. end; procedure TMainForm.actExitApplicationExecute(Sender: TObject); begin Close; end; procedure TMainForm.actFlushExecute(Sender: TObject); var flushwhat: String; begin flushwhat := UpperCase(TAction(Sender).Caption); delete(flushwhat, pos('&', flushwhat), 1); ExecUpdateQuery('FLUSH ' + flushwhat); if Sender = actFlushTableswithreadlock then begin MessageDlg( 'Tables have been flushed and read lock acquired.'#10 + 'Perform backup or snapshot of table data files now.'#10 + 'Press OK to unlock when done...', mtInformation, [mbOk], 0 ); ExecUpdateQuery('UNLOCK TABLES'); end; end; procedure TMainForm.DisplayChange(var msg: TMessage); begin // At this point, the virtual desktop reconfiguration is complete, // but windows have not yet been resized and repositioned. // // HeidiSQL could save the current config here, and do a restore // after the automatic resize/reposition is done; this is signalled // by the first WM_WINDOWPOSCHANGED event to arrive after this procedure // has completed. // // However, that would require a complete save/restore for all windows, // not just the main window, so it would be a bit annoying to code. // // So for now, HeidiSQL trusts MS-Windows to replace windows correctly, // which has the slight annoyance factor that a user connecting with // remote desktop will have an automatic replacement applied instead // of a save/load transition using the last parameters for that virtual // desktop. // (no save here - see above.) refreshMonitorConfig; // (no wait for WindowPosChanged + load here - see above.) end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); var filename : String; begin DoDisconnect; EnterCriticalSection(SqlMessagesLock); FreeAndNil(SqlMessages); LeaveCriticalSection(SqlMessagesLock); OpenRegistry; // Position of Toolbars MainReg.WriteInteger(REGNAME_TOOLBAR2LEFT, ToolBarStandard.Left); MainReg.WriteInteger(REGNAME_TOOLBAR2TOP, ToolBarStandard.Top); MainReg.WriteInteger(REGNAME_TOOLBARDATALEFT, ToolBarData.Left); MainReg.WriteInteger(REGNAME_TOOLBARDATATOP, ToolBarData.Top); MainReg.WriteInteger(REGNAME_TOOLBARQUERYLEFT, ToolBarQuery.Left); MainReg.WriteInteger(REGNAME_TOOLBARQUERYTOP, ToolBarQuery.Top); // Save delimiter MainReg.WriteString( REGNAME_DELIMITER, Delimiter ); MainReg.WriteInteger( REGNAME_QUERYMEMOHEIGHT, pnlQueryMemo.Height ); MainReg.WriteInteger( REGNAME_QUERYHELPERSWIDTH, pnlQueryHelpers.Width ); MainReg.WriteInteger( REGNAME_DBTREEWIDTH, DBtree.width ); MainReg.WriteInteger( REGNAME_SQLOUTHEIGHT, SynMemoSQLLog.Height ); // Save width of probably resized columns of all VirtualTrees SaveListSetup(ListVariables); SaveListSetup(ListStatus); SaveListSetup(ListProcesses); SaveListSetup(ListCommandStats); SaveListSetup(ListTables); FreeAndNil(RoutineEditor); FreeAndNil(MaintenanceForm); FreeAndNil(UserManagerForm); FreeAndNil(ViewEditor); FreeAndNil(SelectDBObjectForm); FreeAndNil(SQLHelpForm); FreeAndNil(OptionsForm); debug('mem: clearing query and browse data.'); SetLength(FDataGridResult.Rows, 0); SetLength(FDataGridResult.Columns, 0); SetLength(FQueryGridResult.Rows, 0); SetLength(FQueryGridResult.Columns, 0); Action := caFree; saveWindowConfig; filename := GetTempDir+'\'+APPNAME+'-preview.'; if FileExists(filename+'html') then deletefile(filename+'html'); if FileExists(filename+'jpg') then deletefile(filename+'jpg'); if FileExists(filename+'gif') then deletefile(filename+'gif'); if FileExists(filename+'bmp') then deletefile(filename+'bmp'); if MainReg <> nil then begin MainReg.CloseKey; MainReg.Free; end; end; var spareMemory: Pointer = nil; procedure HandleRuntimeError(ErrorCode: Byte; ErrorAddr: Pointer); begin if spareMemory <> nil then FreeMem(spareMemory); debug('mem: released spare block.'); spareMemory := nil; if MainForm <> nil then begin PostMessage(MainForm.Handle, WM_REFILL_SPAREBUF, 0, 0); end; raise Exception.Create('Runtime error ' + IntToStr(ErrorCode) + ' at ' + IntToHex(Cardinal(ErrorAddr), 8) + '.'); end; procedure SpareBufRefill; begin debug('mem: reallocating spare block.'); if spareMemory = nil then spareMemory := AllocMem(6543210); end; procedure TMainForm.HandleWMRefill(var msg: TMessage); begin SpareBufRefill; end; {*** 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. } procedure TMainForm.FormCreate(Sender: TObject); var i: Integer; menuitem : TMenuItem; fontname, datafontname : String; fontsize, datafontsize : Integer; DisableProcessWindowsGhostingProc: procedure; begin caption := APPNAME; setLocales; // Make Vista miniature window work. //Application.MainFormOnTaskBar := True; // Use new Vista dialogs per default. //UseLatestCommonDialogs := True; SpareBufRefill; ErrorProc := HandleRuntimeError; refreshMonitorConfig; loadWindowConfig; // Beautify AppRevision if Pos('$Rev: WC', AppRevision) < 1 then AppRevision := 'unknown' else begin AppRevision := StringReplace( AppRevision, '$Rev: WC', '', [rfIgnoreCase] ); AppRevision := StringReplace( AppRevision, '$', '', [] ); AppRevision := Trim( AppRevision ); end; // Compose full version string FullAppVersion := 'Version ' + AppVersion + ', Revision ' + AppRevision; // "All users" folder for HeidiSQL's data (All Users\Application Data) DirnameCommonAppData := GetShellFolder(CSIDL_COMMON_APPDATA) + '\' + APPNAME + '\'; // User folder for HeidiSQL's data (\Application Data) DirnameUserAppData := GetShellFolder(CSIDL_APPDATA) + '\' + APPNAME + '\'; // Ensure directory exists ForceDirectories(DirnameUserAppData); // Folder which contains snippet-files DIRNAME_SNIPPETS := DirnameCommonAppData + 'Snippets\'; // Folder for session logfiles DirnameSessionLogs := DirnameUserAppData + 'Sessionlogs\'; QueryRunningInterlock := 0; UserQueryFired := False; UserQueryFiring := False; TemporaryDatabase := ''; // SQLFiles-History FillPopupQueryLoad; CachedTableLists := WideStrings.TWideStringList.Create; InitializeCriticalSection(SqlMessagesLock); EnterCriticalSection(SqlMessagesLock); SqlMessages := TWideStringList.Create; LeaveCriticalSection(SqlMessagesLock); Delimiter := GetRegValue(REGNAME_DELIMITER, DEFAULT_DELIMITER); // Delphi work around to force usage of Vista's default font (other OSes will be unaffected) SetVistaFonts(Font); InheritFont(Font); InheritFont(tabsetQueryHelpers.Font); InheritFont(SynCompletionProposal1.Font); // Fix node height on Virtual Trees for current DPI settings FixVT(DBTree); FixVT(ListVariables); FixVT(ListStatus); FixVT(ListProcesses); FixVT(ListCommandStats); FixVT(ListTables); // Position of Toolbars ToolBarStandard.Left := GetRegValue(REGNAME_TOOLBAR2LEFT, ToolBarStandard.Left); ToolBarStandard.Top := GetRegValue(REGNAME_TOOLBAR2TOP, ToolBarStandard.Top); ToolBarData.Left := GetRegValue(REGNAME_TOOLBARDATALEFT, ToolBarData.Left); ToolBarData.Top := GetRegValue(REGNAME_TOOLBARDATATOP, ToolBarData.Top); ToolBarQuery.Left := GetRegValue(REGNAME_TOOLBARQUERYLEFT, ToolBarQuery.Left); ToolBarQuery.Top := GetRegValue(REGNAME_TOOLBARQUERYTOP, ToolBarQuery.Top); pnlQueryMemo.Height := GetRegValue(REGNAME_QUERYMEMOHEIGHT, pnlQueryMemo.Height); pnlQueryHelpers.Width := GetRegValue(REGNAME_QUERYHELPERSWIDTH, pnlQueryHelpers.Width); DBtree.Width := GetRegValue(REGNAME_DBTREEWIDTH, DBtree.Width); SynMemoSQLLog.Height := GetRegValue(REGNAME_SQLOUTHEIGHT, SynMemoSQLLog.Height); // Force status bar position to below log memo StatusBar.Top := SynMemoSQLLog.Top + SynMemoSQLLog.Height; prefMaxColWidth := GetRegValue(REGNAME_MAXCOLWIDTH, DEFAULT_MAXCOLWIDTH); prefMaxTotalRows := GetRegValue(REGNAME_MAXTOTALROWS, DEFAULT_MAXTOTALROWS); // Fix registry entry from older versions which can have 0 here which makes no sense // since the autosetting was removed if prefMaxColWidth <= 0 then prefMaxColWidth := DEFAULT_MAXCOLWIDTH; prefLogsqlnum := GetRegValue(REGNAME_LOGSQLNUM, DEFAULT_LOGSQLNUM); prefLogSqlWidth := GetRegValue(REGNAME_LOGSQLWIDTH, DEFAULT_LOGSQLWIDTH); prefCSVSeparator := GetRegValue(REGNAME_CSV_SEPARATOR, DEFAULT_CSV_SEPARATOR); prefCSVEncloser := GetRegValue(REGNAME_CSV_ENCLOSER, DEFAULT_CSV_ENCLOSER); prefCSVTerminator := GetRegValue(REGNAME_CSV_TERMINATOR, DEFAULT_CSV_TERMINATOR); prefRememberFilters := GetRegValue(REGNAME_REMEMBERFILTERS, DEFAULT_REMEMBERFILTERS); // SQL-Font: fontname := GetRegValue(REGNAME_FONTNAME, DEFAULT_FONTNAME); fontsize := GetRegValue(REGNAME_FONTSIZE, DEFAULT_FONTSIZE); SynMemoQuery.Font.Name := fontname; SynMemoQuery.Font.Size := fontsize; SynMemoQuery.Gutter.Font.Name := fontname; SynMemoQuery.Gutter.Font.Size := fontsize; SynMemoFilter.Font.Name := fontname; SynMemoFilter.Font.Size := fontsize; SynMemoSQLLog.Font.Name := fontname; SynMemoSQLLog.Font.Size := fontsize; SynMemoSQLLog.Gutter.Font.Name := fontname; SynMemoSQLLog.Gutter.Font.Size := fontsize; SynMemoProcessView.Font.Name := fontname; SynMemoProcessView.Font.Size := fontsize; // Data-Font: datafontname := GetRegValue(REGNAME_DATAFONTNAME, DEFAULT_DATAFONTNAME); datafontsize := GetRegValue(REGNAME_DATAFONTSIZE, DEFAULT_DATAFONTSIZE); DataGrid.Font.Name := datafontname; QueryGrid.Font.Name := datafontname; DataGrid.Font.Size := datafontsize; QueryGrid.Font.Size := datafontsize; FixVT(DataGrid); FixVT(QueryGrid); // Load color settings prefFieldColorNumeric := GetRegValue(REGNAME_FIELDCOLOR_NUMERIC, DEFAULT_FIELDCOLOR_NUMERIC); prefFieldColorText := GetRegValue(REGNAME_FIELDCOLOR_TEXT, DEFAULT_FIELDCOLOR_TEXT); prefFieldColorBinary := GetRegValue(REGNAME_FIELDCOLOR_BINARY, DEFAULT_FIELDCOLOR_BINARY); prefFieldColorDatetime := GetRegValue(REGNAME_FIELDCOLOR_DATETIME, DEFAULT_FIELDCOLOR_DATETIME); prefFieldColorEnum := GetRegValue(REGNAME_FIELDCOLOR_ENUM, DEFAULT_FIELDCOLOR_ENUM); prefFieldColorSet := GetRegValue(REGNAME_FIELDCOLOR_SET, DEFAULT_FIELDCOLOR_SET); prefNullBG := GetRegValue(REGNAME_BG_NULL, DEFAULT_BG_NULL); CalcNullColors; // Editor enablings prefEnableBinaryEditor := GetRegValue(REGNAME_FIELDEDITOR_BINARY, DEFAULT_FIELDEDITOR_BINARY); prefEnableDatetimeEditor := GetRegValue(REGNAME_FIELDEDITOR_DATETIME, DEFAULT_FIELDEDITOR_DATETIME); prefEnableEnumEditor := GetRegValue(REGNAME_FIELDEDITOR_ENUM, DEFAULT_FIELDEDITOR_ENUM); prefEnableSetEditor := GetRegValue(REGNAME_FIELDEDITOR_SET, DEFAULT_FIELDEDITOR_SET); prefEnableNullBG := GetRegValue(REGNAME_BG_NULL_ENABLED, DEFAULT_BG_NULL_ENABLED); // Color coding: RestoreSyneditStyles(SynSQLSyn1); SynMemoQuery.ActiveLineColor := StringToColor(GetRegValue(REGNAME_SQLCOLACTIVELINE, ColorToString(DEFAULT_SQLCOLACTIVELINE))); // Switch off/on displaying table/db sized in tree menuShowSizeColumn.Checked := GetRegValue(REGNAME_SIZECOL_TREE, DEFAULT_SIZECOL_TREE); if menuShowSizeColumn.Checked then DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options + [coVisible] else DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options - [coVisible]; // Restore width of columns of all VirtualTrees RestoreListSetup(ListVariables); RestoreListSetup(ListStatus); RestoreListSetup(ListProcesses); RestoreListSetup(ListCommandStats); RestoreListSetup(ListTables); // Generate menuitems for popupDbGridHeader (column selection for ListTables) popupDBGridHeader.Items.Clear; for i:=0 to ListTables.Header.Columns.Count-1 do begin menuitem := TMenuItem.Create( popupDBGridHeader ); menuitem.Caption := ListTables.Header.Columns[i].Text; menuitem.OnClick := MenuTablelistColumnsClick; // Disable hiding first column menuitem.Enabled := i>0; menuitem.Checked := coVisible in ListTables.Header.Columns[i].Options; popupDbGridHeader.Items.Add( menuitem ); end; // Place progressbar on the statusbar ProgressBarStatus.Parent := StatusBar; ProgressBarStatus.Visible := False; // Work around Vistas ghosting feature breaking the GUI DisableProcessWindowsGhostingProc := GetProcAddress( GetModuleHandle('user32.dll'), 'DisableProcessWindowsGhosting'); if Assigned(DisableProcessWindowsGhostingProc) then DisableProcessWindowsGhostingProc; QueryMemoLineBreaks := lbsNone; end; {** Check for connection parameters on commandline or show connections form. } procedure TMainForm.Startup; var curParam : Byte; sValue, parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parDescription : String; LastUpdatecheck : TDateTime; UpdatecheckInterval : Integer; DefaultLastrunDate, LastSession: String; frm : TfrmUpdateCheck; dlgResult: Integer; Connected, CommandLineMode: Boolean; ConnForm: TConnForm; begin // Do an updatecheck if checked in settings if GetRegValue(REGNAME_DO_UPDATECHECK, DEFAULT_DO_UPDATECHECK) then begin DefaultLastrunDate := '2000-01-01'; try LastUpdatecheck := StrToDateTime( GetRegValue(REGNAME_LAST_UPDATECHECK, DefaultLastrunDate) ); except LastUpdatecheck := StrToDateTime( DefaultLastrunDate ); end; UpdatecheckInterval := GetRegValue(REGNAME_UPDATECHECK_INTERVAL, DEFAULT_UPDATECHECK_INTERVAL); if DaysBetween(Now, LastUpdatecheck) >= UpdatecheckInterval then begin frm := TfrmUpdateCheck.Create(Self); frm.AutoClose := True; frm.CheckForBuildsInAutoMode := GetRegValue(REGNAME_DO_UPDATECHECK_BUILDS, DEFAULT_DO_UPDATECHECK_BUILDS); frm.ShowModal; FreeAndNil(frm); end; end; Connected := False; // Check commandline if parameters were passed. Otherwise show connections windows curParam := 1; while curParam <= ParamCount do begin // -M and -d are choosen not to conflict with mysql.exe // http://dev.mysql.com/doc/refman/5.0/en/mysql-command-options.html // // To test all supported variants, set Run > Parameters > Parameters option to: // --host=192.168.0.1 --user=root --password -d "My session name" -D"test db" -C -P 2200 if GetParamValue('h', 'host', curParam, sValue) then parHost := sValue else if GetParamValue('P', 'port', curParam, sValue) then parPort := sValue else if GetParamValue('C', 'compress', curParam, sValue) then parCompress := sValue else if GetParamValue('M', 'timeout', curParam, sValue) then parTimeout := sValue else if GetParamValue('u', 'user', curParam, sValue) then parUser := sValue else if GetParamValue('p', 'password', curParam, sValue) then parPass := sValue else if GetParamValue('D', 'database', curParam, sValue) then parDatabase := sValue else if GetParamValue('d', 'description', curParam, sValue) then parDescription := sValue; Inc(curParam); end; // Find stored session if -dSessionName was passed if (parDescription <> '') and (MainReg.OpenKey(REGPATH + REGKEY_SESSIONS + parDescription, False)) then begin parHost := GetRegValue(REGNAME_HOST, DEFAULT_HOST, parDescription); parUser := GetRegValue(REGNAME_USER, DEFAULT_USER, parDescription); parPass := decrypt(GetRegValue(REGNAME_PASSWORD, DEFAULT_PASSWORD, parDescription)); parPort := GetRegValue(REGNAME_PORT, IntToStr(DEFAULT_PORT), parDescription); parTimeout := GetRegValue(REGNAME_TIMEOUT, IntToStr(DEFAULT_TIMEOUT), parDescription); parCompress := IntToStr(Integer(GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, parDescription))); parDatabase := GetRegValue(REGNAME_ONLYDBS, '', parDescription); end; // Minimal parameter for command line mode is hostname CommandLineMode := parHost <> ''; if CommandLineMode then begin Connected := InitConnection(parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, IntToStr(Integer(DEFAULT_ONLYDBSSORTED))); if Connected then begin SessionName := parDescription; if SessionName = '' then SessionName := parHost; end; end; // Auto connection via preference setting // Do not autoconnect if we're in commandline mode and the connection was not successful if (not CommandLineMode) and (not Connected) and GetRegValue(REGNAME_AUTORECONNECT, DEFAULT_AUTORECONNECT) then begin LastSession := GetRegValue(REGNAME_LASTSESSION, ''); if LastSession <> '' then begin Connected := InitConnection( GetRegValue(REGNAME_HOST, '', LastSession), GetRegValue(REGNAME_PORT, '', LastSession), GetRegValue(REGNAME_USER, '', LastSession), decrypt(GetRegValue(REGNAME_PASSWORD, '', LastSession)), Utf8Decode(GetRegValue(REGNAME_ONLYDBS, '', LastSession)), GetRegValue(REGNAME_TIMEOUT, '', LastSession), IntToStr(Integer(GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, LastSession))), IntToStr(Integer(GetRegValue(REGNAME_ONLYDBSSORTED, DEFAULT_ONLYDBSSORTED, LastSession))) ); if Connected then SessionName := LastSession; end; end; // Display session manager if not Connected then begin // Cannot be done in OnCreate because we need ready forms here: ConnForm := TConnForm.Create(Self); dlgResult := ConnForm.ShowModal; FreeAndNil(ConnForm); if dlgResult = mrCancel then begin Close; Halt; end; end; DoAfterConnect; if (not CommandLineMode) and (ParamStr(1) <> '') then begin // Loading SQL file by command line. Mutually exclusive to connect by command line. QueryLoad(ParamStr(1)); end; end; procedure TMainForm.actSessionManagerExecute(Sender: TObject); var ConnForm: TConnForm; begin ConnForm := TConnForm.Create(Self); if ConnForm.ShowModal <> mrCancel then DoAfterConnect; FreeAndNil(ConnForm); end; procedure TMainForm.DoAfterConnect; var i, j: Integer; lastUsedDB: WideString; v: String[50]; v1, v2, v3: String; rx: TRegExpr; functioncats : TStringList; miGroup, miFilterGroup, miFunction, miFilterFunction: TMenuItem; begin DataGridHasChanges := False; // Activate logging if GetRegValue(REGNAME_LOGTOFILE, DEFAULT_LOGTOFILE) then ActivateFileLogging; TimerConnected.Enabled := true; LogSQL('Connected. Thread-ID: ' + IntToStr( MySQLConn.Connection.GetThreadId )); // Detect server version // Be careful with version suffixes, for example: '4.0.31-20070605_Debian-5-log' v := GetVar( 'SELECT VERSION()' ); rx := TRegExpr.Create; rx.ModifierG := True; rx.Expression := '^(\d+)\.(\d+)\.(\d+)'; if rx.Exec(v) then begin v1 := rx.Match[1]; v2 := rx.Match[2]; v3 := rx.Match[3]; end; rx.Free; mysql_version := MakeInt(v1) *10000 + MakeInt(v2) *100 + MakeInt(v3); tabHost.Caption := 'Host: '+MySQLConn.Connection.HostName; showstatus('MySQL '+v1+'.'+v2+'.'+v3, 3); DatabasesWanted := explode(';', FConn.DatabaseList); if FConn.DatabaseListSort then DatabasesWanted.Sort; DBTree.Color := GetRegValue(REGNAME_TREEBACKGROUND, clWindow, SessionName); CheckUptime; // Invoke population of database tree. It's important to do this here after // having filled DatabasesWanted, not at design time. DBtree.RootNodeCount := 1; // Define window properties SetWindowConnected( true ); i := SetWindowName( SessionName ); winName := SessionName; if ( i <> 0 ) then begin winName := winName + Format( ' (%d)', [i] ); end; // Reselect last used database if GetRegValue( REGNAME_RESTORELASTUSEDDB, DEFAULT_RESTORELASTUSEDDB ) then begin lastUsedDB := Utf8Decode(GetRegValue(REGNAME_LASTUSEDDB, '', SessionName)); if lastUsedDB <> '' then try ActiveDatabase := lastUsedDB; except // Suppress exception message when db was dropped externally or // the session was just opened with "OnlyDBs" in place and the // last db is not contained in this list. end; end; // By default, select the host node if not Assigned(DBtree.FocusedNode) then begin DBtree.Selected[DBtree.GetFirst] := true; DBtree.FocusedNode := DBtree.GetFirst; end; // Create function menu items in popupQuery and popupFilter for i:=popupQuery.Items.Count-1 downto 0 do begin if popupQuery.Items[i].Caption = '-' then break; popupQuery.Items.Delete(i); end; for i:=popupFilter.Items.Count-1 downto 0 do begin if popupFilter.Items[i].Caption = '-' then break; popupFilter.Items.Delete(i); end; functioncats := GetFunctionCategories; for i:=0 to functioncats.Count-1 do begin // Create a menu item which gets subitems later miGroup := TMenuItem.Create(popupQuery); miGroup.Caption := functioncats[i]; popupQuery.Items.add(miGroup); miFilterGroup := TMenuItem.Create(popupFilter); miFilterGroup.Caption := miGroup.Caption; popupFilter.Items.add(miFilterGroup); for j:=0 to Length(MySqlFunctions)-1 do begin if MySqlFunctions[j].Category <> functioncats[i] then continue; miFunction := TMenuItem.Create(popupQuery); miFunction.Caption := MySqlFunctions[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 := MySqlFunctions[j].Name + MySqlFunctions[j].Declaration; // Take care of needed server version if MySqlFunctions[j].Version <= mysql_version then begin if MySqlFunctions[j].Description <> '' then miFunction.Hint := miFunction.Hint + ' - ' + Copy(MySqlFunctions[j].Description, 0, 200 ); miFunction.Tag := j; // Place menuitem on menu miFunction.OnClick := insertFunction; end else begin miFunction.Hint := miFunction.Hint + ' - ('+STR_NOTSUPPORTED+', needs >= '+ConvertServerVersion(MySqlFunctions[j].Version)+')'; miFunction.Enabled := False; end; // Prevent generating a seperator for ShortHint and LongHint miFunction.Hint := StringReplace( miFunction.Hint, '|', '¦', [rfReplaceAll] ); miGroup.Add(miFunction); // Create a copy of the menuitem for popupFilter miFilterFunction := TMenuItem.Create(popupFilter); miFilterFunction.Caption := miFunction.Caption; miFilterFunction.Hint := miFunction.Hint; miFilterFunction.ImageIndex := miFunction.ImageIndex; miFilterFunction.Tag := miFunction.Tag; miFilterFunction.OnClick := miFunction.OnClick; miFilterFunction.Enabled := miFunction.Enabled; miFilterGroup.Add(miFilterFunction); end; end; end; procedure TMainForm.DoDisconnect; begin // Open server-specific registry-folder. // relative from already opened folder! OpenRegistry(SessionName); MainReg.WriteString( REGNAME_LASTUSEDDB, Utf8Encode(ActiveDatabase) ); // Post pending UPDATE if DataGridHasChanges then actDataPostChangesExecute(Self); // Clear database and table lists DBtree.ClearSelection; DBtree.FocusedNode := nil; DBtree.Clear; ClearAllTableLists; FreeAndNil(DatabasesWanted); FreeAndNil(Databases); FreeAndNil(InformationSchemaTables); FreeAndNil(dsShowEngines); FreeAndNil(dsHaveEngines); FreeAndNil(dsCollations); // Free forms which use session based datasets, fx dsShowEngines FreeAndNil(TableEditor); FreeAndNil(CreateDatabaseForm); // Closing connection if Assigned(FMysqlConn) then begin LogSQL('Closing connection to "'+SessionName+'" session (' + FMysqlConn.Connection.hostname + ') ...'); FMysqlConn.Disconnect; FreeAndNil(FMysqlConn); end; if prefLogToFile then DeactivateFileLogging; // Invalidate list contents ListVariables.Tag := VTREE_NOTLOADED; ListStatus.Tag := VTREE_NOTLOADED; ListProcesses.Tag := VTREE_NOTLOADED; ListCommandstats.Tag := VTREE_NOTLOADED; SetWindowConnected( false ); SetWindowName( main.discname ); Application.Title := APPNAME; TimerConnected.Enabled := False; time_connected := 0; TimerHostUptime.Enabled := False; end; procedure TMainForm.actCreateDatabaseExecute(Sender: TObject); var newdb: String; begin // Create database: // Create modal form once on demand if CreateDatabaseForm = nil then CreateDatabaseForm := TCreateDatabaseForm.Create(Self); // Rely on the modalresult being set correctly if CreateDatabaseForm.ShowModal = mrOK then begin newdb := CreateDatabaseForm.editDBName.Text; // Add DB to OnlyDBs-regkey if this is not empty if DatabasesWanted.Count > 0 then begin DatabasesWanted.Add( newdb ); OpenRegistry(SessionName); MainReg.WriteString( 'OnlyDBs', ImplodeStr( ';', DatabasesWanted ) ); end; // reload db nodes and switch to new one RefreshTree(False, newdb); end; end; procedure TMainForm.actImportCSVExecute(Sender: TObject); begin // Import Textfile loaddataWindow(self); end; procedure TMainForm.actPreferencesExecute(Sender: TObject); begin // Preferences if OptionsForm = nil then OptionsForm := Toptionsform.Create(Self); OptionsForm.ShowModal; end; procedure TMainForm.actReadmeExecute(Sender: TObject); begin // show readme.txt ShellExec( 'readme.txt', ExtractFilePath(paramstr(0)) ); end; procedure TMainForm.FormResize(Sender: TObject); var i, room: Integer; PanelRect: TRect; begin room := 0; for i := 1 to Statusbar.Panels.Count - 1 do inc(room, Statusbar.Panels[i].Width); StatusBar.Panels[0].Width := Statusbar.Width - room; // Retreive the rectancle of the statuspanel (in our case the fifth panel) SendMessage(StatusBar.Handle, SB_GETRECT, 5, Integer(@PanelRect)); // Position the progressbar over the panel on the statusbar with PanelRect do ProgressBarStatus.SetBounds(Left, Top, Right-Left, Bottom-Top); lblDataTop.Width := pnlDataTop.Width - tlbDataButtons.Width - 10; end; procedure TMainForm.actUserManagerExecute(Sender: TObject); begin if UserManagerForm = nil then UserManagerForm := TUserManagerForm.Create(Self); if UserManagerForm.TestUserAdmin then UserManagerForm.ShowModal; end; procedure TMainForm.menuWindowClick(Sender: TObject); var i: integer; list: TWindowDataArray; item: TMenuItem; begin // Delete dynamically added connection menu items. // NOTE: The menu doesn't like having 0 items, so we keep one which we delete later. for i := menuWindow.Count - 1 downto 1 do menuWindow.Delete(i); // Check if all the heidisql windows are still alive. CheckForCrashedWindows; // Fetch the list of windows. list := GetWindowList; // TODO: Load "all" array with all connections // Re-create dynamic menu items. for i := 0 to High(list) do with list[i] do begin // TODO: Remove connection with this UID from "all" array item := TMenuItem.Create(self); if namePostfix <> 0 then name := name + Format(' (%d)', [namePostFix]); item.Caption := name; if (appHandle = Handle) and (connected) then item.ImageIndex := ICON_MYSELF_CONNECTED else if (appHandle = Handle) and (not connected) then item.ImageIndex := ICON_MYSELF_DISCONNECTED else if (appHandle <> Handle) and (connected) then item.ImageIndex := ICON_OTHER_CONNECTED else if (appHandle <> Handle) and (not connected) then item.ImageIndex := ICON_OTHER_DISCONNECTED; item.Tag := appHandle; item.OnClick := focusWindow; menuWindow.Add(item); end; // NOTE: The menu breaks if it has 0 items at any point. Therefore we delete item 0 as the last thing. // Perhaps later the Window menu will contain more items, for now it's initially filled with a fake menu item. menuWindow.Delete(0); end; procedure TMainForm.actAboutBoxExecute(Sender: TObject); begin // Info-Box AboutWindow (Self); end; procedure TMainForm.actClearEditorExecute(Sender: TObject); var m: TSynMemo; begin if Sender = actClearQueryEditor then m := SynMemoQuery else begin m := SynMemoFilter; editFilterSearch.Clear; end; m.SelectAll; m.SelText := ''; m.SelStart := 0; m.SelEnd := 0; end; procedure TMainForm.actMaintenanceExecute(Sender: TObject); begin // optimize / repair... tables if MaintenanceForm = nil then MaintenanceForm := TOptimize.Create(Self); MaintenanceForm.ShowModal; end; {** Create a view } procedure TMainForm.actCreateViewExecute(Sender: TObject); begin tabEditor.TabVisible := True; PagecontrolMain.ActivePage := tabEditor; PlaceObjectEditor(lntView); ViewEditor.Init; 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); begin // copy table CopyTableWindow(self); end; procedure TMainForm.focusWindow(Sender: TObject); begin ActivateWindow((Sender as TMenuItem).Tag); end; procedure TMainForm.menuConnectionsPopup(Sender: TObject); var i: integer; list: TWindowDataArray; item: TMenuItem; Connections: TStringList; begin // Delete dynamically added connection menu items. for i := menuConnections.Items.Count - 1 downto 0 do begin menuConnections.Items.Delete(i); end; // Check if all the heidisql windows are still alive. CheckForCrashedWindows; // Fetch list of heidisql windows. list := GetWindowList; // Re-create dynamic menu items. for i := 0 to High(list) do with list[i] do begin // TODO: Remove connection with this UID from "all" array item := TMenuItem.Create(self); if namePostfix <> 0 then name := name + Format(' (%d)', [namePostFix]); item.Caption := name; if (appHandle = Handle) and (connected) then item.ImageIndex := ICON_MYSELF_CONNECTED else if (appHandle = Handle) and (not connected) then item.ImageIndex := ICON_MYSELF_DISCONNECTED else if (appHandle <> Handle) and (connected) then item.ImageIndex := ICON_OTHER_CONNECTED else if (appHandle <> Handle) and (not connected) then item.ImageIndex := ICON_OTHER_DISCONNECTED; item.Tag := appHandle; item.OnClick := focusWindow; menuConnections.Items.Add(item); end; // Add separator item := TMenuItem.Create(menuConnections); item.Caption := '-'; menuConnections.Items.Add(item); // "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); // All sessions if MainReg.OpenKey(REGPATH + REGKEY_SESSIONS, False) then begin Connections := TStringList.Create; MainReg.GetKeyNames(Connections); for i := 0 to Connections.Count - 1 do begin item := TMenuItem.Create(menuConnections); item.Caption := Connections[i]; item.OnClick := SessionConnect; item.ImageIndex := 37; if Connections[i] = SessionName then begin item.Checked := True; item.ImageIndex := -1; end; menuConnections.Items.Add(item); end; end; end; procedure TMainForm.File1Click(Sender: TObject); var Item: TMenuItem; i: Integer; Connections: TStringList; begin // Decide if "Connect to" menu should be enabled menuConnectTo.Enabled := False; if MainReg.OpenKey(REGPATH + REGKEY_SESSIONS, False) then begin menuConnectTo.Enabled := MainReg.HasSubKeys; if menuConnectTo.Enabled then begin // Add all sessions to submenu for i := menuConnectTo.Count - 1 downto 0 do menuConnectTo.Delete(i); Connections := TStringList.Create; MainReg.GetKeyNames(Connections); for i := 0 to Connections.Count - 1 do begin Item := TMenuItem.Create(menuConnectTo); Item.Caption := Connections[i]; Item.OnClick := SessionConnect; Item.ImageIndex := 37; if Connections[i] = SessionName then begin Item.Checked := True; Item.ImageIndex := -1; end; menuConnectTo.Add(Item); end; end; end; end; procedure TMainForm.actWebbrowse(Sender: TObject); begin // Browse to URL (hint) ShellExec( TAction(Sender).Hint ); end; // Escape database, table, field, index or key name. function TMainform.mask(str: WideString) : WideString; begin result := maskSql(mysql_version, str); end; procedure TMainForm.actExportSettingsExecute(Sender: TObject); begin // Export settings to .reg-file if SaveDialog2.Execute then begin if winexec(pchar('regedit.exe /e "'+SaveDialog2.FileName+'" HKEY_CURRENT_USER'+REGPATH), SW_SHOW) = ERROR_FILE_NOT_FOUND then MessageDlg('File not found: regedit.exe', mtError, [mbOK], 0); end; end; procedure TMainForm.actImportSettingsExecute(Sender: TObject); begin // Import settings from .reg-file if OpenDialog2.Execute then begin if winexec(pchar('regedit.exe "'+OpenDialog2.FileName+'"'), SW_SHOW) = ERROR_FILE_NOT_FOUND then MessageDlg('File not found: regedit.exe', mtError, [mbOK], 0); end; end; procedure TMainForm.actExecuteQueryExecute(Sender: TObject); begin ExecSqlClick(sender, false); end; procedure TMainForm.actExecuteSelectionExecute(Sender: TObject); begin ExecSqlClick(sender, true); end; procedure TMainForm.actExecuteLineExecute(Sender: TObject); begin ExecSqlClick(sender, false, true); end; procedure TMainForm.actCopyAsCSVExecute(Sender: TObject); var S: TMemoryStream; GridData: PGridResult; begin // Copy data in focused grid as CSV Screen.Cursor := crHourglass; S := TMemoryStream.Create; try GridData := ActiveData; GridToCsv(ActiveGrid, GridData, prefCSVSeparator, prefCSVEncloser, prefCSVTerminator, S); StreamToClipboard(S); finally ShowStatus('Freeing data...'); S.Free; ShowStatus(STATUS_MSG_READY); Screen.Cursor := crDefault; end; end; procedure TMainForm.actCopyAsHTMLExecute(Sender: TObject); var S: TMemoryStream; Title: WideString; GridData: PGridResult; begin // Copy data in focused grid as HTML table Screen.Cursor := crHourglass; S := TMemoryStream.Create; if ActiveGrid = DataGrid then Title := SelectedTable.Text else Title := 'SQL query'; try GridData := ActiveData; GridToHtml(ActiveGrid, GridData, Title, S); StreamToClipboard(S); finally ShowStatus('Freeing data...'); S.Free; ShowStatus(STATUS_MSG_READY); Screen.Cursor := crDefault; end; end; procedure TMainForm.actCopyAsXMLExecute(Sender: TObject); var S: TMemoryStream; Root: WideString; GridData: PGridResult; begin // Copy data in focused grid as XML Screen.Cursor := crHourglass; S := TMemoryStream.Create; if ActiveGrid = DataGrid then Root := SelectedTable.Text else Root := 'SQL query'; try GridData := ActiveData; GridToXml(ActiveGrid, GridData, Root, S); StreamToClipboard(S); finally ShowStatus('Freeing data...'); S.Free; ShowStatus(STATUS_MSG_READY); Screen.Cursor := crDefault; end; end; procedure TMainForm.actCopyAsSQLExecute(Sender: TObject); var S: TMemoryStream; Tablename: WideString; GridData: PGridResult; begin // Copy data in focused grid as SQL Screen.Cursor := crHourglass; S := TMemoryStream.Create; if ActiveGrid = DataGrid then Tablename := SelectedTable.Text else Tablename := 'unknown'; try GridData := ActiveData; GridToSql(ActiveGrid, GridData, Tablename, S); StreamToClipboard(S); finally ShowStatus('Freeing data...'); S.Free; ShowStatus(STATUS_MSG_READY); Screen.Cursor := crDefault; end; end; procedure TMainForm.actExportDataExecute(Sender: TObject); var Grid: TVirtualStringTree; GridData: PGridResult; Dialog: TSaveDialog; FS: TFileStream; Title: WideString; begin // Save data in current dataset as CSV, HTML or XML Dialog := SaveDialogExportData; Grid := ActiveGrid; GridData := ActiveData; if Grid = DataGrid then Title := SelectedTable.Text else Title := 'SQL query'; Dialog.FileName := Title; Dialog.Title := 'Export result set from '+Dialog.Filename+'...'; if Dialog.Execute and (Dialog.FileName <> '') then try Screen.Cursor := crHourGlass; FS := openfs(Dialog.FileName); case Dialog.FilterIndex of 1: GridToCsv(Grid, GridData, prefCSVSeparator, prefCSVEncloser, prefCSVTerminator, FS); 2: GridToHtml(Grid, GridData, Title, FS); 3: GridToXml(Grid, GridData, Title, FS); 4: GridToSql(Grid, GridData, Title, FS); end; ShowStatus('Freeing data...'); FS.Free; finally ShowStatus(STATUS_MSG_READY); Screen.Cursor := crDefault; end; end; // view HTML procedure TMainForm.actHTMLviewExecute(Sender: TObject); const msgNotBinary = 'Non-binary field selected. Only binary fields containing JPEG, PNG, GIF and BMP images are supported.'; msgNotImage = 'Unrecognized image format. Only JPEG, PNG, GIF and BMP are supported.'; var g : TVirtualStringTree; filename : String; f : Textfile; Header, Content : String; IsBinary : Boolean; SaveBinary : Boolean; begin g := ActiveGrid; if g = nil then begin messagebeep(MB_ICONASTERISK); exit; end; Screen.Cursor := crHourGlass; showstatus('Saving contents to file...'); IsBinary := ActiveData.Columns[g.FocusedColumn].DatatypeCat = dtcBinary; Header := WideHexToBin(Copy(g.Text[g.FocusedNode, g.FocusedColumn], 3, 20)); SaveBinary := false; filename := GetTempDir+'\'+APPNAME+'-preview.'; if IsBinary and (Copy(Header, 7, 4) = 'JFIF') then begin SaveBinary := true; filename := filename + 'jpeg'; end else if IsBinary and (Copy(Header, 2, 3) = 'PNG') then begin SaveBinary := true; filename := filename + 'png'; end else if IsBinary and StrCmpBegin('GIF', Header) then begin SaveBinary := true; filename := filename + 'gif'; end else if IsBinary and StrCmpBegin('BM', Header) then begin SaveBinary := true; filename := filename + 'bmp'; end; if not IsBinary then begin MessageDlg(msgNotBinary, mtWarning, [mbOk], 0); end else if not SaveBinary then begin MessageDlg(msgNotImage, mtWarning, [mbOk], 0); end; if SaveBinary then begin if not EnsureFullWidth(g, g.FocusedColumn, g.FocusedNode) then Exit; Content := WideHexToBin(Copy(g.Text[g.FocusedNode, g.FocusedColumn], 3, High(Integer))); AssignFile(f, filename); Rewrite(f); Write(f, Content); CloseFile(f); end; ShowStatus( STATUS_MSG_READY ); Screen.Cursor := crDefault; ShellExec( filename ); end; procedure TMainForm.actInsertFilesExecute(Sender: TObject); begin InsertFilesWindow(Self); end; procedure TMainForm.actExportTablesExecute(Sender: TObject); var f: TExportSQLForm; ds: TDataset; InDBTree: Boolean; Comp: TComponent; begin f := TExportSQLForm.Create(Self); // popupDB is used in DBTree AND ListTables InDBTree := False; Comp := (Sender as TAction).ActionComponent; if Comp is TMenuItem then InDBTree := TPopupMenu((Comp as TMenuItem).GetParentMenu).PopupComponent = DBTree; if InDBTree then begin // If a table is selected, use that for preselection. If only a db was selected, use all tables inside it. if SelectedTable.Text <> '' then f.SelectedTables.Add(SelectedTable.Text) else if Mainform.ActiveDatabase <> '' then begin ds := Mainform.FetchDbTableList(ActiveDatabase); while not ds.Eof do begin f.SelectedTables.Add(ds.FieldByName(DBO_NAME).AsWideString); ds.Next; end; end; end else f.SelectedTables := GetVTCaptions( Mainform.ListTables, True ); f.ShowModal; FreeAndNil(f); end; // Drop Table(s) procedure TMainForm.actDropObjectsExecute(Sender: TObject); var AllCount : Integer; Tables, Views, Functions, Procedures: TWideStringList; msg, activeDB : WideString; InDBTree: Boolean; Act: TAction; procedure DoDrop(Kind: String; List: TWideStringlist; MultiDrops: Boolean); var i: Integer; baseSql, sql: WideString; begin if List.Count > 0 then begin baseSql := 'DROP '+Kind+' '; sql := ''; for i := 0 to List.Count - 1 do begin if (i > 0) and MultiDrops then sql := sql + ', '; sql := sql + mask(List[i]); if not MultiDrops then begin ExecUpdateQuery(baseSql + sql); sql := ''; end; end; if MultiDrops then ExecUpdateQuery(baseSql + sql); end; FreeAndNil(List); end; begin debug('drop objects activated'); // Set default database name to to ActiveDatabase. // Can be overwritten when someone selects a table in dbtree from different database activeDB := ActiveDatabase; Tables := TWideStringlist.Create; Views := TWideStringlist.Create; Procedures := TWideStringlist.Create; Functions := TWideStringlist.Create; Act := Sender as TAction; InDBTree := (Act.ActionComponent is TMenuItem) and (TPopupMenu((Act.ActionComponent as TMenuItem).GetParentMenu).PopupComponent = DBTree); if InDBTree then begin // drop table selected in tree view. case GetFocusedTreeNodeType of lntDb: begin if MessageDlg('Drop Database "'+activeDB+'"?' + crlf + crlf + 'WARNING: You will lose all tables in database '+activeDB+'!', mtConfirmation, [mbok,mbcancel], 0) <> mrok then Abort; Screen.Cursor := crHourglass; try ExecUpdateQuery( 'DROP DATABASE ' + mask(activeDB) ); ClearDbTableList(activeDB); if DatabasesWanted.IndexOf(activeDB) > -1 then begin DatabasesWanted.Delete( DatabasesWanted.IndexOf(activeDB) ); OpenRegistry(SessionName); MainReg.WriteString( 'OnlyDBs', ImplodeStr( ';', DatabasesWanted ) ); end; DBtree.Selected[DBtree.GetFirst] := true; RefreshTree(False); finally Screen.Cursor := crDefault; end; Exit; end; lntTable, lntCrashedTable: Tables.Add(SelectedTable.Text); lntView: Views.Add(SelectedTable.Text); lntProcedure: Procedures.Add(SelectedTable.Text); lntFunction: Functions.Add(SelectedTable.Text); end; end else begin // Invoked from database tab Tables := GetVTCaptions(ListTables, True, 0, lntTable); Tables.AddStrings(GetVTCaptions(ListTables, True, 0, lntCrashedTable)); Views := GetVTCaptions(ListTables, True, 0, lntView); Procedures := GetVTCaptions(ListTables, True, 0, lntProcedure); Functions := GetVTCaptions(ListTables, True, 0, lntFunction); end; // Fix actions temporarily enabled for popup menu. ValidateControls(Sender); AllCount := Tables.Count + Views.Count + Procedures.Count + Functions.Count; // Safety stop to avoid firing DROP TABLE without tablenames if (AllCount = 0) then Exit; // Ask user for confirmation to drop selected objects msg := 'Drop ' + IntToStr(AllCount) + ' object(s) in database "'+activeDB+'"?' + CRLF; if Tables.Count > 0 then msg := msg + CRLF + 'Table(s): ' + ImplodeStr(', ', Tables); if Views.Count > 0 then msg := msg + CRLF + 'View(s): ' + ImplodeStr(', ', Views); if Procedures.Count > 0 then msg := msg + CRLF + 'Procedure(s): ' + ImplodeStr(', ', Procedures); if Functions.Count > 0 then msg := msg + CRLF + 'Function(s): ' + ImplodeStr(', ', Functions); if MessageDlg(msg, mtConfirmation, [mbok,mbcancel], 0) <> mrok then Exit; // Compose and run DROP [TABLE|VIEW|...] queries DoDrop('TABLE', Tables, True); DoDrop('VIEW', Views, True); DoDrop('PROCEDURE', Procedures, False); DoDrop('FUNCTION', Functions, False); // Refresh ListTables + dbtree so the dropped tables are gone: actRefresh.Execute; end; // Load SQL-file, make sure that SheetQuery is activated procedure TMainForm.actLoadSQLExecute(Sender: TObject); begin PageControlMain.ActivePage := tabQuery; if OpenDialogSQLfile.Execute then QueryLoad( OpenDialogSQLfile.FileName ); end; {** Parse commandline for a specific name=value pair @return Boolean True if parameter was found, False if not } function TMainForm.GetParamValue(const paramChar: Char; const paramName: string; var curIdx: Byte; out paramValue: string): Boolean; var i, nextIdx: Integer; param, nextParam: string; begin paramValue := ''; param := ParamStr(curIdx); // Example: --user=root --session="My session name" --password if Pos('--' + paramName, param) = 1 then begin i := Length('--' + paramName) + 1; if param[i] = '=' then paramValue := Copy(param, i + 1, Length(param) - i); if (Copy(paramValue, 1, 1) = '"') and (Copy(paramValue, Length(paramValue), 1) = '"') then paramValue := Copy(paramValue, 2, Length(paramValue) - 2); result := True; end else if Pos('-' + paramChar, param) = 1 then begin if Length(param) > 2 then begin // Example: -uroot -s"My session name" paramValue := Copy(param, 3, Length(param) - 2); if (Copy(paramValue, 1, 1) = '"') and (Copy(paramValue, Length(paramValue), 1) = '"') then paramValue := Copy(paramValue, 2, Length(paramValue) - 2); end else begin // Example: -u root -s "My session name" -p nextIdx := curIdx + 1; if nextIdx <= ParamCount then begin nextParam := ParamStr(nextIdx); if not Pos('-', nextParam) = 1 then paramValue := nextParam; end; end; result := True; end else result := False; end; procedure TMainForm.SessionConnect(Sender: TObject); var Session: String; parHost, parPort, parUser, parPass, parTimeout, parCompress, parDatabase, parSortDatabases: WideString; begin Session := (Sender as TMenuItem).Caption; parHost := GetRegValue(REGNAME_HOST, '', Session); parUser := GetRegValue(REGNAME_USER, '', Session); parPass := decrypt(GetRegValue(REGNAME_PASSWORD, '', Session)); parPort := GetRegValue(REGNAME_PORT, '', Session); parTimeout := GetRegValue(REGNAME_TIMEOUT, '', Session); parCompress := IntToStr(Integer(GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, Session))); parDatabase := Utf8Decode(GetRegValue(REGNAME_ONLYDBS, '', Session)); parSortDatabases := IntToStr(Integer(GetRegValue(REGNAME_ONLYDBSSORTED, DEFAULT_ONLYDBSSORTED, Session))); if InitConnection(parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parSortDatabases) then begin SessionName := Session; DoAfterConnect; end; end; {** Receive connection parameters and create the mdi-window Paremeters are either sent by connection-form or by commandline. } function TMainform.InitConnection(parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parSortDatabases: WideString): Boolean; var MysqlConnection: TMysqlConn; Profile: TOpenConnProf; UsingPass: String; begin // fill structure ZeroMemory(@Profile, SizeOf(Profile)); Profile.MysqlParams.Protocol := 'mysql'; Profile.MysqlParams.Host := Trim( parHost ); Profile.MysqlParams.Port := StrToIntDef(parPort, DEFAULT_PORT); Profile.MysqlParams.Database := ''; Profile.MysqlParams.User := parUser; Profile.MysqlParams.Pass := parPass; if Integer(parCompress) > 0 then Profile.MysqlParams.PrpCompress := 'true' else Profile.MysqlParams.PrpCompress := 'false'; Profile.MysqlParams.PrpTimeout := parTimeout; Profile.MysqlParams.PrpDbless := 'true'; Profile.MysqlParams.PrpClientLocalFiles := 'true'; Profile.MysqlParams.PrpClientInteractive := 'true'; Profile.DatabaseList := parDatabase; Profile.DatabaseListSort := Boolean(StrToIntDef(parSortDatabases, 0)); MysqlConnection := TMysqlConn.Create(@Profile); // attempt to establish connection if Profile.MysqlParams.Pass <> '' then UsingPass := 'Yes' else UsingPass := 'No'; LogSQL('Connecting to '+Profile.MysqlParams.Host+ ', username '+Profile.MysqlParams.User+ ', using password: '+UsingPass+' ...'); if MysqlConnection.Connect <> MCR_SUCCESS then begin // attempt failed -- show error MessageDlg ( 'Could not establish connection! Details:'+CRLF+CRLF+MysqlConnection.LastError, mtError, [mbOK], 0); Result := False; FreeAndNil(MysqlConnection); end else begin Result := True; Profile.MysqlConn := MysqlConnection.Connection; if Assigned(FMysqlConn) then DoDisconnect; // Assign global connection objects FConn := Profile; FMysqlConn := MysqlConnection; end; ShowStatus( STATUS_MSG_READY ); end; procedure TMainForm.actDataDeleteExecute(Sender: TObject); begin // Delete row(s) if (DataGrid.SelectedCount = 1) and (FDataGridResult.Rows[DataGrid.GetFirstSelected.Index].State = grsInserted) then begin // Deleting the virtual row which is only in memory by stopping edit mode actDataCancelChanges.Execute; end else begin // The "normal" case: Delete existing rows if not CheckUniqueKeyClause then Exit; if DataGrid.SelectedCount = 0 then MessageDLG('Please select one or more rows to delete them.', mtError, [mbOK], 0) else if MessageDLG('Delete '+inttostr(DataGrid.SelectedCount)+' row(s)?', mtConfirmation, [mbOK, mbCancel], 0) = mrOK then begin GridPostDelete(DataGrid); end; end; end; procedure TMainForm.actUpdateCheckExecute(Sender: TObject); var frm : TfrmUpdateCheck; begin frm := TfrmUpdateCheck.Create(Self); frm.ShowModal; FreeAndNil(frm); end; procedure TMainForm.actCreateTableExecute(Sender: TObject); begin tabEditor.TabVisible := True; PagecontrolMain.ActivePage := tabEditor; PlaceObjectEditor(lntTable); TableEditor.Init; end; procedure TMainForm.actEmptyTablesExecute(Sender: TObject); var t: TWideStringList; i: Integer; sql_pattern: String; begin if ListTables.SelectedCount = 0 then exit; // Add selected items/tables to helper list t := GetVTCaptions(ListTables, True); if MessageDlg('Empty ' + IntToStr(t.count) + ' table(s) ?' + CRLF + '(' + implodestr(', ', t) + ')', mtConfirmation, [mbOk, mbCancel], 0) <> mrOk then exit; Screen.Cursor := crHourglass; {** @note ansgarbecker: Empty table using faster TRUNCATE statement on newer servers @see http://dev.mysql.com/doc/refman/5.0/en/truncate.html @see https://sourceforge.net/tracker/index.php?func=detail&aid=1644143&group_id=164593&atid=832350 } if mysql_version < 50003 then sql_pattern := 'DELETE FROM ' else sql_pattern := 'TRUNCATE '; for i:=0 to t.count-1 do ExecUpdateQuery( sql_pattern + mask(t[i]) ); t.Free; actRefresh.Execute; Screen.Cursor := crDefault; end; procedure TMainForm.actNewWindowExecute(Sender: TObject); begin debug('perf: new connection clicked.'); ShellExec( ExtractFileName(paramstr(0)), ExtractFilePath(paramstr(0)) ); end; procedure TMainForm.actQueryFindExecute(Sender: TObject); var m: TSynMemo; begin m := SynMemoQuery; // if something is selected search for that text if m.SelAvail then FindDialogQuery.FindText := m.SelText else FindDialogQuery.FindText := m.WordAtCursor; FindDialogQuery.Execute; end; procedure TMainForm.actQueryReplaceExecute(Sender: TObject); var m: TSynMemo; begin m := SynMemoQuery; // if something is selected search for that text if m.SelAvail then ReplaceDialogQuery.FindText := m.SelText else ReplaceDialogQuery.FindText := m.WordAtCursor; ReplaceDialogQuery.Execute; end; procedure TMainForm.actRefreshExecute(Sender: TObject); var tab1, tab2: TTabSheet; List: TVirtualStringTree; begin // Refresh // Force data tab update when appropriate. dataselected := false; tab1 := PageControlMain.ActivePage; if ActiveControl = DBtree then RefreshTree(True) else if tab1 = tabHost then begin tab2 := PageControlHost.ActivePage; if tab2 = tabVariables then List := ListVariables else if tab2 = tabStatus then List := ListStatus else if tab2 = tabProcessList then List := ListProcesses else List := ListCommandStats; List.Tag := VTREE_NOTLOADED; List.Repaint; end else if tab1 = tabDatabase then begin RefreshTreeDB(ActiveDatabase); LoadDatabaseProperties(ActiveDatabase); end else if tab1 = tabData then viewdata(Sender); end; procedure TMainForm.actSQLhelpExecute(Sender: TObject); var keyword : String; ds: TDataset; begin // Call SQL Help from various places if mysql_version < 40100 then exit; keyword := ''; // Query-Tab if ActiveControl is TSynMemo then keyword := TSynMemo(ActiveControl).WordAtCursor // Data-Tab else if (PageControlMain.ActivePage = tabData) and Assigned(DataGrid.FocusedNode) then begin ds := SelectedTableColumns; ds.RecNo := DataGrid.FocusedColumn; keyword := ds.FieldByName('Type').AsWideString; end else if lboxQueryHelpers.Focused then begin // Makes only sense if one of the tabs "SQL fn" or "SQL kw" was selected if tabsetQueryHelpers.TabIndex in [1,2] then begin keyword := lboxQueryHelpers.Items[lboxQueryHelpers.ItemIndex]; end; end; // Clean existing paranthesis, fx: char(64) if Pos( '(', keyword ) > 0 then begin keyword := Copy( keyword, 1, Pos( '(', keyword )-1 ); end; // Show the window CallSQLHelpWithKeyword( keyword ); end; {*** Show SQL Help window directly using a keyword @param String SQL-keyword @see FieldeditForm.btnDatatypeHelp } procedure TMainform.CallSQLHelpWithKeyword( keyword: String ); begin if SQLHelpForm = nil then SQLHelpForm := TfrmSQLhelp.Create(Self); SQLHelpForm.Keyword := keyword; SQLHelpForm.ShowModal; end; procedure TMainForm.actSaveSQLExecute(Sender: TObject); var Text, LB: WideString; begin // Save SQL if SaveDialogSQLFile.Execute then begin Screen.Cursor := crHourGlass; // Save complete content or just the selected text, // depending on the tag of calling control case (Sender as TAction).Tag of 0: Text := SynMemoQuery.Text; 1: Text := SynMemoQuery.SelText; end; LB := ''; case QueryMemoLineBreaks of lbsUnix: LB := LB_UNIX; lbsMac: LB := LB_MAC; lbsWide: LB := LB_WIDE; end; if LB <> '' then Text := WideStringReplace(Text, CRLF, LB, [rfReplaceAll]); SaveUnicodeFile( SaveDialogSQLFile.FileName, Text ); Screen.Cursor := crDefault; end; end; procedure TMainForm.actSaveSQLSnippetExecute(Sender: TObject); var snippetname : String; mayChange : Boolean; Text, LB: WideString; begin // Save snippet if InputQuery( 'Save snippet', 'Snippet name:', snippetname) then begin if Copy( snippetname, Length(snippetname)-4, 4 ) <> '.sql' then snippetname := snippetname + '.sql'; // cleanup snippetname from special characters snippetname := DIRNAME_SNIPPETS + goodfilename(snippetname); if FileExists( snippetname ) then begin if MessageDlg( 'Overwrite existing snippet '+snippetname+'?', mtConfirmation, [mbOK, mbCancel], 0 ) <> mrOK then exit; end; Screen.Cursor := crHourglass; // Save complete content or just the selected text, // depending on the tag of calling control case (Sender as TComponent).Tag of 0: Text := SynMemoQuery.Text; 1: Text := SynMemoQuery.SelText; end; LB := ''; case QueryMemoLineBreaks of lbsUnix: LB := LB_UNIX; lbsMac: LB := LB_MAC; lbsWide: LB := LB_WIDE; end; if LB <> '' then Text := WideStringReplace(Text, CRLF, LB, [rfReplaceAll]); SaveUnicodeFile( snippetname, Text ); FillPopupQueryLoad; if tabsetQueryHelpers.TabIndex = 3 then begin // SQL Snippets selected in query helper, refresh list mayChange := True; // Unused; satisfies callee parameter collection which is probably dictated by tabset. tabsetQueryHelpersChange(Sender, 3, mayChange); end; Screen.Cursor := crDefault; 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 SynMemoQuery.WordWrap := TAction(Sender).Checked; end; procedure TMainForm.FindDialogQueryFind(Sender: TObject); var Options: TSynSearchOptions; Search: String; begin Search := FindDialogQuery.FindText; Options := []; if Sender is TReplaceDialog then Include(Options, ssoEntireScope); if not (frDown in FindDialogQuery.Options) then Include(Options, ssoBackwards); if frMatchCase in FindDialogQuery.Options then Include(Options, ssoMatchCase); if frWholeWord in FindDialogQuery.Options then Include(Options, ssoWholeWord); if SynMemoQuery.SearchReplace(Search, '', Options) = 0 then begin MessageBeep(MB_ICONASTERISK); ShowStatus( 'SearchText ''' + Search + ''' not found!', 0); end; end; procedure TMainForm.ReplaceDialogQueryFind(Sender: TObject); begin FindDialogQuery.FindText := ReplaceDialogQuery.FindText; FindDialogQueryFind( ReplaceDialogQuery ); end; procedure TMainForm.ReplaceDialogQueryReplace(Sender: TObject); var Options: TSynSearchOptions; Search: String; begin Search := ReplaceDialogQuery.FindText; Options := [ssoEntireScope]; // Do replaces always on entire scope, because the standard-dialog lacks of a down/up-option if frReplaceAll in ReplaceDialogQuery.Options then Include( Options, ssoReplaceAll ); if not (frDown in ReplaceDialogQuery.Options) then Include(Options, ssoBackwards); if frMatchCase in ReplaceDialogQuery.Options then Include(Options, ssoMatchCase); if frWholeWord in ReplaceDialogQuery.Options then Include(Options, ssoWholeWord); if frReplace in ReplaceDialogQuery.Options then // Replace instead of ReplaceAll is pressed Include(Options, ssoReplace) else Include(Options, ssoReplaceAll); if SynMemoQuery.SearchReplace( Search, ReplaceDialogQuery.ReplaceText, Options) = 0 then begin MessageBeep(MB_ICONASTERISK); ShowStatus( 'SearchText ''' + Search + ''' not found!', 0); if ssoBackwards in Options then SynMemoQuery.BlockEnd := SynMemoQuery.BlockBegin else SynMemoQuery.BlockBegin := SynMemoQuery.BlockEnd; SynMemoQuery.CaretXY := SynMemoQuery.BlockBegin; end; end; procedure TMainform.FillPopupQueryLoad; var i, j: Integer; menuitem, snippetsfolder: TMenuItem; snippets: TStringList; sqlFilename: String; begin // Fill the popupQueryLoad menu popupQueryLoad.Items.Clear; // Snippets snippets := getFilesFromDir( DIRNAME_SNIPPETS, '*.sql', true ); snippetsfolder := TMenuItem.Create( popupQueryLoad ); snippetsfolder.Caption := 'Snippets'; popupQueryLoad.Items.Add(snippetsfolder); for i := 0 to snippets.Count - 1 do begin menuitem := TMenuItem.Create( snippetsfolder ); menuitem.Caption := snippets[i]; menuitem.OnClick := popupQueryLoadClick; snippetsfolder.Add(menuitem); end; // Separator menuitem := TMenuItem.Create( popupQueryLoad ); menuitem.Caption := '-'; popupQueryLoad.Items.Add(menuitem); // Recent files j := 0; for i:=0 to 19 do begin sqlFilename := GetRegValue( 'SQLFile'+IntToStr(i), '' ); if sqlFilename = '' then continue; inc(j); menuitem := TMenuItem.Create( popupQueryLoad ); menuitem.Caption := IntToStr(j) + ' ' + sqlFilename; menuitem.OnClick := popupQueryLoadClick; popupQueryLoad.Items.Add(menuitem); end; // Separator + "Remove absent files" menuitem := TMenuItem.Create( popupQueryLoad ); menuitem.Caption := '-'; popupQueryLoad.Items.Add(menuitem); menuitem := TMenuItem.Create( popupQueryLoad ); menuitem.Caption := 'Remove absent files'; menuitem.OnClick := PopupQueryLoadRemoveAbsentFiles; popupQueryLoad.Items.Add(menuitem); end; procedure TMainform.PopupQueryLoadRemoveAbsentFiles( sender: TObject ); begin AddOrRemoveFromQueryLoadHistory( '', false, true ); FillPopupQueryLoad; end; procedure TMainform.popupQueryLoadClick( sender: TObject ); var filename : String; p : Integer; begin // Click on the popupQueryLoad filename := (Sender as TMenuItem).Caption; if Pos( '\', filename ) = 0 then begin // assuming we load a snippet filename := DIRNAME_SNIPPETS + filename + '.sql'; end else begin // assuming we load a file from the recent-list p := Pos( ' ', filename ) + 1; filename := Copy(filename, p, Length(filename)); end; filename := Stringreplace(filename, '&', '', [rfReplaceAll]); QueryLoad( filename ); end; procedure TMainform.AddOrRemoveFromQueryLoadHistory( filename: String; AddIt: Boolean = true; CheckIfFileExists: Boolean = true ); var i : Integer; Values, newfilelist : TStringList; savedfilename : String; begin // Add or remove filename to/from history, avoiding duplicates newfilelist := TStringList.create; Values := TStringList.create; OpenRegistry; MainReg.GetValueNames( Values ); // Add new filename if AddIt then newfilelist.Add( filename ); // Add all other filenames for i:=0 to Values.Count-1 do begin if Pos( 'SQLFile', Values[i] ) <> 1 then continue; savedfilename := GetRegValue( Values[i], '' ); MainReg.DeleteValue( Values[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; MainReg.WriteString( 'SQLFile'+IntToStr(i), newfilelist[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 MessageDlg(E.Message, mtError, [mbOK], 0); end else // Cancel clicked ok := True; end; end; {** Validates and sets the Delimiter property plus updates the hint on actSetDelimiter } procedure TMainForm.SetDelimiter(Value: String); var ErrMsg: String; begin ErrMsg := ''; Value := Trim(Value); // Test for empty delimiter. if Value = '' then ErrMsg := 'DELIMITER must be followed by a non-comment character or string'; // Disallow backslash, because the MySQL CLI does so for some reason. // Then again, is there any reason to be bug-per-bug compatible with some random SQL parser? if Pos('\', Value) > 0 then ErrMsg := 'Backslash disallowed in DELIMITER (because the MySQL CLI does not accept it)'; // Disallow stuff which would be negated by the comment parsing logic. if (Pos('/*', Value) > 0) or (Pos('--', Value) > 0) or (Pos('#', Value) > 0) then ErrMsg := 'Start-of-comment tokens disallowed in DELIMITER (because it would be ignored)'; // Disallow stuff which would be negated by the SQL parser (and could slightly confuse it, if at end-of-string). if (Pos('''', Value) > 0) or (Pos('`', Value) > 0) or (Pos('"', Value) > 0) then ErrMsg := 'String literal markers disallowed in DELIMITER (because it would be ignored)'; // Reset an invalid delimiter loaded from registry at startup to the default value if (ErrMsg <> '') and (Delimiter = '') then begin Value := DEFAULT_DELIMITER; ErrMsg := ''; end; // Raise or set it if ErrMsg <> '' then begin ErrMsg := Format('Invalid delimiter %s: %s.', [Value, ErrMsg]); LogSQL(ErrMsg); Raise Exception.Create(ErrMsg); end else begin FDelimiter := Value; LogSQL(Format('Delimiter changed to %s.', [Delimiter])); actSetDelimiter.Hint := actSetDelimiter.Caption + ' (current value: '+Delimiter+')'; end; end; procedure TMainForm.actApplyFilterExecute(Sender: TObject); var i, nr: Integer; OldNumbers, Filters: TStringList; val: String; begin if SynMemoFilter.GetTextLen > 0 then begin // Recreate recent filters list Filters := TStringList.Create; OldNumbers := TStringList.Create; Filters.Add(Trim(Utf8Encode(SynMemoFilter.Text))); MainReg.OpenKey(GetRegKeyTable+'\'+REGNAME_FILTERS, True); MainReg.GetValueNames(OldNumbers); OldNumbers.CustomSort(CompareNumbers); // Add old filters for i := 0 to OldNumbers.Count - 1 do begin nr := MakeInt(OldNumbers[i]); if nr = 0 then continue; // Not a valid entry, ignore that val := MainReg.ReadString(OldNumbers[i]); if Filters.IndexOf(val) = -1 then Filters.Add(val); MainReg.DeleteValue(OldNumbers[i]); end; for i := 1 to Filters.Count do begin MainReg.WriteString(IntToStr(i), Filters[i-1]); // Avoid too much registry spam with mega old filters if i = 20 then break; end; FreeAndNil(OldNumbers); FreeAndNil(Filters); end; viewdata(Sender); end; procedure TMainForm.actDataFirstExecute(Sender: TObject); var Node: PVirtualNode; begin Node := DataGrid.GetFirst; if Assigned(Node) then begin DataGrid.ClearSelection; DataGrid.FocusedNode := Node; DataGrid.Selected[Node] := True; end; end; procedure TMainForm.actDataInsertExecute(Sender: TObject); begin DataGridInsertRow; end; procedure TMainForm.actDataLastExecute(Sender: TObject); var Node: PVirtualNode; begin Node := DataGrid.GetLast; if Assigned(Node) then begin DataGrid.ClearSelection; DataGrid.FocusedNode := Node; DataGrid.Selected[Node] := True; end; end; procedure TMainForm.actDataPostChangesExecute(Sender: TObject); begin DataGridPostUpdateOrInsert(Datagrid.FocusedNode); end; procedure TMainForm.actRemoveFilterExecute(Sender: TObject); begin actClearFilterEditor.Execute; viewdata(Sender); end; procedure TMainForm.actDataCancelChangesExecute(Sender: TObject); begin DataGridCancel(Sender); end; procedure TMainForm.actSelectTreeBackgroundExecute(Sender: TObject); var cs: TColorSelect; begin // Select database tree background color cs := TColorSelect.Create(Self); cs.Dialog.Color := DBtree.Color; if cs.Execute then begin DBtree.Color := cs.Dialog.Color; OpenRegistry(SessionName); MainReg.WriteInteger(REGNAME_TREEBACKGROUND, cs.Dialog.Color); end; end; function TMainForm.CreateOrGetRemoteQueryTab(sender: THandle): THandle; begin // Should create a tab for commands from another window, // or return a handle to an existing tab if one already exists for that window. // // TODO: Implement this when multiple tabs are implemented. // Return a tab's handle instead of the childwin's handle. result := Self.Handle; end; function TMainForm.GetQueryRunning: Boolean; begin Result := ( QueryRunningInterlock = 1 ); end; procedure TMainForm.SetQueryRunning(running: Boolean); var newValue : Integer; oldValue : Integer; begin if ( running ) then begin newValue := 1; end else begin newValue := 0; end; oldValue := InterlockedExchange( QueryRunningInterlock, newValue ); if ( newValue = oldValue ) then begin case ( newValue ) of 1 : begin raise Exception.Create( 'Error: Default connection is ' + 'already executing a query.' ); end; 0 : begin raise Exception.Create( 'Internal badness: Double reset of running ' + 'flag.' ); end; end; end; end; {** Add a SQL-command or comment to SynMemoSQLLog } procedure TMainForm.LogSQL(msg: WideString = ''; comment: Boolean = true); var snip : boolean; begin // Shorten very long messages snip := (prefLogSqlWidth > 0) and (Length(msg) > prefLogSqlWidth); if snip then begin msg := Copy( msg, 0, prefLogSqlWidth ) + '/* large SQL query, snipped at ' + FormatNumber( prefLogSqlWidth ) + ' characters */'; end else if (not snip) and (not comment) then msg := msg + Delimiter else if comment then msg := '/* ' + msg + ' */'; msg := WideStringReplace( msg, #9, ' ', [rfReplaceAll] ); msg := WideStringReplace( msg, #10, ' ', [rfReplaceAll] ); msg := WideStringReplace( msg, #13, ' ', [rfReplaceAll] ); msg := WideStringReplace( msg, ' ', ' ', [rfReplaceAll] ); EnterCriticalSection(SqlMessagesLock); try SqlMessages.Add(msg); finally LeaveCriticalSection(SqlMessagesLock); end; PostMessage(Handle, WM_PROCESSLOG, 0, 0); end; procedure TMainForm.ProcessSqlLog; var msg: WideString; begin EnterCriticalSection(SqlMessagesLock); try if SqlMessages = nil then Exit; if SqlMessages.Count < 1 then Exit; msg := SqlMessages[0]; SqlMessages.Delete(0); finally LeaveCriticalSection(SqlMessagesLock); end; SynMemoSQLLog.Lines.Add( msg ); TrimSQLLog; // Scroll to last line and repaint SynMemoSQLLog.GotoLineAndCenter( SynMemoSQLLog.Lines.Count ); SynMemoSQLLog.Repaint; // Log to file? if prefLogToFile then try WriteLn( FileHandleSessionLog, Format('[%s] %s', [DateTimeToStr(Now), msg]) ); except DeactivateFileLogging; MessageDlg('Error writing to session log file:'+CRLF+FileNameSessionLog+CRLF+CRLF+'Logging is disabled now.', mtError, [mbOK], 0); end; end; {** Delete first line(s) in SQL log and adjust LineNumberStart in gutter Called by LogSQL and preferences dialog } procedure TMainForm.TrimSQLLog; var i : Integer; begin i := 0; while SynMemoSQLLog.Lines.Count > prefLogsqlnum 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; end; procedure TMainForm.ShowHost; begin if (not DBTree.Dragging) and ( (PageControlMain.ActivePage = tabDatabase) or (PageControlMain.ActivePage = tabData) ) then PageControlMain.ActivePage := tabHost; tabDatabase.TabVisible := false; tabEditor.TabVisible := false; tabData.TabVisible := false; PageControlMainChange( Self ); end; procedure TMainForm.ShowDatabase(db: WideString); begin if (not DBtree.Dragging) and ( (PageControlMain.ActivePage = tabHost) or (PageControlMain.ActivePage = tabData) ) then PageControlMain.ActivePage := tabDatabase; tabDatabase.TabVisible := true; tabEditor.TabVisible := false; tabData.TabVisible := false; ShowDBProperties( db ); end; procedure TMainForm.viewdata(Sender: TObject); var i : Integer; select_base, select_base_full, select_from : WideString; sl_query : TWideStringList; KeyCols : WideStrings.TWideStringList; ColName : WideString; col : TVirtualTreeColumn; rx : TRegExpr; ColType : String; ColExists, ShowIt : Boolean; OldOffsetXY : TPoint; procedure InitColumn(name: WideString; ColType: String; Visible: Boolean); var k: Integer; idx: Integer; begin idx := Length(FDataGridResult.Columns); SetLength(FDataGridResult.Columns, idx+1); FDataGridResult.Columns[idx].Name := name; col := DataGrid.Header.Columns.Add; col.Text := name; col.Options := col.Options + [coSmartResize]; if not visible then col.Options := col.Options - [coVisible]; // Sorting color and title image for k:=0 to Length(FDataGridSort)-1 do begin if FDataGridSort[k].ColumnName = name then begin case FDataGridSort[k].SortDirection of ORDER_ASC: begin col.Color := COLOR_SORTCOLUMN_ASC; col.ImageIndex := 109; end; ORDER_DESC: begin col.Color := COLOR_SORTCOLUMN_DESC; col.ImageIndex := 110; end; end; end; end; // Detect data type rx.Expression := '^(tiny|small|medium|big)?int\b'; if rx.Exec(ColType) then begin col.Alignment := taRightJustify; FDataGridResult.Columns[idx].DatatypeCat := dtcInteger; end; rx.Expression := '^(float|double|decimal)\b'; if rx.Exec(ColType) then begin col.Alignment := taRightJustify; FDataGridResult.Columns[idx].DatatypeCat := dtcReal; end; rx.Expression := '^(date|datetime|time(stamp)?)\b'; if rx.Exec(ColType) then begin FDataGridResult.Columns[idx].DatatypeCat := dtcTemporal; if rx.Match[1] = 'date' then FDataGridResult.Columns[idx].Datatype := dtDate else if rx.Match[1] = 'time' then FDataGridResult.Columns[idx].Datatype := dtTime else if rx.Match[1] = 'timestamp' then FDataGridResult.Columns[idx].Datatype := dtTimestamp else FDataGridResult.Columns[idx].Datatype := dtDatetime; end; rx.Expression := '^((tiny|medium|long)?text|(var)?char)\b(\(\d+\))?'; if rx.Exec(ColType) then begin FDataGridResult.Columns[idx].DatatypeCat := dtcText; if rx.Match[4] <> '' then FDataGridResult.Columns[idx].MaxLength := MakeInt(rx.Match[4]) else if ColType = 'tinytext' then // 255 is the width in bytes. If characters that use multiple bytes are // contained, the width in characters is decreased below this number. FDataGridResult.Columns[idx].MaxLength := 255 else if ColType = 'text' then FDataGridResult.Columns[idx].MaxLength := 65535 else if ColType = 'mediumtext' then FDataGridResult.Columns[idx].MaxLength := 16777215 else if ColType = 'longtext' then FDataGridResult.Columns[idx].MaxLength := 4294967295 else // Fallback for unknown column types FDataGridResult.Columns[idx].MaxLength := MaxInt; end; rx.Expression := '^((tiny|medium|long)?blob|(var)?binary|bit)\b'; if rx.Exec(ColType) then FDataGridResult.Columns[idx].DatatypeCat := dtcBinary; if Copy(ColType, 1, 5) = 'enum(' then begin FDataGridResult.Columns[idx].DatatypeCat := dtcIntegerNamed; FDataGridResult.Columns[idx].ValueList := WideStrings.TWideStringList.Create; FDataGridResult.Columns[idx].ValueList.QuoteChar := ''''; FDataGridResult.Columns[idx].ValueList.Delimiter := ','; FDataGridResult.Columns[idx].ValueList.DelimitedText := GetEnumValues(ColType); end; if Copy(ColType, 1, 4) = 'set(' then begin FDataGridResult.Columns[idx].DatatypeCat := dtcSetNamed; FDataGridResult.Columns[idx].ValueList := WideStrings.TWideStringList.Create; FDataGridResult.Columns[idx].ValueList.QuoteChar := ''''; FDataGridResult.Columns[idx].ValueList.Delimiter := ','; FDataGridResult.Columns[idx].ValueList.DelimitedText := GetEnumValues(ColType); end; SelectedTableKeys.First; for k := 0 to SelectedTableKeys.RecordCount - 1 do begin if (SelectedTableKeys.FieldByName('Key_name').AsString = 'PRIMARY') and (SelectedTableKeys.FieldByName('Column_name').AsWideString = name) then begin FDataGridResult.Columns[idx].IsPriPart := True; break; end; SelectedTableKeys.Next; end; end; begin Screen.Cursor := crHourglass; viewingdata := true; sl_query := TWideStringList.Create(); // Ensure grid has left editing mode so DataGrid.OnNewText applies its changes // to the old data, not to the new or some non referenced data if DataGrid.IsEditing then DataGrid.EndEditNode; // Post pending update and set post + cancel buttons to valid state if DataGridHasChanges then actDataPostChangesExecute(Sender); // Switch to PageControlMain.ActivePage := tabData; try if (SelectedTable.Text <> '') and (ActiveDatabase <> '') then begin if FDataGridSelect = nil then FDataGridSelect := WideStrings.TWideStringlist.Create; if DataGridTable <> SelectedTable.Text then begin FDataGridSelect.Clear; ResetSelectedTableStuff; SynMemoFilter.Clear; SetLength(FDataGridSort, 0); // Load default view settings OpenRegistry; if MainReg.OpenKey(GetRegKeyTable, False) then begin if MainReg.ValueExists(REGNAME_DEFAULTVIEW) then begin // Disable default if crash indicator on current table is found if MainReg.ValueExists(REGPREFIX_CRASH_IN_DATA) then begin MainReg.DeleteValue(REGNAME_DEFAULTVIEW); LogSQL('A crash in the previous data loading for this table ('+SelectedTable.Text+') was detected. Filtering was automatically reset to avoid the same crash for now.'); // Reset crash indicator. MainReg.DeleteValue(REGPREFIX_CRASH_IN_DATA); end else begin LoadDataView(MainReg.ReadString(REGNAME_DEFAULTVIEW)); end; end; end; end; FillDataViewPopup; SynMemoFilter.Color := clWindow; rx := TRegExpr.Create; ShowStatus('Freeing data...'); DataGrid.BeginUpdate; OldOffsetXY := DataGrid.OffsetXY; debug('mem: clearing browse data.'); SetLength(FDataGridResult.Columns, 0); SetLength(FDataGridResult.Rows, 0); DataGrid.RootNodeCount := 0; DataGrid.Header.Columns.BeginUpdate; DataGrid.Header.Options := DataGrid.Header.Options + [hoVisible]; DataGrid.Header.Columns.Clear; // No data for routines if SelectedTableColumns = nil then begin DataGrid.Enabled := False; pnlDataTop.Enabled := False; pnlFilter.Enabled := False; lblSorryNoData.Parent := DataGrid; Exit; // Jump to *finally* end else begin DataGrid.Enabled := True; pnlDataTop.Enabled := True; pnlFilter.Enabled := True; lblSorryNoData.Parent := tabData; end; // Prepare SELECT statement select_base := 'SELECT '; select_base_full := select_base; // Selected columns if (FDataGridSelect.Count = 0) or (FDataGridSelect.Count = SelectedTableColumns.RecordCount) then begin tbtnDataColumns.ImageIndex := 107; end else begin for i := FDataGridSelect.Count - 1 downto 0 do begin ColExists := False; SelectedTableColumns.First; while not SelectedTableColumns.Eof do begin if FDataGridSelect[i] = SelectedTableColumns.FieldByName('Field').AsWideString then begin ColExists := True; break; end; SelectedTableColumns.Next; end; if not ColExists then FDataGridSelect.Delete(i); end; // Signal for the user that we now hide some columns tbtnDataColumns.ImageIndex := 108; end; // Ensure key columns are included to enable editing KeyCols := GetKeyColumns; // Truncate column array. SetLength(FDataGridResult.Columns, 0); debug('mem: initializing browse columns.'); SelectedTableColumns.First; while not SelectedTableColumns.Eof do begin ColName := SelectedTableColumns.FieldByName('Field').AsWideString; ShowIt := (FDataGridSelect.Count=0) or (FDataGridSelect.IndexOf(ColName)>-1); if ShowIt or (KeyCols.IndexOf(ColName)>-1) then begin ColType := SelectedTableColumns.FieldByName('Type').AsString; rx.Expression := '^((tiny|medium|long)?(text|blob)|(var)?(char|binary))\b(\(\d+\))?'; if rx.Exec(ColType) then begin select_base := select_base + ' ' + 'LEFT(' + Mask(ColName) + ', ' + IntToStr(GridMaxData) + ')' + ','; end else begin select_base := select_base + ' ' + Mask(ColName) + ','; end; select_base_full := select_base_full + ' ' + Mask(ColName) + ','; InitColumn(ColName, SelectedTableColumns.FieldByName('Type').AsString, ShowIt); end; SelectedTableColumns.Next; end; debug('mem: browse column initialization complete.'); // Cut last comma select_base := copy( select_base, 1, Length(select_base)-1 ); select_base_full := copy( select_base_full, 1, Length(select_base_full)-1 ); // Include db name for cases in which dbtree is switching databases and pending updates are in process select_from := ' FROM '+mask(ActiveDatabase)+'.'+mask(SelectedTable.Text); // Final SELECT segments DataGridCurrentSelect := select_base; DataGridCurrentFullSelect := select_base_full; DataGridCurrentFrom := select_from; DataGridCurrentFilter := SynMemoFilter.Text; if Length(FDataGridSort) > 0 then DataGridCurrentSort := ComposeOrderClause(FDataGridSort) else DataGridCurrentSort := ''; // Set button icons if DataGridCurrentFilter <> '' then tbtnDataFilter.ImageIndex := 108 else tbtnDataFilter.ImageIndex := 107; if DataGridCurrentSort <> '' then tbtnDataSorting.ImageIndex := 108 else tbtnDataSorting.ImageIndex := 107; debug('mem: initializing browse rows (internal data).'); try ReachedEOT := False; SetLength(FDataGridResult.Rows, SIMULATE_INITIAL_ROWS * (100 + SIMULATE_MORE_ROWS) div 100); for i := 0 to SIMULATE_INITIAL_ROWS * (100 + SIMULATE_MORE_ROWS) div 100 - 1 do begin FDataGridResult.Rows[i].Loaded := False; end; debug('mem: initializing browse rows (grid).'); DataGrid.RootNodeCount := SIMULATE_INITIAL_ROWS * (100 + SIMULATE_MORE_ROWS) div 100; except DataGrid.RootNodeCount := 0; SetLength(FDataGridResult.Rows, 0); PageControlMain.ActivePage := tabDatabase; raise; end; debug('mem: browse row initialization complete.'); // Switched to another table if DataGridTable <> SelectedTable.Text then begin DataGrid.OffsetXY := Point(0, 0); // Scroll to top left FreeAndNil(PrevTableColWidths); // Throw away remembered, manually resized column widths end; dataselected := true; PageControlMainChange(Self); end; finally DataGrid.Header.Columns.EndUpdate; DataGrid.EndUpdate; FreeAndNil(sl_query); if DataGridTable = SelectedTable.Text then DataGrid.OffsetXY := OldOffsetXY; viewingdata := false; EnumerateRecentFilters; Screen.Cursor := crDefault; end; DataGridDB := ActiveDatabase; DataGridTable := SelectedTable.Text; AutoCalcColWidths(DataGrid, PrevTableColWidths); end; {*** Calculate + display total rowcount and found rows matching to filter in data-tab } procedure TMainForm.DisplayRowCountStats(MatchingRows: Int64); var rows_total : Int64; // total rowcount IsFiltered, IsInnodb: Boolean; ds: TDataSet; i: Integer; s: WideString; begin lblDataTop.Caption := ActiveDatabase + '.' + SelectedTable.Text; IsFiltered := self.DataGridCurrentFilter <> ''; if GetFocusedTreeNodeType = lntTable then begin // Get rowcount from table ds := FetchActiveDbTableList; rows_total := -1; IsInnodb := False; for i := 0 to ds.RecordCount - 1 do begin if ds.FieldByName(DBO_NAME).AsWideString = SelectedTable.Text then begin s := ds.FieldByName(DBO_ROWS).AsString; if s <> '' then rows_total := MakeInt(s); IsInnodb := ds.Fields[1].AsString = 'InnoDB'; break; end; end; if rows_total > -1 then begin lblDataTop.Caption := lblDataTop.Caption + ': ' + FormatNumber(rows_total) + ' rows total'; if IsInnodb then lblDataTop.Caption := lblDataTop.Caption + ' (approximately)'; if MatchingRows = prefMaxTotalRows then begin lblDataTop.Caption := lblDataTop.Caption + ', limited to ' + FormatNumber(prefMaxTotalRows); end else if IsFiltered then begin if MatchingRows = rows_total then begin lblDataTop.Caption := lblDataTop.Caption + ', filter matches all rows'; end else if IsFiltered and (MatchingRows > -1) then begin lblDataTop.Caption := lblDataTop.Caption + ', ' + FormatNumber(MatchingRows) + ' matches filter'; end; end; end; end; end; procedure TMainForm.WaitForQueryCompletion(WaitForm: TfrmQueryProgress; query: TMySqlQuery; ForceDialog: Boolean); var signal: Cardinal; begin debug( 'Waiting for query to complete.' ); cancelling := false; if ForceDialog then begin debug( 'Showing progress form.' ); WaitForm.ShowModal(); end else begin signal := WaitForSingleObject(query.EventHandle, QueryWaitTime); if signal = 0 then debug( 'Query completed within ' + IntToStr(QueryWaitTime) + 'msec.' ) else begin debug( IntToStr(QueryWaitTime) + 'msec passed, showing progress form.' ); // Hack: Prevent dynamic loading of records in the context of the wait form's message loop. DataGrid.Visible := False; WaitForm.ShowModal(); end; end; CloseHandle(query.EventHandle); debug( 'Query complete.' ); end; {*** Occurs when active tab has changed. } procedure TMainForm.PageControlMainChange(Sender: TObject); var tab: TTabSheet; begin tab := PageControlMain.ActivePage; // 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.SetFocus else if tab = tabData then begin viewdata(Sender); if DataGrid.CanFocus then DataGrid.SetFocus; end else if tab = tabQuery then SynMemoQuery.SetFocus; end; // Ensure controls are in a valid state ValidateControls(Sender); end; procedure TMainForm.PageControlHostChange(Sender: TObject); var tab: TTabSheet; list: TBaseVirtualTree; begin tab := PageControlHost.ActivePage; 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.SetFocus; editFilterVTChange(Sender); end; {*** Ensures that we're connected to the currently selected database. } procedure TMainForm.EnsureDatabase; var db: WideString; begin // Some functions temporarily switch away from the database selected by the user, handle that. if TemporaryDatabase <> '' then db := TemporaryDatabase else db := ActiveDatabase; // Blank = database undefined if db = '' then Exit; if (FMysqlConn.Connection.Database <> db) or (UserQueryFired and not UserQueryFiring) then begin ExecUseQuery(db, false, false); UserQueryFired := false; FMysqlConn.Connection.Database := db; end; end; {*** Look for list of tables for current database in cache. Retrieve from server if necessary. @return TDataSet The cached list of tables for the active database. } function TMainForm.FetchActiveDbTableList: TDataSet; begin Result := FetchDbTableList(ActiveDatabase); end; function TMainForm.FetchDbTableList(db: WideString): TDataSet; var ds: TDataSet; OldCursor: TCursor; Unions: TWideStringlist; ListObjectsSQL: WideString; begin if not DbTableListCachedAndValid(db) then begin // Not in cache, load table list. OldCursor := Screen.Cursor; Screen.Cursor := crHourGlass; ShowStatus('Fetching tables from "' + db + '" ...'); try if not Assigned(InformationSchemaTables) then InformationSchemaTables := GetCol('SHOW TABLES FROM '+mask(DBNAME_INFORMATION_SCHEMA), 0, True, False); if InformationSchemaTables.IndexOf('TABLES') > -1 then begin Unions := TWideStringlist.Create; // Tables and (system) views Unions.Add('SELECT TABLE_NAME AS '+mask(DBO_NAME)+ ', TABLE_TYPE AS '+mask(DBO_TYPE)+ ', ENGINE AS '+mask(DBO_ENGINE)+ ', VERSION AS '+mask(DBO_VERSION)+ ', ROW_FORMAT AS '+mask(DBO_ROWFORMAT)+ ', TABLE_ROWS AS '+mask(DBO_ROWS)+ ', AVG_ROW_LENGTH AS '+mask(DBO_AVGROWLEN)+ ', DATA_LENGTH AS '+mask(DBO_DATALEN)+ ', MAX_DATA_LENGTH AS '+mask(DBO_MAXDATALEN)+ ', INDEX_LENGTH AS '+mask(DBO_INDEXLEN)+ ', DATA_FREE AS '+mask(DBO_DATAFREE)+ ', AUTO_INCREMENT AS '+mask(DBO_AUTOINC)+ ', CREATE_TIME AS '+mask(DBO_CREATED)+ ', UPDATE_TIME AS '+mask(DBO_UPDATED)+ ', CHECK_TIME AS '+mask(DBO_CHECKED)+ ', TABLE_COLLATION AS '+mask(DBO_COLLATION)+ ', CHECKSUM AS '+mask(DBO_CHECKSUM)+ ', CREATE_OPTIONS AS '+mask(DBO_CROPTIONS)+ ', TABLE_COMMENT AS '+mask(DBO_COMMENT)+ ' FROM '+mask(DBNAME_INFORMATION_SCHEMA)+'.TABLES ' + 'WHERE TABLE_SCHEMA = '+esc(db)); // Stored routines if InformationSchemaTables.IndexOf('ROUTINES') > -1 then begin Unions.Add('SELECT ROUTINE_NAME AS '+mask(DBO_NAME)+ ', ROUTINE_TYPE AS '+mask(DBO_TYPE)+ ', NULL AS '+mask(DBO_ENGINE)+ ', NULL AS '+mask(DBO_VERSION)+ ', NULL AS '+mask(DBO_ROWFORMAT)+ ', NULL AS '+mask(DBO_ROWS)+ ', NULL AS '+mask(DBO_AVGROWLEN)+ ', NULL AS '+mask(DBO_DATALEN)+ ', NULL AS '+mask(DBO_MAXDATALEN)+ ', NULL AS '+mask(DBO_INDEXLEN)+ ', NULL AS '+mask(DBO_DATAFREE)+ ', NULL AS '+mask(DBO_AUTOINC)+ ', CREATED AS '+mask(DBO_CREATED)+ ', LAST_ALTERED AS '+mask(DBO_UPDATED)+ ', NULL AS '+mask(DBO_CHECKED)+ ', NULL AS '+mask(DBO_COLLATION)+ ', NULL AS '+mask(DBO_CHECKSUM)+ ', NULL AS '+mask(DBO_CROPTIONS)+ ', ROUTINE_COMMENT AS '+mask(DBO_COMMENT)+ ' FROM '+mask(DBNAME_INFORMATION_SCHEMA)+'.ROUTINES ' + 'WHERE ROUTINE_SCHEMA = '+esc(db)); end; if Unions.Count = 1 then ListObjectsSQL := Unions[0] else ListObjectsSQL := '(' + implodestr(') UNION (', Unions) + ')'; ListObjectsSQL := ListObjectsSQL + ' ORDER BY `Name`'; FreeAndNil(Unions); end else begin // For servers lacking the INFORMATION_SCHEMA or the TABLES table ListObjectsSQL := 'SHOW TABLE STATUS FROM ' + mask(db); end; ds := GetResults(ListObjectsSQL); CachedTableLists.AddObject(db, ds); // Add table names to SQL highlighter SynSQLSyn1.TableNames.BeginUpdate; while not ds.Eof do begin SynSQLSyn1.TableNames.Add(ds.FieldByName(DBO_NAME).AsWideString); ds.Next; end; SynSQLSyn1.TableNames.EndUpdate; finally ShowStatus(STATUS_MSG_READY); Screen.Cursor := OldCursor; end; end; Result := TDataSet(CachedTableLists.Objects[CachedTableLists.IndexOf(db)]); Result.First; end; {*** Nukes cached table list for active database, then refreshes it. @return TDataSet The newly cached list of tables for the active database. } function TMainForm.RefreshActiveDbTableList: TDataSet; begin Result := RefreshDbTableList(ActiveDatabase); end; function TMainForm.RefreshDbTableList(db: WideString): TDataSet; begin ClearDbTableList(db); Result := FetchDbTableList(db); end; procedure TMainForm.ClearDbTableList(db: WideString); var idx: Integer; o: TObject; begin idx := CachedTableLists.IndexOf(db); if idx > -1 then begin o := CachedTableLists.Objects[idx]; FreeAndNil(o); CachedTableLists.Delete(idx); end; end; {*** Nukes the table list cache. } procedure TMainForm.ClearAllTableLists; var idx: Integer; ds: TDataSet; begin for idx := 0 to CachedTableLists.Count - 1 do begin ds := TDataSet(CachedTableLists.Objects[idx]); ds.Close; FreeAndNil(ds); end; CachedTableLists.Clear; end; // Fetch content from a row cell, avoiding NULLs to cause AVs function TMainForm.FieldContent(ds: TDataSet; ColName: WideString): WideString; begin Result := ''; if (ds.FindField(colName) <> nil) and (not ds.FindField(ColName).IsNull) then Result := ds.FieldByName(ColName).AsWideString; end; procedure TMainForm.LoadDatabaseProperties(db: WideString); var i, img : Integer; bytes : Int64; ds : TDataSet; Cap, SelectedCaptions: WideStrings.TWideStringList; begin // DB-Properties Screen.Cursor := crHourGlass; // Remember selected nodes SelectedCaptions := GetVTCaptions(ListTables, True); ds := FetchDbTableList(db); ShowStatus( 'Displaying tables from "' + db + '" ...' ); ListTables.BeginUpdate; ListTables.Clear; SetLength(VTRowDataListTables, ds.RecordCount); for i := 1 to ds.RecordCount do begin VTRowDataListTables[i-1].Captions := WideStrings.TWideStringList.Create; Cap := VTRowDataListTables[i-1].Captions; // Object name Cap.Add( FieldContent(ds, DBO_NAME) ); if (FieldContent(ds, DBO_ROWS) <> '') then Cap.Add( FormatNumber( FieldContent(ds, DBO_ROWS) ) ) else Cap.Add(''); // Size: Data_length + Index_length bytes := GetTableSize(ds); if bytes >= 0 then Cap.Add(FormatByteNumber(bytes)) else Cap.Add(''); Cap.Add( FieldContent(ds, DBO_CREATED) ); Cap.Add( FieldContent(ds, DBO_UPDATED) ); Cap.Add( FieldContent(ds, DBO_ENGINE) ); Cap.Add( FieldContent(ds, DBO_COMMENT) ); Cap.Add( FieldContent(ds, DBO_VERSION) ); Cap.Add( FieldContent(ds, DBO_ROWFORMAT) ); if (FieldContent(ds, DBO_AVGROWLEN) <> '') then Cap.Add( FormatByteNumber(FieldContent(ds, DBO_AVGROWLEN)) ) else Cap.Add(''); if (FieldContent(ds, DBO_MAXDATALEN) <> '') then Cap.Add( FormatByteNumber(FieldContent(ds, DBO_MAXDATALEN)) ) else Cap.Add(''); if (FieldContent(ds, DBO_INDEXLEN) <> '') then Cap.Add( FormatByteNumber(FieldContent(ds, DBO_INDEXLEN)) ) else Cap.Add(''); if (FieldContent(ds, DBO_DATAFREE) <> '') then Cap.Add( FormatByteNumber(FieldContent(ds, DBO_DATAFREE)) ) else Cap.Add(''); if (FieldContent(ds, DBO_AUTOINC) <> '') then Cap.Add( FormatNumber(FieldContent(ds, DBO_AUTOINC)) ) else Cap.Add(''); Cap.Add( FieldContent(ds, DBO_AUTOINC) ); Cap.Add( FieldContent(ds, DBO_COLLATION) ); Cap.Add( FieldContent(ds, DBO_CHECKSUM) ); Cap.Add( FieldContent(ds, DBO_CROPTIONS) ); if ds.FindField(DBO_TYPE) <> nil then Cap.Add(FieldContent(ds, DBO_TYPE)) else Cap.Add('BASE TABLE'); VTRowDataListTables[i-1].NodeType := GetDBObjectType( ds.Fields); // Find icon case VTRowDataListTables[i-1].NodeType of lntTable: img := ICONINDEX_TABLE; lntCrashedTable: img := ICONINDEX_CRASHED_TABLE; lntView: img := ICONINDEX_VIEW; lntProcedure: img := ICONINDEX_STOREDPROCEDURE; lntFunction: img := ICONINDEX_STOREDFUNCTION; else img := -1; end; VTRowDataListTables[i-1].ImageIndex := img; ds.Next; end; ListTables.RootNodeCount := Length(VTRowDataListTables); ListTables.EndUpdate; SetVTSelection(ListTables, SelectedCaptions); showstatus(db + ': ' + IntToStr(ListTables.RootNodeCount) +' table(s)', 0); tabDatabase.Caption := sstr('Database: ' + db, 30); ShowStatus(STATUS_MSG_READY); Screen.Cursor := crDefault; // Ensure tree db node displays its chidren initialized DBtree.ReinitChildren(FindDBNode(db), False); ValidateControls(Self); end; { Show tables and their properties on the tabsheet "Database" } procedure TMainForm.ShowDBProperties(db: WideString); begin Screen.Cursor := crHourglass; PageControlMainChange(Self); ShowStatus( STATUS_MSG_READY ); Screen.Cursor := crDefault; end; {*** Execute a query and return a resultset The currently active connection is used @param String The single SQL-query to be executed on the server } function TMainForm.ExecuteQuery(query: String): TDataSet; begin result := GetResults(query, false, false); end; {*** Execute a query without returning a resultset The currently active connection is used @param String The single SQL-query to be executed on the server } procedure TMainForm.ExecuteNonQuery(SQLQuery: String); begin ExecUpdateQuery(SQLQuery); end; {*** Selection in ListTables is changing } procedure TMainForm.ListTablesChange(Sender: TBaseVirtualTree; Node: PVirtualNode); begin ValidateControls(Sender); end; {*** Enable/disable various buttons and menu items. Invoked when - active sheet changes - highlighted database changes ... } procedure TMainForm.ValidateControls(Sender: TObject); var inDataGrid, inQueryTab, inDataOrQueryTab, inDataOrQueryTabNotEmpty: Boolean; SelectedNodes: TNodeArray; begin inDataGrid := ActiveControl = DataGrid; inDataOrQueryTab := (PageControlMain.ActivePage = tabData) or (PageControlMain.ActivePage = tabQuery); inDataOrQueryTabNotEmpty := inDataOrQueryTab and (ActiveGrid.RootNodeCount > 0); inQueryTab := PageControlMain.ActivePage = tabQuery; SelectedNodes := ListTables.GetSortedSelection(False); actSQLhelp.Enabled := mysql_version >= 40100; actImportCSV.Enabled := mysql_version >= 32206; // Data tab - if query results are made editable, these will need // to be changed to look at which tab is focused. actDataInsert.Enabled := inDataGrid; actDataDelete.Enabled := inDataGrid and (DataGrid.SelectedCount > 0); actDataFirst.Enabled := inDataGrid; actDataLast.Enabled := inDataGrid; actDataPostChanges.Enabled := inDataGrid and DataGridHasChanges; actDataCancelChanges.Enabled := inDataGrid and DataGridHasChanges; // Activate export-options if we're on Data- or Query-tab actCopyAsCSV.Enabled := inDataOrQueryTabNotEmpty; actCopyAsHTML.Enabled := inDataOrQueryTabNotEmpty; actCopyAsXML.Enabled := inDataOrQueryTabNotEmpty; actCopyAsSQL.Enabled := inDataOrQueryTabNotEmpty; actExportData.Enabled := inDataOrQueryTabNotEmpty; actHTMLView.Enabled := inDataOrQueryTabNotEmpty and Assigned(ActiveGrid.FocusedNode); setNull1.Enabled := inDataGrid and Assigned(DataGrid.FocusedNode); // Query tab // Manually invoke OnChange event of tabset to fill helper list with data if inQueryTab then RefreshQueryHelpers; ValidateQueryControls(Sender); if not inQueryTab then // Empty panel with "Line:Char" showstatus('', 1); end; procedure TMainForm.RefreshQueryHelpers; var dummy: Boolean; begin dummy := True; tabsetQueryHelpers.OnChange(Self, tabsetQueryHelpers.TabIndex, dummy); end; procedure TMainForm.ValidateQueryControls(Sender: TObject); var InQueryTab, NotEmpty, HasSelection: Boolean; begin InQueryTab := PageControlMain.ActivePage = tabQuery; NotEmpty := SynMemoQuery.GetTextLen > 0; HasSelection := SynMemoQuery.SelAvail; actExecuteQuery.Enabled := InQueryTab and NotEmpty; actExecuteSelection.Enabled := InQueryTab and HasSelection; actExecuteLine.Enabled := InQueryTab and (SynMemoQuery.LineText <> ''); actSaveSQL.Enabled := InQueryTab and NotEmpty; actSaveSQLselection.Enabled := InQueryTab and HasSelection; actSaveSQLSnippet.Enabled := InQueryTab and NotEmpty; actSaveSQLSelectionSnippet.Enabled := InQueryTab and HasSelection; actQueryFind.Enabled := InQueryTab and NotEmpty; actQueryReplace.Enabled := InQueryTab and NotEmpty; actQueryStopOnErrors.Enabled := InQueryTab; actQueryWordWrap.Enabled := InQueryTab; actClearQueryEditor.Enabled := InQueryTab and NotEmpty; actSetDelimiter.Enabled := InQueryTab; end; procedure TMainForm.CheckUptime; begin ServerUptime := MakeInt(GetVar('SHOW STATUS LIKE ''Uptime''', 1)); // Avoid division by zero ServerUptime := Max(ServerUptime, 1); TimerHostUptime.Enabled := true; end; procedure TMainForm.KillProcess(Sender: TObject); var t : Boolean; ProcessIDs : WideStrings.TWideStringList; i : Integer; begin t := TimerRefresh.Enabled; TimerRefresh.Enabled := false; // prevent av (ListProcesses.selected...) ProcessIDs := GetVTCaptions( ListProcesses, True ); if MessageDlg('Kill '+inttostr(ProcessIDs.count)+' Process(es)?', mtConfirmation, [mbok,mbcancel], 0) = mrok then begin for i := 0 to ProcessIDs.Count - 1 do begin // Don't kill own process if ProcessIDs[i] = IntToStr( MySQLConn.Connection.GetThreadId ) then LogSQL('Ignoring own process id '+ProcessIDs[i]+' when trying to kill it.') else ExecUpdateQuery( 'KILL '+ProcessIDs[i] ); end; ListProcesses.Tag := VTREE_NOTLOADED; ListProcesses.Repaint; end; TimerRefresh.Enabled := t; // re-enable autorefresh timer end; procedure TMainForm.ExecSQLClick(Sender: TObject; Selection: Boolean=false; CurrentLine: Boolean=false); var SQL : WideStrings.TWideStringList; i, j : Integer; rowsaffected : Integer; SQLstart : Integer; SQLend : Integer; SQLscriptstart : Integer; SQLscriptend : Integer; SQLTime : Double; LastVistaCheck : Cardinal; VistaCheck : Boolean; fieldcount : Integer; recordcount : Integer; ds : TDataSet; ColName, Text, LB : WideString; col : TVirtualTreeColumn; begin if CurrentLine then Text := SynMemoQuery.LineText else if Selection then Text := SynMemoQuery.SelText else Text := SynMemoQuery.Text; // Give text back its original linebreaks if possible case QueryMemoLineBreaks of lbsUnix: LB := LB_UNIX; lbsMac: LB := LB_MAC; lbsWide: LB := LB_WIDE; end; if LB <> '' then Text := WideStringReplace(Text, CRLF, LB, [rfReplaceAll]); SQL := parseSQL(Text); if ( SQL.Count = 0 ) then begin LabelResultinfo.Caption := '(nothing to do)'; Exit; end; SQLscriptstart := GetTickCount(); LastVistaCheck := GetTickCount(); LabelResultinfo.Caption := ''; ds := nil; try showstatus( 'Initializing SQL...' ); actExecuteQuery.Enabled := false; actExecuteSelection.Enabled := false; // Let EnsureActiveDatabase know that we've fired user queries. UserQueryFiring := true; rowsaffected := 0; fieldcount := 0; recordcount := 0; EnableProgressBar(SQL.Count); showstatus( 'Executing SQL...' ); for i := 0 to (SQL.Count - 1) do begin ProgressBarStatus.StepIt; ProgressBarStatus.Repaint; if ( sql[i] = '' ) then begin continue; end; // open last query with data-aware: LabelResultinfo.Caption := ''; // ok, let's rock SQLstart := GetTickCount(); try VistaCheck := false; if GetTickCount() - LastVistaCheck > 2500 then begin VistaCheck := true; LastVistaCheck := GetTickCount(); end; ds := GetResults( SQL[i], false, false, VistaCheck ); if ( ds <> nil ) then begin fieldcount := ds.Fieldcount; recordcount := ds.Recordcount; rowsaffected := rowsaffected + TZQuery(ds).RowsAffected; end else begin fieldcount := 0; recordcount := 0; rowsaffected := FMysqlConn.Connection.GetAffectedRowsFromLastPost; end; except on E:Exception do begin if actQueryStopOnErrors.Checked or (i = SQL.Count - 1) then begin Screen.Cursor := crDefault; MessageDlg( E.Message, mtError, [mbOK], 0 ); ProgressBarStatus.Hide; actExecuteQuery.Enabled := true; actExecuteSelection.Enabled := true; Break; end; end; end; SQLend := GetTickCount(); SQLTime := (SQLend - SQLstart) / 1000; LabelResultinfo.Caption := FormatNumber( rowsaffected ) +' row(s) affected, '+ FormatNumber( fieldcount ) +' column(s) x '+ FormatNumber( recordcount ) +' row(s) in last result set.'; if ( SQL.Count = 1 ) then begin LabelResultinfo.Caption := LabelResultinfo.Caption + ' Query time: '+ FormatNumber( SQLTime, 3) +' sec.'; end; end; ProgressBarStatus.Hide; ValidateQueryControls(Sender); if ( SQL.Count > 1 ) then begin SQLscriptend := GetTickCount(); SQLTime := (SQLscriptend - SQLscriptstart) / 1000; LabelResultinfo.Caption := LabelResultinfo.Caption +' Batch time: '+ FormatNumber( SQLTime, 3 ) +' sec.'; end; finally // Let EnsureActiveDatabase know that we've fired user queries. UserQueryFired := true; UserQueryFiring := false; // Avoid excessive GridHighlightChanged() when flicking controls. viewingdata := true; if ds <> nil then begin QueryGrid.BeginUpdate; QueryGrid.Header.Options := QueryGrid.Header.Options + [hoVisible]; QueryGrid.Header.Columns.BeginUpdate; QueryGrid.Header.Columns.Clear; debug('mem: clearing and initializing query columns.'); SetLength(FQueryGridResult.Columns, 0); SetLength(FQueryGridResult.Columns, ds.FieldCount); for i:=0 to ds.FieldCount-1 do begin ColName := ds.Fields[i].FieldName; col := QueryGrid.Header.Columns.Add; col.Text := ColName; col.Options := col.Options - [coAllowClick]; FQueryGridResult.Columns[i].Name := ColName; if ds.Fields[i].DataType in [ftSmallint, ftInteger, ftWord, ftLargeint] then begin FQueryGridResult.Columns[i].DatatypeCat := dtcInteger; col.Alignment := taRightJustify; end else if ds.Fields[i].DataType in [ftFloat] then begin FQueryGridResult.Columns[i].DatatypeCat := dtcReal; col.Alignment := taRightJustify; end else if ds.Fields[i].DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then FQueryGridResult.Columns[i].DatatypeCat := dtcTemporal else if ds.Fields[i].DataType in [ftWideString, ftMemo, ftWideMemo] then FQueryGridResult.Columns[i].DatatypeCat := dtcText else if ds.Fields[i].DataType in [ftBlob] then FQueryGridResult.Columns[i].DatatypeCat := dtcBinary; end; debug('mem: query column initialization complete.'); debug('mem: clearing and initializing query rows (internal data).'); SetLength(FQueryGridResult.Rows, 0); SetLength(FQueryGridResult.Rows, ds.RecordCount); ds.First; for i:=0 to ds.RecordCount-1 do begin FQueryGridResult.Rows[i].Loaded := True; SetLength(FQueryGridResult.Rows[i].Cells, ds.FieldCount); for j:=0 to ds.FieldCount-1 do begin if FQueryGridResult.Columns[j].DatatypeCat = dtcBinary then FQueryGridResult.Rows[i].Cells[j].Text := '0x' + BinToWideHex(ds.Fields[j].AsString) else FQueryGridResult.Rows[i].Cells[j].Text := ds.Fields[j].AsWideString; FQueryGridResult.Rows[i].Cells[j].IsNull := ds.Fields[j].IsNull; end; ds.Next; end; ds.Free; debug('mem: initializing query rows (grid).'); QueryGrid.RootNodeCount := Length(FQueryGridResult.Rows); debug('mem: query row initialization complete.'); QueryGrid.Header.Columns.EndUpdate; QueryGrid.ClearSelection; QueryGrid.OffsetXY := Point(0, 0); QueryGrid.EndUpdate; AutoCalcColWidths(QueryGrid); end; // Ensure controls are in a valid state ValidateControls(Sender); viewingdata := false; Screen.Cursor := crDefault; ShowStatus( STATUS_MSG_READY ); end; end; { Proposal about to insert a String into synmemo } procedure TMainForm.SynCompletionProposal1CodeCompletion(Sender: TObject; var Value: WideString; Shift: TShiftState; Index: Integer; EndToken: WideChar); begin SynCompletionProposal1.Editor.UndoList.AddGroupBreak; end; procedure TMainForm.SynCompletionProposal1AfterCodeCompletion(Sender: TObject; const Value: WideString; Shift: TShiftState; Index: Integer; EndToken: WideChar); begin SynCompletionProposal1.Editor.UndoList.AddGroupBreak; end; { Proposal-Combobox pops up } procedure TMainForm.SynCompletionProposal1Execute(Kind: SynCompletionType; Sender: TObject; var CurrentInput: WideString; var x, y: Integer; var CanExecute: Boolean); var i,j : Integer; ds : TDataset; sql, TableClauses: WideString; Tables : TStringList; tablename : WideString; rx : TRegExpr; PrevShortToken, PrevLongToken, Token : WideString; Start, TokenTypeInt : Integer; Attri : TSynHighlighterAttributes; Editor : TCustomSynEdit; const ItemPattern: WideString = '\image{%d}\hspace{5}\color{clSilver}%s\column{}\color{clWindowText}%s'; procedure addTable( Fields: TFields ); var ObjName, ObjType: WideString; Icon: Integer; begin ObjName := Fields[0].AsWideString; ObjType := ''; if Fields.FindField(DBO_TYPE) <> nil then ObjType := LowerCase(Fields.FieldByName(DBO_TYPE).AsString); case GetDBObjectType(Fields) of lntTable: Icon := ICONINDEX_TABLE; lntCrashedTable: Icon := ICONINDEX_CRASHED_TABLE; lntFunction: Icon := ICONINDEX_STOREDFUNCTION; lntProcedure: Icon := ICONINDEX_STOREDPROCEDURE; lntView: Icon := ICONINDEX_VIEW; else Icon := -1; end; SynCompletionProposal1.InsertList.Add( ObjName ); SynCompletionProposal1.ItemList.Add( WideFormat(ItemPattern, [Icon, ObjType, ObjName]) ); end; procedure addColumns( tablename: WideString ); var dbname : WideString; i : Integer; ds : TDataSet; begin dbname := ActiveDatabase; if Pos( '.', tablename ) > -1 then begin dbname := Copy( tablename, 0, Pos( '.', tablename )-1 ); tablename := Copy( tablename, Pos( '.', tablename )+1, Length(tablename) ); end; // Do not mask db and table name to avoid double masking. // Rely on what the user typed is already a valid masked/quoted identifier. if dbname <> '' then tablename := dbname + '.' + tablename; ds := getResults( 'SHOW COLUMNS FROM '+tablename, true, false ); if ds = nil then exit; for i:=0 to ds.RecordCount-1 do begin SynCompletionProposal1.InsertList.Add( ds.FieldByName( 'Field' ).AsWideString ); SynCompletionProposal1.ItemList.Add( WideFormat(ItemPattern, [ICONINDEX_FIELD, GetFirstWord(ds.FieldByName('Type').AsString), ds.FieldByName('Field').AsWideString]) ); ds.Next; end; ds.Close; FreeAndNil(ds); end; begin Editor := (Sender as TSynCompletionProposal).Editor; Editor.GetHighlighterAttriAtRowColEx(Editor.CaretXY, Token, TokenTypeInt, Start, Attri); if TtkTokenKind(TokenTypeInt) = tkString then begin CanExecute := False; Exit; end; SynCompletionProposal1.InsertList.Clear; SynCompletionProposal1.ItemList.Clear; PrevShortToken := SynCompletionProposal1.PreviousToken; PrevShortToken := WideDequotedStr(PrevShortToken, '`'); rx := TRegExpr.Create; // Find longer token, ignore EndOfTokenChars, just the last chars up to a whitespace rx.Expression := '(\S+).$'; PrevLongToken := Copy(Editor.LineText, 0, x); if rx.Exec(PrevLongToken) then PrevLongToken := rx.Match[1] else PrevLongToken := ''; // 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 the currently edited sql-statement around the cursor position in synmemo j := Length(Editor.Text); for i := Editor.SelStart+1024 downto Editor.SelStart-1024 do begin if i > j then continue; if i < 1 then break; sql := Editor.Text[i] + sql; end; // 2. Parse FROM clause to detect relevant table/view, probably aliased rx.ModifierG := True; rx.ModifierI := True; rx.Expression := '\b(FROM|INTO|UPDATE)\s+(.+)(WHERE|HAVING|ORDER|GROUP)?'; if rx.Exec(sql) then begin TableClauses := rx.Match[2]; // Ensure tables in JOIN clause(s) are splitted by comma TableClauses := WideStringReplace(TableClauses, 'JOIN', ',', [rfReplaceAll, rfIgnoreCase]); // 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 begin if PrevShortToken = WideDequotedStr(rx.Match[3],'`') then begin tablename := rx.Match[1]; break; end; end; end; end; rx.Free; if (tablename <> '') then begin // add columns to proposal addColumns( tablename ); end else if PrevLongToken <> '' then begin // assuming previoustoken itself is a table addColumns( PrevLongToken ); end; if Length(CurrentInput) = 0 then // makes only sense if the user has typed "database." begin i := Databases.IndexOf(PrevShortToken); if i > -1 then begin // Only display tables from specified db Screen.Cursor := crHourGlass; ds := FetchDbTableList(Databases[i]); while not ds.Eof do begin addTable(ds.Fields); ds.Next; end; Screen.Cursor := crDefault; end; end; if SynCompletionProposal1.ItemList.count = 0 then begin // Add databases for i := 0 to Databases.Count - 1 do begin SynCompletionProposal1.InsertList.Add(Databases[i]); SynCompletionProposal1.ItemList.Add(WideFormat(ItemPattern, [ICONINDEX_DB, 'database', Databases[i]])); end; if ActiveDatabase <> '' then begin // Display tables from current db ds := FetchActiveDbTableList; while not ds.Eof do begin addTable(ds.Fields); ds.Next; end; if Length(CurrentInput) = 0 then // assume that we have already a dbname in memo SynCompletionProposal1.Position := Databases.Count; end; // Add functions for i := 0 to Length(MySQLFunctions) - 1 do begin // Don't display unsupported functions here if MySqlFunctions[i].Version > mysql_version then continue; SynCompletionProposal1.InsertList.Add( MySQLFunctions[i].Name + MySQLFunctions[i].Declaration ); SynCompletionProposal1.ItemList.Add( WideFormat(ItemPattern, [ICONINDEX_FUNCTION, 'function', MySQLFunctions[i].Name + '\color{clSilver}' + MySQLFunctions[i].Declaration] ) ); end; // Add keywords for i := 0 to MySQLKeywords.Count - 1 do begin SynCompletionProposal1.InsertList.Add( MySQLKeywords[i] ); SynCompletionProposal1.ItemList.Add( WideFormat(ItemPattern, [ICONINDEX_KEYWORD, 'keyword', MySQLKeywords[i]] ) ); end; end; end; procedure TMainForm.SynMemoQueryStatusChange(Sender: TObject; Changes: TSynStatusChanges); var sm: TSynMemo; begin sm := Sender as TSynMemo; ValidateQueryControls(Sender); showstatus(FormatNumber(sm.CaretY)+' : '+FormatNumber(sm.CaretX), 1); end; procedure TMainForm.TimerHostUptimeTimer(Sender: TObject); var days, hours, minutes, seconds : Integer; msg: string; begin // Host-Uptime days:= ServerUptime div (60*60*24); seconds := ServerUptime mod (60*60*24); hours := seconds div (60*60); seconds := seconds mod (60*60); minutes := seconds div 60; seconds := seconds mod 60; inc(ServerUptime); msg := Format('%d days, %.2d:%.2d:%.2d', [days,hours,minutes,seconds]); if TimerHostUptime.Enabled then msg := Format('Uptime: %s', [msg]) else msg := ''; showstatus(msg, 4); end; procedure TMainForm.FormActivate(Sender: TObject); begin TimerConnected.OnTimer(self); end; procedure TMainForm.ListTablesEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); var NodeData: PVTreeData; begin // Tables and views can be renamed, routines cannot NodeData := Sender.GetNodeData(Node); Allowed := NodeData.NodeType in [lntTable, lntView]; end; {*** Rename table after checking the new name for invalid characters } procedure TMainForm.ListTablesNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: WideString); var NodeData : PVTreeData; begin // Fetch data from node NodeData := Sender.GetNodeData(Node); // Try to rename, on any error abort and don't rename ListItem try ensureValidIdentifier( NewText ); // rename table ExecUpdateQuery( 'RENAME TABLE ' + mask(NodeData.Captions[0]) + ' TO ' + mask(NewText), False, False ); if SynSQLSyn1.TableNames.IndexOf( NewText ) = -1 then begin SynSQLSyn1.TableNames.Add(NewText); end; // Update nodedata NodeData.Captions[0] := NewText; // Now the active tree db has to be updated. But calling RefreshTreeDB here causes an AV // so we do it manually here RefreshActiveDbTableList; DBTree.InvalidateChildren(FindDBNode(ActiveDatabase), True); except On E : Exception do begin MessageDlg( E.Message, mtError, [mbOK], 0 ); end; end; end; procedure TMainForm.TimerConnectedTimer(Sender: TObject); begin if not TimerConnected.Enabled then begin showstatus('Disconnected.', 2); exit; end; inc(time_connected); // calculate and display connection-time showstatus( 'Connected: ' + FormatTimeNumber(time_connected), 2 ); end; procedure TMainForm.Clear2Click(Sender: TObject); begin // clear history-memo Screen.Cursor := crHourglass; SynMemoSQLLog.Lines.Clear; Screen.Cursor := crDefault; end; {** Column-title clicked -> generate "ORDER BY" } procedure TMainForm.QuickFilterClick(Sender: TObject); var filter,value,column : WideString; menuitem : TMenuItem; IsNull: Boolean; begin // Set filter for "where..."-clause value := DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn]; menuitem := (Sender as TMenuItem); column := mask(DataGrid.Header.Columns[DataGrid.FocusedColumn].Text); IsNull := FDataGridResult.Rows[DataGrid.FocusedNode.Index].Cells[DataGrid.FocusedColumn].IsNull; if (menuitem = QF1) and IsNull then filter := column + ' IS NULL' else if menuitem = QF1 then filter := column + ' =' + ' ' + esc( value ) else if (menuitem = QF2) and IsNull then filter := column + ' IS NOT NULL' else if menuitem = QF2 then filter := column + ' !=' + ' ' + esc( value ) else if menuitem = QF3 then filter := column + ' >' + ' ' + esc( value ) else if menuitem = QF4 then filter := column + ' <' + ' ' + esc( value ) else if menuitem = QF5 then filter := column + ' LIKE' + ' ''' + esc( value, true ) + '%''' else if menuitem = QF6 then filter := column + ' LIKE' + ' ''%' + esc( value, true ) + '''' else if menuitem = QF7 then filter := column + ' LIKE' + ' ''%' + esc( value, true ) + '%''' else if menuitem = QF8 then begin filter := InputBox('Specify filter-value...', column+' = ', 'Value'); if filter = 'Value' then abort; filter := column + ' = ''' + filter + ''''; end else if menuitem = QF9 then begin filter := InputBox('Specify filter-value...', column+' != ', 'Value'); if filter = 'Value' then abort; filter := column + ' != ''' + filter + ''''; end else if menuitem = QF10 then begin filter := InputBox('Specify filter-value...', column+' > ', 'Value'); if filter = 'Value' then abort; filter := column + ' > ''' + filter + ''''; end else if menuitem = QF11 then begin filter := InputBox('Specify filter-value...', column+' < ', 'Value'); if filter = 'Value' then abort; filter := column + ' < ''' + filter + ''''; end else if menuitem = QF12 then begin filter := InputBox('Specify filter-value...', column+' LIKE ', 'Value'); if filter = 'Value' then abort; filter := column + ' LIKE ''%' + filter + '%'''; end else if menuitem = QF13 then filter := column + ' IS NULL' else if menuitem = QF14 then filter := column + ' IS NOT NULL' // Filters with text from clipboard else if (menuitem = QF15) or (menuitem = QF16) or (menuitem = QF17) or (menuitem = QF18) or (menuitem = QF19) then begin filter := menuitem.Caption; end; SynMemoFilter.UndoList.AddGroupBreak; SynMemoFilter.SelectAll; SynmemoFilter.SelText := filter; ToggleFilterPanel(True); actApplyFilterExecute(Sender); end; procedure TMainForm.popupQueryPopup(Sender: TObject); begin // Sets cursor into memo and activates TAction(s) like paste SynMemoQuery.SetFocus; end; procedure TMainForm.popupResultGridPopup(Sender: TObject); begin // data available? // Save2CSV.enabled := end; procedure TMainForm.Autoupdate1Click(Sender: TObject); var seconds : String; secondsInt : Integer; begin // set interval for autorefresh-timer seconds := IntToStr(TimerRefresh.interval div 1000); if inputquery('Auto refresh','Refresh list every ... second(s):', seconds) then begin secondsInt := StrToIntDef(seconds, 0); if secondsInt > 0 then begin TimerRefresh.Interval := secondsInt * 1000; TimerRefresh.Enabled := true; EnableAutoRefresh.Checked := true; DisableAutoRefresh.Checked := false; end else MessageDLG('Seconds must be between 1 and ' + IntToStr(maxint) + '.', mtError, [mbOK], 0); end; end; procedure TMainForm.EnableAutoRefreshClick(Sender: TObject); begin // enable autorefresh-timer TimerRefresh.Enabled := true; EnableAutoRefresh.Checked := true; DisableAutoRefresh.Checked := false; end; procedure TMainForm.DisableAutoRefreshClick(Sender: TObject); begin // enable autorefresh-timer TimerRefresh.Enabled := false; EnableAutoRefresh.Checked := false; DisableAutoRefresh.Checked := true; end; procedure TMainForm.SynMemoQueryDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var src : TControl; begin // dragging an object over the query-memo src := Source as TControl; // Accepting drag's from DBTree and QueryHelpers Accept := (src = DBtree) or (src = lboxQueryHelpers); // set x-position of cursor SynMemoQuery.CaretX := (x - SynMemoQuery.Gutter.Width) div SynMemoQuery.CharWidth - 1 + SynMemoQuery.LeftChar; // set y-position of cursor SynMemoQuery.CaretY := y div SynMemoQuery.LineHeight + SynMemoQuery.TopLine; if not SynMemoQuery.Focused then SynMemoQuery.SetFocus; end; procedure TMainForm.SynMemoQueryDragDrop(Sender, Source: TObject; X, Y: Integer); var src : TControl; Text : WideString; LoadText : Boolean; i: Integer; begin // dropping a tree node or listbox item into the query-memo SynMemoQuery.UndoList.AddGroupBreak; src := Source as TControl; Text := 'Error: Unspecified source control in drag''n drop operation!'; LoadText := True; // Check for allowed controls as source has already // been performed in OnDragOver. So, only do typecasting here. if src = DBtree then Text := DBtree.Text[DBtree.GetFirstSelected, 0] else if (src = lboxQueryHelpers) and (lboxQueryHelpers.ItemIndex > -1) then begin // Snippets tab if tabsetQueryHelpers.TabIndex = 3 then begin QueryLoad( DIRNAME_SNIPPETS + lboxQueryHelpers.Items[lboxQueryHelpers.ItemIndex] + '.sql', False ); LoadText := False; // All other tabs end else begin Text := ''; for i := 0 to lboxQueryHelpers.Items.Count - 1 do begin if lboxQueryHelpers.Selected[i] then Text := Text + lboxQueryHelpers.Items[i] + ', '; end; Delete(Text, Length(Text)-1, 2); end; end; // Only insert text if no previous action did the job. // Should be false when dropping a snippet-file here if LoadText then SynMemoQuery.SelText := Text; SynMemoQuery.UndoList.AddGroupBreak; end; procedure TMainForm.SynMemoQueryDropFiles(Sender: TObject; X, Y: Integer; AFiles: TUnicodeStrings); var i : Integer; begin // one or more files from explorer or somewhere else was // dropped onto the query-memo - let's load their contents: for i:=0 to AFiles.Count-1 do begin if fileExists(AFiles[i]) then begin QueryLoad( AFiles[i], false ); end; end; end; procedure TMainForm.popupHostPopup(Sender: TObject); begin Kill1.Enabled := (PageControlHost.ActivePage = tabProcessList) and Assigned(ListProcesses.FocusedNode); menuEditVariable.Enabled := False; if mysql_version >= 40003 then menuEditVariable.Enabled := (PageControlHost.ActivePage = tabVariables) and Assigned(ListVariables.FocusedNode) else menuEditVariable.Hint := STR_NOTSUPPORTED; end; procedure TMainForm.Saveastextfile1Click(Sender: TObject); begin with TSaveDialog.Create(self) do begin Filter := 'Textfiles (*.txt)|*.txt|All Files (*.*)|*.*'; DefaultExt := 'txt'; FilterIndex := 1; Options := [ofOverwritePrompt,ofHideReadOnly,ofEnableSizing]; if Execute then begin Screen.Cursor := crHourglass; SynMemoSQLLog.Lines.SaveToFile(Filename); Screen.Cursor := crdefault; end; end; end; procedure TMainForm.popupDBPopup(Sender: TObject); var L: Cardinal; HasFocus, InDBTree: Boolean; NodeData: PVTreeData; begin // DBtree and ListTables both use popupDB as menu. Find out which of them was rightclicked. if Sender is TPopupMenu then InDBTree := (Sender as TPopupMenu).PopupComponent = DBTree else if Sender is TMenuItem then InDBTree := TPopupMenu((Sender as TMenuItem).GetParentMenu).PopupComponent = DBTree else InDBTree := False; if InDBtree then begin HasFocus := Assigned(DBtree.FocusedNode); if HasFocus then L := DBtree.GetNodeLevel(DBtree.FocusedNode) else L := 0; actCreateDatabase.Enabled := L = 0; actCreateTable.Enabled := L in [1,2]; actCreateView.Enabled := L in [1,2]; actCreateRoutine.Enabled := L in [1,2]; actDropObjects.Enabled := L in [1,2]; actCopyTable.Enabled := HasFocus and (GetFocusedTreeNodeType in [lntTable, lntCrashedTable, lntView]); actEmptyTables.Enabled := HasFocus and (GetFocusedTreeNodeType in [lntTable, lntCrashedTable, lntView]); actEditObject.Enabled := L > 0; // Show certain items which are valid only here menuTreeExpandAll.Visible := True; menuTreeCollapseAll.Visible := True; menuShowSizeColumn.Visible := True; actSelectTreeBackground.Visible := True; end else begin HasFocus := Assigned(ListTables.FocusedNode); actCreateDatabase.Enabled := False; actCreateTable.Enabled := True; actCreateView.Enabled := True; actCreateRoutine.Enabled := True; actDropObjects.Enabled := ListTables.SelectedCount > 0; actEmptyTables.Enabled := False; if HasFocus then begin NodeData := ListTables.GetNodeData(ListTables.FocusedNode); actEmptyTables.Enabled := NodeData.NodeType in [lntTable, lntCrashedTable, lntView]; end; actEditObject.Enabled := HasFocus; // Show certain items which are valid only here actCopyTable.Enabled := actEmptyTables.Enabled; menuTreeExpandAll.Visible := False; menuTreeCollapseAll.Visible := False; menuShowSizeColumn.Visible := False; actSelectTreeBackground.Visible := False; end; actCreateView.Enabled := actCreateView.Enabled and (mysql_version >= 50001); actCreateRoutine.Enabled := actCreateRoutine.Enabled and (mysql_version >= 50003); end; procedure TMainForm.QueryLoad( filename: String; ReplaceContent: Boolean = true ); var filecontent : WideString; msgtext : String; LineBreaks : TLineBreaks; begin // Ask for action when loading a big file if FileExists(filename) and (_GetFileSize( filename ) > 5*SIZE_MB) then begin msgtext := 'The file you are about to load is bigger than '+FormatByteNumber(5*SIZE_MB, 0)+'.' + CRLF + CRLF + 'Do you want to just run the file to avoid loading it completely into the query-editor ( = memory ) ?' + CRLF + CRLF + 'Press' + CRLF + ' [Yes] to run the file without loading it into the editor' + CRLF + ' [No] to load the file into the query editor' + CRLF + ' [Cancel] to cancel file opening.'; case MessageDlg( msgtext, mtWarning, [mbYes, mbNo, mbCancel], 0 ) of // Run the file, don't load it into the editor mrYes: begin RunSQLFileWindow( Self, filename ); // Add filename to history menu if Pos( DIRNAME_SNIPPETS, filename ) = 0 then AddOrRemoveFromQueryLoadHistory( filename, true ); // Don't load into editor Abort; end; // Do nothing here, go ahead and load the file normally into the editor mrNo:; // Cancel opening file mrCancel: Abort; end; end; // 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 Screen.Cursor := crHourGlass; try filecontent := ReadTextfile(filename); if Pos( DIRNAME_SNIPPETS, filename ) = 0 then AddOrRemoveFromQueryLoadHistory( filename, true ); FillPopupQueryLoad; PagecontrolMain.ActivePage := tabQuery; SynCompletionProposal1.Editor.UndoList.AddGroupBreak; if ScanNulChar(filecontent) then begin filecontent := RemoveNulChars(filecontent); MessageDlg(SContainsNulCharFile, mtInformation, [mbOK], 0); end; SynMemoQuery.BeginUpdate; LineBreaks := ScanLineBreaks(filecontent); if ReplaceContent then begin SynMemoQuery.SelectAll; QueryMemoLineBreaks := LineBreaks; end else begin if (QueryMemoLineBreaks <> lbsNone) and (QueryMemoLineBreaks <> LineBreaks) then QueryMemoLineBreaks := lbsMixed else QueryMemoLineBreaks := LineBreaks; end; if QueryMemoLineBreaks = lbsMixed then MessageDlg('This file contains mixed linebreaks. They have been converted to Windows linebreaks (CR+LF).', mtInformation, [mbOK], 0); SynMemoQuery.SelText := filecontent; SynMemoQuery.SelStart := SynMemoQuery.SelEnd; SynMemoQuery.EndUpdate; except on E:Exception do // File does not exist, is locked or broken MessageDlg(E.message, mtError, [mbOK], 0); end; Screen.Cursor := crDefault; end; procedure TMainForm.SaveDialogExportDataTypeChange(Sender: TObject); begin // Set default file-extension of saved file and options on the dialog to show with SaveDialogExportData do begin Case FilterIndex of 1: DefaultExt := 'csv'; 2: DefaultExt := 'html'; 3: DefaultExt := 'xml'; 4: DefaultExt := 'sql'; end; end; end; {** A cell in a DBGrid is painted. Sets custom background color NULL fields. } procedure TMainForm.popupDataGridPopup(Sender: TObject); var y,m,d,h,i,s,ms : Word; cpText, selectedColumn, value : String; CellFocused: Boolean; const CLPBRD : String = 'CLIPBOARD'; begin CellFocused := Assigned(DataGrid.FocusedNode) and (DataGrid.FocusedColumn > NoColumn); DataInsertDateTime.Enabled := CellFocused; if not CellFocused then Exit; decodedate(now, y, m, d); decodetime(now, h, i, s, ms); DataDateTime.Caption := Format('%.4d-%.2d-%.2d %.2d:%.2d:%.2d', [y,m,d,h,i,s]); DataDate.Caption := Format('%.4d-%.2d-%.2d', [y,m,d]); DataTime.Caption := Format('%.2d:%.2d:%.2d', [h,i,s]); DataTimestamp.caption := Format('%.4d%.2d%.2d%.2d%.2d%.2d', [y,m,d,h,i,s]); DataYear.Caption := Format('%.4d', [y]); // Manipulate the Quick-filter menuitems selectedColumn := mask(DataGrid.Header.Columns[DataGrid.FocusedColumn].Text); // 1. block: include selected columnname and value from datagrid in caption if FDataGridResult.Rows[DataGrid.FocusedNode.Index].Cells[DataGrid.FocusedColumn].IsNull then begin QF1.Caption := selectedColumn + ' IS NULL'; QF2.Caption := selectedColumn + ' IS NOT NULL'; QF3.Visible := False; QF4.Visible := False; QF5.Visible := False; QF6.Visible := False; QF7.Visible := False; end else begin value := sstr(DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn], 100); QF1.Caption := selectedColumn + ' = ' + esc( value ); QF2.Caption := selectedColumn + ' != ' + esc( value ); QF3.Caption := selectedColumn + ' > ' + esc( value ); QF4.Caption := selectedColumn + ' < ' + esc( value ); QF5.Caption := selectedColumn + ' LIKE ''' + esc( value, true ) + '%'''; QF6.Caption := selectedColumn + ' LIKE ''%' + esc( value, true ) + ''''; QF7.Caption := selectedColumn + ' LIKE ''%' + esc( value, true ) + '%'''; QF3.Visible := True; QF4.Visible := True; QF5.Visible := True; QF6.Visible := True; QF7.Visible := True; end; // 2. block: include only selected columnname in caption QF8.Caption := selectedColumn + ' = "..."'; QF9.Caption := selectedColumn + ' != "..."'; QF10.Caption := selectedColumn + ' > "..."'; QF11.Caption := selectedColumn + ' < "..."'; QF12.Caption := selectedColumn + ' LIKE "%...%"'; QF13.Caption := selectedColumn + ' IS NULL'; QF14.Caption := selectedColumn + ' IS NOT NULL'; // 3. block: include selected columnname and clipboard-content in caption for one-click-filtering cpText := Clipboard.AsText; if Length(cpText) < 100 then begin QF15.Enabled := true; QF15.Caption := selectedColumn + ' = ' + esc( cpText ); QF16.Enabled := true; QF16.Caption := selectedColumn + ' != ' + esc( cpText ); QF17.Enabled := true; QF17.Caption := selectedColumn + ' > ' + esc( cpText ); QF18.Enabled := true; QF18.Caption := selectedColumn + ' < ' + esc( cpText ); QF19.Enabled := true; QF19.Caption := selectedColumn + ' LIKE ''%' + esc( cpText, true ) + '%'''; end else begin QF15.Enabled := false; QF15.Caption := selectedColumn + ' = ' + CLPBRD; QF16.Enabled := false; QF16.Caption := selectedColumn + ' != ' + CLPBRD; QF17.Enabled := false; QF17.Caption := selectedColumn + ' > ' + CLPBRD; QF18.Enabled := false; QF18.Caption := selectedColumn + ' < ' + CLPBRD; QF19.Enabled := false; QF19.Caption := selectedColumn + ' LIKE %' + CLPBRD + '%'; end; end; procedure TMainForm.InsertDate(Sender: TObject); var d : String; begin // Insert date/time-value into table d := (sender as TMenuItem).Caption; delete(d, Pos('&', d), 1); DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn] := d; end; procedure TMainForm.ExecUseQuery(db: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false); begin ExecUpdateQuery('USE ' + mask(db), HandleErrors, DisplayErrors); FConn.MysqlParams.Database := db; end; {*** Execute a query without returning a resultset The currently active connection is used @param String The single SQL-query to be executed on the server } function TMainForm.ExecUpdateQuery(sql: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false): Int64; var MysqlQuery : TMysqlQuery; ds: TDataSet; begin Result := -1; // Silence compiler warning. MysqlQuery := nil; try try // Start query execution MysqlQuery := RunThreadedQuery(sql, false); Result := FMysqlConn.Connection.GetAffectedRowsFromLastPost; // Inspect query result code and log / notify user on failure if MysqlQuery.Result in [MQR_CONNECT_FAIL,MQR_QUERY_FAIL] then begin raise Exception.Create(MysqlQuery.Comment); end; except on E: Exception do begin LogSQL( E.Message, True ); if DisplayErrors then MessageDlg( E.Message, mtError, [mbOK], 0 ); // Recreate exception, since we free it below the caller // won't know what happened otherwise. if not HandleErrors then raise THandledSQLError.Create(MysqlQuery.Comment); Result := -1; end; end; finally // Cleanup the MysqlQuery object, we won't need it anymore if MysqlQuery <> nil then begin if MysqlQuery.MysqlDataset <> nil then MysqlQuery.MysqlDataset.Close; ds := MysqlQuery.MysqlDataset; FreeAndNil(ds); end; FreeAndNil (MysqlQuery); end; end; {*** Execute a query which may return a resultset. The caller is responsible for freeing the MysqlQuery object and its Dataset member, only on returnvalue True. The currently active connection is used @param String The single SQL-query to be executed on the server @return TMysqlQuery Containing the dataset and info data availability } function TMainForm.ExecSelectQuery(sql: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false; ForceDialog: Boolean = false): TDataSet; var res: TMysqlQuery; begin res := nil; result := nil; try try // Start query execution res := RunThreadedQuery(sql, ForceDialog); result := res.MysqlDataset; // Inspect query result code and log / notify user on failure if res.Result in [MQR_CONNECT_FAIL,MQR_QUERY_FAIL] then begin raise Exception.Create(res.Comment); end; except on E: Exception do begin LogSQL( E.Message, True ); if DisplayErrors then MessageDlg( E.Message, mtError, [mbOK], 0 ); if not HandleErrors then raise THandledSQLError.Create(E.Message); Result := nil; end; end; finally FreeAndNil(res); end; end; {*** Executes a query. } function TMainForm.GetResults( SQLQuery: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false; ForceDialog: Boolean = false): TDataSet; begin result := ExecSelectQuery(SQLQuery, HandleErrors, DisplayErrors, ForceDialog); end; {*** Execute a query and return String from column x } function TMainForm.GetVar( SQLQuery: WideString; x: Integer = 0; HandleErrors: Boolean = false; DisplayErrors: Boolean = false) : WideString; var ds: TDataSet; begin ds := GetResults( SQLQuery, HandleErrors, DisplayErrors ); if ds = nil then exit; Result := ds.Fields[x].AsWideString; ds.Close; FreeAndNil(ds); end; function TMainForm.GetNamedVar( SQLQuery: WideString; x: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false) : WideString; var ds: TDataSet; begin ds := GetResults( SQLQuery, HandleErrors, DisplayErrors ); if ds = nil then exit; Result := ds.Fields.FieldByName(x).AsWideString; ds.Close; FreeAndNil(ds); end; {*** Execute a query and return column x as Stringlist @param String SQL query String @param Integer 0-based column index in the resultset to return @return TStringList } function TMainForm.GetCol( SQLQuery: WideString; x: Integer = 0; HandleErrors: Boolean = false; DisplayErrors: Boolean = false ) : WideStrings.TWideStringList; var i: Integer; ds: TDataSet; begin ds := GetResults( SQLQuery, HandleErrors, DisplayErrors); Result := WideStrings.TWideStringList.Create; if ds = nil then exit; for i := 0 to ds.RecordCount - 1 do begin Result.Add( ds.Fields[x].AsWideString ); ds.Next; end; ds.Close; FreeAndNil(ds); end; {*** Event procedure handler for the ZSQLMonitor1 object } procedure TMainForm.ZSQLMonitor1LogTrace(Sender: TObject; Event: TZLoggingEvent); begin LogSQL( Event.Message, (Event.Category <> lcExecute) ); end; procedure TMainForm.RunAsyncPost(ds: TDeferDataSet); var res: TMysqlQuery; begin FQueryRunning := true; try try CheckConnection; except on E: Exception do begin raise Exception.Create('Failed to reconnect, giving up. (' + E.Message + ')'); end; end; FProgressForm := TFrmQueryProgress.Create(Self); debug('RunThreadedQuery(): Launching asynchronous query.'); res := ExecPostAsync(FConn,FProgressForm.Handle,ds); WaitForQueryCompletion(FProgressForm, res, false); if res.Result in [MQR_CONNECT_FAIL,MQR_QUERY_FAIL] then begin raise Exception.Create(res.Comment); end; finally FQueryRunning := false; end; end; {*** Run a query in a separate thread of execution on the current connection. } function TMainForm.RunThreadedQuery(AQuery: WideString; ForceDialog: Boolean): TMysqlQuery; begin Result := nil; if (Copy(AQuery, 1, 3) <> 'USE') then EnsureDatabase; // Indicate a querythread is active (only one thread allow at this moment) FQueryRunning := true; try // Check if the connection of the current window is still alive // Otherwise reconnect try CheckConnection; except on E: Exception do begin // Ensure auto-updating processlist is disabled, see bug #1865305 DisableAutoRefreshClick(self); Screen.Cursor := crDefault; raise Exception.Create('Failed to reconnect, giving up. (' + E.Message + ')'); end; end; // Create instance of the progress form (but don't show it yet) FProgressForm := TFrmQueryProgress.Create(Self); { Launch a thread of execution that passes the query to the server The progressform serves as receiver of the status messages (WM_MYSQL_THREAD_NOTIFY) of the thread: * After the thread starts it notifies the progressform (MQE_INITED) (which calls ShowModal on itself) * Waits for a completion message from the thread (MQE_FINISHED) to remove itself * Set FQueryRunning to false } debug('RunThreadedQuery(): Launching asynchronous query.'); Result := ExecMysqlStatementAsync (AQuery,FConn,FProgressForm.Handle,RunAsyncPost); { Repeatedly check if the query has finished by inspecting FQueryRunning Allow repainting of user interface } WaitForQueryCompletion(FProgressForm, Result, ForceDialog); finally FQueryRunning := false; end; // Hack: Un-prevent dynamic loading of records in the context of the wait form's message loop. if not DataGrid.Visible then DataGrid.Visible := True; end; procedure TMainForm.CancelQuery; begin cancelling := true; MysqlConn.Connection.CancelQuery; end; // Searchbox unfocused procedure TMainForm.CheckConnection; var connected: Boolean; choice: Integer; begin if not FMysqlConn.IsAlive then begin LogSQL('Connection failure detected. Trying to reconnect.', true); TimerConnected.Enabled := false; TimerConnectedTimer(self); TimerHostUptime.Enabled := false; TimerHostUptimeTimer(self); FQueryRunning := false; try FMysqlConn.Connection.Disconnect; connected := True; try // CheckConnected() doesn't really check anything, it // just sees if the driver has disposed of it's connection // by means of a Disconnect() or not. In which case there // is no point in doing a Reconnect(), it will NOP. FMysqlConn.Connection.CheckConnected; except connected := False; end; while not FMysqlConn.IsAlive do begin try if connected then FMysqlConn.Connection.Reconnect else FMysqlConn.Connection.Connect; except on E: Exception do begin MainForm.Visible := False; choice := MessageDlg( 'Connection to the server has been lost.'#10#10 + E.Message + #10#10 + 'Click Abort to exit this session.', mtError, [mbRetry, mbAbort], 0 ); if choice = mrAbort then begin Close; Halt(1); end; end; end; if FMysqlConn.IsAlive then MainForm.Visible := True; end; time_connected := 0; TimerConnected.Enabled := true; LogSQL('Connected. Thread-ID: ' + IntToStr( MySQLConn.Connection.GetThreadId )); CheckUptime; // Try to restore active database if ActiveDatabase <> '' then ExecUseQuery(ActiveDatabase) finally FQueryRunning := true; end; end; end; function TMainForm.GetActiveGrid: TVirtualStringTree; begin Result := nil; if PageControlMain.ActivePage = tabData then Result := DataGrid else if PageControlMain.ActivePage = tabQuery then Result := QueryGrid; end; function TMainForm.GetActiveData: PGridResult; begin Result := nil; if PageControlMain.ActivePage = tabData then Result := @FDataGridResult else if PageControlMain.ActivePage = tabQuery then Result := @FQueryGridResult; end; function TMainForm.GetActiveDatabase: WideString; var s: PVirtualNode; begin // Find currently selected database node in database tree, // or the parent if a table is currently selected. s := DBtree.GetFirstSelected; if not Assigned(s) then Result := '' else case DBtree.GetNodeLevel(s) of 2: Result := Databases[s.Parent.Index]; 1: Result := Databases[s.Index]; else Result := ''; end; end; function TMainForm.GetSelectedTable: TListNode; begin if Assigned(DBtree.FocusedNode) and (DBtree.GetNodeLevel(DBtree.FocusedNode)=2) then begin Result.Text := DBtree.Text[DBtree.FocusedNode, 0]; Result.NodeType := GetFocusedTreeNodeType; end else begin Result.Text := ''; Result.NodeType := lntNone; end; end; function TMainForm.GetTreeNodeType(Node: PVirtualNode): TListNodeType; var ds: TDataset; begin Result := lntNone; if Assigned(Node) then case DBtree.GetNodeLevel(Node) of 1: Result := lntDb; 2: begin ds := FetchDbTableList(DBTree.Text[Node.Parent, 0]); ds.RecNo := Node.Index+1; Result := GetDBObjectType(ds.Fields); end; end; end; function TMainForm.GetFocusedTreeNodeType: TListNodeType; begin Result := GetTreeNodeType(DBtree.FocusedNode); end; procedure TMainForm.SelectDBObject(Text: WideString; NodeType: TListNodeType); var i: integer; dbnode, tnode, snode: PVirtualNode; begin debug('SelectDBObject()'); // Detect db node case DBtree.GetNodeLevel( DBtree.GetFirstSelected ) of 1: dbnode := DBtree.GetFirstSelected; 2: dbnode := DBtree.GetFirstSelected.Parent; else raise Exception.Create('No selection in tree, could not determine active db.'); end; snode := nil; // 1st search, case sensitive for lower-case-tablenames=0 servers tnode := DBtree.GetFirstChild(dbnode); for i := 0 to dbnode.ChildCount - 1 do begin // Select table node if it has the wanted caption if (DBtree.Text[tnode, 0] = Text) and (GetTreeNodeType(tnode) = NodeType) then begin snode := tnode; break; end; tnode := DBtree.GetNext(tnode); end; // 2nd search, case insensitive now if not Assigned(snode) then begin tnode := DBtree.GetFirstChild(dbnode); for i := 0 to dbnode.ChildCount - 1 do begin // Select table node if it has the wanted caption if (AnsiCompareText(DBtree.Text[tnode, 0], Text) = 0) and (GetTreeNodeType(tnode) = NodeType) then begin snode := tnode; break; end; tnode := DBtree.GetNext(tnode); end; end; if Assigned(snode) then begin // Ensure table node will be visible DBTree.ScrollIntoView(snode, False); DBtree.Expanded[dbnode] := True; DBtree.Selected[snode] := True; // Implicitely calls OnFocusChanged: DBTree.FocusedNode := snode; exit; end; raise Exception.Create('Table node ' + Text + ' not found in tree.'); end; procedure TMainForm.SetSelectedDatabase(db: WideString); var n: PVirtualNode; begin n := FindDBNode(db); if Assigned(n) then begin DBtree.Selected[n] := true; DBtree.FocusedNode := n; end else raise Exception.Create('Database node ' + db + ' not found in tree.'); 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 := TColumnSelectionForm.Create(self) else if btn = tbtnDataSorting then frm := TDataSortingForm.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; end; end; {** Tabset right to query-memo was clicked } procedure TMainForm.tabsetQueryHelpersChange(Sender: TObject; NewTab: Integer; var AllowChange: Boolean); var i, idx : Integer; SnippetsAccessible : Boolean; Files: TStringList; begin lboxQueryHelpers.Items.BeginUpdate; lboxQueryHelpers.Items.Clear; // By default sorted alpabetically lboxQueryHelpers.Sorted := True; // By default disable all items in popupmenu, enable them when needed menuInsertSnippetAtCursor.Enabled := False; menuLoadSnippet.Enabled := False; menuDeleteSnippet.Enabled := False; menuExplore.Enabled := False; menuHelp.Enabled := False; lboxQueryHelpers.MultiSelect := True; case NewTab of 0: // Cols begin // Keep native order of columns lboxQueryHelpers.Sorted := False; if (SelectedTable.Text <> '') and Assigned(SelectedTableColumns) then begin SelectedTableColumns.First; while not SelectedTableColumns.Eof do begin lboxQueryHelpers.Items.Add(SelectedTableColumns.Fields[0].AsWideString); SelectedTableColumns.Next; end; end; end; 1: // SQL functions begin // State of items in popupmenu menuHelp.Enabled := True; for i := 0 to Length(MySQLFunctions) - 1 do begin // Don't display unsupported functions here if MySqlFunctions[i].Version > mysql_version then continue; lboxQueryHelpers.Items.Add( MySQLFunctions[i].Name + MySQLFunctions[i].Declaration ); end; end; 2: // SQL keywords begin // State of items in popupmenu menuHelp.Enabled := True; for i := 0 to MySQLKeywords.Count - 1 do lboxQueryHelpers.Items.Add(MySQLKeywords[i]); end; 3: // SQL Snippets begin lboxQueryHelpers.MultiSelect := False; Files := getFilesFromDir( DIRNAME_SNIPPETS, '*.sql', true ); for i := 0 to Files.Count - 1 do lboxQueryHelpers.Items.Add(Files[i]); Files.Free; // State of items in popupmenu SnippetsAccessible := lboxQueryHelpers.Items.Count > 0; menuDeleteSnippet.Enabled := SnippetsAccessible; menuInsertSnippetAtCursor.Enabled := SnippetsAccessible; menuLoadSnippet.Enabled := SnippetsAccessible; menuExplore.Enabled := True; end; end; // Restore last selected item in tab for i := 0 to Length(QueryHelpersSelectedItems[NewTab]) - 1 do begin idx := QueryHelpersSelectedItems[NewTab][i]; if idx < lboxQueryHelpers.Count then lboxQueryHelpers.Selected[idx] := True; end; lboxQueryHelpers.Items.EndUpdate; end; {** Insert string from listbox with query helpers into SQL memo at doubleclick } procedure TMainForm.lboxQueryHelpersDblClick(Sender: TObject); var text: WideString; i: Integer; begin for i := 0 to lboxQueryHelpers.Items.Count - 1 do begin if lboxQueryHelpers.Selected[i] then text := text + lboxQueryHelpers.Items[i] + ', '; end; Delete(text, Length(text)-1, 2); case tabsetQueryHelpers.TabIndex of 3: // Load snippet file ínto query-memo QueryLoad( DIRNAME_SNIPPETS + lboxQueryHelpers.Items[lboxQueryHelpers.ItemIndex] + '.sql', False ); else // For all other tabs just insert the item from the list SynMemoQuery.SelText := text; end; SynMemoQuery.SetFocus; end; {** Remember last used items in query helper tabs } procedure TMainForm.lboxQueryHelpersClick(Sender: TObject); var i, s, idx: Integer; begin s := tabsetQueryHelpers.TabIndex; SetLength(QueryHelpersSelectedItems[s], 0); for i := 0 to lboxQueryHelpers.Count - 1 do if lboxQueryHelpers.Selected[i] then begin idx := Length(QueryHelpersSelectedItems[s]); SetLength(QueryHelpersSelectedItems[s], idx+1); QueryHelpersSelectedItems[s][idx] := i; end; end; {** Insert function name from popupmenu to query memo } procedure TMainForm.insertFunction(Sender: TObject); var f : String; sm : TSynMemo; begin // Detect which memo is focused if SynMemoFilter.Focused then sm := SynMemoFilter else sm := SynMemoQuery; // Restore function name from array f := MySQLFunctions[TControl(Sender).tag].Name + MySQLFunctions[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; mayChange : Boolean; begin // Don't do anything if no item was selected if lboxQueryHelpers.ItemIndex = -1 then abort; snippetfile := DIRNAME_SNIPPETS + lboxQueryHelpers.Items[ lboxQueryHelpers.ItemIndex ] + '.sql'; if MessageDlg( 'Delete snippet file? ' + CRLF + snippetfile, mtConfirmation, [mbOk, mbCancel], 0) = mrOk then begin Screen.Cursor := crHourGlass; if DeleteFile( snippetfile ) then begin // Refresh list with snippets mayChange := True; // Unused; satisfies callee parameter collection which is probably dictated by tabset. tabsetQueryHelpersChange( Sender, tabsetQueryHelpers.TabIndex, mayChange ); FillPopupQueryLoad; end else begin Screen.Cursor := crDefault; MessageDlg( 'Failed deleting ' + snippetfile, mtError, [mbOK], 0 ); end; Screen.Cursor := crDefault; end; end; {** Load snippet at cursor } procedure TMainForm.menuInsertSnippetAtCursorClick(Sender: TObject); begin QueryLoad( DIRNAME_SNIPPETS + lboxQueryHelpers.Items[lboxQueryHelpers.ItemIndex] + '.sql', False ); end; {** Load snippet and replace content } procedure TMainForm.menuLoadSnippetClick(Sender: TObject); begin QueryLoad( DIRNAME_SNIPPETS + lboxQueryHelpers.Items[lboxQueryHelpers.ItemIndex] + '.sql', True ); end; {** Open snippets-directory in Explorer } procedure TMainForm.menuExploreClick(Sender: TObject); begin // Normally the snippets folder is created at installation. But it sure // can be the case that it has been deleted or that the application was // not installed properly. Ask if we should create the folder now. if DirectoryExists( DIRNAME_SNIPPETS ) then ShellExec( '', DIRNAME_SNIPPETS ) else if MessageDlg( 'Snippets folder does not exist: ' + DIRNAME_SNIPPETS + CRLF + CRLF + 'This folder is normally created when you install '+appname+'.' + CRLF + CRLF + 'Shall it be created now?', mtWarning, [mbYes, mbNo], 0 ) = mrYes then try Screen.Cursor := crHourglass; ForceDirectories( DIRNAME_SNIPPETS ); finally Screen.Cursor := crDefault; end; end; {** Tell a VirtualStringTree the mem size to allocate per node } procedure TMainForm.vstGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); begin NodeDataSize := SizeOf(TVTreeData); end; {** Various lists initialize their nodes by calling the following procedure once per node } procedure TMainForm.vstInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); var NodeData : PVTreeData; a : TVTreeDataArray; begin // Get the pointer to the node data NodeData := Sender.GetNodeData(Node); // Fetch data array a := GetVTreeDataArray( Sender )^; // Bind data to node NodeData.Captions := a[Node.Index].Captions; NodeData.ImageIndex := a[Node.Index].ImageIndex; NodeData.NodeType := a[Node.Index].NodeType; end; {** Free data of a node } procedure TMainForm.vstFreeNode(Sender: TBaseVirtualTree; Node: PVirtualNode); var b : PVTreeDataArray; begin // Detect which global array should be processed b := GetVTreeDataArray( Sender ); // TODO: If you optimize 'b' out of the code, the compiler will // sometimes generate code that causes a new array here instead of // a reference to the global array, thus breaking SetLength. Find // out why... //TestVTreeDataArray(b); if (Low(b^) < 0) or (High(b^) < 0) then raise Exception.Create('Internal error: unsupported array bounds.'); if Node.Index + 1 < Cardinal(High(b^)) then begin // Delete node somewhere in the middle of the array // Taken from http://delphi.about.com/cs/adptips2004/a/bltip0204_2.htm System.Move( b^[Node.Index + 1], b^[Node.Index], (Cardinal(Length(b^)) - (Node.Index - Cardinal(Low(b^))) - 1) * SizeOf(TVTreeData) ); end; SetLength(b^, Length(b^) - 1); end; {** A node in a VirtualStringTree gets visible and asks which text it shall display } procedure TMainForm.vstGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); var NodeData : PVTreeData; i : Integer; begin // Get pointer to node which gets displayed NodeData := Sender.GetNodeData(Node); // Column is -1 if no column headers are defined if Column = -1 then i := 0 else i := Column; // Avoid AV, don't exceed Captions content if NodeData.Captions.Count > i then CellText := NodeData.Captions[i] else CellText := ''; end; {** A node in a VirtualStringTree gets visible and asks which icon it shall display } procedure TMainForm.vstGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var ImageIndex: Integer); var NodeData : PVTreeData; begin // Display icon only for leftmost cell (0) or for tree nodes (-1) if Column > 0 then exit; // Get pointer to node which gets displayed NodeData := Sender.GetNodeData(Node); ImageIndex := NodeData.ImageIndex; end; {** A column header of a VirtualStringTree was clicked: Toggle the sort direction } procedure TMainForm.vstHeaderClick(Sender: TVTHeader; HitInfo: TVTHeaderHitInfo); 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.SortColumn <> HitInfo.Column then Sender.SortColumn := HitInfo.Column else if Sender.SortDirection = sdAscending then Sender.SortDirection := sdDescending else Sender.SortDirection := sdAscending; Sender.Treeview.SortTree( HitInfo.Column, Sender.SortDirection ); end; {** Sorting a column of a VirtualTree by comparing two cells } procedure TMainForm.vstCompareNodes(Sender: TBaseVirtualTree; Node1, Node2: PVirtualNode; Column: TColumnIndex; var Result: Integer); var NodeData1, NodeData2 : PVTreeData; CellText1, CellText2 : String; Number1, Number2 : Extended; begin NodeData1 := Sender.GetNodeData(Node1); NodeData2 := Sender.GetNodeData(Node2); // If captions-item from either nodes is not set, assume empty string if NodeData1.Captions.Count >= Column then CellText1 := NodeData1.Captions[Column] else CellText1 := ''; if NodeData2.Captions.Count >= Column then CellText2 := NodeData2.Captions[Column] else CellText2 := ''; // Map value "0" to "N/A" strings if CellText1 = '' then CellText1 := '0'; if CellText2 = '' then CellText2 := '0'; // Apply different comparisons for numbers and text if StrToIntDef( copy(CellText1,0,1), -1 ) <> -1 then begin // Assuming numeric values Number1 := MakeFloat( CellText1 ); Number2 := MakeFloat( CellText2 ); if Number1 > Number2 then Result := 1 else if Number1 = Number2 then Result := 0 else if Number1 < Number2 then Result := -1; end else begin // Compare Strings Result := AnsiCompareText( CellText1, CellText2 ); end; end; {** VirtualTree was painted. Adjust background color of sorted column. } procedure TMainForm.vstAfterPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); var i : Integer; h : TVTHeader; begin h := (Sender as TVirtualStringTree).Header; for i := 0 to h.Columns.Count - 1 do begin if h.SortColumn = i then case h.SortDirection of sdAscending: h.Columns[i].Color := COLOR_SORTCOLUMN_ASC; sdDescending: h.Columns[i].Color := COLOR_SORTCOLUMN_DESC; end else h.Columns[i].Color := clWindow; end; end; {** Return the data array which belongs to a VirtualTree component } function TMainForm.GetVTreeDataArray( VT: TBaseVirtualTree ): PVTreeDataArray; begin if VT = ListVariables then Result := @VTRowDataListVariables else if VT = ListStatus then Result := @VTRowDataListStatus else if VT = ListCommandStats then Result := @VTRowDataListCommandStats else if VT = ListProcesses then Result := @VTRowDataListProcesses else if VT = ListTables then Result := @VTRowDataListTables else begin raise Exception.Create( VT.ClassName + ' "' + VT.Name + '" doesn''t have an assigned array with data.' ); end; end; {** Internal: Test quality of code/compiler. } procedure TMainForm.TestVTreeDataArray( P: PVTreeDataArray ); begin if P = @VTRowDataListVariables then Exit; if P = @VTRowDataListStatus then Exit; if P = @VTRowDataListCommandStats then Exit; if P = @VTRowDataListProcesses then Exit; if P = @VTRowDataListTables then Exit; raise Exception.Create('Assertion failed: Invalid global VT array.'); end; {** Click on popupDBGridHeader } procedure TMainForm.MenuTablelistColumnsClick(Sender: TObject); var menuitem : TMenuItem; VisibleColumns : WideStrings.TWideStringList; i : Integer; begin VisibleColumns := WideStrings.TWideStringList.Create; menuitem := TMenuItem( Sender ); menuitem.Checked := not menuitem.Checked; for i := 0 to ListTables.Header.Columns.Count - 1 do begin menuitem := popupDbGridHeader.Items[i]; if menuitem.Checked then VisibleColumns.Add(IntToStr(i)); end; SetVisibleListColumns( ListTables, VisibleColumns ); end; {** Save setup of a VirtualStringTree to registry } procedure TMainForm.SaveListSetup( List: TVirtualStringTree ); var i : Byte; ColWidths, ColsVisible, ColPos, Regname: String; begin ColWidths := ''; ColsVisible := ''; ColPos := ''; for i := 0 to List.Header.Columns.Count - 1 do begin // Column widths if ColWidths <> '' then ColWidths := ColWidths + ','; ColWidths := ColWidths + IntToStr(List.Header.Columns[i].Width); // Column visibility if coVisible in List.Header.Columns[i].Options then begin if ColsVisible <> '' then ColsVisible := ColsVisible + ','; ColsVisible := ColsVisible + IntToStr(i); end; // Column position if ColPos <> '' then ColPos := ColPos + ','; ColPos := ColPos + IntToStr(List.Header.Columns[i].Position); end; OpenRegistry; Regname := List.Name; if GetParentForm(List) <> Self then Regname := GetParentForm(List).Name + '.' + Regname; MainReg.WriteString( REGPREFIX_COLWIDTHS + Regname, ColWidths ); MainReg.WriteString( REGPREFIX_COLSVISIBLE + Regname, ColsVisible ); MainReg.WriteString( REGPREFIX_COLPOS + Regname, ColPos ); end; {** Restore setup of VirtualStringTree from registry } procedure TMainForm.RestoreListSetup( List: TVirtualStringTree ); var i : Byte; colwidth, colpos : Integer; Value : WideString; ValueList : WideStrings.TWideStringList; Regname: String; frm: TCustomForm; begin ValueList := WideStrings.TWideStringList.Create; // Column widths Regname := List.Name; frm := GetParentForm(List); if (frm <> Self) and (Assigned(frm)) then Regname := frm.Name + '.' + Regname; Value := GetRegValue(REGPREFIX_COLWIDTHS + Regname, ''); if Value <> '' then begin ValueList := Explode( ',', Value ); for i := 0 to ValueList.Count - 1 do begin colwidth := MakeInt(ValueList[i]); // Check if column number exists and width is at least 1 pixel if (List.Header.Columns.Count > i) and (colwidth > 0) then List.Header.Columns[i].Width := colwidth; end; end; // Column visibility Value := GetRegValue(REGPREFIX_COLSVISIBLE + Regname, ''); if Value <> '' then begin ValueList := Explode( ',', Value ); SetVisibleListColumns( List, ValueList ); end; // Column position Value := GetRegValue(REGPREFIX_COLPOS + Regname, ''); if Value <> '' then begin ValueList := Explode( ',', Value ); for i := 0 to ValueList.Count - 1 do begin colpos := MakeInt(ValueList[i]); // Check if column number exists if List.Header.Columns.Count > i then List.Header.Columns[i].Position := colpos; end; end; ValueList.Free; end; {** (Un)hide columns in a VirtualStringTree. } procedure TMainForm.SetVisibleListColumns( List: TVirtualStringTree; Columns: WideStrings.TWideStringList ); var i : Integer; begin for i := 0 to List.Header.Columns.Count - 1 do begin // Only ListTables' column visibility is currently customizable // so, make sure to unhide the newer "Comment" column in ListColumns for some users if (Columns.IndexOf( IntToStr(i) ) > -1) or (List <> ListTables) then List.Header.Columns[i].Options := List.Header.Columns[i].Options + [coVisible] else List.Header.Columns[i].Options := List.Header.Columns[i].Options - [coVisible]; end; end; {** Start writing logfile. Called either in FormShow or after closing preferences dialog } procedure TMainForm.ActivateFileLogging; var LogfilePattern : String; i : Integer; begin // Ensure directory exists ForceDirectories( DirnameSessionLogs ); // Determine free filename LogfilePattern := '%s %.6u.log'; i := 1; FileNameSessionLog := DirnameSessionLogs + goodfilename(Format(LogfilePattern, [SessionName, i])); while FileExists( FileNameSessionLog ) do begin inc(i); FileNameSessionLog := DirnameSessionLogs + goodfilename(Format(LogfilePattern, [SessionName, i])); end; // Create file handle for writing AssignFile( FileHandleSessionLog, FileNameSessionLog ); {$I-} // Supress errors if FileExists(FileNameSessionLog) then Append(FileHandleSessionLog) else Rewrite(FileHandleSessionLog); {$I+} if IOResult <> 0 then begin MessageDlg('Error opening session log file:'+CRLF+FileNameSessionLog+CRLF+CRLF+'Logging is disabled now.', mtError, [mbOK], 0); prefLogToFile := False; end else prefLogToFile := True; // Update popupMenu items menuLogToFile.Checked := prefLogToFile; menuOpenLogFolder.Enabled := prefLogToFile; end; {** Close logfile. Called in FormClose, in ActivateFileLogging and on closing preferences dialog } procedure TMainForm.DeactivateFileLogging; begin prefLogToFile := False; {$I-} // Supress errors CloseFile(FileHandleSessionLog); {$I+} // Reset IOResult so later checks in ActivateFileLogging doesn't get an old value IOResult; // Update popupMenu items menuLogToFile.Checked := prefLogToFile; menuOpenLogFolder.Enabled := prefLogToFile; end; {** Display tooltips in VirtualTrees. Imitates default behaviour of TListView. } procedure TMainForm.vstGetHint(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var LineBreakStyle: TVTTooltipLineBreakStyle; var HintText: WideString); var r : TRect; DisplayedWidth, NeededWidth : Integer; Tree: TVirtualStringTree; begin Tree := TVirtualStringTree(Sender); HintText := Tree.Text[Node, Column]; // Check if the list has shortened the text r := Tree.GetDisplayRect(Node, Column, True); DisplayedWidth := r.Right-r.Left; NeededWidth := Canvas.TextWidth(HintText) + Tree.TextMargin*2; //debug(format('need: %d, given: %d, font: %s %d', [NeededWidth, DisplayedWidth, canvas.Font.Name, canvas.Font.Size])); // Disable displaying hint if text is displayed completely in list if NeededWidth <= DisplayedWidth then HintText := ''; end; {** Enable/disable file logging by popupmenuclick } procedure TMainForm.menuLogToFileClick(Sender: TObject); var OldprefLogToFile: Boolean; begin OldprefLogToFile := prefLogToFile; if not prefLogToFile then ActivateFileLogging else DeactivateFileLogging; // Save option if prefLogToFile <> OldprefLogToFile then begin OpenRegistry; MainReg.WriteBool('LogToFile', prefLogToFile); end; end; {** Open folder with session logs } procedure TMainForm.menuOpenLogFolderClick(Sender: TObject); begin ShellExec( '', DirnameSessionLogs ); 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.vstHeaderDraggedOut(Sender: TVTHeader; Column: TColumnIndex; DropPosition: TPoint); begin if Sender.Treeview = ListTables then begin // Keep "Tables" column if Column = 0 then Exit; // Uncheck menuitem in header's contextmenu popupDBGridHeader.Items[Column].Checked := False; end; // Hide the draggedout column Sender.Columns[Column].Options := Sender.Columns[Column].Options - [coVisible]; end; {** A cell in ListCommandStats gets painted. Draw a progress bar on it to visualize its percentage value. } procedure TMainForm.ListCommandStatsBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); var percent : Extended; barwidth, cellwidth: Integer; NodeData: PVTreeData; begin // Only paint bar in percentage column if Column <> 4 then Exit; // Add minimal margin to cell edges InflateRect(CellRect, -1, -1); cellwidth := CellRect.Right - CellRect.Left; // Calculate value to display NodeData := Sender.GetNodeData(Node); percent := MakeFloat(NodeData.Captions[Column]); barwidth := Round(cellwidth / 100 * percent); // Adjust width of rect and paint the bar CellRect.Right := CellRect.Right - cellwidth + barwidth; TargetCanvas.Pen.Color := clGray; TargetCanvas.Brush.Color := clInfoBk; TargetCanvas.Rectangle(CellRect); end; {** Fetch table engines from server Currently used in tbl_properties and createtable } procedure TMainForm.TableEnginesCombo(var Combobox: TCombobox); var engineName, defaultEngine, engineSupport : String; HaveEngineList : TStrings; begin Combobox.Items.BeginUpdate; Combobox.Items.Clear; // Cache datasets if ((dsShowEngines = nil) or (dsShowEngines.State = dsInactive)) and ((dsHaveEngines = nil) or (dsHaveEngines.State = dsInactive)) then begin FreeAndNil(dsShowEngines); FreeAndNil(dsHaveEngines); dsShowEngines := GetResults('SHOW ENGINES', True); if dsShowEngines = nil then dsHaveEngines := GetResults('SHOW VARIABLES LIKE ''have%'''); end; if dsShowEngines <> nil then begin dsShowEngines.First; while not dsShowEngines.Eof do begin engineName := dsShowEngines.FieldByName('Engine').AsString; engineSupport := LowerCase(dsShowEngines.FieldByName('Support').AsString); // Add to dropdown if supported if engineSupport <> 'no' then Combobox.Items.Add(engineName); // Check if this is the default engine if engineSupport = 'default' then defaultEngine := engineName; dsShowEngines.Next; end; end else begin // Manually fetch available engine types by analysing have_* options // This is for servers below 4.1 or when the SHOW ENGINES statement has // failed for some other reason // Add default engines which will not show in a have_* variable: Combobox.Items.CommaText := 'MyISAM,MRG_MyISAM,HEAP'; defaultEngine := 'MyISAM'; // Possible other engines: HaveEngineList := TStringList.Create; HaveEngineList.CommaText := 'ARCHIVE,BDB,BLACKHOLE,CSV,EXAMPLE,FEDERATED,INNODB,ISAM'; dsHaveEngines.First; while not dsHaveEngines.Eof do begin engineName := copy(dsHaveEngines.Fields[0].AsString, 6, Length(dsHaveEngines.Fields[0].AsString) ); // Strip additional "_engine" suffix, fx from "have_blackhole_engine" if Pos('_', engineName) > 0 then engineName := copy(engineName, 0, Pos('_', engineName)-1); engineName := UpperCase(engineName); // Add engine to dropdown if it's a) in HaveEngineList and b) activated if (HaveEngineList.IndexOf(engineName) > -1) and (LowerCase(dsHaveEngines.Fields[1].AsString) = 'yes') then Combobox.Items.Add(engineName); dsHaveEngines.Next; end; end; Combobox.Sorted := True; // Select default Combobox.ItemIndex := Combobox.Items.IndexOf(defaultEngine); Combobox.Items.EndUpdate; 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 NodeData : PVTreeData; enableSQLView : Boolean; begin enableSQLView := Assigned(Node); SynMemoProcessView.Enabled := enableSQLView; pnlProcessView.Enabled := enableSQLView; if enableSQLView then begin NodeData := ListProcesses.GetNodeData(Node); SynMemoProcessView.Text := NodeData.Captions[7]; end else SynMemoProcessView.Clear; end; {*** Apply a filter to a Virtual Tree. Currently used for ListVariables, ListStatus and ListProcesses } procedure TMainForm.editFilterVTChange(Sender: TObject); var Node : PVirtualNode; NodeData : PVTreeData; VT : TVirtualStringTree; i : Integer; match : Boolean; search : String; tab: TTabSheet; VisibleCount: Cardinal; begin // Find the correct VirtualTree that shall be filtered tab := PageControlHost.ActivePage; if tab = tabVariables then VT := ListVariables else if tab = tabStatus then VT := ListStatus else if tab = tabProcesslist then VT := ListProcesses else VT := ListCommandStats; // Loop through all nodes to adjust their vsVisible state Node := VT.GetFirst; search := LowerCase( editFilterVT.Text ); VisibleCount := 0; while Assigned(Node) do begin NodeData := VT.GetNodeData(Node); // Don't filter anything if the filter text is empty match := search = ''; // Search for given text in node's captions if not match then for i := 0 to NodeData.Captions.Count - 1 do begin if Pos( search, LowerCase(NodeData.Captions[i]) ) > 0 then begin match := True; break; end; end; if match then begin Node.States := Node.States + [vsVisible]; inc(VisibleCount); end else Node.States := Node.States - [vsVisible]; Node := VT.GetNext(Node); end; // Colorize TEdit with filter string to signalize that some nodes are hidden now if VisibleCount <> VT.RootNodeCount then begin editFilterVT.Font.Color := clRed; editFilterVT.Color := clYellow; end else begin editFilterVT.Font.Color := clWindowText; editFilterVT.Color := clWindow; end; if search <> '' then begin lblFilterVTInfo.Caption := IntToStr(VisibleCount)+' out of '+IntToStr(VT.RootNodeCount)+' matching. ' + IntToStr(VT.RootNodeCount - VisibleCount) + ' hidden.'; end else lblFilterVTInfo.Caption := ''; // RootNode.TotalHeight needs to be recalculated so the scrollbar has the correct // range, ignoring hidden nodes. // Similar to what is done by VT.FixupTotalHeight() which doesn't work // for some reason if called from within VT.UpdateVerticalScrollBar() VT.RootNode.TotalHeight := 0; Node := VT.GetFirst; while Assigned(Node) do begin if vsVisible in Node.States then Inc(VT.RootNode.TotalHeight, Node.TotalHeight); Node := Node.NextSibling; end; VT.UpdateVerticalScrollBar(True); VT.Repaint; end; procedure TMainForm.ListVariablesDblClick(Sender: TObject); begin menuEditVariable.Click; end; {** Edit a server variable } procedure TMainForm.menuEditVariableClick(Sender: TObject); var NodeData: PVTreeData; begin if EditVariableForm = nil then EditVariableForm := TfrmEditVariable.Create(Self); NodeData := ListVariables.GetNodeData(ListVariables.FocusedNode); EditVariableForm.VarName := NodeData.Captions[0]; EditVariableForm.VarValue := NodeData.Captions[1]; // Refresh relevant list node if EditVariableForm.ShowModal = mrOK then NodeData.Captions[1] := GetVar('SHOW VARIABLES LIKE '+esc(NodeData.Captions[0]), 1); end; {** The database tree doesn't use any structure for its nodes. } procedure TMainForm.DBtreeGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize: Integer); begin NodeDataSize := 0; 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: WideString); var ds: TDataset; db, eng: WideString; i: Integer; Bytes: Int64; AllListsCached: Boolean; begin case Column of 0: case Sender.GetNodeLevel(Node) of 0: CellText := FConn.MysqlParams.User + '@' + FConn.MysqlParams.Host; 1: CellText := Databases[Node.Index]; 2: begin ds := FetchDbTableList(Databases[Node.Parent.Index]); ds.RecNo := Node.Index+1; CellText := ds.FieldByName(DBO_NAME).AsWideString; end; end; 1: case GetTreeNodeType(Node) 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 Databases.Count - 1 do begin if not DbTableListCachedAndValid(Databases[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 Databases.Count - 1 do begin ds := FetchDbTableList(Databases[i]); while not ds.Eof do begin Bytes := Bytes + GetTableSize(ds); ds.Next; end; 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 db := DBtree.Text[Node, 0]; if not DbTableListCachedAndValid(db) then CellText := '' else begin Bytes := 0; ds := FetchDbTableList(db); while not ds.Eof do begin if ds.FindField('Type') <> nil then eng := FieldContent(ds, 'Type') else eng := FieldContent(ds, 'Engine'); if UpperCase(eng) <> 'MRG_MYISAM' then Bytes := Bytes + GetTableSize(ds); ds.Next; end; if Bytes >= 0 then CellText := FormatByteNumber(Bytes) else CellText := ''; end; end; lntTable: begin db := DBtree.Text[Node.Parent, 0]; ds := FetchDbTableList(db); ds.RecNo := Node.Index + 1; Bytes := GetTableSize(ds); CellText := FormatByteNumber(Bytes); end else CellText := ''; // Applies for views and crashed tables 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: Integer); var ds: TDataset; begin if Column > 0 then Exit; case Sender.GetNodeLevel(Node) of 0: ImageIndex := ICONINDEX_SERVER; 1: if (Kind = ikSelected) or ((Sender.GetFirstSelected<>nil) and (Node=Sender.GetFirstSelected.Parent)) then ImageIndex := ICONINDEX_DB_HIGHLIGHT else ImageIndex := ICONINDEX_DB; 2: begin ds := FetchDbTableList(Databases[Node.Parent.Index]); ds.RecNo := Node.Index+1; case GetDBObjectType(ds.Fields) of lntTable: if Kind = ikSelected then ImageIndex := ICONINDEX_TABLE_HIGHLIGHT else ImageIndex := ICONINDEX_TABLE; lntView: if Kind = ikSelected then ImageIndex := ICONINDEX_VIEW_HIGHLIGHT else ImageIndex := ICONINDEX_VIEW; lntCrashedTable: if Kind = ikSelected then ImageIndex := ICONINDEX_CRASHED_TABLE_HIGHLIGHT else ImageIndex := ICONINDEX_CRASHED_TABLE; lntProcedure: ImageIndex := ICONINDEX_STOREDPROCEDURE; lntFunction: ImageIndex := ICONINDEX_STOREDFUNCTION; end; end; end; end; {** Set childcount of an expanding treenode } procedure TMainForm.DBtreeInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var ChildCount: Cardinal); var ds: TDataset; specialDbs: WideStrings.TWideStringList; dbName: WideString; i: Integer; begin case Sender.GetNodeLevel(Node) of // Root node has only one single child (user@host) 0: begin Screen.Cursor := crHourglass; Showstatus( 'Reading Databases...' ); try Databases := WideStrings.TWideStringList.Create; if DatabasesWanted.Count = 0 then begin ds := GetResults( 'SHOW DATABASES' ); specialDbs := WideStrings.TWideStringList.Create; for i:=1 to ds.RecordCount do begin dbName := ds.FieldByName('Database').AsWideString; if dbName = DBNAME_INFORMATION_SCHEMA then specialDbs.Insert( 0, dbName ) else Databases.Add( dbName ); ds.Next; end; ds.Close; FreeAndNil(ds); Databases.Sort; // Prioritised position of system-databases for i := specialDbs.Count - 1 downto 0 do Databases.Insert( 0, specialDbs[i] ); end else for i:=0 to DatabasesWanted.Count-1 do Databases.Add(DatabasesWanted[i]); showstatus( IntToStr( Databases.Count ) + ' Databases', 0 ); ChildCount := Databases.Count; // Avoids excessive InitializeKeywordLists() calls. SynSQLSyn1.TableNames.BeginUpdate; SynSQLSyn1.TableNames.Clear; // Let synedit know all database names so that they can be highlighted // TODO: Is this right? Adding "." seems to make more sense.. for i := 0 to Databases.Count - 1 do SynSQLSyn1.TableNames.Add(Databases[i]); SynSQLSyn1.TableNames.EndUpdate; finally ShowStatus( STATUS_MSG_READY ); Screen.Cursor := crDefault; end; end; // DB node expanding 1: begin Screen.Cursor := crHourglass; Showstatus( 'Reading Tables...' ); try ds := FetchDbTableList(Databases[Node.Index]); ChildCount := ds.RecordCount; finally ShowStatus( STATUS_MSG_READY ); Screen.Cursor := crDefault; end; // Auto resize "Size" column in dbtree when needed // See also OnResize if coVisible in (Sender as TVirtualStringTree).Header.Columns[1].Options then (Sender as TVirtualStringTree).Header.AutoFitColumns(False, smaUseColumnOption, 1, 1); end; else Exit; end; end; {** Set initial options of a treenode } procedure TMainForm.DBtreeInitNode(Sender: TBaseVirtualTree; ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates); var level: Cardinal; begin level := Sender.GetNodeLevel(Node); // Ensure plus sign is visible for root and dbs if level in [0,1] then Include( InitialStates, ivsHasChildren); // Host node is always expanded if level = 0 then Include( InitialStates, ivsExpanded ); end; {** Selection in database tree has changed } procedure TMainForm.DBtreeFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); var newDb, newDbObject, Cap: WideString; begin debug('DBtreeFocusChanged()'); if not Assigned(Node) then Exit; // Post pending UPDATE if DataGridHasChanges then actDataPostChangesExecute(Sender); case Sender.GetNodeLevel(Node) of 0: ShowHost; 1: begin newDb := Databases[Node.Index]; ShowDatabase( newDb ); end; 2: begin newDb := Databases[Node.Parent.Index]; newDbObject := SelectedTable.Text; tabEditor.TabVisible := True; tabData.TabVisible := SelectedTable.NodeType in [lntTable, lntCrashedTable, lntView]; if tabEditor.TabVisible then begin actEditObjectExecute(Sender); // 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 PagecontrolMain.ActivePage := tabEditor; // When a table is clicked in the tree, and the data // tab is active, update the data tab if PagecontrolMain.ActivePage = tabData then ViewData(Sender); // When a table is clicked in the tree, and the query // tab is active, update the list of columns if PagecontrolMain.ActivePage = tabQuery then begin // Don't know why this next line is necessary, couldn't find // documented in the code how the refresh mechanism for it is // supposed to work. It is necessary, though. ResetSelectedTableStuff; RefreshQueryHelpers; end; end; end; end; if newDb <> '' then LoadDatabaseProperties(newDb); // Set window caption and taskbar text Cap := winName; if newDb <> '' then Cap := Cap + ' /' + newDb; if newDbObject <> '' then Cap := Cap + '/' + newDbObject; Cap := Cap + ' - ' + APPNAME + ' ' + FullAppVersion; Caption := Cap; Application.Title := Cap; end; procedure TMainForm.DBtreeDblClick(Sender: TObject); var Node: PVirtualNode; begin // Paste DB or table name into query window on treeview double click. Node := DBtree.GetFirstSelected; if not Assigned(Node) then Exit; if DBtree.GetNodeLevel(Node) = 0 then Exit; if PageControlMain.ActivePage <> tabQuery then Exit; SynMemoQuery.SelText := DBtree.Text[Node, 0]; SynMemoQuery.SetFocus; end; procedure TMainForm.DBtreePaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); begin // Grey out rather unimportant "Size" column if Column <> 1 then Exit; case DBtree.GetNodeLevel(Node) of 0: TargetCanvas.Font.Color := clWindowText; 1: TargetCanvas.Font.Color := $008f8f8f; 2: TargetCanvas.Font.Color := $00cfcfcf; end; end; {** Refresh the whole tree } procedure TMainForm.RefreshTree(DoResetTableCache: Boolean; SelectDatabase: WideString = ''); var oldActiveDatabase, db: WideString; oldSelectedTable: TListNode; Node: PVirtualNode; ExpandedDBs, TablesFetched: WideStrings.TWideStringList; i: Integer; begin // Remember currently active database and table oldActiveDatabase := ActiveDatabase; oldSelectedTable := SelectedTable; // Temporary unselect any node to postpone event handlings if (DBtree.GetFirstSelected <> nil) and (DBtree.GetNodeLevel(DBtree.GetFirstSelected) > 0) then DBtree.ClearSelection; // Remember expandation status of all dbs and whether their tables were fetched ExpandedDBs := WideStrings.TWideStringList.Create; TablesFetched := WideStrings.TWideStringList.Create; Node := DBtree.GetFirstChild(DBtree.GetFirst); for i := 0 to DBtree.GetFirst.ChildCount - 1 do begin db := DBtree.Text[Node, 0]; if DBtree.ChildrenInitialized[Node] then TablesFetched.Add(db); if vsExpanded in Node.States then ExpandedDBs.Add(db); Node := DBtree.GetNextSibling(Node); end; // ReInit tree population DBTree.BeginUpdate; DBtree.ReinitChildren(DBTree.GetFirst, False); // .ResetNode(DBtree.GetFirst); if DoResetTableCache then ClearAllTableLists; // Reselect active or new database if present. Could have been deleted or renamed. try if SelectDatabase <> '' then ActiveDatabase := SelectDatabase else if oldActiveDatabase <> '' then ActiveDatabase := oldActiveDatabase; except end; // Expand nodes which were previously expanded Node := DBtree.GetFirstChild(DBtree.GetFirst); for i := 0 to DBtree.GetFirst.ChildCount - 1 do begin db := DBtree.Text[Node, 0]; if TablesFetched.IndexOf(db) > -1 then DBtree.ReinitChildren(Node, False); DBtree.Expanded[Node] := ExpandedDBs.IndexOf(db) > -1; Node := DBtree.GetNextSibling(Node); end; ExpandedDBs.Free; TablesFetched.Free; try if oldSelectedTable.Text <> '' then SelectDBObject(oldSelectedTable.Text, oldSelectedTable.NodeType); except end; DBTree.EndUpdate; end; {** Refresh one database node in the db tree } procedure TMainForm.RefreshTreeDB(db: WideString); var oldActiveDatabase: WideString; dbnode: PVirtualNode; begin oldActiveDatabase := ActiveDatabase; DBtree.ClearSelection; DBNode := FindDBNode(db); RefreshDbTableList(db); DBTree.ReinitNode(dbnode, true); DBtree.InvalidateChildren(dbnode, false); ActiveDatabase := oldActiveDatabase; end; {** Find a database node in the tree by passing its name } function TMainForm.FindDBNode(db: WideString): PVirtualNode; var i, s: Integer; n: PVirtualNode; begin Result := nil; // Ensure Databases list is instantiated (by DBtree.InitChildren) if Databases = nil then DBtree.ReinitNode(DBtree.GetFirst, False); // TStringList.CaseSensitive= True|False is only used in .IndexOf and .Sort procs, // it does not avoid or remove duplicate items Databases.CaseSensitive := True; s := Databases.IndexOf(db); if s = -1 then begin Databases.CaseSensitive := False; s := Databases.IndexOf(db); end; if s > -1 then begin n := DBtree.GetFirstChild(DBtree.GetFirst); for i := 0 to DBtree.GetFirst.ChildCount - 1 do begin if Integer(n.Index) = s then begin Result := n; Exit; end; n := DBtree.GetNextSibling(n); end; end; end; {** Expand all db nodes } procedure TMainForm.menuTreeExpandAllClick(Sender: TObject); begin DBtree.FullExpand; DBtree.ScrollIntoView(DBtree.GetFirstSelected, False); end; {** Collapse all db nodes } 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.GetFirstSelected, False); end; function TMainForm.GetTableSize(ds: TDataSet): Int64; var d, i: String; begin d := FieldContent(ds, 'Data_length'); i := FieldContent(ds, 'Index_length'); if (d = '') or (i = '') then Result := -1 else Result := MakeInt(d) + MakeInt(i); end; function TMainForm.DbTableListCachedAndValid(db: WideString): Boolean; var ds: TDataSet; begin Result := CachedTableLists.IndexOf(db) > -1; if Result then begin ds := TDataSet(CachedTableLists.Objects[CachedTableLists.IndexOf(db)]); // Delphi's RTL (TDataSet in DB.pas) throws exceptions right and left // if the database the dataset(-derivate, aka TZDataSet) came from is // currently, or has been earlier been, disconnected. Therefore, nuke // these datasets, they'll have to be reloaded. if ds.State = dsInactive then begin ClearDbTableList(db); Result := False; end; end; end; procedure TMainForm.editFilterSearchChange(Sender: TObject); var Add, Clause: WideString; i: Integer; ed: TEdit; begin ed := TEdit(Sender); Clause := ''; Add := ''; if ed.Text <> '' then begin SelectedTableColumns.First; for i := 0 to SelectedTableColumns.RecordCount - 1 do begin if i > 0 then Add := Add + ' OR '; Add := Add + mask(SelectedTableColumns.Fields[0].AsWideString) + ' LIKE ' + esc('%'+ed.Text+'%'); if Length(Add) > 45 then begin Clause := Clause + Add + CRLF; Add := ''; end; SelectedTableColumns.Next; end; if Add <> '' then Clause := Clause + Add; end; SynMemoFilter.UndoList.AddGroupBreak; SynMemoFilter.SelectAll; SynMemoFilter.SelText := Clause; SynMemoFilterChange(Sender); end; procedure TMainForm.SynMemoFilterChange(Sender: TObject); var SomeText: Boolean; begin SomeText := (SynMemoFilter.GetTextLen > 0) or (editFilterSearch.Text <> ''); actClearFilterEditor.Enabled := SomeText; 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.editFilterSearchEnter(Sender: TObject); begin // Enables triggering apply button with Enter btnFilterApply.Default := True; end; procedure TMainForm.editFilterSearchExit(Sender: TObject); begin btnFilterApply.Default := False; end; procedure TMainForm.EnsureNodeLoaded(Sender: TBaseVirtualTree; Node: PVirtualNode; WhereClause: WideString); var res: PGridResult; query: WideString; ds: TDataSet; i, j: LongInt; begin if Sender = DataGrid then res := @FDataGridResult else res := @FQueryGridResult; if (not res.Rows[Node.Index].Loaded) and (res.Rows[Node.Index].State <> grsInserted) then begin query := DataGridCurrentSelect + DataGridCurrentFrom; // Passed WhereClause has prio over current filter, fixes bug #754 if WhereClause <> '' then begin query := query + ' WHERE ' + WhereClause; end else if DataGridCurrentFilter <> '' then begin query := query + ' WHERE ' + DataGridCurrentFilter; end; // start query ShowStatus('Retrieving data...'); ds := GetResults(query); // If new data does not match current filter, remove from tree. if Cardinal(ds.RecordCount) < 1 then begin // Remove entry from dynamic array. for i := Node.Index to Length(res.Rows) - 1 do begin if i < Length(res.Rows) - 1 then res.Rows[i] := res.Rows[i + 1]; end; SetLength(res.Rows, Length(res.Rows) - 1); // Remove entry from node list. Sender.DeleteNode(Node); end; // fill in data ShowStatus('Filling grid with record-data...'); if Cardinal(ds.RecordCount) > 0 then begin SetLength(res.Rows[Node.Index].Cells, ds.Fields.Count); i := Node.Index; for j := 0 to ds.Fields.Count - 1 do begin if res.Columns[j].DatatypeCat = dtcBinary then res.Rows[i].Cells[j].Text := '0x' + BinToWideHex(ds.Fields[j].AsString) else res.Rows[i].Cells[j].Text := ds.Fields[j].AsWideString; res.Rows[i].Cells[j].IsNull := ds.Fields[j].IsNull; end; res.Rows[Node.Index].Loaded := True; end; ShowStatus( STATUS_MSG_READY ); FreeAndNil(ds); end; end; procedure TMainForm.EnsureChunkLoaded(Sender: TBaseVirtualTree; Node: PVirtualNode; FullWidth: Boolean = False); var res: PGridResult; start, limit: Cardinal; query: WideString; ds: TDataSet; i, j: LongInt; hi: LongInt; regCrashIndicName: String; begin if Sender = DataGrid then res := @FDataGridResult else res := @FQueryGridResult; if (not res.Rows[Node.Index].Loaded) and (res.Rows[Node.Index].State <> grsInserted) then begin start := Node.Index - (Node.Index mod GridMaxRows); limit := TVirtualStringTree(Sender).RootNodeCount - start; if limit > GridMaxRows then limit := GridMaxRows; if FullWidth then query := DataGridCurrentFullSelect + DataGridCurrentFrom else query := DataGridCurrentSelect + DataGridCurrentFrom; if DataGridCurrentFilter <> '' then query := query + ' WHERE ' + DataGridCurrentFilter; if DataGridCurrentSort <> '' then query := query + ' ORDER BY ' + DataGridCurrentSort; query := query + WideFormat(' LIMIT %d, %d', [start, limit]); // Set indicator for possibly crashing query OpenRegistry(SessionName); regCrashIndicName := Utf8Encode(REGPREFIX_CRASH_IN_DATA + ActiveDatabase + '.' + SelectedTable.Text); MainReg.WriteBool(regCrashIndicName, True); // start query ShowStatus('Retrieving data...'); debug(Format('mem: loading data chunk from row %d to %d', [start, limit])); try ds := GetResults(query); except // if something bad happened, nuke cache, reset cursor and display error. TVirtualStringTree(Sender).RootNodeCount := 0; SetLength(res.Rows, 0); ReachedEOT := true; ShowStatus(STATUS_MSG_READY); Screen.Cursor := crDefault; raise; end; if Cardinal(ds.RecordCount) < limit then begin limit := ds.RecordCount; TVirtualStringTree(Sender).RootNodeCount := start + limit; SetLength(res.Rows, start + limit); ReachedEOT := true; end; if not ReachedEOT then begin hi := start + limit; if hi < SIMULATE_INITIAL_ROWS then hi := SIMULATE_INITIAL_ROWS; hi := hi * (100 + SIMULATE_MORE_ROWS) div 100; Sender.BeginUpdate; TVirtualStringTree(Sender).RootNodeCount := Cardinal(hi); SetLength(res.Rows, hi); Sender.EndUpdate; end; debug(Format('mem: loaded data chunk from row %d to %d', [start, limit])); // Query was completed successfully. Reset crash indicator. MainReg.DeleteValue(regCrashIndicName); // fill in data ShowStatus('Filling grid with record-data...'); for i := start to start + limit - 1 do begin SetLength(res.Rows[i].Cells, ds.Fields.Count); for j := 0 to ds.Fields.Count - 1 do begin if res.Columns[j].DatatypeCat = dtcBinary then res.Rows[i].Cells[j].Text := '0x' + BinToWideHex(ds.Fields[j].AsString) else res.Rows[i].Cells[j].Text := ds.Fields[j].AsWideString; res.Rows[i].Cells[j].IsNull := ds.Fields[j].IsNull; end; res.Rows[i].Loaded := True; ds.Next; end; if res = @FDataGridResult then begin if ReachedEOT then DisplayRowCountStats(Length(res.Rows)) else DisplayRowCountStats(-1); end; ShowStatus( STATUS_MSG_READY ); FreeAndNil(ds); end; end; procedure TMainForm.DiscardNodeData(Sender: TVirtualStringTree; Node: PVirtualNode); var Data: PGridResult; begin // Avoid discarding query data as it will never be reloaded. if Sender <> DataGrid then Exit; Data := @FDataGridResult; // Avoid rows being edited. if Data.Rows[Node.Index].State = grsDefault then begin Data.Rows[Node.Index].Loaded := false; SetLength(Data.Rows[Node.Index].Cells, 0); end; end; {** A grid cell fetches its text content } procedure TMainForm.GridGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText: WideString); var c: PGridCell; gr: PGridResult; EditingCell: Boolean; begin if Column = -1 then Exit; if Sender = DataGrid then gr := @FDataGridResult else gr := @FQueryGridResult; if Node.Index >= Cardinal(Length(gr.Rows)) then Exit; EnsureChunkLoaded(Sender, Node); if Node.Index >= Cardinal(Length(gr.Rows)) then Exit; c := @gr.Rows[Node.Index].Cells[Column]; EditingCell := Sender.IsEditing and (Node = Sender.FocusedNode) and (Column = Sender.FocusedColumn); if c.Modified then begin if c.NewIsNull then begin if EditingCell then CellText := '' else CellText := TEXT_NULL; end else CellText := c.NewText; end else begin if c.IsNull then begin if EditingCell then CellText := '' else CellText := TEXT_NULL; end else begin CellText := c.Text; if Length(c.Text) = GridMaxData then CellText := CellText + ' [...]'; end; end; end; procedure TMainForm.CalcNullColors; begin prefNullColorNumeric := ColorAdjustBrightness(prefFieldColorNumeric, COLORSHIFT_NULLFIELDS); prefNullColorText := ColorAdjustBrightness(prefFieldColorText, COLORSHIFT_NULLFIELDS); prefNullColorBinary := ColorAdjustBrightness(prefFieldColorBinary, COLORSHIFT_NULLFIELDS); prefNullColorDatetime := ColorAdjustBrightness(prefFieldColorDatetime, COLORSHIFT_NULLFIELDS); prefNullColorEnum := ColorAdjustBrightness(prefFieldColorEnum, COLORSHIFT_NULLFIELDS); prefNullColorSet := ColorAdjustBrightness(prefFieldColorSet, COLORSHIFT_NULLFIELDS); prefNullColorDefault := ColorAdjustBrightness(clWindow, COLORSHIFT_NULLFIELDS); 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.GridPaintText(Sender: TBaseVirtualTree; const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType); var isNull: Boolean; cl: TColor; r: PGridResult; begin if Column = -1 then Exit; if Sender = DataGrid then r := @FDataGridResult else r := @FQueryGridResult; if Node.Index >= Cardinal(Length(r.Rows)) then Exit; // Make primary key columns bold if r.Columns[Column].IsPriPart then TargetCanvas.Font.Style := TargetCanvas.Font.Style + [fsBold]; // NULL value isNull := r.Rows[Node.Index].Cells[Column].IsNull; // Do not apply any color on a selected, highlighted cell to keep readability if (Node = Sender.FocusedNode) and (Column = Sender.FocusedColumn) then cl := clHighlightText else if vsSelected in Node.States then cl := clBlack // Numeric field else if r.Columns[Column].DatatypeCat in [dtcInteger, dtcReal] then if isNull then cl := prefNullColorNumeric else cl := prefFieldColorNumeric // Date field else if r.Columns[Column].DatatypeCat = dtcTemporal then if isNull then cl := prefNullColorDatetime else cl := prefFieldColorDatetime // Text field else if r.Columns[Column].DatatypeCat = dtcText then if isNull then cl := prefNullColorText else cl := prefFieldColorText // Text field else if r.Columns[Column].DatatypeCat = dtcBinary then if isNull then cl := prefNullColorBinary else cl := prefFieldColorBinary // Enum field else if r.Columns[Column].DatatypeCat = dtcIntegerNamed then if isNull then cl := prefNullColorEnum else cl := prefFieldColorEnum // Set field else if r.Columns[Column].DatatypeCat = dtcSetNamed then if isNull then cl := prefNullColorSet else cl := prefFieldColorSet else if isNull then cl := prefNullColorDefault else cl := clWindowText; TargetCanvas.Font.Color := cl; end; procedure TMainForm.DataGridAfterCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellRect: TRect); begin // Don't waist time if Column = -1 then Exit; if Node.Index >= Cardinal(Length(FDataGridResult.Rows)) then Exit; // Paint a red triangle at the top left corner of the cell if FDataGridResult.Rows[Node.Index].Cells[Column].Modified then PngImageListMain.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; i, j : Integer; columnexists : Boolean; ColName: WideString; begin if HitInfo.Column = NoColumn then Exit; if HitInfo.Button = mbLeft then begin 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 columnexists := False; for i := Low(FDataGridSort) to High(FDataGridSort) do begin if FDataGridSort[i].ColumnName = ColName then begin // AddOrderCol is already in the list. Switch its direction: // ASC > DESC > [delete col] columnexists := True; if FDataGridSort[i].SortDirection = ORDER_ASC then FDataGridSort[i].SortDirection := ORDER_DESC else begin // Delete order col for j := i to High(FDataGridSort) - 1 do FDataGridSort[j] := FDataGridSort[j+1]; SetLength(FDataGridSort, Length(FDataGridSort)-1); end; // We found the matching column, no need to loop further break; end; end; if not columnexists then begin i := Length(FDataGridSort); SetLength(FDataGridSort, i+1); FDataGridSort[i] := TOrderCol.Create; FDataGridSort[i].ColumnName := ColName; FDataGridSort[i].SortDirection := ORDER_ASC; end; ViewData(Sender); end else begin frm := TColumnSelectionForm.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; {** Only allow grid editing if there is a good key available } procedure TMainForm.setNULL1Click(Sender: TObject); begin if not CheckUniqueKeyClause then Exit; // Internally calls OnNewText event: DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn] := ''; FDataGridResult.Rows[DataGrid.FocusedNode.Index].Cells[DataGrid.FocusedColumn].NewIsNull := True; DataGrid.RepaintNode(DataGrid.FocusedNode); end; {** Content of a grid cell was modified } procedure TMainForm.DataGridNewText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; NewText: WideString); var Row: PGridRow; begin Row := @FDataGridResult.Rows[Node.Index]; // Remember new value Row.Cells[Column].NewText := NewText; Row.Cells[Column].NewIsNull := False; Row.Cells[Column].Modified := True; // Set state of row for UPDATE mode, don't touch grsInserted if Row.State = grsDefault then FDataGridResult.Rows[Node.Index].State := grsModified; DataGridHasChanges := True; ValidateControls(Sender); end; {** Checks if there is a unique key available which can be used for UPDATEs and INSERTs } function TMainForm.CheckUniqueKeyClause: Boolean; var mres: Integer; begin Result := GetKeyColumns.Count > 0; if not Result then begin Screen.Cursor := crDefault; mres := MessageDlg('Grid editing and selective row operations are blocked because this table does not have a primary '+ 'or a unique key, or it only contains a unique key which allows NULLs which turns that '+ 'key to be non unique again. You can create or edit the keys using the index manager.'+CRLF+CRLF+ 'Press'+CRLF+ ' [Ok] to cancel editing and call the index manager'+CRLF+ ' [Cancel] to cancel editing.', mtWarning, [mbOK, mbCancel], 0); if mres = mrOK then actEditObjectExecute(actEditObject); end; end; {** DataGrid: node focus has changed } procedure TMainForm.DataGridChange(Sender: TBaseVirtualTree; Node: PVirtualNode); begin ValidateControls(Sender); end; {** DataGrid: node and/or column focus is about to change. See if we allow that. } procedure TMainForm.DataGridFocusChanging(Sender: TBaseVirtualTree; OldNode, NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed: Boolean); begin // Detect changed focus and update row if Assigned(OldNode) and (OldNode <> NewNode) then Allowed := DataGridPostUpdateOrInsert(OldNode) else Allowed := True; end; {** DataGrid: invoke update or insert routine } function TMainForm.DataGridPostUpdateOrInsert(Node: PVirtualNode): Boolean; begin Result := True; if Cardinal(High(FDataGridResult.Rows)) >= Node.Index then case FDataGridResult.Rows[Node.Index].State of grsModified: Result := GridPostUpdate(DataGrid); grsInserted: Result := GridPostInsert(DataGrid); end; end; {** DataGrid: compose and fire UPDATE query } function TMainForm.GridPostUpdate(Sender: TBaseVirtualTree): Boolean; var i: Integer; sql, Val: WideString; Row: PGridRow; begin sql := 'UPDATE '+mask(DataGridDB)+'.'+mask(DataGridTable)+' SET'; Row := @FDataGridResult.Rows[Sender.FocusedNode.Index]; for i := 0 to Length(FDataGridResult.Columns) - 1 do begin if Row.Cells[i].Modified then begin Val := Row.Cells[i].NewText; if FDataGridResult.Columns[i].DatatypeCat = dtcReal then Val := FloatStr(Val) else if FDataGridResult.Columns[i].DatatypeCat = dtcBinary then begin CheckHex(Copy(Val, 3), 'Invalid hexadecimal string given in field "' + FDataGridResult.Columns[i].Name + '".'); if Val = '0x' then Val := esc(''); end else Val := esc(Val); if Row.Cells[i].NewIsNull then Val := 'NULL'; sql := sql + ' ' + mask(FDataGridResult.Columns[i].Name) + '=' + Val + ', '; end; end; // Cut trailing comma sql := Copy(sql, 1, Length(sql)-2); sql := sql + ' WHERE ' + GetWhereClause(Row, @FDataGridResult.Columns); try // Send UPDATE query if (ExecUpdateQuery(sql, False, True) = 0) then begin MessageDlg('Your change did not affect any row! This can have several causes:' + CRLF + CRLF + 'a) Your changes were silently converted by the server. For instance, if you tried to ' + 'update an unsigned TINYINT field from its maximum value 255 to a higher value.' + CRLF + CRLF + 'b) The server could not find the source row because it was deleted ' + 'from outside.' + CRLF + CRLF + 'c) The server could not find the source row because its primary key fields were modified ' + 'from outside.', mtInformation, [mbOK], 0); end; Result := True; except Result := False; end; if Result then begin // Reselect just updated row in grid from server to ensure displaying // correct values which were silently converted by the server for i := 0 to Length(FDataGridResult.Columns) - 1 do begin if not Row.Cells[i].Modified then Continue; Row.Cells[i].Text := Row.Cells[i].NewText; Row.Cells[i].IsNull := Row.Cells[i].NewIsNull; end; GridFinalizeEditing(Sender); Row.Loaded := false; EnsureNodeLoaded(Sender, Sender.FocusedNode, GetWhereClause(Row, @FDataGridResult.Columns)); end; end; {** Repaint edited node and reset state of grid row } procedure TMainForm.GridFinalizeEditing(Sender: TBaseVirtualTree); var i, c: Integer; begin c := Sender.FocusedNode.Index; FDataGridResult.Rows[c].State := grsDefault; for i := 0 to Length(FDataGridResult.Rows[c].Cells) - 1 do begin FDataGridResult.Rows[c].Cells[i].NewText := ''; FDataGridResult.Rows[c].Cells[i].Modified := False; end; Sender.RepaintNode(Sender.FocusedNode); DataGridHasChanges := False; ValidateControls(Sender); end; {** Compose a WHERE clause used for UPDATEs and DELETEs } function TMainForm.GetWhereClause(Row: PGridRow; Columns: PGridColumns): WideString; var i, j: Integer; KeyVal: WideString; KeyCols: WideStrings.TWideStringlist; begin Result := ''; KeyCols := GetKeyColumns; for i := 0 to KeyCols.Count - 1 do begin for j := 0 to Length(Columns^) - 1 do begin if Columns^[j].Name = KeyCols[i] then break; end; // Find old value of key column KeyVal := Row.Cells[j].Text; // Quote if needed if FDataGridResult.Columns[j].DatatypeCat = dtcReal then KeyVal := FloatStr(KeyVal) else if FDataGridResult.Columns[j].DatatypeCat = dtcBinary then begin if KeyVal = '0x' then KeyVal := esc(''); end else KeyVal := esc(KeyVal); if Row.Cells[j].IsNull then KeyVal := ' IS NULL' else KeyVal := '=' + KeyVal; Result := Result + mask(KeyCols[i]) + KeyVal + ' AND '; end; // Cut trailing AND Result := Copy(Result, 1, Length(Result)-5); end; {** Find key columns for a WHERE clause by analysing a SHOW KEYS FROM ... resultset } function TMainForm.GetKeyColumns: WideStrings.TWideStringlist; var i: Integer; AllowsNull: Boolean; procedure FindColumns(const KeyName: WideString); begin // Find relevant key column names Result.Clear; SelectedTableKeys.First; while not SelectedTableKeys.Eof do begin if SelectedTableKeys.FieldByName('Key_name').AsWideString = KeyName then Result.Add(SelectedTableKeys.FieldByName('Column_name').AsWideString); SelectedTableKeys.Next; end; end; begin Result := WideStrings.TWideStringlist.Create; // Find best key for updates SelectedTableKeys.First; // 1. round: find a primary key while not SelectedTableKeys.Eof do begin if SelectedTableKeys.FieldByName('Key_name').AsWideString = 'PRIMARY' then begin FindColumns(SelectedTableKeys.FieldByName('Key_name').AsWideString); Exit; end; SelectedTableKeys.Next; end; // no primary key available -> 2. round: find a unique key SelectedTableKeys.First; while not SelectedTableKeys.Eof do begin if SelectedTableKeys.FieldByName('Non_unique').AsInteger = 0 then begin // We found a UNIQUE key - better than nothing. Check if one of the key // columns allows NULLs which makes it dangerous to use in UPDATES + DELETES. FindColumns(SelectedTableKeys.FieldByName('Key_name').AsWideString); SelectedTableColumns.First; AllowsNull := False; for i := 0 to Result.Count - 1 do begin while (not SelectedTableColumns.Eof) and (not AllowsNull) do begin if SelectedTableColumns.FieldByName('Field').AsWideString = Result[i] then AllowsNull := UpperCase(SelectedTableColumns.FieldByName('Null').AsString) = 'YES'; SelectedTableColumns.Next; end; if AllowsNull then break; end; if AllowsNull then Result.Clear else break; end; SelectedTableKeys.Next; end; end; {** DataGrid: compose and fire UPDATE query } procedure TMainForm.DataGridInsertRow; var i, j: Integer; begin // Scroll to the bottom to ensure we append the new row at the very last FDataGridResult chunk DataGrid.FocusedNode := DataGrid.GetLast; DataGrid.Repaint; // Steeling focus now to invoke posting a pending row update DataGrid.FocusedNode := nil; i := Length(FDataGridResult.Rows); SetLength(FDataGridResult.Rows, i+1); SetLength(FDataGridResult.Rows[i].Cells, Length(FDataGridResult.Columns)); FDataGridResult.Rows[i].State := grsInserted; for j := 0 to Length(FDataGridResult.Rows[i].Cells) - 1 do begin FDataGridResult.Rows[i].Cells[j].Text := ''; end; DataGrid.FocusedNode := DataGrid.AddChild(nil); DataGrid.ClearSelection; DataGrid.Selected[DataGrid.FocusedNode] := True; DataGridHasChanges := True; ValidateControls(DataGrid); end; {** DataGrid: compose and fire INSERT query } function TMainForm.GridPostInsert(Sender: TBaseVirtualTree): Boolean; var Row: PGridRow; sql, Cols, Val, Vals: WideString; i: Integer; Node: PVirtualNode; begin Node := Sender.FocusedNode; Row := @FDataGridResult.Rows[Node.Index]; Cols := ''; Vals := ''; for i := 0 to Length(FDataGridResult.Columns) - 1 do begin SelectedTableColumns.RecNo := i; if Row.Cells[i].Modified then begin Cols := Cols + mask(FDataGridResult.Columns[i].Name) + ', '; Val := Row.Cells[i].NewText; if FDataGridResult.Columns[i].DatatypeCat = dtcReal then Val := FloatStr(Val) else if FDataGridResult.Columns[i].DatatypeCat = dtcBinary then begin CheckHex(Copy(Val, 3), 'Invalid hexadecimal string given in field "' + FDataGridResult.Columns[i].Name + '".'); if Val = '0x' then Val := esc(''); end else Val := esc(Val); if Row.Cells[i].NewIsNull then Val := 'NULL'; Vals := Vals + Val + ', '; end; end; if Length(Cols) = 0 then begin // No field was manually modified, cancel the INSERT in that case Sender.BeginUpdate; Sender.DeleteNode(Node); SetLength(FDataGridResult.Rows, Length(FDataGridResult.Rows) - 1); Sender.EndUpdate; DataGridHasChanges := False; ValidateControls(Sender); Result := True; // Important for DataGridFocusChanging to allow moving focus end else begin // At least one field was modified, assume this INSERT should be posted Vals := Copy(Vals, 1, Length(Vals)-2); Cols := Copy(Cols, 1, Length(Cols)-2); sql := 'INSERT INTO '+mask(DataGridDB)+'.'+mask(DataGridTable)+' ('+Cols+') VALUES ('+Vals+')'; // Send INSERT query if (ExecUpdateQuery(sql) = 0) then begin MessageBox(Self.Handle, 'Server failed to insert row.', 'Error', 0); end; Result := True; Row.Loaded := false; EnsureNodeLoaded(Sender, Node, GetWhereClause(Row, @FDataGridResult.Columns)); GridFinalizeEditing(Sender); end; end; {** DataGrid: compose and fire DELETE query } function TMainForm.GridPostDelete(Sender: TBaseVirtualTree): Boolean; var Node: PVirtualNode; Nodes: TNodeArray; sql: WideString; Affected: Int64; Selected, i, j: Integer; msg: String; begin Node := Sender.GetFirstSelected; sql := 'DELETE FROM '+mask(SelectedTable.Text)+' WHERE'; while Assigned(Node) do begin EnsureChunkLoaded(Sender, Node); sql := sql + ' (' + GetWhereClause(@FDataGridResult.Rows[Node.Index], @FDataGridResult.Columns) + ') OR'; Node := Sender.GetNextSelected(Node); end; sql := Copy(sql, 1, Length(sql)-3); try // Send DELETE query ExecUpdateQuery(sql, False, True); Result := True; except Result := False; end; if Result then begin // Remove deleted row nodes out of the grid Affected := FMysqlConn.Connection.GetAffectedRowsFromLastPost; Selected := Sender.SelectedCount; if Affected = Selected then begin // Fine. Number of deleted rows equals the selected node count. // In this case, just remove the selected nodes, avoid a full reload Sender.BeginUpdate; Nodes := Sender.GetSortedSelection(True); for i:=High(Nodes) downto Low(Nodes) do begin for j := Nodes[i].Index to High(FDataGridResult.Rows)-1 do begin // Move upper rows by one so the selected row gets overwritten FDataGridResult.Rows[j] := FDataGridResult.Rows[j+1]; end; end; SetLength(FDataGridResult.Rows, Length(FDataGridResult.Rows) - Selected); Sender.DeleteSelectedNodes; Sender.EndUpdate; end else begin // Should never get called as we block DELETEs on tables without a unique key ViewData(Sender); msg := 'Warning: Consistency problem detected.' + CRLF + CRLF + 'The last DELETE query affected ' + FormatNumber(Affected) + ' rows, when it should have touched '+FormatNumber(Selected)+' row(s)!' + CRLF + CRLF + 'This is most likely caused by not having a primary key in the table''s definition.'; LogSQL( msg ); MessageDlg( msg, mtWarning, [mbOK], 0); end; end; end; {** DataGrid: cancel INSERT or UPDATE mode, reset modified node data } procedure TMainForm.DataGridCancel(Sender: TObject); var i: Integer; begin case FDataGridResult.Rows[DataGrid.FocusedNode.Index].State of grsModified: GridFinalizeEditing(DataGrid); grsInserted: begin i := Length(FDataGridResult.Rows); DataGrid.DeleteNode(DataGrid.FocusedNode, False); SetLength(FDataGridResult.Rows, i-1); // Focus+select last node if possible actDataLastExecute(Sender); end; end; DataGridHasChanges := False; ValidateControls(Sender); end; procedure TMainForm.GridKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); var g: TVirtualStringTree; begin g := TVirtualStringTree(Sender); case Key of VK_HOME: g.FocusedColumn := 0; VK_END: g.FocusedColumn := g.Header.Columns.Count-1; VK_RETURN: if Assigned(g.FocusedNode) then g.EditNode(g.FocusedNode, g.FocusedColumn); VK_DOWN: if (g = DataGrid) and Assigned(g.FocusedNode) and (g.FocusedNode.Index = g.RootNodeCount-1) then actDataInsertExecute(Sender); end; end; // TODO: Version of EnsureFullWidth() that fetches all width limited columns // for a row, and fetches 500 rows at a time, for use with GridTo{Xml,Csv,Html}. // Would reduce number of database roundtrips; also the per-query overhead // right now is horrendous for some reason (thinking mysqlquerythread). function TMainForm.EnsureFullWidth(Grid: TBaseVirtualTree; Column: TColumnIndex; Node: PVirtualNode): Boolean; var Data: PGridResult; Cell: PGridCell; Row: PGridRow; Col: PGridColumn; sql: WideString; len: Int64; ds: TDataSet; begin Result := True; // Only the data grid uses delayed loading of full-width data. if Grid <> DataGrid then Exit; Data := @FDataGridResult; // Load entire data for field. Col := @Data.Columns[Column]; Row := @Data.Rows[Node.Index]; Cell := @Data.Rows[Node.Index].Cells[Column]; len := Length(Cell.Text); // Recalculate due to textual formatting of raw binary data. if (Col.DatatypeCat = dtcBinary) and (len > 2) then len := (len - 2) div 2; // Assume width limit in effect if data exactly at limit threshold. if len = GridMaxData then begin if CheckUniqueKeyClause then begin sql := 'SELECT ' + mask(Col.Name) + ' FROM ' + mask(SelectedTable.Text) + ' WHERE ' + GetWhereClause(Row, @Data.Columns) ; ds := GetResults(sql); if Col.DatatypeCat = dtcBinary then Cell.Text := '0x' + BinToWideHex(ds.Fields[0].AsString) else Cell.Text := ds.Fields[0].AsWideString; Cell.IsNull := ds.Fields[0].IsNull; end else Result := False; end; end; procedure TMainForm.DataGridEditing(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean); begin Allowed := True; if FDataGridResult.Rows[Node.Index].State = grsDefault then Allowed := CheckUniqueKeyClause; if Allowed then begin // Move Esc shortcut from "Cancel row editing" to "Cancel cell editing" actDataCancelChanges.ShortCut := 0; actDataPostChanges.ShortCut := 0; EnsureFullWidth(Sender, Column, Node); end; end; procedure TMainForm.DataGridEdited(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; AutoCalcColWidths(DataGrid, PrevTableColWidths); end; procedure TMainForm.DataGridEditCancelled(Sender: TBaseVirtualTree; Column: TColumnIndex); begin // Reassign Esc to "Cancel row editing" action actDataCancelChanges.ShortCut := TextToShortcut('Esc'); actDataPostChanges.ShortCut := TextToShortcut('Ctrl+Enter'); end; procedure TMainForm.DataGridCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink); var MemoEditor: TMemoEditorLink; DateTimeEditor: TDateTimeEditorLink; EnumEditor: TEnumEditorLink; SetEditor: TSetEditorLink; InplaceEditor: TInplaceEditorLink; TypeCat: TDatatypeCategoryIndex; begin TypeCat := FDataGridResult.Columns[Column].DatatypeCat; if TypeCat = dtcText then begin InplaceEditor := TInplaceEditorLink.Create(Sender as TVirtualStringTree); InplaceEditor.MaxLength := FDataGridResult.Columns[Column].MaxLength; InplaceEditor.ButtonVisible := true; EditLink := InplaceEditor; end else if (TypeCat = dtcBinary) and prefEnableBinaryEditor then begin MemoEditor := TMemoEditorLink.Create; MemoEditor.MaxLength := FDataGridResult.Columns[Column].MaxLength; EditLink := MemoEditor; end else if (TypeCat = dtcTemporal) and prefEnableDatetimeEditor then begin DateTimeEditor := TDateTimeEditorLink.Create; DateTimeEditor.Datatype := FDataGridResult.Columns[Column].Datatype; EditLink := DateTimeEditor; end else if (TypeCat = dtcIntegerNamed) and prefEnableEnumEditor then begin EnumEditor := TEnumEditorLink.Create; EnumEditor.ValueList := FDataGridResult.Columns[Column].ValueList; EditLink := EnumEditor; end else if (TypeCat = dtcSetNamed) and prefEnableSetEditor then begin SetEditor := TSetEditorLink.Create; SetEditor.ValueList := FDataGridResult.Columns[Column].ValueList; EditLink := SetEditor; end else begin InplaceEditor := TInplaceEditorLink.Create(Sender as TVirtualStringTree); InplaceEditor.ButtonVisible := False; EditLink := InplaceEditor; end; end; function TMainForm.GetSelectedTableColumns: TDataset; begin if (FSelectedTableColumns = nil) or (FSelectedTableColumns.State = dsInactive) then begin FreeAndNil(FSelectedTableColumns); // Avoid SQL error on routines if GetFocusedTreeNodeType in [lntTable, lntView] then begin ShowStatus('Reading table columns ...'); FSelectedTableColumns := GetResults( 'SHOW /*!32332 FULL */ COLUMNS FROM ' + mask(SelectedTable.Text), false ); end; end; Result := FSelectedTableColumns; end; function TMainForm.GetSelectedTableKeys: TDataset; begin if (FSelectedTableKeys = nil) or (FSelectedTableKeys.State = dsInactive) then begin FreeAndNil(FSelectedTableKeys); // Avoid SQL error on routines if GetFocusedTreeNodeType in [lntTable, lntView] then begin ShowStatus('Reading table keys ...'); FSelectedTableKeys := GetResults( 'SHOW KEYS FROM ' + mask(SelectedTable.Text) ); end; end; Result := FSelectedTableKeys; end; procedure TMainForm.menuShowSizeColumnClick(Sender: TObject); var NewVal: Boolean; begin NewVal := not TMenuItem(Sender).Checked; TMenuItem(Sender).Checked := newVal; if NewVal then DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options + [coVisible] else DBtree.Header.Columns[1].Options := DBtree.Header.Columns[1].Options - [coVisible]; OpenRegistry; MainReg.WriteBool(REGNAME_SIZECOL_TREE, NewVal); end; procedure TMainForm.AutoCalcColWidths(Tree: TVirtualStringTree; PrevLayout: Widestrings.TWideStringlist = nil); var Node: PVirtualNode; i, j, ColTextWidth: 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 Tree.BeginUpdate; try // Weird: Fixes first time calculation always based on Tahoma/8pt font Tree.Canvas.Font := Tree.Font; for i := 0 to Tree.Header.Columns.Count - 1 do begin Col := Tree.Header.Columns[i]; if not (coVisible in Col.Options) then continue; if (PrevLayout <> nil) and (PrevLayout.IndexOfName(Col.Text) > -1) then begin Col.Width := MakeInt(PrevLayout.Values[Col.Text]); continue; end; ColTextWidth := Tree.Canvas.TextWidth(Tree.Header.Columns[i].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 j := 0; if Assigned(Tree.FocusedNode) then begin Node := Tree.FocusedNode; while Assigned(Node) do begin inc(j); if (Node = Tree.GetFirst) or (j > 50) then break; Node := Tree.GetPreviousVisible(Node); end; end; j := 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, i, True, True); ColTextWidth := Max(ColTextWidth, Rect.Right - Rect.Left); inc(j); if j > 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 + 5; ColTextWidth := Min(ColTextWidth, prefMaxColWidth); Col.Width := ColTextWidth; end; finally Tree.EndUpdate; end; end; procedure TMainForm.DataGridColumnResize(Sender: TVTHeader; Column: TColumnIndex); var col: TVirtualTreeColumn; begin // Avoid AVs if Column < 0 then Exit; // Don't waste time storing changes while a column is automatically resized if tsUpdating in Sender.Treeview.TreeStates then Exit; if PrevTableColWidths = nil then PrevTableColWidths := WideStrings.TWideStringList.Create; col := Sender.Columns[Column]; PrevTableColWidths.Values[col.Text] := inttostr(col.Width); end; procedure TMainForm.GridBeforeCellPaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex; CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect); var gr: PGridResult; begin if Column = -1 then Exit; if Sender = DataGrid then gr := @FDataGridResult else gr := @FQueryGridResult; EnsureChunkLoaded(Sender, Node); if (Node = Sender.FocusedNode) and (Column = Sender.FocusedColumn) then begin TargetCanvas.Brush.Color := clHighlight; TargetCanvas.FillRect(CellRect); end else if vsSelected in Node.States then begin TargetCanvas.Brush.Color := $0040FFFF; TargetCanvas.FillRect(CellRect); end else if prefEnableNullBG and gr.Rows[Node.Index].Cells[Column].IsNull then begin TargetCanvas.Brush.Color := prefNullBG; TargetCanvas.FillRect(CellRect); end; end; procedure TMainForm.FillDataViewPopup; var i: Integer; DataViews: TStringList; mi: TMenuItem; begin // Load all view names into popupmenu for i := popupDataView.Items.Count-1 downto 0 do begin if popupDataView.Items[i].Caption = '-' then break; popupDataView.Items.Delete(i); end; // Unhide "Load xyz by default" item if default is set menuViewDefault.Visible := False; OpenRegistry; if MainReg.OpenKey(GetRegKeyTable, False) then begin if MainReg.ValueExists(REGNAME_DEFAULTVIEW) then begin menuViewDefault.Caption := 'Load view "'+MainReg.ReadString(REGNAME_DEFAULTVIEW)+'" by default'; menuViewDefault.Visible := True; end; end; // Add views DataViews := TStringList.Create; GetDataViews(DataViews); for i := 0 to DataViews.Count - 1 do begin mi := TMenuItem.Create(popupDataView); mi.Caption := DataViews[i]; mi.OnClick := DataViewClick; popupDataView.Items.Add(mi); end; // Highlight drop down button if views are available if DataViews.Count = 0 then tbtnDataView.ImageIndex := 113 else tbtnDataView.ImageIndex := 112; end; procedure TMainForm.popupDataViewPopup(Sender: TObject); begin // Only enable "Save view" menu if any view part is set menuViewSave.Enabled := (FDataGridSelect.Count > 0) or (Length(FDataGridSort)>0) or (SynMemoFilter.GetTextLen > 0); end; procedure TMainForm.GetDataViews(List: TStrings); var i: Integer; begin // Load all view names into popupmenu OpenRegistry; if MainReg.OpenKey(GetRegKeyTable, False) then begin MainReg.GetKeyNames(List); for i := List.Count - 1 downto 0 do begin if Copy(List[i], 0, Length(REGPREFIX_DATAVIEW)) <> REGPREFIX_DATAVIEW then List.Delete(i) else List[i] := Copy(List[i], Length(REGPREFIX_DATAVIEW)+1, Length(List[i])); end; end; end; procedure TMainForm.menuViewSaveClick(Sender: TObject); var frm: TFrmDataViewSave; begin frm := TFrmDataViewSave.Create(Self); if frm.ShowModal = mrOK then FillDataViewPopup; frm.Free; end; procedure TMainForm.menuViewDefaultClick(Sender: TObject); begin menuViewDefault.Visible := False; OpenRegistry; if MainReg.OpenKey(GetRegKeyTable, False) then begin if MainReg.ValueExists(REGNAME_DEFAULTVIEW) then MainReg.DeleteValue(REGNAME_DEFAULTVIEW) end; end; procedure TMainForm.DataViewClick(Sender: TObject); begin LoadDataView((Sender as TMenuItem).Caption); ViewData(tbtnDataView); end; procedure TMainForm.LoadDataView(ViewName: String); var rx: TRegExpr; idx, i: Integer; Col: WideString; HiddenCols: TWideStringList; begin OpenRegistry; if MainReg.OpenKey(GetRegKeyTable + '\' + REGPREFIX_DATAVIEW + ViewName, False) then begin // Columns HiddenCols := TWideStringlist.Create; HiddenCols.Delimiter := REGDELIM; HiddenCols.StrictDelimiter := True; HiddenCols.DelimitedText := Utf8Decode(MainReg.ReadString(REGNAME_HIDDENCOLUMNS)); SelectedTableColumns.First; FDataGridSelect.Clear; for i := 0 to SelectedTableColumns.RecordCount - 1 do begin Col := SelectedTableColumns.Fields[0].AsWideString; if HiddenCols.IndexOf(Col) = -1 then FDataGridSelect.Add(Col); SelectedTableColumns.Next; end; FreeAndNil(HiddenCols); // Filter SynMemoFilter.Text := Utf8Decode(MainReg.ReadString(REGNAME_FILTER)); if SynMemoFilter.GetTextLen > 0 then ToggleFilterPanel(True); // Sort SetLength(FDataGridSort, 0); rx := TRegExpr.Create; rx.Expression := '\b(\d)_(.+)\'+REGDELIM; rx.ModifierG := False; if rx.Exec(Utf8Decode(MainReg.ReadString(REGNAME_SORT))) then while true do begin idx := Length(FDataGridSort); SetLength(FDataGridSort, idx+1); FDataGridSort[idx] := TOrderCol.Create; FDataGridSort[idx].ColumnName := rx.Match[2]; FDataGridSort[idx].SortDirection := StrToIntDef(rx.Match[1], ORDER_ASC); if not rx.ExecNext then break; end; end; end; function TMainForm.GetRegKeyTable: String; begin // Return the slightly complex registry path to \Servers\ThisServer\curdb|curtable Result := REGPATH + REGKEY_SESSIONS + SessionName + '\' + Utf8Encode(ActiveDatabase) + REGDELIM + Utf8Encode(SelectedTable.Text); end; procedure TMainForm.QueryGridFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex); begin ValidateControls(Sender); end; procedure TMainForm.pnlQueryHelpersCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); begin // Ensure minimum width for query helpers while resizing Resize := NewWidth >= 20; end; procedure TMainForm.pnlQueryMemoCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); begin // Ensure visibility of query memo while resizing Resize := NewWidth >= pnlQueryHelpers.Width + spltQueryHelpers.Width + 40; end; procedure TMainForm.DataGridMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var Grid: TVirtualStringTree; Hit: THitInfo; 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 DataGridPostUpdateOrInsert(Grid.FocusedNode); end; procedure TMainForm.ListVariablesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); var i : Integer; vt: TVirtualStringTree; ds: TDataSet; Sel: TWideStringList; begin // Display server variables vt := Sender as TVirtualStringTree; if vt.Tag <> VTREE_NOTLOADED then Exit; Sel := GetVTCaptions(vt, True); ResetVTNodes(vt); Screen.Cursor := crHourglass; ds := GetResults('SHOW VARIABLES'); SetLength(VTRowDataListVariables, ds.RecordCount); for i:=1 to ds.RecordCount do begin VTRowDataListVariables[i-1].ImageIndex := 25; VTRowDataListVariables[i-1].Captions := WideStrings.TWideStringList.Create; VTRowDataListVariables[i-1].Captions.Add( ds.Fields[0].AsWideString ); VTRowDataListVariables[i-1].Captions.Add( ds.Fields[1].AsWideString ); ds.Next; end; ds.Close; FreeAndNil(ds); vt.RootNodeCount := Length(VTRowDataListVariables); vt.SortTree(vt.Header.SortColumn, vt.Header.SortDirection); vt.Tag := VTREE_LOADED; SetVTSelection(vt, Sel); // Apply or reset filter editFilterVTChange(Sender); // Display number of listed values on tab tabVariables.Caption := 'Variables (' + IntToStr(vt.RootNodeCount) + ')'; Screen.Cursor := crDefault; end; procedure TMainForm.ListStatusBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); var i: Integer; valcount: Int64; tmpval: Double; ds: TDataSet; val, avg_perhour, avg_persec: WideString; valIsBytes, valIsNumber: Boolean; vt: TVirtualStringTree; Sel: TWideStringList; begin // Display server status key/value pairs vt := Sender as TVirtualStringTree; if vt.Tag <> VTREE_NOTLOADED then Exit; Sel := GetVTCaptions(vt, True); ResetVTNodes(vt); Screen.Cursor := crHourglass; ds := GetResults( 'SHOW /*!50002 GLOBAL */ STATUS' ); SetLength(VTRowDataListStatus, ds.RecordCount); for i:=1 to ds.RecordCount do begin VTRowDataListStatus[i-1].ImageIndex := 25; VTRowDataListStatus[i-1].Captions := WideStrings.TWideStringList.Create; VTRowDataListStatus[i-1].Captions.Add( ds.Fields[0].AsWideString ); val := ds.Fields[1].AsWideString; avg_perhour := ''; avg_persec := ''; // Detect value type valIsNumber := IntToStr(MakeInt(val)) = val; valIsBytes := valIsNumber and (Copy(ds.Fields[0].AsWideString, 1, 6) = 'Bytes_'); // Calculate average values ... if valIsNumber then begin valCount := MakeInt(val); // ... per hour tmpval := valCount / ( ServerUptime / 60 / 60 ); if valIsBytes then avg_perhour := FormatByteNumber( Trunc(tmpval) ) else avg_perhour := FormatNumber( tmpval, 1 ); // ... per second tmpval := valCount / ServerUptime; if valIsBytes then avg_persec := FormatByteNumber( Trunc(tmpval) ) else avg_persec := FormatNumber( tmpval, 1 ); end; // Format numeric or byte values if valIsBytes then val := FormatByteNumber(val) else if valIsNumber then val := FormatNumber(val); VTRowDataListStatus[i-1].Captions.Add( val ); VTRowDataListStatus[i-1].Captions.Add(avg_perhour); VTRowDataListStatus[i-1].Captions.Add(avg_persec); ds.Next; end; ds.Close; FreeAndNil(ds); // Tell VirtualTree the number of nodes it will display vt.RootNodeCount := Length(VTRowDataListStatus); vt.SortTree(vt.Header.SortColumn, vt.Header.SortDirection); vt.Tag := VTREE_LOADED; SetVTSelection(vt, Sel); // Apply or reset filter editFilterVTChange(Sender); // Display number of listed values on tab tabStatus.Caption := 'Status (' + IntToStr(vt.RootNodeCount) + ')'; Screen.Cursor := crDefault; end; procedure TMainForm.ListProcessesBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); var i, j: Integer; ds: TDataSet; vt: TVirtualStringTree; Sel: TWideStringList; begin // Display client threads vt := Sender as TVirtualStringTree; if vt.Tag <> VTREE_NOTLOADED then Exit; Sel := GetVTCaptions(vt, True); ResetVTNodes(vt); Screen.Cursor := crHourglass; try ds := GetResults('SHOW FULL PROCESSLIST', false, false); SetLength(VTRowDataListProcesses, ds.RecordCount); for i:=1 to ds.RecordCount do begin VTRowDataListProcesses[i-1].Captions := WideStrings.TWideStringList.Create; VTRowDataListProcesses[i-1].Captions.Add( ds.Fields[0].AsWideString ); if AnsiCompareText( ds.Fields[4].AsString, 'Killed') = 0 then VTRowDataListProcesses[i-1].ImageIndex := 26 // killed else begin if ds.FindField('Info').AsString = '' then VTRowDataListProcesses[i-1].ImageIndex := 55 // idle else VTRowDataListProcesses[i-1].ImageIndex := 57 // running query end; for j := 1 to 7 do VTRowDataListProcesses[i-1].Captions.Add(ds.Fields[j].AsWideString); ds.Next; end; ds.Close; FreeAndNil(ds); vt.RootNodeCount := Length(VTRowDataListProcesses); vt.SortTree(vt.Header.SortColumn, vt.Header.SortDirection); vt.Tag := VTREE_LOADED; SetVTSelection(vt, Sel); // Apply or reset filter editFilterVTChange(Sender); // Display number of listed values on tab tabProcessList.Caption := 'Process-List (' + IntToStr(vt.RootNodeCount) + ')'; except on E: Exception do begin LogSQL('Error loading process list (automatic refresh disabled): ' + e.Message); TimerRefresh.Enabled := false; end; end; Screen.Cursor := crDefault; end; procedure TMainForm.ListCommandStatsBeforePaint(Sender: TBaseVirtualTree; TargetCanvas: TCanvas); procedure addLVitem( idx: Integer; caption: WideString; commandCount: Int64; totalCount: Int64 ); var tmpval : Double; begin VTRowDataListCommandStats[idx].ImageIndex := 25; VTRowDataListCommandStats[idx].Captions := WideStrings.TWideStringList.Create; caption := Copy( caption, 5, Length(caption) ); caption := WideStringReplace( caption, '_', ' ', [rfReplaceAll] ); VTRowDataListCommandStats[idx].Captions.Add( caption ); // Total Frequency VTRowDataListCommandStats[idx].Captions.Add( FormatNumber( commandCount ) ); // Average per hour tmpval := commandCount / ( ServerUptime / 60 / 60 ); VTRowDataListCommandStats[idx].Captions.Add( FormatNumber( tmpval, 1 ) ); // Average per second tmpval := commandCount / ServerUptime; VTRowDataListCommandStats[idx].Captions.Add( FormatNumber( tmpval, 1 ) ); // Percentage. Take care of division by zero errors and Int64's if commandCount < 1 then commandCount := 1; if totalCount < 1 then totalCount := 1; tmpval := 100 / totalCount * commandCount; VTRowDataListCommandStats[idx].Captions.Add( FormatNumber( tmpval, 1 ) + ' %' ); end; var i: Integer; questions: Int64; ds: TDataSet; vt: TVirtualStringTree; Sel: TWideStringList; begin // Display command statistics vt := Sender as TVirtualStringTree; if vt.Tag <> VTREE_NOTLOADED then Exit; Sel := GetVTCaptions(vt, True); ResetVTNodes(vt); Screen.Cursor := crHourglass; ds := GetResults('SHOW /*!50002 GLOBAL */ STATUS LIKE ''Com\_%''' ); questions := MakeInt(GetVar('SHOW /*!50002 GLOBAL */ STATUS LIKE ''Questions''', 1)); if questions = 0 then Raise Exception.Create('Could not detect value of "Questions" status. Command statistics are not available.'); SetLength(VTRowDataListCommandStats, ds.RecordCount+1); addLVitem(0, ' All commands', questions, questions ); for i:=1 to ds.RecordCount do begin addLVitem(i, ds.Fields[0].AsWideString, MakeInt(ds.Fields[1].AsString), questions ); ds.Next; end; ds.Close; FreeAndNil(ds); // Tell VirtualTree the number of nodes it will display vt.RootNodeCount := Length(VTRowDataListCommandStats); vt.SortTree(vt.Header.SortColumn, vt.Header.SortDirection); vt.Tag := VTREE_LOADED; SetVTSelection(vt, Sel); // Apply or reset filter editFilterVTChange(Sender); // Display number of listed values on tab tabCommandStats.Caption := 'Command-Statistics (' + IntToStr(vt.RootNodeCount) + ')'; Screen.Cursor := crDefault; end; procedure TMainForm.actCopyOrCutExecute(Sender: TObject); var Control: TWinControl; Edit: TCustomEdit; Grid: TVirtualStringTree; SynMemo: TSynMemo; Success, DoCut: Boolean; begin // Copy text from a focused control to clipboard Success := False; Control := Screen.ActiveControl; // Do not handle Search/replace dialog if not Control.Focused then Exit; DoCut := Sender = actCut; if Control is TCustomEdit then begin Edit := TCustomEdit(Control); if Edit.SelLength > 0 then begin if DoCut then Edit.CutToClipboard else Edit.CopyToClipboard; Success := True; end; end else if Control is TVirtualStringTree then begin Grid := Control as TVirtualStringTree; if Assigned(Grid.FocusedNode) then begin if Grid = ActiveGrid then EnsureFullWidth(Grid, Grid.FocusedColumn, Grid.FocusedNode); CopyToClipboard(Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]); if (Grid = ActiveGrid) and DoCut then Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := ''; Success := True; end; end else if Control is TSynMemo then begin SynMemo := Control as TSynMemo; if SynMemo.SelAvail then begin if DoCut then SynMemo.CutToClipboard else SynMemo.CopyToClipboard; Success := True; end; end; if not Success then MessageBeep(MB_ICONASTERISK); end; procedure TMainForm.actPasteExecute(Sender: TObject); var Control: TWinControl; Edit: TCustomEdit; Grid: TVirtualStringTree; SynMemo: TSynMemo; Success: Boolean; CB: TUniClipboard; begin // Paste text into the focused control Success := False; Control := Screen.ActiveControl; // Do not handle Search/replace dialog if not Control.Focused then Exit; 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 TVirtualStringTree then begin Grid := Control as TVirtualStringTree; if Assigned(Grid.FocusedNode) and (Grid = ActiveGrid) then begin CB := TUniClipboard.Create; Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := CB.AsWideString; Success := True; end; end else if Control is TSynMemo then begin SynMemo := TSynMemo(Control); if not SynMemo.ReadOnly then begin SynMemo.PasteFromClipboard; Success := True; end; end; if not Success then MessageBeep(MB_ICONASTERISK); end; procedure TMainForm.actSelectAllExecute(Sender: TObject); var Control: TWinControl; Grid: TVirtualStringTree; ListBox: TTNTListBox; Success: Boolean; begin // Select all items, text or whatever Success := False; Control := Screen.ActiveControl; // Do not handle Search/replace dialog if not Control.Focused then Exit; 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 TTNTListBox then begin ListBox := TTNTListBox(Control); if ListBox.MultiSelect then begin ListBox.SelectAll; Success := True; end; end; if not Success then MessageBeep(MB_ICONASTERISK); end; procedure TMainForm.EnumerateRecentFilters; var flt: TStringList; i: Integer; item: TMenuItem; rx: TRegExpr; capt: 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 if MainReg.OpenKey(GetRegKeyTable+'\'+REGNAME_FILTERS, False) then begin flt := TStringList.Create; rx := TRegExpr.Create; rx.Expression := '\s+'; MainReg.GetValueNames(flt); for i := 0 to flt.Count - 1 do begin item := TMenuItem.Create(popupFilter); capt := MainReg.ReadString(flt[i]); capt := rx.Replace(capt, ' ', True); item.Hint := capt; item.Caption := sstr(capt, 50); item.Tag := MakeInt(flt[i]); item.OnClick := LoadRecentFilter; menuRecentFilters.Add(item); capt := Utf8Decode(capt); comboRecentFilters.Items.Add(sstr(capt, 100)); end; FreeAndNil(rx); FreeAndNil(flt); 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; 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 TTNTComboBox).ItemIndex+1; if MainReg.OpenKey(GetRegKeyTable+'\'+REGNAME_FILTERS, False) then begin SynMemoFilter.UndoList.AddGroupBreak; SynMemoFilter.BeginUpdate; SynMemoFilter.SelectAll; SynMemoFilter.SelText := Utf8Decode( MainReg.ReadString(IntToStr(key)) ); SynMemoFilter.EndUpdate; end; end; procedure TMainForm.actCreateRoutineExecute(Sender: TObject); begin tabEditor.TabVisible := True; PagecontrolMain.ActivePage := tabEditor; PlaceObjectEditor(lntProcedure); RoutineEditor.Init; end; procedure TMainForm.DataGridScroll(Sender: TBaseVirtualTree; DeltaX, DeltaY: Integer); var query: String; count: Int64; begin // If the user moves the scrollbar all the way to the bottom of the data grid, // for example by pressing CTRL+END, jump to the bottom of table data. if ReachedEOT then Exit; if tsThumbTracking in Sender.TreeStates then Exit; if Int64(- Sender.OffsetY - DeltaY) < Int64(Sender.RootNode.TotalHeight) then Exit; // First, figure out how many rows the table contains. ShowStatus('Counting rows...'); query := 'SELECT COUNT(*)' + DataGridCurrentFrom; if DataGridCurrentFilter <> '' then query := query + ' WHERE ' + DataGridCurrentFilter; try count := MakeInt(GetVar(query)); // Work around a memory allocation bug in VirtualTree. if count > prefMaxTotalRows then count := prefMaxTotalRows; except on E: Exception do begin MessageDlg(E.Message, mtError, [mbOK], 0); Exit; end; end; ShowStatus(STATUS_MSG_READY); // Then, adjust the data grid and data containers. debug('mem: initializing browse rows (internal data).'); try SetLength(FDataGridResult.Rows, count); debug('mem: initializing browse rows (grid).'); DataGrid.RootNodeCount := count; ReachedEOT := True; DisplayRowCountStats(count); except DataGrid.RootNodeCount := 0; SetLength(FDataGridResult.Rows, 0); PageControlMain.ActivePage := tabDatabase; raise; end; // Finally, jump to the last row. Sender.ScrollIntoView(Sender.GetLast, False); end; procedure TMainForm.DBtreeExpanded(Sender: TBaseVirtualTree; Node: PVirtualNode); begin // Auto resize "Size" column in dbtree when needed // See also OnInitChildren if coVisible in DBtree.Header.Columns[1].Options then DBtree.Header.AutoFitColumns(False, smaUseColumnOption, 1, 1); end; function TMainform.GetCollations(Items: TWideStrings = nil): TDataset; begin // Return cached collation list, used in several places, e.g. table editor if (dsCollations = nil) or (dsCollations.State = dsInactive) then begin FreeAndNil(dsCollations); dsCollations := GetResults('SHOW COLLATION', True); end; if Assigned(dsCollations) then begin dsCollations.First; if Assigned(Items) then begin while not dsCollations.Eof do begin Items.Add(dsCollations.FieldByName('Collation').AsWideString); dsCollations.Next; end; dsCollations.First; end; end; Result := dsCollations; end; procedure TMainForm.PlaceObjectEditor(Which: TListNodeType); var frm: TFrame; begin // Place the relevant editor frame onto the editor tab, hide all others if (not (Which in [lntTable, lntCrashedTable])) and Assigned(TableEditor) then FreeAndNil(TableEditor); if (Which <> lntView) and Assigned(ViewEditor) then FreeAndNil(ViewEditor); if (not (Which in [lntProcedure, lntFunction])) and Assigned(RoutineEditor) then FreeAndNil(RoutineEditor); if Which in [lntTable, lntCrashedTable] then begin if not Assigned(TableEditor) then TableEditor := TfrmTableEditor.Create(tabEditor); frm := TableEditor; end else if Which = lntView then begin if not Assigned(ViewEditor) then ViewEditor := TfrmView.Create(tabEditor); frm := ViewEditor; end else if Which in [lntProcedure, lntFunction] then begin if not Assigned(RoutineEditor) then RoutineEditor := TfrmRoutineEditor.Create(tabEditor); frm := RoutineEditor; end else Exit; frm.Parent := tabEditor; end; procedure TMainForm.SetEditorTabCaption(Editor: TFrame; ObjName: WideString); var ObjType, Cap: WideString; IconIndex: Integer; begin if Editor = TableEditor then begin ObjType := 'Table'; IconIndex := ICONINDEX_TABLE; end else if Editor = ViewEditor then begin ObjType := 'View'; IconIndex := ICONINDEX_VIEW; end else if Editor = RoutineEditor then begin ObjType := 'Routine'; IconIndex := ICONINDEX_STOREDPROCEDURE; end else Exit; tabEditor.ImageIndex := IconIndex; Cap := ObjType+': '; if ObjName = '' then Cap := Cap + '[Untitled]' else Cap := sstr(Cap + ObjName, 30); tabEditor.Caption := Cap; end; procedure TMainForm.actEditObjectExecute(Sender: TObject); var NodeData: PVTreeData; RoutineType: String; begin debug('actEditObjectExecute()'); if ListTables.Focused then begin // Got here from ListTables.OnDblClick or ListTables's context menu item "Edit" NodeData := ListTables.GetNodeData(ListTables.FocusedNode); if (NodeData.Captions[0] <> SelectedTable.Text) or (NodeData.NodeType <> SelectedTable.NodeType) then SelectDBObject(NodeData.Captions[0], NodeData.NodeType); end; case GetFocusedTreeNodeType of lntDb: begin if CreateDatabaseForm = nil then CreateDatabaseForm := TCreateDatabaseForm.Create(Self); CreateDatabaseForm.modifyDB := ActiveDatabase; CreateDatabaseForm.ShowModal; end; lntTable, lntCrashedTable: begin PlaceObjectEditor(SelectedTable.NodeType); TableEditor.Init(SelectedTable.Text); end; lntView: begin PlaceObjectEditor(SelectedTable.NodeType); ViewEditor.Init(SelectedTable.Text); end; lntFunction, lntProcedure: begin PlaceObjectEditor(SelectedTable.NodeType); if SelectedTable.NodeType = lntFunction then RoutineType := 'FUNCTION' else RoutineType := 'PROCEDURE'; RoutineEditor.Init(SelectedTable.Text, RoutineType); end; end; end; procedure TMainForm.ListTablesDblClick(Sender: TObject); var NodeData: PVTreeData; begin // DoubleClick: Display editor debug('ListTablesDblClick()'); if Assigned(ListTables.FocusedNode) then begin NodeData := ListTables.GetNodeData(ListTables.FocusedNode); SelectDBObject(ListTables.Text[ListTables.FocusedNode, ListTables.FocusedColumn], NodeData.NodeType); end; end; procedure TMainform.ResetSelectedTableStuff; begin // Free selected table's cached column and key list FreeAndNil(FSelectedTableColumns); FreeAndNil(FSelectedTableKeys); end; end.