udamysqldriver.pas

MYSQL 连接控件 MYSQL 连接控件

unit uDAMYSQLDriver;
{----------------------------------------------------------------------------}
{ Data Abstract Library - Driver Library
{
{ compiler: Delphi 6 and up
{ platform: Win32
{
{ (c)opyright SciBit. all rights reserved.
{
{ Using this code requires a valid license of the Data Abstract
{ which can be obtained at http://www.remobjects.com.
{----------------------------------------------------------------------------}

{$IFDEF MSWINDOWS}
{$I ..\DataAbstract.inc}
{$ENDIF MSWINDOWS}
{$IFDEF LINUX}
{$I ../DataAbstract.inc}
{$ENDIF LINUX}

{.$DEFINE DEBUG}

interface
uses DB, SysUtils, Classes, uDAEngine, uDAInterfaces, uROClasses, uDAUtils,
     MySQLServer,MySQLDataset;

{$R DataAbstract_MySQLDriver_Glyphs.res}
type
  { TDAMySQLDriverReference }
  TDAMySQLDriverReference = class(TDADriverReference)
  end;

  { TDAMySQLDriver }
  TDAMySQLDriver = class(TDAEDriver)
  protected
    function GetConnectionClass: TDAEConnectionClass; override;
    // IDADriver
    function GetDriverID: string; override;
    function GetDescription: string; override;
    function GetAvailableDriverOptions: TDAAvailableDriverOptions; override;
    function GetDefaultCustomParameters: string; override;
  public
  end;

  { TDAMySQLConnection }
  TDAMySQLConnection = class(TDAEConnection)
  private
    fServer: TMySQLServer;
    fInTransaction: boolean; // Basically a dummy
  protected
    // IDAConnection
    function CreateCustomConnection: TCustomConnection; override;
    function CreateMacroProcessor: TDASQLMacroProcessor; override;
    function GetDatasetClass: TDAEDatasetClass; override;

    function DoBeginTransaction: integer; override;
    procedure DoCommitTransaction; override;
    procedure DoRollbackTransaction; override;
    function DoGetInTransaction: boolean; override;

    procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser;aConnectionObject: TCustomConnection); override;
    procedure DoGetTableNames(out List: IROStrings); override;
    procedure DoGetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection); override;
    procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;

    function QuoteIdentifierIfNeeded(const iIdentifier: string): string; override;
    // IDAUseGenerators
    function DoGetLastAutoInc(const GeneratorName: string): integer; override;
  public
  end;

  { TDAEMySQLDataset }
  TDAEMySQLDataset = class(TDAEDataset)
     procedure LogSQL(ASQL: string);
     procedure DoOnExecSQL(Dataset: TMySQLDatasetBase; var SQL: string; var Continue: boolean);
  protected
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;
    procedure DoPrepare(Value: boolean); override;
    function DoGetSQL: string; override;
    procedure DoSetSQL(const Value: string); override;
    function DoExecute: integer; override;
  public
    procedure Refresh;
  end;

  { TMySQLMacroProcessor }
  TMySQLMacroProcessor = class(TDASQLMacroProcessor)
    function DateTime(Sender: TObject; const Parameters: array of string): string; override;

    function AddTime(Sender: TObject; const Parameters: array of string): string; override;

    function Length(Sender: TObject; const Parameters: array of string): string; override;
    function LowerCase(Sender: TObject; const Parameters: array of string): string; override;
    function UpperCase(Sender: TObject; const Parameters: array of string): string; override;
    function TrimLeft(Sender: TObject; const Parameters: array of string): string; override;
    function TrimRight(Sender: TObject; const Parameters: array of string): string; override;
    function Copy(Sender: TObject; const Parameters: array of string): string; override;
    function Nolock(Sender: TObject; const Parameters: array of string): string; override;

  public
    constructor Create;
  end;


procedure Register;

function GetDriverObject: IDADriver; stdcall;


implementation
uses uDADriverManager, uDARes;

var
  _driver: TDAEDriver = nil;

procedure Register;
begin
  RegisterComponents(DAPalettePageName, [TDAMySQLDriver]);
end;

function GetDriverObject: IDADriver;
begin
  if (_driver = nil) then _driver := TDAMySQLDriver.Create(nil);
  result := _driver;
end;

{ TDAMySQLDriver }

function TDAMySQLDriver.GetAvailableDriverOptions: TDAAvailableDriverOptions;
begin
  result := [doServerName, doDatabaseName, doLogin, doCustom];
//  result := [doDatabaseName];
end;

function TDAMySQLDriver.GetDefaultCustomParameters: string;
begin
  Result := 'MySQL?Server=localhost;Port=3306;Database=mysql;UserID=root;Password=';
end;

function TDAMySQLDriver.GetConnectionClass: TDAEConnectionClass;
begin
  result := TDAMySQLConnection;
end;

function TDAMySQLDriver.GetDescription: string;
begin
  result := 'Data Abstract MySQL Driver';
end;

function TDAMySQLDriver.GetDriverID: string;
begin
  result := 'MySQL';
end;

{ TDAMySQLConnection }
function TDAMySQLConnection.CreateCustomConnection: TCustomConnection;
begin
  fServer := TMySQLServer.Create(nil);
  fServer.LoginPrompt := FALSE;
  result := fServer;
end;

function TDAMySQLConnection.CreateMacroProcessor: TDASQLMacroProcessor;
begin
  result := TMySQLMacroProcessor.Create;
end;

function TDAMySQLConnection.GetDatasetClass: TDAEDatasetClass;
begin
  result := TDAEMySQLDataset;
end;

function TDAMySQLConnection.DoBeginTransaction: integer;
begin
  fInTransaction := TRUE;
  result := 0;
end;

procedure TDAMySQLConnection.DoCommitTransaction;
begin
  fInTransaction := FALSE;
end;

function TDAMySQLConnection.DoGetInTransaction: boolean;
begin
  result := fInTransaction;
end;

procedure TDAMySQLConnection.DoRollbackTransaction;
begin
  fInTransaction := FALSE
end;

procedure TDAMySQLConnection.DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
begin
  inherited;
  with aConnStrParser do begin
    if Server<>'' then fServer.Host := Server;
    if AuxParams['Port'] <> '' then fServer.Port := StrToIntDef(AuxParams['Port'],3306);
    if (Self.UserID <> '') then fServer.Username := Self.UserID
    else fServer.Username := UserID;
    if (Self.Password <> '') then fServer.Password := Self.Password
    else fServer.Password := Password;
    if Database <> '' then fServer.DatabaseName := Database
    else if AuxParams['Database'] <> '' then fServer.DatabaseName := AuxParams['Database']
    else fServer.DatabaseName := AuxParams['DB'];
  end;
end;

function TDAMySQLConnection.QuoteIdentifierIfNeeded(const iIdentifier: string): string;
begin
  Result := fServer.FormatIdentifier(iIdentifier);
end;

procedure TDAMySQLConnection.DoGetTableNames(out List: IROStrings);
begin
  List := TROStrings.Create;
  fServer.GetTableNames(fServer.DatabaseName,List.Strings);
end;

procedure TDAMySQLConnection.DoGetQueryFields(const aSQL: string; aParamsIfNeeded: TDAParamCollection; out Fields: TDAFieldCollection);
var
  qry: IDADataset;
  i: integer;
begin
  Fields := TDAFieldCollection.Create(nil);
  qry := GetDatasetClass.Create(Self);
  try
    qry.SQL := aSQL;
    TMySQLDataset(qry.Dataset).Options := [doShareConnection,doMacrosEnabled,doMacroCheck,do2KStrToMemo,doRetrieveIndexDefs,doUseCursor];
    if assigned(aParamsIfNeeded) then
      qry.Params.AssignParamCollection(aParamsIfNeeded);
    qry.Open;
    Fields.Assign(qry.Fields);
    for i := 0 to qry.Fields.Count-1 do
     Fields[i].DictionaryEntry := TFieldInfo(TMySQLDataset(qry.Dataset).MySQLFields.Objects[i]).FieldTableOriginal
  finally
    qry := nil;
  end;
end;

procedure TDAMySQLConnection.DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection);
var
  qry: IDADataset;
  i: integer;
begin
  Fields := TDAFieldCollection.Create(nil);
  qry := GetDatasetClass.Create(Self);
  try
    qry.SQL := 'SELECT * FROM ' + QuoteIdentifierIfNeeded(aTableName) + ' WHERE 1=0';
    TMySQLDataset(qry.Dataset).Options := [doShareConnection,doMacrosEnabled,doMacroCheck,do2KStrToMemo,doRetrieveIndexDefs,doUseCursor];
    qry.Open;
    Fields.Assign(qry.Fields);
    for i := 0 to qry.Fields.Count-1 do
     Fields[i].DictionaryEntry := TFieldInfo(TMySQLDataset(qry.Dataset).MySQLFields.Objects[i]).FieldTableOriginal
  finally
    qry := nil;
  end;
end;

function TDAMySQLConnection.DoGetLastAutoInc(const GeneratorName: string): integer;
var ds: IDADataset;
begin
  ds := NewDataset('SELECT LAST_INSERT_ID();');//, [GeneratorName]));
  ds.Open;
  result := StrToIntDef(ds.Fields[0].AsString,0);
end;

{ TDAEMySQLDataset }
procedure TDAEMySQLDataset.LogSQL(ASQL: string);
begin
{$IFDEF DEBUG}
  with TStringList.Create do
  try
     if FileExists('c:\sql.txt') then LoadFromFile('c:\sql.txt');
     Add(ASQL);
     SaveToFile('c:\sql.txt');
  finally
     Free
  end;
{$ENDIF}
end;

procedure TDAEMySQLDataset.DoOnExecSQL(Dataset: TMySQLDatasetBase; var SQL: string; var Continue: boolean);
begin
  LogSQL('ExecSQL: '+SQL+#13#10);
end;

function TDAEMySQLDataset.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
  result := TMySQLDataset.Create(nil);
  TMySQLDataset(result).OnExecSQL := DoOnExecSQL;
  TMySQLDataset(result).Server := TDAMySQLConnection(aConnection).fServer;
  TMySQLDataset(result).TableName := GetLogicalName;
end;

procedure TDAEMySQLDataset.DoPrepare(Value: boolean);
begin
  // Nothing!
end;

function TDAEMySQLDataset.DoGetSQL: string;
begin
  result := TMySQLDataset(Dataset).RealSQL;
end;

procedure TDAEMySQLDataset.DoSetSQL(const Value: string);
begin
  LogSQL('DoSetSQL: '+Value+#13#10);
  TMySQLDataset(Dataset).SQL.Text := Value;
end;

function TDAEMySQLDataset.DoExecute: integer;
begin
  result := inherited DoExecute;
  result := StrToIntDef(TMySQLDataset(Dataset).AffectedRows,0);
end;

procedure TDAEMySQLDataset.Refresh;
begin
  Dataset.Refresh;
end;


{ TMySQLMacroProcessor }

constructor TMySQLMacroProcessor.Create;
begin
  inherited Create('YYYY-MM-DD', 'YYYY-MM-DD HH:MM:SS.ZZZ', FALSE);
end;

function TMySQLMacroProcessor.AddTime(Sender: TObject; const Parameters: array of string): string;
begin
  result := Format('DATE_ADD(''%s'', INTERVAL %s %s)', [Parameters[0], Parameters[1], Parameters[2]]);
end;

function TMySQLMacroProcessor.Copy(Sender: TObject; const Parameters: array of string): string;
begin
  result := Format('SUBSTRING(%s FROM %s FOR %s)', [Parameters[0], Parameters[1], Parameters[2]]);
end;

function TMySQLMacroProcessor.DateTime(Sender: TObject; const Parameters: array of string): string;
begin
  result := 'CURRENT_TIMESTAMP'
end;

function TMySQLMacroProcessor.Length(Sender: TObject;
  const Parameters: array of string): string;
begin
  result := Format('LENGTH(%s)', [Parameters[0]]);
end;

function TMySQLMacroProcessor.LowerCase(Sender: TObject;
  const Parameters: array of string): string;
begin
  result := Format('LOWER(%s)', [Parameters[0]]);
end;

function TMySQLMacroProcessor.TrimLeft(Sender: TObject; const Parameters: array of string): string;
begin
  result := Format('TRIM(LEADING '' '' FROM %s)', [Parameters[0]]);
end;

function TMySQLMacroProcessor.TrimRight(Sender: TObject; const Parameters: array of string): string;
begin
  result := Format('TRIM(TRAILING '' '' FROM %s)', [Parameters[0]]);
end;

function TMySQLMacroProcessor.UpperCase(Sender: TObject;
  const Parameters: array of string): string;
begin
  result := Format('UPPER(%s)', [Parameters[0]]);
end;

function TMySQLMacroProcessor.Nolock(Sender: TObject; const Parameters: array of string): string;
begin
  result := '';
end;



exports
  GetDriverObject name func_GetDriverObject;

initialization
  _driver := nil;
  RegisterDriverProc(GetDriverObject);

finalization
  UnregisterDriverProc(GetDriverObject);
  FreeAndNIL(_driver);

end.