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 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;
      FServer: TMySQLServer;
      function GetQuery: TMySQLDataset;
    protected
      procedure BuildFieldList; override;
      function  GetActive: Boolean; override;
      function  GetMySQLDatabaseForName(const aDatabaseName: string=''): TMySQLServer;
      procedure SetActive(Value: Boolean); override;
      procedure SetDatabase(aDatabase: TComponent); 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
      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 MySQLDrivers;
{******************************************************************************
 *
 ** 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.GetDatabaseNames }

procedure TdaMySQLSession.GetDatabaseNames(aList: TStrings);
var
  liIndex: Integer;
begin
  aList.Clear;
  daGetDatabaseObjectsFromOwner(TdaSessionClass(Self.ClassType), aList, DataOwner);
  for liIndex := 0 to aList.Count-1 do
     if Assigned(aList.Objects[liIndex]) and (FMySQLDatabaseList.IndexOf(TComponent(aList.Objects[liIndex]).Name)<0) then
        FMySQLDatabaseList.AddObject(TComponent(aList.Objects[liIndex]).Name, TComponent(aList.Objects[liIndex]));
end; {procedure, GetDatabaseNames}

function  TdaMySQLSession.GetMySQLDatabaseForName(const aDatabaseName: string): TMySQLServer;
begin
  Result := nil;
	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
     	Exception.Create('No TMySQLServer called "'+aDatabaseName+'".');
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
  Result := Assigned(FMySQLDatabaseList.Objects[0]) and TMySQLServer(FMySQLDatabaseList.Objects[0]).Driver.IsReservedWord(aString);
end; {procedure, IsSQLReservedWord}

{------------------------------------------------------------------------------}
{ 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);

end; {procedure, ContainsSQLFunctionCall}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.BuildFunctionList }

procedure TdaMySQLSession.BuildFunctionList;
begin
  {aggregate functions}
  FFunctions.CommaText := 'ABS(,ACOS(,ADDDATE(,ASCII(,ASIN(,ATAN(,ATAN(,AVG(,BENCHMARK(,BIN(,BIT_AND(,BIT_COUNT(,BIT_OR(,CEILING(,CHAR(,CHAR_LENGTH(,CHARACTER_LENGTH(,'+
	'COALESCE(,CONCAT(,CONV(,COS(,COT(,COUNT(,CURDATE(,CURRENT_DATE,CURRENT_TIME,CURRENT_TIMESTAMP,CURTIME(,DATABASE(,DATE_ADD(,DATE_FORMAT(,'+
	'DATE_SUB(,DAYNAME(,DAYOFMONTH(,DAYOFWEEK(,DAYOFYEAR(,DECODE(,DEGREES(,ELT(,ENCODE(,ENCRYPT(,EXP(,EXPORT_SET(,EXTRACT(,FIELD(,'+
	'FIND_IN_SET(,FLOOR(,FORMAT(,FROM_DAYS(,FROM_UNIXTIME(,GET_LOCK(,GREATEST(,HEX(,HOUR(,IF(,IFNULL(,INSERT(,INSTR(,INTERVAL(,ISNULL(,LAST_INSERT_ID(,'+
	'LCASE(,LEAST(,LEFT(,LENGTH(,LOCATE(,LOG(,LOWER(,LPAD(,LTRIM(,MAKE_SET(,MAX(,MD(,MID(,MIN(,MINUTE(,MOD(,MONTH(,MONTHNAME(,NOW(,OCT(,OCTET_LENGTH(,ORD(,PASSWORD(,PERIOD_ADD(,'+
	'PERIOD_DIFF(,PI(,POSITION(,POW(,POWER(,QUARTER(,RADIANS(,RAND(,RELEASE_LOCK(,REPEAT(,REPLACE(,REVERSE(,RIGHT(,ROUND(,RPAD(,RTRIM(,SEC_TO_TIME(,'+
	'SECOND(,SESSION_USER(,SIGN(,SIN(,SOUNDEX(,SPACE(,SQRT(,STD(,STDDEV(,STRCMP(,SUBDATE(,SUBSTRING(,SUBSTRING_INDEX(,SUM(,SYSDATE(,SYSTEM_USER(,'+
	'TAN(,TIME_FORMAT(,TIME_TO_SEC(,TO_DAYS(,TRIM(,TRUNCATE(,UCASE(,UNIX_TIMESTAMP(,UPPER(,USER(,VERSION(,WEEK(,WEEKDAY(,YEAR(';
end; {procedure, BuildFunctionList}

{------------------------------------------------------------------------------}
{ TdaMySQLSession.GetSearchCriteriaDateFormat }

function TdaMySQLSession.GetSearchCriteriaDateFormat(aDatabaseType: TppDatabaseType; const aDatabaseName: String): String;
begin
  Result := 'YYYY-MM-DD';
end; {function, GetSearchCriteriaDateFormat}