unit uDAMyDACDriver;

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

{$I ..\DataAbstract.inc}

{$R DataAbstract_MyDACDriver_Glyphs.res}
{.$DEFINE ENABLE_SQLMonitor}
{.$DEFINE MYSQL4Compatible}

interface

uses DB, Classes, uDAEngine, uDAInterfaces, {uDAADOInterfaces,} uROClasses, DBAccess, MyAccess,
  {$IFDEF ENABLE_SQLMonitor}DASQLMonitor, MySQLMonitor,{$ENDIF ENABLE_SQLMonitor} uROBinaryHelpers, uDAUtils, uDAMySQLInterfaces;

type { TDAMyDACDriver }
  TDAMyDACDriver = class(TDADriverReference)
  end;

     { TDAEADODriver }
  TDAEADODriver = class(TDAMySQLDriver)
  private
    {$IFDEF ENABLE_SQLMonitor}
    fMonitor: TMySQLMonitor;
    fTraceCallBack: TDALogTraceEvent;

    procedure OnMyDACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);
    {$ENDIF ENABLE_SQLMonitor}
  protected
    function GetConnectionClass: TDAEConnectionClass; override;
    {$IFDEF ENABLE_SQLMonitor}
    procedure DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); override;
    {$ENDIF ENABLE_SQLMonitor}
       // IDADriver
    function GetDriverID: string; override; safecall;
    function GetDescription: string; override; safecall;
    function GetDefaultCustomParameters: string; override; safecall;
    procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;
  end;

     { TDAEMyConnection }
  TDAEMyConnection = class(TDAMySQLConnection, IDAMySQLConnection,IDACanQueryDatabaseNames)
  private
    function GetMyConnection: TMyConnection;

  protected
    function GetTableSchema: string; override;
    function useUnicode:Boolean; override;

    function CreateCustomConnection: TCustomConnection; override;

    function GetDatasetClass: TDAEDatasetClass; override;
    function GetStoredProcedureClass: TDAEStoredProcedureClass; override;

    procedure DoApplyConnectionString(aConnStrParser: TDAConnectionStringParser;
      aConnectionObject: TCustomConnection); override;

    function DoBeginTransaction: integer; override;
    procedure DoCommitTransaction; override;
    procedure DoRollbackTransaction; override;
    function DoGetInTransaction: boolean; override;
    procedure DoGetTableNames(out List: IROStrings); override;
    procedure DoGetViewNames(out List: IROStrings); override;
    procedure DoGetStoredProcedureNames(out List: IROStrings); override;
    procedure DoGetForeignKeys(out ForeignKeys: TDADriverForeignKeyCollection); override;
    procedure DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection); override;
    function GetDatabaseNames: IROStrings;
    procedure DoGetTableFields(const aTableName: string; out Fields: TDAFieldCollection); override;
    property MyConnection: TMyConnection read GetMyConnection;
  public
  end;

     { TDAEMyQuery }
  TDAEMyQuery = class(TDAEDataset, IDAMustSetParams)
  private

  protected
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;

    function DoExecute: integer; override;
    function DoGetSQL: string; override;
    procedure DoSetSQL(const Value: string); override;
    procedure DoPrepare(Value: boolean); override;

       // IDAMustSetParams
    procedure SetParamValues(Params: TDAParamCollection); safecall;
    procedure GetParamValues(Params: TDAParamCollection); safecall;

  public
  end;

     { TDAEADOStoredProcedure }
  TDAEADOStoredProcedure = class(TDAEStoredProcedure, IDAMustSetParams)
  protected
    function CreateDataset(aConnection: TDAEConnection): TDataset; override;

    function GetStoredProcedureName: string; override;
    procedure SetStoredProcedureName(const Name: string); override;
    function Execute: integer; override;

       // IDAMustSetParams
    procedure SetParamValues(Params: TDAParamCollection); safecall;
    procedure GetParamValues(Params: TDAParamCollection); safecall;
  end;

procedure Register;

function GetDriverObject: IDADriver; stdcall;

implementation

uses
  SysUtils,Variants,
  uDADriverManager, uDARes;

var
  _driver: TDAEDriver = nil;

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

{$IFDEF DataAbstract_SchemaModelerOnly}
{$INCLUDE ..\DataAbstract_SchemaModelerOnly.inc}
{$ENDIF DataAbstract_SchemaModelerOnly}

function GetDriverObject: IDADriver;
begin
  {$IFDEF DataAbstract_SchemaModelerOnly}
  if not RunningInSchemaModeler then begin
    result := nil;
    exit;
  end;
  {$ENDIF}
  if (_driver = nil) then _driver := TDAEADODriver.Create(nil);
  result := _driver;
end;

{$IFDEF LATEST_MyDAC}
{$I uDACRLabsUtils.inc}
{$ENDIF LATEST_MyDAC}


{$I uDACRLabsUtils.inc}
{ TDAEMyConnection }

function TDAEMyConnection.DoBeginTransaction: integer;
begin
  MyConnection.StartTransaction;
  result := 0;
end;

procedure TDAEMyConnection.DoCommitTransaction;
begin
  MyConnection.Commit;
end;

function TDAEMyConnection.GetMyConnection: TMyConnection;
begin
  result := TMyConnection(inherited ConnectionObject);
end;

function TDAEMyConnection.CreateCustomConnection: TCustomConnection;
begin
  result := TMyConnection.Create(nil);
  TMyConnection(result).LoginPrompt := FALSE;
end;

function TDAEMyConnection.GetDatasetClass: TDAEDatasetClass;
begin
  result := TDAEMyQuery;
end;

function TDAEMyConnection.GetStoredProcedureClass: TDAEStoredProcedureClass;
begin
  result := TDAEADOStoredProcedure;
end;

procedure TDAEMyConnection.DoGetStoredProcedureNames(out List: IROStrings);
begin
  {$IFDEF MYSQL4Compatible}
  List := TROStrings.Create;
  MyConnection.GetStoredProcNames(List.Strings);
  {$ELSE}
  inherited DoGetStoredProcedureNames(List);
  {$ENDIF}
end;

procedure TDAEMyConnection.DoGetTableNames(out List: IROStrings);
begin
  {$IFDEF MYSQL4Compatible}
  List := TROStrings.Create;
  MyConnection.GetTableNames(List.Strings);
  {$ELSE}
  inherited DoGetTableNames(List);
  {$ENDIF MYSQL4Compatible}
end;

procedure TDAEMyConnection.DoRollbackTransaction;
begin
  MyConnection.Rollback;
end;

function TDAEMyConnection.DoGetInTransaction: boolean;
begin
  result := MyConnection.InTransaction
end;


procedure TDAEMyConnection.DoApplyConnectionString(
  aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
const
  stdMSSQL_ConnectionString = 'User ID=%s;Password=%s;Initial Catalog=%s;Data Source=%s';
var
  adoconn: string;
  i: integer;
  sName,sValue: string;
begin
  inherited;

  with aConnStrParser do begin
    adoconn := Format(stdMSSQL_ConnectionString, [UserID, Password, Database, Server]);

    MyConnection.Database := Database;

    MyConnection.Server := Server;

    if (Self.UserID <> '') then
      MyConnection.Username := Self.UserID
    else
      MyConnection.Username := UserID;

    if (Self.Password <> '') then
      MyConnection.Password := Self.Password
    else
      MyConnection.Password := Password;
    for i := 0 to AuxParamsCount -1 do
    begin
      sName := AuxParamNames[i];
      sValue := AuxParams[AuxParamNames[i]];
      if SameText('Port', sName) then MyConnection.Port:= StrToIntDef(sValue,3306);
      if SameText('useUnicode', sName) then MyConnection.Options.UseUnicode:=StrToBoolDef(sValue,False);
    end;
  end;
end;

function TDAEMyConnection.GetTableSchema: string;
begin
  Result:=MyConnection.Database;
end;

function TDAEMyConnection.useUnicode: Boolean;
begin
  Result:= GetMyConnection.Options.UseUnicode;
end;

function TDAEMyConnection.GetDatabaseNames: IROStrings;
begin
  {$IFDEF MYSQL4Compatible}
  Result := TROStrings.Create();
  MyConnection.GetDatabaseNames(Result.Strings);
  {$ELSE}
  Result := inherited GetDatabaseNames;
  {$ENDIF MYSQL4Compatible}
end;

procedure TDAEMyConnection.DoGetViewNames(out List: IROStrings);
begin
  {$IFDEF MYSQL4Compatible}
  List := TROStrings.Create;
  GetTablesList(MyConnection, List.Strings);
  {$ELSE}
  inherited DoGetViewNames(List);
  {$ENDIF MYSQL4Compatible}
end;

procedure TDAEMyConnection.DoGetForeignKeys(
  out ForeignKeys: TDADriverForeignKeyCollection);
begin
  {$IFDEF MYSQL4Compatible}
  ForeignKeys := TDADriverForeignKeyCollection.Create(nil);
  {$ELSE}
  inherited DoGetForeignKeys(ForeignKeys);
  {$ENDIF MYSQL4Compatible}
end;

procedure TDAEMyConnection.DoGetStoredProcedureParams(
  const aStoredProcedureName: string; out Params: TDAParamCollection);
{$IFDEF MYSQL4Compatible}
var
  cmd: IDASQLCommand;
  {$ENDIF MYSQL4Compatible}
begin
  {$IFDEF MYSQL4Compatible}
  cmd := NewCommand(aStoredProcedureName, stStoredProcedure);
  cmd.RefreshParams;
  Params := TDAParamCollection.Create(nil);
  Params.AssignParamCollection(cmd.Params);
  {$ELSE}
  inherited DoGetStoredProcedureParams(aStoredProcedureName, Params);
  {$ENDIF MYSQL4Compatible}
end;

procedure TDAEMyConnection.DoGetTableFields(const aTableName: string;
  out Fields: TDAFieldCollection);
{$IFDEF MYSQL4Compatible}
  var
  qry: IDADataset;
{$ENDIF}
begin
  {$IFDEF MYSQL4Compatible}
  Fields := TDAFieldCollection.Create(nil);
  qry := GetDatasetClass.Create(Self);
  try
    qry.SQL := 'SELECT * FROM ' + QuoteIdentifierIfNeeded(aTableName) + ' WHERE 1=0';
    qry.Open;
    Fields.Assign(qry.Fields);
  finally
    qry := nil;
  end;
  {$ELSE}
  inherited DoGetTableFields(aTableName, Fields);
  {$ENDIF MYSQL4Compatible}
end;

{ TDAEADODriver }

procedure TDAEADODriver.GetAuxParams(const AuxDriver: string;
  out List: IROStrings);
begin
  inherited;
  List.Add('useUnicode=(True;False)');
end;

function TDAEADODriver.GetConnectionClass: TDAEConnectionClass;
begin
  result := TDAEMyConnection;
end;

function TDAEADODriver.GetDefaultCustomParameters: string;
begin
  Result:= inherited GetDefaultCustomParameters + 'useUnicode=False;';
end;

function TDAEADODriver.GetDescription: string;
begin
  result := 'Core Lab MyDAC Driver'{$IFDEF DataAbstract_SchemaModelerOnly} + SchemaModelerOnly{$ENDIF};
end;

function TDAEADODriver.GetDriverID: string;
begin
  result := 'MyDAC';
end;

{$IFDEF ENABLE_SQLMonitor}
procedure TDAEADODriver.OnMyDACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);
begin
  if Assigned(fTraceCallback) then fTraceCallback(Sender, Text, integer(Flag));
end;

procedure TDAEADODriver.DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent);
var
  MyDACopts: TDATraceFlags;
begin
  inherited;

  if TraceActive then begin
    if (fMonitor = nil) then fMonitor := TMySQLMonitor.Create(Self);

    fMonitor.Active := FALSE;
    fMonitor.OnSQL := OnMyDACTrace;

    MyDACopts := [];
    if (toPrepare in TraceOptions) then MyDACopts := MyDACopts + [tfQPrepare];
    if (toExecute in TraceOptions) then MyDACopts := MyDACopts + [tfQExecute];
    if (toFetch in TraceOptions) then MyDACopts := MyDACopts + [tfQFetch];
    if (toError in TraceOptions) then MyDACopts := MyDACopts + [tfError];
    if (toStmt in TraceOptions) then MyDACopts := MyDACopts + [tfStmt];
    if (toConnect in TraceOptions) then MyDACopts := MyDACopts + [tfConnect];
    if (toTransact in TraceOptions) then MyDACopts := MyDACopts + [tfTransact];
    if (toBlob in TraceOptions) then MyDACopts := MyDACopts + [tfBlob];
    if (toService in TraceOptions) then MyDACopts := MyDACopts + [tfService];
    if (toMisc in TraceOptions) then MyDACopts := MyDACopts + [tfMisc];
    if (toParams in TraceOptions) then MyDACopts := MyDACopts + [tfParams];

    fTraceCallBack := Callback;

    fMonitor.TraceFlags := MyDACopts;
    fMonitor.Active := TRUE;
  end
  else begin
    FreeAndNIL(fMonitor);
    fTraceCallback := nil;
  end;
end;
{$ENDIF ENABLE_SQLMonitor}

{ TDAEMyQuery }

function TDAEMyQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
  result := TMyQuery.Create(nil);
  TMyQuery(result).ReadOnly := TRUE;
  TMyQuery(result).Connection := TDAEMyConnection(aConnection).MyConnection;
  TMyQuery(result).FetchAll := True;  //for preventing creating an additional session when you call StartTransaction (an known issue of OLEDB)

//  GetLastAutoInc will work in case these options is commented
//  TMyQuery(result).FetchAll := False;
//  TMyQuery(result).Unidirectional := True;
end;

function TDAEMyQuery.DoExecute: integer;
begin
  inherited DoExecute;
  result := TMyQuery(Dataset).RowsAffected;
end;

function TDAEMyQuery.DoGetSQL: string;
begin
  result := TMyQuery(Dataset).SQL.Text;
end;

procedure TDAEMyQuery.DoPrepare(Value: boolean);
begin
  // Do not do inherited DoPrepare for MySQL.
  {with TMyQuery(Dataset) do begin
     if not Options.Direct then Prepared := Value;
  end;}
end;

procedure TDAEMyQuery.DoSetSQL(const Value: string);
begin
  TMyQuery(Dataset).SQL.Text := Value;
end;

procedure TDAEMyQuery.SetParamValues(Params: TDAParamCollection);
begin
  WriteCrLabsParamValues(Params, TMyQuery(Dataset).Params);
end;

procedure TDAEMyQuery.GetParamValues(Params: TDAParamCollection); safecall;
var
  i: integer;
  par: uDAInterfaces.TDAParam;
  inpar: TParam;
begin
  for i := 0 to (Params.Count - 1) do begin
    par := Params[i];
    inpar := TMyQuery(Dataset).Params.ParamByName(par.Name);
    par.Value := inpar.Value;
  end;
end;

{ TDAEADOStoredProcedure }

function TDAEADOStoredProcedure.CreateDataset(
  aConnection: TDAEConnection): TDataset;
begin
  result := TMyStoredProc.Create(nil);
  TMyStoredProc(result).Connection := TDAEMyConnection(aConnection).MyConnection;
end;

function TDAEADOStoredProcedure.Execute: integer;
begin
  SetParamValues(GetParams);
  TMyStoredProc(Dataset).ExecProc;
  Result := -1;
  GetParamValues(GetParams);
end;

function TDAEADOStoredProcedure.GetStoredProcedureName: string;
begin
  result := TMyStoredProc(Dataset).StoredProcName;
end;

procedure TDAEADOStoredProcedure.SetStoredProcedureName(
  const Name: string);
begin
  TMyStoredProc(Dataset).StoredProcName := Name;
end;

procedure TDAEADOStoredProcedure.SetParamValues(Params: TDAParamCollection);
begin
  WriteCrLabsParamValues(Params, TMyStoredProc(Dataset).Params);
end;

procedure TDAEADOStoredProcedure.GetParamValues(Params: TDAParamCollection); safecall;
var
  i: Integer;
  lParam: DBAccess.TDAParam;
begin
  for i := 0 to TMyStoredProc(DataSet).Params.Count - 1 do begin
    lParam:=TMyStoredProc(DataSet).Params[i];
    if (lParam.ParamType in [ptOutput, ptInputOutput, ptResult]) then
      params.ParamByName(lParam.Name).Value := lParam.Value;
  end;
end;

exports
  GetDriverObject name func_GetDriverObject;

initialization
  _driver := nil;
  RegisterDriverProc(GetDriverObject);

finalization
  UnregisterDriverProc(GetDriverObject);
  FreeAndNIL(_driver);

end.