damysql.pas

MYSQL 连接控件 MYSQL 连接控件

{******************************************************************************}
{                                                                              }
{           ReportBuilder Data Access Developement Environment (DADE)          }
{                                                                              }
{                  Modified by SciBit   [e-mail]                        }
{                                                                              }
{******************************************************************************}

unit daMySQL;

interface

uses Classes, SysUtils, Forms, ExtCtrls,  DB,
     ppClass, ppComm, ppDBPipe, ppDB, ppClasUt, ppTypes, daSQL,
//     daLinkBroker, ppUtils,daMetaData,
     daDB, daQueryDataView, daDataView, daPreviewDataDlg,
     MySQLServer, MySQLDataset;

type
 { TppChildMySQLPipeline }
  TppChildMySQLPipeline = class(TppChildDBPipeline)
  end; {class, TppChildMySQLPipeline}

  { TdaChildMySQLQuery }
  TdaChildMySQLQuery = class(TMySQLDataset)
    public
      function HasParent: Boolean; override;
    end;  {class, TdaChildMySQLQuery}

  { TdaChildMySQLTable }
  TdaChildMySQLTable = class(TMySQLDataset)
    public
      function HasParent: Boolean; override;
    end;  {class, TdaChildMySQLTable}

  { TdaMySQLSession }
  TdaMySQLSession = class(TdaSession)
    private
      FReservedWords: TStringList;
      FFunctions: TStringList;
      FMySQLDatabaseList: TStringList;

      procedure AddDatabase(aDatabase: TComponent);
      procedure BuildReservedWordList;
      procedure BuildFunctionList;

    protected
      procedure SetDataOwner(aDataOwner: TComponent); override;

    public
      constructor Create(aComponent: TComponent); override;
      destructor Destroy; override;

      class function ClassDescription: String; override;
      class function DataSetClass: TdaDataSetClass; override;
      class function DatabaseClass: TComponentClass; override;

      function  ContainsSQLFunctionCall(const aString: String; aDatabaseType: TppDatabaseType): Boolean; override;
      function  DefaultSQLType(aDatabaseType: TppDatabaseType): TppSQLType; override;
      procedure GetDatabaseNames(aList: TStrings); override;
      function  GetMySQLDatabaseForName(const aDatabaseName: string): TMySQLServer;
      function  GetDatabaseType(const aDatabaseName: String): TppDatabaseType; override;
      procedure GetTableNames(const aDatabaseName: String; aList: TStrings); override;
      function  IsSQLReservedWord(const aString: String; aDatabaseType: TppDatabaseType): Boolean; override;
      function  ValidDatabaseTypes: TppDatabaseTypes; override;
      function  GetSearchCriteriaDateFormat(aDatabaseType: TppDatabaseType; const aDatabaseName: String): String; override;
      function  GetSearchCriteriaTimeFormat(aDatabaseType: TppDatabaseType; const aDatabaseName: String): String; override;

  end; {class, TdaMySQLSession}

  { TdaMySQLDataset }
  TdaMySQLDataset = class(TdaDataSet)
    private
      FQuery: TMySQLDataset;
      function GetQuery: TMySQLDataset;
    protected
      procedure BuildFieldList; override;
      function  GetActive: Boolean; override;
      function  GetMySQLDatabaseForName(const aDatabaseName: string): TMySQLServer;
      procedure SetActive(Value: Boolean); override;
      procedure SetDatabaseName(const aDatabaseName: String); override;
      procedure SetDataName(const aDataName: String); override;

      property Query: TMySQLDataset read GetQuery;
    public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;

      class function ClassDescription: String; override;

      procedure GetFieldNamesForSQL(aList: TStrings; aSQL: TStrings); override;
      procedure GetFieldsForSQL(aList: TList; aSQL: TStrings); override;
  end; {class, TdaMySQLDataset}

  { TdaMySQLQueryDataView }
  TdaMySQLQueryDataView = class(TdaQueryDataView)
    private
      FDataSource: TppChildDataSource;
      FQuery: TdaChildMySQLQuery;
    protected
      procedure Loaded; override;
      function  GetMySQLDatabaseForName(const aDatabaseName: string): TMySQLServer;
      procedure SQLChanged; override;
    public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;

      class function PreviewFormClass: TFormClass; override;
      class function SessionClass: TClass; override;

      procedure Init; override;
      procedure ConnectPipelinesToData; override;
    published
      property DataSource: TppChildDataSource read FDataSource;
  end; {class, TdaMySQLQueryDataView}

  {Delphi design time registration}
  procedure Register;

implementation
uses MySQLStrUtils;
{******************************************************************************
 *
 ** R E G I S T E R
 *
{******************************************************************************}
procedure Register;
begin
  {MySQL DataAccess Components}
  RegisterNoIcon([TdaChildMySQLQuery, TdaChildMySQLTable]);

  {MySQL DataViews}
  RegisterNoIcon([TdaMySQLQueryDataView]);
end;

{******************************************************************************
 *
 ** C H I L D   MySQL  D A T A   A C C E S S   C O M P O N  E N T S
 *
{******************************************************************************}

{------------------------------------------------------------------------------}
{ TdaChildMySQLQuery.HasParent }

function TdaChildMySQLQuery.HasParent: Boolean;
begin
  Result := True;
end; {function, HasParent}

{------------------------------------------------------------------------------}
{ TdaChildMySQLTable.HasParent }

function TdaChildMySQLTable.HasParent: Boolean;
begin
  Result := True;
end; {function, HasParent}

{******************************************************************************
 *
 ** MySQL   S E S S I O N
 *
{******************************************************************************}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.ClassDescription }

constructor TdaMySQLSession.Create(aComponent: TComponent);
begin

  FFunctions := TStringList.Create;
  FReservedWords := TStringList.Create;
	FMySQLDatabaseList := TStringList.Create;
  inherited Create(aComponent);

end; {constructor, Create}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.ClassDescription }

destructor TdaMySQLSession.Destroy;
begin


  inherited Destroy;
  FFunctions.Free;
  FReservedWords.Free;
  FMySQLDatabaseList.Free;
end; {destructor, Destroy}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.ClassDescription }

class function TdaMySQLSession.ClassDescription: String;
begin
  Result := 'MySQLSession';
end; {class function, ClassDescription}


{------------------------------------------------------------------------------}
{ TdaMySQLSession.DataSetClass }

class function TdaMySQLSession.DataSetClass: TdaDataSetClass;
begin
  Result := TdaMySQLDataset;
end; {class function, DataSetClass}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.DatabaseClass }

class function TdaMySQLSession.DatabaseClass: TComponentClass;
begin
  Result := TMySQLServer;
end;

{------------------------------------------------------------------------------}
{ TdaMySQLSession.GetTableNames }

procedure TdaMySQLSession.GetTableNames(const aDatabaseName: String; aList: TStrings);
var
  lDatabase: TMySQLServer;
begin
  {get the database}
  lDatabase := GetMySQLDatabaseForName(aDatabaseName);

  {connection must be active to get table names}
  if not lDatabase.Connected then lDatabase.Connected := True;

  if lDatabase.Connected then lDatabase.GetTableNames(lDatabase.DatabaseName, alist);

end; {procedure, GetTableNames}


{------------------------------------------------------------------------------}
{ TdaMySQLSession.AddDatabase }

procedure TdaMySQLSession.AddDatabase(aDatabase: TComponent);
begin
  if FMySQLDatabaseList.IndexOf(aDatabase.Name) < 0 then FMySQLDatabaseList.AddObject(aDatabase.Name,aDatabase);
end; {procedure, AddDatabase}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.GetDatabaseNames }

procedure TdaMySQLSession.GetDatabaseNames(aList: TStrings);
var
  liIndex: Integer;
begin
  if Assigned(DataOwner) then begin
  	aList.Clear;
  	for liIndex := 0 to DataOwner.ComponentCount-1 do
     	if (DataOwner.Components[liIndex] is DatabaseClass) and (aList.IndexOf(DataOwner.Components[liIndex].Name)<0) then
       		aList.AddObject(DataOwner.Components[liIndex].Name, DataOwner.Components[liIndex]);
  end;
end; {procedure, GetDatabaseNames}

function  TdaMySQLSession.GetMySQLDatabaseForName(const aDatabaseName: string): TMySQLServer;
begin
	if FMySQLDatabaseList.IndexOf(aDatabaseName)>-1 then
		Result := TMySQLServer(FMySQLDatabaseList.Objects[FMySQLDatabaseList.IndexOf(aDatabaseName)])
  else
  	if FMySQLDatabaseList.Count>0 then
     	Result := TMySQLServer(FMySQLDatabaseList.Objects[0])
     else
     	Result := nil
end;

{------------------------------------------------------------------------------}
{ TdaMySQLSession.SetDataOwner }

procedure TdaMySQLSession.SetDataOwner(aDataOwner: TComponent);
begin
  inherited SetDataOwner(aDataOwner);
  GetDatabaseNames(FMySQLDatabaseList);
end; {procedure, SetDataOwner}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.ValidDatabaseTypes }

function TdaMySQLSession.ValidDatabaseTypes: TppDatabaseTypes;
begin
  Result := [dtMySQL];
end; {procedure, ValidDatabaseTypes}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.GetDatabaseType }

function TdaMySQLSession.GetDatabaseType(const aDatabaseName: String): TppDatabaseType;
begin
  Result := dtMySQL;
end; {function, GetDatabaseType}


{------------------------------------------------------------------------------}
{ TdaMySQLSession.DefaultSQLType }

function TdaMySQLSession.DefaultSQLType(aDatabaseType: TppDatabaseType): TppSQLType;
begin
  Result := sqSQL2;
end; {function, DefaultSQLType}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.IsSQLReservedWord }

function TdaMySQLSession.IsSQLReservedWord(const aString: String; aDatabaseType: TppDatabaseType): Boolean;
begin

  if (FReservedWords.Count = 0) then
    BuildReservedWordList;

  Result := (FReservedWords.IndexOf(aString) <> -1);

end; {procedure, IsSQLReservedWord}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.BuildReservedWordList }

procedure TdaMySQLSession.BuildReservedWordList;
begin
  FReservedWords.CommaText := 'action,add,aggregate,all,alter,'+
  'after,and,as,asc,avg,avg_row_length,'+
  'auto_increment,between,bigint,bit,binary,blob,bool,both,by,'+
	'cascade,case,char,character,change,'+
  'check,checksum,column,columns,comment,'+
  'constraint,create,cross,current_date,current_time,current_timestamp,'+
	'data,database,databases,date,datetime,'+
  'day,day_hour,day_minute,day_second,'+
  'dayofmonth,dayofweek,dayofyear,dec,decimal,default,delayed,'+
	'delay_key_write,delete,desc,describe,'+
  'distinct,distinctrow,double,drop,end,'+
  'else,escape,escaped,enclosed,enum,explain,'+
  'exists,fields,file,first,float,'+
	'float4,float8,flush,foreign,'+
	'from,for,full,function,'+
	'global,grant,grants,group,'+
	'having,heap,high_priority,hour,'+
	'hour_minute,hour_second,hosts,identified,'+
	'ignore,in,index,infile,'+
	'inner,insert,insert_id,int,'+
	'integer,interval,int1,int2,'+
	'int3,int4,int8,into,'+
	'if,is,isam,join,'+
	'key,keys,kill,last_insert_id,'+
	'leading,left,length,like,'+
	'lines,limit,load,local,'+
	'lock,logs,long,longblob,'+
	'longtext,low_priority,max,max_rows,'+
	'match,mediumblob,mediumtext,mediumint,'+
	'middleint,min_rows,minute,minute_second,'+
	'modify,month,monthname,myisam,'+
	'natural,numeric,no,not,'+
	'null,on,optimize,option,'+
	'optionally,or,order,outer,'+
	'outfile,pack_keys,partial,password,'+
	'precision,primary,procedure,process,'+
	'processlist,privileges,read,real,'+
	'references,reload,regexp,rename,'+
	'replace,restrict,returns,revoke,'+
	'rlike,row,rows,second,'+
	'select,set,show,shutdown,'+
	'smallint,soname,sql_big_tables,sql_big_selects,'+
	'sql_low_priority_updates,sql_log_off,sql_log_update,sql_select_limit,'+
	'sql_small_result,sql_big_result,sql_warnings,straight_join,'+
	'starting,status,string,table,'+
	'tables,temporary,terminated,text,'+
	'then,time,timestamp,tinyblob,'+
	'tinytext,tinyint,trailing,to,'+
	'type,use,using,unique,'+
	'unlock,unsigned,update,usage,'+
	'values,varchar,variables,varying,'+
	'varbinary,with,write,when,'+
	'where,year,year_month,zerofill';
end; {procedure, BuildReservedWordList}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.ContainsSQLFunctionCall }

function TdaMySQLSession.ContainsSQLFunctionCall(const aString: String; aDatabaseType: TppDatabaseType): Boolean;
var
  liIndex: Integer;
  liPosition: Integer;
  lsFunction: String;
begin

  if (FFunctions.Count = 0) then
    BuildFunctionList;

  liIndex := 0;
  liPosition := 0;
  lsFunction := UpperCase(aString);

  while (liIndex < FFunctions.Count) and (liPosition = 0) do
    begin
      liPosition := Pos(FFunctions[liIndex], lsFunction);

      Inc(liIndex);
    end;

  Result := (liPosition <> 0);