diff --git a/components/heidisql/include/const.inc b/components/heidisql/include/const.inc
index a9b05348..f2733a8d 100644
--- a/components/heidisql/include/const.inc
+++ b/components/heidisql/include/const.inc
@@ -128,6 +128,8 @@ const
REGNAME_SQLHELPWINHEIGHT = 'SQLHelp_WindowHeight';
REGNAME_SQLHELPPLWIDTH = 'SQLHelp_PnlLeftWidth';
REGNAME_SQLHELPPRHEIGHT = 'SQLHelp_PnlRightTopHeight';
+ REGNAME_PROCEDITOR_WIDTH = 'ProcedureEditorWidth';
+ REGNAME_PROCEDITOR_HEIGHT = 'ProcedureEditorHeight';
REGNAME_HOST = 'Host';
DEFAULT_HOST = '127.0.0.1';
REGNAME_USER = 'User';
@@ -254,6 +256,8 @@ const
ICONINDEX_VIEW_HIGHLIGHT = 82;
ICONINDEX_CRASHED_TABLE_HIGHLIGHT = -1;
ICONINDEX_CRASHED_TABLE = -1;
+ ICONINDEX_STOREDPROCEDURE = 119;
+ ICONINDEX_STOREDFUNCTION = 35;
// Size of byte units
{KiloByte} SIZE_KB = 1024;
diff --git a/packages/delphi11/heidisql.dpr b/packages/delphi11/heidisql.dpr
index 3f2934ac..dd869bcc 100644
--- a/packages/delphi11/heidisql.dpr
+++ b/packages/delphi11/heidisql.dpr
@@ -41,7 +41,8 @@ uses
bineditor in '..\..\source\bineditor.pas' {frmBinEditor},
grideditlinks in '..\..\source\grideditlinks.pas',
uVistaFuncs in '..\..\source\uVistaFuncs.pas',
- dataviewsave in '..\..\source\dataviewsave.pas' {FrmDataViewSave};
+ dataviewsave in '..\..\source\dataviewsave.pas' {FrmDataViewSave},
+ routine_editor in '..\..\source\routine_editor.pas' {frmRoutineEditor};
{$R ..\..\res\icon.RES}
{$R ..\..\res\version.RES}
diff --git a/packages/delphi11/heidisql.dproj b/packages/delphi11/heidisql.dproj
index 7ed1920f..31c73551 100644
--- a/packages/delphi11/heidisql.dproj
+++ b/packages/delphi11/heidisql.dproj
@@ -134,6 +134,9 @@
+
+
+
diff --git a/res/icons/go_both.png b/res/icons/go_both.png
new file mode 100644
index 00000000..5b5392d9
Binary files /dev/null and b/res/icons/go_both.png differ
diff --git a/res/icons/go_left.png b/res/icons/go_left.png
new file mode 100644
index 00000000..ef575c2c
Binary files /dev/null and b/res/icons/go_left.png differ
diff --git a/res/icons/go_right.png b/res/icons/go_right.png
new file mode 100644
index 00000000..a82664e1
Binary files /dev/null and b/res/icons/go_right.png differ
diff --git a/res/icons/script_gear.png b/res/icons/script_gear.png
new file mode 100644
index 00000000..56fcf84a
Binary files /dev/null and b/res/icons/script_gear.png differ
diff --git a/source/grideditlinks.pas b/source/grideditlinks.pas
index 6d038ce3..c52684de 100644
--- a/source/grideditlinks.pas
+++ b/source/grideditlinks.pas
@@ -65,6 +65,7 @@ type
procedure ComboKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
public
ValueList: TWideStringList;
+ AllowCustomText: Boolean;
constructor Create;
destructor Destroy; override;
function BeginEdit: Boolean; virtual; stdcall;
@@ -443,6 +444,7 @@ end;
constructor TEnumEditorLink.Create;
begin
inherited;
+ AllowCustomText := False;
end;
@@ -506,11 +508,16 @@ begin
FColumn := Column;
FCombo := TTnTComboBox.Create(Tree);
FCombo.Parent := FTree;
- // Set style to OwnerDraw, otherwise we wouldn't be able to adjust the combo's height
- FCombo.Style := csOwnerDrawFixed;
for i := 0 to ValueList.Count - 1 do
FCombo.Items.Add(ValueList[i]);
- FCombo.ItemIndex := FCombo.Items.IndexOf(FTree.Text[FNode, FColumn]);
+ if AllowCustomText then begin
+ FCombo.Style := csDropDown;
+ FCombo.Text := FTree.Text[FNode, FColumn];
+ end else begin
+ // Set style to OwnerDraw, otherwise we wouldn't be able to adjust the combo's height
+ FCombo.Style := csOwnerDrawFixed;
+ FCombo.ItemIndex := FCombo.Items.IndexOf(FTree.Text[FNode, FColumn]);
+ end;
FCombo.SetFocus;
FCombo.OnKeyDown := ComboKeyDown;
end;
diff --git a/source/helpers.pas b/source/helpers.pas
index 45ef5544..41fe3bc0 100644
--- a/source/helpers.pas
+++ b/source/helpers.pas
@@ -186,7 +186,7 @@ type
procedure ResetVTNodes(Sender: TBaseVirtualTree);
procedure EnableProgressBar(MaxValue: Integer);
function CompareNumbers(List: TStringList; Index1, Index2: Integer): Integer;
-
+ function ListIndexByRegExpr(List: TWideStrings; Expression: WideString): Integer;
var
MYSQL_KEYWORDS : TStringList;
MainReg : TRegistry;
@@ -2958,6 +2958,25 @@ begin
end;
+function ListIndexByRegExpr(List: TWideStrings; Expression: WideString): Integer;
+var
+ rx: TRegExpr;
+ i: Integer;
+begin
+ // Find item in stringlist by passing a regular expression
+ rx := TRegExpr.Create;
+ rx.Expression := Expression;
+ rx.ModifierI := True;
+ Result := -1;
+ for i := 0 to List.Count - 1 do begin
+ if rx.Exec(List[i]) then begin
+ Result := i;
+ break;
+ end;
+ end;
+ FreeAndNil(rx);
+end;
+
initialization
diff --git a/source/main.dfm b/source/main.dfm
index f9f33975..e8fc0aba 100644
--- a/source/main.dfm
+++ b/source/main.dfm
@@ -294,7 +294,7 @@ object MainForm: TMainForm
object ToolBarDatabase: TToolBar
Left = 407
Top = 2
- Width = 161
+ Width = 184
Height = 22
Align = alNone
AutoSize = True
@@ -337,6 +337,11 @@ object MainForm: TMainForm
Top = 0
Action = actCopyTable
end
+ object btnDBCreateRoutine: TToolButton
+ Left = 161
+ Top = 0
+ Action = actCreateRoutine
+ end
end
object ToolBarQuery: TToolBar
Left = 398
@@ -2423,6 +2428,13 @@ object MainForm: TMainForm
ShortCut = 16449
OnExecute = actSelectAllExecute
end
+ object actCreateRoutine: TAction
+ Category = 'Database'
+ Caption = 'Create stored routine ...'
+ Hint = 'Create stored routine|Create stored procedure or function'
+ ImageIndex = 119
+ OnExecute = actCreateRoutineExecute
+ end
end
object SaveDialog2: TSaveDialog
DefaultExt = 'reg'
@@ -5788,6 +5800,98 @@ object MainForm: TMainForm
50555366888F0D87EB0300ABBCD31120BDDC3E0000000049454E44AE426082}
Name = 'PngImage118'
Background = clWindow
+ end
+ item
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C0000033E4944415478DA5593694C134114C7FFBBDBC536959422
+ 4255CAA98D168D82F70989C603CF180D06F08826C62F95C633866FC60F1EF188
+ 1A356A830A0A887C50A284C32B6804AD31A411902A056D48CAE101424BB7BBEB
+ DB161B9DE497D9CCCCFBCDDB37338C2CCB50DACE07DFE6517721254ABD705890
+ A0204812BC01E9178D0F127D8448FC20FA8962A296F92BD85EE6B2CC348CBD78
+ 286B3CFE6D437E92113F7C22FC02303022A2B3EF37AA3F0F7DA7696B589057E2
+ 3C9199A22FDCBB2806DF7E8AE019062A06E054040744B0D4B32C78FAF6056434
+ BA8671A3A9BB372CD856D47271FDF4584BCEEC18B4F749B49802684AC585042C
+ C9406B27E938586F75E1747E22CED677222CD87ABDB964FB7C635EA6291AEDBD
+ 02588AA0CD43C18A040C3892A48CE770D0E6C0A6A5F1B8FCE26B7758B0F9F2BB
+ BA8295A615C9315A74F44B2440280B1205FB51D98C093CF22FD8E1E3E5011ADA
+ 12166C38F7AAFD4C6EC614BFC4C33344634C685745A434AFF33902821FABB3D7
+ 21EF4A13BC7E61DCA3034BBE87056B4F3E1DB9579015D1EA11314487C5523033
+ E086D0DF017EE22CA0C701898E759A793A9ED4BF0027F98B76EDC8DF1D14AC3A
+ 5EAD5171EC70E5D19568EA1220212415BEBC44727232DC6E370C060365C3C2E5
+ 72C16834A2AAAA4A116A8382E5850F13745A755719095E770AC16AD32942E8FD
+ 028356445B5B1B5A5A5AA0D16860369B11171787C6C6C6228BC512CA20EBF0FD
+ A9B1FAC8D6B263ABF1AA330051A20BD45A135C989090009BCD86A53987114F47
+ 585379036BB3B3E17038D0DCDC0C66F1FEE218CAF6EAA6CC8C2DB9CBA7A2BED5
+ 0FAD9A2ECBC74A444747232D2D0DB5B5B5485FB313497A0EF7EFDC44E6B22568
+ 686880DD6E07B3609F2D87044549F1B19A9424137E8FC8104419524084817523
+ 3B5D8FC1C1417C7276D06592618C9F84C8C848545454D87C3EDF1166EE9E6BA7
+ 3666CD3C5298BFE0BF37400E14DFBE15FC67A7D30993C904AFD71B2C626A6A2A
+ CACBCBA94E8C8AC9D87169DFA2F4C957E7991311355683289D1A7AED18E888F7
+ 6F9EA1A6FA31F61758F1EE6D133C1E0FFAE438743BEAE4402050575A5ABA8A99
+ 957B5EA981954824C68DA21F45A78EE079B59A47BAA60D3D3D3DF828CF6957DE
+ DE87BB56BB92E91FC57C618DF121CA350000000049454E44AE426082}
+ Name = 'PngImage119'
+ Background = clWindow
+ end
+ item
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001874455874536F667477617265005061696E742E4E45542076332E33
+ 36A9E7E2250000012D4944415478DA6364A010308E00038A963AFDFFF4F31DC3
+ 9CA40B8C641990BDC8E6BFA8802CC3B5A7E7185665DE64246840DE129BFF0CFF
+ FF30FCFA07C47FFE32480A2A33E8C9DA309CBABF8FE1CAD3D30C3B0B9F33E235
+ 206B91D97F579D7886BFFFFF31FCFDF797E11FC37F86171F9E3008F288311CBF
+ BB87E1FCE3A30CA72ABF31E23420699EC17F2FFD6486876F6E33FC06BAE2CFBF
+ DF0CBFFFFE666062626310E3956138726F27C3990727196E36FE61C46A40D42C
+ 8DFF7E06E9408D7F19FEFCFD0B76C9F38F8F1884782480B61F63D87D63E78D07
+ 2D0C9A385D10304DE1EF8F5FBF8061F08BE1C79FDF0CCA225A4C164A6E0C671E
+ 1D63D87B6BF7A5472D0CFA24C5825613E36B1339479103B7F69D7DD4C6604272
+ 342AD430BCFEFB8F59E471DB5FF2D2012130F00600002C1881115D33879F0000
+ 000049454E44AE426082}
+ Name = 'PngImage122'
+ Background = clWindow
+ end
+ item
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001874455874536F667477617265005061696E742E4E45542076332E33
+ 36A9E7E225000001244944415478DA6364A010300E630352E619FCE7631762E8
+ 8BDEC748B20161D3D5FF6B491B31BCFEF098616ADC11D20C70EF97FCAF236DCA
+ 60A6E8C470E9F11186E7EFEF32B0B13033B031B10055B3304C8A4135108563D6
+ CEF5DF50D69AC152D985E1FD97570C1202320C4C4025CC4CCC0CCC8C4C0CBBAF
+ 2C649816770ABB01EAF52CFF4D14CC196C94DC195E7D7EC2F0EFDF2F06566656
+ 061626560656A0EDF222AA0CDB2ECE6598977401B70B146A18AEBB6AB86B18CA
+ 5A31BCFBF28241925F0E6C330B3333D02066864D1766322C4BBB81DB001090AB
+ 61B8E8ACE6AA672267C570E2DE2E86BB6FAEFDE360610586011B03071B1BC386
+ AC07CC046341AE8AE18C839A93F19947FBDF5CABFB2F4A563A90AD62FECFCCF4
+ F7CD831606F20C20160CBC0100DB5A4E11E73E07AB0000000049454E44AE4260
+ 82}
+ Name = 'PngImage121'
+ Background = clWindow
+ end
+ item
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001874455874536F667477617265005061696E742E4E45542076332E33
+ 36A9E7E225000001C14944415478DA6364A010300E430352E619FCE7631762E8
+ 8BDE872257B4D4E9FFA79FEF18E6245D60C46940D874F5FF5AD2460CAF3F3C66
+ 981A7704452E7B91CD7F510159866B4FCF31ACCABCC98861807BBFE47F1D6953
+ 06334527864B8F8F303C7F7F97818D8599818D8905A88A8581974B82414FD686
+ E1D4FD7D0C579E9E66D859F89C116E80593BD77F43596B064B651786F75F5E31
+ 4808C8303001A598999819981999187EFFFBC3F0F7DF3F86171F9F3008F28831
+ 1CBFBB87E1FCE3A30CA72ABF3132AAD7B3FC37513067B051726778F5F909C3BF
+ 7FBF18589959195898409885E1FFFF7F0C4C4C8C0C3F7EFF64F8F5F71790CDC6
+ 20C62BC370E4DE4E86330F4E425CA050C370DD55C35DC350D68AE1DD97170C92
+ FC72609B599899818630035DF097E1F7EFDF0CCF3E3D6210E29100DA7E8C61F7
+ 8D9D371EB43068C2C340AE86E1A2B39AAB9E899C15C3897BBB18EEBEB9C6C0C1
+ C2CAC0CAC8CAC0C1C6C6C0C729C560A1E4C670E6D13186BDB7765F7AD4C2A08F
+ 110B72550C671CD49C8CCF3CDAFFE65ADD7F516439AD26C6D726728E22076EED
+ 3BFBA88DC104673A90AD62FECFCCF4F70DD079280600BDF9FAEF3F6691C76D7F
+ 71A703AAA444BA1B0000092995BA9A525B530000000049454E44AE426082}
+ Name = 'PngImage120'
+ Background = clWindow
end>
PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
Left = 104
@@ -5917,6 +6021,9 @@ object MainForm: TMainForm
object Createview2: TMenuItem
Action = actCreateView
end
+ object actCreateRoutine1: TMenuItem
+ Action = actCreateRoutine
+ end
object Exporttables1: TMenuItem
Action = actExportTables
end
diff --git a/source/main.pas b/source/main.pas
index a7154d1b..012b43e4 100644
--- a/source/main.pas
+++ b/source/main.pas
@@ -22,7 +22,7 @@ uses
SynCompletionProposal, ZSqlMonitor, SynEditHighlighter, SynHighlighterSQL,
TntStdCtrls, Tabs, SynUnicode, mysqlconn, EditVar, helpers, queryprogress,
mysqlquery, createdatabase, createtable, tbl_properties, SynRegExpr,
- WideStrUtils, ZDbcLogging, ExtActns, CommCtrl;
+ WideStrUtils, ZDbcLogging, ExtActns, CommCtrl, routine_editor;
type
TMainForm = class(TForm)
@@ -459,6 +459,9 @@ type
N26: TMenuItem;
actSessionManager: TAction;
Sessionmanager1: TMenuItem;
+ actCreateRoutine: TAction;
+ actCreateRoutine1: TMenuItem;
+ btnDBCreateRoutine: TToolButton;
procedure refreshMonitorConfig;
procedure loadWindowConfig;
procedure saveWindowConfig;
@@ -731,6 +734,7 @@ type
procedure actSelectAllExecute(Sender: TObject);
procedure EnumerateRecentFilters;
procedure LoadRecentFilter(Sender: TObject);
+ procedure actCreateRoutineExecute(Sender: TObject);
private
FDelimiter: String;
ServerUptime : Integer;
@@ -788,6 +792,7 @@ type
UserManagerForm: TUserManagerForm;
SelectDBObjectForm: TfrmSelectDBObject;
SQLHelpForm: TfrmSQLhelp;
+ RoutineEditForm: TfrmRoutineEditor;
DatabasesWanted,
Databases : Widestrings.TWideStringList;
TemporaryDatabase : WideString;
@@ -1189,6 +1194,7 @@ begin
SaveListSetup(ListColumns);
FreeAndNil(CreateTableForm);
+ FreeAndNil(RoutineEditForm);
debug('mem: clearing query and browse data.');
SetLength(FDataGridResult.Rows, 0);
@@ -4390,6 +4396,7 @@ begin
actCopyTable.Enabled := inDbTab and DBObjectSelected;
actEditView.Enabled := inDbTab and ViewSelected and (mysql_version >= 50001);
actCreateView.Enabled := FrmIsFocussed and (ActiveDatabase <> '') and (mysql_version >= 50001);
+ actCreateRoutine.Enabled := FrmIsFocussed and (ActiveDatabase <> '') and (mysql_version >= 50003);
actCreateDatabase.Enabled := FrmIsFocussed;
DBfocused := Assigned(DBtree.FocusedNode) and (DBtree.GetNodeLevel(DBtree.FocusedNode) = 1);
actDropDatabase.Enabled := DBfocused and FrmIsFocussed;
@@ -9021,5 +9028,13 @@ begin
end;
+procedure TMainForm.actCreateRoutineExecute(Sender: TObject);
+begin
+ if not Assigned(RoutineEditForm) then
+ RoutineEditForm := TfrmRoutineEditor.Create(Self);
+ RoutineEditForm.ShowModal;
+end;
+
+
end.
diff --git a/source/routine_editor.dfm b/source/routine_editor.dfm
new file mode 100644
index 00000000..e8f33f5a
--- /dev/null
+++ b/source/routine_editor.dfm
@@ -0,0 +1,326 @@
+object frmRoutineEditor: TfrmRoutineEditor
+ Left = 0
+ Top = 0
+ Caption = 'Stored routine editor'
+ ClientHeight = 464
+ ClientWidth = 384
+ Color = clBtnFace
+ Constraints.MinHeight = 500
+ Constraints.MinWidth = 400
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poMainFormCenter
+ OnClose = FormClose
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnShow = FormShow
+ DesignSize = (
+ 384
+ 464)
+ PixelsPerInch = 96
+ TextHeight = 13
+ object lblName: TLabel
+ Left = 8
+ Top = 11
+ Width = 31
+ Height = 13
+ Caption = '&Name:'
+ FocusControl = editName
+ end
+ object lblType: TLabel
+ Left = 8
+ Top = 36
+ Width = 28
+ Height = 13
+ Caption = '&Type:'
+ end
+ object lblReturns: TLabel
+ Left = 8
+ Top = 61
+ Width = 42
+ Height = 13
+ Caption = '&Returns:'
+ FocusControl = comboReturns
+ end
+ object lblParameters: TLabel
+ Left = 8
+ Top = 187
+ Width = 59
+ Height = 13
+ Caption = 'Parameters:'
+ end
+ object lblSQL: TLabel
+ Left = 8
+ Top = 87
+ Width = 62
+ Height = 13
+ Caption = '&Data access:'
+ FocusControl = comboDataAccess
+ end
+ object lblSecurity: TLabel
+ Left = 8
+ Top = 112
+ Width = 65
+ Height = 13
+ Caption = 'SQL Se&curity:'
+ FocusControl = comboSecurity
+ end
+ object lblComment: TLabel
+ Left = 8
+ Top = 137
+ Width = 49
+ Height = 13
+ Caption = '&Comment:'
+ FocusControl = editComment
+ end
+ object lblSQLcode: TLabel
+ Left = 8
+ Top = 317
+ Width = 68
+ Height = 13
+ Caption = '&Routine body:'
+ end
+ object btnApply: TButton
+ Left = 301
+ Top = 432
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Caption = 'Apply'
+ TabOrder = 3
+ OnClick = PostChanges
+ end
+ object btnCancel: TButton
+ Left = 220
+ Top = 432
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Cancel = True
+ Caption = 'Cancel'
+ ModalResult = 2
+ TabOrder = 2
+ end
+ object btnOK: TButton
+ Left = 139
+ Top = 432
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Caption = 'OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 1
+ OnClick = PostChanges
+ end
+ object btnHelp: TButton
+ Left = 8
+ Top = 432
+ Width = 75
+ Height = 25
+ Anchors = [akLeft, akBottom]
+ Caption = 'Help'
+ TabOrder = 0
+ OnClick = btnHelpClick
+ end
+ object comboReturns: TComboBox
+ Left = 100
+ Top = 58
+ Width = 276
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ ItemHeight = 13
+ TabOrder = 4
+ Text = 'comboReturns'
+ OnChange = Modification
+ end
+ object comboType: TTntComboBox
+ Left = 100
+ Top = 33
+ Width = 276
+ Height = 21
+ Style = csDropDownList
+ Anchors = [akLeft, akTop, akRight]
+ ItemHeight = 13
+ TabOrder = 5
+ OnSelect = comboTypeSelect
+ end
+ object editName: TTntEdit
+ Left = 100
+ Top = 8
+ Width = 276
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 6
+ Text = 'editName'
+ OnChange = editNameChange
+ end
+ object tlbParameters: TToolBar
+ Left = 8
+ Top = 206
+ Width = 72
+ Height = 84
+ Align = alNone
+ ButtonWidth = 66
+ Caption = 'tlbParameters'
+ Images = MainForm.PngImageListMain
+ List = True
+ ShowCaptions = True
+ TabOrder = 7
+ object btnAddParam: TToolButton
+ Left = 0
+ Top = 0
+ Caption = 'Add'
+ ImageIndex = 45
+ Wrap = True
+ OnClick = btnAddParamClick
+ end
+ object btnRemoveParam: TToolButton
+ Left = 0
+ Top = 22
+ Caption = 'Remove'
+ ImageIndex = 46
+ Wrap = True
+ OnClick = btnRemoveParamClick
+ end
+ object btnClearParams: TToolButton
+ Left = 0
+ Top = 44
+ Caption = 'Clear'
+ ImageIndex = 26
+ OnClick = btnClearParamsClick
+ end
+ end
+ object listParameters: TVirtualStringTree
+ Left = 100
+ Top = 206
+ Width = 276
+ Height = 100
+ Anchors = [akLeft, akTop, akRight]
+ DragImageKind = diMainColumnOnly
+ DragMode = dmAutomatic
+ DragType = dtVCL
+ EditDelay = 0
+ Header.AutoSizeIndex = 1
+ Header.Font.Charset = DEFAULT_CHARSET
+ Header.Font.Color = clWindowText
+ Header.Font.Height = -11
+ Header.Font.Name = 'Tahoma'
+ Header.Font.Style = []
+ Header.MainColumn = 1
+ Header.Options = [hoAutoResize, hoColumnResize, hoDblClickResize, hoDrag, hoVisible]
+ Header.ParentFont = True
+ Images = MainForm.PngImageListMain
+ NodeDataSize = 0
+ TabOrder = 8
+ TreeOptions.MiscOptions = [toAcceptOLEDrop, toEditable, toFullRepaintOnResize, toGridExtensions, toInitOnSave, toToggleOnDblClick, toWheelPanning]
+ TreeOptions.PaintOptions = [toShowButtons, toShowDropmark, toShowHorzGridLines, toShowVertGridLines, toThemeAware, toUseBlendedImages, toFullVertGridLines]
+ TreeOptions.SelectionOptions = [toExtendedFocus, toFullRowSelect]
+ WantTabs = True
+ OnBeforePaint = listParametersBeforePaint
+ OnCreateEditor = listParametersCreateEditor
+ OnEditing = listParametersEditing
+ OnFocusChanged = listParametersFocusChanged
+ OnGetText = listParametersGetText
+ OnPaintText = listParametersPaintText
+ OnGetImageIndex = listParametersGetImageIndex
+ OnNewText = listParametersNewText
+ Columns = <
+ item
+ Options = [coAllowClick, coDraggable, coEnabled, coParentBidiMode, coParentColor, coShowDropMark, coVisible, coFixed, coAllowFocus]
+ Position = 0
+ Width = 25
+ WideText = '#'
+ end
+ item
+ Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus]
+ Position = 1
+ Width = 87
+ WideText = 'Name'
+ end
+ item
+ Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus]
+ Position = 2
+ Width = 90
+ WideText = 'Datatype'
+ end
+ item
+ Options = [coDraggable, coEnabled, coParentBidiMode, coParentColor, coResizable, coShowDropMark, coVisible, coAllowFocus]
+ Position = 3
+ Width = 70
+ WideText = 'Context'
+ end>
+ end
+ object comboDataAccess: TComboBox
+ Left = 100
+ Top = 84
+ Width = 276
+ Height = 21
+ Style = csDropDownList
+ Anchors = [akLeft, akTop, akRight]
+ ItemHeight = 13
+ TabOrder = 9
+ OnChange = Modification
+ end
+ object comboSecurity: TComboBox
+ Left = 100
+ Top = 109
+ Width = 276
+ Height = 21
+ Style = csDropDownList
+ Anchors = [akLeft, akTop, akRight]
+ ItemHeight = 13
+ TabOrder = 10
+ OnChange = Modification
+ end
+ object editComment: TTntEdit
+ Left = 100
+ Top = 134
+ Width = 276
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 11
+ Text = 'editComment'
+ OnChange = Modification
+ end
+ object chkDeterministic: TCheckBox
+ Left = 100
+ Top = 161
+ Width = 276
+ Height = 17
+ Anchors = [akLeft, akTop, akRight]
+ Caption = '&Deterministic'
+ TabOrder = 12
+ OnClick = Modification
+ end
+ object SynMemoBody: TSynMemo
+ Left = 8
+ Top = 336
+ Width = 368
+ Height = 90
+ SingleLineMode = False
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -13
+ Font.Name = 'Courier New'
+ Font.Style = []
+ TabOrder = 13
+ OnDragDrop = SynMemoBodyDragDrop
+ OnDragOver = SynMemoBodyDragOver
+ Gutter.DigitCount = 3
+ Gutter.Font.Charset = DEFAULT_CHARSET
+ Gutter.Font.Color = clWindowText
+ Gutter.Font.Height = -11
+ Gutter.Font.Name = 'Courier New'
+ Gutter.Font.Style = []
+ Gutter.ShowLineNumbers = True
+ Highlighter = MainForm.SynSQLSyn1
+ Lines.UnicodeStrings = 'SynMemoBody'
+ OnChange = Modification
+ end
+end
diff --git a/source/routine_editor.pas b/source/routine_editor.pas
new file mode 100644
index 00000000..64a8cae2
--- /dev/null
+++ b/source/routine_editor.pas
@@ -0,0 +1,477 @@
+unit routine_editor;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, SynEdit, SynMemo, StdCtrls, TntStdCtrls, ComCtrls, ToolWin,
+ VirtualTrees, WideStrings, db, SynRegExpr;
+
+type
+ TfrmRoutineEditor = class(TForm)
+ btnApply: TButton;
+ btnCancel: TButton;
+ btnOK: TButton;
+ btnHelp: TButton;
+ lblName: TLabel;
+ lblType: TLabel;
+ lblReturns: TLabel;
+ comboReturns: TComboBox;
+ comboType: TTNTComboBox;
+ editName: TTntEdit;
+ lblParameters: TLabel;
+ tlbParameters: TToolBar;
+ btnAddParam: TToolButton;
+ btnRemoveParam: TToolButton;
+ btnClearParams: TToolButton;
+ listParameters: TVirtualStringTree;
+ lblSQL: TLabel;
+ comboDataAccess: TComboBox;
+ lblSecurity: TLabel;
+ comboSecurity: TComboBox;
+ lblComment: TLabel;
+ editComment: TTntEdit;
+ chkDeterministic: TCheckBox;
+ lblSQLcode: TLabel;
+ SynMemoBody: TSynMemo;
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure comboTypeSelect(Sender: TObject);
+ procedure PostChanges(Sender: TObject);
+ procedure btnHelpClick(Sender: TObject);
+ procedure editNameChange(Sender: TObject);
+ procedure btnAddParamClick(Sender: TObject);
+ procedure listParametersGetText(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
+ var CellText: WideString);
+ procedure listParametersGetImageIndex(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
+ var Ghosted: Boolean; var ImageIndex: Integer);
+ procedure btnClearParamsClick(Sender: TObject);
+ procedure btnRemoveParamClick(Sender: TObject);
+ procedure listParametersBeforePaint(Sender: TBaseVirtualTree;
+ TargetCanvas: TCanvas);
+ procedure listParametersFocusChanged(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex);
+ procedure listParametersCreateEditor(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
+ procedure listParametersNewText(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
+ procedure listParametersEditing(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
+ procedure Modification(Sender: TObject);
+ procedure SynMemoBodyDragOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+ procedure SynMemoBodyDragDrop(Sender, Source: TObject; X, Y: Integer);
+ procedure listParametersPaintText(Sender: TBaseVirtualTree;
+ const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
+ TextType: TVSTTextType);
+ private
+ { Private declarations }
+ Parameters: TWideStringList;
+ AlterRoutineType: String;
+ FModified: Boolean;
+ procedure SetModified(Value: Boolean);
+ property Modified: Boolean read FModified write SetModified;
+ public
+ { Public declarations }
+ AlterRoutineName: WideString;
+ end;
+
+
+implementation
+
+uses main, helpers, mysql_structures, grideditlinks;
+
+{$R *.dfm}
+
+const
+ DELIM = '|';
+
+
+procedure TfrmRoutineEditor.FormCreate(Sender: TObject);
+var
+ i: Integer;
+begin
+ // Restore form dimensions
+ Width := GetRegValue(REGNAME_PROCEDITOR_WIDTH, Width);
+ Height := GetRegValue(REGNAME_PROCEDITOR_HEIGHT, Height);
+ // Combo items in a .dfm are sporadically lost after an IDE restart,
+ // so we set them here to avoid developer annoyance
+ comboType.Items.Add('Procedure (doesn''t return a result)');
+ comboType.Items.Add('Function (returns a result)');
+ comboDataAccess.Items.Add('Contains SQL');
+ comboDataAccess.Items.Add('No SQL');
+ comboDataAccess.Items.Add('Reads SQL data');
+ comboDataAccess.Items.Add('Modifies SQL data');
+ comboSecurity.Items.Add('Definer');
+ comboSecurity.Items.Add('Invoker');
+ for i := Low(MySqlDataTypeArray) to High(MySqlDataTypeArray) do
+ comboReturns.Items.Add(MySqlDataTypeArray[i].Name);
+ SetWindowSizeGrip(Handle, True);
+ InheritFont(Font);
+ SynMemoBody.Font.Name := Mainform.SynMemoQuery.Font.Name;
+ SynMemoBody.Font.Size := Mainform.SynMemoQuery.Font.Size;
+ SynMemoBody.Options := Mainform.SynMemoQuery.Options;
+ Parameters := TWideStringList.Create;
+end;
+
+
+procedure TfrmRoutineEditor.FormDestroy(Sender: TObject);
+begin
+ // Store form dimensions
+ OpenRegistry;
+ MainReg.WriteInteger(REGNAME_PROCEDITOR_WIDTH, Width);
+ MainReg.WriteInteger(REGNAME_PROCEDITOR_HEIGHT, Height);
+end;
+
+
+procedure TfrmRoutineEditor.FormShow(Sender: TObject);
+var
+ ds: TDataSet;
+ Create: WideString;
+ Params: TWideStringlist;
+ Context: String;
+ rx: TRegExpr;
+ i: Integer;
+begin
+ editName.Text := AlterRoutineName;
+ comboType.ItemIndex := 0;
+ comboReturns.Text := '';
+ listParameters.Clear;
+ comboDataAccess.ItemIndex := 0;
+ comboSecurity.ItemIndex := 0;
+ editComment.Clear;
+ SynMemoBody.Text := 'BEGIN'+CRLF+CRLF+'END';
+ if editName.Text <> '' then begin
+ // Editing existing routine
+ ds := Mainform.GetResults('SELECT * FROM '+DBNAME_INFORMATION_SCHEMA+'.ROUTINES'+
+ ' WHERE ROUTINE_SCHEMA='+esc(Mainform.ActiveDatabase)+' AND ROUTINE_NAME='+esc(AlterRoutineName));
+ if ds.RecordCount <> 1 then begin
+ MessageDlg('Cannot find properties of stored routine '+AlterRoutineName, mtError, [mbOK], 0);
+ Close;
+ end;
+ ds.First;
+ AlterRoutineType := ds.FieldByName('ROUTINE_TYPE').AsString;
+ comboType.ItemIndex := ListIndexByRegExpr(comboType.Items, '^'+AlterRoutineType+'\b');
+ chkDeterministic.Checked := ds.FieldByName('IS_DETERMINISTIC').AsString = 'YES';
+ comboReturns.Text := ds.FieldByName('DTD_IDENTIFIER').AsWideString;
+ comboDataAccess.ItemIndex := comboDataAccess.Items.IndexOf(ds.FieldByName('SQL_DATA_ACCESS').AsString);
+ comboSecurity.ItemIndex := comboSecurity.Items.IndexOf(ds.FieldByName('SECURITY_TYPE').AsString);
+ editComment.Text := ds.FieldByName('ROUTINE_COMMENT').AsWideString;
+ SynMemoBody.Text := ds.FieldByName('ROUTINE_DEFINITION').AsWideString;
+ Create := Mainform.GetVar('SHOW CREATE '+AlterRoutineType+' '+Mainform.mask(editName.Text), 2);
+ rx := TRegExpr.Create;
+ rx.ModifierI := True;
+ rx.ModifierG := False;
+ // CREATE DEFINER=`root`@`localhost` PROCEDURE `bla2`(IN p1 INT, p2 VARCHAR(20))
+ rx.Expression := '^CREATE\s.+\s(PROCEDURE|FUNCTION)\s.+`\((.+)\)\s';
+ if rx.Exec(Create) then begin
+ Params := explode(',', rx.Match[2]);
+ rx.Expression := '^((IN|OUT|INOUT)\s+)?(\S+)\s+(.+)$';
+ for i := 0 to Params.Count - 1 do begin
+ if rx.Exec(Trim(Params[i])) then begin
+ Context := rx.Match[2];
+ if Context = '' then
+ Context := 'IN';
+ Parameters.Add(rx.Match[3] + DELIM + rx.Match[4] + DELIM + Context);
+ end;
+ end;
+ FreeAndNil(Params);
+ end;
+ FreeAndNil(ds);
+ end;
+ editName.SetFocus;
+ editNameChange(Sender);
+ comboTypeSelect(comboType);
+ btnRemoveParam.Enabled := Assigned(listParameters.FocusedNode);
+ Modified := False;
+end;
+
+
+procedure TfrmRoutineEditor.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ // Reset edited proc name for the next call
+ AlterRoutineName := '';
+ Parameters.Clear;
+end;
+
+
+procedure TfrmRoutineEditor.editNameChange(Sender: TObject);
+begin
+ editName.Font.Color := clWindowText;
+ editName.Color := clWindow;
+ try
+ ensureValidIdentifier( editName.Text );
+ except
+ // Invalid name
+ if editName.Text <> '' then begin
+ editName.Font.Color := clRed;
+ editName.Color := clYellow;
+ end;
+ end;
+ Modified := True;
+end;
+
+
+procedure TfrmRoutineEditor.Modification(Sender: TObject);
+begin
+ Modified := True;
+end;
+
+
+procedure TfrmRoutineEditor.comboTypeSelect(Sender: TObject);
+var
+ isfunc: Boolean;
+begin
+ isfunc := (Sender as TTNTComboBox).ItemIndex = 1;
+ lblReturns.Enabled := isfunc;
+ comboReturns.Enabled := isfunc;
+ Modified := True;
+ listParameters.Repaint;
+end;
+
+
+procedure TfrmRoutineEditor.btnAddParamClick(Sender: TObject);
+begin
+ Parameters.Add('Param'+IntToStr(Parameters.Count+1)+DELIM+'INT'+DELIM+'IN');
+ // See List.OnPaint:
+ listParameters.Repaint;
+ Modified := True;
+end;
+
+
+procedure TfrmRoutineEditor.btnRemoveParamClick(Sender: TObject);
+begin
+ Parameters.Delete(ListParameters.FocusedNode.Index);
+ listParameters.Repaint;
+ Modified := True;
+end;
+
+
+procedure TfrmRoutineEditor.btnClearParamsClick(Sender: TObject);
+begin
+ Parameters.Clear;
+ listParameters.Repaint;
+ Modified := True;
+end;
+
+
+procedure TfrmRoutineEditor.listParametersBeforePaint(Sender: TBaseVirtualTree;
+ TargetCanvas: TCanvas);
+begin
+ (Sender as TVirtualStringTree).RootNodeCount := Parameters.Count;
+end;
+
+
+procedure TfrmRoutineEditor.listParametersGetImageIndex(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
+ var Ghosted: Boolean; var ImageIndex: Integer);
+var
+ List: TVirtualStringTree;
+ Context: String;
+begin
+ // Draw arrow icon to indicate in/out context
+ List := Sender as TVirtualStringTree;
+ if Column <> 3 then
+ ImageIndex := -1
+ else begin
+ Context := List.Text[Node, 3];
+ if Context = 'IN' then ImageIndex := 120
+ else if Context = 'OUT' then ImageIndex := 121
+ else if Context = 'INOUT' then ImageIndex := 122;
+ end;
+end;
+
+
+procedure TfrmRoutineEditor.listParametersGetText(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
+ var CellText: WideString);
+var
+ Values: TWideStringList;
+begin
+ if Column = 0 then
+ CellText := IntToStr(Node.Index+1)
+ else if (Column = 3) and (comboType.ItemIndex = 1) then
+ CellText := 'IN' // A function can only have IN parameters
+ else begin
+ Values := explode(DELIM, Parameters[Node.Index]);
+ CellText := Values[Column-1];
+ FreeAndNil(Values);
+ end;
+end;
+
+
+procedure TfrmRoutineEditor.listParametersPaintText(Sender: TBaseVirtualTree;
+ const TargetCanvas: TCanvas; Node: PVirtualNode; Column: TColumnIndex;
+ TextType: TVSTTextType);
+begin
+ if (Column = 3) and (comboType.ItemIndex = 1) then
+ TargetCanvas.Font.Color := clBtnShadow;
+end;
+
+
+procedure TfrmRoutineEditor.listParametersFocusChanged(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex);
+begin
+ btnRemoveParam.Enabled := Assigned(Node);
+ if Assigned(Node) and (not ((comboType.ItemIndex = 1) and (Column=3))) then
+ Sender.EditNode(Node, Column);
+end;
+
+
+procedure TfrmRoutineEditor.listParametersNewText(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; NewText: WideString);
+var
+ OldValues: TWideStringList;
+ new: WideString;
+begin
+ OldValues := explode(DELIM, Parameters[Node.Index]);
+ case Column of
+ 1: new := NewText + DELIM + OldValues[1] + DELIM + OldValues[2];
+ 2: new := OldValues[0] + DELIM + NewText + DELIM + OldValues[2];
+ 3: new := OldValues[0] + DELIM + OldValues[1] + DELIM + NewText;
+ end;
+ Parameters[Node.Index] := new;
+ Modified := True;
+end;
+
+
+procedure TfrmRoutineEditor.listParametersCreateEditor(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; out EditLink: IVTEditLink);
+var
+ EnumEditor: TEnumEditorLink;
+ i: Integer;
+begin
+ if Column = 1 then
+ EditLink := TStringEditLink.Create
+ else if Column = 2 then begin
+ EnumEditor := TEnumEditorLink.Create;
+ EnumEditor.AllowCustomText := True;
+ EnumEditor.ValueList := TWideStringList.Create;
+ for i:=Low(MySqlDataTypeArray) to High(MySqlDataTypeArray) do
+ EnumEditor.ValueList.Add(MySqlDataTypeArray[i].Name);
+ EditLink := EnumEditor;
+ end else if Column = 3 then begin
+ EnumEditor := TEnumEditorLink.Create;
+ EnumEditor.ValueList := TWideStringList.Create;
+ EnumEditor.ValueList.Add('IN');
+ EnumEditor.ValueList.Add('OUT');
+ EnumEditor.ValueList.Add('INOUT');
+ EditLink := EnumEditor;
+ end;
+end;
+
+
+procedure TfrmRoutineEditor.listParametersEditing(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex; var Allowed: Boolean);
+begin
+ // Do not allow the number cells to be edited
+ Allowed := Column > 0;
+ if (Column = 3) and (comboType.ItemIndex = 1) then begin
+ Allowed := False;
+ MessageDlg('A stored function can only have IN parameters so context editing is blocked.', mtInformation, [mbOK], 0);
+ end;
+end;
+
+
+procedure TfrmRoutineEditor.SynMemoBodyDragOver(Sender, Source: TObject; X,
+ Y: Integer; State: TDragState; var Accept: Boolean);
+begin
+ // Allow dragging parameters here
+ Accept := Source = listParameters;
+ // set cursor position
+ SynMemoBody.CaretX := (x - SynMemoBody.Gutter.Width) div SynMemoBody.CharWidth - 1 + SynMemoBody.LeftChar;
+ SynMemoBody.CaretY := y div SynMemoBody.LineHeight + SynMemoBody.TopLine;
+ if not SynMemoBody.Focused then
+ SynMemoBody.SetFocus;
+end;
+
+
+procedure TfrmRoutineEditor.SynMemoBodyDragDrop(Sender, Source: TObject; X,
+ Y: Integer);
+var
+ list: TVirtualStringTree;
+ memo: TSynMemo;
+begin
+ list := Source as TVirtualStringTree;
+ memo := Sender as TSynMemo;
+ memo.SelText := list.Text[list.FocusedNode, 1];
+end;
+
+
+procedure TfrmRoutineEditor.PostChanges(Sender: TObject);
+var
+ sql: WideString;
+ i: Integer;
+ par: TWideStringList;
+ ProcOrFunc: String;
+begin
+ // Apply or OK button clicked
+ ProcOrFunc := UpperCase(GetFirstWord(comboType.Text));
+ if editName.Text = '' then begin
+ MessageDlg('Please specify the routine''s name.', mtError, [mbOK], 0);
+ editName.SetFocus;
+ Exit;
+ end else if (ProcOrFunc = 'FUNCTION') and (comboReturns.Text = '') then begin
+ MessageDlg('Please specify the function''s returning datatype.', mtError, [mbOK], 0);
+ comboReturns.SetFocus;
+ Exit;
+ end;
+
+ sql := 'CREATE '+ProcOrFunc+' '+Mainform.mask(editName.Text)+'(';
+ for i := 0 to Parameters.Count - 1 do begin
+ par := explode(DELIM, Parameters[i]);
+ if ProcOrFunc = 'PROCEDURE' then
+ sql := sql + par[2] + ' ';
+ sql := sql + par[0] + ' ' + par[1];
+ if i < Parameters.Count-1 then
+ sql := sql + ', ';
+ end;
+ sql := sql + ') ';
+ if comboReturns.Enabled then
+ sql := sql + 'RETURNS '+comboReturns.Text+' ';
+ sql := sql + 'LANGUAGE SQL ';
+ if not chkDeterministic.Checked then
+ sql := sql + 'NOT ';
+ sql := sql + 'DETERMINISTIC ';
+ sql := sql + UpperCase(comboDataAccess.Text)+' ';
+ sql := sql + 'SQL SECURITY ' + UpperCase(comboSecurity.Text)+' ';
+ sql := sql + 'COMMENT ' + esc(editComment.Text)+' ';
+ sql := sql + SynMemoBody.Text;
+ try
+ // Drop the old routine first. There is no way to ALTER parameters or the name of it.
+ // See also: http://dev.mysql.com/doc/refman/5.0/en/alter-procedure.html
+ if AlterRoutineName <> '' then
+ Mainform.ExecUpdateQuery('DROP '+AlterRoutineType+' '+Mainform.mask(AlterRoutineName), True);
+ Mainform.ExecUpdateQuery(sql, False, True);
+ // Set editing name if create/alter query was successful
+ AlterRoutineName := editName.Text;
+ AlterRoutineType := ProcOrFunc;
+ Modified := False;
+ except
+ On E:Exception do begin
+ ModalResult := mrNone;
+ end;
+ end;
+end;
+
+
+procedure TfrmRoutineEditor.SetModified(Value: Boolean);
+begin
+ FModified := Value;
+ btnOK.Enabled := FModified;
+ btnApply.Enabled := FModified;
+end;
+
+
+procedure TfrmRoutineEditor.btnHelpClick(Sender: TObject);
+begin
+ // Help button
+ Mainform.CallSQLHelpWithKeyword('CREATE PROCEDURE');
+end;
+
+
+end.