diff --git a/components/heidisql/include/const.inc b/components/heidisql/include/const.inc
index 64911f36..ac2367cf 100644
--- a/components/heidisql/include/const.inc
+++ b/components/heidisql/include/const.inc
@@ -7,6 +7,7 @@ const
// Names of the system tables and system databases
PRIVTABLE_USERS = 'user';
PRIVTABLE_DB = 'db';
+ PRIVTABLE_HOST = 'host';
PRIVTABLE_TABLES = 'tables_priv';
PRIVTABLE_COLUMNS = 'columns_priv';
DBNAME_INFORMATION_SCHEMA = 'information_schema';
@@ -158,6 +159,10 @@ const
REGNAME_VIEWWINHEIGHT = 'View_WindowHeight';
REGNAME_PREFER_SHOWTABLES = 'PreferShowTables';
DEFAULT_PREFER_SHOWTABLES = False;
+ REGNAME_USERMNGR_WINWIDTH = 'Usermanager_WindowWidth';
+ REGNAME_USERMNGR_WINHEIGHT = 'Usermanager_WindowHeight';
+ REGNAME_SELECTDBO_WINWIDTH = 'SelectDBO_WindowWidth';
+ REGNAME_SELECTDBO_WINHEIGHT = 'SelectDBO_WindowHeight';
REGPREFIX_COLWIDTHS = 'ColWidths_';
REGPREFIX_COLSVISIBLE = 'ColsVisible_';
@@ -175,6 +180,9 @@ const
ICONINDEX_INDEXKEY = 23;
ICONINDEX_UNIQUEKEY = 24;
ICONINDEX_FULLTEXTKEY = 22;
+ ICONINDEX_SERVER = 1;
+ ICONINDEX_DB = 5;
+ ICONINDEX_DB_HIGHLIGHT = 70;
ICONINDEX_TABLE = 14;
ICONINDEX_TABLE_HIGHLIGHT = 71;
ICONINDEX_VIEW = 81;
@@ -217,3 +225,5 @@ const
NODETYPE_DEFAULT = 0;
NODETYPE_BASETABLE = 1;
NODETYPE_VIEW = 2;
+ NODETYPE_DB = 3;
+ NODETYPE_COLUMN = 4;
diff --git a/packages/delphi11/heidisql.dpr b/packages/delphi11/heidisql.dpr
index 63fa1091..142fd508 100644
--- a/packages/delphi11/heidisql.dpr
+++ b/packages/delphi11/heidisql.dpr
@@ -18,7 +18,6 @@ uses
optimizetables in '..\..\source\optimizetables.pas' {optimize},
printlist in '..\..\source\printlist.pas' {printlistForm},
copytable in '..\..\source\copytable.pas' {CopyTableForm},
- edituser in '..\..\source\edituser.pas' {FormEditUser},
insertfiles in '..\..\source\insertfiles.pas' {frmInsertFiles},
insertfiles_progress in '..\..\source\insertfiles_progress.pas' {frmInsertFilesProgress},
helpers in '..\..\source\helpers.pas',
@@ -37,7 +36,8 @@ uses
createdatabase in '..\..\source\createdatabase.pas' {CreateDatabaseForm},
updatecheck in '..\..\source\updatecheck.pas' {frmUpdateCheck},
editvar in '..\..\source\editvar.pas' {frmEditVariable},
- view in '..\..\source\view.pas' {frmView};
+ view in '..\..\source\view.pas' {frmView},
+ selectdbobject in '..\..\source\selectdbobject.pas' {frmSelectDBObject};
{$R *.RES}
diff --git a/packages/delphi11/heidisql.dproj b/packages/delphi11/heidisql.dproj
index 800fa5fe..0d786843 100644
--- a/packages/delphi11/heidisql.dproj
+++ b/packages/delphi11/heidisql.dproj
@@ -85,9 +85,6 @@
-
-
-
@@ -129,6 +126,9 @@
+
+
+
@@ -147,4 +147,4 @@
-
\ No newline at end of file
+
diff --git a/res/icons/group_edit.png b/res/icons/group_edit.png
deleted file mode 100644
index c88b945b..00000000
Binary files a/res/icons/group_edit.png and /dev/null differ
diff --git a/res/icons/user_delete.png b/res/icons/user_delete.png
new file mode 100644
index 00000000..acbb5630
Binary files /dev/null and b/res/icons/user_delete.png differ
diff --git a/res/icons/user_edit.png b/res/icons/user_edit.png
new file mode 100644
index 00000000..c1974cda
Binary files /dev/null and b/res/icons/user_edit.png differ
diff --git a/source/childwin.pas b/source/childwin.pas
index 2ecfbb27..fa0f0283 100644
--- a/source/childwin.pas
+++ b/source/childwin.pas
@@ -1314,8 +1314,8 @@ begin
newTree.Parent := self;
tnodehost := newTree.Items.Add( nil, FConn.MysqlParams.User + '@' + FConn.MysqlParams.Host ); // Host or Root
- tnodehost.ImageIndex := 1;
- tnodehost.SelectedIndex := 1;
+ tnodehost.ImageIndex := ICONINDEX_SERVER;
+ tnodehost.SelectedIndex := ICONINDEX_SERVER;
select := 0;
// Avoids excessive InitializeKeywordLists() calls.
@@ -1330,8 +1330,8 @@ begin
for i := 0 to ( OnlyDBs2.Count - 1 ) do
begin
tnode := newTree.Items.AddChild( tnodehost, OnlyDBs2[i] );
- tnode.ImageIndex := 5;
- tnode.SelectedIndex := 70;
+ tnode.ImageIndex := ICONINDEX_DB;
+ tnode.SelectedIndex := ICONINDEX_DB_HIGHLIGHT;
// Add dummy-node, will be replaced by real tables on expanding
newTree.Items.AddChild( tnode, DUMMY_NODE_TEXT );
if i = 0 then tnodehost.Expand(false);
@@ -5983,8 +5983,8 @@ procedure TMDIChild.vstGetImageIndex(Sender: TBaseVirtualTree; Node:
var
NodeData : PVTreeData;
begin
- // Display icon only for leftmost cell
- if Column <> 0 then
+ // 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);
diff --git a/source/edituser.dfm b/source/edituser.dfm
deleted file mode 100644
index 98e9af76..00000000
--- a/source/edituser.dfm
+++ /dev/null
@@ -1,108 +0,0 @@
-object FormEditUser: TFormEditUser
- Left = 792
- Top = 134
- AutoSize = True
- BorderStyle = bsDialog
- BorderWidth = 5
- Caption = 'Edit User...'
- ClientHeight = 168
- ClientWidth = 313
- Color = clBtnFace
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Tahoma'
- Font.Style = []
- OldCreateOrder = False
- Position = poMainFormCenter
- OnShow = FormShow
- PixelsPerInch = 96
- TextHeight = 13
- object Button1: TButton
- Left = 237
- Top = 143
- Width = 75
- Height = 25
- Cancel = True
- Caption = 'Cancel'
- ModalResult = 2
- TabOrder = 0
- end
- object Button2: TButton
- Left = 154
- Top = 143
- Width = 75
- Height = 25
- Caption = 'Save'
- Default = True
- ModalResult = 1
- TabOrder = 1
- OnClick = Button2Click
- end
- object GroupBox1: TGroupBox
- Left = 0
- Top = 0
- Width = 313
- Height = 137
- Caption = 'Edit users credentials'
- TabOrder = 2
- object Label1: TLabel
- Left = 24
- Top = 32
- Width = 52
- Height = 13
- Caption = 'Username:'
- end
- object Label2: TLabel
- Left = 24
- Top = 56
- Width = 26
- Height = 13
- Caption = 'Host:'
- end
- object Label3: TLabel
- Left = 24
- Top = 80
- Width = 74
- Height = 13
- Caption = 'New Password:'
- end
- object Label4: TLabel
- Left = 24
- Top = 104
- Width = 88
- Height = 13
- Caption = 'Retype Password:'
- end
- object EditUsername: TEdit
- Left = 125
- Top = 28
- Width = 150
- Height = 21
- TabOrder = 0
- end
- object EditHost: TEdit
- Left = 125
- Top = 52
- Width = 150
- Height = 21
- TabOrder = 1
- end
- object EditPassword1: TEdit
- Left = 125
- Top = 76
- Width = 150
- Height = 21
- PasswordChar = '*'
- TabOrder = 2
- end
- object EditPassword2: TEdit
- Left = 125
- Top = 100
- Width = 150
- Height = 21
- PasswordChar = '*'
- TabOrder = 3
- end
- end
-end
diff --git a/source/edituser.pas b/source/edituser.pas
deleted file mode 100644
index a19f6908..00000000
--- a/source/edituser.pas
+++ /dev/null
@@ -1,103 +0,0 @@
-unit edituser;
-
-interface
-
-uses
- Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- StdCtrls;
-
-type
- TFormEditUser = class(TForm)
- Button1: TButton;
- Button2: TButton;
- GroupBox1: TGroupBox;
- Label1: TLabel;
- Label2: TLabel;
- Label3: TLabel;
- Label4: TLabel;
- EditUsername: TEdit;
- EditHost: TEdit;
- EditPassword1: TEdit;
- EditPassword2: TEdit;
- procedure FormShow(Sender: TObject);
- procedure Button2Click(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- function EditUserWindow(AOwner: TComponent): Boolean;
-
-implementation
-
-uses usermanager, childwin, MAIN;
-
-{$I const.inc}
-{$R *.DFM}
-
-{**
- Create form on demand
- @param TComponent Owner of form (should be calling form)
- @return Boolean Form closed using modalresult mrOK
-}
-function EditUserWindow(AOwner: TComponent): Boolean;
-var
- f : TFormEditUser;
-begin
- f := TFormEditUser.Create(AOwner);
- Result := (f.ShowModal=mrOK);
- FreeAndNil(f);
-end;
-
-
-procedure TFormEditUser.FormShow(Sender: TObject);
-begin
- EditUsername.Text := UserManagerForm.user;
- EditHost.Text := UserManagerForm.host;
- EditPassword1.Text := '';
- EditPassword2.Text := '';
- EditUsername.SetFocus;
-end;
-
-procedure TFormEditUser.Button2Click(Sender: TObject);
-var passwdset : String;
-begin
- // Save credentials
- Screen.Cursor := crHourglass;
- if EditPassword1.Text <> EditPassword2.Text then begin
- Screen.Cursor := crDefault;
- MessageDlg('Retyped password doesn''t match with first password.', mtError, [mbOK], 0);
- EditPassword2.SetFocus;
- abort;
- end;
- passwdset := ', Password=password('''+Self.EditPassword1.Text+''')';
- if EditPassword1.Text = '' then begin
- // No password?
- Screen.Cursor := crDefault;
-
- if MessageDlg('Set empty password?' + CRLF + 'Press no to leave the old password.',
- mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
- passwdset := '';
- end;
- Mainform.ChildWin.ExecUpdateQuery('UPDATE mysql.user SET Host='''+EditHost.Text+''', User='''+EditUsername.Text+''' '+passwdset+' WHERE Host='''+UserManagerForm.host+''' AND User='''+UserManagerForm.user+'''');
- Mainform.ChildWin.ExecUpdateQuery('UPDATE mysql.db SET Host='''+EditHost.Text+''', User='''+EditUsername.Text+''' WHERE Host='''+UserManagerForm.host+''' AND User='''+UserManagerForm.user+'''');
- Mainform.ChildWin.ExecUpdateQuery('UPDATE mysql.tables_priv SET Host='''+EditHost.Text+''', User='''+EditUsername.Text+''' WHERE Host='''+UserManagerForm.host+''' AND User='''+UserManagerForm.user+'''');
- Mainform.ChildWin.ExecUpdateQuery('UPDATE mysql.columns_priv SET Host='''+EditHost.Text+''', User='''+EditUsername.Text+''' WHERE Host='''+UserManagerForm.host+''' AND User='''+UserManagerForm.user+'''');
- Mainform.ChildWin.ExecUpdateQuery('FLUSH PRIVILEGES');
-
- UserManagerForm.ShowPrivilegesControls(false, true, false);
-
- // Clear and refill user-list
- FreeAndNil(UserManagerForm.ZQueryDBs);
- FreeAndNil(UserManagerForm.ZQueryTables);
- FreeAndNil(UserManagerForm.ZQueryColumns);
- FreeAndNil(UserManagerForm.ZQueryUsers);
- UserManagerForm.TreeViewUsers.Items.Clear;
- UserManagerForm.PageControl1.OnChange(self);
-
- Screen.Cursor := crdefault;
- Close;
-end;
-
-end.
diff --git a/source/main.dfm b/source/main.dfm
index 5ba8cf6e..c4d26a46 100644
--- a/source/main.dfm
+++ b/source/main.dfm
@@ -1184,31 +1184,32 @@ object MainForm: TMainForm
PngImage.Data = {
89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
610000001974455874536F6674776172650041646F626520496D616765526561
- 647971C9653C000002E54944415478DA85D26948545118C6F1E7DED16B5E7574
- 5CA6C646BDEE6B4AA399669B0C894B64995BAB186529ED460B6520D69720D428
- 0D4949A1144A8B8C2025D25033D14CAD68DCD351C975CC1967BCCE3099906BE8
- F9780EEFEFC3FFBC8456ABC54AE746A4657CACD82083C79DE4B2D394BAA29128
- 78518BC4579F3AD9BFEFC44AC0B950A1F8C201DD328AA32217DE9756D399271F
- 749C5F15C88DB3B817126E7386A037C284E70299B4045AB60763324AE69ED8C1
- 5B15C88A34B91B915274919677823634804AA1C038CDA0B5F47A77604AA3EDAA
- 40446874C2ED83C28742CF2D84014542A521F17BA80739792525370B2AF62F03
- 12021DE3BD18AB0C8D5ACBD5E190EA16E560932BB3DD33DA778DAE5A870B0252
- C8E513E0186E8062B81284AA2F6E0E880B7010FB3A3165D3AC665130AE8F2714
- B405F87A12ECB0B684BEC53618DB8A20EBAAC1F7B78F06E780F418519581A975
- 80F95A33B83A09F0B9418291C151503401AB784BF8711918717D30DA2E81B1B9
- 3D28233EBEBECBD7CC01F763EC9F059FBA15C9A7C616056B294F836FA8182676
- C1981A28827284C0E08F494CA858F0D8F1F906FF0B36D6FF01B4400FC60EE150
- F56583A4D49896DBA0B7AA0E3972535C319C9C0738DE99D73283DA53237DA8D9
- 60F2F15698B809C1F7D837339C0552570D76C2167D95B5B823530E987707E524
- F94BDA660132A0E8F85E3FA7F4B39745863595C5A087EAB1CB6E1AAE3BF780FD
- 950F82C342352EC450659D52A354B8395FAAEDFE17996042B2A37C1C858F8F24
- 86D2CD5A12930D85386CDA0235C187995935787C6A66D80AD2F7F54A3D8DDCC3
- 39B9B673E12F11CD69DE6AD6258EF394138561FD75086B12233A290F92C264F4
- 75D740CFDA0B53232AD818EBC3FEF41B62E9B2115D19DBFBEBE52241F1542C8C
- B66E86F0B927AE1E4B00480DBE94BF44FB4F297AB91138EAFC0D8213AF970392
- 8204FFF6AEA1C0D496085FCD7A9770A6310C22C61C9B5C19F442809C8FDED243
- 8E0DB9BBDD156DB6F1854F96027F00878B3EF0E6507EDA0000000049454E44AE
- 426082}
+ 647971C9653C000003084944415478DAA5D36B4893611407F0FFB3779B5ACEE9
+ A64BB3655EA2344DB4CC72599FC46E921566526A4AA44650242295D29D34A320
+ 21B3B228141704155D30B5A28B16A5A3B432BB985463DE66DB9C7BE7FB6E7B9A
+ 0B8202EB43CFB773E0FC383CE71C4229C5FF3CF227B02DCEB734544E8B19C631
+ 99B3538C70024B8F913959D73E58F24F206F9EBC383A901E154D22C4E18C399E
+ C2CC3A3060A6F4BD4174E876C7D0BEBF02552BBDA9BB84C1A0C90E3B19CF08E0
+ 200C0CA30EE84C76536DBB41FA57E0E812098DC9D881A8195EF8A6D5A1AEB616
+ 42A11063C403BCC5C02F4E5449B2CA6E8E4D089CCB0AD2675634C9B88FF760B6
+ B0181A36C2CB7312A47392D05096668A4F966DE52DA16AC6330AA3430F41ACDA
+ ECDF80531B239E64EE2C51D90422780A6DE33ECC36064262C3B33B073EC724AC
+ 0EF6F04B8434381686CFAD7877F77CFF2F60CACA3A9197B1A5E660CCF3CCB59B
+ F341DDE5AE3CE52D78D6588EA815A90E2FEFF982E18FDD90FA86422C51A0EBFE
+ 65AB0BF05B51EF461DF65C77F89FBE7B6E115E9FC900C54F58E6338AB8E52A48
+ 439231A65383D5130CBCB380B7727A2B6B4E20F2656AC2D991ED230EBCD8503D
+ 0FEDF080C600B0A380D2F80005018D9086AD86555B0581D806DE1C04FDA3D6FE
+ 61B370596C61F34B12B1B62635800C5DCB2B2A84DE83C11B0B05CF02FE7D3790
+ 3FF32914916B9CC5A72110D9C08D04E36BF30BD4BC093970E2EC99FDAE2968F6
+ CEB24D8B4F65AE0CAAD0169002C6D9F954FD4DA4FB3D46C4D255E0FA2F81301C
+ ACC669E87BA8814C39179F1EDDE2171EEF12BB805725B31DCAC40C52705589C8
+ B47418BA6E2037AC1336A2805CDE021F85D859AC84B6A51BC73449A8DCA0C787
+ A67A1A57FE56E0023A2F6DDFCD75351CACECCBC16BBA4858147E18EBB75D4077
+ 7D21B4BDAD709B1E0D93F34F2ADAD6618E778F2577EA2D4614B6B42232ABB2F4
+ D722F5AA0B24173A02C597DF461FC9F1DD93B77B4B9E738BED78D9741DEF3F7D
+ 41B56EEB779D38BC6D559066D32E553F3B3DBD6A64C26B4C4B94B1B1210AE182
+ F06050D1582B3B30989352DED933D139FF00B0986008DCC8D9BB000000004945
+ 4E44AE426082}
Name = 'PngImage10'
Background = clWindow
end
@@ -3429,6 +3430,36 @@ object MainForm: TMainForm
86F8BFF90166BD77F0B083A4C90000000049454E44AE426082}
Name = 'PngImage82'
Background = clWindow
+ end
+ item
+ PngImage.Data = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 610000001974455874536F6674776172650041646F626520496D616765526561
+ 647971C9653C000002BB4944415478DAA5937D48535118C69FE3BDD3399D2B3F
+ 5033518B205311D3283123C9BE3441162223350B4C0D4221C2024D3052214128
+ D344321035C5A83F4A324711A810E20A4D532433A2A1B64DE7749BDEDD7B4FD7
+ 09129416740EE78FF39EF7FDF19EE73987504AF13F83FC0970F9806FD96E1F5A
+ C230A20727502C712EB62F8B4C6D9BCE50FA57407EAC4F497410AD92290811A5
+ 3DE7A058B68BF8B14CE9A45976AB7BC458BE25A021751B952B19182C0204B216
+ 7181481898AD22662C82A55567566D09A83AA2A4319A2244857AE1BB7E066DAD
+ AD605916ABC41D0E9BD9713831419953FD7C755340534E8829FB8ED69BFBFC1A
+ CB363B8CF38BF0F2544015711C3DD51996C84327FDA272EBB94D0177CFEDEBCF
+ 2E2E4DE05D64F064F9B5142CF30C58C2A3ABAE5277A9F963DCA657F04F6D9379
+ 2D0E3CAC8819CC56E71680CA7D9C71EAB0E1656B2DCA07E39ECEBAC56619B479
+ F6DF007E298FDDA8285C9423A0FE55533C461F6840B17E46A4B923AB1D9AA241
+ D8F9E962024793F14D816D03E07BBA937002CE6F770D7AD4D3180B1DDCF1DE0C
+ D8AD928D521A2FADA4C9FB08D3D581D34FC1CAB82EB882AB49D172954E40C4D9
+ E6F440627C967FED2A4CEE0CC66C140EA9495E928A5B01A286EB916CE9407852
+ 3ADC7645C03EDC8BB13EADB8303151EC047C28DDCBEF3C98CE741A1230149806
+ 46EA5CE4A913C04B86A9BBF6E04C5E21DCA7DE02FA0140A582910D81AEB77FDA
+ 0918290B17831335A4F0493022333231BEA800950002B7DE4561BB1B8ED57480
+ EC576F086E2E0FC0509F893A01A32D576E70E33D15F7662F6094C6B3919AA320
+ BF5895D6188A13A9C9F0F8D68D55FB1CD6D45BB230189F827EC385AF1D85CAE6
+ 9120D7964FD1B7A9D994CAC814DE20D2631029D4F21744EDFF8E0DF3E5C0BAE8
+ B164E0313DC7088E157A93FCEB77EECF0CBE6E9D9FC96704122230542F55359C
+ D2F2953F01332057A0274B93790000000049454E44AE426082}
+ Name = 'PngImage83'
+ Background = clWindow
end>
PngOptions = [pngBlendOnDisabled, pngGrayscaleOnDisabled]
Left = 8
diff --git a/source/main.pas b/source/main.pas
index bdd027e1..80b91bae 100644
--- a/source/main.pas
+++ b/source/main.pas
@@ -17,7 +17,8 @@ uses
ActnList, ImgList, Registry, ShellApi, ToolWin, Clipbrd, db, DBCtrls,
SynMemo, synedit, SynEditTypes, ZDataSet, ZSqlProcessor,
HeidiComp, sqlhelp, MysqlQueryThread, Childwin, VirtualTrees, TntDBGrids,
- StrUtils, DateUtils, PngImageList, OptimizeTables, View;
+ StrUtils, DateUtils, PngImageList, OptimizeTables, View, Usermanager,
+ SelectDBObject;
type
TMainForm = class(TForm)
@@ -212,6 +213,8 @@ type
public
MaintenanceForm: TOptimize;
ViewForm: TfrmView;
+ UserManagerForm: TUserManagerForm;
+ SelectDBObjectForm: TfrmSelectDBObject;
procedure OpenRegistry(Session: String = '');
function GetRegValue( valueName: String; defaultValue: Integer; Session: String = '' ) : Integer; Overload;
function GetRegValue( valueName: String; defaultValue: Boolean; Session: String = '' ) : Boolean; Overload;
@@ -258,7 +261,6 @@ uses
exportsql,
tbl_properties,
loaddata,
- usermanager,
options,
printlist,
copytable,
@@ -684,7 +686,9 @@ end;
procedure TMainForm.UserManagerExecute(Sender: TObject);
begin
- UserManagerWindow (Self);
+ if UserManagerForm = nil then
+ UserManagerForm := TUserManagerForm.Create(Self);
+ UserManagerForm.ShowModal;
end;
procedure TMainForm.menuWindowClick(Sender: TObject);
diff --git a/source/selectdbobject.dfm b/source/selectdbobject.dfm
new file mode 100644
index 00000000..5d6f9dfd
--- /dev/null
+++ b/source/selectdbobject.dfm
@@ -0,0 +1,144 @@
+object frmSelectDBObject: TfrmSelectDBObject
+ Left = 0
+ Top = 0
+ Caption = 'Select database object ...'
+ ClientHeight = 316
+ ClientWidth = 232
+ Color = clBtnFace
+ Constraints.MinHeight = 343
+ Constraints.MinWidth = 240
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ OldCreateOrder = False
+ Position = poOwnerFormCenter
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnResize = FormResize
+ OnShow = FormShow
+ DesignSize = (
+ 232
+ 316)
+ PixelsPerInch = 96
+ TextHeight = 13
+ object lblSelect: TLabel
+ Left = 8
+ Top = 8
+ Width = 161
+ Height = 13
+ Caption = 'Select database, table or column:'
+ end
+ object lblDB: TLabel
+ Left = 8
+ Top = 218
+ Width = 17
+ Height = 13
+ Anchors = [akLeft, akBottom]
+ Caption = 'DB:'
+ end
+ object lblTable: TLabel
+ Left = 69
+ Top = 218
+ Width = 30
+ Height = 13
+ Anchors = [akLeft, akBottom]
+ Caption = 'Table:'
+ end
+ object lblCol: TLabel
+ Left = 131
+ Top = 218
+ Width = 39
+ Height = 13
+ Anchors = [akLeft, akBottom]
+ Caption = 'Column:'
+ end
+ object lblHint: TLabel
+ Left = 8
+ Top = 260
+ Width = 135
+ Height = 13
+ Anchors = [akLeft, akBottom]
+ Caption = '(% and _ wildcards allowed)'
+ end
+ object TreeDBO: TVirtualStringTree
+ Left = 8
+ Top = 27
+ Width = 216
+ Height = 184
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ 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 = [hoColumnResize, hoDrag]
+ Images = MainForm.PngImageListMain
+ Indent = 16
+ Margin = 2
+ TabOrder = 0
+ TreeOptions.PaintOptions = [toHotTrack, toShowButtons, toShowDropmark, toShowRoot, toShowTreeLines, toThemeAware, toUseBlendedImages]
+ OnFocusChanged = TreeDBOFocusChanged
+ OnGetText = TreeDBOGetText
+ OnGetImageIndex = TreeDBOGetImageIndex
+ OnGetNodeDataSize = TreeDBOGetNodeDataSize
+ OnInitChildren = TreeDBOInitChildren
+ OnInitNode = TreeDBOInitNode
+ Columns = <>
+ end
+ object btnOK: TButton
+ Left = 68
+ Top = 283
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Caption = 'OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 1
+ end
+ object btnCancel: TButton
+ Left = 149
+ Top = 283
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Cancel = True
+ Caption = 'Cancel'
+ ModalResult = 2
+ TabOrder = 2
+ end
+ object editDB: TEdit
+ Left = 8
+ Top = 233
+ Width = 57
+ Height = 21
+ Anchors = [akLeft, akBottom]
+ TabOrder = 3
+ Text = 'editDB'
+ OnChange = editChange
+ end
+ object editTable: TEdit
+ Left = 69
+ Top = 233
+ Width = 58
+ Height = 21
+ Anchors = [akLeft, akBottom]
+ TabOrder = 4
+ Text = 'editTable'
+ OnChange = editChange
+ end
+ object editCol: TEdit
+ Left = 131
+ Top = 233
+ Width = 53
+ Height = 21
+ Anchors = [akLeft, akBottom]
+ TabOrder = 5
+ Text = 'editCol'
+ OnChange = editChange
+ end
+end
diff --git a/source/selectdbobject.pas b/source/selectdbobject.pas
new file mode 100644
index 00000000..0f4258c1
--- /dev/null
+++ b/source/selectdbobject.pas
@@ -0,0 +1,260 @@
+unit selectdbobject;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, VirtualTrees, Childwin, DB, Registry;
+
+type
+ TfrmSelectDBObject = class(TForm)
+ TreeDBO: TVirtualStringTree;
+ btnOK: TButton;
+ btnCancel: TButton;
+ lblSelect: TLabel;
+ editDB: TEdit;
+ editTable: TEdit;
+ editCol: TEdit;
+ lblDB: TLabel;
+ lblTable: TLabel;
+ lblCol: TLabel;
+ lblHint: TLabel;
+ procedure editChange(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormResize(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure TreeDBOFocusChanged(Sender: TBaseVirtualTree; Node: PVirtualNode;
+ Column: TColumnIndex);
+ procedure TreeDBOGetImageIndex(Sender: TBaseVirtualTree; Node: PVirtualNode;
+ Kind: TVTImageKind; Column: TColumnIndex; var Ghosted: Boolean; var
+ ImageIndex: Integer);
+ procedure TreeDBOGetNodeDataSize(Sender: TBaseVirtualTree; var NodeDataSize:
+ Integer);
+ procedure TreeDBOGetText(Sender: TBaseVirtualTree; Node: PVirtualNode; Column:
+ TColumnIndex; TextType: TVSTTextType; var CellText: WideString);
+ procedure TreeDBOInitChildren(Sender: TBaseVirtualTree; Node: PVirtualNode; var
+ ChildCount: Cardinal);
+ procedure TreeDBOInitNode(Sender: TBaseVirtualTree; ParentNode, Node:
+ PVirtualNode; var InitialStates: TVirtualNodeInitStates);
+ private
+ { Private declarations }
+ FDatabases: TStringList;
+ FColumns: Array of Array of TStringList;
+ function GetSelectedObject: TStringList;
+ public
+ { Public declarations }
+ property SelectedObject: TStringList read GetSelectedObject;
+ end;
+
+function SelectDBO: TStringList;
+
+var
+ CWin: TMDIChild;
+
+implementation
+
+uses main, helpers;
+
+{$R *.dfm}
+
+function SelectDBO: TStringList;
+begin
+ if Mainform.SelectDBObjectForm = nil then
+ Mainform.SelectDBObjectForm := TfrmSelectDBObject.Create(Mainform);
+ Result := nil;
+ if Mainform.SelectDBObjectForm.ShowModal = mrOK then
+ Result := Mainform.SelectDBObjectForm.SelectedObject;
+end;
+
+
+procedure TfrmSelectDBObject.FormCreate(Sender: TObject);
+begin
+ Width := Mainform.GetRegValue(REGNAME_SELECTDBO_WINWIDTH, Width);
+ Height := Mainform.GetRegValue(REGNAME_SELECTDBO_WINHEIGHT, Height);
+end;
+
+procedure TfrmSelectDBObject.FormDestroy(Sender: TObject);
+var
+ reg: TRegistry;
+begin
+ reg := TRegistry.Create;
+ if reg.OpenKey(REGPATH, False) then begin
+ reg.WriteInteger( REGNAME_SELECTDBO_WINWIDTH, Width );
+ reg.WriteInteger( REGNAME_SELECTDBO_WINHEIGHT, Height );
+ reg.CloseKey;
+ end;
+ reg.Free;
+end;
+
+procedure TfrmSelectDBObject.FormResize(Sender: TObject);
+var
+ EditWidth: Integer;
+const
+ space = 3;
+begin
+ // Calculate width for 1 TEdit
+ EditWidth := (TreeDBO.Width - 2*space) div 3;
+ // Set widths
+ editDb.Width := EditWidth;
+ editTable.Width := EditWidth;
+ editCol.Width := EditWidth;
+ // Set position of TEdits
+ editDb.Left := TreeDBO.Left;
+ editTable.Left := TreeDBO.Left + EditWidth + space;
+ editCol.Left := TreeDBO.Left + 2*(EditWidth + space);
+ // Set position of TLabels
+ lblDB.Left := editDB.Left;
+ lblTable.Left := editTable.Left;
+ lblCol.Left := editCol.Left;
+end;
+
+procedure TfrmSelectDBObject.FormShow(Sender: TObject);
+var
+ i: Integer;
+begin
+ CWin := Mainform.Childwin;
+ TreeDBO.Clear;
+ FDatabases := TStringList.Create;
+ for i := 0 to CWin.DBtree.Items.Count - 1 do begin
+ if CWin.DBtree.Items[i].Level <> 1 then
+ continue;
+ FDatabases.Add(CWin.DBtree.Items[i].Text);
+ end;
+ TreeDBO.RootNodeCount := FDatabases.Count;
+ SetLength(FColumns, FDatabases.Count);
+// TreeDBO.OnFocusChanged(TreeDBO, TreeDBO.FocusedNode, 0);
+ editDB.Clear;
+ editTable.Clear;
+ editCol.Clear;
+ editChange(Sender);
+end;
+
+
+function TfrmSelectDBObject.GetSelectedObject: TStringList;
+begin
+ Result := nil;
+ if editDb.Text <> '' then begin
+ Result := TStringList.Create;
+ Result.Add(editDb.Text);
+ if editTable.Text <> '' then Result.Add(editTable.Text);
+ if editCol.Text <> '' then Result.Add(editCol.Text);
+ end;
+ // Let the result be nil to indicate we have no selected node
+end;
+
+procedure TfrmSelectDBObject.TreeDBOFocusChanged(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Column: TColumnIndex);
+var
+ s: TStringList;
+begin
+ editDB.Clear;
+ editTable.Clear;
+ editCol.Clear;
+ if Assigned(TreeDBO.FocusedNode) then begin
+ s := TStringList.Create;
+ s.Delimiter := '.';
+ s.DelimitedText := TreeDBO.Path(TreeDBO.FocusedNode, -1, ttStatic, '.');
+ // Tree.Path is buggy, has mostly one superflous empty item at the end. Cut that.
+ while s.Count > 3 do
+ s.Delete(s.Count-1);
+ if s.Count >= 1 then editDB.Text := s[0];
+ if s.Count >= 2 then editTable.Text := s[1];
+ if s.Count >= 3 then editCol.Text := s[2];
+ s.Free;
+ end;
+end;
+
+
+procedure TfrmSelectDBObject.editChange(Sender: TObject);
+begin
+ // DB must be filled
+ btnOK.Enabled := editDB.Text <> '';
+ // If col given, check if table is also given
+ if editCol.Text <> '' then
+ btnOK.Enabled := editTable.Text <> '';
+end;
+
+
+procedure TfrmSelectDBObject.TreeDBOGetImageIndex(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex; var Ghosted:
+ Boolean; var ImageIndex: Integer);
+var
+ ds: TDataset;
+begin
+ case Sender.GetNodeLevel(Node) of
+ 0: ImageIndex := ICONINDEX_DB;
+ 1: begin
+ ds := CWin.FetchDbTableList(FDatabases[Node.Parent.Index]);
+ ds.RecNo := Node.Index+1;
+ case GetDBObjectType(ds.Fields) of
+ NODETYPE_BASETABLE: ImageIndex := ICONINDEX_TABLE;
+ NODETYPE_VIEW: ImageIndex := ICONINDEX_VIEW;
+ end;
+ end;
+ 2: ImageIndex := ICONINDEX_FIELD;
+ end;
+end;
+
+
+procedure TfrmSelectDBObject.TreeDBOGetNodeDataSize(Sender: TBaseVirtualTree;
+ var NodeDataSize: Integer);
+begin
+ NodeDataSize := 0;
+end;
+
+
+procedure TfrmSelectDBObject.TreeDBOInitChildren(Sender: TBaseVirtualTree;
+ Node: PVirtualNode; var ChildCount: Cardinal);
+var
+ ds: TDataset;
+ cols: TStringList;
+begin
+ // Fetch sub nodes
+ case Sender.GetNodeLevel(Node) of
+ 0: begin // DB expanding
+ ds := CWin.FetchDbTableList(FDatabases[Node.Index]);
+ ChildCount := ds.RecordCount;
+ SetLength(FColumns[Node.Index], ds.RecordCount);
+ end;
+ 1: begin // Table expanding
+ ds := CWin.FetchDbTableList(FDatabases[Node.Parent.Index]);
+ ds.RecNo := Node.Index+1;
+ cols := CWin.GetCol('SHOW COLUMNS FROM '
+ + Mainform.mask(FDatabases[Node.Parent.Index])+'.'
+ + Mainform.Mask(ds.Fields[0].AsString));
+ FColumns[Node.Parent.Index][Node.Index] := cols;
+ ChildCount := cols.Count;
+ end;
+ end;
+
+end;
+
+
+procedure TfrmSelectDBObject.TreeDBOGetText(Sender: TBaseVirtualTree; Node:
+ PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType; var CellText:
+ WideString);
+var
+ ds: TDataset;
+begin
+ case Sender.GetNodeLevel(Node) of
+ 0: CellText := FDatabases[Node.Index];
+ 1: begin
+ ds := CWin.FetchDbTableList(FDatabases[Node.Parent.Index]);
+ ds.RecNo := Node.Index+1;
+ CellText := ds.Fields[0].AsString;
+ end;
+ 2: CellText := FColumns[Node.Parent.Parent.Index][Node.Parent.Index][Node.Index];
+ end;
+end;
+
+
+procedure TfrmSelectDBObject.TreeDBOInitNode(Sender: TBaseVirtualTree;
+ ParentNode, Node: PVirtualNode; var InitialStates: TVirtualNodeInitStates);
+begin
+ // Ensure plus sign is visible for dbs and tables
+ if Sender.GetNodeLevel(Node) in [0,1] then
+ InitialStates := InitialStates + [ivsHasChildren];
+end;
+
+end.
diff --git a/source/usermanager.dfm b/source/usermanager.dfm
index 63932a64..1b12ef5f 100644
--- a/source/usermanager.dfm
+++ b/source/usermanager.dfm
@@ -1,13 +1,13 @@
object UserManagerForm: TUserManagerForm
Left = 252
Top = 131
- BorderWidth = 5
- Caption = 'User-Manager'
- ClientHeight = 380
- ClientWidth = 533
+ BorderIcons = [biSystemMenu, biMaximize]
+ Caption = 'User Manager'
+ ClientHeight = 446
+ ClientWidth = 352
Color = clBtnFace
- Constraints.MinHeight = 417
- Constraints.MinWidth = 551
+ Constraints.MinHeight = 473
+ Constraints.MinWidth = 360
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
@@ -17,485 +17,459 @@ object UserManagerForm: TUserManagerForm
Position = poMainFormCenter
OnClose = FormClose
OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnResize = FormResize
OnShow = FormShow
+ DesignSize = (
+ 352
+ 446)
PixelsPerInch = 96
TextHeight = 13
- object PageControl1: TPageControl
- Left = 0
- Top = 0
- Width = 533
- Height = 343
- ActivePage = TabSheetAddUser
- Align = alClient
- Images = MainForm.PngImageListMain
- TabHeight = 22
+ object lblUser: TLabel
+ Left = 8
+ Top = 11
+ Width = 29
+ Height = 13
+ Caption = '&User:'
+ FocusControl = comboUsers
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ object comboUsers: TComboBoxEx
+ Left = 56
+ Top = 8
+ Width = 235
+ Height = 22
+ ItemsEx = <>
+ Style = csExDropDownList
+ Anchors = [akLeft, akTop, akRight]
+ ItemHeight = 16
TabOrder = 0
- OnChange = PageControl1Change
- object TabSheetAddUser: TTabSheet
- Caption = 'Add User'
- ImageIndex = 21
- object Label4: TLabel
- Left = 16
- Top = 40
+ OnChange = comboUsersChange
+ Images = MainForm.PngImageListMain
+ end
+ object btnCancel: TButton
+ Left = 269
+ Top = 413
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Cancel = True
+ Caption = 'Cancel'
+ ModalResult = 2
+ TabOrder = 1
+ end
+ object btnOK: TButton
+ Left = 187
+ Top = 413
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Caption = 'OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 2
+ OnClick = btnOKClick
+ end
+ object comboObjects: TComboBoxEx
+ Left = 8
+ Top = 232
+ Width = 283
+ Height = 22
+ ItemsEx = <>
+ Style = csExDropDownList
+ Anchors = [akLeft, akTop, akRight]
+ ItemHeight = 16
+ TabOrder = 3
+ OnChange = comboObjectsChange
+ Images = MainForm.PngImageListMain
+ end
+ object boxPrivs: TCheckListBox
+ Left = 8
+ Top = 260
+ Width = 336
+ Height = 147
+ OnClickCheck = boxPrivsClickCheck
+ Anchors = [akLeft, akTop, akRight, akBottom]
+ Columns = 3
+ ItemHeight = 13
+ TabOrder = 4
+ end
+ object tlbObjects: TToolBar
+ Left = 297
+ Top = 232
+ Width = 46
+ Height = 22
+ Align = alNone
+ Anchors = [akTop, akRight]
+ AutoSize = True
+ Caption = 'tlbObjects'
+ Images = MainForm.PngImageListMain
+ ParentShowHint = False
+ ShowHint = True
+ TabOrder = 5
+ object btnAddObject: TToolButton
+ Left = 0
+ Top = 0
+ Hint = 'Add object ...'
+ ImageIndex = 45
+ OnClick = btnAddObjectClick
+ end
+ object btnDeleteObject: TToolButton
+ Left = 23
+ Top = 0
+ Hint = 'Remove access to object ...'
+ ImageIndex = 46
+ OnClick = btnDeleteObjectClick
+ end
+ end
+ object tlbUsers: TToolBar
+ Left = 297
+ Top = 8
+ Width = 46
+ Height = 22
+ Align = alNone
+ Anchors = [akTop, akRight]
+ AutoSize = True
+ Caption = 'tlbUsers'
+ Images = MainForm.PngImageListMain
+ ParentShowHint = False
+ ShowHint = True
+ TabOrder = 6
+ object btnAddUser: TToolButton
+ Left = 0
+ Top = 0
+ Hint = 'Create user ...'
+ ImageIndex = 45
+ OnClick = btnAddUserClick
+ end
+ object btnDeleteUser: TToolButton
+ Left = 23
+ Top = 0
+ Hint = 'Delete user ...'
+ ImageIndex = 46
+ OnClick = btnDeleteUserClick
+ end
+ end
+ object chkTogglePrivs: TCheckBox
+ Left = 8
+ Top = 417
+ Width = 129
+ Height = 17
+ Anchors = [akLeft, akBottom]
+ Caption = 'Select / Deselect all'
+ TabOrder = 7
+ OnClick = chkTogglePrivsClick
+ end
+ object PageControlUser: TPageControl
+ Left = 8
+ Top = 36
+ Width = 335
+ Height = 190
+ ActivePage = tabSettings
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 8
+ object tabSettings: TTabSheet
+ Caption = 'Settings'
+ DesignSize = (
+ 327
+ 162)
+ object lblFromHost: TLabel
+ Left = 10
+ Top = 62
Width = 52
Height = 13
- Caption = '&Username:'
- FocusControl = EditUser
+ Caption = 'From &host:'
+ FocusControl = editFromHost
end
- object Label5: TLabel
- Left = 16
- Top = 88
+ object lblPassword: TLabel
+ Left = 10
+ Top = 36
Width = 50
Height = 13
Caption = '&Password:'
- FocusControl = EditPassword
+ FocusControl = editPassword
end
- object Label6: TLabel
- Left = 16
- Top = 64
- Width = 53
+ object lblUsername: TLabel
+ Left = 10
+ Top = 10
+ Width = 55
Height = 13
- Caption = 'From &Host:'
- FocusControl = EditHost
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Tahoma'
- Font.Style = []
- ParentFont = False
+ Caption = 'User &name:'
end
- object Label7: TLabel
- Left = 256
- Top = 16
- Width = 89
+ object lblHostHint: TLabel
+ Left = 100
+ Top = 84
+ Width = 164
Height = 13
- Caption = 'Allow a&ccess to:'
- FocusControl = DBUserTree
+ Caption = '(Host: % and _ wildcards allowed)'
+ end
+ object lblWarning: TLabel
+ Left = 10
+ Top = 136
+ Width = 314
+ Height = 23
+ Anchors = [akLeft, akTop, akRight]
+ AutoSize = False
+ Caption = 'Security warning'
Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
+ Font.Color = clRed
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
+ WordWrap = True
end
- object Label8: TLabel
- Left = 16
- Top = 128
- Width = 58
+ object editPassword: TEdit
+ Left = 100
+ Top = 33
+ Width = 220
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 1
+ Text = 'editPassword'
+ OnChange = editPasswordChange
+ OnEnter = editPasswordEnter
+ OnExit = editPasswordExit
+ end
+ object editFromHost: TEdit
+ Left = 100
+ Top = 59
+ Width = 220
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 2
+ Text = 'editFromHost'
+ OnChange = editFromHostChange
+ end
+ object chkDisabled: TCheckBox
+ Left = 10
+ Top = 105
+ Width = 103
+ Height = 17
+ Alignment = taLeftJustify
+ Caption = '&Disable account:'
+ TabOrder = 3
+ OnClick = chkDisabledClick
+ end
+ object editUsername: TEdit
+ Left = 100
+ Top = 7
+ Width = 220
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ TabOrder = 0
+ Text = 'editUsername'
+ OnChange = editUsernameChange
+ end
+ end
+ object tabLimitations: TTabSheet
+ Caption = 'Limitations'
+ ImageIndex = 1
+ DesignSize = (
+ 327
+ 162)
+ object lblMaxQuestions: TLabel
+ Left = 10
+ Top = 10
+ Width = 182
Height = 13
- Caption = 'Privileges:'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Tahoma'
- Font.Style = [fsBold]
- ParentFont = False
+ Caption = 'Maximum number of &queries per hour:'
+ FocusControl = editMaxQuestions
end
- object Label9: TLabel
- Left = 16
- Top = 16
- Width = 67
+ object lblMaxUpdates: TLabel
+ Left = 10
+ Top = 34
+ Width = 186
Height = 13
- Caption = 'Credentials:'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Tahoma'
- Font.Style = [fsBold]
- ParentFont = False
+ Caption = 'Maximum number of &updates per hour:'
+ FocusControl = editMaxUpdates
end
- object Bevel1: TBevel
- Left = 16
- Top = 120
- Width = 209
- Height = 9
- Shape = bsTopLine
+ object lblMaxConnections: TLabel
+ Left = 10
+ Top = 58
+ Width = 204
+ Height = 13
+ Caption = 'Maximum number of &connections per hour:'
+ FocusControl = editMaxConnections
end
- object Label1: TLabel
- Left = 274
- Top = 272
+ object lblMaxUserConnections: TLabel
+ Left = 10
+ Top = 82
+ Width = 225
+ Height = 13
+ Caption = 'Maximum number of &simultaneous connections:'
+ FocusControl = editMaxUserConnections
+ end
+ object lblLimitHint: TLabel
+ Left = 184
+ Top = 138
+ Width = 133
+ Height = 13
+ Caption = '(Use 0 to indicate unlimited)'
+ end
+ object editMaxUserConnections: TEdit
+ Left = 240
+ Top = 79
+ Width = 64
+ Height = 21
+ Anchors = [akTop, akRight]
+ TabOrder = 6
+ Text = '0'
+ end
+ object editMaxConnections: TEdit
+ Left = 240
+ Top = 55
+ Width = 64
+ Height = 21
+ Anchors = [akTop, akRight]
+ TabOrder = 4
+ Text = '0'
+ end
+ object editMaxUpdates: TEdit
+ Left = 240
+ Top = 31
+ Width = 64
+ Height = 21
+ Anchors = [akTop, akRight]
+ TabOrder = 2
+ Text = '0'
+ end
+ object editMaxQuestions: TEdit
+ Left = 240
+ Top = 7
+ Width = 64
+ Height = 21
+ Anchors = [akTop, akRight]
+ TabOrder = 0
+ Text = '0'
+ end
+ object udMaxQuestions: TUpDown
+ Left = 304
+ Top = 7
+ Width = 16
+ Height = 21
+ Anchors = [akTop, akRight]
+ Associate = editMaxQuestions
+ Max = 32767
+ TabOrder = 1
+ Wrap = True
+ end
+ object udMaxUpdates: TUpDown
+ Left = 304
+ Top = 31
+ Width = 16
+ Height = 21
+ Anchors = [akTop, akRight]
+ Associate = editMaxUpdates
+ Max = 32767
+ TabOrder = 3
+ Wrap = True
+ end
+ object udMaxConnections: TUpDown
+ Left = 304
+ Top = 55
+ Width = 16
+ Height = 21
+ Anchors = [akTop, akRight]
+ Associate = editMaxConnections
+ Max = 32767
+ TabOrder = 5
+ Wrap = True
+ end
+ object udMaxUserConnections: TUpDown
+ Left = 304
+ Top = 79
+ Width = 16
+ Height = 21
+ Anchors = [akTop, akRight]
+ Associate = editMaxUserConnections
+ Max = 32767
+ TabOrder = 7
+ Wrap = True
+ end
+ end
+ object tabUserInfo: TTabSheet
+ Caption = 'User info'
+ ImageIndex = 2
+ TabVisible = False
+ DesignSize = (
+ 327
+ 162)
+ object lblFullName: TLabel
+ Left = 10
+ Top = 10
+ Width = 49
+ Height = 13
+ Caption = '&Full name:'
+ end
+ object lblDescription: TLabel
+ Left = 10
+ Top = 36
Width = 57
Height = 13
Caption = '&Description:'
- Enabled = False
- FocusControl = EditDescription
end
- object DBUserTree: TTreeView
- Left = 256
- Top = 40
- Width = 257
- Height = 193
- Images = MainForm.PngImageListMain
- Indent = 19
- ReadOnly = True
- RowSelect = True
- ShowLines = False
- ShowRoot = False
- TabOrder = 3
- OnExpanding = DBUserTreeExpanding
+ object lblEmail: TLabel
+ Left = 10
+ Top = 62
+ Width = 28
+ Height = 13
+ Caption = '&Email:'
end
- object EditUser: TEdit
- Left = 96
- Top = 40
- Width = 129
- Height = 21
- TabOrder = 0
- end
- object EditPassword: TEdit
- Left = 96
+ object lblContactInfo: TLabel
+ Left = 10
Top = 88
- Width = 129
+ Width = 63
+ Height = 13
+ Caption = '&Contact info:'
+ end
+ object editFullName: TEdit
+ Left = 100
+ Top = 7
+ Width = 220
Height = 21
- PasswordChar = '*'
- TabOrder = 2
- end
- object EditHost: TEdit
- Left = 96
- Top = 64
- Width = 129
- Height = 21
- TabOrder = 1
- Text = '%'
- end
- object CheckListBoxPrivileges: TCheckListBox
- Left = 96
- Top = 152
- Width = 129
- Height = 113
- ItemHeight = 13
- Items.Strings = (
- 'Select'
- 'Insert'
- 'Update'
- '...')
- TabOrder = 5
- end
- object CheckBoxAllPrivileges: TCheckBox
- Left = 96
- Top = 128
- Width = 105
- Height = 17
- Caption = '&All Privileges'
- TabOrder = 4
- OnClick = CheckBoxAllPrivilegesClick
- end
- object CheckBoxWithGrant: TCheckBox
- Left = 96
- Top = 272
- Width = 105
- Height = 17
- Caption = '&With Grant Option'
- TabOrder = 6
- end
- object CheckBoxCreateAccount: TCheckBox
- Left = 256
- Top = 248
- Width = 249
- Height = 17
- Caption = 'Create Connection-Account for appname'
- TabOrder = 7
- OnClick = CheckBoxCreateAccountClick
- end
- object EditDescription: TEdit
- Left = 336
- Top = 270
- Width = 177
- Height = 21
- Enabled = False
- TabOrder = 8
- end
- end
- object TabSheetEditUsers: TTabSheet
- Caption = 'Edit Users'
- ImageIndex = 12
- object Panel1: TPanel
- Left = 280
- Top = 0
- Width = 245
- Height = 311
- Align = alRight
- Anchors = [akLeft, akTop, akRight, akBottom]
- BevelOuter = bvNone
+ Anchors = [akLeft, akTop, akRight]
+ MaxLength = 60
TabOrder = 0
- DesignSize = (
- 245
- 311)
- object Label13: TLabel
- Left = 14
- Top = 82
- Width = 39
- Height = 13
- Caption = 'Column:'
- Visible = False
- end
- object LabelColumn: TLabel
- Left = 84
- Top = 82
- Width = 60
- Height = 13
- Caption = 'LabelColumn'
- Visible = False
- end
- object LabelTable: TLabel
- Left = 84
- Top = 66
- Width = 51
- Height = 13
- Caption = 'LabelTable'
- Visible = False
- end
- object LabelDB: TLabel
- Left = 84
- Top = 50
- Width = 38
- Height = 13
- Caption = 'LabelDB'
- Visible = False
- end
- object Label12: TLabel
- Left = 14
- Top = 66
- Width = 30
- Height = 13
- Caption = 'Table:'
- Visible = False
- end
- object Label11: TLabel
- Left = 14
- Top = 50
- Width = 50
- Height = 13
- Caption = 'Database:'
- Visible = False
- end
- object LabelPrivileges: TLabel
- Left = 14
- Top = 8
- Width = 58
- Height = 13
- Caption = 'Privileges:'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Tahoma'
- Font.Style = [fsBold]
- ParentFont = False
- Visible = False
- WordWrap = True
- end
- object LabelPleaseSelect: TLabel
- Left = 40
- Top = 96
- Width = 136
- Height = 39
- Caption =
- 'Please select a user or doubleclick on a user to access items be' +
- 'low him.'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Tahoma'
- Font.Style = [fsBold]
- ParentFont = False
- WordWrap = True
- end
- object LabelNoPrivs: TLabel
- Left = 24
- Top = 120
- Width = 200
- Height = 13
- Caption = 'No Privileges are set for the selected item'
- Visible = False
- end
- object LabelUser: TLabel
- Left = 14
- Top = 32
- Width = 3
- Height = 13
- end
- object CheckListBoxPrivs: TCheckListBox
- Left = 14
- Top = 106
- Width = 107
- Height = 193
- OnClickCheck = CheckListBoxPrivsClickCheck
- Anchors = [akLeft, akTop, akRight, akBottom]
- ItemHeight = 13
- Items.Strings = (
- 'Select'
- 'Insert'
- 'Update'
- 'Delete'
- 'Create'
- 'Drop'
- 'Reload'
- 'Shutdown'
- 'Process'
- 'File'
- 'Grant'
- 'References'
- 'Index'
- 'Alter')
- TabOrder = 0
- Visible = False
- end
- object ButtonSelectAll: TButton
- Left = 136
- Top = 172
- Width = 100
- Height = 25
- Anchors = [akRight, akBottom]
- Caption = 'Select all'
- TabOrder = 1
- Visible = False
- OnClick = ButtonSelectAllClick
- end
- object ButtonSelectNone: TButton
- Left = 136
- Top = 204
- Width = 100
- Height = 25
- Anchors = [akRight, akBottom]
- Caption = 'Select none'
- TabOrder = 2
- Visible = False
- OnClick = ButtonSelectNoneClick
- end
- object ButtonSet: TButton
- Left = 136
- Top = 244
- Width = 100
- Height = 25
- Anchors = [akRight, akBottom]
- Caption = 'Grant Privileges'
- Enabled = False
- TabOrder = 3
- Visible = False
- OnClick = ButtonSetClick
- end
- object ButtonSelectPrivileges: TButton
- Left = 72
- Top = 136
- Width = 113
- Height = 25
- Caption = 'Specify Privileges'
- TabOrder = 4
- OnClick = ButtonSelectPrivilegesClick
- end
- object ButtonRevoke: TButton
- Left = 136
- Top = 274
- Width = 100
- Height = 25
- Anchors = [akRight, akBottom]
- Caption = 'Revoke Privileges'
- TabOrder = 5
- OnClick = ButtonRevokeClick
- end
+ Text = 'editFullName'
end
- object Panel2: TPanel
- Left = 0
- Top = 0
- Width = 280
- Height = 311
- Align = alClient
- BevelOuter = bvNone
- BorderWidth = 5
- Caption = 'Panel2'
+ object editDescription: TEdit
+ Left = 100
+ Top = 33
+ Width = 220
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ MaxLength = 255
TabOrder = 1
- object Label2: TLabel
- Left = 5
- Top = 5
- Width = 270
- Height = 13
- Align = alTop
- Caption = 'Registered users:'
- Font.Charset = DEFAULT_CHARSET
- Font.Color = clWindowText
- Font.Height = -11
- Font.Name = 'Tahoma'
- Font.Style = [fsBold]
- ParentFont = False
- end
- object TreeViewUsers: TTreeView
- Left = 5
- Top = 18
- Width = 270
- Height = 253
- Align = alClient
- Anchors = [akLeft, akTop, akBottom]
- ChangeDelay = 50
- HotTrack = True
- Images = MainForm.PngImageListMain
- Indent = 19
- ReadOnly = True
- TabOrder = 0
- OnChange = TreeViewUsersChange
- OnDblClick = TreeViewUsersDblClick
- end
- object Panel4: TPanel
- Left = 5
- Top = 271
- Width = 270
- Height = 35
- Align = alBottom
- BevelOuter = bvNone
- TabOrder = 1
- object ButtonEditUser: TButton
- Left = 0
- Top = 8
- Width = 105
- Height = 25
- Caption = 'Edit User...'
- Enabled = False
- TabOrder = 0
- OnClick = ButtonEditUserClick
- end
- object Button1: TButton
- Left = 112
- Top = 8
- Width = 105
- Height = 25
- Caption = 'Refresh'
- TabOrder = 1
- OnClick = Button1Click
- end
- end
+ Text = 'editDescription'
+ end
+ object editEmail: TEdit
+ Left = 100
+ Top = 59
+ Width = 220
+ Height = 21
+ Anchors = [akLeft, akTop, akRight]
+ MaxLength = 80
+ TabOrder = 2
+ Text = 'editEmail'
+ end
+ object memoContactInfo: TMemo
+ Left = 100
+ Top = 86
+ Width = 220
+ Height = 67
+ Anchors = [akLeft, akTop, akRight]
+ Lines.Strings = (
+ 'memoContactInfo')
+ MaxLength = 65535
+ ScrollBars = ssVertical
+ TabOrder = 3
end
- end
- end
- object Panel3: TPanel
- Left = 0
- Top = 343
- Width = 533
- Height = 37
- Align = alBottom
- BevelOuter = bvNone
- TabOrder = 1
- DesignSize = (
- 533
- 37)
- object ButtonClose: TButton
- Left = 456
- Top = 8
- Width = 75
- Height = 25
- Anchors = [akTop, akRight]
- Cancel = True
- Caption = 'Close'
- ModalResult = 2
- TabOrder = 0
- end
- object ButtonAddUser: TButton
- Left = 368
- Top = 8
- Width = 75
- Height = 25
- Anchors = [akTop, akRight]
- Caption = 'Add User'
- Default = True
- TabOrder = 1
- OnClick = ButtonAddUserClick
end
end
end
diff --git a/source/usermanager.pas b/source/usermanager.pas
index edc4e04a..37ac137f 100644
--- a/source/usermanager.pas
+++ b/source/usermanager.pas
@@ -1,1046 +1,1617 @@
unit usermanager;
-// -------------------------------------
-// Usermanager
-// -------------------------------------
-
-
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
- ComCtrls, StdCtrls, CheckLst, ImgList, ExtCtrls, Registry, ZDataset, Db;
- // winsock
+ ComCtrls, StdCtrls, CheckLst, ExtCtrls, Buttons, DB,
+ Registry, ToolWin;
+
+{$I const.inc}
+
type
- TUserManagerForm = class(TForm)
- PageControl1: TPageControl;
- TabSheetAddUser: TTabSheet;
- DBUserTree: TTreeView;
- EditUser: TEdit;
- EditPassword: TEdit;
- EditHost: TEdit;
- Label4: TLabel;
- Label5: TLabel;
- Label6: TLabel;
- Label7: TLabel;
- CheckListBoxPrivileges: TCheckListBox;
- CheckBoxAllPrivileges: TCheckBox;
- Label8: TLabel;
- CheckBoxWithGrant: TCheckBox;
- Label9: TLabel;
- Bevel1: TBevel;
- CheckBoxCreateAccount: TCheckBox;
- EditDescription: TEdit;
- Label1: TLabel;
- TabSheetEditUsers: TTabSheet;
- Panel1: TPanel;
- CheckListBoxPrivs: TCheckListBox;
- Label13: TLabel;
- LabelColumn: TLabel;
- LabelTable: TLabel;
- LabelDB: TLabel;
- Label12: TLabel;
- Label11: TLabel;
- LabelPrivileges: TLabel;
- Panel2: TPanel;
- Label2: TLabel;
- TreeViewUsers: TTreeView;
- ButtonSelectAll: TButton;
- ButtonSelectNone: TButton;
- ButtonSet: TButton;
- LabelPleaseSelect: TLabel;
- LabelNoPrivs: TLabel;
- ButtonSelectPrivileges: TButton;
- Panel3: TPanel;
- ButtonClose: TButton;
- ButtonAddUser: TButton;
- LabelUser: TLabel;
- ButtonRevoke: TButton;
- Panel4: TPanel;
- ButtonEditUser: TButton;
- Button1: TButton;
- procedure FormCreate(Sender: TObject);
- procedure DBUserTreeExpanding(Sender: TObject; Node: TTreeNode;
- var AllowExpansion: Boolean);
- procedure FormShow(Sender: TObject);
- procedure CheckBoxAllPrivilegesClick(Sender: TObject);
- procedure ButtonAddUserClick(Sender: TObject);
- procedure CheckBoxCreateAccountClick(Sender: TObject);
- procedure TreeViewUsersDblClick(Sender: TObject);
- procedure TreeViewUsersChange(Sender: TObject; Node: TTreeNode);
- procedure PageControl1Change(Sender: TObject);
- procedure ButtonSelectAllClick(Sender: TObject);
- procedure ButtonSelectNoneClick(Sender: TObject);
- procedure ShowPrivilegesControls(v,w,y: Boolean);
- procedure ButtonSelectPrivilegesClick(Sender: TObject);
- procedure ShowPrivs(node: TTreeNode);
- procedure FormClose(Sender: TObject; var Action: TCloseAction);
- procedure ButtonSetClick(Sender: TObject);
- procedure CheckListBoxPrivsClickCheck(Sender: TObject);
- procedure ButtonRevokeClick(Sender: TObject);
- procedure ButtonEditUserClick(Sender: TObject);
- procedure Button1Click(Sender: TObject);
- procedure GetResUsers;
- procedure GetResDBs;
- procedure GetResTables;
- procedure GetResColumns;
- function getColumnNamesOrValues( which: String = 'columns' ): TStringList;
- function getPrivColumns( privtable: String ): TDataSet;
- procedure clearCache;
-
-
- private
- { Private declarations }
- editcurrent : Boolean;
- public
- { Public declarations }
- User, Host : String; // Remember for setting privileges
- ZQueryDBs, ZQueryTables, ZQueryColumns, ZQueryUsers: TDataSet;
- ColumnsUsers, ColumnsDB, ColumnsTables, ColumnsColumns : TDataSet;
+ TPrivilege = class(TObject)
+ private
+ FDBOType: Byte;
+ // Internal Flags
+ FDeleted: Boolean;
+ FAdded: Boolean;
+ FModified: Boolean;
+ function GetDBOKey: String;
+ function GetDBOPrettyKey: String;
+ function GetPrettyPrivNames: TStringList;
+ public
+ DBONames: TStringList;
+ PrivNames: TStringList;
+ SelectedPrivNames: TStringList;
+ constructor Create(Fields: TFields; FieldDefs: TDataset = nil; AvoidFieldDefs: TDataSet = nil; CropFieldDefs: TDataSet = nil; SimulateDbField: Boolean = False);
+ procedure Merge(Fields: TFields);
+ property DBOType: Byte read FDBOType;
+ property DBOKey: String read GetDBOKey;
+ property DBOPrettyKey: String read GetDBOPrettyKey;
+ property PrettyPrivNames: TStringList read GetPrettyPrivNames;
+ property Added: Boolean read FAdded write FAdded;
+ property Modified: Boolean read FModified write FModified;
+ property Deleted: Boolean read FDeleted write FDeleted;
end;
- function UserManagerWindow (AOwner : TComponent; Flags : String = '') : Boolean;
+ TUser = class; // Forward declaration
-var
- UserManagerForm: TUserManagerForm;
- old_ActualDatabase : String;
+ TPrivileges = class(TObject)
+ private
+ FPrivilegeItems: Array of TPrivilege;
+ FOwner: TUser;
+ function GetPrivilege(Index: Integer): TPrivilege;
+ function GetCount: Integer;
+ public
+ constructor Create(AOwner: TUser);
+ function AddPrivilege(Fields: TFields; FieldDefs: TDataset = nil; AvoidFieldDefs: TDataSet = nil; CropFieldDefs: TDataSet = nil; SimulateDbField: Boolean = False): TPrivilege;
+ property Items[Index: Integer]: TPrivilege read GetPrivilege; default;
+ property Count: Integer read GetCount;
+ procedure DeletePrivilege(Index: Integer);
+ function FindPrivilege(Fields: TFields; SimulateDbField: Boolean): TPrivilege;
+ end;
+ TUser = class(TObject)
+ private
+ FOldName: String;
+ FNewName: String;
+ FPassword: String;
+ FOldPasswordHashed: String;
+ FOldHost: String;
+ FNewHost: String;
+ FOldMaxQuestions: Cardinal;
+ FOldMaxUpdates: Cardinal;
+ FOldMaxConnections: Cardinal;
+ FOldMaxUserConnections: Cardinal;
+ FMaxQuestions: Cardinal;
+ FMaxUpdates: Cardinal;
+ FMaxConnections: Cardinal;
+ FMaxUserConnections: Cardinal;
+ // Internal Flags
+ FDeleted: Boolean;
+ FDisabled: Boolean;
+ FAdded: Boolean;
+ FPasswordModified: Boolean;
+ FOtherModified: Boolean;
+ FPrivileges: TPrivileges;
+ function GetModified: Boolean;
+ function GetName: String;
+ procedure SetName(str: String);
+ function GetHost: String;
+ procedure SetHost(str: String);
+ procedure SetPassword(str: String);
+ public
+ constructor Create(Fields: TFields = nil); overload;
+ constructor Create(Name: String; Host: String); overload;
+ property Name: String read GetName write SetName;
+ property Host: String read GetHost write SetHost;
+ property Password: String read FPassword write SetPassword;
+ property OldPasswordHashed: String read FOldPasswordHashed write FOldPasswordHashed;
+ property Privileges: TPrivileges read FPrivileges;
+ property MaxQuestions: Cardinal read FMaxQuestions write FMaxQuestions;
+ property MaxUpdates: Cardinal read FMaxUpdates write FMaxUpdates;
+ property MaxConnections: Cardinal read FMaxConnections write FMaxConnections;
+ property MaxUserConnections: Cardinal read FMaxUserConnections write FMaxUserConnections;
+ property Deleted: Boolean read FDeleted write FDeleted;
+ property Disabled: Boolean read FDisabled write FDisabled;
+ property Added: Boolean read FAdded;
+ property Modified: Boolean read GetModified write FOtherModified;
+ property PasswordModified: Boolean read FPasswordModified write FPasswordModified;
+ end;
+
+ TUsers = class(TObject)
+ constructor Create;
+ private
+ FUserItems: Array of TUser;
+ function GetUser(Index: Integer): TUser;
+ function GetCount: Integer;
+ public
+ // The default property, can be access via Object[nr]
+ property Items[Index: Integer]: TUser read GetUser; default;
+ property Count: Integer read GetCount;
+ procedure AddUser(User: TUser);
+ procedure DeleteUser(Index: Integer);
+ function FindUser(Name: String; Host: String): TUser;
+ end;
+
+ TUserManagerForm = class(TForm)
+ lblUser: TLabel;
+ comboUsers: TComboBoxEx;
+ btnCancel: TButton;
+ btnOK: TButton;
+ comboObjects: TComboBoxEx;
+ boxPrivs: TCheckListBox;
+ tlbObjects: TToolBar;
+ btnAddObject: TToolButton;
+ btnDeleteObject: TToolButton;
+ tlbUsers: TToolBar;
+ btnAddUser: TToolButton;
+ btnDeleteUser: TToolButton;
+ chkTogglePrivs: TCheckBox;
+ PageControlUser: TPageControl;
+ tabSettings: TTabSheet;
+ lblFromHost: TLabel;
+ lblPassword: TLabel;
+ editPassword: TEdit;
+ editFromHost: TEdit;
+ tabLimitations: TTabSheet;
+ lblMaxQuestions: TLabel;
+ lblMaxUpdates: TLabel;
+ lblMaxConnections: TLabel;
+ lblMaxUserConnections: TLabel;
+ editMaxUserConnections: TEdit;
+ editMaxConnections: TEdit;
+ editMaxUpdates: TEdit;
+ editMaxQuestions: TEdit;
+ udMaxQuestions: TUpDown;
+ udMaxUpdates: TUpDown;
+ udMaxConnections: TUpDown;
+ udMaxUserConnections: TUpDown;
+ tabUserInfo: TTabSheet;
+ lblFullName: TLabel;
+ editFullName: TEdit;
+ chkDisabled: TCheckBox;
+ lblDescription: TLabel;
+ editDescription: TEdit;
+ lblEmail: TLabel;
+ editEmail: TEdit;
+ lblContactInfo: TLabel;
+ memoContactInfo: TMemo;
+ lblUsername: TLabel;
+ editUsername: TEdit;
+ lblLimitHint: TLabel;
+ lblHostHint: TLabel;
+ lblWarning: TLabel;
+ procedure boxPrivsClickCheck(Sender: TObject);
+ procedure btnAddObjectClick(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure btnAddUserClick(Sender: TObject);
+ procedure btnDeleteObjectClick(Sender: TObject);
+ procedure btnDeleteUserClick(Sender: TObject);
+ procedure btnOKClick(Sender: TObject);
+ procedure chkDisabledClick(Sender: TObject);
+ procedure chkTogglePrivsClick(Sender: TObject);
+ procedure comboObjectsChange(Sender: TObject);
+ procedure comboUsersChange(Sender: TObject);
+ procedure editFromHostChange(Sender: TObject);
+ procedure clickLimitations(Sender: TObject; Button: TUDBtnType);
+ procedure editLimitations(Sender: TObject);
+ procedure editPasswordChange(Sender: TObject);
+ procedure editPasswordEnter(Sender: TObject);
+ procedure editPasswordExit(Sender: TObject);
+ procedure editUsernameChange(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormCreate(Sender: TObject);
+ procedure FormResize(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ private
+ { Private declarations }
+ Users: TUsers;
+ procedure RefreshGUI;
+ procedure RefreshUserPulldown;
+ procedure SetChkToggleStatus;
+ public
+ { Public declarations }
+ end;
+
+procedure GetPrivilegeRowKey(Fields: TFields; SimulateDbField: Boolean; out DBOType: Byte; out DBONames: TStringList);
implementation
uses
- main, childwin, helpers, edituser;
+ main, childwin, helpers, selectdbobject;
+
+
+var
+ CWin: TMDIChild;
+ db: String;
+ // Results from SELECT * FROM user/db/...
+ dsUser, dsDb, dsTables, dsColumns,
+ // Results from SHOW FIELDS FROM user/db/...
+ dsTablesFields, dsColumnsFields : TDataset;
+
-{$I const.inc}
{$R *.DFM}
-function UserManagerWindow (AOwner : TComponent; Flags : String = '') : Boolean;
-var
- f : TUserManagerForm;
- test_result : String;
- cwin : TMDIChild;
-begin
- // Test if we can access the privileges database and tables by
- // A. Using the mysql-DB
- cwin := Mainform.Childwin;
- try
- try
- cwin.TemporaryDatabase := DBNAME_MYSQL;
- cwin.EnsureDatabase;
- except
- MessageDlg('You have no access to the privileges database.', mtError, [mbOK], 0);
- Result := false;
- exit;
- end;
- // B. retrieving a count of all users.
- test_result := cwin.GetVar( 'SELECT COUNT(*) FROM '+mainform.mask(PRIVTABLE_USERS), 0, true, false );
- if test_result = '' then
- begin
- MessageDlg('You have no access to the privileges tables.', mtError, [mbOK], 0);
- Result := false;
- exit;
- end;
- f := TUserManagerForm.Create(AOwner);
-
- // use this dirty trick to overcome limitations
- UsermanagerForm := f;
-
- // set flags ...
- Result := (f.ShowModal = mrOK);
- FreeAndNil (f);
-
- UsermanagerForm := nil; // uhhh
- finally
- cwin.TemporaryDatabase := '';
- end;
-end;
-
-procedure TUserManagerForm.FormShow(Sender: TObject);
-var
- i : Integer;
- tntop, tn1, tnu1, tnu2 : TTreeNode;
-
-// wsadat : WSAData;
-// host : String;
-// ph : PHostEnt;
-begin
- Screen.Cursor := crHourglass;
- DBUserTree.Items.Clear;
- TreeViewUsers.Items.Clear;
- PageControl1.ActivePageIndex := 0;
- ShowPrivilegesControls(false, true, false);
- CheckBoxCreateAccount.Caption := 'Create connection account for ' + APPNAME;
-
- tnu1 := DBUserTree.Items.Add(nil, 'Global Access');
- tnu1.ImageIndex := 1;
- tnu1.SelectedIndex := tnu1.ImageIndex;
- tntop := Mainform.Childwin.tnodehost; // tnodehost on childwin
- tn1 := tntop.GetFirstChild;
- for i:=0 to tntop.Count-1 do
- begin
- tnu2 := DBUserTree.Items.AddChild(tnu1, tn1.Text);
- tnu2.ImageIndex := tn1.ImageIndex;
- tnu2.SelectedIndex := tn1.SelectedIndex;
- DBUserTree.Items.AddChild( tnu2, DUMMY_NODE_TEXT );
- tn1 := tntop.getNextChild(tn1);
-
- end;
- EditUser.Text := Mainform.Childwin.Conn.MysqlParams.User;
-
- tnu1.Expand(false);
- tnu1.Selected := true;
-
- with CheckListBoxPrivileges do
- for i:=0 to 8 do
- Checked[i] := true;
-
- PageControl1.OnChange(self);
-
-{
- // get users hostname
- WSAStartup(MAKEWORD(1, 1), wsadat);
- gethostname(pchar(host), 80);
- ph := gethostbyname(pchar(host));
- EditHost.Text := ph.h_name;
- WSACleanup();
+{**
+ FormCreate: Restore GUI setup
}
-
- Screen.Cursor := crDefault;
-end;
-
-procedure TUserManagerForm.CheckBoxAllPrivilegesClick(Sender: TObject);
+procedure TUserManagerForm.FormCreate(Sender: TObject);
begin
- CheckListBoxPrivileges.Enabled := not CheckBoxAllPrivileges.Checked;
-end;
-
-procedure TUserManagerForm.ButtonAddUserClick(Sender: TObject);
-var
- i : Integer;
- priv, query, access, fromhost, pass, grant : String;
-begin
- // Account
- if CheckBoxCreateAccount.Checked then
- with TRegistry.Create do
- begin
- OpenKey(REGPATH + REGKEY_SESSIONS, false);
- if KeyExists(EditDescription.Text) then
- begin
- MessageDlg('This Description (' + EditDescription.Text + ') is already used.' + CRLF + 'Please specify another description!', mtError, [mbOK], 0);
- EditDescription.SetFocus;
- exit;
- end
- else with TRegistry.Create do
- begin
- OpenKey(REGPATH + REGKEY_SESSIONS + EditDescription.Text, true);
- WriteString(REGNAME_HOST, Mainform.Childwin.Conn.MysqlParams.Host);
- WriteString(REGNAME_USER, EditUser.Text);
- WriteString(REGNAME_PASSWORD, encrypt(EditPassword.Text));
- WriteString(REGNAME_PORT, IntToStr(Mainform.Childwin.Conn.MysqlParams.Port));
- WriteString(REGNAME_TIMEOUT, IntToStr(DEFAULT_TIMEOUT));
- WriteBool(REGNAME_COMPRESSED, DEFAULT_COMPRESSED);
- WriteString(REGNAME_ONLYDBS, '');
- CloseKey;
- Free;
- end;
- Free;
- end;
-
- priv := '';
- if CheckBoxAllPrivileges.Checked then
- priv := 'ALL PRIVILEGES'
- else
- with CheckListBoxPrivileges do
- for i:=0 to Items.Count - 1 do
- if Checked[i] then
- begin
- if priv <> '' then
- priv := priv + ', ';
- priv := priv + Items[i];
- end;
- if priv = '' then
- priv := 'USAGE';
-
- case DBUserTree.Selected.Level of
- 0 : access := '*.*';
- 1 : access := MainForm.Mask( DBUserTree.Selected.Text ) + '.*';
- 2 : access := MainForm.Mask( DBUserTree.Selected.Text );
- end;
-
- if EditHost.Text = '' then
- fromhost := '%'
- else
- fromhost := EditHost.Text;
-
- if EditPassWord.Text <> '' then
- pass := ' IDENTIFIED BY ''' + EditPassWord.Text + '''';
-
- if CheckBoxWithGrant.Checked then
- grant := ' WITH GRANT OPTION';
-
- query := 'GRANT ' + priv + ' ON ' + access + ' TO ''' + EditUser.Text + '''@''' + fromhost + '''' + pass + grant;
- Mainform.Childwin.ExecUpdateQuery(query);
- Mainform.Childwin.ExecUpdateQuery('FLUSH PRIVILEGES');
- ShowMessage('User succesfully created.');
-end;
-
-
-procedure TUserManagerForm.CheckBoxCreateAccountClick(Sender: TObject);
-begin
- Label1.Enabled := CheckBoxCreateAccount.Checked;
- EditDescription.Enabled := CheckBoxCreateAccount.Checked;
- if (CheckBoxCreateAccount.Checked) and (EditDescription.Text = '') then
- begin
- EditDescription.Text := Mainform.Childwin.Caption;
- EditDescription.SetFocus;
- end;
-end;
-
-
-procedure TUserManagerForm.TreeViewUsersDblClick(Sender: TObject);
-var
- tnu, tndb : TTreeNode;
- i : Integer;
- TableNames : TStringList;
- ZQueryColumnNames : TDataSet;
-begin
- // Add subitems to TreeNode:
-
- Screen.Cursor := crHourGlass;
-
- if not TreeViewUsers.Selected.HasChildren then
- case TreeViewUsers.Selected.Level of
-
- 0 : // add dbs to user-node...
- begin
- tndb := Mainform.Childwin.tnodehost.GetFirstChild;
- for i:=0 to Mainform.Childwin.tnodehost.Count-1 do
- begin
- tnu := TreeViewUsers.Items.AddChild(TreeViewUsers.Selected, tndb.Text);
- tnu.ImageIndex := tndb.ImageIndex;
- tnu.SelectedIndex := tndb.SelectedIndex;
- tndb := Mainform.Childwin.tnodehost.getNextChild(tndb);
- end;
- end;
-
- 1 : // add tables to user-node...
- begin
- TableNames := Mainform.Childwin.GetCol( 'SHOW TABLES FROM ' + MainForm.mask(TreeViewUsers.Selected.Text) );
- for i:=0 to TableNames.Count-1 do
- begin
- with TreeViewUsers.Items.AddChild( TreeViewUsers.Selected, TableNames[i] ) do
- begin
- ImageIndex := 14;
- SelectedIndex := ImageIndex;
- end;
- end;
- end;
-
-
- 2 : // add columns to user-node...
- begin
- // find fields from table
- ZQueryColumnNames := Mainform.Childwin.GetResults( 'SHOW COLUMNS FROM ' + mainform.mask(TreeViewUsers.Selected.Parent.Text) + '.' + mainform.mask(TreeViewUsers.Selected.Text));
- for i:=1 to ZQueryColumnNames.RecordCount do
- begin
- tnu := TreeViewUsers.Items.AddChild(TreeViewUsers.Selected, ZQueryColumnNames.Fields[0].AsString);
- tnu.ImageIndex := ICONINDEX_FIELD;
- tnu.SelectedIndex := ICONINDEX_FIELD;
- ZQueryColumnNames.Next;
- end;
- ZQueryColumnNames.Close;
- FreeAndNil( ZQueryColumnNames );
- end;
-
-
- end;
-
- if not TreeViewUsers.Selected.Expanded then
- TreeViewUsers.Selected.Expand(false);
-
- Screen.Cursor := crDefault;
-end;
-
-
-procedure TUserManagerForm.TreeViewUsersChange(Sender: TObject;
- Node: TTreeNode);
-var
- n : TTreeNode;
- highlight : TColor;
-begin
- // Selecting a User, DB, Table or Column in TreeViewUsers
- n := Node;
- while n.Parent <> nil do
- n := n.Parent;
- // show controls:
- ShowPrivilegesControls(false, false, true);
- User := copy(n.Text, 0, pos('@', n.Text)-1);
- Host := copy(n.Text, pos('@', n.Text)+1, length(n.text));
- LabelUser.Caption := 'User ''' + User + ''' connecting from host ''' + Host + '''';
-
- highlight := clNavy;
- case Node.level of
- 0 : begin
- LabelDB.Caption := ''; LabelDB.Font.Color := highlight;
- LabelTable.Caption := ''; LabelTable.Font.Color := highlight;
- LabelColumn.Caption := ''; LabelColumn.Font.Color := highlight;
- ButtonEditUser.Enabled := true;
- end;
- 1 : begin
- LabelDB.Caption := Node.Text; LabelDB.Font.Color := clWindowText;
- LabelTable.Caption := ''; LabelTable.Font.Color := highlight;
- LabelColumn.Caption := ''; LabelColumn.Font.Color := highlight;
- GetResDBs;
- ButtonEditUser.Enabled := false;
- end;
- 2 : begin
- LabelDB.Caption := Node.Parent.Text; LabelDB.Font.Color := clWindowText;
- LabelTable.Caption := Node.Text; LabelTable.Font.Color := clWindowText;
- LabelColumn.Caption := ''; LabelColumn.Font.Color := highlight;
- GetResTables;
- ButtonEditUser.Enabled := false;
- end;
- 3 : begin
- LabelDB.Caption := Node.Parent.Parent.Text; LabelDB.Font.Color := clWindowText;
- LabelTable.Caption := Node.Parent.Text; LabelTable.Font.Color := clWindowText;
- LabelColumn.Caption := Node.Text; LabelColumn.Font.Color := clWindowText;
- GetResColumns;
- ButtonEditUser.Enabled := false;
- end;
- end;
-
- editcurrent := true;
- ShowPrivs(node);
-
-end;
-
-
-procedure TUserManagerForm.PageControl1Change(Sender: TObject);
-var
- i : Integer;
- tn : TTreeNode;
-begin
- // Toggle Button Add User
- ButtonAddUser.Visible := PageControl1.ActivePage = TabSheetAddUser;
-
- // ---------------------
- // Edit Users:
-
- // Fill Tree with Registered Users:
- if (PageControl1.ActivePage = TabSheetEditUsers) and
- (TreeViewUsers.Items.Count = 0) then
- begin
- GetResUsers;
- for i:=1 to ZQueryUsers.RecordCount do
- begin
- tn := TreeViewUsers.Items.AddChild(nil, ZQueryUsers.Fields[1].AsString + '@' + ZQueryUsers.Fields[0].AsString );
- tn.ImageIndex := 43;
- tn.SelectedIndex := tn.ImageIndex;
- ZQueryUsers.Next;
- end;
- end;
- // ---------------------
-end;
-
-procedure TUserManagerForm.ButtonSelectAllClick(Sender: TObject);
-begin
- // Select all
- ToggleCheckListBox(CheckListBoxPrivs, true);
- CheckListBoxPrivs.OnClickCheck(self);
-end;
-
-procedure TUserManagerForm.ButtonSelectNoneClick(Sender: TObject);
-begin
- // Select none
- ToggleCheckListBox(CheckListBoxPrivs, false);
- CheckListBoxPrivs.OnClickCheck(self);
-end;
-
-
-procedure TUserManagerForm.ShowPrivilegesControls(v, w, y: Boolean);
- function getPrivNames( privtable : String ): TStringList;
- var
- i,j : Byte;
- q : TDataSet;
- setlist : TStringList;
- tmpstr : String;
- begin
- // Get cached dataset
- q := getPrivColumns( privtable );
- result := TStringList.Create;
- for i := 0 to q.RecordCount-1 do
- begin
- if pos( '_priv', q.FieldByName('Field').AsString ) > 0 then
- begin
- // user + db are enum(Y,N)
- if StrCmpBegin( 'enum', q.FieldByName('Type').AsString ) then
- begin
- result.add( q.FieldByName('Field').AsString );
- result[result.count-1] := stringreplace( result[result.count-1], '_priv', '', [] );
- end
- // table + column are set(x,y,z)
- else if StrCmpBegin( 'set', q.FieldByName('Type').AsString ) then
- begin
- tmpstr := getEnumValues(q.FieldByName('Type').AsString);
- tmpstr := StringReplace( tmpstr, '''', '', [rfReplaceAll] );
- setlist := explode(',', tmpstr );
- for j:=0 to setlist.Count-1 do
- begin
- result.Add(q.FieldByName('Field').AsString+': '+setlist[j]);
- result[result.count-1] := stringreplace( result[result.count-1], '_priv', '', [] );
- end;
- end
- //result[i] := uppercase( result[i] );
- end;
- q.next;
- end;
- end;
-begin
- // show/hide Privileges-Controls
- // v : some privileges set?
- // w : a user selected?
- // y : no privileges set
- LabelPrivileges.Visible := v;
- Label11.Visible := v;
- Label12.Visible := v;
- Label13.Visible := v;
- LabelUser.Visible := v;
- LabelDB.Visible := v;
- LabelTable.Visible := v;
- LabelColumn.Visible := v;
- CheckListBoxPrivs.Visible := v;
- ButtonSelectAll.Visible := v;
- ButtonSelectNone.Visible := v;
- ButtonSet.Visible := v;
- if v then
- ButtonSet.Enabled := false;
- ButtonRevoke.Visible := v;
- if v then
- ButtonRevoke.Enabled := editcurrent;
- LabelPleaseSelect.Visible := w;
- LabelNoPrivs.Visible := y;
- ButtonSelectPrivileges.Visible := y;
-
- if TreeViewUsers.Selected <> nil then
- begin
- CheckListBoxPrivs.Clear;
- case TreeViewUsers.Selected.Level of
- 0 : begin // General
- CheckListBoxPrivs.Items := getPrivNames( PRIVTABLE_USERS );
- ButtonRevoke.Caption := 'Delete User';
- end;
- 1 : begin // DB
- CheckListBoxPrivs.Items := getPrivNames( PRIVTABLE_DB );
- ButtonRevoke.Caption := 'Revoke Privileges';
- end;
- 2 : begin // Table
- CheckListBoxPrivs.Items := getPrivNames( PRIVTABLE_TABLES );
- ButtonRevoke.Caption := 'Revoke Privileges';
- end;
- 3 : begin // Column
- CheckListBoxPrivs.Items := getPrivNames( PRIVTABLE_COLUMNS );
- ButtonRevoke.Caption := 'Revoke Privileges';
- end;
- end;
- end;
-end;
-
-
-procedure TUserManagerForm.ButtonSelectPrivilegesClick(Sender: TObject);
-begin
- // Specify some privileges
- editcurrent := false;
- ShowPrivilegesControls(true, false, false);
-end;
-
-
-
-procedure TUserManagerForm.ShowPrivs(node: TTreeNode);
-var
- i,j : Integer;
- ColumnName, value : String;
- set_values : TStringList;
-begin
- // Show user-privileges (general, db, table or column)
- // depending on node.level
-
- case Node.Level of
- 0 : begin // General user-privileges
- ZQueryUsers.First;
- for i:=1 to ZQueryUsers.RecordCount do
- begin
- if (ZQueryUsers.Fields[0].AsString+'' = Host) and (ZQueryUsers.Fields[1].AsString+'' = User) then
- begin // found the according user!
- ShowPrivilegesControls(true, false, false);
- for j := 0 to CheckListBoxPrivs.count -1 do
- begin
- CheckListBoxPrivs.Checked[j] := ZQueryUsers.FieldByName( CheckListBoxPrivs.Items[j] + '_priv' ).AsBoolean;
- end;
- break;
- end;
- ZQueryUsers.Next;
- end;
- end;
-
- 1 : begin // db-privileges
- ZQueryDBs.First;
- for i:=1 to ZQueryDBs.RecordCount do
- begin
- if (ZQueryDBs.Fields[0].AsString = Host)
- and (ZQueryDBs.Fields[1].AsString = Node.Text)
- and (ZQueryDBs.Fields[2].AsString = User) then
- begin
- // some privs are set:
- ShowPrivilegesControls(true, false, false);
- for j := 0 to CheckListBoxPrivs.count -1 do
- begin
- CheckListBoxPrivs.Checked[j] := ZQueryDbs.FieldByName( CheckListBoxPrivs.Items[j] + '_priv' ).AsBoolean;
- end;
- end;
- ZQueryDBs.Next;
- end;
- end;
-
- 2 : begin // table-privileges
- ZQueryTables.First;
- for i:=1 to ZQueryTables.RecordCount do
- begin
- if (ZQueryTables.Fields[0].AsString = Host)
- and (ZQueryTables.Fields[1].AsString = Node.Parent.Text)
- and (ZQueryTables.Fields[2].AsString = User)
- and (ZQueryTables.Fields[3].AsString = Node.Text) then
- begin // found the according record!
- // some privs are set:
- ShowPrivilegesControls(true, false, false);
- for j := 0 to CheckListBoxPrivs.count -1 do
- begin
- if pos( ':', CheckListBoxPrivs.Items[j] ) > 0 then
- begin
- ColumnName := copy( CheckListBoxPrivs.Items[j], 0, pos( ':', CheckListBoxPrivs.Items[j] )-1 ) + '_priv';
- set_values := Explode( ',', ZQueryTables.FieldByName( ColumnName ).AsString );
- value := copy(CheckListBoxPrivs.Items[j], pos( ':', CheckListBoxPrivs.Items[j] )+2, length(CheckListBoxPrivs.Items[j]));
- CheckListBoxPrivs.Checked[j] := (set_values.IndexOf( value )>-1 );
- end
- else
- CheckListBoxPrivs.Checked[j] := ZQueryTables.FieldByName( CheckListBoxPrivs.Items[j] + '_priv' ).AsBoolean;
- end;
- end;
- ZQueryTables.Next;
- end;
- end;
-
- 3 : begin // column-privileges
- ZQueryColumns.First;
- for i:=1 to ZQueryColumns.RecordCount do
- begin
- if (ZQueryColumns.Fields[0].AsString = Host)
- and (ZQueryColumns.Fields[1].AsString = Node.Parent.Parent.Text)
- and (ZQueryColumns.Fields[2].AsString = User)
- and (ZQueryColumns.Fields[3].AsString = Node.Parent.Text)
- and (ZQueryColumns.Fields[4].AsString = Node.Text) then
- begin
- // some privs are set:
- ShowPrivilegesControls(true, false, false);
- for j := 0 to CheckListBoxPrivs.count -1 do
- begin
- if pos( ':', CheckListBoxPrivs.Items[j] ) > 0 then
- begin
- ColumnName := copy( CheckListBoxPrivs.Items[j], 0, pos( ':', CheckListBoxPrivs.Items[j] )-1 ) + '_priv';
- set_values := Explode( ',', ZQueryColumns.FieldByName( ColumnName ).AsString );
- value := copy(CheckListBoxPrivs.Items[j], pos( ':', CheckListBoxPrivs.Items[j] )+2, length(CheckListBoxPrivs.Items[j]));
- CheckListBoxPrivs.Checked[j] := (set_values.IndexOf( value )>-1 );
- end
- else
- CheckListBoxPrivs.Checked[j] := ZQueryColumns.FieldByName( CheckListBoxPrivs.Items[j] + '_priv' ).AsBoolean;
- end;
- end;
- ZQueryColumns.Next;
- end;
- end;
- end;
-
-end;
-
-
-
-// Generate column-names for INSERT
-function TUserManagerForm.getColumnNamesOrValues( which: String = 'columns' ): TStringList;
-var
- i : Integer;
- ColumnNames, Values, set_values : TStringList;
- ColumnName, privobject : String;
-begin
- ColumnNames := TStringList.Create;
- Values := TStringList.Create;
- i := 0;
- while i < CheckListBoxPrivs.Items.Count do
- begin
- if pos( ':', CheckListBoxPrivs.Items[i] ) = 0 then
- begin // user- and db-privs, which are stored in enumns
- ColumnNames.Add( Mainform.Mask( CheckListBoxPrivs.Items[i] + '_priv' ) );
- Values.add( bool2str(CheckListBoxPrivs.Checked[i] ) );
- end
- else
- begin // table- and columns-privs, which are stored in sets
- ColumnName := copy( CheckListBoxPrivs.Items[i], 0, pos( ':', CheckListBoxPrivs.Items[i] )-1 );
- ColumnNames.Add( Mainform.Mask( ColumnName + '_priv' ) );
- set_values := TStringList.Create;
- while i < CheckListBoxPrivs.Items.Count do
- begin
- if not StrCmpBegin( ColumnName+':', CheckListBoxPrivs.Items[i] ) then
- begin
- dec(i);
- break;
- end;
- privobject := copy( CheckListBoxPrivs.Items[i], length(ColumnName)+3, length(CheckListBoxPrivs.Items[i] ) );
- if CheckListBoxPrivs.Checked[i] then
- set_values.Add( privobject );
- inc(i);
- end;
- Values.add( ImplodeStr( ',', set_values ) );
- end;
- inc(i);
- end;
- if which = 'columns' then
- result := ColumnNames
- else
- result := Values;
-
-end;
-
-
-
-
-// Grant specified Privileges
-procedure TUserManagerForm.ButtonSetClick(Sender: TObject);
-
- // Generate names and values for UPDATE
- function getUpdateClause : String;
- var
- i : Byte;
- columns, values : TStringList;
- begin
- result := '';
- columns := getColumnNamesOrValues( 'columns' );
- values := getColumnNamesOrValues( 'values' );
- if values.Count <> columns.count then
- begin
- MessageDlg( 'Internal Error: ColumnNames.Count <> Values.Count .', mtError, [mbOK], 0 );
- exit;
- end;
- for i := 0 to columns.Count - 1 do
- begin
- if i > 0 then
- result := result + ', ';
- result := result + columns[i] + ' = ''' + values[i] + '''';
- end;
- end;
-
-var
- sql : String;
-begin
- Screen.Cursor := crHourglass;
- case TreeViewUsers.Selected.Level of
- 0 : begin // general
- sql := 'UPDATE '+mainform.mask(PRIVTABLE_USERS)+' SET ';
- sql := sql + getUpdateClause;
- sql := sql + ' WHERE Host = ''' + Host + ''' AND User = ''' + User + '''';
- Mainform.Childwin.ExecUpdateQuery(sql);
- GetResUsers;
- end;
-
- 1 : begin // db
- if editcurrent then
- begin
- sql := 'UPDATE '+mainform.mask(PRIVTABLE_DB)+' SET ';
- sql := sql + getUpdateClause;
- sql := sql + ' WHERE Host = ''' + Host + ''' AND Db = ''' + TreeViewUsers.Selected.Text + ''' AND User = ''' + User + '''';
- end
- else
- begin
- sql := 'INSERT INTO '+mainform.mask(PRIVTABLE_DB)+' (Host, Db, User, ';
- sql := sql + ImplodeStr( ', ', getColumnNamesOrValues( 'columns' ) );
- sql := sql + ') VALUES (''' + Host + ''', ''' + TreeViewUsers.Selected.Text + ''', ''' + User + ''', ';
- sql := sql + '''' + ImplodeStr( ''', ''', getColumnNamesOrValues( 'values' ) ) + '''';
- sql := sql + ')';
- editcurrent := true;
- end;
- Mainform.Childwin.ExecUpdateQuery(sql);
- GetResDBs;
- end;
-
- 2 : begin // table
- if editcurrent then
- begin
- sql := 'UPDATE '+mainform.mask(PRIVTABLE_TABLES)+' SET ';
- sql := sql + getUpdateClause;
- sql := sql + ' WHERE Host = ''' + Host + ''' AND Db = ''' + TreeViewUsers.Selected.Parent.Text + ''' AND User = ''' + User + ''' AND Table_name = ''' + TreeViewUsers.Selected.Text + '''';
- end
- else
- begin
- sql := 'INSERT INTO '+mainform.mask(PRIVTABLE_TABLES)+' (Host, Db, User, Table_name, Grantor, ';
- sql := sql + ImplodeStr( ', ', getColumnNamesOrValues( 'columns' ) );
- sql := sql + ') VALUES ('''+Host+''','''+TreeViewUsers.Selected.Parent.Text+''','''+User+''','''+TreeViewUsers.Selected.Text+''','''+Mainform.Childwin.Conn.MysqlParams.User+''', ';
- sql := sql + '''' + ImplodeStr( ''', ''', getColumnNamesOrValues( 'values' ) ) + '''';
- sql := sql + ')';
- editcurrent := true;
- end;
- Mainform.Childwin.ExecUpdateQuery(sql);
- GetResTables;
- end;
-
- 3 : begin // column
- if editcurrent then begin
- sql := 'UPDATE '+mainform.mask(PRIVTABLE_COLUMNS)+' SET ';
- sql := sql + getUpdateClause;
- sql := sql + ' WHERE Host = ''' + Host + ''' AND Db = ''' + TreeViewUsers.Selected.Parent.Parent.Text + ''' AND User = ''' + User + ''' AND Table_name = ''' + TreeViewUsers.Selected.Parent.Text + ''' AND Column_name = ''' + TreeViewUsers.Selected.Text + '''';
- end
- else begin
- sql := 'INSERT INTO '+mainform.mask(PRIVTABLE_COLUMNS)+' (Host, Db, User, Table_name, Column_name, ';
- sql := sql + ImplodeStr( ', ', getColumnNamesOrValues( 'columns' ) );
- sql := sql + ') VALUES ('''+Host+''','''+TreeViewUsers.Selected.Parent.Parent.Text+''','''+User+''','''+TreeViewUsers.Selected.Parent.Text+''','''+TreeViewUsers.Selected.Text+''', ';
- sql := sql + '''' + ImplodeStr( ''', ''', getColumnNamesOrValues( 'values' ) ) + '''';
- sql := sql + ')';
- editcurrent := true;
- end;
- Mainform.Childwin.ExecUpdateQuery(sql);
- GetResColumns;
- end;
- end;
- Mainform.Childwin.ExecUpdateQuery('FLUSH PRIVILEGES');
- ButtonRevoke.Enabled := editcurrent;
- Screen.Cursor := crDefault;
-end;
-
-
-
-
-procedure TUserManagerForm.FormClose(Sender: TObject;
- var Action: TCloseAction);
-begin
- clearCache;
-end;
-
-
-procedure TUserManagerForm.CheckListBoxPrivsClickCheck(Sender: TObject);
-begin
- ButtonSet.Enabled := true;
-end;
-
-
-{***
- A database-node is about to be expanded:
- Drop the dummy-node and add all tables
-}
-procedure TUserManagerForm.DBUserTreeExpanding(Sender: TObject; Node: TTreeNode;
- var AllowExpansion: Boolean);
-var
- i : Integer;
- TableNames : TStringList;
-begin
- if (Node.getFirstChild <> nil) and (Node.getFirstChild.Text = DUMMY_NODE_TEXT) then
- begin
- // Drop dummynode
- for i := Node.Count-1 downto 0 do
- Node.Item[i].delete;
- // Get all tables into dbtree
- TableNames := Mainform.Childwin.GetCol( 'SHOW TABLES FROM ' + MainForm.mask(Node.Text) );
- for i:=0 to TableNames.Count-1 do
- begin
- with DBUserTree.Items.AddChild( Node, TableNames[i] ) do
- begin
- ImageIndex := 14;
- SelectedIndex := ImageIndex;
- end;
- end;
-
- end;
-end;
-
-procedure TUserManagerForm.ButtonRevokeClick(Sender: TObject);
-var sql : String;
-begin
- // Delete some Privs
- Screen.Cursor := crHourglass;
- case TreeViewUsers.Selected.Level of
- 0 : // delete user
- if MessageDLG('Delete User '''+User+''' and all its privileges?', mtConfirmation, [mbNo, mbYes], 0) = mrYes then begin
- sql := 'DELETE FROM '+mainform.mask(PRIVTABLE_USERS)+' WHERE Host='''+Host+''' AND User='''+User+'''';
- Mainform.Childwin.ExecUpdateQuery(sql);
- sql := 'DELETE FROM '+mainform.mask(PRIVTABLE_DB)+' WHERE Host='''+Host+''' AND User='''+User+'''';
- Mainform.Childwin.ExecUpdateQuery(sql);
- sql := 'DELETE FROM '+mainform.mask(PRIVTABLE_TABLES)+' WHERE Host='''+Host+''' AND User='''+User+'''';
- Mainform.Childwin.ExecUpdateQuery(sql);
- sql := 'DELETE FROM '+mainform.mask(PRIVTABLE_COLUMNS)+' WHERE Host='''+Host+''' AND User='''+User+'''';
- Mainform.Childwin.ExecUpdateQuery(sql);
- TreeViewUsers.Selected.Delete;
- FreeAndNil( ZQueryDBs );
- FreeAndNil( ZQueryTables );
- FreeAndNil( ZQueryColumns );
- GetResUsers;
- Mainform.Childwin.ExecUpdateQuery('FLUSH PRIVILEGES');
- end;
- 1 : // delete db-privs
- begin
- sql := 'DELETE FROM '+mainform.mask(PRIVTABLE_DB)+' WHERE Host='''+Host+''' AND User='''+User+''' AND Db='''+TreeViewUsers.Selected.Text+'''';
- Mainform.Childwin.ExecUpdateQuery(sql);
- ShowPrivilegesControls(false, false, true);
- GetResDBs;
- Mainform.Childwin.ExecUpdateQuery('FLUSH PRIVILEGES');
- end;
- 2 : // delete table-privs
- begin
- sql := 'DELETE FROM '+mainform.mask(PRIVTABLE_TABLES)+' WHERE Host='''+Host+''' AND User='''+User+''' AND Db='''+TreeViewUsers.Selected.Parent.Text+''' AND Table_name='''+TreeViewUsers.Selected.Text+'''';
- Mainform.Childwin.ExecUpdateQuery(sql);
- ShowPrivilegesControls(false, false, true);
- GetResTables;
- Mainform.Childwin.ExecUpdateQuery('FLUSH PRIVILEGES');
- end;
- 3 : // delete column-privs
- begin
- sql := 'DELETE FROM '+mainform.mask(PRIVTABLE_COLUMNS)+' WHERE Host='''+Host+''' AND User='''+User+''' AND Db='''+TreeViewUsers.Selected.Parent.Parent.Text+''' AND Table_name='''+TreeViewUsers.Selected.Parent.Text+''' AND Column_name='''+TreeViewUsers.Selected.Text+'''';
- Mainform.Childwin.ExecUpdateQuery(sql);
- ShowPrivilegesControls(false, false, true);
- GetResColumns;
- Mainform.Childwin.ExecUpdateQuery('FLUSH PRIVILEGES');
- end;
- end;
- Screen.Cursor := crDefault;
-end;
-
-procedure TUserManagerForm.ButtonEditUserClick(Sender: TObject);
-begin
- EditUserWindow(self);
-end;
-
-procedure TUserManagerForm.clearCache;
-begin
- // free memory
- if ZQueryUsers <> nil then ZQueryUsers.Close;
- FreeAndNil( ZQueryUsers );
- if ZQueryDBs <> nil then ZQueryDBs.Close;
- FreeAndNil( ZQueryDBs );
- if ZQueryTables <> nil then ZQueryTables.Close;
- FreeAndNil( ZQueryTables );
- if ZQueryColumns <> nil then ZQueryColumns.Close;
- FreeAndNil( ZQueryColumns );
- if ColumnsUsers <> nil then ColumnsUsers.Close;
- FreeAndNil(ColumnsUsers);
- if ColumnsDB <> nil then ColumnsDB.Close;
- FreeAndNil(ColumnsDB);
- if ColumnsTables <> nil then ColumnsTables.Close;
- FreeAndNil(ColumnsTables);
- if ColumnsColumns <> nil then ColumnsColumns.Close;
- FreeAndNil(ColumnsColumns);
-end;
-
-procedure TUserManagerForm.Button1Click(Sender: TObject);
-begin
- clearCache;
- ShowPrivilegesControls(false, true, false);
- TreeViewUsers.Items.Clear;
- PageControl1.OnChange(self);
-end;
-
-
-procedure TUserManagerForm.GetResUsers;
-begin
- if (not Assigned(ZQueryUsers)) or (not ZQueryUsers.Active) then
- ZQueryUsers := Mainform.Childwin.GetResults( 'SELECT * FROM '+mainform.mask(PRIVTABLE_USERS)
- + ' ORDER BY '+mainform.mask('User')+', '+mainform.mask('Host'));
-end;
-
-procedure TUserManagerForm.GetResDBs;
-begin
- if (not Assigned(ZQueryDBs)) or (not ZQueryDBs.Active) then
- ZQueryDBs := Mainform.Childwin.GetResults( 'SELECT * FROM '+mainform.mask(PRIVTABLE_DB));
-end;
-
-procedure TUserManagerForm.GetResTables;
-begin
- if (not Assigned(ZQueryTables)) or (not ZQueryTables.Active) then
- ZQueryTables := Mainform.Childwin.GetResults( 'SELECT * FROM '+mainform.mask(PRIVTABLE_TABLES));
-end;
-
-procedure TUserManagerForm.GetResColumns;
-begin
- if (not Assigned(ZQueryColumns)) or (not ZQueryColumns.Active) then
- ZQueryColumns := Mainform.Childwin.GetResults( 'SELECT * FROM '+mainform.mask(PRIVTABLE_COLUMNS));
-end;
-
-
-{***
- Return and cache column names from privtables
- This caching avoids tons of SHOW COLUMNS queries
- @param string Name of privileges table
-}
-function TUserManagerForm.getPrivColumns( privtable: String ): TDataSet;
-begin
- if privtable = PRIVTABLE_USERS then
- begin
- if not Assigned(ColumnsUsers) then
- ColumnsUsers := Mainform.Childwin.GetResults( 'SHOW COLUMNS FROM '+mainform.mask(privtable));
- result := ColumnsUsers;
- end
-
- else if privtable = PRIVTABLE_DB then
- begin
- if not Assigned(ColumnsDB) then
- ColumnsDB := Mainform.Childwin.GetResults( 'SHOW COLUMNS FROM '+mainform.mask(privtable));
- result := ColumnsDB;
- end
-
- else if privtable = PRIVTABLE_TABLES then
- begin
- if not Assigned(ColumnsTables) then
- ColumnsTables := Mainform.Childwin.GetResults( 'SHOW COLUMNS FROM '+mainform.mask(privtable));
- result := ColumnsTables;
- end
-
- else if privtable = PRIVTABLE_COLUMNS then
- begin
- if not Assigned(ColumnsColumns) then
- ColumnsColumns := Mainform.Childwin.GetResults( 'SHOW COLUMNS FROM '+mainform.mask(privtable));
- result := ColumnsColumns;
- end
-
- else
- begin
- result := nil;
- end;
-
- // Make sure cursor is set to 1st row
- if Assigned(result) then
- result.First;
-
+ Width := Mainform.GetRegValue(REGNAME_USERMNGR_WINWIDTH, Width);
+ Height := Mainform.GetRegValue(REGNAME_USERMNGR_WINHEIGHT, Height);
+ db := Mainform.Mask(DBNAME_MYSQL);
end;
{**
- Fetch names of privileges from mysql.users to use them in the checklistbox
- on the "Add user" page.
+ FormDestroy: Save GUI setup
}
-procedure TUserManagerForm.FormCreate(Sender: TObject);
+procedure TUserManagerForm.FormDestroy(Sender: TObject);
var
- Privs: TDataset;
- PrivName: String;
+ reg: TRegistry;
begin
- Privs := getPrivColumns(PRIVTABLE_USERS);
- // Add to listbox and cut off "_priv" suffixes
- CheckListBoxPrivileges.Items.BeginUpdate;
- CheckListBoxPrivileges.Items.Clear;
- while not Privs.Eof do begin
- PrivName := Privs.FieldByName('Field').AsString;
- // Only add relevant columns
- if Pos('_priv', PrivName) > 0 then
- CheckListBoxPrivileges.Items.Add( Copy(PrivName, 1, Length(PrivName)-5) );
- Privs.Next;
+ reg := TRegistry.Create;
+ if reg.OpenKey(REGPATH, False) then begin
+ reg.WriteInteger( REGNAME_USERMNGR_WINWIDTH, Width );
+ reg.WriteInteger( REGNAME_USERMNGR_WINHEIGHT, Height );
+ reg.CloseKey;
+ end;
+ reg.Free;
+end;
+
+
+{**
+ FormResize: Adjust columns of boxPriv
+}
+procedure TUserManagerForm.FormResize(Sender: TObject);
+begin
+ boxPrivs.Columns := Trunc(Width / 110);
+end;
+
+
+{**
+ FormShow: Load users and privileges into memory
+}
+procedure TUserManagerForm.FormShow(Sender: TObject);
+var
+ test_result: String;
+begin
+ // Test if we can access the privileges database and tables by
+ // A. Using the mysql-DB
+ CWin := Mainform.Childwin;
+ try
+ CWin.ExecuteNonQuery('USE ' + db);
+ except
+ MessageDlg('You have no access to the privileges database.', mtError, [mbOK], 0);
+ ModalResult := mrCancel;
+ Exit;
+ end;
+ // B. retrieving a count of all users.
+ test_result := cwin.GetVar( 'SELECT COUNT(*) FROM '+db+'.'+Mainform.Mask(PRIVTABLE_USERS), 0, true, false );
+ if test_result = '' then begin
+ MessageDlg('You have no access to the privileges tables.', mtError, [mbOK], 0);
+ ModalResult := mrCancel;
+ Exit;
+ end;
+
+ // Load users into memory
+ Users := TUsers.Create;
+ // Enable limitations editors only if relevant fields exist
+ lblMaxQuestions.Enabled := dsUser.FindField('max_questions') <> nil;
+ editMaxQuestions.Enabled := lblMaxQuestions.Enabled;
+ udMaxQuestions.Enabled := lblMaxQuestions.Enabled;
+
+ lblMaxUpdates.Enabled := dsUser.FindField('max_updates') <> nil;
+ editMaxQuestions.Enabled := lblMaxUpdates.Enabled;
+ udMaxUpdates.Enabled := lblMaxUpdates.Enabled;
+
+ lblMaxConnections.Enabled := dsUser.FindField('max_connections') <> nil;
+ editMaxConnections.Enabled := lblMaxConnections.Enabled;
+ udMaxConnections.Enabled := lblMaxConnections.Enabled;
+
+ lblMaxUserConnections.Enabled := dsUser.FindField('max_user_connections') <> nil;
+ editMaxUserConnections.Enabled := lblMaxUserConnections.Enabled;
+ udMaxUserConnections.Enabled := lblMaxUserConnections.Enabled;
+
+ RefreshGUI;
+end;
+
+
+{**
+ FormClose: Free memory from privileges
+}
+procedure TUserManagerForm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ Users.Free;
+end;
+
+
+{**
+ Load all users into GUI and select one in the pulldown
+}
+procedure TUserManagerForm.RefreshGUI;
+begin
+ RefreshUserPulldown;
+ // Manually invoke change-event of pulldown to verify valid state of GUI
+ comboUsersChange(Self);
+end;
+
+
+{**
+ Set correct image index of users in pulldown, corresponding
+ to their modified / added / deleted state
+}
+procedure TUserManagerForm.RefreshUserPulldown;
+var
+ i, Selected, IconIndex: Integer;
+ Username: String;
+begin
+ Selected := comboUsers.ItemIndex;
+ comboUsers.ItemsEx.Clear;
+ for i:=0 to Users.Count-1 do begin
+
+ // Compose displayed username
+ Username := Users[i].Name;
+ if (Users[i].Host <> '%') and (Users[i].Host <> '') then
+ Username := Username + '@' + Users[i].Host;
+
+ // Detect modified status of the user object itself
+ if Users[i].Deleted then IconIndex := 83
+ else if Users[i].Added then IconIndex := 21
+ else if Users[i].Modified then IconIndex := 12
+ else IconIndex := 43;
+
+ comboUsers.ItemsEx.AddItem(Username, IconIndex, IconIndex, -1, 0, nil);
+ end;
+ if Users.Count > 0 then begin
+ if (Selected > -1) and (Selected < Users.Count) then
+ comboUsers.ItemIndex := Selected
+ else
+ comboUsers.ItemIndex := 0; // Relevant at first time loading
+ end;
+end;
+
+{**
+ A user was selected from the pulldown
+}
+procedure TUserManagerForm.comboUsersChange(Sender: TObject);
+var
+ uid, i, Icon: Integer;
+ u: TUser;
+ OneSelected, Enable: Boolean;
+ t, evEd: TNotifyEvent;
+ evUd: TUDClickEvent;
+begin
+ lblWarning.Visible := False;
+ uid := comboUsers.ItemIndex;
+ comboObjects.ItemsEx.Clear;
+ OneSelected := uid > -1;
+ Enable := OneSelected;
+ if OneSelected then begin
+ u := Users[uid];
+ Enable := not u.Deleted;
+
+ t := editUsername.OnChange;
+ editUsername.OnChange := nil;
+ editUsername.Text := u.Name;
+ editUsername.OnChange := t;
+
+ editPasswordExit(Sender);
+
+ t := editFromHost.OnChange;
+ editFromHost.OnChange := nil;
+ editFromHost.Text := u.Host;
+ editFromHost.OnChange := t;
+
+ t := chkDisabled.OnClick;
+ chkDisabled.OnClick := nil;
+ chkDisabled.Checked := u.Disabled;
+ chkDisabled.OnClick := t;
+
+ // Activate "deleted" warning
+ if u.Deleted then begin
+ lblWarning.Visible := True;
+ lblWarning.Caption := 'User is marked for deletion.';
+ end;
+
+ // Limitations
+ udMaxQuestions.Position := u.MaxQuestions;
+ udMaxUpdates.Position := u.MaxUpdates;
+ udMaxConnections.Position := u.MaxConnections;
+ udMaxUserConnections.Position := u.MaxUserConnections;
+
+ // Display priv objects
+ for i := 0 to u.Privileges.Count - 1 do begin
+ // Hide deleted priv objects
+ if u.Privileges[i].Deleted then
+ Continue;
+ Icon := -1;
+ case u.Privileges[i].DBOType of
+ NODETYPE_DEFAULT: Icon := ICONINDEX_SERVER;
+ NODETYPE_DB: Icon := ICONINDEX_DB;
+ NODETYPE_BASETABLE: Icon := ICONINDEX_TABLE;
+ NODETYPE_VIEW: Icon := ICONINDEX_VIEW;
+ NODETYPE_COLUMN: Icon := ICONINDEX_FIELD;
+ end;
+ comboObjects.ItemsEx.AddItem(u.Privileges[i].DBOPrettyKey, Icon, Icon, -1, 0, nil);
+ end;
+ if comboObjects.ItemsEx.Count > 0 then
+ comboObjects.ItemIndex := 0;
+ comboObjectsChange(Sender);
+ evEd := editLimitations;
+ evUd := clickLimitations;
+ end else begin
+ editUsername.Text := '';
+ editPassword.Text := '';
+ editFromHost.Text := '';
+ udMaxQuestions.Position := 0;
+ udMaxUpdates.Position := 0;
+ udMaxConnections.Position := 0;
+ udMaxUserConnections.Position := 0;
+ evEd := nil;
+ evUd := nil;
+ end;
+ // Update top buttons
+ btnDeleteUser.Enabled := Enable;
+ // Update control in Settings tab
+ lblUsername.Enabled := Enable;
+ editUsername.Enabled := Enable;
+ lblPassword.Enabled := Enable;
+ editPassword.Enabled := Enable;
+ lblFromHost.Enabled := Enable;
+ editFromHost.Enabled := Enable;
+ lblHostHint.Enabled := Enable;
+ chkDisabled.Enabled := Enable;
+ // Update controls in Limitations tab
+ lblMaxQuestions.Enabled := Enable;
+ editMaxQuestions.Enabled := Enable;
+ udMaxQuestions.Enabled := Enable;
+ lblMaxUpdates.Enabled := Enable;
+ editMaxUpdates.Enabled := Enable;
+ udMaxUpdates.Enabled := Enable;
+ lblMaxConnections.Enabled := Enable;
+ editMaxConnections.Enabled := Enable;
+ udMaxConnections.Enabled := Enable;
+ lblMaxUserConnections.Enabled := Enable;
+ editMaxUserConnections.Enabled := Enable;
+ udMaxUserConnections.Enabled := Enable;
+ udMaxQuestions.OnClick := evUd;
+ udMaxUpdates.OnClick := evUd;
+ udMaxConnections.OnClick := evUd;
+ udMaxUserConnections.OnClick := evUd;
+ editMaxQuestions.OnClick := evEd;
+ editMaxUpdates.OnClick := evEd;
+ editMaxConnections.OnClick := evEd;
+ editMaxUserConnections.OnClick := evEd;
+ // Update controls for privileges
+ comboObjects.Enabled := Enable;
+ btnAddObject.Enabled := Enable;
+ boxPrivs.Enabled := Enable;
+ chkTogglePrivs.Enabled := Enable;
+end;
+
+
+{**
+ Create new user
+}
+procedure TUserManagerForm.btnAddUserClick(Sender: TObject);
+const
+ name: String = 'New User';
+var
+ u: TUser;
+begin
+ // Avoid duplicates.
+ u := Users.FindUser(name, '%');
+ if u <> nil then begin
+ comboUsers.ItemIndex := comboUsers.Items.IndexOf(name);
+ comboUsersChange(Self);
+ editUserName.SetFocus;
+ MessageDlg('User/host combination "'+name+'@%" already exists.'+CRLF+CRLF+'Please chose a different username.', mtError, [mbOK], 0);
+ Exit;
+ end;
+ Users.AddUser(TUser.Create(name, '%'));
+ RefreshGUI;
+ // Select newly added item.
+ comboUsers.ItemIndex := comboUsers.ItemsEx.Count - 1;
+ comboUsersChange(Self);
+ // Focus the user name entry box.
+ editUserName.SetFocus;
+end;
+
+
+{**
+ Delete user
+}
+procedure TUserManagerForm.btnDeleteUserClick(Sender: TObject);
+begin
+ if MessageDlg('Delete user "'+comboUsers.ItemsEx[comboUsers.ItemIndex].Caption+'"?', mtConfirmation, [mbYes, mbCancel], 0 ) <> mrYes then
+ Exit;
+ Users.DeleteUser(comboUsers.ItemIndex);
+ RefreshGUI;
+end;
+
+
+{**
+ Disable a user
+}
+procedure TUserManagerForm.chkDisabledClick(Sender: TObject);
+var
+ disabled: Boolean;
+ u: TUser;
+begin
+ disabled := TCheckbox(Sender).Checked;
+ u := Users[comboUsers.ItemIndex];
+ u.Disabled := disabled;
+ // Reset password from "!" to empty string. Avoids again disabling it
+ // by just leaving and saving the exclamation mark
+ if u.Password = '!' then u.Password := '';
+ u.Modified := True;
+ comboUsersChange(self);
+end;
+
+
+{**
+ Database object selected
+}
+procedure TUserManagerForm.comboObjectsChange(Sender: TObject);
+var
+ priv: TPrivilege;
+ EnableDelete: Boolean;
+ i: Integer;
+begin
+ boxPrivs.OnClickCheck := nil;
+ boxPrivs.Items.BeginUpdate;
+ boxPrivs.Items.Clear;
+ EnableDelete := False;
+ if comboObjects.ItemIndex > -1 then begin
+ priv := Users[comboUsers.ItemIndex].Privileges[comboObjects.ItemIndex];
+ boxPrivs.Items := priv.PrettyPrivNames;
+ // Check selected privs
+ for i := 0 to priv.PrivNames.Count - 1 do begin
+ boxPrivs.Checked[i] := priv.SelectedPrivNames.IndexOf(priv.PrivNames[i]) > -1;
+ end;
+ EnableDelete := (priv.DBOType <> NODETYPE_DEFAULT) and
+ (priv.DBOKey <> '%');
+ end;
+ if comboUsers.ItemIndex > -1 then
+ EnableDelete := EnableDelete and (not Users[comboUsers.ItemIndex].Deleted);
+ boxPrivs.Items.EndUpdate;
+ btnDeleteObject.Enabled := EnableDelete;
+ SetChkToggleStatus;
+ boxPrivs.OnClickCheck := boxPrivsClickCheck;
+end;
+
+
+procedure TUserManagerForm.btnAddObjectClick(Sender: TObject);
+var
+ NewObj: TStringList;
+ ds, FieldDefs: TDataset;
+ NewPriv: TPrivilege;
+ u: TUser;
+ i: Integer;
+begin
+ NewObj := SelectDBO;
+ if NewObj <> nil then begin
+ u := Users[comboUsers.ItemIndex];
+ for i := 0 to u.Privileges.Count - 1 do begin
+ NewObj.Delimiter := u.Privileges[i].DBONames.Delimiter;
+ if u.Privileges[i].DBOKey = NewObj.DelimitedText then begin
+ MessageDlg(NewObj.DelimitedText+' already exists.', mtError, [mbOK], 0);
+ comboObjects.ItemIndex := i;
+ comboObjectsChange(Sender);
+ Exit;
+ end;
+ end;
+ ds := nil;
+ FieldDefs := nil;
+ case NewObj.Count of
+ 1: ds := dsDb;
+ 2: begin ds := dsTables; FieldDefs := dsTablesFields; end;
+ 3: begin ds := dsColumns; FieldDefs := dsColumnsFields; end;
+ else
+ Exception.Create('Added privilege object has an invalid number of segments ('+IntToStr(NewObj.Count)+')');
+ end;
+ NewPriv := u.Privileges.AddPrivilege(ds.Fields, FieldDefs);
+ NewPriv.Added := True;
+ NewPriv.DBONames := NewObj;
+ u.Modified := True;
+ RefreshUserPulldown;
+ // Display new priv:
+ comboUsersChange(Sender);
+ comboObjects.ItemIndex := comboObjects.ItemsEx.Count-1;
+ comboObjectsChange(Sender);
+ end;
+end;
+
+
+{**
+ Revoke access to an object
+}
+procedure TUserManagerForm.btnDeleteObjectClick(Sender: TObject);
+begin
+ Users[comboUsers.ItemIndex].Privileges.DeletePrivilege(comboObjects.ItemIndex);
+ RefreshGUI;
+end;
+
+
+{**
+ Manual click within boxPrivs
+}
+procedure TUserManagerForm.boxPrivsClickCheck(Sender: TObject);
+var
+ p: TPrivilege;
+ i: Integer;
+begin
+ p := Users[comboUsers.ItemIndex].Privileges[comboObjects.ItemIndex];
+ p.SelectedPrivNames.Clear;
+ for i := 0 to boxPrivs.Count - 1 do begin
+ if boxPrivs.Checked[i] then
+ p.SelectedPrivNames.Add(p.PrivNames[i]);
+ end;
+ p.Modified := True;
+ Users[comboUsers.ItemIndex].Modified := True;
+ // Update users icons in pulldown
+ RefreshUserPulldown;
+ SetChkToggleStatus;
+end;
+
+
+{**
+ Set the correct state of the tristate checkbox "Select / Deselect all"
+}
+procedure TUserManagerForm.SetChkToggleStatus;
+var
+ i : Integer;
+ allSelected, noneSelected : Boolean;
+begin
+ allselected := True;
+ noneSelected := True;
+ for i := 0 to boxPrivs.Items.Count - 1 do begin
+ if boxPrivs.Checked[i] then
+ noneSelected := False
+ else
+ allSelected := False;
+ end;
+ // Disable clickevent handling
+ chkTogglePrivs.OnClick := nil;
+ if noneSelected then
+ chkTogglePrivs.State := cbUnchecked
+ else if allSelected then
+ chkTogglePrivs.State := cbChecked
+ else
+ chkTogglePrivs.State := cbGrayed;
+ // Enable clickevent handling
+ chkTogglePrivs.OnClick := chkTogglePrivsClick;
+end;
+
+
+{**
+ Username edited
+}
+procedure TUserManagerForm.editUsernameChange(Sender: TObject);
+var
+ u: TUser;
+ t: TNotifyEvent;
+begin
+ u := Users[comboUsers.ItemIndex];
+ // Check if user/host combination already exists
+ if Users.FindUser(editUsername.Text, u.Host) = nil then
+ u.Name := editUsername.Text
+ else
+ MessageDlg('User/host combination "'+editUsername.Text+'@'+u.Host+'" already exists.'+CRLF+CRLF+'Please chose a different username.', mtError, [mbOK], 0);
+ // User edit probably has to be reset to the previous value
+ t := editUsername.OnChange;
+ editUsername.OnChange := nil;
+ editUsername.Text := u.Name;
+ editUsername.OnChange := t;
+ RefreshUserPulldown;
+end;
+
+
+{**
+ "From Host" edited
+}
+procedure TUserManagerForm.editFromHostChange(Sender: TObject);
+var
+ u, f: TUser;
+ t: TNotifyEvent;
+begin
+ u := Users[comboUsers.ItemIndex];
+ // Check if user/host combination already exists
+ f := Users.FindUser(u.Name, editFromHost.Text);
+ if (f = nil) or (f = u) then
+ u.Host := editFromHost.Text
+ else
+ MessageDlg('User/host combination "'+u.Name+'@'+editFromHost.Text+'" already exists.'+CRLF+CRLF+'Please choose a different hostname.', mtError, [mbOK], 0);
+ // Host edit probably has to be reset to the previous value
+ t := editFromHost.OnChange;
+ editFromHost.OnChange := nil;
+ editFromHost.Text := u.Host;
+ editFromHost.OnChange := t;
+ RefreshUserPulldown;
+end;
+
+
+{**
+ Password field focused: Clear password if it's hashed
+}
+procedure TUserManagerForm.editPasswordEnter(Sender: TObject);
+var
+ e: TNotifyEvent;
+begin
+ if Users[comboUsers.ItemIndex].Password = '' then begin
+ e := editPassword.OnChange;
+ editPassword.OnChange := nil;
+ editPassword.Clear;
+ editPassword.PasswordChar := '*';
+ editPassword.OnChange := e;
+ end;
+end;
+
+
+{**
+ Password edited
+}
+procedure TUserManagerForm.editPasswordChange(Sender: TObject);
+var
+ u: TUser;
+ t: TNotifyEvent;
+begin
+ u := Users[comboUsers.ItemIndex];
+ u.Password := editPassword.Text;
+ if u.PasswordModified then begin
+ u.Disabled := False;
+ t := chkDisabled.OnClick;
+ chkDisabled.OnClick := nil;
+ chkDisabled.Checked := False;
+ chkDisabled.OnClick := t;
+ end;
+ RefreshUserPulldown;
+end;
+
+
+{**
+ Password field is unfocused: Apply change pw to user object
+}
+procedure TUserManagerForm.editPasswordExit(Sender: TObject);
+var
+ e: TNotifyEvent;
+ u: TUser;
+begin
+ u := Users[comboUsers.ItemIndex];
+ e := editPassword.OnChange;
+ editPassword.OnChange := nil;
+ editPassword.PasswordChar := #0;
+ if u.Disabled then
+ editPassword.Text := '!'
+ else if not u.PasswordModified then
+ editPassword.Text := u.OldPasswordHashed
+ else begin
+ editPassword.PasswordChar := '*';
+ editPassword.Text := u.Password;
+ end;
+ editPassword.OnChange := e;
+ // Show security warning for empty password if user is not disabled
+ lblWarning.Visible := (not u.Disabled) and (
+ (u.PasswordModified and (u.Password = '')) or
+ ((not u.PasswordModified) and (u.OldPasswordHashed = ''))
+ );
+ lblWarning.Caption := 'This user has a blank password.';
+end;
+
+
+
+{**
+ Select/Deselect all privileges
+}
+procedure TUserManagerForm.chkTogglePrivsClick(Sender: TObject);
+begin
+ ToggleCheckListBox(boxPrivs, (Sender as TCheckbox).Checked);
+ // Ensure user gets marked as modified
+ boxPrivsClickCheck(Sender);
+end;
+
+
+procedure TUserManagerForm.clickLimitations(Sender: TObject; Button: TUDBtnType);
+begin
+ editLimitations(Sender);
+end;
+
+
+procedure TUserManagerForm.editLimitations(Sender: TObject);
+var
+ u: TUser;
+begin
+ u := Users[comboUsers.ItemIndex];
+ u.MaxQuestions := udMaxQuestions.Position;
+ u.MaxUpdates := udMaxUpdates.Position;
+ u.MaxConnections := udMaxConnections.Position;
+ u.MaxUserConnections := udMaxUserConnections.Position;
+ u.Modified := True;
+end;
+
+
+{**
+ OK clicked: Apply all changes
+}
+procedure TUserManagerForm.btnOKClick(Sender: TObject);
+var
+ i, j, k: Integer;
+ u: TUser;
+ p: TPrivilege;
+ sql, TableName, SetFieldName: String;
+ TableSet: TDataSet;
+ AcctWhere, AcctValues, PrivWhere: String;
+ AcctUpdates, PrivValues, PrivUpdates: TStringList;
+ procedure LogSQL(sql: String);
+ begin
+ Mainform.Childwin.LogSQL(sql);
+ end;
+ procedure Exec(sql: String);
+ begin
+ //LogSQL(sql); Exit;
+ Mainform.Childwin.ExecuteNonQuery(sql);
+ end;
+ function Mask(sql: String): String;
+ begin
+ Result := Mainform.Mask(sql);
+ end;
+ function Delim(list: TStringList; spacing: Boolean = True): String;
+ var
+ i: Integer;
+ begin
+ Result := '';
+ for i := 0 to list.Count - 1 do begin
+ if i > 0 then begin
+ Result := Result + list.Delimiter;
+ if spacing then Result := Result + ' ';
+ end;
+ Result := Result + list[i];
+ end;
+ end;
+begin
+ LogSQL('Removing accounts marked for deletion...');
+ for i := 0 to Users.Count - 1 do begin
+ u := Users[i];
+ // Only process deleted users in this loop.
+ if not u.Deleted then Continue;
+ // No need to delete users that do not exist yet.
+ if u.Added then Continue;
+ // Go.
+ LogSQL('Deleting account ' + u.FOldName + '@' + u.FOldHost + '.');
+ AcctWhere := ' WHERE ' + mask('User') + '=' + esc(u.FOldName) + ' AND ' + mask('Host') + '=' + esc(u.FOldHost);
+ sql := 'DELETE FROM ' + db + '.';
+ Exec(sql + mask(PRIVTABLE_COLUMNS) + AcctWhere);
+ Exec(sql + mask(PRIVTABLE_TABLES) + AcctWhere);
+ Exec(sql + mask(PRIVTABLE_DB) + AcctWhere);
+ Exec(sql + mask(PRIVTABLE_USERS) + AcctWhere);
+ end;
+
+ AcctUpdates := TStringList.Create;
+ AcctUpdates.Delimiter := ',';
+ LogSQL('Propagating key changes for renamed and redesignated accounts...');
+ for i := 0 to Users.Count - 1 do begin
+ u := Users[i];
+ // Process accounts with name or host changes.
+ if (u.FOldName = u.Name) and (u.FOldHost = u.Host) then Continue;
+ // Note: must not skip added orphan users; they might have orphaned privileges that needs a key update.
+ if (u.FOldName = 'New User') then Continue;
+ AcctUpdates.Clear;
+ // Apply user name update.
+ if u.FOldName <> u.Name then
+ AcctUpdates.Add(mask('User') + '=' + esc(u.Name));
+ // Apply host criteria update.
+ if u.FOldHost <> u.Host then
+ AcctUpdates.Add(mask('Host') + '=' + esc(u.Host));
+ // Skip accounts with other kinds of changes, they will be processed later.
+ if AcctUpdates.Count = 0 then Continue;
+ // Go.
+ LogSQL('Renaming/redesignating account ' + u.FOldName + '@' + u.FOldHost + '.');
+ AcctWhere := ' WHERE ' + mask('User') + '=' + esc(u.FOldName) + ' AND ' + mask('Host') + '=' + esc(u.FOldHost);
+ AcctValues := ' SET ' + Delim(AcctUpdates);
+ sql := 'UPDATE ' + db + '.';
+ // Todo: Allow concurrency by skipping this account and removing from Users array if changing key in mysql.user fails.
+ Exec(sql + mask(PRIVTABLE_USERS) + AcctValues + AcctWhere);
+ Exec(sql + mask(PRIVTABLE_DB) + AcctValues + AcctWhere);
+ Exec(sql + mask(PRIVTABLE_TABLES) + AcctValues + AcctWhere);
+ Exec(sql + mask(PRIVTABLE_COLUMNS) + AcctValues + AcctWhere);
+ end;
+
+ LogSQL('Applying changes to authentication details and limitations...');
+ for i := 0 to Users.Count - 1 do begin
+ u := Users[i];
+ // Process accounts with changes in this loop.
+ if not u.Modified then Continue;
+ // No need to modify users that do not exist yet.
+ if u.Added then Continue;
+ // Decide what needs to be updated.
+ AcctUpdates.Clear;
+ // Apply password update.
+ if u.Disabled then begin
+ if u.OldPasswordHashed <> '!' then
+ AcctUpdates.Add(mask('Password') + '=' + esc('!'));
+ end else if u.PasswordModified then
+ AcctUpdates.Add(mask('Password') + '= PASSWORD(' + esc(u.Password) + ')');
+ // Apply limitation updates.
+ if dsUser.FindField('max_questions') <> nil then begin
+ if u.FOldMaxQuestions <> u.MaxQuestions then
+ AcctUpdates.Add(mask('max_questions') + '=' + IntToStr(u.MaxQuestions));
+ if u.FOldMaxUpdates <> u.MaxUpdates then
+ AcctUpdates.Add(mask('max_updates') + '=' + IntToStr(u.MaxUpdates));
+ if u.FOldMaxConnections <> u.MaxConnections then
+ AcctUpdates.Add(mask('max_connections') + '=' + IntToStr(u.MaxConnections));
+ if u.FOldMaxUserConnections <> u.MaxUserConnections then
+ AcctUpdates.Add(mask('max_user_connections') + '=' + IntToStr(u.MaxUserConnections));
+ end;
+ // Skip accounts with fx only username / host changes, they've already been processed.
+ if AcctUpdates.Count = 0 then Continue;
+ // Go.
+ LogSQL('Updating account ' + u.Name + '@' + u.Host + '.');
+ AcctWhere := ' WHERE ' + mask('User') + '=' + esc(u.Name) + ' AND ' + mask('Host') + '=' + esc(u.Host);
+ AcctValues := ' SET ' + Delim(AcctUpdates);
+ sql := 'UPDATE ' + db + '.';
+ Exec(sql + mask(PRIVTABLE_USERS) + AcctValues + AcctWhere);
+ end;
+
+ LogSQL('Creating new accounts...');
+ for i := 0 to Users.Count - 1 do begin
+ u := Users[i];
+ // Process only added accounts in this loop.
+ if not u.Added then Continue;
+ // Go.
+ LogSQL('Creating account ' + u.Name + '@' + u.Host + '.');
+ AcctUpdates.Clear;
+ // Apply user name and host designation.
+ AcctUpdates.Add(mask('Host') + '=' + esc(u.Host));
+ AcctUpdates.Add(mask('User') + '=' + esc(u.Name));
+ // Apply password.
+ if u.Disabled then
+ AcctUpdates.Add(mask('Password') + '=' + esc('!'))
+ else
+ AcctUpdates.Add(mask('Password') + '=PASSWORD(' + esc(u.Password) + ')');
+ // Apply limits.
+ if dsUser.FindField('max_questions') <> nil then begin
+ AcctUpdates.Add(mask('max_questions') + '=' + IntToStr(u.MaxQuestions));
+ AcctUpdates.Add(mask('max_updates') + '=' + IntToStr(u.MaxUpdates));
+ AcctUpdates.Add(mask('max_connections') + '=' + IntToStr(u.MaxConnections));
+ AcctUpdates.Add(mask('max_user_connections') + '=' + IntToStr(u.MaxUserConnections));
+ end;
+ // Special case: work around missing default values (bug) in MySQL.
+ if dsUser.FindField('ssl_cipher') <> nil then begin
+ AcctUpdates.Add(mask('ssl_cipher') + '=' + esc(''));
+ AcctUpdates.Add(mask('x509_issuer') + '=' + esc(''));
+ AcctUpdates.Add(mask('x509_subject') + '=' + esc(''));
+ end;
+ sql := 'INSERT INTO ' + db + '.' + mask(PRIVTABLE_USERS);
+ sql := sql + ' SET ' + Delim(AcctUpdates);
+ // Todo: Allow concurrency by skipping this account and removing from Users array if inserting key in mysql.user fails.
+ Exec(sql);
+ end;
+
+ LogSQL('Applying privilege changes...');
+ PrivUpdates := TStringList.Create;
+ PrivUpdates.Delimiter := ',';
+ PrivValues := TStringList.Create;
+ PrivValues.Delimiter := ',';
+ for i := 0 to Users.Count - 1 do begin
+ u := Users[i];
+ AcctWhere := ' WHERE ' + mask('User') + '=' + esc(u.Name) + ' AND ' + mask('Host') + '=' + esc(u.Host);
+ PrivUpdates.Clear;
+ // Traverse the privilege definitions.
+ for j := 0 to u.Privileges.Count - 1 do begin
+ p := u.Privileges[j];
+ // Apply only a collection of privilege values if it has modifications.
+ if not p.Modified then Continue;
+ // Go.
+ LogSQL('Applying privilege to account ' + u.Name + '@' + u.Host + ' for ' + p.DBOPrettyKey + '.');
+ case p.DBOType of
+ NODETYPE_DEFAULT: begin
+ TableSet := dsUser;
+ TableName := mask(PRIVTABLE_USERS);
+ SetFieldName := '';
+ end;
+ NODETYPE_DB: begin
+ TableSet := dsDb;
+ TableName := mask(PRIVTABLE_DB);
+ SetFieldName := '';
+ end;
+ NODETYPE_BASETABLE: begin
+ TableSet := dsTables;
+ TableName := mask(PRIVTABLE_TABLES);
+ SetFieldName := 'table_priv';
+ end;
+ NODETYPE_COLUMN: begin
+ TableSet := dsColumns;
+ TableName := mask(PRIVTABLE_COLUMNS);
+ SetFieldName := 'column_priv';
+ end;
+ else begin
+ raise Exception.Create('Processed privilege has an undefined db object type: ' + IntToStr(p.DBOType));
+ end;
+ end;
+ // Deduce a key for this privilege definition, appropriate for DELETE.
+ PrivWhere := '';
+ for k := 0 to p.DBONames.Count - 1 do begin
+ case k of
+ 0: PrivWhere := PrivWhere + ' AND ' + mask('Db') + '=' + esc(p.DBONames[k]);
+ 1: PrivWhere := PrivWhere + ' AND ' + mask('Table_name') + '=' + esc(p.DBONames[k]);
+ 2: PrivWhere := PrivWhere + ' AND ' + mask('Column_name') + '=' + esc(p.DBONames[k]);
+ end;
+ end;
+ // Special case: remove redundant privileges in mysql.user.
+ if (p.DBOType = NODETYPE_DB) and (p.DBOKey = '%') then begin
+ PrivUpdates.Clear;
+ for k := 0 to p.PrivNames.Count - 1 do begin
+ if dsUser.FindField(p.PrivNames[k] + '_priv') <> nil then
+ PrivUpdates.Add(mask(p.PrivNames[k] + '_priv') + '=' + esc('N'));
+ end;
+ sql := 'UPDATE ' + db + '.' + mask(PRIVTABLE_USERS);
+ sql := sql + ' SET ' + Delim(PrivUpdates);
+ Exec(sql + AcctWhere);
+ end;
+ // Remove old privilege definition.
+ if (p.DBOType <> NODETYPE_DEFAULT) then begin
+ sql := 'DELETE FROM ' + db + '.' + TableName;
+ Exec(sql + AcctWhere + PrivWhere);
+ end else begin
+ // Special case: avoid removing old definition when dealing with
+ // server-level privileges, since they're entangled with
+ // authentication details over in mysql.user.
+ // instead, we have to set them manually to 'N'.
+ PrivUpdates.Clear;
+ for k := 0 to p.PrivNames.Count - 1 do
+ if TableSet.FindField(p.PrivNames[k] + '_priv') <> nil then
+ PrivUpdates.Add(mask(p.PrivNames[k] + '_priv') + '=' + esc('N'));
+ sql := 'UPDATE ' + db + '.' + TableName;
+ sql := sql + ' SET ' + Delim(PrivUpdates);
+ sql := sql + AcctWhere;
+ end;
+ // Deduce a new key for this privilege definition, one appropriate for INSERT/UPDATE.
+ PrivUpdates.Clear;
+ PrivUpdates.Add(mask('Host') + '=' + esc(u.Host));
+ PrivUpdates.Add(mask('User') + '=' + esc(u.Name));
+ for k := 0 to p.DBONames.Count - 1 do begin
+ case k of
+ 0: PrivUpdates.Add(mask('Db') + '=' + esc(p.DBONames[k]));
+ 1: PrivUpdates.Add(mask('Table_name') + '=' + esc(p.DBONames[k]));
+ 2: PrivUpdates.Add(mask('Column_name') + '=' + esc(p.DBONames[k]));
+ end;
+ end;
+ PrivWhere := Delim(PrivUpdates);
+ // Assemble list of key fields for new privilege definition.
+ PrivUpdates.Clear;
+ PrivValues.Clear;
+ // Assemble values of new privilege definition.
+ for k := 0 to p.SelectedPrivNames.Count - 1 do begin
+ if TableSet.FindField(p.SelectedPrivNames[k] + '_priv') <> nil then begin
+ // There's an ENUM field matching the privilege name.
+ PrivUpdates.Add(mask(p.SelectedPrivNames[k] + '_priv') + '=' + esc('Y'));
+ end else
+ // It must be part of a SET field, then.
+ PrivValues.Add(p.SelectedPrivNames[k]);
+ end;
+ // Insert new privilege definition.
+ sql := 'INSERT INTO ' + db + '.' + TableName;
+ if SetFieldName <> '' then
+ PrivUpdates.Add(mask(SetFieldName) + '=' + esc(Delim(PrivValues, False)));
+ sql := sql + ' SET ' + PrivWhere + ', ' + Delim(PrivUpdates);
+ // Special case: UPDATE instead of INSERT for server-level privileges (see further above).
+ if (p.DBOType = NODETYPE_DEFAULT) then begin
+ // Server barfs if we do not set missing defaults, sigh.
+ if dsUser.FindField('ssl_cipher') <> nil then begin
+ PrivValues.Clear;
+ PrivValues.Add(mask('ssl_cipher') + '=' + esc(''));
+ PrivValues.Add(mask('x509_issuer') + '=' + esc(''));
+ PrivValues.Add(mask('x509_subject') + '=' + esc(''));
+ sql := sql + ', ' + Delim(PrivValues);
+ end;
+ sql := sql + ' ON DUPLICATE KEY UPDATE';
+ sql := sql + ' ' + Delim(PrivUpdates);
+ end;
+ Exec(sql);
+ // Special case: update redundant column privileges in mysql.tables_priv.
+ if (p.DBOType = NODETYPE_COLUMN) and (dsTables.FindField('column_priv') <> nil) then begin
+ // We need to deduce a completely new key because column_priv in mysql.tables_priv does not have a column field next to it, sigh.
+ PrivUpdates.Clear;
+ PrivUpdates.Add(mask('Host') + '=' + esc(u.Host));
+ PrivUpdates.Add(mask('User') + '=' + esc(u.Name));
+ for k := 0 to p.DBONames.Count - 1 do begin
+ case k of
+ 0: PrivUpdates.Add(mask('Db') + '=' + esc(p.DBONames[k]));
+ 1: PrivUpdates.Add(mask('Table_name') + '=' + esc(p.DBONames[k]));
+ // (2: Special case, do nothing.)
+ end;
+ end;
+ PrivWhere := Delim(PrivUpdates);
+ sql := 'INSERT INTO ' + db + '.' + PRIVTABLE_TABLES;
+ sql := sql + ' SET ' + PrivWhere;
+ sql := sql + ', ' + mask('column_priv') + '=' + esc(Delim(PrivValues, False));
+ sql := sql + ' ON DUPLICATE KEY UPDATE';
+ sql := sql + ' ' + mask('column_priv') + '=' + esc(Delim(PrivValues, False));
+ Exec(sql);
+ end;
+ end;
+ end;
+end;
+
+
+
+{ *** TUsers *** }
+
+constructor TUsers.Create;
+var
+ u: TUser;
+ i: Integer;
+ user, host: String;
+begin
+ dsUser := CWin.GetResults('SELECT * FROM '+db+'.'+Mainform.Mask(PRIVTABLE_USERS) + ' ORDER BY '
+ + Mainform.Mask('User')+', '
+ + Mainform.Mask('Host'));
+ dsDb := CWin.GetResults('SELECT * FROM '+db+'.'+Mainform.Mask(PRIVTABLE_DB)
+ // Ignore db entries that contain magic pointers to the mysql.host table.
+ + ' WHERE Db <> '#39#39
+ + ' ORDER BY '
+ + Mainform.Mask('User')+', '
+ + Mainform.Mask('Host')+', '
+ + Mainform.Mask('Db'));
+ dsTables := CWin.GetResults('SELECT * FROM '+db+'.'+Mainform.Mask(PRIVTABLE_TABLES) + ' ORDER BY '
+ + Mainform.Mask('User')+', '
+ + Mainform.Mask('Host')+', '
+ + Mainform.Mask('Db')+', '
+ + Mainform.Mask('Table_name'));
+ dsColumns := CWin.GetResults('SELECT * FROM '+db+'.'+Mainform.Mask(PRIVTABLE_COLUMNS) + ' ORDER BY '
+ + Mainform.Mask('User')+', '
+ + Mainform.Mask('Host')+', '
+ + Mainform.Mask('Db')+', '
+ + Mainform.Mask('Table_name')+', '
+ + Mainform.Mask('Column_name'));
+ dsTablesFields := CWin.GetResults('SHOW FIELDS FROM '+db+'.tables_priv LIKE ''%\_priv''');
+ dsColumnsFields := CWin.GetResults('SHOW FIELDS FROM '+db+'.columns_priv LIKE ''%\_priv''');
+ for i := 1 to dsUser.RecordCount do begin
+ // Avoid using dsUser.Next and dsUser.Eof here because TUser.Create
+ // also iterates through the global dsUser result and moves the cursor
+ dsUser.RecNo := i;
+ u := TUser.Create(dsUser.Fields);
+ AddUser(u);
+ end;
+ // Find orphaned privileges in mysql.db.
+ for i := 1 to dsDb.RecordCount do begin
+ dsDb.RecNo := i;
+ user := dsDb.Fields.FieldByName('User').AsString;
+ host := dsDb.Fields.FieldByName('Host').AsString;
+ if FindUser(user, host) = nil then AddUser(TUser.Create(user, host));
+ end;
+ // Find orphaned privileges in mysql.tables_priv.
+ for i := 1 to dsTables.RecordCount do begin
+ dsTables.RecNo := i;
+ user := dsTables.Fields.FieldByName('User').AsString;
+ host := dsTables.Fields.FieldByName('Host').AsString;
+ if FindUser(user, host) = nil then AddUser(TUser.Create(user, host));
+ end;
+ // Find orphaned privileges in mysql.columns_priv.
+ for i := 1 to dsColumns.RecordCount do begin
+ dsColumns.RecNo := i;
+ user := dsColumns.Fields.FieldByName('User').AsString;
+ host := dsColumns.Fields.FieldByName('Host').AsString;
+ if FindUser(user, host) = nil then AddUser(TUser.Create(user, host));
+ end;
+end;
+
+procedure TUsers.AddUser(User: TUser);
+begin
+ SetLength(FUserItems, Length(FUserItems)+1);
+ FUserItems[Length(FUserItems)-1] := User;
+end;
+
+function TUsers.GetUser(Index: Integer): TUser;
+begin
+ Result := FUserItems[Index];
+end;
+
+function TUsers.GetCount: Integer;
+begin
+ Result := Length(FUserItems);
+end;
+
+procedure TUsers.DeleteUser(Index: Integer);
+var
+ i: Integer;
+begin
+ if FUserItems[Index].Added then begin
+ // This user was created only in memory, not yet on the server.
+ // Erase this item out of UserItems, not only display the deleted icon
+ for i := Index+1 to Length(FUserItems) - 1 do
+ FUserItems[i-1] := FUserItems[i];
+ SetLength(FUserItems, Length(FUserItems)-1);
+ end else
+ FUserItems[Index].Deleted := True
+end;
+
+function TUsers.FindUser(Name: String; Host: String): TUser;
+var
+ i: Integer;
+begin
+ Result := nil;
+ if Host = '' then Host := '%';
+ for i := 0 to Length(FUserItems) - 1 do begin
+ if (FUserItems[i].Name = Name) and (FUserItems[i].Host = Host) then begin
+ Result := FUserItems[i];
+ Exit;
+ end;
+ end;
+end;
+
+
+{ *** TUser *** }
+
+constructor TUser.Create(Name: String; Host: String);
+begin
+ FAdded := True;
+ FDeleted := False;
+ FOtherModified := False;
+ FPasswordModified := False;
+ FDisabled := True;
+ FOldPasswordHashed := '';
+ FOldName := Name;
+ FOldHost := Host;
+ if FOldHost = '' then begin
+ // Get rid of duplicate entries.
+ // Todo: handle collisions.
+ FNewHost := '%';
+ FOtherModified := True;
+ end;
+ FPassword := '';
+ FPrivileges := TPrivileges.Create(Self);
+end;
+
+constructor TUser.Create(Fields: TFields);
+begin
+ // Loading an existing user
+ FAdded := False;
+ FDeleted := False;
+ FOtherModified := False;
+ FPasswordModified := False;
+ FDisabled := False;
+ FOldName := Fields.FieldByName('User').AsString;
+ FOldHost := Fields.FieldByName('Host').AsString;
+ if FOldHost = '' then begin
+ // Get rid of duplicate entries.
+ // Todo: handle collisions.
+ FNewHost := '%';
+ FOtherModified := True;
+ end;
+ FPassword := '';
+ FOldPasswordHashed := Fields.FieldByName('Password').AsString;
+ FOldMaxQuestions := 0;
+ if Fields.FindField('max_questions') <> nil then
+ FOldMaxQuestions := MakeInt(Fields.FieldByName('max_questions').AsString);
+ FMaxQuestions := FOldMaxQuestions;
+ FOldMaxUpdates := 0;
+ if Fields.FindField('max_updates') <> nil then
+ FOldMaxUpdates := MakeInt(Fields.FieldByName('max_updates').AsString);
+ FMaxUpdates := FOldMaxUpdates;
+ FOldMaxConnections := 0;
+ if Fields.FindField('max_connections') <> nil then
+ FOldMaxConnections := MakeInt(Fields.FieldByName('max_connections').AsString);
+ FMaxConnections := FOldMaxConnections;
+ FOldMaxUserConnections := 0;
+ if Fields.FindField('max_user_connections') <> nil then
+ FOldMaxUserConnections := MakeInt(Fields.FieldByName('max_user_connections').AsString);
+ FMaxUserConnections := FOldMaxUserConnections;
+
+ FPrivileges := TPrivileges.Create(Self);
+end;
+
+function TUser.GetModified: Boolean;
+begin
+ Result := FPasswordModified or FOtherModified;
+end;
+
+function TUser.GetName: String;
+begin
+ Result := FOldName;
+ if FNewName <> '' then
+ Result := FNewName;
+end;
+
+procedure TUser.SetName(str: String);
+begin
+ FOtherModified := FOtherModified or (Name <> str);
+ FNewName := str;
+end;
+
+function TUser.GetHost: String;
+begin
+ Result := FOldHost;
+ if FNewHost <> '' then
+ Result := FNewHost;
+end;
+
+procedure TUser.SetHost(str: String);
+begin
+ if str = '' then
+ str := '%';
+ FOtherModified := FOtherModified or (Host <> str);
+ FNewHost := str;
+end;
+
+procedure TUser.SetPassword(str: String);
+begin
+ // If password was edited but hasn't changed (fx by a copy+paste action)
+ if FOldPasswordHashed = str then begin
+ FPasswordModified := false;
+ FPassword := '';
+ end else begin
+ FPasswordModified := true;
+ FPassword := str;
+ end;
+end;
+
+
+{ *** TPrivileges *** }
+constructor TPrivileges.Create(AOwner: TUser);
+var
+ p: TPrivilege;
+ host, user: String;
+ // Extract privilege objects from results of user, db, tables_priv + columns_priv
+ procedure LoadPrivs(ds: TDataset; FieldDefs: TDataset = nil; AvoidFieldDefs: TDataset = nil; CropDbFieldDefs: TDataset = nil);
+ var
+ hasUserField : Boolean;
+ simulateDb : Boolean;
+ begin
+ ds.First;
+ // The priv table 'host' does not have a user field, use '%'.
+ hasUserField := ds.FieldDefs.IndexOf('User') > -1;
+ user := '%';
+ // When cropping the priv table 'user' to load only db privileges, use '%' for db.
+ simulateDb := cropDbFieldDefs <> nil;
+ while not ds.Eof do begin
+ if hasUserField then user := ds.FieldByName('User').AsString;
+ host := ds.FieldByName('Host').AsString;
+ if (host = FOwner.FOldHost) and (user = FOwner.FOldName) then begin
+ // Find existing privilege, or create + add new one.
+ p := FindPrivilege(ds.Fields, simulateDb);
+ if (p = nil) then begin
+ p := AddPrivilege(ds.Fields, FieldDefs, AvoidFieldDefs, CropDbFieldDefs, simulateDb);
+ end;
+ // Merge grants from row into the privilege object.
+ p.Merge(ds.Fields)
+ end;
+ ds.Next;
+ end;
+ end;
+begin
+ FOwner := AOwner;
+ if AOwner.Added then begin
+ // Create blanket "server privileges" and "all objects" items.
+ AddPrivilege(dsUser.Fields, nil, dsDb);
+ AddPrivilege(dsUser.Fields, nil, nil, dsDb, True);
+ end;
+ // Load server privileges from 'user' rows, avoiding db privileges.
+ LoadPrivs(dsUser, nil, dsDb);
+ // Load db privileges from 'user' rows, avoiding server privileges.
+ LoadPrivs(dsUser, nil, nil, dsDb);
+ // Load the rest of the privileges.
+ LoadPrivs(dsDb);
+ LoadPrivs(dsTables, dsTablesFields);
+ LoadPrivs(dsColumns, dsColumnsFields);
+end;
+
+function TPrivileges.GetPrivilege(Index: Integer): TPrivilege;
+begin
+ Result := FPrivilegeItems[Index];
+end;
+
+function TPrivileges.GetCount: Integer;
+begin
+ Result := Length(FPrivilegeItems);
+end;
+
+function TPrivileges.FindPrivilege(Fields: TFields; SimulateDbField: Boolean): TPrivilege;
+var
+ i : Integer;
+ DBOType: Byte;
+ DBONames: TStringList;
+begin
+ Result := nil;
+ GetPrivilegeRowKey(Fields, SimulateDbField, DBOType, DBONames);
+ for i := 0 to Length(FPrivilegeItems) - 1 do begin
+ if
+ (FPrivilegeItems[i].DBOType = DBOType) and
+ (DBONames.DelimitedText = FPrivilegeItems[i].DBONames.DelimitedText)
+ then begin
+ Result := FPrivilegeItems[i];
+ Exit;
+ end;
+ end;
+end;
+
+function TPrivileges.AddPrivilege(Fields: TFields; FieldDefs: TDataset = nil; AvoidFieldDefs: TDataSet = nil; CropFieldDefs: TDataSet = nil; SimulateDbField: Boolean = False): TPrivilege;
+begin
+ Result := TPrivilege.Create(Fields, FieldDefs, AvoidFieldDefs, CropFieldDefs, SimulateDbField);
+ SetLength(FPrivilegeItems, Length(FPrivilegeItems)+1);
+ FPrivilegeItems[Length(FPrivilegeItems)-1] := Result;
+ // Minimum default privs for a new user should be read only for everything, or?
+ if FOwner.Added and (Result.FDBOType = NODETYPE_DB) and (Result.DBOKey = '%') then begin
+ Result.SelectedPrivNames.Add('Select');
+ Result.Modified := True;
+ end;
+end;
+
+procedure TPrivileges.DeletePrivilege(Index: Integer);
+var
+ i: Integer;
+begin
+ if FPrivilegeItems[Index].Added then begin
+ // This user was created only in memory, not yet on the server.
+ // Erase this item out of UserItems, not only display the deleted icon
+ for i := Index+1 to Length(FPrivilegeItems) - 1 do
+ FPrivilegeItems[i-1] := FPrivilegeItems[i];
+ SetLength(FPrivilegeItems, Length(FPrivilegeItems)-1);
+ end else begin
+ FPrivilegeItems[Index].Deleted := True;
+ FOwner.Modified := True;
+ end;
+end;
+
+
+{ *** TPrivilege *** }
+
+constructor TPrivilege.Create(Fields: TFields; FieldDefs: TDataset = nil; AvoidFieldDefs: TDataSet = nil; CropFieldDefs: TDataSet = nil; SimulateDbField: Boolean = False);
+var
+ i: Integer;
+ tables_col_ignore: Boolean;
+ cropNames: TStringList;
+ // Find possible values for the given SET column
+ function GetSETValues(FieldName: String): TStringList;
+ begin
+ FieldDefs.First;
+ Result := TStringList.Create;
+ while not FieldDefs.Eof do begin
+ if FieldDefs.FieldByName('Field').AsString = FieldName + '_priv' then begin
+ Result.QuoteChar := '''';
+ Result.DelimitedText := getEnumValues( FieldDefs.FieldByName('Type').AsString );
+ end;
+ FieldDefs.Next;
+ end;
+ end;
+begin
+ // Defaults
+ FDeleted := False;
+ FAdded := False;
+ FModified := False;
+ DBONames := TStringList.Create;
+ PrivNames := TStringList.Create;
+ SelectedPrivNames := TStringList.Create;
+ // Find out what xxxx_priv privilege columns this server/version has.
+ Fields.GetFieldNames(PrivNames);
+ for i := PrivNames.Count - 1 downto 0 do begin
+ if Length(PrivNames[i]) > 5 then begin
+ if Copy(PrivNames[i], Length(PrivNames[i]) - 4, 5) = '_priv' then begin
+ // Avoid duplicated db privileges in user table.
+ if AvoidFieldDefs = nil then Continue;
+ if AvoidFieldDefs.FieldDefs.IndexOf(PrivNames[i]) = -1 then Continue;
+ end;
+ end;
+ PrivNames.Delete(i)
+ end;
+ if CropFieldDefs <> nil then begin
+ cropNames := TStringList.Create;
+ CropFieldDefs.Fields.GetFieldNames(cropNames);
+ for i := PrivNames.Count - 1 downto 0 do begin
+ if cropNames.IndexOf(PrivNames[i]) = -1 then PrivNames.Delete(i);
+ end;
+ end;
+ // Find out what SET fields of tables_priv this server/version has.
+ // Only load tables_priv.Table_priv
+ i := PrivNames.IndexOf('Table_priv');
+ if i > -1 then begin
+ PrivNames.Delete(i);
+ PrivNames.AddStrings(GetSETValues('Table'));
+ end;
+ tables_col_ignore := i > -1;
+ // Find out what SET fields of columns_priv this server/version has.
+ i := PrivNames.IndexOf('Column_priv');
+ if i > -1 then begin
+ PrivNames.Delete(i);
+ if not tables_col_ignore then
+ PrivNames.AddStrings(GetSETValues('Column'));
+ end;
+ // Snip "_priv" from ENUM field names.
+ for i := PrivNames.Count - 1 downto 0 do begin
+ if Length(PrivNames[i]) > 5 then begin
+ if Copy(PrivNames[i], Length(PrivNames[i]) - 4, 5) = '_priv' then begin
+ PrivNames[i] := Copy(PrivNames[i], 0, Length(PrivNames[i]) - 5);
+ end;
+ end;
+ end;
+ // Get unique identifier for this privilege row.
+ GetPrivilegeRowKey(Fields, SimulateDbField, FDBOType, DBONames);
+end;
+
+procedure TPrivilege.Merge(Fields: TFields);
+var
+ i: Integer;
+ tmp: TStringList;
+ fieldNames: TStringList;
+begin
+ fieldNames := TStringList.Create;
+ Fields.GetFieldNames(fieldNames);
+ // Apply ENUM privileges, skipping any SET privileges.
+ for i := PrivNames.Count - 1 downto 0 do begin
+ if fieldNames.IndexOf(PrivNames[i] + '_priv') > -1 then begin
+ if UpperCase(Fields.FieldByName(PrivNames[i] + '_priv').AsString) = 'Y' then begin
+ SelectedPrivNames.Add(PrivNames[i]);
+ end;
+ end;
+ end;
+ // Parse SET field in column "tables_priv"
+ i := fieldNames.IndexOf('Table_priv');
+ if i > -1 then begin
+ tmp := TStringList.Create;
+ tmp.CommaText := Fields.FieldByName('Table_priv').AsString;
+ SelectedPrivNames.AddStrings(tmp);
+ end else begin
+ // Parse SET field in column "columns_priv"
+ i := fieldNames.IndexOf('Column_priv');
+ if i > -1 then begin
+ tmp := TStringList.Create;
+ tmp.CommaText := Fields.FieldByName('Column_priv').AsString;
+ SelectedPrivNames.AddStrings(tmp);
+ end;
+ end;
+ FreeAndNil(tmp);
+end;
+
+
+function TPrivilege.GetDBOPrettyKey: String;
+begin
+ Result := '';
+ case FDBOType of
+ NODETYPE_DEFAULT: Result := Result + 'Server privileges';
+ NODETYPE_DB: Result := Result + 'Database: ';
+ NODETYPE_BASETABLE: Result := Result + 'Table: ';
+ NODETYPE_COLUMN: Result := Result + 'Column: ';
+ end;
+ Result := Result + GetDBOKey;
+ // Special case "db=%"
+ if (FDBOType = NODETYPE_DB) and (DBOKey = '%') then
+ Result := 'All databases';
+end;
+
+
+function TPrivilege.GetDBOKey: String;
+begin
+ DBONames.Delimiter := '.';
+ Result := DBONames.DelimitedText;
+end;
+
+function TPrivilege.GetPrettyPrivNames: TStringList;
+var
+ i: Integer;
+ p: String;
+begin
+ Result := TStringList.Create;
+ for i := 0 to PrivNames.Count - 1 do begin
+ // Fetch original name
+ p := PrivNames[i];
+ if Pos('_priv', p) = Length(p)-4 then
+ p := Copy(p, 0, Length(p)-4);
+ p := StringReplace(p, '_', ' ', [rfReplaceAll]);
+ p := Trim(p);
+ Result.Add(p);
+ end;
+end;
+
+
+procedure GetPrivilegeRowKey(Fields: TFields; SimulateDbField: Boolean; out DBOType: Byte; out DBONames: TStringList);
+begin
+ DBOType := NODETYPE_DEFAULT;
+ DBONames := TStringList.Create;
+ DBONames.Delimiter := '.';
+ if SimulateDbField then begin
+ DBOType := NODETYPE_DB;
+ DBONames.Add('%');
+ end;
+ if Fields.FindField('Db') <> nil then begin
+ DBOType := NODETYPE_DB;
+ DBONames.Add(Fields.FieldByName('Db').AsString);
+ end;
+ if Fields.FindField('Table_name') <> nil then begin
+ DBOType := NODETYPE_BASETABLE;
+ DBONames.Add(Fields.FieldByName('Table_name').AsString);
+ end;
+ if Fields.FindField('Column_name') <> nil then begin
+ DBOType := NODETYPE_COLUMN;
+ DBONames.Add(Fields.FieldByName('Column_name').AsString);
end;
- CheckListBoxPrivileges.Items.EndUpdate;
end;
end.