opensource/HeidiSQL
1
0
Fork 0
mirror of https://github.com/HeidiSQL/HeidiSQL.git synced 2025-08-06 18:24:26 +08:00
Code Issues Packages Projects Releases Wiki Activity
Files
HeidiSQL/source/childwin.pas

6537 lines
222 KiB
ObjectPascal
Raw Blame History

unit Childwin;
// -------------------------------------
// MDI-Child-Window
// -------------------------------------
interface
uses
Synchronization,
Contnrs,
Windows, Classes, Graphics, Forms, Controls, StdCtrls,
ExtCtrls, ComCtrls, ImgList, SysUtils, Dialogs, Menus,
SynEdit, SynMemo, SynEditHighlighter, SynHighlighterSQL, SynEditSearch,
SynEditTypes, Clipbrd,
Buttons, CheckLst, ToolWin, Db,
helpers,
ZDataset,
ZAbstractRODataset, ZConnection,
ZSqlMonitor, ZDbcLogging,
SynCompletionProposal, HeidiComp, SynEditMiscClasses, MysqlQuery,
MysqlQueryThread, queryprogress, communication, MysqlConn, Tabs,
VirtualTrees, createdatabase, tbl_properties, createtable,
SynRegExpr, EditVar, PngSpeedButton, WideStrings, WideStrUtils, SynUnicode,
TntStdCtrls;
type
TOrderCol = class(TObject)
ColumnName: WideString;
SortDirection: Byte;
end;
TOrderColArray = Array of TOrderCol;
type
TMDIChild = class(TForm)
panelTop: TPanel;
DBtree: TVirtualStringTree;
Splitter1: TSplitter;
PageControlMain: TPageControl;
tabData: TTabSheet;
tabDatabase: TTabSheet;
splitterTopBottom: TSplitter;
tabQuery: TTabSheet;
popupTreeView: TPopupMenu;
menuRefreshDBTree: TMenuItem;
tabTable: TTabSheet;
popupDbGrid: TPopupMenu;
menuproperties: TMenuItem;
menudroptable: TMenuItem;
menuemptytable: TMenuItem;
tabHost: TTabSheet;
PageControlHost: TPageControl;
tabVariables: TTabSheet;
tabProcessList: TTabSheet;
ListVariables: TVirtualStringTree;
ListProcesses: TVirtualStringTree;
popupHost: TPopupMenu;
Kill1: TMenuItem;
NewDatabase1: TMenuItem;
ListTables: TVirtualStringTree;
Refresh1: TMenuItem;
pnlDataTop: TPanel;
menurefresh: TMenuItem;
N2: TMenuItem;
pnlQueryMemo: TPanel;
SynSQLSyn1: TSynSQLSyn;
SynMemoQuery: TSynMemo;
spltQuery: TSplitter;
menucreatetable: TMenuItem;
OpenDialog1: TOpenDialog;
TimerHostUptime: TTimer;
popupTableGrid: TPopupMenu;
Refresh2: TMenuItem;
DropField1: TMenuItem;
N3: TMenuItem;
N5: TMenuItem;
PopupmenuDropDatabase: TMenuItem;
popupDataGrid: TPopupMenu;
Refresh3: TMenuItem;
MenuAddField: TMenuItem;
MenuEditField: TMenuItem;
popupResultGrid: TPopupMenu;
Copyrecords1: TMenuItem;
CopyasCSVData1: TMenuItem;
N9: TMenuItem;
LabelResultinfo: TLabel;
menuAlterTable: TMenuItem;
N10: TMenuItem;
MenuRenameTable: TMenuItem;
TimerConnected: TTimer;
N12: TMenuItem;
popupSqlLog: TPopupMenu;
Clear2: TMenuItem;
Copy1: TMenuItem;
N13: TMenuItem;
EditQuery1: TMenuItem;
Markall3: TMenuItem;
N15: TMenuItem;
menuMaintenance: TMenuItem;
TimerConnectErrorCloseWindow: TTimer;
PopupMenuDropTable: TMenuItem;
N17: TMenuItem;
ListColumns: TVirtualStringTree;
CopycontentsasHTML1: TMenuItem;
CopycontentsasHTML2: TMenuItem;
Copy3: TMenuItem;
Paste2: TMenuItem;
N4: TMenuItem;
DataGrid: TVirtualStringTree;
QueryGrid: TVirtualStringTree;
Copytableas1: TMenuItem;
Delete1: TMenuItem;
N6: TMenuItem;
QF1: TMenuItem;
QF2: TMenuItem;
QuickFilter1: TMenuItem;
QF3: TMenuItem;
QF4: TMenuItem;
N7: TMenuItem;
DropFilter1: TMenuItem;
PrintList2: TMenuItem;
PrintList3: TMenuItem;
PrintList4: TMenuItem;
N1: TMenuItem;
MenuCopyTable: TMenuItem;
SynMemoFilter: TSynMemo;
N18: TMenuItem;
selectall1: TMenuItem;
MenuAutoupdate: TMenuItem;
TimerHost: 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;
CopyasXMLdata1: TMenuItem;
CopyasXMLdata2: TMenuItem;
Exportdata1: TMenuItem;
Exportdata2: TMenuItem;
SaveDialogExportData: TSaveDialog;
N11: TMenuItem;
ProgressBarQuery: TProgressBar;
Copy4: TMenuItem;
N14: TMenuItem;
DataInsertDateTime: TMenuItem;
DataTimestamp: TMenuItem;
DataDateTime: TMenuItem;
DataTime: TMenuItem;
DataDate: TMenuItem;
DataYear: TMenuItem;
ViewasHTML1: TMenuItem;
HTMLview1: TMenuItem;
InsertfilesintoBLOBfields1: TMenuItem;
InsertfilesintoBLOBfields2: TMenuItem;
InsertfilesintoBLOBfields3: TMenuItem;
N19: TMenuItem;
setNULL1: TMenuItem;
ZSQLMonitor1: TZSQLMonitor;
Exporttables1: TMenuItem;
Exporttables2: TMenuItem;
popupDbGridHeader: TPopupMenu;
SynCompletionProposal1: TSynCompletionProposal;
OpenDialogSQLFile: TOpenDialog;
SaveDialogSQLFile: TSaveDialog;
SynEditSearch1: TSynEditSearch;
N16: TMenuItem;
ManageIndexes1: TMenuItem;
tabCommandStats: TTabSheet;
ListCommandStats: TVirtualStringTree;
QF13: TMenuItem;
QF14: TMenuItem;
QF15: TMenuItem;
QF16: TMenuItem;
QF17: 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;
menuRenameColumn: TMenuItem;
N22: TMenuItem;
N23: TMenuItem;
menuSaveSelectionToFile: TMenuItem;
menuSaveAsSnippet: TMenuItem;
menuSaveSelectionAsSnippet: TMenuItem;
popupQueryHelpers: TPopupMenu;
menuDeleteSnippet: TMenuItem;
menuHelp: TMenuItem;
menuLoadSnippet: TMenuItem;
menuInsertSnippetAtCursor: TMenuItem;
menuExplore: TMenuItem;
PopupMenuCreateTable: TMenuItem;
menuSQLhelp: TMenuItem;
N24: TMenuItem;
menuSQLhelpData: TMenuItem;
menuAlterdatabase: TMenuItem;
menuTreeAlterTable: TMenuItem;
menuLogToFile: TMenuItem;
menuOpenLogFolder: TMenuItem;
tabStatus: TTabSheet;
ListStatus: TVirtualStringTree;
Splitter3: TSplitter;
pnlProcessViewBox: TPanel;
pnlProcessView: TPanel;
SynMemoProcessView: TSynMemo;
pnlFilterVariables: TPanel;
lblFilterVariables: TLabel;
editFilterVariables: TEdit;
pnlFilterStatus: TPanel;
lblFilterStatus: TLabel;
editFilterStatus: TEdit;
pnlFilterProcesses: TPanel;
lblFilterProcesses: TLabel;
editFilterProcesses: TEdit;
menuEditVariable: TMenuItem;
actView1: TMenuItem;
Createview1: TMenuItem;
menuTreeCreateView: TMenuItem;
menuTreeEditView: 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;
procedure menuRenameColumnClick(Sender: TObject);
procedure ListColumnsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; NewText: WideString);
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 ListColumnsChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure controlsKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
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 PerformConnect;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure pcChange(Sender: TObject);
procedure ValidateControls(FrmIsFocussed: Boolean = true);
procedure ValidateQueryControls(FrmIsFocussed: Boolean = true);
function FieldContent(ds: TDataSet; ColName: WideString): WideString;
procedure LoadDatabaseProperties(db: WideString);
procedure ShowHost;
procedure ShowDatabase(db: WideString);
procedure ShowDBProperties(db: WideString);
procedure ShowTable(table: WideString; tab: TTabSheet = nil);
procedure ShowTableProperties;
procedure ShowTableData(table: WideString);
procedure EnsureFullWidth(Grid: TBaseVirtualTree; Column: TColumnIndex; Node: PVirtualNode);
procedure EnsureNodeLoaded(Sender: TBaseVirtualTree; Node: PVirtualNode; WhereClause: String);
procedure EnsureChunkLoaded(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure DiscardNodeData(Sender: TVirtualStringTree; Node: PVirtualNode);
procedure viewdata(Sender: TObject);
procedure RefreshFieldListClick(Sender: TObject);
procedure MenuRefreshClick(Sender: TObject);
procedure LogSQL(msg: WideString = ''; comment: Boolean = true );
procedure ShowVariablesAndProcesses(Sender: TObject);
procedure KillProcess(Sender: TObject);
procedure PageControlHostChange(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 FormShow(Sender: TObject);
procedure ListTablesNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; NewText: WideString);
procedure MenuRenameTableClick(Sender: TObject);
procedure TimerConnectedTimer(Sender: TObject);
procedure Clear2Click(Sender: TObject);
procedure EditQuery1Click(Sender: TObject);
procedure Markall3Click(Sender: TObject);
procedure ReadWindowOptions;
procedure ListTablesDblClick(Sender: TObject);
procedure TimerConnectErrorCloseWindowTimer(Sender: TObject);
procedure QuickFilterClick(Sender: TObject);
function GetFilter: WideString;
procedure SaveFilter(Clause: WideString = '');
procedure DropFilter1Click(Sender: TObject);
procedure selectall1Click(Sender: TObject);
procedure popupResultGridPopup(Sender: TObject);
procedure Autoupdate1Click(Sender: TObject);
procedure EnableAutoRefreshClick(Sender: TObject);
procedure ShowProcessList(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: TWideStrings);
procedure popupHostPopup(Sender: TObject);
procedure Saveastextfile1Click(Sender: TObject);
procedure popupTreeViewPopup(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);
function mask(str: WideString) : WideString;
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; Column: TColumnIndex; Button:
TMouseButton; Shift: TShiftState; X, Y: Integer);
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; Column: TColumnIndex;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure vstCompareNodes(Sender: TBaseVirtualTree; Node1, Node2:
PVirtualNode; Column: TColumnIndex; var Result: Integer);
procedure vstBeforePaint(Sender: TBaseVirtualTree; TargetCanvas:
TCanvas);
procedure vstHeaderDraggedOut(Sender: TVTHeader; Column: TColumnIndex;
DropPosition: TPoint);
procedure DBtreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
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 ListProcessesChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
procedure editFilterVTChange(Sender: TObject);
procedure ListColumnsDblClick(Sender: TObject);
procedure ListVariablesDblClick(Sender: TObject);
procedure menuEditVariableClick(Sender: TObject);
procedure menuRefreshDBTreeClick(Sender: TObject);
procedure menuTreeCollapseAllClick(Sender: TObject);
procedure menuTreeExpandAllClick(Sender: TObject);
procedure SynMemoFilterChange(Sender: TObject);
procedure tabsetQueryHelpersGetImageIndex(Sender: TObject; TabIndex: Integer;
var ImageIndex: Integer);
procedure DataGridAfterCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellRect: TRect);
procedure menuShowSizeColumnClick(Sender: TObject);
procedure DataGridColumnResize(Sender: TVTHeader; Column: TColumnIndex);
procedure DBtreeClick(Sender: TObject);
procedure GridBeforeCellPaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
CellPaintMode: TVTCellPaintMode; CellRect: TRect; var ContentRect: TRect);
private
uptime : Integer;
time_connected : Cardinal;
viewingdata : Boolean;
FMysqlConn : TMysqlConn;
FConn : TOpenConnProf;
QueryRunningInterlock : Integer;
lastUsedDB : String;
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 : TDataSet;
FilterPanelManuallyOpened : Boolean;
winName : String;
FLastSelectedTableColumns,
FLastSelectedTableKeys : TDataset;
ViewDataPrevTable : WideString;
PrevTableColWidths : WideStrings.TWideStringList;
DataGridHasChanges : Boolean;
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;
procedure insertFunction(Sender: TObject);
function GetActiveDatabase: WideString;
function GetSelectedTable: WideString;
procedure SetSelectedDatabase(db: WideString);
procedure SetSelectedTable(table: WideString);
procedure SaveListSetup( List: TVirtualStringTree );
procedure RestoreListSetup( List: TVirtualStringTree );
procedure SetVisibleListColumns( List: TVirtualStringTree; Columns: WideStrings.TWideStringList );
function GetTableSize(ds: TDataSet): Int64;
procedure ToggleFilterPanel(ForceVisible: Boolean = False);
function GetSelTableColumns: TDataset;
function GetSelTableKeys: TDataset;
procedure AutoCalcColWidths(Tree: TVirtualStringTree; PrevLayout: Widestrings.TWideStringlist = nil);
public
DatabasesWanted,
Databases : Widestrings.TWideStringList;
TemporaryDatabase : WideString;
dataselected : Boolean;
editing : Boolean;
mysql_version : Integer;
SessionName : String;
VTRowDataListVariables,
VTRowDataListStatus,
VTRowDataListProcesses,
VTRowDataListCommandStats,
VTRowDataListTables,
VTRowDataListColumns : TVTreeDataArray;
FProgressForm : TFrmQueryProgress;
// Variables set by preferences dialog
prefRememberFilters : Boolean;
prefLogsqlnum,
prefLogSqlWidth,
prefMaxColWidth : Integer;
prefCSVSeparator,
prefCSVEncloser,
prefCSVTerminator : String[10];
prefLogToFile,
prefPreferShowTables,
prefEnableTextEditor,
prefEnableBinaryEditor,
prefEnableDatetimeEditor,
prefEnableEnumEditor,
prefEnableSetEditor,
prefEnableNullBG : Boolean;
prefFieldColorNumeric,
prefFieldColorText,
prefFieldColorBinary,
prefFieldColorDatetime,
prefFieldColorEnum,
prefFieldColorSet,
prefNullColorNumeric,
prefNullColorText,
prefNullColorBinary,
prefNullColorDatetime,
prefNullColorEnum,
prefNullColorSet,
prefNullColorDefault,
prefNullBG : TColor;
CreateDatabaseForm : TCreateDatabaseForm;
CreateTableForm : TCreateTableForm;
TablePropertiesForm : Ttbl_properties_form;
FDataGridResult,
FQueryGridResult : TGridResult;
DataGridCurrentSelect : WideString;
DataGridCurrentFilter : WideString;
DataGridCurrentSort : WideString;
procedure Init(AConn : POpenConnProf; AMysqlConn : TMysqlConn);
//procedure HandleQueryNotification(ASender : TMysqlQuery; AEvent : Integer);
function GetVisualDataset: PGridResult;
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 : WideString read GetSelectedTable write SetSelectedTable;
function FetchActiveDbTableList: TDataSet;
function RefreshActiveDbTableList: TDataSet;
function FetchDbTableList(db: WideString): TDataSet;
function RefreshDbTableList(db: WideString): TDataSet;
procedure ClearDbTableList(db: WideString);
function DbTableListCached(db: WideString): Boolean;
procedure ClearAllTableLists;
procedure EnsureDatabase;
procedure TestVTreeDataArray( P: PVTreeDataArray );
function GetVTreeDataArray( VT: TBaseVirtualTree ): PVTreeDataArray;
procedure ActivateFileLogging;
procedure DeactivateFileLogging;
procedure TrimSQLLog;
function HandleOrderColumns( AddOrderCol: TOrderCol = nil ): TOrderColArray;
function ComposeOrderClause( Cols: TOrderColArray ): WideString;
procedure TableEnginesCombo(var Combobox: TCombobox);
function GetNodeType(Node: PVirtualNode): Byte;
function GetSelectedNodeType: Byte;
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 FSelectedTableColumns: TDataset read GetSelTableColumns write FLastSelectedTableColumns;
property FSelectedTableKeys: TDataset read GetSelTableKeys write FLastSelectedTableKeys;
procedure CalcNullColors;
end;
type
// Represents errors already "handled" (shown to user),
// which can thus safely be ignored.
THandledSQLError = class(Exception)
end;
// -----------------------------------------------------------------------------
implementation
uses
Main, fieldeditor,
copytable, sqlhelp, printlist,
column_selection, data_sorting, runsqlfile, mysql_structures,
Registry, grideditlinks;
type
PMethod = ^TMethod;
{$I const.inc}
{$R *.DFM}
function TMDIChild.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;
procedure TMDIChild.PerformConnect;
var
v : String[50];
v1, v2, v3 : String;
rx : TRegExpr;
begin
try
time_connected := 0;
TimerConnected.Enabled := true;
LogSQL( 'Connection established with host "' + FMysqlConn.Connection.hostname +
'" on port ' + IntToStr(FMysqlConn.Connection.Port) );
LogSQL( 'Connection-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;
Mainform.showstatus('MySQL '+v1+'.'+v2+'.'+v3, 2);
// On Re-Connection, try to restore lost properties
if FMysqlConn.Connection.Database <> '' then
ExecUseQuery( FMysqlConn.Connection.Database );
except
on E: Exception do begin
LogSQL( E.Message, true );
Screen.Cursor := crDefault;
MessageDlg( E.Message, mtError, [mbOK], 0 );
raise;
end;
end;
end;
function TMDIChild.GetQueryRunning: Boolean;
begin
Result := ( QueryRunningInterlock = 1 );
end;
procedure TMDIChild.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;
procedure TMDIChild.Init(AConn : POpenConnProf; AMysqlConn : TMysqlConn);
var
AutoReconnect : Boolean;
i, j : Integer;
miGroup,
miFilterGroup,
miFunction,
miFilterFunction : TMenuItem;
functioncats : TStringList;
reg : TRegistry;
begin
QueryRunningInterlock := 0;
UserQueryFired := False;
UserQueryFiring := False;
TemporaryDatabase := '';
CachedTableLists := WideStrings.TWideStringList.Create;
InitializeCriticalSection(SqlMessagesLock);
EnterCriticalSection(SqlMessagesLock);
SqlMessages := TWideStringList.Create;
LeaveCriticalSection(SqlMessagesLock);
FConn := AConn^;
FMysqlConn := AMysqlConn; // we're now responsible to free it
FConn.MysqlConn := FMysqlConn.Connection; // use this connection (instead of zConn)
// Initialization: establish connection and read some vars from registry
MainForm.Showstatus( 'Creating window...' );
// Temporarily disable AutoReconnect in Registry
// in case of unexpected application-termination
AutoReconnect := Mainform.GetRegValue(REGNAME_AUTORECONNECT, DEFAULT_AUTORECONNECT);
if AutoReconnect then begin
reg := TRegistry.Create();
reg.OpenKey( REGPATH, true );
reg.WriteBool( REGNAME_AUTORECONNECT, False );
reg.CloseKey;
FreeAndNil(reg);
end;
ReadWindowOptions();
MainForm.Showstatus( 'Connecting to ' + FConn.MysqlParams.Host + '...' );
try
PerformConnect();
except
TimerConnectErrorCloseWindow.Enabled := true;
Exit;
end;
SessionName := FMysqlConn.SessionName;
DatabasesWanted := explode(';', FConn.DatabaseList);
if FConn.DatabaseListSort then
DatabasesWanted.Sort;
// Fill variables-list, processlist and DB-tree
ShowVariablesAndProcesses( Self );
// Invoke population of database tree. It's important to do this here after
// having filled DatabasesWanted, not at design time.
DBtree.RootNodeCount := 1;
// Re-enable AutoReconnect in Registry!
if AutoReconnect then begin
reg := TRegistry.Create;
reg.OpenKey( REGPATH, true );
reg.WriteBool( REGNAME_AUTORECONNECT, true );
reg.CloseKey;
FreeAndNil(reg);
end;
// Define window properties
SetWindowConnected( true );
i := SetWindowName( SessionName );
winName := SessionName;
if ( i <> 0 ) then
begin
winName := winName + Format( ' (%d)', [i] );
end;
Application.Title := winName + ' - ' + APPNAME;
Caption := winName;
// Reselect last used database
if MainForm.GetRegValue( REGNAME_RESTORELASTUSEDDB, DEFAULT_RESTORELASTUSEDDB ) and ( lastUsedDB <> '' ) then
begin
try
ActiveDatabase := Utf8Decode(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 else // By default, select the host node
DBtree.Selected[DBtree.GetFirst] := true;
// read function-list into menu
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, '|', '<27>', [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 TMDIChild.ReadWindowOptions;
var
i : Integer;
menuitem : Tmenuitem;
fontname, datafontname : String;
fontsize, datafontsize : Integer;
begin
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);
FixVT(ListColumns);
// Other values:
pnlQueryMemo.Height := Mainform.GetRegValue(REGNAME_QUERYMEMOHEIGHT, pnlQueryMemo.Height);
pnlQueryHelpers.Width := Mainform.GetRegValue(REGNAME_QUERYHELPERSWIDTH, pnlQueryHelpers.Width);
DBtree.Width := Mainform.GetRegValue(REGNAME_DBTREEWIDTH, DBtree.Width);
SynMemoSQLLog.Height := Mainform.GetRegValue(REGNAME_SQLOUTHEIGHT, SynMemoSQLLog.Height);
prefMaxColWidth := Mainform.GetRegValue(REGNAME_MAXCOLWIDTH, DEFAULT_MAXCOLWIDTH);
// 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 := Mainform.GetRegValue(REGNAME_LOGSQLNUM, DEFAULT_LOGSQLNUM);
prefLogSqlWidth := Mainform.GetRegValue(REGNAME_LOGSQLWIDTH, DEFAULT_LOGSQLWIDTH);
prefCSVSeparator := Mainform.GetRegValue(REGNAME_CSV_SEPARATOR, DEFAULT_CSV_SEPARATOR);
prefCSVEncloser := Mainform.GetRegValue(REGNAME_CSV_ENCLOSER, DEFAULT_CSV_ENCLOSER);
prefCSVTerminator := Mainform.GetRegValue(REGNAME_CSV_TERMINATOR, DEFAULT_CSV_TERMINATOR);
prefRememberFilters := Mainform.GetRegValue(REGNAME_REMEMBERFILTERS, DEFAULT_REMEMBERFILTERS);
prefPreferShowTables := Mainform.GetRegValue(REGNAME_PREFER_SHOWTABLES, DEFAULT_PREFER_SHOWTABLES);
// SQL-Font:
fontname := Mainform.GetRegValue(REGNAME_FONTNAME, DEFAULT_FONTNAME);
fontsize := Mainform.GetRegValue(REGNAME_FONTSIZE, DEFAULT_FONTSIZE);
SynMemoQuery.Font.Name := fontname;
SynMemoQuery.Font.Size := fontsize;
SynMemoFilter.Font.Name := fontname;
SynMemoFilter.Font.Size := fontsize;
SynMemoSQLLog.Font.Name := fontname;
SynMemoSQLLog.Font.Size := fontsize;
SynMemoProcessView.Font.Name := fontname;
SynMemoProcessView.Font.Size := fontsize;
// Data-Font:
datafontname := Mainform.GetRegValue(REGNAME_DATAFONTNAME, DEFAULT_DATAFONTNAME);
datafontsize := Mainform.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 := Mainform.GetRegValue(REGNAME_FIELDCOLOR_NUMERIC, DEFAULT_FIELDCOLOR_NUMERIC);
prefFieldColorText := Mainform.GetRegValue(REGNAME_FIELDCOLOR_TEXT, DEFAULT_FIELDCOLOR_TEXT);
prefFieldColorBinary := Mainform.GetRegValue(REGNAME_FIELDCOLOR_BINARY, DEFAULT_FIELDCOLOR_BINARY);
prefFieldColorDatetime := Mainform.GetRegValue(REGNAME_FIELDCOLOR_DATETIME, DEFAULT_FIELDCOLOR_DATETIME);
prefFieldColorEnum := Mainform.GetRegValue(REGNAME_FIELDCOLOR_ENUM, DEFAULT_FIELDCOLOR_ENUM);
prefFieldColorSet := Mainform.GetRegValue(REGNAME_FIELDCOLOR_SET, DEFAULT_FIELDCOLOR_SET);
prefNullBG := Mainform.GetRegValue(REGNAME_BG_NULL, DEFAULT_BG_NULL);
CalcNullColors;
// Editor enablings
prefEnableTextEditor := Mainform.GetRegValue(REGNAME_FIELDEDITOR_TEXT, DEFAULT_FIELDEDITOR_TEXT);
prefEnableBinaryEditor := Mainform.GetRegValue(REGNAME_FIELDEDITOR_BINARY, DEFAULT_FIELDEDITOR_BINARY);
prefEnableDatetimeEditor := Mainform.GetRegValue(REGNAME_FIELDEDITOR_DATETIME, DEFAULT_FIELDEDITOR_DATETIME);
prefEnableEnumEditor := Mainform.GetRegValue(REGNAME_FIELDEDITOR_ENUM, DEFAULT_FIELDEDITOR_ENUM);
prefEnableSetEditor := Mainform.GetRegValue(REGNAME_FIELDEDITOR_SET, DEFAULT_FIELDEDITOR_SET);
prefEnableNullBG := Mainform.GetRegValue(REGNAME_BG_NULL_ENABLED, DEFAULT_BG_NULL_ENABLED);
// Color coding:
SynSQLSyn1.KeyAttri.Foreground := StringToColor(Mainform.GetRegValue(REGNAME_SQLCOLKEYATTRI, ColorToString(DEFAULT_SQLCOLKEYATTRI)));
SynSQLSyn1.FunctionAttri.Foreground := StringToColor(Mainform.GetRegValue(REGNAME_SQLCOLFUNCTIONATTRI, ColorToString(DEFAULT_SQLCOLFUNCTIONATTRI)));
SynSQLSyn1.DataTypeAttri.Foreground := StringToColor(Mainform.GetRegValue(REGNAME_SQLCOLDATATYPEATTRI, ColorToString(DEFAULT_SQLCOLDATATYPEATTRI)));
SynSQLSyn1.NumberAttri.Foreground := StringToColor(Mainform.GetRegValue(REGNAME_SQLCOLNUMBERATTRI, ColorToString(DEFAULT_SQLCOLNUMBERATTRI)));
SynSQLSyn1.StringAttri.Foreground := StringToColor(Mainform.GetRegValue(REGNAME_SQLCOLSTRINGATTRI, ColorToString(DEFAULT_SQLCOLSTRINGATTRI)));
SynSQLSyn1.CommentAttri.Foreground := StringToColor(Mainform.GetRegValue(REGNAME_SQLCOLCOMMENTATTRI, ColorToString(DEFAULT_SQLCOLCOMMENTATTRI)));
SynSQLSyn1.TablenameAttri.Foreground := StringToColor(Mainform.GetRegValue(REGNAME_SQLCOLTABLENAMEATTRI, ColorToString(DEFAULT_SQLCOLTABLENAMEATTRI)));
SynMemoQuery.ActiveLineColor := StringToColor(Mainform.GetRegValue(REGNAME_SQLCOLACTIVELINE, ColorToString(DEFAULT_SQLCOLACTIVELINE)));
// Switch off/on displaying table/db sized in tree
menuShowSizeColumn.Checked := Mainform.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);
RestoreListSetup(ListColumns);
// Activate logging
if Mainform.GetRegValue(REGNAME_LOGTOFILE, DEFAULT_LOGTOFILE) then
ActivateFileLogging;
// Set last used database, select it later in Init
lastUsedDB := Mainform.GetRegValue(REGNAME_LASTUSEDDB, '', FConn.Description);
// 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;
end;
procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
var
reg : TRegistry;
begin
// Post pending UPDATE
if DataGridHasChanges then
Mainform.actDataPostChangesExecute(Sender);
SetWindowConnected( false );
SetWindowName( main.discname );
Application.Title := APPNAME;
debug('mem: clearing query and browse data.');
SetLength(FDataGridResult.Rows, 0);
SetLength(FDataGridResult.Columns, 0);
SetLength(FQueryGridResult.Rows, 0);
SetLength(FQueryGridResult.Columns, 0);
// Closing connection
FMysqlConn.Disconnect;
FreeAndNil(FMysqlConn);
EnterCriticalSection(SqlMessagesLock);
FreeAndNil(SqlMessages);
LeaveCriticalSection(SqlMessagesLock);
reg := TRegistry.Create();
if reg.OpenKey( REGPATH, true ) then
begin
WindowState := wsMaximized;
reg.WriteInteger( REGNAME_QUERYMEMOHEIGHT, pnlQueryMemo.Height );
reg.WriteInteger( REGNAME_QUERYHELPERSWIDTH, pnlQueryHelpers.Width );
reg.WriteInteger( REGNAME_DBTREEWIDTH, DBtree.width );
reg.WriteInteger( REGNAME_SQLOUTHEIGHT, SynMemoSQLLog.Height );
// Save width of probably resized columns of all VirtualTrees
SaveListSetup(ListVariables);
SaveListSetup(ListStatus);
SaveListSetup(ListProcesses);
SaveListSetup(ListCommandStats);
SaveListSetup(ListTables);
SaveListSetup(ListColumns);
// Open server-specific registry-folder.
// relative from already opened folder!
reg.OpenKey( REGKEY_SESSIONS + FConn.Description, true );
reg.WriteString( REGNAME_LASTUSEDDB, Utf8Encode(ActiveDatabase) );
end;
FreeAndNil(reg);
// Clear database and table lists
DBtree.Clear;
ClearAllTableLists;
FreeAndNil(DatabasesWanted);
FreeAndNil(Databases);
FreeAndNil(CachedTableLists);
ValidateControls(False);
Action := caFree;
SetWindowConnected( false );
SetWindowName( main.discname );
Application.Title := APPNAME;
if prefLogToFile then
DeactivateFileLogging;
end;
{**
Add a SQL-command or comment to SynMemoSQLLog
}
procedure TMDIChild.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;
msg := WideStringReplace( msg, #9, ' ', [rfReplaceAll] );
msg := WideStringReplace( msg, #10, ' ', [rfReplaceAll] );
msg := WideStringReplace( msg, #13, ' ', [rfReplaceAll] );
msg := WideStringReplace( msg, ' ', ' ', [rfReplaceAll] );
if ( comment ) then
begin
msg := '/* ' + msg + ' */';
end;
EnterCriticalSection(SqlMessagesLock);
try
SqlMessages.Add(msg);
finally
LeaveCriticalSection(SqlMessagesLock);
end;
PostMessage(MainForm.Handle, WM_PROCESSLOG, 0, 0);
end;
procedure TMDIChild.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 TMDIChild.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 TMDIChild.ShowHost;
begin
if (not DBTree.Dragging) and (
(PageControlMain.ActivePage = tabDatabase) or
(PageControlMain.ActivePage = tabTable) or
(PageControlMain.ActivePage = tabData)
) then PageControlMain.ActivePage := tabHost;
tabDatabase.TabVisible := false;
tabTable.TabVisible := false;
tabData.TabVisible := false;
Caption := winName;
pcChange( Self );
end;
procedure TMDIChild.ShowDatabase(db: WideString);
begin
if (not DBtree.Dragging) and (
(PageControlMain.ActivePage = tabHost) or
(PageControlMain.ActivePage = tabTable) or
(PageControlMain.ActivePage = tabData)
) then PageControlMain.ActivePage := tabDatabase;
tabDatabase.TabVisible := true;
tabTable.TabVisible := false;
tabData.TabVisible := false;
Caption := winName + ' - /' + db;
ShowDBProperties( db );
end;
{***
Do the default action (show table properties or table data) for a table.
}
procedure TMDIChild.ShowTable(table: WideString; tab: TTabSheet = nil);
begin
if tab = nil then tab := tabTable; // Alternative default: tabData
if tab = tabTable then ShowTableProperties;
if tab = tabData then ShowTableData( table );
Caption := winName + ' - /' + ActiveDatabase + '/' + SelectedTable;
end;
procedure TMDIChild.viewdata(Sender: TObject);
var
sorting : WideString;
i, count : Integer;
OrderColumns : TOrderColArray;
reg_value : String;
select_base : WideString;
select_from : WideString;
sl_query : TWideStringList;
DisplayedColumnsList,
HiddenKeyCols,
KeyCols : WideStrings.TWideStringList;
Filter, ColName : WideString;
col : TVirtualTreeColumn;
rx : TRegExpr;
ColType : String;
ColExists : Boolean;
procedure InitColumn(idx: Integer; name: WideString);
var
ColType: String;
k: Integer;
begin
FDataGridResult.Columns[idx].Name := name;
col := DataGrid.Header.Columns.Add;
col.Text := name;
col.Options := col.Options + [coSmartResize];
if HiddenKeyCols.IndexOf(name) > -1 then col.Options := col.Options - [coVisible];
// Sorting color and title image
for k:=0 to Length(OrderColumns)-1 do begin
if OrderColumns[k].ColumnName = name then begin
case OrderColumns[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;
// Right alignment for numeric columns
FSelectedTableColumns.First;
while not FSelectedTableColumns.Eof do begin
if FSelectedTableColumns.FieldByName('Field').AsWideString = name then begin
ColType := FSelectedTableColumns.FieldByName('Type').AsString;
rx.Expression := '^(tiny|small|medium|big)?int\b';
if rx.Exec(ColType) then begin
col.Alignment := taRightJustify;
FDataGridResult.Columns[idx].IsInt := True;
end;
rx.Expression := '^(float|double|decimal)\b';
if rx.Exec(ColType) then begin
col.Alignment := taRightJustify;
FDataGridResult.Columns[idx].IsFloat := True;
end;
rx.Expression := '^(date|datetime|time(stamp)?)\b';
if rx.Exec(ColType) then begin
FDataGridResult.Columns[idx].IsDate := True;
if rx.Match[1] = 'date' then FDataGridResult.Columns[idx].DataType := tpDATE
else if rx.Match[1] = 'time' then FDataGridResult.Columns[idx].DataType := tpTIME
else if rx.Match[1] = 'timestamp' then FDataGridResult.Columns[idx].DataType := tpTIMESTAMP
else FDataGridResult.Columns[idx].DataType := tpDATETIME;
end;
rx.Expression := '^((tiny|medium|long)?text|(var)?char)\b(\(\d+\))?';
if rx.Exec(ColType) then begin
FDataGridResult.Columns[idx].IsText := True;
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].IsBinary := True;
if Copy(ColType, 1, 5) = 'enum(' then begin
FDataGridResult.Columns[idx].IsEnum := True;
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].IsSet := True;
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;
end;
FSelectedTableColumns.Next;
end;
FSelectedTableKeys.First;
for k := 0 to FSelectedTableKeys.RecordCount - 1 do begin
if (FSelectedTableKeys.FieldByName('Key_name').AsString = 'PRIMARY')
and (FSelectedTableKeys.FieldByName('Column_name').AsWideString = name) then begin
FDataGridResult.Columns[idx].IsPriPart := True;
break;
end;
FSelectedTableKeys.Next;
end;
end;
begin
Screen.Cursor := crHourglass;
// Post pending UPDATE
if DataGridHasChanges then
Mainform.actDataPostChangesExecute(Sender);
viewingdata := true;
sl_query := TWideStringList.Create();
try
// Read cached ORDER-clause and set Grid.Sortcolumns
sorting := '';
OrderColumns := HandleOrderColumns;
if Length(OrderColumns) > 0 then begin
sorting := ComposeOrderClause(OrderColumns);
// Signal for the user that we applied an ORDER-clause
tbtnDataSorting.ImageIndex := 108;
end else
tbtnDataSorting.ImageIndex := 107;
if (SelectedTable <> '') and (ActiveDatabase <> '') then begin
// Ensure <Table> and <Data> are visible
tabTable.TabVisible := true;
tabData.TabVisible := true;
// Switch to <Data>
PageControlMain.ActivePage := tabData;
// Read columns to display from registry
reg_value := Mainform.GetRegValue(REGNAME_DISPLAYEDCOLUMNS + '_' + ActiveDatabase + '.' + SelectedTable, '', SessionName);
DisplayedColumnsList := WideStrings.TWideStringlist.Create;
DisplayedColumnsList.Delimiter := '`';
DisplayedColumnsList.DelimitedText := reg_value;
HiddenKeyCols := WideStrings.TWideStringlist.Create;
SynMemoFilter.Color := clWindow;
rx := TRegExpr.Create;
MainForm.ShowStatus('Freeing data...');
DataGrid.BeginUpdate;
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;
// Prepare SELECT statement
select_base := 'SELECT ';
// Try to calc the rowcount regardless of a given LIMIT
// Only needed if the user specified a WHERE-clause
Filter := GetFilter;
// Selected columns
if DisplayedColumnsList.Count = 0 then begin
FSelectedTableColumns.First;
while not FSelectedTableColumns.Eof do begin
DisplayedColumnsList.Add(FSelectedTableColumns.FieldByName('Field').AsWideString);
FSelectedTableColumns.Next;
end;
tbtnDataColumns.ImageIndex := 107;
end else begin
for i := DisplayedColumnsList.Count - 1 downto 0 do begin
ColExists := False;
FSelectedTableColumns.First;
while not FSelectedTableColumns.Eof do begin
if DisplayedColumnsList[i] = FSelectedTableColumns.FieldByName('Field').AsWideString then begin
ColExists := True;
break;
end;
FSelectedTableColumns.Next;
end;
if not ColExists then
DisplayedColumnsList.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;
for i := 0 to KeyCols.Count - 1 do
if DisplayedColumnsList.IndexOf(KeyCols[i]) = -1 then begin
DisplayedColumnsList.Add(KeyCols[i]);
HiddenKeyCols.Add(KeyCols[i]);
end;
// Initialize column array to correct length.
debug('mem: initializing browse columns.');
SetLength(FDataGridResult.Columns, DisplayedColumnsList.Count);
for i := 0 to DisplayedColumnsList.Count - 1 do begin
ColName := DisplayedColumnsList[i];
FSelectedTableColumns.First;
while not FSelectedTableColumns.Eof do begin
if FSelectedTableColumns.FieldByName('Field').AsWideString = ColName then begin
ColType := FSelectedTableColumns.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;
Break;
end;
FSelectedTableColumns.Next;
end;
end;
for i := 0 to DisplayedColumnsList.Count - 1 do begin
ColName := DisplayedColumnsList[i];
InitColumn(i, ColName);
end;
debug('mem: browse column initialization complete.');
// Cut last comma
select_base := copy( select_base, 1, Length(select_base)-1 );
select_from := ' FROM ' + mask( SelectedTable );
try
MainForm.ShowStatus('Counting rows...');
sl_query.Add('SELECT COUNT(*)');
sl_query.Add(select_from);
// Apply custom WHERE filter
if Filter <> '' then sl_query.Add('WHERE ' + Filter);
count := StrToInt(GetVar(sl_query.Text));
except
on E:Exception do begin
// Most likely we have a wrong filter-clause when this happens
// Put the user with his nose onto the wrong filter
// either specified by user or
// created by HeidiSQL by using the search box
ToggleFilterPanel(True);
SynMemoFilter.Color := $008080FF; // light pink
DataGrid.Header.Options := DataGrid.Header.Options - [hoVisible];
MessageDlg( E.Message, mtError, [mbOK], 0 );
raise;
end;
end;
MainForm.ShowStatus( STATUS_MSG_READY );
DataGridCurrentSelect := select_base + select_from;
DataGridCurrentFilter := Filter;
DataGridCurrentSort := sorting;
debug('mem: initializing browse rows (internal data).');
SetLength(FDataGridResult.Rows, count);
for i := 0 to count - 1 do begin
FDataGridResult.Rows[i].Loaded := False;
end;
debug('mem: initializing browse rows (grid).');
DataGrid.RootNodeCount := count;
debug('mem: browse row initialization complete.');
// Switched to another table
if ViewDataPrevTable <> SelectedTable then begin
DataGrid.OffsetXY := Point(0, 0); // Scroll to top left
FreeAndNil(PrevTableColWidths); // Throw away remembered, manually resized column widths
end;
DisplayRowCountStats;
dataselected := true;
pcChange(self);
end;
finally
DataGrid.Header.Columns.EndUpdate;
DataGrid.EndUpdate;
FreeAndNil(sl_query);
AutoCalcColWidths(DataGrid, PrevTableColWidths);
viewingdata := false;
Screen.Cursor := crDefault;
end;
ViewDataPrevTable := SelectedTable;
end;
{***
Calculate + display total rowcount and found rows matching to filter
in data-tab
}
procedure TMDIChild.DisplayRowCountStats;
var
rows_matching : Int64; // rows matching to where-filter
rows_total : Int64; // total rowcount
filter : WideString;
begin
lblDataTop.Caption := ActiveDatabase + '.' + SelectedTable + ': ';
Filter := GetFilter;
if GetSelectedNodeType = NODETYPE_TABLE then begin
if Filter <> '' then begin
// Get rowcount from table
rows_total := StrToInt64( GetVar( 'SELECT COUNT(*) FROM ' + mask( SelectedTable ), 0 ) );
end else begin
rows_total := DataGrid.RootNodeCount
end;
lblDataTop.Caption := lblDataTop.Caption + FormatNumber( rows_total ) + ' rows total';
end else begin
// Don't fetch rowcount from views to fix bug #1844952
rows_total := -1;
lblDataTop.Caption := lblDataTop.Caption + ' [View]';
end;
rows_matching := DataGrid.RootNodeCount;
if( rows_matching <> rows_total ) and
(Filter <> '') then
lblDataTop.Caption := lblDataTop.Caption + ', ' + FormatNumber(rows_matching) + ' matching to filter';
if ( rows_matching = rows_total ) and
(Filter <> '') then
lblDataTop.Caption := lblDataTop.Caption + ', filter matches all rows';
end;
procedure TMDIChild.WaitForQueryCompletion(WaitForm: TfrmQueryProgress; query: TMySqlQuery; ForceDialog: Boolean);
var
signal: Cardinal;
begin
debug( 'Waiting for query to complete.' );
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 TMDIChild.pcChange(Sender: TObject);
begin
// Load data.
// Do this only if the user clicked the new tab. Not on automatic tab changes.
if Sender = PageControlMain then begin
if (PageControlMain.ActivePage = tabData) then viewdata(Sender);
end;
// 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 PageControlMain.ActivePage = tabDatabase then ListTables.SetFocus;
if PageControlMain.ActivePage = tabTable then ListColumns.SetFocus;
if PageControlMain.ActivePage = tabData then DataGrid.SetFocus;
if PageControlMain.ActivePage = tabQuery then SynMemoQuery.SetFocus;
end;
// Ensure controls are in a valid state
ValidateControls;
// Show processlist if it's visible now but empty yet
if PageControlMain.ActivePage = tabHost then begin
if ListProcesses.RootNodeCount = 0 then
ShowProcessList( self );
end;
end;
{***
Ensures that we're connected to the currently selected database.
}
procedure TMDIChild.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 TMDIChild.FetchActiveDbTableList: TDataSet;
begin
Result := FetchDbTableList(ActiveDatabase);
end;
function TMDIChild.FetchDbTableList(db: WideString): TDataSet;
var
ds: TDataSet;
OldCursor: TCursor;
begin
if not DbTableListCached(db) then begin
// Not in cache, load table list.
OldCursor := Screen.Cursor;
Screen.Cursor := crHourGlass;
MainForm.ShowStatus('Fetching tables from "' + db + '" ...');
try
if (mysql_version >= 32300) and (not prefPreferShowTables) then begin
ds := GetResults('SHOW TABLE STATUS FROM ' + mask(db), false, false);
end else begin
// contains table names, nothing else.
ds := GetResults('SHOW /*!50002 FULL */ TABLES FROM ' + mask(db), false, false);
// could clean up data (rename first column to 'Name') and
// and add row counters to data set as a new field by using
// SELECT COUNT(*), but that would potentially be rather slow.
end;
CachedTableLists.AddObject(db, ds);
// Add table names to SQL highlighter
SynSQLSyn1.TableNames.BeginUpdate;
while not ds.Eof do begin
SynSQLSyn1.TableNames.Add(ds.Fields[0].AsWideString);
ds.Next;
end;
SynSQLSyn1.TableNames.EndUpdate;
finally
MainForm.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 TMDIChild.RefreshActiveDbTableList: TDataSet;
begin
Result := RefreshDbTableList(ActiveDatabase);
end;
function TMDIChild.RefreshDbTableList(db: WideString): TDataSet;
begin
ClearDbTableList(db);
Result := FetchDbTableList(db);
end;
procedure TMDIChild.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 TMDIChild.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 TMDIChild.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 TMDIChild.LoadDatabaseProperties(db: WideString);
var
i : Integer;
bytes : Int64;
ds : TDataSet;
ListCaptions,
SelectedCaptions: WideStrings.TWideStringList;
begin
// DB-Properties
Screen.Cursor := crHourGlass;
// Remember selected nodes
SelectedCaptions := GetVTCaptions(ListTables, True);
try
ds := FetchDbTableList(db);
MainForm.ShowStatus( 'Displaying tables from "' + db + '" ...' );
ListTables.BeginUpdate;
ListTables.Clear;
SetLength(VTRowDataListTables, ds.RecordCount);
for i := 1 to ds.RecordCount do
begin
listcaptions := WideStrings.TWideStringList.Create;
// Table
ListCaptions.Add( ds.Fields[0].AsWideString );
// Treat tables slightly different than views
case GetDBObjectType( ds.Fields) of
NODETYPE_TABLE, NODETYPE_CRASHED_TABLE: // A normal table
begin
if GetDBObjectType(ds.Fields) = NODETYPE_CRASHED_TABLE then begin
VTRowDataListTables[i-1].ImageIndex := ICONINDEX_CRASHED_TABLE;
VTRowDataListTables[i-1].NodeType := NODETYPE_CRASHED_TABLE;
end else begin
VTRowDataListTables[i-1].ImageIndex := ICONINDEX_TABLE;
VTRowDataListTables[i-1].NodeType := NODETYPE_TABLE;
end;
// Rows
if ds.FindField('Rows') <> nil then
ListCaptions.Add( FormatNumber( FieldContent(ds, 'Rows') ) )
else
ListCaptions.Add('');
// Size: Data_length + Index_length
bytes := GetTableSize(ds);
if bytes >= 0 then ListCaptions.Add(FormatByteNumber(bytes))
else ListCaptions.Add('');
// Created:
ListCaptions.Add( FieldContent(ds, 'Create_time') );
// Updated:
ListCaptions.Add( FieldContent(ds, 'Update_time') );
// Engine
if ds.FindField('Type') <> nil then
ListCaptions.Add( FieldContent(ds, 'Type') )
else
ListCaptions.Add( FieldContent(ds, 'Engine') );
// Comment
ListCaptions.Add( FieldContent(ds, 'Comment') );
// Version
ListCaptions.Add( FieldContent(ds, 'Version') );
// Row format
ListCaptions.Add( FieldContent(ds, 'Row_format') );
// Avg row length
if (FieldContent(ds, 'Avg_row_length') <> '') then
ListCaptions.Add( FormatByteNumber(FieldContent(ds, 'Avg_row_length')) )
else ListCaptions.Add('');
// Max data length
if (FieldContent(ds, 'Max_data_length') <> '') then
ListCaptions.Add( FormatByteNumber(FieldContent(ds, 'Max_data_length')) )
else ListCaptions.Add('');
// Index length
if (FieldContent(ds, 'Index_length') <> '') then
ListCaptions.Add( FormatByteNumber(FieldContent(ds, 'Index_length')) )
else ListCaptions.Add('');
// Data free
if (FieldContent(ds, 'Data_free') <> '') then
ListCaptions.Add( FormatByteNumber(FieldContent(ds, 'Data_free')) )
else ListCaptions.Add('');
// Auto increment
if (FieldContent(ds, 'Auto_increment') <> '') then
ListCaptions.Add( FormatNumber(FieldContent(ds, 'Auto_increment')) )
else ListCaptions.Add('');
// Check time
ListCaptions.Add( FieldContent(ds, 'Check_time') );
// Collation
ListCaptions.Add( FieldContent(ds, 'Collation') );
// Checksum
ListCaptions.Add( FieldContent(ds, 'Checksum') );
// Create_options
ListCaptions.Add( FieldContent(ds, 'Create_options') );
// Object type
ListCaptions.Add('Base table');
end;
NODETYPE_VIEW:
begin // View
VTRowDataListTables[i-1].ImageIndex := ICONINDEX_VIEW;
VTRowDataListTables[i-1].NodeType := NODETYPE_VIEW;
// Rows
ListCaptions.Add('');
// Size
ListCaptions.Add('');
// Created:
ListCaptions.Add('');
// Updated:
ListCaptions.Add('');
// Engine
ListCaptions.Add('');
// Comment
ListCaptions.Add(FieldContent(ds, 'Comment'));
// Version
ListCaptions.Add('');
// Row_format
ListCaptions.Add('');
// Avg_row_length
ListCaptions.Add('');
// Max_data_length
ListCaptions.Add('');
// Index_length
ListCaptions.Add('');
// Data_free
ListCaptions.Add('');
// Auto_increment
ListCaptions.Add('');
// Check_time
ListCaptions.Add('');
// Collation
ListCaptions.Add('');
// Checksum
ListCaptions.Add('');
// Create_options
ListCaptions.Add('');
// Object Type
ListCaptions.Add('View');
end;
end;
VTRowDataListTables[i-1].Captions := ListCaptions;
ds.Next;
end;
finally
ListTables.RootNodeCount := Length(VTRowDataListTables);
ListTables.EndUpdate;
SetVTSelection(ListTables, SelectedCaptions);
Mainform.showstatus(db + ': ' + IntToStr(ListTables.RootNodeCount) +' table(s)', 0);
tabDatabase.Caption := sstr('Database: ' + db, 30);
MainForm.ShowStatus(STATUS_MSG_READY);
Screen.Cursor := crDefault;
// Ensure tree db node displays its chidren initialized
DBtree.ReinitChildren(FindDBNode(db), False);
end;
end;
{ Show tables and their properties on the tabsheet "Database" }
procedure TMDIChild.ShowDBProperties(db: WideString);
begin
Screen.Cursor := crHourglass;
pcChange( Self );
MainForm.ShowStatus( STATUS_MSG_READY );
Screen.Cursor := crDefault;
end;
{ Show columns of selected table, indicate indexed columns by certain icons }
procedure TMDIChild.RefreshFieldListClick(Sender: TObject);
begin
ShowTableProperties;
end;
procedure TMDIChild.ShowTableProperties;
var
i,j : Integer;
isFulltext : Boolean;
dummy: Boolean;
hasCommentColumn: Boolean;
SelectedCaptions: WideStrings.TWideStringList;
defaultVal: WideString;
begin
// Table-Properties
dataselected := false;
Screen.Cursor := crHourGlass;
tabTable.Caption := sstr('Table: ' + SelectedTable, 30);
tabDatabase.TabVisible := true;
tabTable.TabVisible := true;
tabData.TabVisible := true;
if (not DBtree.Dragging) and (
(PageControlMain.ActivePage = tabHost) or
(PageControlMain.ActivePage = tabDatabase)
) then PageControlMain.ActivePage := tabTable;
MainForm.ShowStatus( 'Reading table properties...' );
// Remember selected nodes
SelectedCaptions := GetVTCaptions(ListColumns, True);
ListColumns.BeginUpdate;
ListColumns.Clear;
FSelectedTableColumns := nil;
FSelectedTableKeys := nil;
Try
// Hide column "Comment" on old servers.
hasCommentColumn := FSelectedTableColumns.FindField('Comment') <> nil;
if not hasCommentColumn then
ListColumns.Header.Columns[5].Options := ListColumns.Header.Columns[5].Options - [coVisible];
SetLength(VTRowDataListColumns, FSelectedTableColumns.RecordCount);
for i:=1 to FSelectedTableColumns.RecordCount do
begin
VTRowDataListColumns[i-1].ImageIndex := ICONINDEX_FIELD;
VTRowDataListColumns[i-1].Captions := WideStrings.TWideStringList.Create;
VTRowDataListColumns[i-1].Captions.Add( FSelectedTableColumns.FieldByName('Field').AsWideString );
VTRowDataListColumns[i-1].Captions.Add( FSelectedTableColumns.FieldByName('Type').AsWideString );
if lowercase( FSelectedTableColumns.FieldByName('Null').AsString ) = 'yes' then
VTRowDataListColumns[i-1].Captions.Add('Yes')
else VTRowDataListColumns[i-1].Captions.Add('No');
if FSelectedTableColumns.FieldByName('Default').IsNull then
// In MySQL, it is not possible to use fx NOW() as a column default.
// Also, if default is NULL, then the actual default is either NULL
// or nothing at all. Looking at another column, "Null", can help
// determine which one it really is, as can a SHOW CREATE TABLE.
// According with the above, it is not possible in MySQL to create
// a column which may be NULL but which has no default value.
if LowerCase(FSelectedTableColumns.FieldByName('Null').AsString) = 'yes' then
VTRowDataListColumns[i-1].Captions.Add('NULL')
else
// No default value.
VTRowDataListColumns[i-1].Captions.Add('')
else begin
defaultVal := FSelectedTableColumns.FieldByName('Default').AsWideString;
if UpperCase(defaultVal) <> 'CURRENT_TIMESTAMP' then
defaultVal := '''' + defaultVal + '''';
VTRowDataListColumns[i-1].Captions.Add(defaultVal);
end;
VTRowDataListColumns[i-1].Captions.Add( FSelectedTableColumns.FieldByName('Extra').AsWideString );
if hasCommentColumn then
VTRowDataListColumns[i-1].Captions.Add( FSelectedTableColumns.FieldByName('Comment').AsWideString )
else
VTRowDataListColumns[i-1].Captions.Add('');
FSelectedTableColumns.Next;
end;
ListColumns.RootNodeCount := Length(VTRowDataListColumns);
// Manually invoke OnChange event of tabset to fill helper list with data
if tabsetQueryHelpers.TabIndex = 0 then
tabsetQueryHelpers.OnChange( Self, tabsetQueryHelpers.TabIndex, dummy);
Screen.Cursor := crHourglass;
for i:=1 to FSelectedTableKeys.RecordCount do
begin
// Search for the column name in listColumns
for j:=0 to Length(VTRowDataListColumns)-1 do
begin
if FSelectedTableKeys.FieldByName('Column_name').AsWideString = VTRowDataListColumns[j].Captions[0] then
begin
// Only apply a new icon if it was not already changed
if VTRowDataListColumns[j].ImageIndex <> ICONINDEX_FIELD then
break;
// Check if column is part of a fulltext key
if mysql_version < 40002 then
isFulltext := (FSelectedTableKeys.FieldByName('Comment').AsString = 'FULLTEXT')
else
isFulltext := (FSelectedTableKeys.FieldByName('Index_type').AsString = 'FULLTEXT');
// Primary key
if FSelectedTableKeys.FieldByName('Key_name').AsString = 'PRIMARY' then
VTRowDataListColumns[j].ImageIndex := ICONINDEX_PRIMARYKEY
// Fulltext index
else if isFullText then
VTRowDataListColumns[j].ImageIndex := ICONINDEX_FULLTEXTKEY
// Unique index
else if FSelectedTableKeys.FieldByName('Non_unique').AsString = '0' then
VTRowDataListColumns[j].ImageIndex := ICONINDEX_UNIQUEKEY
// Normal index
else
VTRowDataListColumns[j].ImageIndex := ICONINDEX_INDEXKEY;
// Column was found and processed
break;
end;
end;
FSelectedTableKeys.Next;
end;
{
** note, ansgarbecker, 2007-08-26
VT has a pretty autosorting feature, which keeps the sorting even after having
filled it with new data.
But: Don't use this auto-sorting here, neither automatically nor manual
because that would cause big confusion to the user if a just clicked
table displays its fields not in the natural order.
@todo Detect if the list was just refreshed (and then keep sorting)
or if another table get displayed (then don't sort, as below)
}
ListColumns.Header.SortColumn := -1;
ListColumns.Header.SortDirection := sdAscending;
finally
ListColumns.EndUpdate;
// Reselect previous selected nodes
SetVTSelection(ListColumns, SelectedCaptions);
Screen.Cursor := crDefault;
end;
pcChange( Self );
MainForm.ShowStatus( STATUS_MSG_READY );
MainForm.showstatus(ActiveDatabase + ': '+ SelectedTable + ': ' + IntToStr(ListColumns.RootNodeCount) +' column(s)', 0);
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 TMDIChild.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 TMDIChild.ExecuteNonQuery(SQLQuery: String);
begin
ExecUpdateQuery(SQLQuery);
end;
{***
Selection in ListTables is changing
}
procedure TMDIChild.ListTablesChange(Sender: TBaseVirtualTree; Node:
PVirtualNode);
begin
ValidateControls;
end;
{***
Enable/disable various buttons and menu items.
Invoked when
- active sheet changes
- highlighted database changes
- ChildWindow is activated / deactivated
@param Boolean Is this form activated in terms of our remaining MDI-functionality?
Only used with False by FormDeactivate-procedure to
deactivate various controls on mainform
}
procedure TMDIChild.ValidateControls( FrmIsFocussed: Boolean = true );
var
DBObjectSelected, TableSelected, ViewSelected,
inDbTab, inTableTab, inDataTab, inQueryTab, inDataOrQueryTab, inDataOrQueryTabNotEmpty,
FieldsSelected, FieldFocused, dummy, DBfocused : Boolean;
NodeData: PVTreeData;
SelectedNodes: TNodeArray;
begin
inDbTab := FrmIsFocussed and (PageControlMain.ActivePage = tabDatabase);
inTableTab := FrmIsFocussed and (PageControlMain.ActivePage = tabTable);
inDataTab := FrmIsFocussed and (PageControlMain.ActivePage = tabData);
inDataOrQueryTab := FrmIsFocussed and ((PageControlMain.ActivePage = tabData) or (PageControlMain.ActivePage = tabQuery));
inDataOrQueryTabNotEmpty := inDataOrQueryTab and (hoVisible in ActiveGrid.Header.Options);
inQueryTab := FrmIsFocussed and (PageControlMain.ActivePage = tabQuery);
SelectedNodes := ListTables.GetSortedSelection(False);
DBObjectSelected := (Length(SelectedNodes)>0) and FrmIsFocussed;
TableSelected := False;
ViewSelected := False;
// Check type of first selected node, to en-/disable certain menu items
if DBObjectSelected then begin
NodeData := ListTables.GetNodeData( SelectedNodes[0] );
TableSelected := (NodeData.NodeType = NODETYPE_TABLE) or (NodeData.NodeType = NODETYPE_CRASHED_TABLE);
ViewSelected := NodeData.NodeType = NODETYPE_VIEW;
end;
// Standard toolbar and main menu
MainForm.actRefresh.Enabled := FrmIsFocussed;
MainForm.actFlushHosts.Enabled := FrmIsFocussed;
MainForm.actFlushLogs.Enabled := FrmIsFocussed;
MainForm.actFlushPrivileges.Enabled := FrmIsFocussed;
MainForm.actFlushTables.Enabled := FrmIsFocussed;
MainForm.actFlushTableswithreadlock.Enabled := FrmIsFocussed;
MainForm.actFlushStatus.Enabled := FrmIsFocussed;
MainForm.actUserManager.Enabled := FrmIsFocussed;
MainForm.actMaintenance.Enabled := FrmIsFocussed;
MainForm.actInsertFiles.Enabled := FrmIsFocussed;
// PrintList should only be active if we're focussing one of the ListViews,
// at least as long we are not able to print DBGrids
MainForm.actPrintList.Enabled := FrmIsFocussed;
MainForm.actSQLhelp.Enabled := (mysql_version >= 40100) and FrmIsFocussed;
MainForm.actImportCSV.Enabled := (mysql_version >= 32206) and FrmIsFocussed;
MainForm.actExportTables.Enabled := FrmIsFocussed;
// Database tab
Mainform.actEmptyTables.Enabled := inDbTab and TableSelected;
Mainform.actEditTableProperties.Enabled := inDbTab and TableSelected;
MenuRenameTable.Enabled := inDbTab and DBObjectSelected;
Mainform.actCopyTable.Enabled := inDbTab and DBObjectSelected;
Mainform.actEditView.Enabled := inDbTab and ViewSelected and (mysql_version >= 50001);
Mainform.actCreateView.Enabled := FrmIsFocussed and (ActiveDatabase <> '') and (mysql_version >= 50001);
MainForm.actCreateDatabase.Enabled := FrmIsFocussed;
DBfocused := Assigned(DBtree.FocusedNode) and (DBtree.GetNodeLevel(DBtree.FocusedNode) = 1);
MainForm.actDropDatabase.Enabled := DBfocused and FrmIsFocussed;
MainForm.actEditDatabase.Enabled := DBfocused and FrmIsFocussed and (mysql_version >= 50002);
if mysql_version < 50002 then
MainForm.actEditDatabase.Hint := STR_NOTSUPPORTED
else
MainForm.actEditDatabase.Hint := 'Rename and/or modify character set of database';
MainForm.actDropTablesAndViews.Enabled := (DBObjectSelected and inDbTab) or ((not inQueryTab) and (SelectedTable <> '') and FrmIsFocussed);
MainForm.actCreateTable.Enabled := (ActiveDatabase <> '') and FrmIsFocussed;
Mainform.actEditTableFields.Enabled := DBObjectSelected and inDbTab;
// Table tab
FieldFocused := inTableTab and Assigned(ListColumns.FocusedNode);
FieldsSelected := inTableTab and (Length(ListColumns.GetSortedSelection(False))>0);
// Toggle state of menuitems and buttons
Mainform.actEditField.Enabled := FieldFocused and FieldsSelected;
Mainform.actCreateField.Enabled := inTableTab;
Mainform.actDropFields.Enabled := FieldsSelected;
Mainform.actEditIndexes.Enabled := inTableTab;
menuRenameColumn.Enabled := FieldFocused and FieldsSelected;
// Data tab - if query results are made editable, these will need
// to be changed to look at which tab is focused.
Mainform.actDataInsert.Enabled := inDataTab;
Mainform.actDataDelete.Enabled := inDataTab and (DataGrid.SelectedCount > 0);
Mainform.actDataFirst.Enabled := inDataTab;
Mainform.actDataLast.Enabled := inDataTab;
Mainform.actDataPostChanges.Enabled := inDataTab and DataGridHasChanges;
Mainform.actDataCancelChanges.Enabled := inDataTab and DataGridHasChanges;
// Activate export-options if we're on Data- or Query-tab
MainForm.actCopyAsCSV.Enabled := inDataOrQueryTabNotEmpty;
MainForm.actCopyAsHTML.Enabled := inDataOrQueryTabNotEmpty;
MainForm.actCopyAsXML.Enabled := inDataOrQueryTabNotEmpty;
MainForm.actExportData.Enabled := inDataOrQueryTabNotEmpty;
MainForm.actHTMLView.Enabled := inDataOrQueryTabNotEmpty;
// Query tab
MainForm.actLoadSQL.Enabled := FrmIsFocussed;
// Manually invoke OnChange event of tabset to fill helper list with data
if inQueryTab and FrmIsFocussed then
tabsetQueryHelpers.OnChange(Self, tabsetQueryHelpers.TabIndex, dummy);
ValidateQueryControls(FrmIsFocussed);
if not FrmIsFocussed then begin
// Empty "connected" and "uptime"
MainForm.showstatus('', 1);
MainForm.showstatus('', 2);
MainForm.showstatus('', 3);
end;
end;
procedure TMDIChild.ValidateQueryControls(FrmIsFocussed: Boolean = true);
var
InQueryTab, NotEmpty, HasSelection: Boolean;
begin
InQueryTab := FrmIsFocussed and (PageControlMain.ActivePage = tabQuery);
NotEmpty := FrmIsFocussed and (SynMemoQuery.GetTextLen > 0);
HasSelection := FrmIsFocussed and SynMemoQuery.SelAvail;
Mainform.actExecuteQuery.Enabled := InQueryTab and NotEmpty;
Mainform.actExecuteSelection.Enabled := InQueryTab and HasSelection;
Mainform.actExecuteLine.Enabled := InQueryTab and (SynMemoQuery.LineText <> '');
MainForm.actSaveSQL.Enabled := InQueryTab and NotEmpty;
MainForm.actSaveSQLselection.Enabled := InQueryTab and HasSelection;
MainForm.actSaveSQLSnippet.Enabled := InQueryTab and NotEmpty;
MainForm.actSaveSQLSelectionSnippet.Enabled := InQueryTab and HasSelection;
MainForm.actQueryFind.Enabled := InQueryTab and NotEmpty;
MainForm.actQueryReplace.Enabled := InQueryTab and NotEmpty;
MainForm.actQueryStopOnErrors.Enabled := InQueryTab;
MainForm.actQueryWordWrap.Enabled := InQueryTab;
Mainform.actClearQueryEditor.Enabled := InQueryTab and NotEmpty;
Mainform.actSetDelimiter.Enabled := InQueryTab;
end;
procedure TMDIChild.ShowTableData(table: WideString);
begin
dataselected := false;
PageControlMain.ActivePage := tabData;
viewdata(self);
pcChange( Self );
end;
procedure TMDIChild.ShowVariablesAndProcesses(Sender: TObject);
procedure addLVitem( caption: WideString; commandCount: Int64; totalCount: Int64 );
var
i : Integer;
tmpval : Double;
begin
SetLength( VTRowDataListCommandStats, Length(VTRowDataListCommandStats)+1 );
i := Length(VTRowDataListCommandStats)-1;
VTRowDataListCommandStats[i].ImageIndex := 25;
VTRowDataListCommandStats[i].Captions := WideStrings.TWideStringList.Create;
caption := Copy( caption, 5, Length(caption) );
caption := WideStringReplace( caption, '_', ' ', [rfReplaceAll] );
VTRowDataListCommandStats[i].Captions.Add( caption );
// Total Frequency
VTRowDataListCommandStats[i].Captions.Add( FormatNumber( commandCount ) );
// Average per hour
uptime := max(uptime, 1);
tmpval := commandCount / ( uptime / 60 / 60 );
VTRowDataListCommandStats[i].Captions.Add( FormatNumber( tmpval, 1 ) );
// Average per second
tmpval := commandCount / uptime;
VTRowDataListCommandStats[i].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[i].Captions.Add( FormatNumber( tmpval, 1 ) + ' %' );
end;
var
i : Integer;
questions : Int64;
ds : TDataSet;
SelectedCaptions: WideStrings.TWideStringList;
begin
// Prevent auto update from executing queries if the host tab is not activated
if (Sender is TTimer) and (PageControlMain.ActivePage <> tabHost) then
Exit;
// Refresh variables and process-list
Screen.Cursor := crHourglass;
// Remember selected nodes
SelectedCaptions := GetVTCaptions(ListVariables, True);
// VARIABLES
ListVariables.BeginUpdate;
ListVariables.Clear;
ds := GetResults( 'SHOW VARIABLES', false );
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);
// Tell VirtualTree the number of nodes it will display
ListVariables.RootNodeCount := Length(VTRowDataListVariables);
ListVariables.EndUpdate;
SetVTSelection( ListVariables, SelectedCaptions );
// Apply filter
if editFilterVariables.Text <> '' then
editFilterVTChange(editFilterVariables);
// Display number of listed values on tab
tabVariables.Caption := 'Variables (' + IntToStr(ListVariables.RootNodeCount) + ')';
// STATUS
uptime := 1; // avoids division by zero :)
questions := 1;
// Remember selected nodes
SelectedCaptions := GetVTCaptions(ListStatus, True);
ListStatus.BeginUpdate;
ListStatus.Clear;
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 );
VTRowDataListStatus[i-1].Captions.Add( ds.Fields[1].AsWideString );
if lowercase( ds.Fields[0].AsString ) = 'uptime' then
uptime := MakeInt(ds.Fields[1].AsString);
if lowercase( ds.Fields[0].AsString ) = 'questions' then
questions := MakeInt(ds.Fields[1].AsString);
ds.Next;
end;
// Tell VirtualTree the number of nodes it will display
ListStatus.RootNodeCount := Length(VTRowDataListStatus);
ListStatus.EndUpdate;
SetVTSelection( ListStatus, SelectedCaptions );
// Apply filter
if editFilterStatus.Text <> '' then
editFilterVTChange(editFilterStatus);
// Display number of listed values on tab
tabStatus.Caption := 'Status (' + IntToStr(ListStatus.RootNodeCount) + ')';
// Command-Statistics
SelectedCaptions := GetVTCaptions(ListCommandStats, True);
ListCommandStats.BeginUpdate;
ListCommandStats.Clear;
SetLength( VTRowDataListCommandStats, 0 );
addLVitem( ' All commands', questions, questions );
ds.First;
for i:=1 to ds.RecordCount do
begin
if LowerCase( Copy( ds.Fields[0].AsString, 1, 4 ) ) = 'com_' then
begin
addLVitem( ds.Fields[0].AsWideString, MakeInt(ds.Fields[1].AsString), questions );
end;
ds.Next;
end;
ds.Close;
FreeAndNil(ds);
// Tell VirtualTree the number of nodes it will display
ListCommandStats.RootNodeCount := Length(VTRowDataListCommandStats);
ListCommandStats.EndUpdate;
SetVTSelection( ListCommandStats, SelectedCaptions );
TimerHostUptime.Enabled := true;
TimerHostUptimeTimer(self);
TimerHostUptime.OnTimer := TimerHostUptimeTimer;
Screen.Cursor := crDefault;
ShowProcesslist(self); // look at next procedure
end;
procedure TMDIChild.ShowProcessList(sender: TObject);
var
i,j : Integer;
ds : TDataSet;
SelectedCaptions: WideStrings.TWideStringList;
begin
// No need to update if it's not visible.
if PageControlMain.ActivePage <> tabHost then exit;
if PageControlHost.ActivePage <> tabProcesslist then exit;
Screen.Cursor := crHourglass;
// Remember selected nodes
SelectedCaptions := GetVTCaptions(ListProcesses, True);
try
ListProcesses.BeginUpdate;
ListProcesses.Clear;
debug('ShowProcessList()');
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);
tabProcessList.Caption := 'Process-List (' + IntToStr(Length(VTRowDataListProcesses)) + ')';
except
on E: Exception do begin
LogSQL('Error loading process list (automatic refresh disabled): ' + e.Message);
TimerHost.Enabled := false;
end;
end;
ListProcesses.RootNodeCount := Length(VTRowDataListProcesses);
ListProcesses.EndUpdate;
// Reselect previous selected nodes
SetVTSelection( ListProcesses, SelectedCaptions );
// Apply filter
if editFilterProcesses.Text <> '' then
editFilterVTChange(editFilterProcesses);
Screen.Cursor := crDefault;
end;
procedure TMDIChild.KillProcess(Sender: TObject);
var t : Boolean;
ProcessIDs : WideStrings.TWideStringList;
i : Integer;
begin
t := TimerHost.Enabled;
TimerHost.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;
ShowVariablesAndProcesses(self);
end;
TimerHost.Enabled := t; // re-enable autorefresh timer
end;
procedure TMDIChild.PageControlHostChange(Sender: TObject);
begin
// Show processlist if it's visible now but empty yet
if ListProcesses.RootNodeCount = 0 then
ShowProcessList( self );
end;
procedure TMDIChild.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 : WideString;
col : TVirtualTreeColumn;
begin
if CurrentLine then SQL := parseSQL(SynMemoQuery.LineText)
else if Selection then SQL := parseSQL(SynMemoQuery.SelText)
else SQL := parseSQL(SynMemoQuery.Text);
if ( SQL.Count = 0 ) then
begin
LabelResultinfo.Caption := '(nothing to do)';
Exit;
end;
SQLscriptstart := GetTickCount();
LastVistaCheck := GetTickCount();
LabelResultinfo.Caption := '';
ds := nil;
try
MainForm.showstatus( 'Initializing SQL...' );
Mainform.actExecuteQuery.Enabled := false;
Mainform.actExecuteSelection.Enabled := false;
// Let EnsureActiveDatabase know that we've fired user queries.
UserQueryFiring := true;
rowsaffected := 0;
fieldcount := 0;
recordcount := 0;
ProgressBarQuery.Max := SQL.Count;
ProgressBarQuery.Position := 0;
ProgressBarQuery.Show();
MainForm.showstatus( 'Executing SQL...' );
for i := 0 to (SQL.Count - 1) do
begin
ProgressBarQuery.StepIt();
ProgressBarQuery.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 Mainform.actQueryStopOnErrors.Checked or (i = SQL.Count - 1) then begin
Screen.Cursor := crDefault;
MessageDlg( E.Message, mtError, [mbOK], 0 );
ProgressBarQuery.Hide();
Mainform.actExecuteQuery.Enabled := true;
Mainform.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;
ProgressBarQuery.Hide();
ValidateQueryControls;
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].IsInt := True;
col.Alignment := taRightJustify;
end else if ds.Fields[i].DataType in [ftFloat] then begin
FQueryGridResult.Columns[i].IsFloat := True;
col.Alignment := taRightJustify;
end else if ds.Fields[i].DataType in [ftDate, ftTime, ftDateTime, ftTimeStamp] then
FQueryGridResult.Columns[i].IsDate := True
else if ds.Fields[i].DataType in [ftWideString, ftMemo, ftWideMemo] then
FQueryGridResult.Columns[i].IsText := True
else if ds.Fields[i].DataType in [ftBlob] then
FQueryGridResult.Columns[i].IsBinary := True;
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].IsBinary 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;
viewingdata := false;
Screen.Cursor := crDefault;
MainForm.ShowStatus( STATUS_MSG_READY );
end;
end;
{**
Clicked somewhere in the field-list of the "Table"-tabsheet
}
procedure TMDIChild.ListColumnsChange(Sender: TBaseVirtualTree; Node:
PVirtualNode);
begin
ValidateControls;
end;
{ Proposal about to insert a String into synmemo }
procedure TMDIChild.SynCompletionProposal1CodeCompletion(Sender: TObject;
var Value: WideString; Shift: TShiftState; Index: Integer; EndToken: WideChar);
begin
SynCompletionProposal1.Editor.UndoList.AddGroupBreak;
end;
procedure TMDIChild.SynCompletionProposal1AfterCodeCompletion(Sender: TObject;
const Value: WideString; Shift: TShiftState; Index: Integer; EndToken: WideChar);
begin
SynCompletionProposal1.Editor.UndoList.AddGroupBreak;
end;
{ Proposal-Combobox pops up }
procedure TMDIChild.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;
procedure addTable( Fields: TFields );
var ObjName, ObjType: WideString;
begin
ObjName := Fields[0].AsWideString;
case GetDBObjectType(Fields) of
NODETYPE_CRASHED_TABLE: ObjType := 'table';
NODETYPE_TABLE: ObjType := 'table';
NODETYPE_VIEW: ObjType := 'view';
else ObjType := 'unknown';
end;
SynCompletionProposal1.InsertList.Add( ObjName );
SynCompletionProposal1.ItemList.Add( '\hspace{2}\color{'+ColorToString(SynSQLSyn1.TableNameAttri.Foreground)+'}'+ObjType+'\color{clWindowText}\column{}' + 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( '\hspace{2}\color{'+ColorToString(clTeal)+'}column\color{clWindowText}\column{}' + ds.FieldByName( 'Field' ).AsWideString + '\style{-B} ' + ds.FieldByName( 'Type' ).AsString );
ds.Next;
end;
ds.Close;
FreeAndNil(ds);
end;
begin
SynCompletionProposal1.InsertList.Clear;
SynCompletionProposal1.ItemList.Clear;
// 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(SynCompletionProposal1.Editor.Text);
for i := SynCompletionProposal1.Editor.SelStart+1024 downto SynCompletionProposal1.Editor.SelStart-1024 do
begin
if i > j then
continue;
if i < 1 then
break;
sql := SynCompletionProposal1.Editor.Text[i] + sql;
end;
// 2. Parse FROM clause to detect relevant table/view, probably aliased
rx := TRegExpr.Create;
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 := '`?(\w+)`?(\s+(AS\s+)?`?(\w+)`?)?';
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 (WideDequotedStr(SynCompletionProposal1.PreviousToken,'`') = WideDequotedStr(rx.Match[4],'`') )
or (SynCompletionProposal1.PreviousToken = rx.Match[1]) then begin
tablename := Trim(rx.Match[1]);
break;
end;
end;
end;
end;
rx.Free;
if (tablename <> '') then begin
// add columns to proposal
addColumns( tablename );
end else if SynCompletionProposal1.PreviousToken <> '' then begin
// assuming previoustoken itself is a table
addColumns( SynCompletionProposal1.PreviousToken );
end;
if Length(CurrentInput) = 0 then // makes only sense if the user has typed "database."
begin
i := Databases.IndexOf( SynCompletionProposal1.PreviousToken );
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) and (Length(CurrentInput)>0) then
begin
// Add databases
for i := 0 to Databases.Count - 1 do begin
SynCompletionProposal1.InsertList.Add(Databases[i]);
SynCompletionProposal1.ItemList.Add(Databases[i]);
end;
for i:=0 to SynCompletionProposal1.ItemList.count-1 do
SynCompletionProposal1.ItemList[i] := '\hspace{2}\color{'+ColorToString(SynSQLSyn1.TableNameAttri.Foreground)+'}database\color{clWindowText}\column{}' + SynCompletionProposal1.ItemList[i];
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( '\hspace{2}\color{'+ColorToString(SynSQLSyn1.FunctionAttri.Foreground)+'}function\color{clWindowText}\column{}' + MySQLFunctions[i].Name + '\style{-B}' + MySQLFunctions[i].Declaration );
end;
// Add keywords
for i := 0 to MYSQL_KEYWORDS.Count - 1 do
begin
SynCompletionProposal1.InsertList.Add( MYSQL_KEYWORDS[i] );
SynCompletionProposal1.ItemList.Add( '\hspace{2}\color{'+ColorToString(SynSQLSyn1.KeyAttri.Foreground)+'}keyword\color{clWindowText}\column{}'+MYSQL_KEYWORDS[i] );
end;
end;
end;
procedure TMDIChild.SynMemoQueryStatusChange(Sender: TObject; Changes:
TSynStatusChanges);
begin
ValidateQueryControls;
end;
procedure TMDIChild.TimerHostUptimeTimer(Sender: TObject);
var
days, hours, minutes, seconds : Integer;
msg: string;
begin
// Host-Uptime
days:= uptime div (60*60*24);
seconds := uptime mod (60*60*24);
hours := seconds div (60*60);
seconds := seconds mod (60*60);
minutes := seconds div 60;
seconds := seconds mod 60;
inc(uptime);
msg := Format('%d days, %.2d:%.2d:%.2d', [days,hours,minutes,seconds]);
if TimerHostUptime.Enabled then msg := Format('Uptime: %s', [msg])
else msg := '';
Mainform.showstatus(msg, 3);
end;
procedure TMDIChild.FormActivate(Sender: TObject);
begin
TimerConnected.OnTimer(self);
end;
procedure TMDIChild.FormShow(Sender: TObject);
begin
DataGridHasChanges := False;
{ TODO : only load file when autoconnected ?? }
if (paramstr(1) <> '') and Main.loadsqlfile then
try
// load sql-file from paramstr
SynMemoQuery.Lines.LoadFromFile(paramstr(1));
Main.loadsqlfile := false;
except
MessageDLG('File could not be opened: ' + paramstr(1), mtError, [mbOK], 0);
end;
//TODO:
//ds.DisableControls;
end;
{***
Rename table after checking the new name for invalid characters
}
procedure TMDIChild.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 TMDIChild.MenuRenameTableClick(Sender: TObject);
begin
// menuitem for edit table-name
ListTables.EditNode( ListTables.FocusedNode, 0 );
end;
procedure TMDIChild.TimerConnectedTimer(Sender: TObject);
begin
if not TimerConnected.Enabled then begin
MainForm.showstatus('Disconnected.', 1);
exit;
end;
inc(time_connected);
// calculate and display connection-time
MainForm.showstatus( 'Connected: ' + FormatTimeNumber(time_connected), 1 );
end;
procedure TMDIChild.Clear2Click(Sender: TObject);
begin
// clear history-memo
Screen.Cursor := crHourglass;
SynMemoSQLLog.Lines.Clear;
Screen.Cursor := crDefault;
end;
procedure TMDIChild.EditQuery1Click(Sender: TObject);
begin
// take query from history to query-tab
SynMemoQuery.Text := SynMemoSQLLog.SelText;
PageControlMain.ActivePage := tabQuery;
pcChange(self);
end;
procedure TMDIChild.Markall3Click(Sender: TObject);
begin
// select all in history
SynMemoSQLLog.SelectAll;
end;
procedure TMDIChild.ListTablesDblClick(Sender: TObject);
begin
Mainform.actEditTableFields.Execute;
end;
procedure TMDIChild.TimerConnectErrorCloseWindowTimer(Sender: TObject);
begin
// can't connect -> close MDI-Child
TimerConnectErrorCloseWindow.Enabled := false;
Mainform.Showstatus('', 1);
MainForm.ShowStatus( STATUS_MSG_READY );
close;
end;
{**
Column-title clicked -> generate "ORDER BY"
}
procedure TMDIChild.QuickFilterClick(Sender: TObject);
var
filter,value,column : WideString;
menuitem : TMenuItem;
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);
if menuitem = QF1 then
filter := column + ' =' + ' ' + esc( value )
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
// Filters with text from clipboard
else if (menuitem = QF13) or (menuitem = QF14) or (menuitem = QF15) or (menuitem = QF16) or (menuitem = QF17) then
begin
filter := menuitem.Caption;
end;
SynMemoFilter.UndoList.AddGroupBreak;
SynMemoFilter.SelectAll;
SynmemoFilter.SelText := filter;
SaveFilter(filter);
viewdata(Sender);
end;
function TMDIChild.GetFilter: WideString;
var
SomeFilter: Boolean;
reg: TRegistry;
regCrashIndicName, regFilterName: String;
begin
// Read cached WHERE-clause and set filter
if prefRememberFilters then begin
regFilterName := Utf8Encode(REGPREFIX_WHERECLAUSE + ActiveDatabase + '.' + SelectedTable);
Result := Mainform.GetRegValue(regFilterName, '', FConn.Description );
if Result <> '' then begin
// Check for crash indicator on current table
regCrashIndicName := Utf8Encode(REGPREFIX_CRASH_IN_DATA + ActiveDatabase + '.' + SelectedTable);
if(Mainform.GetRegValue(regCrashIndicName, False, FConn.Description)) then begin
LogSQL('A crash in the previous data loading for this table ('+SelectedTable+') was detected. Filter was automatically reset to avoid the same crash for now.');
Result := '';
reg := TRegistry.Create;
reg.OpenKey( REGPATH + REGKEY_SESSIONS + FConn.Description, true );
// Filter was nuked. Reset crash indicator.
reg.DeleteValue(regFilterName);
reg.CloseKey;
reg.Free;
end;
end;
end else
Result := SynMemoFilter.Text;
SomeFilter := Result <> '';
if SomeFilter then tbtnDataFilter.ImageIndex := 108
else tbtnDataFilter.ImageIndex := 107;
// Ensure filter panel is visible
if SomeFilter then
ToggleFilterPanel(True);
// Hide it if it was auto opened previously
if (not SomeFilter) and pnlFilter.Visible and (not FilterPanelManuallyOpened) then
ToggleFilterPanel;
if SynMemoFilter.Text <> Result then begin
SynMemoFilter.UndoList.AddGroupBreak;
SynMemoFilter.SelectAll;
SynMemoFilter.SelText := Result;
end;
SynMemoFilterChange(Self);
end;
procedure TMDIChild.SaveFilter(Clause: WideString = '');
var
regname: String;
begin
// Store whereclause in Registry
if prefRememberFilters then begin
Mainform.regMain.openkey( REGPATH + REGKEY_SESSIONS + FConn.Description, false );
regname := REGPREFIX_WHERECLAUSE + ActiveDatabase + '.' + SelectedTable;
if Clause <> '' then Mainform.regMain.WriteString( regname, Clause )
else if Mainform.regMain.ValueExists( regname ) then Mainform.regMain.DeleteValue( regname );
end
end;
procedure TMDIChild.DropFilter1Click(Sender: TObject);
begin
// Drop Filter
SaveFilter;
viewdata(Sender);
end;
// select all tables
procedure TMDIChild.selectall1Click(Sender: TObject);
begin
ListTables.SelectAll(False);
end;
procedure TMDIChild.popupQueryPopup(Sender: TObject);
begin
// Sets cursor into memo and activates TAction(s) like paste
SynMemoQuery.SetFocus;
end;
procedure TMDIChild.popupResultGridPopup(Sender: TObject);
begin
// data available?
// MainForm.Save2CSV.enabled :=
end;
procedure TMDIChild.controlsKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
Grid : TVirtualStringTree;
CB: TUniClipboard;
begin
// Check for F1-pressed
if Key = VK_F1 then
Mainform.actSQLhelp.Execute
// Simulate Ctrl+A-behaviour of common editors
else if ( Shift = [ssCtrl] ) and ( Key = Ord('A') ) then
begin
if Sender is TCustomEdit then
TCustomEdit(Sender).SelectAll;
end
// Enable copy + paste shortcuts in dbgrids
else if (Sender is TVirtualStringTree) and (not TVirtualStringTree(Sender).IsEditing)
and (Shift = [ssCtrl]) and (Assigned(TVirtualStringTree(Sender).FocusedNode))
then begin
Grid := Sender as TVirtualStringTree;
// TODO: Clipboard.AsText is not Unicode safe!
if Key = Ord('C') then
CopyToClipboard(Grid.Text[Grid.FocusedNode, Grid.FocusedColumn])
else if Key = Ord('V') then begin
CB := TUniClipboard.Create;
Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := CB.AsWideString;
end
else if Key = Ord('X') then begin
CopyToClipboard(Grid.Text[Grid.FocusedNode, Grid.FocusedColumn]);
Grid.Text[Grid.FocusedNode, Grid.FocusedColumn] := '';
end;
end;
end;
procedure TMDIChild.Autoupdate1Click(Sender: TObject);
var
seconds : String;
secondsInt : Integer;
begin
// set interval for autorefresh-timer
seconds := IntToStr(TimerHost.interval div 1000);
if inputquery('Auto-refresh processlist','Update list every ... seconds:', seconds) then begin
secondsInt := StrToIntDef(seconds, 0);
if secondsInt > 0 then begin
TimerHost.Interval := secondsInt * 1000;
TimerHost.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 TMDIChild.EnableAutoRefreshClick(Sender: TObject);
begin
// enable autorefresh-timer
TimerHost.Enabled := true;
EnableAutoRefresh.Checked := true;
DisableAutoRefresh.Checked := false;
end;
procedure TMDIChild.DisableAutoRefreshClick(Sender: TObject);
begin
// enable autorefresh-timer
TimerHost.Enabled := false;
EnableAutoRefresh.Checked := false;
DisableAutoRefresh.Checked := true;
end;
procedure TMDIChild.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 TMDIChild.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 TMDIChild.SynMemoQueryDropFiles(Sender: TObject; X, Y: Integer;
AFiles: TWideStrings);
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 TMDIChild.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 TMDIChild.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 TMDIChild.popupTreeViewPopup(Sender: TObject);
var
L: Cardinal;
begin
// toggle drop-items and remember right-clicked item
if DBtree.GetFirstSelected = nil then
L := 0
else
L := DBtree.GetNodeLevel(DBtree.GetFirstSelected);
Mainform.actCreateTable.Enabled := L in [1,2];
Mainform.actCreateView.Enabled := (L in [1,2]) and (mysql_version >= 50001);
Mainform.actEditTableProperties.Enabled := (L = 2) and ((GetSelectedNodeType = NODETYPE_TABLE) or (GetSelectedNodeType = NODETYPE_CRASHED_TABLE));
Mainform.actEditView.Enabled := (L = 2) and (GetSelectedNodeType = NODETYPE_VIEW);
MainForm.actDropTablesAndViews.Enabled := (L = 2);
end;
procedure TMDIChild.QueryLoad( filename: String; ReplaceContent: Boolean = true );
var
filecontent : WideString;
msgtext : String;
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
Mainform.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
Mainform.AddOrRemoveFromQueryLoadHistory( filename, true );
Mainform.FillPopupQueryLoad;
PagecontrolMain.ActivePage := tabQuery;
SynCompletionProposal1.Editor.UndoList.AddGroupBreak;
SynMemoQuery.BeginUpdate;
if ReplaceContent then
SynMemoQuery.SelectAll;
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 TMDIChild.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';
end;
end;
end;
{**
A cell in a DBGrid is painted. Sets custom background color NULL fields.
}
procedure TMDIChild.popupDataGridPopup(Sender: TObject);
var
y,m,d,h,i,s,ms : Word;
cpText, selectedColumn, value : String;
const
CLPBRD : String = 'CLIPBOARD';
begin
{DONE -oFrancisco -cData-browsing:Bugfix: [1650528] Access violation with F5}
if Assigned(DataGrid.FocusedNode) and (DataGrid.FocusedColumn > -1) then
begin
DataInsertDateTime.Enabled := FDataGridResult.Columns[DataGrid.FocusedColumn].IsDate;
if DataInsertDateTime.Enabled then
begin
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]);
end;
// Manipulate the Quick-filter menuitems
selectedColumn := mask(DataGrid.Header.Columns[DataGrid.FocusedColumn].Text);
// 1. block: include selected columnname and value from datagrid in caption
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 ) + '%''';
// 2. block: include only selected columnname in caption
QF8.Caption := selectedColumn + ' = "..."';
QF9.Caption := selectedColumn + ' != "..."';
QF10.Caption := selectedColumn + ' > "..."';
QF11.Caption := selectedColumn + ' < "..."';
QF12.Caption := selectedColumn + ' LIKE "%...%"';
// 3. block: include selected columnname and clipboard-content in caption for one-click-filtering
cpText := Clipboard.AsText;
if Length(cpText) < 100 then
begin
QF13.Enabled := true; QF13.Caption := selectedColumn + ' = ' + esc( cpText );
QF14.Enabled := true; QF14.Caption := selectedColumn + ' != ' + esc( cpText );
QF15.Enabled := true; QF15.Caption := selectedColumn + ' > ' + esc( cpText );
QF16.Enabled := true; QF16.Caption := selectedColumn + ' < ' + esc( cpText );
QF17.Enabled := true; QF17.Caption := selectedColumn + ' LIKE ''%' + esc( cpText, true ) + '%''';
end
else
begin
QF13.Enabled := false; QF13.Caption := selectedColumn + ' = ' + CLPBRD;
QF14.Enabled := false; QF14.Caption := selectedColumn + ' != ' + CLPBRD;
QF15.Enabled := false; QF15.Caption := selectedColumn + ' > ' + CLPBRD;
QF16.Enabled := false; QF16.Caption := selectedColumn + ' < ' + CLPBRD;
QF17.Enabled := false; QF17.Caption := selectedColumn + ' LIKE %' + CLPBRD + '%';
end;
end;
end;
procedure TMDIChild.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 TMDIChild.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 TMDIChild.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 TMDIChild.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 TMDIChild.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 TMDIChild.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 TMDIChild.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;
{***
This returns the GridResult object that is currently visible to the user,
depending on with tabsheet is active.
@return PGridResult if data/query tab is active, nil otherwise.
}
function TMDIChild.GetVisualDataset: PGridResult;
begin
Result := nil;
case PageControlMain.ActivePageIndex of
3: Result := @FDataGridResult;
4: Result := @FQueryGridResult;
end;
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 TMDIChild.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 TMDIChild.ZSQLMonitor1LogTrace(Sender: TObject;
Event: TZLoggingEvent);
begin
LogSQL( Event.Message, (Event.Category <> lcExecute) );
end;
procedure TMDIChild.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 TMDIChild.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;
// Searchbox unfocused
function TMDIChild.mask(str: WideString) : WideString;
begin
result := maskSql(mysql_version, str);
end;
procedure TMDIChild.CheckConnection;
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);
// 1) CheckConnection is always called from
// within an FQueryRunning-enabled block.
// 2) PerformConnect (see below) will make calls
// that open an FQueryRunning block, causing an
// error message.
//
// Therefore, flick the state of the running
// flag before running PerformConnect().
FQueryRunning := false;
try
FMysqlConn.Connection.Reconnect;
PerformConnect;
finally
FQueryRunning := true;
end;
end;
end;
function TMDIChild.GetActiveGrid: TVirtualStringTree;
begin
Result := nil;
if PageControlMain.ActivePage = tabData then Result := DataGrid
else if PageControlMain.ActivePage = tabQuery then Result := QueryGrid;
end;
function TMDIChild.GetActiveData: PGridResult;
begin
Result := nil;
if PageControlMain.ActivePage = tabData then Result := @FDataGridResult
else if PageControlMain.ActivePage = tabQuery then Result := @FQueryGridResult;
end;
function TMDIChild.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 TMDIChild.GetSelectedTable: WideString;
begin
if DBtree.GetFirstSelected = nil then Result := ''
else case DBtree.GetNodeLevel(DBtree.GetFirstSelected) of
2: Result := DBtree.Text[DBtree.GetFirstSelected, 0];
else Result := '';
end;
end;
function TMDIChild.GetNodeType(Node: PVirtualNode): Byte;
var
ds: TDataset;
begin
Result := NODETYPE_DEFAULT;
if Assigned(Node) then case DBtree.GetNodeLevel(Node) of
1: Result := NODETYPE_DB;
2: begin
ds := FetchDbTableList(DBTree.Text[Node.Parent, 0]);
ds.RecNo := Node.Index+1;
Result := GetDBObjectType(ds.Fields);
end;
end;
end;
function TMDIChild.GetSelectedNodeType: Byte;
begin
Result := GetNodeType(DBtree.GetFirstSelected);
end;
procedure TMDIChild.SetSelectedTable(table: WideString);
var
i: integer;
dbnode, tnode, snode: PVirtualNode;
begin
// 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] = table 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], table) = 0 then begin
snode := tnode;
break;
end;
tnode := DBtree.GetNext(tnode);
end;
end;
if Assigned(snode) then begin
// Ensure table node will be visible
DBtree.Expanded[dbnode] := True;
DBtree.Selected[snode] := True;
exit;
end;
raise Exception.Create('Table node ' + table + ' not found in tree.');
end;
procedure TMDIChild.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 TMDIChild.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 TMDIChild.tabsetQueryHelpersChange(Sender: TObject; NewTab: Integer;
var AllowChange: Boolean);
var
i : 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 <> '' then for i := 0 to High(VTRowDataListColumns) do
begin
lboxQueryHelpers.Items.Add(VTRowDataListColumns[i].Captions[0]);
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 MYSQL_KEYWORDS.Count - 1 do
lboxQueryHelpers.Items.Add(MYSQL_KEYWORDS[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
if (Length(QueryHelpersSelectedItems[NewTab]) > 0)
and (Length(QueryHelpersSelectedItems[NewTab]) <= lboxQueryHelpers.Count) then
begin
for i := 0 to Length(QueryHelpersSelectedItems[NewTab]) - 1 do begin
lboxQueryHelpers.Selected[QueryHelpersSelectedItems[NewTab][i]] := True;
end;
end;
lboxQueryHelpers.Items.EndUpdate;
end;
{**
Insert string from listbox with query helpers into SQL
memo at doubleclick
}
procedure TMDIChild.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 <20>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 TMDIChild.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 TMDIChild.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;
end;
{**
Activate inline-item-editor of listColumns
}
procedure TMDIChild.menuRenameColumnClick(Sender: TObject);
begin
ListColumns.EditNode(ListColumns.FocusedNode, 0);
end;
{**
Rename a column name from within listColumns
}
procedure TMDIChild.ListColumnsNewText(Sender: TBaseVirtualTree; Node:
PVirtualNode; Column: TColumnIndex; NewText: WideString);
var
def : TDataSet;
sql_update, sql_null, sql_default, sql_extra, sql_comment, DefaultValue : WideString;
NodeData : PVTreeData;
begin
// Try to rename, on any error abort and don't rename ListItem
try
ensureValidIdentifier( NewText );
// Fetch data from listitem
NodeData := ListColumns.GetNodeData(Node);
// Fetch column definition
def := GetResults( 'SHOW FULL COLUMNS FROM ' + mask(SelectedTable) + ' LIKE ' + esc(NodeData.Captions[0]), False, False );
// Check NOT NULL
sql_null := 'NULL ';
if UpperCase(def.FieldByName('Null').AsString) = 'NO' then
sql_null := 'NOT NULL ';
// Check default value, take care of non-literals / functions
sql_default := '';
DefaultValue := def.FieldByName('Default').AsWideString;
if DefaultValue <> '' then
begin
if (UpperCase(def.FieldByName('Type').AsString) <> 'TIMESTAMP') and (DefaultValue <> 'CURRENT_TIMESTAMP') then
DefaultValue := esc(DefaultValue);
sql_default := 'DEFAULT ' + DefaultValue + ' ';
end;
// Check extra options (auto_increment)
sql_extra := '';
if def.FieldByName('Extra').AsString <> '' then
sql_extra := ' '+WideUpperCase(def.FieldByName('Extra').AsString);
// Comment
sql_comment := '';
if def.FieldByName('Comment').AsWideString <> '' then
sql_comment := ' COMMENT '+esc(def.FieldByName('Comment').AsWideString);
// Concat column definition
sql_update := 'ALTER TABLE ' + mask(SelectedTable) +
' CHANGE ' + mask(NodeData.Captions[0]) +
' ' + mask(NewText) + ' ' +
def.FieldByName('Type').AsString + ' ' +
sql_null +
sql_default +
sql_extra +
sql_comment;
// Cleanup
def.Close;
FreeAndNil(def);
// Fire ALTER query
ExecUpdateQuery( sql_update, False, False );
FSelectedTableColumns := nil;
FSelectedTableKeys := nil;
// Update listitem
NodeData.Captions[0] := NewText;
except
On E : Exception do
begin
MessageDlg( E.Message, mtError, [mbOK], 0 );
end;
end;
end;
{**
Delete a snippet file
}
procedure TMDIChild.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 );
Mainform.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 TMDIChild.menuInsertSnippetAtCursorClick(Sender: TObject);
begin
QueryLoad( DIRNAME_SNIPPETS + lboxQueryHelpers.Items[lboxQueryHelpers.ItemIndex] + '.sql', False );
end;
{**
Load snippet and replace content
}
procedure TMDIChild.menuLoadSnippetClick(Sender: TObject);
begin
QueryLoad( DIRNAME_SNIPPETS + lboxQueryHelpers.Items[lboxQueryHelpers.ItemIndex] + '.sql', True );
end;
{**
Open snippets-directory in Explorer
}
procedure TMDIChild.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 TMDIChild.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 TMDIChild.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 TMDIChild.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 TMDIChild.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 TMDIChild.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 TMDIChild.vstHeaderClick(Sender: TVTHeader; Column:
TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
// Don't call sorting procedure on right click
// Some list-headers have a contextmenu which should popup then.
if Button = mbRight then
Exit;
if Sender.SortColumn <> Column then
Sender.SortColumn := Column
else if Sender.SortDirection = sdAscending then
Sender.SortDirection := sdDescending
else
Sender.SortDirection := sdAscending;
Sender.Treeview.SortTree( Column, Sender.SortDirection );
end;
{**
Sorting a column of a VirtualTree by comparing two cells
}
procedure TMDIChild.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 gets painted. Adjust background color of sorted column.
}
procedure TMDIChild.vstBeforePaint(Sender: TBaseVirtualTree;
TargetCanvas: TCanvas);
var
i : Integer;
h : TVTHeader;
begin
h := TVirtualStringTree(Sender).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 TMDIChild.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 if VT = ListColumns then
Result := @VTRowDataListColumns
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 TMDIChild.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;
if P = @VTRowDataListColumns then Exit;
raise Exception.Create('Assertion failed: Invalid global VT array.');
end;
{**
Click on popupDBGridHeader
}
procedure TMDIChild.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 TMDIChild.SaveListSetup( List: TVirtualStringTree );
var
i : Byte;
ColWidths, ColsVisible, ColPos : String;
reg : TRegistry;
begin
reg := TRegistry.Create;
reg.OpenKey( REGPATH, true );
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;
reg.WriteString( REGPREFIX_COLWIDTHS + List.Name, ColWidths );
reg.WriteString( REGPREFIX_COLSVISIBLE + List.Name, ColsVisible );
reg.WriteString( REGPREFIX_COLPOS + List.Name, ColPos );
FreeAndNil(reg);
end;
{**
Restore setup of VirtualStringTree from registry
}
procedure TMDIChild.RestoreListSetup( List: TVirtualStringTree );
var
i : Byte;
colwidth, colpos : Integer;
Value : WideString;
ValueList : WideStrings.TWideStringList;
begin
ValueList := WideStrings.TWideStringList.Create;
// Column widths
Value := Mainform.GetRegValue(REGPREFIX_COLWIDTHS + List.Name, '');
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 := Mainform.GetRegValue(REGPREFIX_COLSVISIBLE + List.Name, '');
if Value <> '' then begin
ValueList := Explode( ',', Value );
SetVisibleListColumns( List, ValueList );
end;
// Column position
Value := Mainform.GetRegValue(REGPREFIX_COLPOS + List.Name, '');
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 TMDIChild.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 TMDIChild.ActivateFileLogging;
var
LogfilePattern : String;
i : Integer;
begin
// Ensure directory exists
ForceDirectories( DirnameSessionLogs );
// Determine free filename if it's emtpy yet
if FileNameSessionLog = '' then
begin
LogfilePattern := '%s %.6u.log';
i := 1;
FileNameSessionLog := DirnameSessionLogs + goodfilename(Format(LogfilePattern, [FConn.Description, i]));
while FileExists( FileNameSessionLog ) do
begin
inc(i);
FileNameSessionLog := DirnameSessionLogs + goodfilename(Format(LogfilePattern, [FConn.Description, i]));
end;
end;
// Be sure file is closed before we (re-)open it
DeactivateFileLogging;
// 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 TMDIChild.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 TMDIChild.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 TMDIChild.menuLogToFileClick(Sender: TObject);
var
reg : TRegistry;
OldprefLogToFile: Boolean;
begin
OldprefLogToFile := prefLogToFile;
if not prefLogToFile then
ActivateFileLogging
else
DeactivateFileLogging;
// Save option
if prefLogToFile <> OldprefLogToFile then
begin
reg := TRegistry.Create;
reg.OpenKey(REGPATH, true);
reg.WriteBool('LogToFile', prefLogToFile);
reg.Free;
end;
end;
{**
Open folder with session logs
}
procedure TMDIChild.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 TMDIChild.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 TMDIChild.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;
function TMDIChild.HandleOrderColumns( AddOrderCol: TOrderCol = nil ): TOrderColArray;
var
i, j : Integer;
reg : TRegistry;
reg_name : WideString;
old_orderclause, new_orderclause, columnname : WideString;
order_parts, ValidColumns : WideStrings.TWideStringList;
columnexists : Boolean;
regCrashIndicName: String;
begin
SetLength( Result, 0 );
// Read ORDER clause from registry
reg_name := Utf8Encode(REGPREFIX_ORDERCLAUSE + ActiveDatabase + '.' + SelectedTable);
old_orderclause := Utf8Decode(Mainform.GetRegValue(reg_name, '', FConn.Description));
if old_orderclause <> '' then
begin
// Check for crash indicator on current table
regCrashIndicName := Utf8Encode(REGPREFIX_CRASH_IN_DATA + ActiveDatabase + '.' + SelectedTable);
if(Mainform.GetRegValue(regCrashIndicName, False, FConn.Description)) then begin
LogSQL('A crash in the previous data loading for this table ('+SelectedTable+') was detected. A stored ORDER clause was automatically reset to avoid the same crash for now.');
reg := TRegistry.Create;
reg.OpenKey( REGPATH + REGKEY_SESSIONS + FConn.Description, true );
// Remove ORDER BY clause from registry
reg.DeleteValue(reg_name);
reg.CloseKey;
reg.Free;
end else begin
// Parse ORDER clause
order_parts := explode( ',', old_orderclause );
ValidColumns := GetVTCaptions( ListColumns );
for i := 0 to order_parts.Count - 1 do
begin
columnname := Trim( Copy( order_parts[i], 0, LastPos( ' ', order_parts[i] ) ) );
columnname := WideDequotedStr(columnname, '`');
columnexists := ValidColumns.IndexOf(columnname) > -1;
if not columnexists then
begin
LogSQL( 'Notice: A stored ORDER-BY clause could not be applied, '+
'because the column "' + columnname + '" does not exist!');
Continue;
end;
// Add part of order clause to result array
SetLength(Result, Length(Result)+1);
Result[Length(Result)-1] := TOrderCol.Create;
Result[Length(Result)-1].ColumnName := columnname;
Result[Length(Result)-1].SortDirection := Integer( Copy( order_parts[i], ( Length( order_parts[i] ) - 3 ), 4 ) = 'DESC' );
end;
end;
end;
// Add a new order column after a columns title has been clicked
if AddOrderCol <> nil then
begin
// Check if order column is already existant
columnexists := False;
for i := Low(Result) to High(Result) do
begin
if Result[i].ColumnName = AddOrderCol.ColumnName then
begin
// AddOrderCol is already in the list. Switch its direction:
// ASC > DESC > [delete col]
columnexists := True;
if Result[i].SortDirection = ORDER_ASC then
Result[i].SortDirection := ORDER_DESC
else
begin
// Delete order col
for j := i to High(Result) - 1 do
Result[j] := Result[j+1];
SetLength(Result, Length(Result)-1);
end;
// We found the matching column, no need to loop further
break;
end;
end;
if not columnexists then
begin
SetLength(Result, Length(Result)+1);
Result[Length(Result)-1] := AddOrderCol;
end;
end;
// Update registry
new_orderclause := ComposeOrderClause(Result);
if new_orderclause <> old_orderclause then
begin
reg := TRegistry.Create();
reg.OpenKey( REGPATH + REGKEY_SESSIONS + FConn.Description, true );
if new_orderclause <> '' then
reg.WriteString(reg_name , Utf8Encode(new_orderclause))
else
reg.DeleteValue(reg_name);
reg.Free;
end;
end;
{**
Concat all sort options to a ORDER clause
}
function TMDIChild.ComposeOrderClause(Cols: TOrderColArray): WideString;
var
i : Integer;
sort : String;
begin
result := '';
for i := 0 to Length(Cols) - 1 do
begin
if result <> '' then
result := result + ', ';
if Cols[i].SortDirection = ORDER_ASC then
sort := TXT_ASC
else
sort := TXT_DESC;
result := result + Mainform.Mask( Cols[i].ColumnName ) + ' ' + sort;
end;
end;
{**
Fetch table engines from server
Currently used in tbl_properties and createtable
}
procedure TMDIChild.TableEnginesCombo(var Combobox: TCombobox);
var
engineName, defaultEngine, engineSupport : String;
HaveEngineList : TStrings;
begin
Combobox.Items.BeginUpdate;
Combobox.Items.Clear;
// Cache datasets
if (dsShowEngines = nil) and (dsHaveEngines = nil) then
begin
dsShowEngines := Mainform.Childwin.GetResults('SHOW ENGINES', True);
if dsShowEngines = nil then
dsHaveEngines := Mainform.Childwin.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 TMDIChild.ListProcessesChange(Sender: TBaseVirtualTree; Node:
PVirtualNode);
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 TMDIChild.editFilterVTChange(Sender: TObject);
var
Node : PVirtualNode;
NodeData : PVTreeData;
VT : TVirtualStringTree;
Edit : TEdit;
i : Integer;
match : Boolean;
search : String;
somefiltered : Boolean;
begin
// Find the correct VirtualTree that shall be filtered
if Sender = editFilterVariables then
VT := ListVariables
else if Sender = editFilterStatus then
VT := ListStatus
else if Sender = editFilterProcesses then
VT := ListProcesses
else
Raise Exception.Create('editFilterVTChange() called with wrong sender control ('+(Sender as TControl).Name+')' );
Edit := Sender as TEdit;
// Loop through all nodes to adjust their vsVisible state
Node := VT.GetFirst;
search := LowerCase( Edit.Text );
somefiltered := False;
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
Node.States := Node.States + [vsVisible]
else
Node.States := Node.States - [vsVisible];
if (not somefiltered) and (not match) then
somefiltered := True;
Node := VT.GetNext(Node);
end;
// Colorize TEdit with filter string to signalize that some nodes are hidden now
if somefiltered then begin
Edit.Font.Color := clRed;
Edit.Color := clYellow;
end else begin
Edit.Font.Color := clWindowText;
Edit.Color := clWindow;
end;
// Needs a refresh to apply visible states
VT.Refresh;
end;
procedure TMDIChild.ListVariablesDblClick(Sender: TObject);
begin
menuEditVariable.Click;
end;
{**
Edit a server variable
}
procedure TMDIChild.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;
{**
Apply icons to tabs of query helpers box
}
procedure TMDIChild.tabsetQueryHelpersGetImageIndex(Sender: TObject; TabIndex:
Integer; var ImageIndex: Integer);
begin
case TabIndex of
0: ImageIndex := 42;
1: ImageIndex := 13;
2: ImageIndex := 25;
3: ImageIndex := 35;
end;
end;
{**
The database tree doesn't use any structure for its nodes.
}
procedure TMDIChild.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 TMDIChild.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.Fields[0].AsWideString;
end;
end;
1: case GetNodeType(Node) of
// Calculate and display the sum of all table sizes in ALL dbs if all table lists are cached
NODETYPE_DEFAULT: begin
AllListsCached := true;
for i := 0 to Databases.Count - 1 do begin
if not DbTableListCached(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.
NODETYPE_DB: begin
db := DBtree.Text[Node, 0];
if not DbTableListCached(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;
NODETYPE_TABLE: 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 TMDIChild.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
NODETYPE_TABLE:
if Kind = ikSelected then
ImageIndex := ICONINDEX_TABLE_HIGHLIGHT
else ImageIndex := ICONINDEX_TABLE;
NODETYPE_VIEW:
if Kind = ikSelected then
ImageIndex := ICONINDEX_VIEW_HIGHLIGHT
else ImageIndex := ICONINDEX_VIEW;
NODETYPE_CRASHED_TABLE:
if Kind = ikSelected then
ImageIndex := ICONINDEX_CRASHED_TABLE_HIGHLIGHT
else ImageIndex := ICONINDEX_CRASHED_TABLE;
end;
end;
end;
end;
{**
Set childcount of an expanding treenode
}
procedure TMDIChild.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;
mainform.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]);
Mainform.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 "<db name>.<table name>" seems to make more sense..
for i := 0 to Databases.Count - 1 do
SynSQLSyn1.TableNames.Add(Databases[i]);
SynSQLSyn1.TableNames.EndUpdate;
finally
MainForm.ShowStatus( STATUS_MSG_READY );
Screen.Cursor := crDefault;
end;
end;
// DB node expanding
1: begin
Screen.Cursor := crHourglass;
mainform.Showstatus( 'Reading Tables...' );
try
ds := FetchDbTableList(Databases[Node.Index]);
ChildCount := ds.RecordCount;
finally
MainForm.ShowStatus( STATUS_MSG_READY );
Screen.Cursor := crDefault;
end;
end;
else Exit;
end;
end;
{**
Set initial options of a treenode
}
procedure TMDIChild.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 TMDIChild.DBtreeChange(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
newDb: WideString;
begin
if not Assigned(Node) then
Exit;
case Sender.GetNodeLevel(Node) of
0: ShowHost;
1: begin
newDb := Databases[Node.Index];
ShowDatabase( newDb );
end;
2: begin
newDb := Databases[Node.Parent.Index];
ShowTable( (Sender as TVirtualStringTree).Text[Node, 0] );
end;
end;
if newDb <> '' then
LoadDatabaseProperties(newDb);
if PageControlMain.ActivePage = tabData then
viewData(self);
end;
procedure TMDIChild.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 TMDIChild.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 database tab
}
procedure TMDIChild.MenuRefreshClick(Sender: TObject);
begin
RefreshTreeDB(ActiveDatabase);
LoadDatabaseProperties(ActiveDatabase);
end;
{**
Refresh whole database tree
}
procedure TMDIChild.menuRefreshDBTreeClick(Sender: TObject);
begin
RefreshTree(True);
end;
{**
Refresh the whole tree
}
procedure TMDIChild.RefreshTree(DoResetTableCache: Boolean; SelectDatabase: WideString = '');
var
oldActiveDatabase, oldSelectedTable, db: WideString;
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 <> '' then SelectedTable := oldSelectedTable;
except
end;
DBTree.EndUpdate;
end;
{**
Refresh one database node in the db tree
}
procedure TMDIChild.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 TMDIChild.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 TMDIChild.menuTreeExpandAllClick(Sender: TObject);
begin
DBtree.FullExpand;
DBtree.ScrollIntoView(DBtree.GetFirstSelected, False);
end;
{**
Collapse all db nodes
}
procedure TMDIChild.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 TMDIChild.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 TMDIChild.DbTableListCached(db: WideString): Boolean;
begin
Result := CachedTableLists.IndexOf(db) > -1;
end;
procedure TMDIChild.editFilterSearchChange(Sender: TObject);
var
Add, Clause: WideString;
i: Integer;
ed: TEdit;
begin
ed := TEdit(Sender);
Clause := '';
Add := '';
if ed.Text <> '' then begin
for i := 0 to Length(VTRowDataListColumns) - 1 do begin
if i > 0 then
Add := Add + ' OR ';
Add := Add + mask(VTRowDataListColumns[i].Captions[0]) + ' LIKE ' + esc('%'+ed.Text+'%');
if Length(Add) > 45 then begin
Clause := Clause + Add + CRLF;
Add := '';
end;
end;
if Add <> '' then
Clause := Clause + Add;
end;
SynMemoFilter.UndoList.AddGroupBreak;
SynMemoFilter.SelectAll;
SynMemoFilter.SelText := Clause;
SynMemoFilterChange(Sender);
end;
procedure TMDIChild.ListColumnsDblClick(Sender: TObject);
begin
Mainform.actEditField.Execute;
end;
procedure TMDIChild.SynMemoFilterChange(Sender: TObject);
var
SomeText: Boolean;
begin
SomeText := (SynMemoFilter.GetTextLen > 0) or (editFilterSearch.Text <> '');
Mainform.actClearFilterEditor.Enabled := SomeText;
end;
procedure TMDIChild.ToggleFilterPanel(ForceVisible: Boolean = False);
var
ShowIt: Boolean;
begin
ShowIt := ForceVisible or (not pnlFilter.Visible);
tbtnDataFilter.Down := ShowIt;
pnlFilter.Visible := ShowIt;
end;
procedure TMDIChild.editFilterSearchEnter(Sender: TObject);
begin
// Enables triggering apply button with Enter
btnFilterApply.Default := True;
end;
procedure TMDIChild.editFilterSearchExit(Sender: TObject);
begin
btnFilterApply.Default := False;
end;
procedure TMDIChild.EnsureNodeLoaded(Sender: TBaseVirtualTree; Node: PVirtualNode; WhereClause: String);
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;
// 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
MainForm.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
MainForm.ShowStatus('Filling grid with record-data...');
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].IsBinary 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;
MainForm.ShowStatus( STATUS_MSG_READY );
FreeAndNil(ds);
end;
end;
procedure TMDIChild.EnsureChunkLoaded(Sender: TBaseVirtualTree; Node: PVirtualNode);
var
res: PGridResult;
start, limit: Cardinal;
query: WideString;
ds: TDataSet;
i, j: LongInt;
reg: TRegistry;
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;
query := DataGridCurrentSelect;
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
reg := TRegistry.Create;
reg.OpenKey( REGPATH + REGKEY_SESSIONS + FConn.Description, true );
regCrashIndicName := Utf8Encode(REGPREFIX_CRASH_IN_DATA + ActiveDatabase + '.' + SelectedTable);
reg.WriteBool(regCrashIndicName, True);
// start query
MainForm.ShowStatus('Retrieving data...');
debug(Format('mem: loading data chunk from row %d to %d', [start, limit]));
ds := GetResults(query);
if Cardinal(ds.RecordCount) < limit then begin
limit := ds.RecordCount;
TVirtualStringTree(Sender).RootNodeCount := start + limit;
SetLength(res.Rows, start + limit);
end;
debug(Format('mem: loaded data chunk from row %d to %d', [start, limit]));
// Query was completed successfully. Reset crash indicator.
reg.DeleteValue(regCrashIndicName);
reg.CloseKey;
reg.Free;
// fill in data
MainForm.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].IsBinary 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;
MainForm.ShowStatus( STATUS_MSG_READY );
FreeAndNil(ds);
end;
end;
procedure TMDIChild.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 TMDIChild.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 prefEnableNullBG and (c.IsNull or c.NewIsNull) then begin
// Don't display any text if NULL background was activated. In most cases better readable
CellText := '';
end else 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 TMDIChild.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 TMDIChild.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];
// Do not apply any color on a selected, highlighted node to keep readability
if vsSelected in Node.States then
Exit;
// NULL value
isNull := r.Rows[Node.Index].Cells[Column].IsNull;
// Numeric field
if r.Columns[Column].isInt or r.Columns[Column].isFloat then
if isNull then cl := prefNullColorNumeric else cl := prefFieldColorNumeric
// Date field
else if r.Columns[Column].isDate then
if isNull then cl := prefNullColorDatetime else cl := prefFieldColorDatetime
// Text field
else if r.Columns[Column].isText then
if isNull then cl := prefNullColorText else cl := prefFieldColorText
// Text field
else if r.Columns[Column].isBinary then
if isNull then cl := prefNullColorBinary else cl := prefFieldColorBinary
// Enum field
else if r.Columns[Column].isEnum then
if isNull then cl := prefNullColorEnum else cl := prefFieldColorEnum
// Set field
else if r.Columns[Column].isSet then
if isNull then cl := prefNullColorSet else cl := prefFieldColorSet
else
if isNull then cl := prefNullColorDefault else cl := clWindowText;
TargetCanvas.Font.Color := cl;
end;
procedure TMDIChild.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
Mainform.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 TMDIChild.DataGridHeaderClick(Sender: TVTHeader; Column:
TColumnIndex; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
c : TOrderCol;
frm: TForm;
begin
if Button = mbLeft then begin
c := TOrderCol.Create;
c.ColumnName := Sender.Columns[Column].Text;
HandleOrderColumns(c);
ViewData(Sender);
end else begin
frm := TColumnSelectionForm.Create(self);
// Position new form relative to btn's position
frm.Top := Y + DataGrid.ClientOrigin.Y - Integer(DataGrid.Header.Height);
frm.Left := X + DataGrid.ClientOrigin.X;
// Display form
frm.Show;
end;
end;
{**
Only allow grid editing if there is a good key available
}
procedure TMDIChild.setNULL1Click(Sender: TObject);
begin
if not CheckUniqueKeyClause then
Exit;
DataGrid.Text[DataGrid.FocusedNode, DataGrid.FocusedColumn] := '';
FDataGridResult.Rows[DataGrid.FocusedNode.Index].Cells[DataGrid.FocusedColumn].NewIsNull := True;
FDataGridResult.Rows[DataGrid.FocusedNode.Index].Cells[DataGrid.FocusedColumn].Modified := True;
FDataGridResult.Rows[DataGrid.FocusedNode.Index].State := grsModified;
DataGridHasChanges := True;
DataGrid.RepaintNode(DataGrid.FocusedNode);
ValidateControls;
end;
{**
Content of a grid cell was modified
}
procedure TMDIChild.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;
end;
{**
Checks if there is a unique key available which can be used for UPDATEs and INSERTs
}
function TMDIChild.CheckUniqueKeyClause: Boolean;
var
mres: Integer;
begin
Result := GetKeyColumns.Count > 0;
if not Result then begin
mres := MessageDlg('Grid editing is 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
MainForm.actEditIndexesExecute(DataGrid);
end;
end;
{**
DataGrid: node focus has changed
}
procedure TMDIChild.DataGridChange(Sender: TBaseVirtualTree; Node:
PVirtualNode);
begin
ValidateControls;
end;
{**
DataGrid: node and/or column focus is about to change. See if we allow that.
}
procedure TMDIChild.DataGridFocusChanging(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex; var Allowed:
Boolean);
begin
// Detect changed focus and update row
if Assigned(OldNode) and Assigned(NewNode) and (OldNode <> NewNode) then
Allowed := DataGridPostUpdateOrInsert(OldNode)
else
Allowed := True;
end;
{**
DataGrid: invoke update or insert routine
}
function TMDIChild.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 TMDIChild.GridPostUpdate(Sender: TBaseVirtualTree): Boolean;
var
i: Integer;
sql, Val: WideString;
Row: PGridRow;
begin
sql := 'UPDATE '+mask(SelectedTable)+' 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].IsFloat then Val := FloatStr(Val);
if not FDataGridResult.Columns[i].IsBinary then Val := esc(Val);
if FDataGridResult.Columns[i].IsBinary then CheckHex(Copy(Val, 3), 'Invalid hexadecimal string given in field "' + FDataGridResult.Columns[i].Name + '".');
if Val = '0x' then Val := esc('');
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
ExecUpdateQuery(sql, False, True);
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 TMDIChild.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;
end;
{**
Compose a WHERE clause used for UPDATEs and DELETEs
}
function TMDIChild.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].IsFloat then KeyVal := FloatStr(KeyVal);
if not FDataGridResult.Columns[j].IsBinary then KeyVal := esc(KeyVal);
if KeyVal = '0x' then KeyVal := esc('');
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 TMDIChild.GetKeyColumns: WideStrings.TWideStringlist;
var
i: Integer;
AllowsNull: Boolean;
procedure FindColumns(const KeyName: WideString);
begin
// Find relevant key column names
Result.Clear;
FSelectedTableKeys.First;
while not FSelectedTableKeys.Eof do begin
if FSelectedTableKeys.FieldByName('Key_name').AsWideString = KeyName then
Result.Add(FSelectedTableKeys.FieldByName('Column_name').AsWideString);
FSelectedTableKeys.Next;
end;
end;
begin
Result := WideStrings.TWideStringlist.Create;
// Find best key for updates
FSelectedTableKeys.First;
// 1. round: find a primary key
while not FSelectedTableKeys.Eof do begin
if FSelectedTableKeys.FieldByName('Key_name').AsWideString = 'PRIMARY' then begin
FindColumns(FSelectedTableKeys.FieldByName('Key_name').AsWideString);
Exit;
end;
FSelectedTableKeys.Next;
end;
// no primary key available -> 2. round: find a unique key
FSelectedTableKeys.First;
while not FSelectedTableKeys.Eof do begin
if FSelectedTableKeys.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(FSelectedTableKeys.FieldByName('Key_name').AsWideString);
FSelectedTableColumns.First;
AllowsNull := False;
for i := 0 to Result.Count - 1 do begin
while (not FSelectedTableColumns.Eof) and (not AllowsNull) do begin
if FSelectedTableColumns.FieldByName('Field').AsWideString = Result[i] then
AllowsNull := UpperCase(FSelectedTableColumns.FieldByName('Null').AsString) = 'YES';
FSelectedTableColumns.Next;
end;
if AllowsNull then break;
end;
if AllowsNull then Result.Clear
else break;
end;
FSelectedTableKeys.Next;
end;
end;
{**
DataGrid: compose and fire UPDATE query
}
procedure TMDIChild.DataGridInsertRow;
var
i, j: Integer;
begin
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.AddChild(nil);
DataGrid.FocusedNode := DataGrid.GetLast;
DataGrid.ClearSelection;
DataGrid.Selected[DataGrid.FocusedNode] := True;
DataGridHasChanges := True;
ValidateControls;
end;
{**
DataGrid: compose and fire INSERT query
}
function TMDIChild.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
FSelectedTableColumns.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].IsFloat then Val := FloatStr(Val);
if not FDataGridResult.Columns[i].IsBinary then Val := esc(Val);
if FDataGridResult.Columns[i].IsBinary then CheckHex(Copy(Val, 3), 'Invalid hexadecimal string given in field "' + FDataGridResult.Columns[i].Name + '".');
if Val = '0x' then Val := esc('');
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;
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(SelectedTable)+' ('+Cols+') VALUES ('+Vals+')';
// Send INSERT query
ExecUpdateQuery(sql, False, True);
Result := True;
Row.Loaded := false;
EnsureNodeLoaded(Sender, Node, GetWhereClause(Row, @FDataGridResult.Columns));
GridFinalizeEditing(Sender);
end;
end;
{**
DataGrid: compose and fire DELETE query
}
function TMDIChild.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)+' WHERE';
while Assigned(Node) do begin
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 TMDIChild.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
Mainform.actDataLastExecute(Sender);
end;
end;
DataGridHasChanges := False;
ValidateControls;
end;
procedure TMDIChild.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
Mainform.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).
procedure TMDIChild.EnsureFullWidth(Grid: TBaseVirtualTree; Column: TColumnIndex; Node: PVirtualNode);
var
Data: PGridResult;
Cell: PGridCell;
Row: PGridRow;
Col: PGridColumn;
sql: WideString;
len: Int64;
ds: TDataSet;
begin
// 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.IsBinary) 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
sql :=
'SELECT ' + mask(Col.Name) +
' FROM ' + mask(SelectedTable) +
' WHERE ' + GetWhereClause(Row, @Data.Columns)
;
ds := GetResults(sql);
if Col.IsBinary then Cell.Text := '0x' + BinToWideHex(ds.Fields[0].AsString)
else Cell.Text := ds.Fields[0].AsWideString;
Cell.IsNull := ds.Fields[0].IsNull;
end;
end;
procedure TMDIChild.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"
Mainform.actDataCancelChanges.ShortCut := 0;
Mainform.actDataPostChanges.ShortCut := 0;
EnsureFullWidth(Sender, Column, Node);
end;
end;
procedure TMDIChild.DataGridEdited(Sender: TBaseVirtualTree; Node:
PVirtualNode; Column: TColumnIndex);
begin
// Reassign Esc to "Cancel row editing" action
Mainform.actDataCancelChanges.ShortCut := TextToShortcut('Esc');
Mainform.actDataPostChanges.ShortCut := TextToShortcut('Ctrl+Enter');
AutoCalcColWidths(DataGrid, PrevTableColWidths);
end;
procedure TMDIChild.DataGridEditCancelled(Sender: TBaseVirtualTree; Column:
TColumnIndex);
begin
// Reassign Esc to "Cancel row editing" action
Mainform.actDataCancelChanges.ShortCut := TextToShortcut('Esc');
Mainform.actDataPostChanges.ShortCut := TextToShortcut('Ctrl+Enter');
end;
procedure TMDIChild.DataGridCreateEditor(Sender: TBaseVirtualTree; Node:
PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
var
MemoEditor: TMemoEditorLink;
DateTimeEditor: TDateTimeEditorLink;
EnumEditor: TEnumEditorLink;
SetEditor: TSetEditorLink;
begin
if
(FDataGridResult.Columns[Column].IsText and prefEnableTextEditor) or
(FDataGridResult.Columns[Column].IsBinary and prefEnableBinaryEditor)
then begin
MemoEditor := TMemoEditorLink.Create;
MemoEditor.MaxLength := FDataGridResult.Columns[Column].MaxLength;
EditLink := MemoEditor;
end else if FDataGridResult.Columns[Column].IsDate and prefEnableDatetimeEditor then begin
DateTimeEditor := TDateTimeEditorLink.Create;
DateTimeEditor.DataType := FDataGridResult.Columns[Column].DataType;
EditLink := DateTimeEditor;
end else if FDataGridResult.Columns[Column].IsEnum and prefEnableEnumEditor then begin
EnumEditor := TEnumEditorLink.Create;
EnumEditor.ValueList := FDataGridResult.Columns[Column].ValueList;
EditLink := EnumEditor;
end else if FDataGridResult.Columns[Column].IsSet and prefEnableSetEditor then begin
SetEditor := TSetEditorLink.Create;
SetEditor.ValueList := FDataGridResult.Columns[Column].ValueList;
EditLink := SetEditor;
end else
EditLink := TStringEditLink.Create;
end;
function TMDIChild.GetSelTableColumns: TDataset;
begin
if FLastSelectedTableColumns = nil then
FLastSelectedTableColumns := GetResults( 'SHOW /*!32332 FULL */ COLUMNS FROM ' + mask(SelectedTable), false );
Result := FLastSelectedTableColumns;
end;
function TMDIChild.GetSelTableKeys: TDataset;
begin
if FLastSelectedTableKeys = nil then
FLastSelectedTableKeys := GetResults( 'SHOW KEYS FROM ' + mask(SelectedTable) );
Result := FLastSelectedTableKeys;
end;
procedure TMDIChild.menuShowSizeColumnClick(Sender: TObject);
var
reg: TRegistry;
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];
reg := TRegistry.Create;
reg.OpenKey(REGPATH, true);
reg.WriteBool(REGNAME_SIZECOL_TREE, NewVal);
reg.CloseKey;
FreeAndNil(reg);
end;
procedure TMDIChild.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;
// 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
Rect := Tree.GetDisplayRect(Node, i, True, True);
ColTextWidth := Max(ColTextWidth, Rect.Right - Rect.Left);
inc(j);
if j > 100 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;
Tree.EndUpdate;
end;
procedure TMDIChild.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 TMDIChild.DBtreeClick(Sender: TObject);
begin
// Auto resize "Size" column in dbtree when needed
if coVisible in DBTree.Header.Columns[1].Options then
DBTree.Header.AutoFitColumns(False, smaUseColumnOption, 1, 1);
end;
procedure TMDIChild.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;
if prefEnableNullBG and gr.Rows[Node.Index].Cells[Column].IsNull then begin
TargetCanvas.Brush.Color := prefNullBG;
TargetCanvas.FillRect(CellRect);
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink