From 049e4bb526b16ba4998d1afbfb90759f6e09a063 Mon Sep 17 00:00:00 2001 From: Ansgar Becker Date: Mon, 4 Apr 2011 06:12:56 +0000 Subject: [PATCH] Group network types in fewer dbms names, to have less code. Also, support other MS SQL network types: tcp/ip, spx/ipx, vines and rpc. --- source/connections.dfm | 2 +- source/connections.pas | 28 ++++++++-- source/dbconnection.pas | 112 ++++++++++++++++++++++++++++++---------- source/helpers.pas | 2 +- source/main.pas | 41 ++++++--------- 5 files changed, 127 insertions(+), 58 deletions(-) diff --git a/source/connections.dfm b/source/connections.dfm index 9bbad065..cd12354c 100644 --- a/source/connections.dfm +++ b/source/connections.dfm @@ -295,7 +295,7 @@ object connform: Tconnform ItemIndex = 0 TabOrder = 0 Text = 'TCP/IP' - OnChange = Modification + OnChange = comboNetTypeChange Items.Strings = ( 'TCP/IP' 'Named pipe' diff --git a/source/connections.pas b/source/connections.pas index 992b46e7..41fbc8e5 100644 --- a/source/connections.pas +++ b/source/connections.pas @@ -112,6 +112,7 @@ type procedure lblDownloadPlinkClick(Sender: TObject); procedure comboDatabasesDropDown(Sender: TObject); procedure chkLoginPromptClick(Sender: TObject); + procedure comboNetTypeChange(Sender: TObject); private { Private declarations } FLoaded: Boolean; @@ -146,6 +147,7 @@ var LastSessions: TStringList; hSysMenu: THandle; idx: Integer; + nt: TNetType; begin // Fix GUI stuff InheritFont(Font); @@ -156,6 +158,11 @@ begin FixVT(ListSessions); ListSessions.OnGetHint := Mainform.vstGetHint; FLoaded := False; + + comboNetType.Clear; + for nt:=Low(nt) to High(nt) do + comboNetType.Items.Add(TConnectionParameters.NetTypeName(nt, True)); + FSessionNames := TStringList.Create; FSessionNames.OnChange := SessionNamesChange; RefreshSessionList; @@ -609,6 +616,19 @@ begin end; +procedure Tconnform.comboNetTypeChange(Sender: TObject); +begin + if (not editPort.Modified) and (FLoaded) then begin + case TNetType(comboNetType.ItemIndex) of + ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHTunnel: + updownPort.Position := DEFAULT_PORT; + ntMSSQL_NamedPipe, ntMSSQL_TCPIP, ntMSSQL_SPX, ntMSSQL_VINES, ntMSSQL_RPC: + updownPort.Position := 1433; + end; + end; + Modification(Sender); +end; + procedure Tconnform.Modification(Sender: TObject); var PasswordModified: Boolean; @@ -691,15 +711,15 @@ begin // Validate session GUI stuff NetType := TNetType(comboNetType.ItemIndex); - if NetType = ntNamedPipe then + if NetType = ntMySQL_NamedPipe then lblHost.Caption := 'Socket name:' else lblHost.Caption := 'Hostname / IP:'; - lblPort.Enabled := NetType in [ntTCPIP, ntSSHtunnel]; + lblPort.Enabled := NetType in [ntMySQL_TCPIP, ntMySQL_SSHtunnel, ntMSSQL_TCPIP]; editPort.Enabled := lblPort.Enabled; updownPort.Enabled := lblPort.Enabled; - tabSSLoptions.TabVisible := NetType = ntTCPIP; - tabSSHtunnel.TabVisible := NetType = ntSSHtunnel; + tabSSLoptions.TabVisible := NetType = ntMySQL_TCPIP; + tabSSHtunnel.TabVisible := NetType = ntMySQL_SSHtunnel; end; end; diff --git a/source/dbconnection.pas b/source/dbconnection.pas index 673790a4..02815b82 100644 --- a/source/dbconnection.pas +++ b/source/dbconnection.pas @@ -325,7 +325,9 @@ type { TConnectionParameters and friends } - TNetType = (ntTCPIP, ntNamedPipe, ntSSHtunnel, ntMSSQL); + TNetType = (ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHtunnel, + ntMSSQL_NamedPipe, ntMSSQL_TCPIP, ntMSSQL_SPX, ntMSSQL_VINES, ntMSSQL_RPC); + TNetTypeGroup = (ngMySQL, ngMSSQL); TMySQLClientOption = ( opCompress, // CLIENT_COMPRESS @@ -363,8 +365,11 @@ type constructor Create; function CreateConnection(AOwner: TComponent): TDBConnection; function CreateQuery(AOwner: TComponent): TDBQuery; + class function NetTypeName(NetType: TNetType; LongFormat: Boolean): String; + function GetNetTypeGroup: TNetTypeGroup; published property NetType: TNetType read FNetType write FNetType; + property NetTypeGroup: TNetTypeGroup read GetNetTypeGroup; property Hostname: String read FHostname write FHostname; property Port: Integer read FPort write FPort; property Username: String read FUsername write FUsername; @@ -742,7 +747,7 @@ uses helpers, loginform; constructor TConnectionParameters.Create; begin - FNetType := ntTCPIP; + FNetType := ntMySQL_TCPIP; FHostname := DEFAULT_HOST; FUsername := DEFAULT_USER; FPassword := ''; @@ -760,10 +765,10 @@ end; function TConnectionParameters.CreateConnection(AOwner: TComponent): TDBConnection; begin - case FNetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: + case NetTypeGroup of + ngMySQL: Result := TMySQLConnection.Create(AOwner); - ntMSSQL: + ngMSSQL: Result := TAdoDBConnection.Create(AOwner); else raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(FNetType)]); @@ -774,10 +779,10 @@ end; function TConnectionParameters.CreateQuery(AOwner: TComponent): TDBQuery; begin - case FNetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: + case NetTypeGroup of + ngMySQL: Result := TMySQLQuery.Create(AOwner); - ntMSSQL: + ngMSSQL: Result := TAdoDBQuery.Create(AOwner); else raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(FNetType)]); @@ -785,6 +790,47 @@ begin end; +class function TConnectionParameters.NetTypeName(NetType: TNetType; LongFormat: Boolean): String; +begin + if LongFormat then case NetType of + ntMySQL_TCPIP: + Result := 'MySQL (TCP/IP)'; + ntMySQL_NamedPipe: + Result := 'MySQL (named pipe)'; + ntMySQL_SSHtunnel: + Result := 'MySQL (SSH tunnel)'; + ntMSSQL_NamedPipe: + Result := 'Microsoft SQL Server (named pipe)'; + ntMSSQL_TCPIP: + Result := 'Microsoft SQL Server (TCP/IP)'; + ntMSSQL_SPX: + Result := 'Microsoft SQL Server (SPX/IPX)'; + ntMSSQL_VINES: + Result := 'Microsoft SQL Server (Banyan VINES)'; + ntMSSQL_RPC: + Result := 'Microsoft SQL Server (Windows RPC)'; + end else case NetType of + ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHtunnel: + Result := 'MySQL'; + ntMSSQL_NamedPipe, ntMSSQL_TCPIP: + Result := 'MS SQL'; + end; +end; + + +function TConnectionParameters.GetNetTypeGroup: TNetTypeGroup; +begin + case FNetType of + ntMySQL_TCPIP, ntMySQL_NamedPipe, ntMySQL_SSHtunnel: + Result := ngMySQL; + ntMSSQL_NamedPipe, ntMSSQL_TCPIP, ntMSSQL_SPX, ntMSSQL_VINES, ntMSSQL_RPC: + Result := ngMSSQL; + else + raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(FNetType)]); + end; +end; + + { TMySQLConnection } @@ -933,7 +979,7 @@ begin FinalSocket := ''; FinalPort := FParameters.Port; case FParameters.NetType of - ntTCPIP: begin + ntMySQL_TCPIP: begin if ( IsNotEmpty(FParameters.SSLCACertificate) and IsEmpty(FParameters.SSLPrivateKey) @@ -967,12 +1013,12 @@ begin end; end; - ntNamedPipe: begin + ntMySQL_NamedPipe: begin FinalHost := '.'; FinalSocket := FParameters.Hostname; end; - ntSSHtunnel: begin + ntMySQL_SSHtunnel: begin // Build plink.exe command line // plink bob@domain.com -pw myPassw0rd1 -P 22 -i "keyfile.pem" -L 55555:localhost:3306 PlinkCmd := FParameters.SSHPlinkExe + ' -ssh '; @@ -1091,17 +1137,33 @@ end; procedure TAdoDBConnection.SetActive(Value: Boolean); var - tmpdb, Error: String; + tmpdb, Error, NetLib, DataSource: String; rx: TRegExpr; + i: Integer; begin if Value then begin DoBeforeConnect; - FAdoHandle.ConnectionString := 'Provider=SQLOLEDB.1;'+ + NetLib := ''; + case Parameters.NetType of + ntMSSQL_NamedPipe: NetLib := 'DBNMPNTW'; + ntMSSQL_TCPIP: NetLib := 'DBMSSOCN'; + ntMSSQL_SPX: NetLib := 'DBMSSPXN'; + ntMSSQL_VINES: NetLib := 'DBMSVINN'; + ntMSSQL_RPC: NetLib := 'DBMSRPCN'; + end; + DataSource := Parameters.Hostname; + if Parameters.NetType = ntMSSQL_TCPIP then + DataSource := DataSource + ','+IntToStr(Parameters.Port); + FAdoHandle.ConnectionString := 'Provider=SQLOLEDB;'+ 'Password='+Parameters.Password+';'+ 'Persist Security Info=True;'+ 'User ID='+Parameters.Username+';'+ - 'Data Source='+Parameters.Hostname + 'Network Library='+NetLib+';'+ + 'Data Source='+DataSource ; + // Show up dynamic connection properties, probably useful for debugging + for i:=0 to FAdoHandle.Properties.Count-1 do + Log(lcDebug, 'OLE DB property "'+FAdoHandle.Properties[i].Name+'": '+String(FAdoHandle.Properties[i].Value)); try FAdoHandle.Connected := True; FConnectionStarted := GetTickCount div 1000; @@ -1167,7 +1229,7 @@ end; procedure TDBConnection.DoBeforeConnect; var UsernamePrompt, PasswordPrompt: String; - UsingPass, Protocol: String; + UsingPass: String; begin // Prompt for password on initial connect if FParameters.LoginPrompt and (not FLoginPromptDone) then begin @@ -1180,14 +1242,8 @@ begin end; // Prepare connection - case FParameters.NetType of - ntTCPIP: Protocol := 'TCP/IP'; - ntNamedPipe: Protocol := 'named pipe'; - ntSSHtunnel: Protocol := 'SSH tunnel'; - ntMSSQL: Protocol := 'MS SQL'; - end; if FParameters.Password <> '' then UsingPass := 'Yes' else UsingPass := 'No'; - Log(lcInfo, 'Connecting to '+FParameters.Hostname+' via '+Protocol+ + Log(lcInfo, 'Connecting to '+FParameters.Hostname+' via '+FParameters.NetTypeName(FParameters.NetType, True)+ ', username '+FParameters.Username+ ', using password: '+UsingPass+' ...'); end; @@ -2146,10 +2202,10 @@ begin Log(lcDebug, 'Fetching user@host ...'); Ping(True); if FCurrentUserHostCombination = '' then begin - case Parameters.NetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: + case Parameters.NetTypeGroup of + ngMySQL: sql := 'SELECT CURRENT_USER()'; - ntMSSQL: + ngMSSQL: sql := 'SELECT SYSTEM_USER'; else raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(Parameters.NetType)]); @@ -2568,8 +2624,8 @@ begin Result.Values['Compressed protocol'] := EvalBool(opCompress in Parameters.Options); Result.Values['Unicode enabled'] := EvalBool(IsUnicode); Result.Values['SSL enabled'] := EvalBool(opSSL in Parameters.Options); - case Parameters.NetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: begin + case Parameters.NetTypeGroup of + ngMySQL: begin Result.Values['Client version (libmysql)'] := DecodeApiString(mysql_get_client_info); Infos := DecodeApiString(mysql_stat((Self as TMySQLConnection).FHandle)); rx := TRegExpr.Create; @@ -2588,7 +2644,7 @@ begin rx.Free; end; - ntMSSQL: ; // Nothing specific yet + ngMSSQL: ; // Nothing specific yet end; end; end; diff --git a/source/helpers.pas b/source/helpers.pas index 1282138b..ff55b21b 100644 --- a/source/helpers.pas +++ b/source/helpers.pas @@ -2680,7 +2680,7 @@ begin raise Exception.Create('Error: Session "'+Session+'" not found in registry.') else begin Result := TConnectionParameters.Create; - Result.NetType := TNetType(GetRegValue(REGNAME_NETTYPE, Integer(ntTCPIP), Session)); + Result.NetType := TNetType(GetRegValue(REGNAME_NETTYPE, Integer(ntMySQL_TCPIP), Session)); Result.Hostname := GetRegValue(REGNAME_HOST, '', Session); Result.Username := GetRegValue(REGNAME_USER, '', Session); Result.Password := decrypt(GetRegValue(REGNAME_PASSWORD, '', Session)); diff --git a/source/main.pas b/source/main.pas index 6bb68fad..0e30aeab 100644 --- a/source/main.pas +++ b/source/main.pas @@ -1082,9 +1082,9 @@ begin 2: ImageIndex := 149; 3: begin Conn := ActiveConnection; - if Conn <> nil then case Conn.Parameters.NetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: ImageIndex := 164; - ntMSSQL: ImageIndex := 123; + if Conn <> nil then case Conn.Parameters.NetTypeGroup of + ngMySQL: ImageIndex := 164; + ngMSSQL: ImageIndex := 123; end; end; 6: begin @@ -1811,7 +1811,7 @@ begin if Port <> 0 then FCmdlineConnectionParams.Port := Port; if Socket <> '' then begin FCmdlineConnectionParams.Hostname := Socket; - FCmdlineConnectionParams.NetType := ntNamedPipe; + FCmdlineConnectionParams.NetType := ntMySQL_NamedPipe; end; // Ensure we have a session name to pass to InitConnection if (FCmdlineSessionName = '') and (FCmdlineConnectionParams.Hostname <> '') then @@ -3081,13 +3081,13 @@ begin for Obj in Objects do begin actNewQueryTab.Execute; Tab := QueryTabs[MainForm.QueryTabs.Count-1]; - case Obj.Connection.Parameters.NetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: + case Obj.Connection.Parameters.NetTypeGroup of + ngMySQL: case Obj.NodeType of lntProcedure: Query := 'CALL '; lntFunction: Query := 'SELECT '; end; - ntMSSQL: + ngMSSQL: Query := 'EXEC '; end; Parameters := TRoutineParamList.Create; @@ -3101,10 +3101,10 @@ begin end; Parameters.Free; ParamValues := ''; - if Params.Count > 0 then case Obj.Connection.Parameters.NetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: + if Params.Count > 0 then case Obj.Connection.Parameters.NetTypeGroup of + ngMySQL: ParamValues := '(' + ImplodeStr(', ', Params) + ')'; - ntMSSQL: + ngMSSQL: ParamValues := ' ' + ImplodeStr(' ', Params); end; Query := Query + ParamValues; @@ -4882,7 +4882,6 @@ end; procedure TMainForm.TimerConnectedTimer(Sender: TObject); var ConnectedTime: Integer; - Vendor: String; Conn: TDBConnection; begin Conn := ActiveConnection; @@ -4890,13 +4889,7 @@ begin // Calculate and display connection-time. Also, on any connect or reconnect, update server version panel. ConnectedTime := Conn.ConnectionUptime; ShowStatusMsg('Connected: ' + FormatTimeNumber(ConnectedTime), 2); - case Conn.Parameters.NetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: - Vendor := 'MySQL'; - ntMSSQL: - Vendor := 'MS SQL'; - end; - ShowStatusMsg(Vendor+' '+Conn.ServerVersionStr, 3); + ShowStatusMsg(Conn.Parameters.NetTypeName(Conn.Parameters.NetType, False)+' '+Conn.ServerVersionStr, 3); end else begin ShowStatusMsg('Disconnected.', 2); end; @@ -6897,10 +6890,10 @@ begin if PrevDBObj.Connection <> DBObj.Connection then begin LogSQL('Connection switch!', lcDebug); DBTree.Color := GetRegValue(REGNAME_TREEBACKGROUND, clWindow, DBObj.Connection.SessionName); - case DBObj.Connection.Parameters.NetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: + case DBObj.Connection.Parameters.NetTypeGroup of + ngMySQL: SynSQLSyn1.SQLDialect := sqlMySQL; - ntMSSQL: + ngMSSQL: SynSQLSyn1.SQLDialect := sqlMSSQL2K; else raise Exception.CreateFmt(MsgUnhandledNetType, [Integer(DBObj.Connection.Parameters.NetType)]); @@ -8216,8 +8209,8 @@ begin vt.FocusedNode := nil; vt.Clear; Conn := ActiveConnection; - case Conn.Parameters.NetType of - ntTCPIP, ntNamedPipe, ntSSHTunnel: begin + case Conn.Parameters.NetTypeGroup of + ngMySQL: begin if Conn.InformationSchemaObjects.IndexOf('PROCESSLIST') > -1 then begin // Minimize network traffic on newer servers by fetching only first KB of SQL query in "Info" column Results := Conn.GetResults('SELECT '+Conn.QuoteIdent('ID')+', '+Conn.QuoteIdent('USER')+', '+Conn.QuoteIdent('HOST')+', '+Conn.QuoteIdent('DB')+', ' @@ -8228,7 +8221,7 @@ begin Results := Conn.GetResults('SHOW FULL PROCESSLIST'); end; end; - ntMSSQL: begin + ngMSSQL: begin Results := Conn.GetResults('SELECT '+ Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('spid')+ ', RTRIM('+Conn.QuoteIdent('p')+'.'+Conn.QuoteIdent('loginame')+') AS '+Conn.QuoteIdent('loginname')+