Files
HeidiSQL/source/connections.pas

1262 lines
43 KiB
ObjectPascal

unit connections;
// -------------------------------------
// Connections (start-window)
// -------------------------------------
interface
uses
Windows, SysUtils, Classes, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, ComCtrls,
VirtualTrees, Menus, Graphics, Generics.Collections, ActiveX, extra_controls, Messages,
dbconnection, gnugettext;
type
Tconnform = class(TFormWithSizeGrip)
btnCancel: TButton;
btnOpen: TButton;
btnSave: TButton;
ListSessions: TVirtualStringTree;
btnNew: TButton;
btnDelete: TButton;
popupSessions: TPopupMenu;
menuSave: TMenuItem;
menuDelete: TMenuItem;
menuSaveAs: TMenuItem;
TimerStatistics: TTimer;
PageControlDetails: TPageControl;
tabSettings: TTabSheet;
lblPort: TLabel;
lblPassword: TLabel;
lblHost: TLabel;
lblUsername: TLabel;
lblNetworkType: TLabel;
chkCompressed: TCheckBox;
editPort: TEdit;
updownPort: TUpDown;
editPassword: TEdit;
editUsername: TEdit;
editHost: TEdit;
tabAdvanced: TTabSheet;
lblSSLPrivateKey: TLabel;
lblSSLCACertificate: TLabel;
lblSSLCertificate: TLabel;
editSSLPrivateKey: TButtonedEdit;
editSSLCACertificate: TButtonedEdit;
editSSLCertificate: TButtonedEdit;
tabStatistics: TTabSheet;
lblLastConnectLeft: TLabel;
lblCounterLeft: TLabel;
lblCreatedLeft: TLabel;
lblCreatedRight: TLabel;
lblCounterRight1: TLabel;
lblLastConnectRight: TLabel;
tabSSHtunnel: TTabSheet;
editSSHlocalport: TEdit;
editSSHUser: TEdit;
editSSHPassword: TEdit;
lblSSHLocalPort: TLabel;
lblSSHUser: TLabel;
lblSSHPassword: TLabel;
editSSHPlinkExe: TButtonedEdit;
lblSSHPlinkExe: TLabel;
comboNetType: TComboBox;
lblSSHhost: TLabel;
editSSHhost: TEdit;
editSSHport: TEdit;
editSSHPrivateKey: TButtonedEdit;
lblSSHkeyfile: TLabel;
lblDownloadPlink: TLabel;
editDatabases: TButtonedEdit;
lblDatabase: TLabel;
chkLoginPrompt: TCheckBox;
lblPlinkTimeout: TLabel;
editSSHTimeout: TEdit;
updownSSHTimeout: TUpDown;
chkWindowsAuth: TCheckBox;
splitterMain: TSplitter;
tabStart: TTabSheet;
lblHelp: TLabel;
chkWantSSL: TCheckBox;
btnImportSettings: TButton;
timerSettingsImport: TTimer;
popupNew: TPopupMenu;
menuNewSessionInRoot: TMenuItem;
menuNewFolderInRoot: TMenuItem;
menuContextNewFolderInFolder: TMenuItem;
menuContextNewSessionInFolder: TMenuItem;
menuNewSessionInFolder: TMenuItem;
menuNewFolderInFolder: TMenuItem;
chkLocalTimeZone: TCheckBox;
editStartupScript: TButtonedEdit;
lblStartupScript: TLabel;
chkFullTableStatus: TCheckBox;
btnMore: TButton;
popupMore: TPopupMenu;
Checkforupdates1: TMenuItem;
About1: TMenuItem;
Preferences1: TMenuItem;
Exportsettingsfile1: TMenuItem;
Importsettingsfile1: TMenuItem;
lblComment: TLabel;
memoComment: TMemo;
lblQueryTimeout: TLabel;
editQueryTimeout: TEdit;
updownQueryTimeout: TUpDown;
menuMoreGeneralHelp: TMenuItem;
menuRename: TMenuItem;
lblSSLcipher: TLabel;
editSSLcipher: TEdit;
lblKeepAlive: TLabel;
editKeepAlive: TEdit;
updownKeepAlive: TUpDown;
lblCounterRight2: TLabel;
lblCounterLeft2: TLabel;
procedure FormCreate(Sender: TObject);
procedure btnOpenClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure btnSaveClick(Sender: TObject);
procedure btnSaveAsClick(Sender: TObject);
procedure btnNewClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure Modification(Sender: TObject);
procedure ListSessionsGetText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; TextType: TVSTTextType; var CellText: String);
procedure ListSessionsFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
procedure ListSessionsGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
procedure ListSessionsNewText(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; NewText: String);
procedure ListSessionsFocusChanging(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex;
var Allowed: Boolean);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDestroy(Sender: TObject);
procedure TimerStatisticsTimer(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure ListSessionsCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode; Column: TColumnIndex;
out EditLink: IVTEditLink);
procedure PickFile(Sender: TObject);
procedure editSSHPlinkExeChange(Sender: TObject);
procedure editHostChange(Sender: TObject);
procedure lblDownloadPlinkClick(Sender: TObject);
procedure editDatabasesRightButtonClick(Sender: TObject);
procedure chkLoginPromptClick(Sender: TObject);
procedure ListSessionsGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
procedure comboNetTypeChange(Sender: TObject);
procedure splitterMainMoved(Sender: TObject);
procedure btnImportSettingsClick(Sender: TObject);
procedure timerSettingsImportTimer(Sender: TObject);
procedure ListSessionsStructureChange(Sender: TBaseVirtualTree;
Node: PVirtualNode; Reason: TChangeReason);
procedure ListSessionsDragOver(Sender: TBaseVirtualTree; Source: TObject;
Shift: TShiftState; State: TDragState; Pt: TPoint; Mode: TDropMode;
var Effect: Integer; var Accept: Boolean);
procedure ListSessionsDragDrop(Sender: TBaseVirtualTree; Source: TObject;
DataObject: IDataObject; Formats: TFormatArray; Shift: TShiftState;
Pt: TPoint; var Effect: Integer; Mode: TDropMode);
procedure btnMoreClick(Sender: TObject);
procedure menuRenameClick(Sender: TObject);
private
{ Private declarations }
FLoaded: Boolean;
FSessionModified, FOnlyPasswordModified: Boolean;
FServerVersion: String;
FSessionColor: TColor;
FSettingsImportWaitTime: Cardinal;
FPopupDatabases: TPopupMenu;
procedure RefreshSessions(ParentNode: PVirtualNode);
function SelectedSessionPath: String;
function CurrentParams: TConnectionParameters;
procedure FinalizeModifications(var CanProceed: Boolean);
procedure ValidateControls;
function NodeSessionNames(Node: PVirtualNode; var RegKey: String): TStringList;
procedure MenuDatabasesClick(Sender: TObject);
procedure WMNCLBUTTONDOWN(var Msg: TWMNCLButtonDown) ; message WM_NCLBUTTONDOWN;
procedure WMNCLBUTTONUP(var Msg: TWMNCLButtonUp) ; message WM_NCLBUTTONUP;
public
{ Public declarations }
end;
implementation
uses Main, apphelpers, grideditlinks, types_helpers;
{$I const.inc}
{$R *.DFM}
procedure Tconnform.WMNCLBUTTONDOWN(var Msg: TWMNCLButtonDown) ;
begin
if Msg.HitTest = HTHELP then
Msg.Result := 0 // "eat" the message
else
inherited;
end;
procedure Tconnform.WMNCLBUTTONUP(var Msg: TWMNCLButtonUp) ;
begin
if Msg.HitTest = HTHELP then begin
Msg.Result := 0;
Help(Self, 'connecting');
end else
inherited;
end;
procedure Tconnform.FormCreate(Sender: TObject);
var
LastActiveSession, NetTypeStr: String;
LastSessions: TStringList;
PSess: PConnectionParameters;
nt: TNetType;
Node: PVirtualNode;
Params: TConnectionParameters;
begin
// Fix GUI stuff
TranslateComponent(Self);
InheritFont(Font);
FixDropDownButtons(Self);
Width := AppSettings.ReadInt(asSessionManagerWindowWidth);
Height := AppSettings.ReadInt(asSessionManagerWindowHeight);
Left := AppSettings.ReadInt(asSessionManagerWindowLeft, '', Left);
Top := AppSettings.ReadInt(asSessionManagerWindowTop, '', Top);
// Move to visible area if window was on a now plugged off monitor previously
MakeFullyVisible;
ListSessions.Width := AppSettings.ReadInt(asSessionManagerListWidth);
splitterMain.OnMoved(Sender);
FixVT(ListSessions);
MainForm.RestoreListSetup(ListSessions);
ListSessions.OnCompareNodes := MainForm.AnyGridCompareNodes;
ListSessions.OnHeaderClick := MainForm.AnyGridHeaderClick;
ListSessions.OnHeaderDraggedOut := MainForm.AnyGridHeaderDraggedOut;
btnImportSettings.Caption := MainForm.actImportSettings.Caption;
FLoaded := False;
comboNetType.Clear;
Params := TConnectionParameters.Create;
for nt:=Low(nt) to High(nt) do begin
NetTypeStr := Params.NetTypeName(nt, True);
if RunningOnWindows10S and (not Params.IsCompatibleToWin10S(nt)) then begin
NetTypeStr := NetTypeStr + ' ['+_('Does not work on Windows 10 S')+']';
end;
comboNetType.Items.Add(NetTypeStr);
end;
Params.Free;
// Init sessions tree
RefreshSessions(nil);
// Focus last session
SelectNode(ListSessions, nil);
LastSessions := Explode(DELIM, AppSettings.ReadString(asLastSessions));
LastActiveSession := AppSettings.ReadString(asLastActiveSession);
if (LastActiveSession = '') and (LastSessions.Count > 0) then
LastActiveSession := LastSessions[0];
Node := ListSessions.GetFirst;
while Assigned(Node) do begin
PSess := ListSessions.GetNodeData(Node);
if PSess.SessionPath = LastActiveSession then
SelectNode(ListSessions, Node);
Node := ListSessions.GetNext(Node);
end;
end;
procedure Tconnform.RefreshSessions(ParentNode: PVirtualNode);
var
SessionNames: TStringList;
RegKey: String;
i: Integer;
Params: TConnectionParameters;
SessNode: PVirtualNode;
begin
// Initialize session tree
if ParentNode=nil then
ListSessions.Clear
else
ListSessions.DeleteChildren(ParentNode, True);
SessionNames := NodeSessionNames(ParentNode, RegKey);
for i:=0 to SessionNames.Count-1 do begin
Params := TConnectionParameters.Create(RegKey+SessionNames[i]);
SessNode := ListSessions.AddChild(ParentNode, PConnectionParameters(Params));
if Params.IsFolder then
RefreshSessions(SessNode);
end;
end;
procedure Tconnform.FormDestroy(Sender: TObject);
begin
// Save GUI stuff
AppSettings.WriteInt(asSessionManagerListWidth, ListSessions.Width);
AppSettings.WriteInt(asSessionManagerWindowWidth, Width);
AppSettings.WriteInt(asSessionManagerWindowHeight, Height);
AppSettings.WriteInt(asSessionManagerWindowLeft, Left);
AppSettings.WriteInt(asSessionManagerWindowTop, Top);
MainForm.SaveListSetup(ListSessions);
end;
procedure Tconnform.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
// Modifications? Ask if they should be saved.
FinalizeModifications(CanClose);
end;
procedure Tconnform.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// Suspend calculating statistics as long as they're not visible
TimerStatistics.Enabled := False;
Action := caFree;
end;
procedure Tconnform.FormShow(Sender: TObject);
begin
ListSessions.SetFocus;
// Reactivate statistics
TimerStatistics.Enabled := True;
TimerStatistics.OnTimer(Sender);
FLoaded := True;
end;
procedure Tconnform.btnOpenClick(Sender: TObject);
var
Connection: TDBConnection;
begin
// Connect to selected session
if not btnOpen.Enabled then
Exit;
Screen.Cursor := crHourglass;
if Mainform.InitConnection(CurrentParams, True, Connection) then
ModalResult := mrOK
else begin
TimerStatistics.OnTimer(Sender);
ModalResult := mrNone;
end;
Screen.Cursor := crDefault;
end;
procedure Tconnform.btnSaveClick(Sender: TObject);
var
Sess: PConnectionParameters;
begin
// Overtake edited values for current parameter object and save to registry
Sess := ListSessions.GetNodeData(ListSessions.FocusedNode);
Sess.Hostname := editHost.Text;
Sess.Username := editUsername.Text;
Sess.Password := editPassword.Text;
Sess.LoginPrompt := chkLoginPrompt.Checked;
Sess.WindowsAuth := chkWindowsAuth.Checked;
Sess.Port := updownPort.Position;
Sess.NetType := TNetType(comboNetType.ItemIndex);
Sess.Compressed := chkCompressed.Checked;
Sess.QueryTimeout := updownQueryTimeout.Position;
Sess.KeepAlive := updownKeepAlive.Position;
Sess.LocalTimeZone := chkLocalTimeZone.Checked;
Sess.FullTableStatus := chkFullTableStatus.Checked;
Sess.AllDatabasesStr := editDatabases.Text;
Sess.Comment := memoComment.Text;
Sess.StartupScriptFilename := editStartupScript.Text;
Sess.SSHPlinkExe := editSSHPlinkExe.Text;
Sess.SSHHost := editSSHhost.Text;
Sess.SSHPort := MakeInt(editSSHport.Text);
Sess.SSHUser := editSSHUser.Text;
Sess.SSHPassword := editSSHPassword.Text;
Sess.SSHTimeout := updownSSHTimeout.Position;
Sess.SSHPrivateKey := editSSHPrivateKey.Text;
Sess.SSHLocalPort := MakeInt(editSSHlocalport.Text);
Sess.WantSSL := chkWantSSL.Checked;
Sess.SSLPrivateKey := editSSLPrivateKey.Text;
Sess.SSLCertificate := editSSLCertificate.Text;
Sess.SSLCACertificate := editSSLCACertificate.Text;
Sess.SSLCipher := editSSLCipher.Text;
Sess.SaveToRegistry;
FSessionModified := False;
ListSessions.Invalidate;
ValidateControls;
end;
procedure Tconnform.btnMoreClick(Sender: TObject);
var
btn: TButton;
begin
btn := Sender as TButton;
btn.DropDownMenu.Popup(btn.ClientOrigin.X, btn.ClientOrigin.Y+btn.Height);
end;
procedure Tconnform.btnSaveAsClick(Sender: TObject);
var
newName, ParentKey: String;
NameOK: Boolean;
NewSess: TConnectionParameters;
Node: PVirtualNode;
SessionNames: TStringList;
begin
// Save session as ...
newName := _('Enter new session name ...');
NameOK := False;
SessionNames := NodeSessionNames(ListSessions.FocusedNode.Parent, ParentKey);
while not NameOK do begin
if not InputQuery(_('Clone session ...'), _('New session name:'), newName) then
Exit; // Cancelled
NameOK := SessionNames.IndexOf(newName) = -1;
if not NameOK then
ErrorDialog(f_('Session "%s" already exists!', [ParentKey+newName]))
else begin
// Create the key and save its values
NewSess := CurrentParams;
NewSess.SessionPath := ParentKey+newName;
NewSess.SaveToRegistry;
Node := ListSessions.InsertNode(ListSessions.FocusedNode, amInsertAfter, PConnectionParameters(NewSess));
FSessionModified := False;
SelectNode(ListSessions, Node);
end;
end;
SessionNames.Free;
end;
procedure Tconnform.btnImportSettingsClick(Sender: TObject);
begin
MainForm.actImportSettings.Execute;
FSettingsImportWaitTime := 0;
timerSettingsImport.Enabled := MainForm.ImportSettingsDone;
end;
procedure Tconnform.timerSettingsImportTimer(Sender: TObject);
begin
Inc(FSettingsImportWaitTime, timerSettingsImport.Interval);
RefreshSessions(nil);
if ListSessions.RootNodeCount > 0 then
timerSettingsImport.Enabled := False;
if FSettingsImportWaitTime >= 10000 then begin
timerSettingsImport.Enabled := False;
MessageDialog(f_('Imported sessions could not be detected. Restarting %s may solve that.', [APPNAME]), mtWarning, [mbOK]);
end;
end;
procedure Tconnform.btnNewClick(Sender: TObject);
var
i: Integer;
CanProceed, CreateInRoot: Boolean;
NewSess: TConnectionParameters;
ParentSess: PConnectionParameters;
ParentNode, NewNode: PVirtualNode;
ParentPath: String;
SiblingSessionNames: TStringList;
begin
// Create new session or folder
FinalizeModifications(CanProceed);
if not CanProceed then
Exit;
CreateInRoot := (Sender = menuNewSessionInRoot) or (Sender = menuNewFolderInRoot);
if Assigned(ListSessions.FocusedNode) then
ParentSess := ListSessions.GetNodeData(ListSessions.FocusedNode)
else
ParentSess := nil;
if CreateInRoot then
ParentNode := nil
else begin
if ParentSess = nil then
ParentNode := nil
else if ParentSess.IsFolder then
ParentNode := ListSessions.FocusedNode
else
ParentNode := ListSessions.FocusedNode.Parent;
end;
SiblingSessionNames := NodeSessionNames(ParentNode, ParentPath);
NewSess := TConnectionParameters.Create;
NewSess.IsFolder := (Sender = menuNewFolderInRoot) or (Sender = menuContextNewFolderInFolder) or (Sender = menuNewFolderInFolder);
NewSess.SessionPath := ParentPath + 'Unnamed';
i := 0;
while SiblingSessionNames.IndexOf(NewSess.SessionName) > -1 do begin
inc(i);
NewSess.SessionPath := ParentPath + 'Unnamed-' + IntToStr(i);
end;
NewSess.SaveToRegistry;
SiblingSessionNames.Free;
NewNode := ListSessions.AddChild(ParentNode, PConnectionParameters(NewSess));
// Select it
SelectNode(ListSessions, NewNode);
ValidateControls;
ListSessions.EditNode(NewNode, 0);
end;
procedure Tconnform.btnDeleteClick(Sender: TObject);
var
Sess: PConnectionParameters;
Node, FocusNode: PVirtualNode;
begin
Node := ListSessions.FocusedNode;
Sess := ListSessions.GetNodeData(Node);
if MessageDialog(f_('Delete session "%s"?', [Sess.SessionName]), mtConfirmation, [mbYes, mbCancel]) = mrYes then
begin
AppSettings.SessionPath := Sess.SessionPath;
AppSettings.DeleteCurrentKey;
if Assigned(Node.NextSibling) then
FocusNode := Node.NextSibling
else if Assigned(Node.PrevSibling) then
FocusNode := Node.PrevSibling
else
FocusNode := Node.Parent;
ListSessions.DeleteNode(Node);
SelectNode(ListSessions, FocusNode);
ListSessions.SetFocus;
end;
end;
function Tconnform.SelectedSessionPath: String;
var
Sess: PConnectionParameters;
begin
Sess := ListSessions.GetNodeData(ListSessions.FocusedNode);
Result := Sess.SessionPath;
end;
function Tconnform.CurrentParams: TConnectionParameters;
var
FromReg: PConnectionParameters;
begin
// Return non-stored parameters
FromReg := ListSessions.GetNodeData(ListSessions.FocusedNode);
if FromReg.IsFolder then begin
Result := FromReg^;
end else begin
Result := TConnectionParameters.Create;
Result.SessionPath := SelectedSessionPath;
Result.SessionColor := FSessionColor;
Result.NetType := TNetType(comboNetType.ItemIndex);
Result.ServerVersion := FServerVersion;
Result.Hostname := editHost.Text;
Result.Username := editUsername.Text;
Result.Password := editPassword.Text;
Result.LoginPrompt := chkLoginPrompt.Checked;
Result.WindowsAuth := chkWindowsAuth.Checked;
if updownPort.Enabled then
Result.Port := updownPort.Position
else
Result.Port := 0;
Result.AllDatabasesStr := editDatabases.Text;
Result.Comment := memoComment.Text;
Result.SSHHost := editSSHHost.Text;
Result.SSHPort := MakeInt(editSSHPort.Text);
Result.SSHUser := editSSHuser.Text;
Result.SSHPassword := editSSHpassword.Text;
Result.SSHTimeout := updownSSHTimeout.Position;
Result.SSHPrivateKey := editSSHPrivateKey.Text;
Result.SSHLocalPort := MakeInt(editSSHlocalport.Text);
Result.SSHPlinkExe := editSSHplinkexe.Text;
Result.WantSSL := chkWantSSL.Checked;
Result.SSLPrivateKey := editSSLPrivateKey.Text;
Result.SSLCertificate := editSSLCertificate.Text;
Result.SSLCACertificate := editSSLCACertificate.Text;
Result.SSLCipher := editSSLCipher.Text;
Result.StartupScriptFilename := editStartupScript.Text;
Result.Compressed := chkCompressed.Checked;
Result.QueryTimeout := updownQueryTimeout.Position;
Result.KeepAlive := updownKeepAlive.Position;
Result.LocalTimeZone := chkLocalTimeZone.Checked;
Result.FullTableStatus := chkFullTableStatus.Checked;
end;
end;
procedure Tconnform.ListSessionsGetImageIndex(Sender: TBaseVirtualTree;
Node: PVirtualNode; Kind: TVTImageKind; Column: TColumnIndex;
var Ghosted: Boolean; var ImageIndex: Integer);
var
Sess: PConnectionParameters;
begin
// An edited session gets an additional pencil symbol
if Column > 0 then
ImageIndex := -1
else case Kind of
ikNormal, ikSelected: begin
Sess := Sender.GetNodeData(Node);
ImageIndex := Sess.ImageIndex;
end;
ikOverlay:
if (Node = Sender.FocusedNode) and FSessionModified then
ImageIndex := 162;
end;
end;
procedure Tconnform.ListSessionsGetNodeDataSize(Sender: TBaseVirtualTree;
var NodeDataSize: Integer);
begin
NodeDataSize := SizeOf(TConnectionParameters);
end;
procedure Tconnform.ListSessionsGetText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; TextType: TVSTTextType;
var CellText: String);
var
Sess: PConnectionParameters;
begin
// Display session name cell
Sess := Sender.GetNodeData(Node);
if Sess.IsFolder then begin
case Column of
0: CellText := Sess.SessionName;
else CellText := '';
end;
end else begin
case Column of
0: begin
CellText := Sess.SessionName;
if FSessionModified and (Node = Sender.FocusedNode) and (not Sender.IsEditing) then
CellText := CellText + ' *';
end;
1: CellText := Sess.Hostname;
2: CellText := Sess.Username;
3: CellText := Sess.ServerVersion;
4: if Sess.LastConnect>0 then
CellText := DateTimeToStr(Sess.LastConnect)
else
CellText := '';
5: CellText := FormatNumber(Sess.Counter);
6: CellText := Sess.Comment;
end;
end;
end;
function Tconnform.NodeSessionNames(Node: PVirtualNode; var RegKey: String): TStringList;
var
Sess: PConnectionParameters;
Folders: TStringList;
begin
// Find sibling session names in a folder node
if Node = nil then
Node := ListSessions.RootNode;
// Find registry sub path for given node
RegKey := '';
if Node <> ListSessions.RootNode then begin
Sess := ListSessions.GetNodeData(Node);
RegKey := Sess.SessionPath + '\';
end;
// Fetch from registry
Folders := TStringList.Create;
Result := AppSettings.GetSessionNames(RegKey, Folders);
Result.AddStrings(Folders);
Folders.Free;
end;
procedure Tconnform.ListSessionsCreateEditor(Sender: TBaseVirtualTree; Node: PVirtualNode;
Column: TColumnIndex; out EditLink: IVTEditLink);
begin
// Use our own text editor to rename a session
EditLink := TInplaceEditorLink.Create(Sender as TVirtualStringTree);
end;
procedure Tconnform.ListSessionsDragDrop(Sender: TBaseVirtualTree;
Source: TObject; DataObject: IDataObject; Formats: TFormatArray;
Shift: TShiftState; Pt: TPoint; var Effect: Integer; Mode: TDropMode);
var
TargetNode, ParentNode: PVirtualNode;
AttachMode: TVTNodeAttachMode;
TargetSess, FocusedSess: PConnectionParameters;
ParentKey: String;
SiblingSessions: TStringList;
begin
TargetNode := Sender.GetNodeAt(Pt.X, Pt.Y);
if not Assigned(TargetNode) then begin
MessageBeep(MB_ICONEXCLAMATION);
Exit;
end;
TargetSess := Sender.GetNodeData(TargetNode);
FocusedSess := Sender.GetNodeData(ListSessions.FocusedNode);
case Mode of
dmAbove:
AttachMode := amInsertBefore;
dmOnNode:
if TargetSess.IsFolder then
AttachMode := amAddChildFirst
else
AttachMode := amInsertBefore;
dmBelow:
AttachMode := amInsertAfter;
else
AttachMode := amInsertAfter;
end;
if AttachMode in [amInsertBefore, amInsertAfter] then
ParentNode := TargetNode.Parent
else
ParentNode := TargetNode;
SiblingSessions := NodeSessionNames(ParentNode, ParentKey);
// Test if target folder has an equal named node
if SiblingSessions.IndexOf(FocusedSess.SessionName) > -1 then
ErrorDialog(f_('Session "%s" already exists!', [ParentKey+FocusedSess.SessionName]))
else begin
try
AppSettings.SessionPath := FocusedSess.SessionPath;
AppSettings.MoveCurrentKey(REGKEY_SESSIONS+'\'+ParentKey+FocusedSess.SessionName);
ListSessions.MoveTo(ListSessions.FocusedNode, TargetNode, AttachMode, False);
FocusedSess.SessionPath := ParentKey+FocusedSess.SessionName;
except
on E:Exception do
ErrorDialog(f_('Error while moving registry key: %s', [E.Message]));
end;
end;
SiblingSessions.Free;
end;
procedure Tconnform.ListSessionsDragOver(Sender: TBaseVirtualTree;
Source: TObject; Shift: TShiftState; State: TDragState; Pt: TPoint;
Mode: TDropMode; var Effect: Integer; var Accept: Boolean);
var
TargetNode, ParentNode: PVirtualNode;
TargetSess: PConnectionParameters;
begin
// Allow node dragging everywhere except within the current folder
TargetNode := Sender.GetNodeAt(Pt.X, Pt.Y);
TargetSess := Sender.GetNodeData(TargetNode);
Accept := (Source = Sender)
and Assigned(TargetSess)
and (Mode <> dmNowhere)
and (TargetNode <> ListSessions.FocusedNode.Parent);
// Moving a folder into itself would create an infinite folder structure
if Accept and TargetSess.IsFolder then
Accept := Accept and (TargetNode <> ListSessions.FocusedNode);
if Accept and (not TargetSess.IsFolder) then
Accept := Accept and (TargetNode.Parent <> ListSessions.FocusedNode.Parent);
if Accept then begin
// Do not allow focused node to be moved somewhere below itself
ParentNode := TargetNode.Parent;
while Assigned(ParentNode) do begin
Accept := Accept and (ParentNode <> ListSessions.FocusedNode);
if not Accept then
Break;
ParentNode := ParentNode.Parent;
end;
// Shows the right tooltip on Aero GUI
Effect := DROPEFFECT_MOVE;
end;
end;
procedure Tconnform.ListSessionsFocusChanged(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex);
var
SessionFocused, InFolder: Boolean;
Sess: PConnectionParameters;
begin
// select one connection!
Screen.Cursor := crHourglass;
TimerStatistics.Enabled := False;
SessionFocused := False;
InFolder := False;
Sess := nil;
if Assigned(Node) then begin
Sess := Sender.GetNodeData(Node);
SessionFocused := not Sess.IsFolder;
InFolder := (ListSessions.GetNodeLevel(Node) > 0) or Sess.IsFolder;
end;
FLoaded := False;
tabStart.TabVisible := not SessionFocused;
tabSettings.TabVisible := SessionFocused;
tabSSHtunnel.TabVisible := SessionFocused;
tabAdvanced.TabVisible := SessionFocused;
tabStatistics.TabVisible := SessionFocused;
menuRename.Enabled := Assigned(Node);
menuNewSessionInFolder.Enabled := InFolder;
menuNewFolderInFolder.Enabled := InFolder;
FreeAndNil(FPopupDatabases);
if not SessionFocused then begin
PageControlDetails.ActivePage := tabStart;
if ListSessions.RootNodeCount = 0 then
lblHelp.Caption := f_('New here? In order to connect to a server, you have to create a so called '+
'"session" at first. Just click the "New" button on the bottom left to create your first session.'+
'Give it a friendly name (e.g. "Local DB server") so you''ll recall it the next time you start %s.', [APPNAME])
else
lblHelp.Caption := _('Please click a session on the left list to edit parameters, doubleclick to open it.');
end else begin
PageControlDetails.ActivePage := tabSettings;
comboNetType.ItemIndex := Integer(Sess.NetType);
editHost.Text := Sess.Hostname;
editUsername.Text := Sess.Username;
editPassword.Text := Sess.Password;
chkLoginPrompt.Checked := Sess.LoginPrompt;
chkWindowsAuth.Checked := Sess.WindowsAuth;
updownPort.Position := Sess.Port;
chkCompressed.Checked := Sess.Compressed;
updownQueryTimeout.Position := Sess.QueryTimeout;
updownKeepAlive.Position := Sess.KeepAlive;
chkLocalTimeZone.Checked := Sess.LocalTimeZone;
chkFullTableStatus.Checked := Sess.FullTableStatus;
editDatabases.Text := Sess.AllDatabasesStr;
memoComment.Text := Sess.Comment;
editStartupScript.Text := Sess.StartupScriptFilename;
editSSHPlinkExe.Text := Sess.SSHPlinkExe;
editSSHHost.Text := Sess.SSHHost;
editSSHport.Text := IntToStr(Sess.SSHPort);
editSSHUser.Text := Sess.SSHUser;
editSSHPassword.Text := Sess.SSHPassword;
updownSSHTimeout.Position := Sess.SSHTimeout;
editSSHPrivateKey.Text := Sess.SSHPrivateKey;
editSSHlocalport.Text := IntToStr(Sess.SSHLocalPort);
chkWantSSL.Checked := Sess.WantSSL;
editSSLPrivateKey.Text := Sess.SSLPrivateKey;
editSSLCertificate.Text := Sess.SSLCertificate;
editSSLCACertificate.Text := Sess.SSLCACertificate;
editSSLCipher.Text := Sess.SSLCipher;
FServerVersion := Sess.ServerVersion;
FSessionColor := Sess.SessionColor;
end;
FLoaded := True;
FSessionModified := False;
ListSessions.Repaint;
ValidateControls;
TimerStatistics.Enabled := True;
TimerStatistics.OnTimer(Sender);
Screen.Cursor := crDefault;
end;
procedure Tconnform.TimerStatisticsTimer(Sender: TObject);
var
LastConnect, Created, DummyDate: TDateTime;
begin
// Continuously update statistics labels
lblLastConnectRight.Caption := _('unknown or never');
lblLastConnectRight.Hint := '';
lblLastConnectRight.Enabled := False;
lblCreatedRight.Caption := _('unknown');
lblCreatedRight.Hint := '';
lblCreatedRight.Enabled := False;
lblCounterRight1.Caption := '';
lblCounterRight2.Caption := '';
if not Assigned(ListSessions.FocusedNode) then
Exit;
AppSettings.SessionPath := SelectedSessionPath;
DummyDate := StrToDateTime('2000-01-01');
LastConnect := StrToDateTimeDef(AppSettings.ReadString(asLastConnect), DummyDate);
if LastConnect <> DummyDate then begin
lblLastConnectRight.Hint := DateTimeToStr(LastConnect);
lblLastConnectRight.Caption := DateBackFriendlyCaption(LastConnect);
lblLastConnectRight.Enabled := True;
end;
Created := StrToDateTimeDef(AppSettings.ReadString(asSessionCreated), DummyDate);
if Created <> DummyDate then begin
lblCreatedRight.Hint := DateTimeToStr(Created);
lblCreatedRight.Caption := DateBackFriendlyCaption(Created);
lblCreatedRight.Enabled := True;
end;
lblCounterRight1.Caption := FormatNumber(AppSettings.ReadInt(asConnectCount));
lblCounterRight2.Caption := FormatNumber(AppSettings.ReadInt(asRefusedCount));
Invalidate;
end;
procedure Tconnform.ListSessionsFocusChanging(Sender: TBaseVirtualTree; OldNode,
NewNode: PVirtualNode; OldColumn, NewColumn: TColumnIndex;
var Allowed: Boolean);
begin
if NewNode <> OldNode then
FinalizeModifications(Allowed)
else
Allowed := False;
end;
procedure Tconnform.ListSessionsNewText(Sender: TBaseVirtualTree;
Node: PVirtualNode; Column: TColumnIndex; NewText: String);
var
ParentKey: String;
Connection: TDBConnection;
Sess: PConnectionParameters;
SiblingSessions: TStringList;
begin
// Rename session
Sess := Sender.GetNodeData(Node);
SiblingSessions := NodeSessionNames(Node.Parent, ParentKey);
if SiblingSessions.IndexOf(NewText) > -1 then begin
ErrorDialog(f_('Session "%s" already exists!', [ParentKey+NewText]));
NewText := Sess.SessionName;
end else begin
AppSettings.SessionPath := Sess.SessionPath;
AppSettings.MoveCurrentKey(REGKEY_SESSIONS+'\'+ParentKey+NewText);
// Also fix internal session names in main form, which gets used to store e.g. "lastuseddb" later
for Connection in MainForm.Connections do begin
if Connection.Parameters.SessionPath = Sess.SessionPath then
Connection.Parameters.SessionPath := ParentKey+NewText;
end;
MainForm.SetWindowCaption;
Sess.SessionPath := ParentKey+NewText;
end;
SiblingSessions.Free;
end;
procedure Tconnform.ListSessionsStructureChange(Sender: TBaseVirtualTree;
Node: PVirtualNode; Reason: TChangeReason);
begin
// Node added or removed. Tree needs a repaint in some cases.
// TODO: does not work
Sender.Repaint;
end;
procedure Tconnform.editHostChange(Sender: TObject);
begin
editSSHhost.TextHint := TEdit(Sender).Text;
Modification(Sender);
end;
procedure Tconnform.chkLoginPromptClick(Sender: TObject);
var
Checked: Boolean;
begin
// Login prompt and SQL Server integrated Windows Auth are mutually exclusive
Checked := TCheckBox(Sender).Checked;
if Checked and (Sender = chkWindowsAuth) then
chkLoginPrompt.Checked := False;
if Checked and (Sender = chkLoginPrompt) then
chkWindowsAuth.Checked := False;
Modification(Sender);
end;
procedure Tconnform.editDatabasesRightButtonClick(Sender: TObject);
var
Connection: TDBConnection;
Params: TConnectionParameters;
Item: TMenuItem;
DB: String;
p: TPoint;
Databases: TStringList;
begin
if FPopupDatabases = nil then begin
// Try to connect and lookup database names
Params := CurrentParams;
Connection := Params.CreateConnection(Self);
Connection.Parameters.AllDatabasesStr := '';
Connection.LogPrefix := SelectedSessionPath;
Connection.OnLog := Mainform.LogSQL;
FPopupDatabases := TPopupMenu.Create(Self);
FPopupDatabases.AutoHotkeys := maManual;
Screen.Cursor := crHourglass;
try
Connection.Active := True;
if Params.NetTypeGroup = ngPgSQL then
Databases := Connection.GetCol('SELECT datname FROM pg_database WHERE datistemplate=FALSE')
else
Databases := Connection.AllDatabases;
for DB in Databases do begin
Item := TMenuItem.Create(FPopupDatabases);
Item.Caption := DB;
Item.OnClick := MenuDatabasesClick;
Item.AutoCheck := True;
Item.RadioItem := Params.NetTypeGroup = ngPgSQL;
FPopupDatabases.Items.Add(Item);
end;
Databases.Free;
except
// Silence connection errors here - should be sufficient to log them
end;
FreeAndNil(Connection);
end;
// Check/uncheck items, based on semicolon list
Databases := Explode(';', editDatabases.Text);
for Item in FPopupDatabases.Items do begin
Item.Checked := Databases.IndexOf(Item.Caption) > -1;
end;
Databases.Free;
p := editDatabases.ClientToScreen(editDatabases.ClientRect.BottomRight);
FPopupDatabases.Popup(p.X-editDatabases.Images.Width, p.Y);
Screen.Cursor := crDefault;
end;
procedure Tconnform.MenuDatabasesClick(Sender: TObject);
var
Item: TMenuItem;
Databases: TStringList;
SelStart: Integer;
begin
Databases := TStringList.Create;
for Item in FPopupDatabases.Items do begin
if Item.Checked then
Databases.Add(Item.Caption);
end;
SelStart := editDatabases.SelStart;
editDatabases.Text := implodestr(';', Databases);
editDatabases.SelStart := SelStart;
end;
procedure Tconnform.menuRenameClick(Sender: TObject);
begin
// Start node editor to rename a session
ListSessions.EditNode(ListSessions.FocusedNode, ListSessions.Header.MainColumn);
end;
procedure Tconnform.comboNetTypeChange(Sender: TObject);
var
Params: TConnectionParameters;
begin
// Autoset default port number as long as that was not modified by user
Params := CurrentParams;
if (not editPort.Modified) and (FLoaded) then
case Params.NetTypeGroup of
ngMySQL, ngMariaDB:
updownPort.Position := MakeInt(AppSettings.GetDefaultString(asPort));
ngMSSQL:
updownPort.Position := 1433;
ngPgSQL:
updownPort.Position := 5432;
end;
FreeAndNil(Params);
Modification(Sender);
end;
procedure Tconnform.Modification(Sender: TObject);
var
PasswordModified: Boolean;
Sess: PConnectionParameters;
begin
// Some modification -
if FLoaded then begin
Sess := ListSessions.GetNodeData(ListSessions.FocusedNode);
FSessionModified := (Sess.Hostname <> editHost.Text)
or (Sess.Username <> editUsername.Text)
or (Sess.LoginPrompt <> chkLoginPrompt.Checked)
or (Sess.WindowsAuth <> chkWindowsAuth.Checked)
or (Sess.Port <> updownPort.Position)
or (Sess.Compressed <> chkCompressed.Checked)
or (Sess.QueryTimeout <> updownQueryTimeout.Position)
or (Sess.KeepAlive <> updownKeepAlive.Position)
or (Sess.LocalTimeZone <> chkLocalTimeZone.Checked)
or (Sess.FullTableStatus <> chkFullTableStatus.Checked)
or (Sess.NetType <> TNetType(comboNetType.ItemIndex))
or (Sess.StartupScriptFilename <> editStartupScript.Text)
or (Sess.AllDatabasesStr <> editDatabases.Text)
or (Sess.Comment <> memoComment.Text)
or (Sess.SSHHost <> editSSHHost.Text)
or (IntToStr(Sess.SSHPort) <> editSSHPort.Text)
or (Sess.SSHPlinkExe <> editSSHPlinkExe.Text)
or (IntToStr(Sess.SSHLocalPort) <> editSSHlocalport.Text)
or (Sess.SSHUser <> editSSHUser.Text)
or (Sess.SSHPassword <> editSSHPassword.Text)
or (Sess.SSHTimeout <> updownSSHTimeout.Position)
or (Sess.SSHPrivateKey <> editSSHPrivateKey.Text)
or (Sess.WantSSL <> chkWantSSL.Checked)
or (Sess.SSLPrivateKey <> editSSLPrivateKey.Text)
or (Sess.SSLCertificate <> editSSLCertificate.Text)
or (Sess.SSLCACertificate <> editSSLCACertificate.Text)
or (Sess.SSLCipher <> editSSLCipher.Text);
PasswordModified := Sess.Password <> editPassword.Text;
FOnlyPasswordModified := PasswordModified and (not FSessionModified);
FSessionModified := FSessionModified or PasswordModified;
if (Sender=editHost) or (Sender=editUsername) or (Sender=editPassword) or
(Sender=comboNetType) or (Sender=chkWindowsAuth) or (Sender=editPort) then begin
// Be sure to use the modified connection params next time the user clicks the "Databases" pulldown
FreeAndNil(FPopupDatabases);
end;
ListSessions.Repaint;
ValidateControls;
end;
end;
procedure Tconnform.FinalizeModifications(var CanProceed: Boolean);
begin
if FSessionModified and (not FOnlyPasswordModified) then begin
case MessageDialog(_('Save modifications?'), f_('Settings for "%s" were changed.', [SelectedSessionPath]), mtConfirmation, [mbYes, mbNo, mbCancel]) of
mrYes: begin
btnSave.OnClick(Self);
CanProceed := True;
end;
mrNo: begin
CanProceed := True;
end;
mrCancel: CanProceed := False;
end;
end else
CanProceed := True;
end;
procedure Tconnform.ValidateControls;
var
SessionFocused, FolderFocused: Boolean;
Params: TConnectionParameters;
begin
SessionFocused := False;
FolderFocused := False;
if Assigned(ListSessions.FocusedNode) then begin
Params := CurrentParams;
SessionFocused := not Params.IsFolder;
FolderFocused := Params.IsFolder;
if SessionFocused then begin
// Validate session GUI stuff
if Params.NetType = ntMySQL_NamedPipe then
lblHost.Caption := _('Socket name:')
else
lblHost.Caption := _('Hostname / IP:');
chkWindowsAuth.Enabled := Params.IsMSSQL;
lblUsername.Enabled := ((not chkLoginPrompt.Checked) or (not chkLoginPrompt.Enabled))
and ((not chkWindowsAuth.Checked) or (not chkWindowsAuth.Enabled));
editUsername.Enabled := lblUsername.Enabled;
lblPassword.Enabled := lblUsername.Enabled;
editPassword.Enabled := lblUsername.Enabled;
lblPort.Enabled := Params.NetType in [ntMySQL_TCPIP, ntMySQL_SSHtunnel, ntMSSQL_TCPIP, ntPgSQL_TCPIP];
if (Params.NetType = ntMSSQL_TCPIP) and (Pos('\', editHost.Text) > 0) then
lblPort.Enabled := False; // Named instance without port
editPort.Enabled := lblPort.Enabled;
updownPort.Enabled := lblPort.Enabled;
if Params.NetTypeGroup = ngPgSQL then
lblDatabase.Caption := _('Database')+':'
else
lblDatabase.Caption := _('Databases')+':';
chkWantSSL.Enabled := Params.NetType = ntMySQL_TCPIP;
lblSSLPrivateKey.Enabled := Params.WantSSL;
editSSLPrivateKey.Enabled := Params.WantSSL;
lblSSLCACertificate.Enabled := Params.WantSSL;
editSSLCACertificate.Enabled := Params.WantSSL;
lblSSLCertificate.Enabled := Params.WantSSL;
editSSLCertificate.Enabled := Params.WantSSL;
lblSSLcipher.Enabled := Params.WantSSL;
editSSLcipher.Enabled := Params.WantSSL;
tabSSHtunnel.TabVisible := Params.NetType = ntMySQL_SSHtunnel;
lblQueryTimeout.Enabled := Params.NetTypeGroup in [ngMSSQL, ngPgSQL];
editQueryTimeout.Enabled := lblQueryTimeout.Enabled;
updownQueryTimeout.Enabled := lblQueryTimeout.Enabled;
Params.Free;
end;
end;
// Main buttons
btnOpen.Enabled := SessionFocused;
btnSave.Enabled := SessionFocused and FSessionModified;
btnDelete.Enabled := SessionFocused or FolderFocused;
menuSave.Enabled := btnSave.Enabled;
menuSaveAs.Enabled := SessionFocused;
menuDelete.Enabled := btnDelete.Enabled;
end;
procedure Tconnform.splitterMainMoved(Sender: TObject);
var
ButtonWidth: Integer;
begin
// Splitter resized - adjust width of buttons
ButtonWidth := Round((ListSessions.Width - 2 * ListSessions.Margins.Left) / 3);
btnNew.Width := ButtonWidth;
btnSave.Width := ButtonWidth;
btnDelete.Width := ButtonWidth;
btnNew.Left := ListSessions.Left;
btnSave.Left := btnNew.Left + btnNew.Width + ListSessions.Margins.Left;
btnDelete.Left := btnSave.Left + btnSave.Width + ListSessions.Margins.Left;
end;
procedure Tconnform.PickFile(Sender: TObject);
var
Selector: TOpenDialog;
Edit: TButtonedEdit;
i: Integer;
Control: TControl;
begin
// Select startup SQL file, SSL file or whatever button clicked
Edit := Sender as TButtonedEdit;
Selector := TOpenDialog.Create(Self);
Selector.FileName := editStartupScript.Text;
if Edit = editStartupScript then
Selector.Filter := _('SQL files')+' (*.sql)|*.sql|'+_('All files')+' (*.*)|*.*'
else if Edit = editSSHPlinkExe then
Selector.Filter := _('Executables')+' (*.exe)|*.exe|'+_('All files')+' (*.*)|*.*'
else if Edit = editSSHPrivateKey then
Selector.Filter := _('PuTTY private key')+' (*.ppk)|*.ppk|'+_('All files')+' (*.*)|*.*'
else
Selector.Filter := _('Privacy Enhanced Mail certificates')+' (*.pem)|*.pem|'+_('Certificates')+' (*.crt)|*.crt|'+_('All files')+' (*.*)|*.*';
// Find relevant label and set open dialog's title
for i:=0 to Edit.Parent.ControlCount - 1 do begin
Control := Edit.Parent.Controls[i];
if (Control is TLabel) and ((Control as TLabel).FocusControl = Edit) then begin
Selector.Title := 'Select ' + (Control as TLabel).Caption;
break;
end;
end;
if Selector.Execute then begin
// Remove path if it's the application directory
if ExtractFilePath(Selector.FileName) = ExtractFilePath(Application.ExeName) then
Edit.Text := ExtractFileName(Selector.FileName)
else
Edit.Text := Selector.FileName;
Modification(Selector);
end;
Selector.Free;
end;
procedure Tconnform.editSSHPlinkExeChange(Sender: TObject);
begin
if not FileExists(editSSHPlinkExe.Text) then
editSSHPlinkExe.Font.Color := clRed
else
editSSHPlinkExe.Font.Color := clWindowText;
Modification(Sender);
end;
procedure Tconnform.lblDownloadPlinkClick(Sender: TObject);
begin
ShellExec(TLabel(Sender).Hint);
end;
end.