Implement connecting via named pipe. Code contributed by gabylastar, minor modifications by me. Fixes issue #520.

This commit is contained in:
Ansgar Becker
2009-08-08 19:06:41 +00:00
parent 62dbda76ff
commit 0e341f19cb
21 changed files with 199 additions and 80 deletions

View File

@ -34,6 +34,10 @@ const
// Used for simulating a TTreeNode which has subnodes
DUMMY_NODE_TEXT : String = 'Dummy node, should never be visible';
// Connection types, used on session dialog
NETTYPE_TCPIP = 0;
NETTYPE_NAMEDPIPE = 1;
// Various names of registry variables
// User-changable variables have a default value
// Note: Color values are in HEX format: $00BBGGRR
@ -112,6 +116,8 @@ const
DEFAULT_PASSWORD = '';
REGNAME_PORT = 'Port';
DEFAULT_PORT = 3306;
REGNAME_NETTYPE = 'NetType';
DEFAULT_NETTYPE = NETTYPE_TCPIP;
REGNAME_TIMEOUT = 'Timeout';
DEFAULT_TIMEOUT = 30;
REGNAME_COMPRESSED = 'Compressed';

View File

@ -112,6 +112,7 @@ type
FProtocol: string;
FHostName: string;
FPort: Integer;
FSocketName: string;
FDatabase: WideString;
FUser: string;
FPassword: string;
@ -219,6 +220,7 @@ type
property Protocol: string read FProtocol write FProtocol;
property HostName: string read FHostName write FHostName;
property Port: Integer read FPort write FPort default 0;
property SocketName: string read FSocketName write FSocketName;
property Database: WideString read FDatabase write FDatabase;
property User: string read FUser write FUser;
property Password: string read FPassword write FPassword;
@ -482,13 +484,13 @@ function TZConnection.ConstructURL(const UserName, Password: string): string;
begin
if Port <> 0 then
begin
Result := Format('zdbc:%s://%s:%d/%s?UID=%s;PWD=%s', [FProtocol, FHostName,
FPort, FDatabase, UserName, Password]);
Result := Format('zdbc:%s://%s:%d@%s/%s?UID=%s;PWD=%s', [FProtocol, FHostName,
FPort, SocketName, FDatabase, UserName, Password]);
end
else
begin
Result := Format('zdbc:%s://%s/%s?UID=%s;PWD=%s', [FProtocol, FHostName,
FDatabase, UserName, Password]);
Result := Format('zdbc:%s://%s@%s/%s?UID=%s;PWD=%s', [FProtocol, FHostName,
SocketName, FDatabase, UserName, Password]);
end;
end;

View File

@ -102,7 +102,7 @@ type
public
constructor Create(Driver: IZDriver; const Url: string;
PlainDriver: IZASAPlainDriver;
const HostName: string; Port: Integer; const Database: string;
const HostName: string; Port: Integer; const SocketName: string; const Database: string;
const User: string; const Password: string; Info: TStrings);
destructor Destroy; override;
@ -172,14 +172,15 @@ var
TempInfo: TStrings;
HostName, Database, UserName, Password: string;
Port: Integer;
SocketName: string;
PlainDriver: IZASAPlainDriver;
begin
TempInfo := TStringList.Create;
try
ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, Database,
UserName, Password, TempInfo);
PlainDriver := GetPlainDriver(Url);
Result := TZASAConnection.Create(Self, Url, PlainDriver, HostName, Port,
Result := TZASAConnection.Create(Self, Url, PlainDriver, HostName, Port, SocketName,
Database, UserName, Password, TempInfo);
finally
TempInfo.Free;
@ -334,10 +335,10 @@ end;
@param Info a string list with extra connection parameters.
}
constructor TZASAConnection.Create(Driver: IZDriver; const Url: string;
PlainDriver: IZASAPlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZASAPlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database, User, Password: string; Info: TStrings);
begin
inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
inherited Create(Driver, Url, HostName, Port, SocketName, Database, User, Password, Info,
TZASADatabaseMetadata.Create(Self, Url, Info));
FPlainDriver := PlainDriver;

View File

@ -101,7 +101,7 @@ type
procedure StartTransaction; virtual;
public
constructor Create(Driver: IZDriver; const Url: string;
PlainDriver: IZPlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZPlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database: string; const User: string; const Password: string; Info: TStrings);
destructor Destroy; override;
@ -175,19 +175,20 @@ var
TempInfo: TStrings;
HostName, Database, UserName, Password: string;
Port: Integer;
SocketName: string;
Protocol: string;
PlainDriver: IZPlainDriver;
begin
TempInfo := TStringList.Create;
try
ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, Database,
UserName, Password, TempInfo);
Protocol := ResolveConnectionProtocol(Url, GetSupportedProtocols);
if Protocol = FAdoPlainDriver.GetProtocol then
PlainDriver := FAdoPlainDriver;
PlainDriver.Initialize;
Result := TZAdoConnection.Create(Self, Url, PlainDriver, HostName,
Port, Database, UserName, Password, TempInfo);
Port, SocketName, Database, UserName, Password, TempInfo);
finally
TempInfo.Free;
end;
@ -224,12 +225,12 @@ end;
@param Info a string list with extra connection parameters.
}
constructor TZAdoConnection.Create(Driver: IZDriver; const Url: string;
PlainDriver: IZPlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZPlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database: string; const User: string; const Password: string; Info: TStrings);
begin
FAdoConnection := CoConnection.Create;
FPLainDriver := PlainDriver;
inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
inherited Create(Driver, Url, HostName, Port, SocketName, Database, User, Password, Info,
TZAdoDatabaseMetadata.Create(Self, Url, Info));
end;

View File

@ -103,6 +103,7 @@ type
FDriver: IZDriver;
FHostName: string;
FPort: Integer;
FSocketName: string;
FDatabase: string;
FUser: string;
FPassword: string;
@ -114,7 +115,7 @@ type
FMetadata: TContainedObject;
protected
constructor Create(Driver: IZDriver; const Url: string; const HostName: string;
Port: Integer; const Database: string; const User: string; const Password: string;
Port: Integer; const SocketName: string; const Database: string; const User: string; const Password: string;
Info: TStrings; Metadata: TContainedObject);
procedure RaiseUnsupportedException;
@ -128,6 +129,7 @@ type
property Driver: IZDriver read FDriver write FDriver;
property HostName: string read FHostName write FHostName;
property Port: Integer read FPort write FPort;
property SocketName: string read FSocketName write FSocketName;
property Database: string read FDatabase write FDatabase;
property User: string read FUser write FUser;
property Password: string read FPassword write FPassword;
@ -402,12 +404,13 @@ end;
@param Info a string list with extra connection parameters.
}
constructor TZAbstractConnection.Create(Driver: IZDriver; const Url: string;
const HostName: string; Port: Integer; const Database: string; const User: string;
const HostName: string; Port: Integer; const SocketName: string; const Database: string; const User: string;
const Password: string; Info: TStrings; Metadata: TContainedObject);
begin
FDriver := Driver;
FHostName := HostName;
FPort := Port;
FSocketName := SocketName;
FDatabase := Database;
FMetadata := Metadata;

View File

@ -184,12 +184,13 @@ var
TempInfo: TStrings;
HostName, Database, UserName, Password: string;
Port: Integer;
SocketName: string;
Protocol: string;
PlainDriver: IZDBLibPlainDriver;
begin
TempInfo := TStringList.Create;
try
ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, Database,
UserName, Password, TempInfo);
Protocol := ResolveConnectionProtocol(Url, GetSupportedProtocols);
if Protocol = FMSSqlPlainDriver.GetProtocol then
@ -269,7 +270,7 @@ begin
Metadata := TZSybaseDatabaseMetadata.Create(Self, Url, Info)
else Metadata := nil;
inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
inherited Create(Driver, Url, HostName, Port, SocketName, Database, User, Password, Info,
Metadata);
FHandle := nil;

View File

@ -199,11 +199,12 @@ var
TempInfo: TStrings;
HostName, Database, UserName, Password: string;
Port: Integer;
SocketName: string;
PlainDriver: IZInterbasePlainDriver;
begin
TempInfo := TStringList.Create;
try
ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, Database,
UserName, Password, TempInfo);
PlainDriver := GetPlainDriver(Url);
Result := TZInterbase6Connection.Create(Self, Url, PlainDriver, HostName,
@ -397,7 +398,7 @@ var
ClientCodePage: string;
UserSetDialect: string;
begin
inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
inherited Create(Driver, Url, HostName, Port, SocketName, Database, User, Password, Info,
TZInterbase6DatabaseMetadata.Create(Self, Url, Info));
FPlainDriver := PlainDriver;

View File

@ -111,7 +111,7 @@ type
FAnsiMode: Boolean;
public
constructor Create(Driver: IZDriver; const Url: string;
PlainDriver: IZMySQLPlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZMySQLPlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database: string; const User: string; const Password: string; Info: TStrings);
destructor Destroy; override;
@ -208,20 +208,20 @@ end;
function TZMySQLDriver.Connect(const Url: string; Info: TStrings): IZConnection;
var
TempInfo: TStrings;
HostName, Database, UserName, Password: string;
HostName, Database, UserName, Password, SocketName: string;
Port: Integer;
PlainDriver: IZMySQLPlainDriver;
begin
TempInfo := TStringList.Create;
try
PlainDriver := GetPlainDriver(Url);
ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, Database,
UserName, Password, TempInfo);
// PATCH ADDED BY tohenk
if PlainDriver <> nil then
PlainDriver.BuildArguments(TempInfo);
Result := TZMySQLConnection.Create(Self, Url, PlainDriver, HostName, Port,
Database, UserName, Password, TempInfo);
SocketName, Database, UserName, Password, TempInfo);
finally
TempInfo.Free;
end;
@ -350,10 +350,10 @@ end;
@param Info a string list with extra connection parameters.
}
constructor TZMySQLConnection.Create(Driver: IZDriver; const Url: string;
PlainDriver: IZMySQLPlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZMySQLPlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database, User, Password: string; Info: TStrings);
begin
inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
inherited Create(Driver, Url, HostName, Port, SocketName, Database, User, Password, Info,
TZMySQLDatabaseMetadata.Create(Self, Url, Info));
{ Sets a default properties }
@ -429,7 +429,7 @@ begin
{ Connect to MySQL database. }
if FPlainDriver.RealConnect(FHandle, PChar(HostName), PChar(User),
PChar(Password), PChar(Database), Port, nil,
PChar(Password), PChar(Database), Port, PChar(SocketName),
ClientFlag) = nil then
begin
CheckMySQLError(FPlainDriver, FHandle, lcConnect, LogMessage);

View File

@ -183,12 +183,13 @@ var
TempInfo: TStrings;
Hostname, UserName, Password: string;
Port: Integer;
SocketName: string;
begin
inherited Create(Connection, Url, Info);
TempInfo := TStringList.Create;
try
ResolveDatabaseUrl(Url, Info, HostName, Port, FDatabase,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, FDatabase,
UserName, Password, TempInfo);
finally
TempInfo.Free;

View File

@ -115,7 +115,7 @@ type
public
constructor Create(Driver: IZDriver; const Url: string;
PlainDriver: IZOraclePlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZOraclePlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database: string; const User: string; const Password: string; Info: TStrings);
destructor Destroy; override;
@ -198,14 +198,15 @@ var
TempInfo: TStrings;
HostName, Database, UserName, Password: string;
Port: Integer;
SocketName: string;
PlainDriver: IZOraclePlainDriver;
begin
TempInfo := TStringList.Create;
try
PlainDriver := GetPlainDriver(Url);
ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, Database,
UserName, Password, TempInfo);
Result := TZOracleConnection.Create(Self, Url, PlainDriver, HostName, Port,
Result := TZOracleConnection.Create(Self, Url, PlainDriver, HostName, Port, SocketName,
Database, UserName, Password, TempInfo);
finally
TempInfo.Free;
@ -293,10 +294,10 @@ end;
@param Info a string list with extra connection parameters.
}
constructor TZOracleConnection.Create(Driver: IZDriver; const Url: string;
PlainDriver: IZOraclePlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZOraclePlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database, User, Password: string; Info: TStrings);
begin
inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
inherited Create(Driver, Url, HostName, Port, SocketName, Database, User, Password, Info,
TZOracleDatabaseMetadata.Create(Self, Url, Info));
{ Sets a default properties }

View File

@ -228,12 +228,13 @@ var
TempInfo: TStrings;
HostName, UserName, Password: string;
Port: Integer;
SocketName: string;
begin
inherited Create(Connection, Url, Info);
TempInfo := TStringList.Create;
try
ResolveDatabaseUrl(Url, Info, HostName, Port, FDatabase,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, FDatabase,
UserName, Password, TempInfo);
finally
TempInfo.Free;

View File

@ -159,7 +159,7 @@ TZPgCharactersetType = (
procedure LoadServerVersion;
public
constructor Create(Driver: IZDriver; const Url: string;
PlainDriver: IZPostgreSQLPlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZPostgreSQLPlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database: string; const User: string; const Password: string; Info: TStrings);
destructor Destroy; override;
@ -253,15 +253,16 @@ var
TempInfo: TStrings;
HostName, Database, UserName, Password: string;
Port: Integer;
SocketName: string;
PlainDriver: IZPostgreSQLPlainDriver;
begin
TempInfo := TStringList.Create;
try
PlainDriver := GetPlainDriver(Url);
ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, Database,
UserName, Password, TempInfo);
Result := TZPostgreSQLConnection.Create(Self, Url, PlainDriver, HostName,
Port, Database, UserName, Password, TempInfo);
Port, SocketName, Database, UserName, Password, TempInfo);
finally
TempInfo.Free;
end;
@ -353,10 +354,10 @@ end;
@param Info a string list with extra connection parameters.
}
constructor TZPostgreSQLConnection.Create(Driver: IZDriver; const Url: string;
PlainDriver: IZPostgreSQLPlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZPostgreSQLPlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database, User, Password: string; Info: TStrings);
begin
inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
inherited Create(Driver, Url, HostName, Port, SocketName, Database, User, Password, Info,
TZPostgreSQLDatabaseMetadata.Create(Self, Url, Info));
{ Sets a default PostgreSQL port }

View File

@ -244,12 +244,13 @@ var
TempInfo: TStrings;
Hostname, UserName, Password: string;
Port: Integer;
SocketName: string;
begin
inherited Create(Connection, Url, Info);
TempInfo := TStringList.Create;
try
ResolveDatabaseUrl(Url, Info, HostName, Port, FDatabase,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, FDatabase,
UserName, Password, TempInfo);
finally
TempInfo.Free;

View File

@ -105,7 +105,7 @@ type
public
constructor Create(Driver: IZDriver; const Url: string;
PlainDriver: IZSQLitePlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZSQLitePlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database: string; const User: string; const Password: string; Info: TStrings);
destructor Destroy; override;
@ -177,14 +177,15 @@ var
TempInfo: TStrings;
HostName, Database, UserName, Password: string;
Port: Integer;
SocketName: string;
PlainDriver: IZSQLitePlainDriver;
begin
TempInfo := TStringList.Create;
try
PlainDriver := GetPlainDriver(Url);
ResolveDatabaseUrl(Url, Info, HostName, Port, Database,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, Database,
UserName, Password, TempInfo);
Result := TZSQLiteConnection.Create(Self, Url, PlainDriver, HostName, Port,
Result := TZSQLiteConnection.Create(Self, Url, PlainDriver, HostName, Port, SocketName,
Database, UserName, Password, TempInfo);
finally
TempInfo.Free;
@ -275,10 +276,10 @@ end;
@param Info a string list with extra connection parameters.
}
constructor TZSQLiteConnection.Create(Driver: IZDriver; const Url: string;
PlainDriver: IZSQLitePlainDriver; const HostName: string; Port: Integer;
PlainDriver: IZSQLitePlainDriver; const HostName: string; Port: Integer; const SocketName: string;
const Database, User, Password: string; Info: TStrings);
begin
inherited Create(Driver, Url, HostName, Port, Database, User, Password, Info,
inherited Create(Driver, Url, HostName, Port, SocketName, Database, User, Password, Info,
TZSQLiteDatabaseMetadata.Create(Self, Url, Info));
{ Sets a default properties }

View File

@ -228,12 +228,13 @@ var
TempInfo: TStrings;
HostName, UserName, Password: string;
Port: Integer;
SocketName: string;
begin
inherited Create(Connection, Url, Info);
TempInfo := TStringList.Create;
try
ResolveDatabaseUrl(Url, Info, HostName, Port, FDatabase,
ResolveDatabaseUrl(Url, Info, HostName, Port, SocketName, FDatabase,
UserName, Password, TempInfo);
finally
TempInfo.Free;

View File

@ -84,7 +84,7 @@ function ResolveConnectionProtocol(Url: string;
@param ResutlInfo a result info parameters.
}
procedure ResolveDatabaseUrl(const Url: string; Info: TStrings;
var HostName: string; var Port: Integer; var Database: string;
var HostName: string; var Port: Integer; var SocketName: string; var Database: string;
var UserName: string; var Password: string; ResultInfo: TStrings);
{**
@ -205,7 +205,7 @@ end;
@param ResutlInfo a result info parameters.
}
procedure ResolveDatabaseUrl(const Url: string; Info: TStrings;
var HostName: string; var Port: Integer; var Database: string;
var HostName: string; var Port: Integer; var SocketName: string; var Database: string;
var UserName: string; var Password: string; ResultInfo: TStrings);
var
Index: Integer;
@ -220,6 +220,7 @@ begin
{ Set default values. }
HostName := 'localhost';
Port := 0;
SocketName := '';
Database := '';
UserName := '';
Password := '';
@ -247,12 +248,26 @@ begin
if Pos(':', Temp) = 1 then
begin
Delete(Temp, 1, 1);
Index := FirstDelimiter('/?', Temp);
Index := FirstDelimiter('@?', Temp);
if Index = 0 then
Index := FirstDelimiter('/?', Temp);
if Index = 0 then
RaiseException;
Port := StrToInt(Copy(Temp, 1, Index - 1));
Delete(Temp, 1, Index - 1);
{ Retrieves socket name }
if Pos('@', Temp) = 1 then
begin
Delete(Temp, 1, 1);
Index := FirstDelimiter('/?', Temp);
if Index = 0 then
RaiseException;
SocketName := Copy(Temp, 1, Index - 1);
Delete(Temp, 1, Index - 1);
end;
end;
if Pos('/', Temp) <> 1 then

View File

@ -4,12 +4,12 @@ object connform: Tconnform
Top = 129
BorderIcons = [biSystemMenu]
Caption = 'Session manager'
ClientHeight = 284
ClientHeight = 304
ClientWidth = 456
Color = clBtnFace
Constraints.MaxHeight = 320
Constraints.MaxHeight = 340
Constraints.MaxWidth = 800
Constraints.MinHeight = 320
Constraints.MinHeight = 340
Constraints.MinWidth = 462
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
@ -23,13 +23,13 @@ object connform: Tconnform
OnShow = FormShow
DesignSize = (
456
284)
304)
PixelsPerInch = 96
TextHeight = 13
object lblHost: TLabel
Tag = 6
Left = 139
Top = 76
Top = 101
Width = 72
Height = 13
Caption = '&Hostname / IP:'
@ -38,7 +38,7 @@ object connform: Tconnform
object lblUsername: TLabel
Tag = 7
Left = 139
Top = 100
Top = 125
Width = 26
Height = 13
Caption = '&User:'
@ -47,7 +47,7 @@ object connform: Tconnform
object lblPassword: TLabel
Tag = 8
Left = 139
Top = 124
Top = 149
Width = 50
Height = 13
Caption = '&Password:'
@ -56,7 +56,7 @@ object connform: Tconnform
object lblPort: TLabel
Tag = 9
Left = 139
Top = 148
Top = 173
Width = 24
Height = 13
Caption = 'P&ort:'
@ -65,7 +65,7 @@ object connform: Tconnform
object lblTimeout: TLabel
Tag = 10
Left = 279
Top = 148
Top = 173
Width = 42
Height = 13
Caption = '&Timeout:'
@ -83,7 +83,7 @@ object connform: Tconnform
object lblSeconds: TLabel
Tag = 11
Left = 391
Top = 148
Top = 173
Width = 39
Height = 13
Anchors = [akLeft, akTop, akRight]
@ -92,7 +92,7 @@ object connform: Tconnform
object lblOnlyDBs: TLabel
Tag = 13
Left = 139
Top = 195
Top = 218
Width = 63
Height = 13
Caption = 'Data&base(s):'
@ -101,7 +101,7 @@ object connform: Tconnform
end
object editHost: TEdit
Left = 230
Top = 73
Top = 98
Width = 215
Height = 21
Anchors = [akLeft, akTop, akRight]
@ -110,7 +110,7 @@ object connform: Tconnform
end
object editUsername: TEdit
Left = 230
Top = 97
Top = 122
Width = 215
Height = 21
Anchors = [akLeft, akTop, akRight]
@ -119,7 +119,7 @@ object connform: Tconnform
end
object editPassword: TEdit
Left = 230
Top = 121
Top = 146
Width = 215
Height = 21
Anchors = [akLeft, akTop, akRight]
@ -129,7 +129,7 @@ object connform: Tconnform
end
object editPort: TEdit
Left = 230
Top = 145
Top = 170
Width = 43
Height = 21
TabOrder = 4
@ -137,7 +137,7 @@ object connform: Tconnform
end
object editTimeout: TEdit
Left = 331
Top = 144
Top = 169
Width = 51
Height = 21
TabOrder = 5
@ -3005,7 +3005,7 @@ object connform: Tconnform
object chkCompressed: TCheckBox
Tag = 12
Left = 230
Top = 171
Top = 194
Width = 215
Height = 17
Caption = '&Compressed client/server protocol'
@ -3014,7 +3014,7 @@ object connform: Tconnform
end
object editOnlyDBs: TTntEdit
Left = 230
Top = 192
Top = 215
Width = 215
Height = 21
Hint = 'A list of wanted databases, separated by semicolon'
@ -3026,7 +3026,7 @@ object connform: Tconnform
end
object chkSorted: TCheckBox
Left = 230
Top = 219
Top = 242
Width = 215
Height = 17
Anchors = [akLeft, akTop, akRight]
@ -3036,7 +3036,7 @@ object connform: Tconnform
end
object btnSaveAndConnect: TButton
Left = 139
Top = 248
Top = 271
Width = 95
Height = 25
Anchors = [akTop, akRight]
@ -3048,7 +3048,7 @@ object connform: Tconnform
object btnConnect: TButton
Tag = 15
Left = 245
Top = 248
Top = 271
Width = 95
Height = 25
Anchors = [akTop, akRight]
@ -3060,7 +3060,7 @@ object connform: Tconnform
object btnCancel: TButton
Tag = 16
Left = 350
Top = 248
Top = 271
Width = 95
Height = 25
Anchors = [akTop, akRight]
@ -3124,4 +3124,24 @@ object connform: Tconnform
TabOrder = 14
OnClick = ButtonEditDescClick
end
object radioTypeTCPIP: TRadioButton
Left = 230
Top = 75
Width = 67
Height = 17
Caption = 'TCP/IP'
Checked = True
TabOrder = 15
TabStop = True
OnClick = radioNetTypeClick
end
object radioTypeNamedPipe: TRadioButton
Left = 314
Top = 75
Width = 113
Height = 17
Caption = 'Named pipe'
TabOrder = 16
OnClick = radioNetTypeClick
end
end

View File

@ -43,6 +43,8 @@ type
btnDelete: TToolButton;
btnSaveAs: TToolButton;
btnEditDesc: TButton;
radioTypeTCPIP: TRadioButton;
radioTypeNamedPipe: TRadioButton;
procedure CreateParams(var Params: TCreateParams); override;
procedure FormCreate(Sender: TObject);
procedure btnSaveAndConnectClick(Sender: TObject);
@ -56,6 +58,7 @@ type
procedure comboSessionSelect(Sender: TObject);
procedure Modified(Sender: TObject);
procedure ButtonEditDescClick(Sender: TObject);
procedure radioNetTypeClick(Sender: TObject);
private
{ Private declarations }
procedure FillSessionCombo(Sender: TObject);
@ -93,6 +96,7 @@ end;
procedure Tconnform.btnConnectClick(Sender: TObject);
var
btn: TButton;
ConType: Byte;
begin
Screen.Cursor := crHourglass;
// Save last connection name to registry
@ -102,7 +106,11 @@ begin
btn := Sender as TButton;
btn.Enabled := false;
if radioTypeTCPIP.Checked then ConType := NETTYPE_TCPIP
else ConType := NETTYPE_NAMEDPIPE;
if Mainform.InitConnection(
ConType,
editHost.Text,
editPort.Text,
editUsername.Text,
@ -172,6 +180,10 @@ begin
MainReg.WriteString(REGNAME_USER, editUsername.Text);
MainReg.WriteString(REGNAME_PASSWORD, encrypt(editPassword.Text));
MainReg.WriteString(REGNAME_PORT, editPort.Text);
if radioTypeTCPIP.Checked then
MainReg.WriteInteger(REGNAME_NETTYPE, NETTYPE_TCPIP)
else
MainReg.WriteInteger(REGNAME_NETTYPE, NETTYPE_NAMEDPIPE);
MainReg.WriteString(REGNAME_TIMEOUT, editTimeout.Text);
MainReg.WriteBool(REGNAME_COMPRESSED, chkCompressed.Checked);
MainReg.WriteString(REGNAME_ONLYDBS, Utf8Encode(editOnlyDBs.Text));
@ -230,6 +242,7 @@ begin
Screen.Cursor := crHourglass;
OpenRegistry(session);
MainReg.WriteInteger(REGNAME_NETTYPE, DEFAULT_NETTYPE);
MainReg.WriteString(REGNAME_HOST, DEFAULT_HOST);
MainReg.WriteString(REGNAME_USER, DEFAULT_USER);
MainReg.WriteString(REGNAME_PASSWORD, encrypt(DEFAULT_PASSWORD));
@ -270,6 +283,10 @@ begin
Session := comboSession.Text;
SessionSelected := (Session <> '') and MainReg.KeyExists(REGPATH + REGKEY_SESSIONS + Session);
if SessionSelected then begin
case GetRegValue(REGNAME_NETTYPE, DEFAULT_NETTYPE, Session) of
NETTYPE_NAMEDPIPE: radioTypeNamedPipe.Checked := True;
else radioTypeTCPIP.Checked := True;
end;
editHost.Text := GetRegValue(REGNAME_HOST, '', Session);
editUsername.Text := GetRegValue(REGNAME_USER, '', Session);
editPassword.Text := decrypt(GetRegValue(REGNAME_PASSWORD, '', Session));
@ -279,6 +296,7 @@ begin
editOnlyDBs.Text := Utf8Decode(GetRegValue(REGNAME_ONLYDBS, '', Session));
chkSorted.Checked := GetRegValue(REGNAME_ONLYDBSSORTED, DEFAULT_ONLYDBSSORTED, Session);
end else begin
radioTypeTCPIP.Checked := True;
editHost.Text := '';
editUsername.Text := '';
editPassword.Text := '';
@ -294,6 +312,8 @@ begin
btnSaveAndConnect.Enabled := SessionSelected;
btnDelete.Enabled := SessionSelected;
btnEditDesc.Enabled := SessionSelected;
radioTypeTCPIP.Enabled := SessionSelected;
radioTypeNamedPipe.Enabled := SessionSelected;
editHost.Enabled := SessionSelected;
editUsername.Enabled := SessionSelected;
editPassword.Enabled := SessionSelected;
@ -311,6 +331,8 @@ begin
lblSeconds.Enabled := SessionSelected;
lblOnlyDBs.Enabled := SessionSelected;
radioNetTypeClick(Sender);
Screen.Cursor := crDefault;
end;
@ -353,4 +375,16 @@ begin
end;
procedure Tconnform.radioNetTypeClick(Sender: TObject);
begin
// Toggle between TCP/IP and named pipes mode
if radioTypeTCPIP.Checked then
lblHost.Caption := 'Hostname / IP:'
else
lblHost.Caption := 'Socket name:';
editPort.Enabled := radioTypeTCPIP.Checked;
lblPort.Enabled := editPort.Enabled;
end;
end.

View File

@ -815,7 +815,7 @@ type
procedure FillPopupQueryLoad;
procedure PopupQueryLoadRemoveAbsentFiles( sender: TObject );
procedure SessionConnect(Sender: TObject);
function InitConnection(parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parSortDatabases: WideString): Boolean;
function InitConnection(parNetType: Integer; parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parSortDatabases: WideString): Boolean;
//procedure HandleQueryNotification(ASender : TMysqlQuery; AEvent : Integer);
function ExecUpdateQuery(sql: WideString; HandleErrors: Boolean = false; DisplayErrors: Boolean = false): Int64;
@ -1430,7 +1430,7 @@ end;
}
procedure TMainForm.Startup;
var
curParam : Byte;
curParam, parNetType: Byte;
sValue,
parHost, parPort, parUser, parPass, parDatabase,
parTimeout, parCompress, parDescription : String;
@ -1515,6 +1515,7 @@ begin
// Check commandline if parameters were passed. Otherwise show connections windows
curParam := 1;
parNetType := NETTYPE_TCPIP;
while curParam <= ParamCount do begin
// -M and -d are choosen not to conflict with mysql.exe
// http://dev.mysql.com/doc/refman/5.0/en/mysql-command-options.html
@ -1525,6 +1526,8 @@ begin
parHost := sValue
else if GetParamValue('P', 'port', curParam, sValue) then
parPort := sValue
else if GetParamValue('T', 'nettype', curParam, sValue) then
parNetType := StrToIntDef(sValue, NETTYPE_TCPIP)
else if GetParamValue('C', 'compress', curParam, sValue) then
parCompress := sValue
else if GetParamValue('M', 'timeout', curParam, sValue) then
@ -1542,6 +1545,7 @@ begin
// Find stored session if -dSessionName was passed
if (parDescription <> '') and (MainReg.OpenKey(REGPATH + REGKEY_SESSIONS + parDescription, False)) then begin
parNetType := GetRegValue(REGNAME_NETTYPE, DEFAULT_NETTYPE, parDescription);
parHost := GetRegValue(REGNAME_HOST, DEFAULT_HOST, parDescription);
parUser := GetRegValue(REGNAME_USER, DEFAULT_USER, parDescription);
parPass := decrypt(GetRegValue(REGNAME_PASSWORD, DEFAULT_PASSWORD, parDescription));
@ -1554,7 +1558,7 @@ begin
// Minimal parameter for command line mode is hostname
CommandLineMode := parHost <> '';
if CommandLineMode then begin
Connected := InitConnection(parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, IntToStr(Integer(DEFAULT_ONLYDBSSORTED)));
Connected := InitConnection(parNetType, parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, IntToStr(Integer(DEFAULT_ONLYDBSSORTED)));
if Connected then begin
SessionName := parDescription;
if SessionName = '' then
@ -1568,6 +1572,7 @@ begin
LastSession := GetRegValue(REGNAME_LASTSESSION, '');
if LastSession <> '' then begin
Connected := InitConnection(
GetRegValue(REGNAME_NETTYPE, DEFAULT_NETTYPE, LastSession),
GetRegValue(REGNAME_HOST, '', LastSession),
GetRegValue(REGNAME_PORT, '', LastSession),
GetRegValue(REGNAME_USER, '', LastSession),
@ -2514,9 +2519,11 @@ end;
procedure TMainForm.SessionConnect(Sender: TObject);
var
Session: String;
parNetType: Integer;
parHost, parPort, parUser, parPass, parTimeout, parCompress, parDatabase, parSortDatabases: WideString;
begin
Session := (Sender as TMenuItem).Caption;
parNetType := GetRegValue(REGNAME_NETTYPE, DEFAULT_NETTYPE, Session);
parHost := GetRegValue(REGNAME_HOST, '', Session);
parUser := GetRegValue(REGNAME_USER, '', Session);
parPass := decrypt(GetRegValue(REGNAME_PASSWORD, '', Session));
@ -2525,7 +2532,7 @@ begin
parCompress := IntToStr(Integer(GetRegValue(REGNAME_COMPRESSED, DEFAULT_COMPRESSED, Session)));
parDatabase := Utf8Decode(GetRegValue(REGNAME_ONLYDBS, '', Session));
parSortDatabases := IntToStr(Integer(GetRegValue(REGNAME_ONLYDBSSORTED, DEFAULT_ONLYDBSSORTED, Session)));
if InitConnection(parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parSortDatabases) then begin
if InitConnection(parNetType, parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parSortDatabases) then begin
SessionName := Session;
DoAfterConnect;
end;
@ -2536,15 +2543,16 @@ end;
Receive connection parameters and create the mdi-window
Paremeters are either sent by connection-form or by commandline.
}
function TMainform.InitConnection(parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parSortDatabases: WideString): Boolean;
function TMainform.InitConnection(parNetType: Integer; parHost, parPort, parUser, parPass, parDatabase, parTimeout, parCompress, parSortDatabases: WideString): Boolean;
var
MysqlConnection: TMysqlConn;
Profile: TOpenConnProf;
UsingPass: String;
UsingPass, NetType: String;
begin
// fill structure
ZeroMemory(@Profile, SizeOf(Profile));
Profile.MysqlParams.Protocol := 'mysql';
Profile.MysqlParams.NetType := parNetType;
Profile.MysqlParams.Host := Trim( parHost );
Profile.MysqlParams.Port := StrToIntDef(parPort, DEFAULT_PORT);
Profile.MysqlParams.Database := '';
@ -2565,7 +2573,12 @@ begin
// attempt to establish connection
if Profile.MysqlParams.Pass <> '' then UsingPass := 'Yes' else UsingPass := 'No';
LogSQL('Connecting to '+Profile.MysqlParams.Host+
case parNetType of
NETTYPE_TCPIP: NetType := 'TCP/IP';
NETTYPE_NAMEDPIPE: NetType := 'named pipe';
else NetType := 'unknown protocol';
end;
LogSQL('Connecting to '+Profile.MysqlParams.Host+' via '+NetType+
', username '+Profile.MysqlParams.User+
', using password: '+UsingPass+' ...');
if MysqlConnection.Connect <> MCR_SUCCESS then begin

View File

@ -9,6 +9,8 @@ const
MCR_SUCCESS = 0;
MCR_FAILED = 1;
{$I const.inc}
type
@ -52,7 +54,13 @@ begin
with FOpenConn.MysqlParams do
begin
FConn.Protocol := 'mysql';
FConn.Hostname := Host;
if FOpenConn.MysqlParams.NetType = NETTYPE_TCPIP then begin
FConn.Hostname := Host;
FConn.SocketName := '';
end else begin
FConn.Hostname := '.';
FConn.SocketName := Host;
end;
FConn.User := User;
FConn.Password := Pass;
FConn.Port := Port;

View File

@ -21,6 +21,7 @@ type
// Mysql protocol-relevant connection parameter structure
TMysqlConnParams = record
NetType: Integer;
Host: String;
Database: WideString;
Protocol,
@ -117,7 +118,13 @@ begin
FResult := 0;
FSql := ASql;
mc.HostName := AConn.MysqlParams.Host;
if AConn.MysqlParams.NetType = NETTYPE_TCPIP then begin
mc.HostName := AConn.MysqlParams.Host;
mc.SocketName := '';
end else begin
mc.HostName := '.';
mc.SocketName := AConn.MysqlParams.Host;
end;
mc.Database := AConn.MysqlParams.Database;
mc.User := AConn.MysqlParams.User;
mc.Password := AConn.MysqlParams.Pass;