mysqlserver.pas

MYSQL 连接控件 MYSQL 连接控件

//	Author:			Jacques Venter, [e-mail]
//	Copyright: 		1999,2000,2001,2002,2003,2004,2005,2006 SciBit - Scientific Bitware (Pty) Ltd
//	Version:			2006.4.4.0
//	Comments:		The MySQLServer - maintains all connections and datasets to a mysql server
//	History:
//                  2006.4.3.0 (2005-12-20)
//                     Delphi 2006 release
//                  2005.4.2.0 (2005-09-20)
//                     Add Delphi 2006 support
//                  2005.4.1.1 (2005-03-14)
//                     Add Pipe communication
//                  2004.3.0.1 (2004-08-20)
//                     Set defaults options for Dataset and DatasetFrom to Options - [doRetrieveFieldValues,doRetrieveIndexDefs]
//                  2004.3.0.0 (2004-08-10)
//                     Time for a new release, no use being selfish and keeping all these nice to haves from the customers :P
//                  2004.2.0.6 (2004-08-05)
//                     Force Read of Params in case of driver already dtDirect and setting drivertype, so that timeouts can be set correctly
//                  2004.2.0.5 (2004-06-25)
//                     Add soCloseOnChildren option to optionally close connection when all connected datasets closed
//						2004.2.0.4 (2004-06-23)
//                     Add Assign method
//						2004.2.0.3 (2004-05-26)
//                     Fix minor bug of if dynamic dataset still exists and FreeDataset has not been called by end-user
//						2004.2.0.2 (2004-05-20)
//                     Check for differences when setting major props before disconnecting
//						2004.2.0.1 (2004-05-19)
//                     Add CreateDatabase function and soAutoCreate,soDropIfExists option :)
//						2004.2.0.0 (2004-04-05)
//                     Add SSL & Compiler directive support
//                     Add client-timeout option
//                     Certified with MySQL servers, 3.21.x, 3.22.x, 3.23.x, 4.0.1, 4.0.18, 4.1.1, 5.0
//						2004.1.2.0 (2004-03-24)
//                     Change SetParams to override existing parameters of drivers if new options are assigned
//						2004.1.1.0 (2004-02-15)
//                     Certified with MySQL servers, 3.21.x, 3.22.x, 3.23.x, 4.0.1, 4.0.18, 4.1.1
//                     Certified with libmysql.dll,libmysqld.dll version 3.23.x, 4.0.18, 4.1.1 (4.0.18 Stable prefered)
//                     Certified with Delphi 5,6,7 and Kylix 1,2,3
//							Added Support for 4.0 Embedded & Direct Access
//						2003.1.2.0 (2003-12-15)
//							Added Support for MySQL4.1
//						2003.1.1.0 (2003-06-15)
//							Added Support for MySQL4.0
//						2002.1.1.0 (2002-12-19)
//							Certify for Delphi 5,6,7 and Kylix 1,2,3
//							Added compiler directive for console applications
//						2002.1.0.4 (2002-6-11)
//							Add Ping function
//						2002.1.0.3 (2002-6-7)
//							Add TOwnDatasets list,  Dataset and DatasetFrom methods
//						2002.1.0.2 (2002-2-13
//							Put mysql_ping back in Server property
//						2002.1.0.1 (2002-2-9)
//							Add GetLock/ReleaseLock functions
//						2002.1.0.0
//							Switch to clientlib: 23-Sep-2001  mf  Code maintenance for release 3.23.42 MySQL-Win32 3.23.42
//							Use new defines.inc declarations
//						2001.1.0.9
//							Certify for Delphi 5, Delphi 6 and Kylix 1 and Kylix 2
//							Make Single Source
//							Fix minor bug in HexStr
//							Add feature to initialize Detail Dataset fieldvalues automatically to linked Master Dataset fieldvalues
//							Add TMySQLTable, TMySQLQuery to make things simpler for beginners
//						2000.0.3.1
//							Added ResultType property
//							Fixed minor bugs
//						2000.0.2.1
//							Added AllFieldValues property
//							Added Filter and Filtered properties
//							Added MasterSource and MasterFields properties
//							Added updating for tables without keys
//							Fixed minor bugs
//						2000.0.1.1
//							First release
//
//   Licensing
//
//       Copyright (c) 1998-2004 SciBit - Scientific Bitware (Pty) Ltd
//       ALL RIGHTS RESERVED
//
//  The entire contents of this file is protected by South African and
//  International Copyright Laws. Unauthorized reproduction,
//  reverse-engineering, and distribution of all or any portion of
//  the code contained in this file is strictly prohibited and may
//  result in severe civil and criminal penalties and will be
//  prosecuted to the maximum extent possible under the law.
//
//  RESTRICTIONS
//
//  THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES
//  (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE
//  SECRETS OF SCIBIT (Pty) Ltd. THE REGISTERED DEVELOPER IS
//  LICENSED TO DISTRIBUTE THE SOURCECODE AND ALL
//  ACCOMPANYING VCL CONTROLS AS PART OF AN EXECUTABLE PROGRAM ONLY.
//
//  THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED
//  FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE
//  COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE
//  AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT
//  AND PERMISSION FROM SciBit - Scientific Bitware (Pty) Ltd
//
//  CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON
//  ADDITIONAL RESTRICTIONS.
//
//*******************************************************************
unit MySQLServer;
interface
{$I product.inc}
uses
	SysUtils, Classes, DB,
{$IFDEF IDEONLY}
  {$IFDEF MSWINDOWS}
  Windows,
  {$ENDIF}
{$ENDIF}
{$IFNDEF CONSOLEAPP}
  {$IFDEF MSWINDOWS}
	Dialogs,Controls,
  {$ELSE}
	QDialogs,QControls,
  {$ENDIF}
	MySQLLoginDlg,
{$ENDIF}
	MySQLDrivers,MySQLParser;

type
	TMySQLServer = class;

  TMySQLServerLoginEvent = procedure(Server: TMySQLServer; LoginParams: TStrings) of object;
  TMySQLServerOptions = set of (coLongPassword,coFoundRows,coLongFlag,coConnectWithDB,coNoSchema,coCompress,coODBC,
                                coLocalFiles,coIgnoreSpace,coInteractive,
                                {$IFDEF HAVE_SSL}
                                coSSL,
                                {$ENDIF}
                                coIgnoreSigpipe,coTransactions,coProtocol41,coSecureConnection,coMultiQueries,
                                soAutoCreate,soDropIfExists,soCloseOnChildren);
  TMySQLDriverType = (
     {$IFDEF MYSQLDIRECT}dtDirect,{$ENDIF}
     {$IFDEF MYSQLEMBEDDED}dtEmbedded,{$ENDIF}
     dtLibrary);

  TMySQLProtocolType = (
     ptTCP
     ,ptPipe
  //   ,dtMemory
  );

  TMySQLServer = class(TCustomConnection)
  private
     FDriverType: TMySQLDriverType;
     FProtocolType: TMySQLProtocolType;
  	FDriver:     TMySQLBase;
     FConnection: pointer;
     FConOptions: TMySQLServerOptions;
     FHost,
     FUserName,
     FPassword: string;
     FPort: word;
     FParams: TStrings;
     FOnLogin: TMySQLServerLoginEvent;
    	FDBName: string;
     FOwnDatasets: TStringList;
     function   	GetDriver: TMySQLBase;
     function   	GetHost: string;
     function   	GetPort: word;
     function   	GetUserName:string;
     function   	GetPassword:string;
     function   	GetCompression: boolean;
     procedure   SetCompression(Value: boolean = False);
     procedure   SetDriverType(Value: TMySQLDriverType);
     procedure   SetProtocolType(Value: TMySQLProtocolType);
     procedure   SetDriver(Value: TMySQLBase);
     procedure   SetDatabaseName(Value: string);
     procedure   SetHost(Value: string = 'localhost');
     procedure   SetPort(Value: word = 3306);
     procedure   SetUserName(Value: string = 'root');
     procedure   SetPassword(Value: string = '');
     procedure   SetParams(Value: TStrings);
		procedure 	ActivateConnection;
     function		GetOptions: TMySQLServerOptions;
     procedure	SetOptions(const Value: TMySQLServerOptions);
  protected
     procedure   DisconnectClients;
     function    CheckChildrenAllClosed: boolean;
     procedure   CloseClients;
    	procedure 	Notification(AComponent: TComponent; Operation: TOperation); override;
     procedure   Loaded; override;
     procedure	Link(const Detail,Master,Condition: string);
     procedure	UnLink(const Detail: string);
     function		FindDataset(const AName: string=''): integer;

     procedure	DoConnect; override;
     procedure	DoDisconnect; override;
     procedure   SetConnected(Value: boolean); override;
    	function 	GetConnected: Boolean; override;
     function    GetClientVersion: string;
     function    GetClientVer: integer;
     function    GetServerVersion: string;
     function    GetServerVer: integer;

     function		NewDataset(const AName: string=''; const Table: string=''): TDataset;
  public
     constructor Create(AOwner: TComponent); override;
     destructor 	Destroy; override;
     procedure   Assign(Source: TPersistent); override;
     // Internal Dataset usage
     procedure   RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil); override;
     procedure   UnRegisterClient(Client: TObject); override;
     function		AllocConnection: pointer;
     procedure	FreeConnection(var Value: pointer);
     // End-users usage
     procedure   Connect;
     procedure   Disconnect;
     function    CreateDatabase(const AExecSQL: boolean=False): string; overload;
    	procedure 	CreateDatabase(Value: string; Conn: pointer =nil); overload;
		function 	SelectDatabase(Value: string; Conn: pointer = nil): boolean;
    	procedure 	DropDatabase(Value: string; Conn: pointer = nil);
     function    ExecSQL(SQL: string): boolean;
		function 	ExecSQLBatch(SQL: TStrings): boolean;
		function  	ConnectionDatabase(Conn: pointer = nil): string;
		procedure 	GetDatabaseNames(List: TStrings);
		procedure 	GetTableNames(const DatabaseName: string; List: TStrings; const Conn: pointer = nil);
     procedure 	GetFieldNames(const DatabaseName, TableName: string; List: TStrings);
		function 	EscapeStr(const Value: string): string;
     function		FormatIdentifier(const Value: string=''): string;
     function		GetLock(const Value: string = 'MyLock'; TimeOut: integer = 0): integer;
     function		ReleaseLock(const Value: string = 'MyLock'): integer;
     function		Ping: boolean;
     function		Dataset(const AName: string='';const Table: string='';AutoOpen: boolean=False; const Master: string=''; const Condition: string=''): TDataset;
     function		DatasetFrom(const SQL: string='';const AName: string='';AutoOpen: boolean=True; const Master: string=''; const Condition: string=''): TDataset;
		procedure 	FreeDataset(const AName: string='');

     property    Driver: TMySQLBase read GetDriver write SetDriver;
     property    Connection: pointer read FConnection;
  published
     // ReadOnly
     property    ClientVersion: string read GetClientVersion;
     property    ServerVersion: string read GetServerVersion;
     property    ClientVer: integer read GetClientVer;
     property    ServerVer: integer read GetServerVer;
     // Full Access
     property DriverKind: TMySQLDriverType read FDriverType write SetDriverType default {$IFDEF MYSQLDIRECT}dtDirect{$ELSE}dtLibrary{$ENDIF};
     property Protocol: TMySQLProtocolType read FProtocolType write SetProtocolType default ptTcp;
     property DriverProperties: TMySQLBase read GetDriver write SetDriver;
     property Connected default False;
  	property	DatabaseName: string read FDBName write SetDatabaseName;
     property Host: string read GetHost write SetHost;
     property Port: word read GetPort write SetPort default 3306;
    	property LoginPrompt default False;
     property UserName: string read GetUserName write SetUsername;
     property Password: string read GetPassword write SetPassword;
     property Params: TStrings read FParams write SetParams;
     property Compression: boolean read GetCompression write SetCompression default False;
     property Options: TMySQLServerOptions read GetOptions write SetOptions default [coInteractive,coTransactions,coProtocol41];
  	property AfterConnect;
  	property AfterDisconnect;
  	property BeforeConnect;
  	property BeforeDisconnect;
  	property OnLogin: TMySQLServerLoginEvent read FOnLogin write FOnLogin;
  end;

implementation
uses
  MySQLStrUtils,MySQLDataset;

//****************************************************
// 					TMySQL Server
//****************************************************
constructor TMySQLServer.Create(AOwner: TComponent);
begin
  FDBName := '';
  LoginPrompt := False;
  FConOptions := [coInteractive,coTransactions,coProtocol41];
  FHost := 'localhost';
  FPort := 3306;
  FUserName := 'root';
  FPassword := '';
  FParams := TStringList.Create;
  FOwnDatasets := TStringList.Create;
  FDriver := {$IFDEF MYSQLDIRECT}TMySQLDirect.Create(ReadIniSection(Params.Text,'direct',''));
             {$ELSE}TMySQLLibrary.Create(ReadIniSection(Params.Text,'client',''));{$ENDIF}
  FDriverType := {$IFDEF MYSQLDIRECT}dtDirect{$ELSE}dtLibrary{$ENDIF};
  FProtocolType := ptTcp;
	inherited Create(AOwner);
end;

destructor TMySQLServer.Destroy;
begin
  try
     Close;
  finally
     DisconnectClients;
     inherited;
     while FOwnDatasets.Count>0 do FreeDataset(FOwnDatasets[0]);
     FreeAndNil(FOwnDatasets);
     if Assigned(FDriver) then FreeAndNil(FDriver);
     FreeAndNil(FParams);
  end;
end;

procedure TMySQLServer.Assign(Source: TPersistent);
begin
  if (Source is TMySQLServer) then begin
     Connected := False;
     LoginPrompt := TMySQLServer(Source).LoginPrompt;
     Options := TMySQLServer(Source).Options;
     Params.Text := TMySQLServer(Source).Params.Text;
     DriverKind := TMySQLServer(Source).DriverKind;
     if DriverKind in [dtLibrary{$IFDEF MYSQLEMBEDDED},dtEmbedded{$ENDIF}] then
        TMySQLLibrary(Driver).ClientDLL := TMySQLLibrary(TMySQLServer(Source).Driver).ClientDLL;
     Host := TMySQLServer(Source).Host;
     Port := TMySQLServer(Source).Port;
     UserName := TMySQLServer(Source).Username;
     Password := TMySQLServer(Source).Password;
     DatabaseName := TMySQLServer(Source).DatabaseName;
  end else inherited Assign(Source);
end;


procedure TMySQLServer.DisconnectClients;
begin
  while FOwnDatasets.Count>0 do FreeDataset(FOwnDatasets[0]);
  while DatasetCount>0 do TMySQLDatasetBase(Datasets[0]).Server := nil;
end;

procedure TMySQLServer.CloseClients;
var
  i: integer;
begin
  for i := 0 to FOwnDatasets.Count-1 do TMySQLDatasetBase(FOwnDatasets.Objects[i]).Close;
  for i := 0 to DatasetCount-1 do TMySQLDatasetBase(Datasets[0]).Close;
end;

procedure TMySQLServer.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
end;

procedure TMySQLServer.Loaded;
begin
  inherited;
  try
     try
        if StreamedConnected then SetConnected(True);
     except
        on E: Exception do if csDesigning in ComponentState then ShowException(E, ExceptAddr)
        else raise;
     end;
  finally
     StreamedConnected := False;
  end;
end;

procedure TMySQLServer.RegisterClient(Client: TObject; Event: TConnectChangeEvent = nil);
begin
	inherited;
end;

procedure TMySQLServer.UnRegisterClient(Client: TObject);
begin