unit uDASDACDriver;

{----------------------------------------------------------------------------}
{ Data Abstract Library - Driver Library
{
{ compiler: Delphi 6 and up
{ platform: Win32
{
{ (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_SDACDriver_Glyphs.res}

interface

uses
  DB, Classes, uDAEngine, uDAInterfaces, uDAADOInterfaces, uROClasses,
  DBAccess, MSAccess, DASQLMonitor,
  MSSQLMonitor, Variants, uDAUtils;

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

     { TDAEADODriver }
  TDAEADODriver = class(TDAMSSQLDriver)
  private
    fMonitor: TMSSQLMonitor;
    fTraceCallBack: TDALogTraceEvent;

    procedure OnSDACTrace(Sender: TObject; Text: string; Flag: TDATraceFlag);

  protected
    function GetConnectionClass: TDAEConnectionClass; override;
    procedure DoSetTraceOptions(TraceActive: boolean; TraceOptions: TDATraceOptions; Callback: TDALogTraceEvent); override;

       // IDADriver
    function GetDriverID: string; override;
    function GetDescription: string; override;
    function GetAvailableDriverOptions: TDAAvailableDriverOptions; override; safecall;
    function GetDefaultCustomParameters: String; override; safecall;
    procedure GetAuxParams(const AuxDriver: string; out List: IROStrings); override;    
  end;

     { TDAEMSConnection }
  TDAEMSConnection = class(TDAMSConnection, IDAADOConnection, IDACanQueryDatabaseNames)
  private
    fMSConnection: TMSConnection;

//    procedure GetSysObjects(const aCondition: string; aList: TStrings);

  protected
    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 DoGetStoredProcedureParams(const aStoredProcedureName : string; out Params : TDAParamCollection); //override;
    // IADOConnection
    function GetProviderName: string; safecall;
    function GetProviderType: TDAOleDBProviderType; safecall;
    function GetCommandTimeout: Integer; safecall;
    procedure SetCommandTimeout(const Value: Integer); safecall;
  end;

     { TDAEMSQuery }
  TDAEMSQuery = 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,
  uDADriverManager, uDARes, OLEDBAccess,
    uROBinaryHelpers;

var
  _driver: TDAEDriver = nil;

procedure Register;
begin
  RegisterComponents(DAPalettePageName, [TDASDACDriver]);
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;

{$I uDACRLabsUtils.inc}

{ TDAEMSConnection }

procedure TDAEMSConnection.DoApplyConnectionString(
  aConnStrParser: TDAConnectionStringParser; aConnectionObject: TCustomConnection);
var
  adoconn: string;
  i: integer;
begin
  inherited;

  with aConnStrParser do begin
    adoconn := Format(stdMSSQL_ConnectionString, [UserID, Password, Database, Server]);
    adoconn := '';
    if UserId <> '' then begin
      if adoconn = '' then
        AdoConn := 'User ID='+UserID
      else
        AdoConn := ADoConn + ';User ID='+UserID;
    end;
    if Password <> '' then begin
      if adoconn = '' then
        AdoConn := 'Password='+Password
      else
        AdoConn := ADoConn + ';Password='+Password;
    end;
    if DataBase <> '' then begin
      if adoconn = '' then
        AdoConn := 'Initial Catalog='+Database
      else
        AdoConn := ADoConn + ';Initial Catalog='+Database;
    end;
    if Server <> '' then begin
      if adoconn = '' then
        AdoConn := 'Data Source='+Server
      else
        AdoConn := ADoConn + ';Data Source='+Server;
    end;

    AdoConn := ADoConn + ';';
    MSSQLSchemaEnabled := True; // by default
    for i := 0 to AuxParamsCount -1 do
    begin
      if Uppercase(AuxParamNames[i]) = 'SCHEMAS' then
        MSSQLSchemaEnabled := AuxParams['Schemas'] = '1'
      else
        adoconn := adoconn + AuxParamNames[i] + '=' + AuxParams[AuxParamNames[i]]+';';
    end;

    fMSConnection.ConnectString := adoconn;

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

    if (Self.Password <> '') then fMSConnection.Password := Self.Password;
  end;
end;

function TDAEMSConnection.DoBeginTransaction: integer;
begin
  fMSConnection.StartTransaction;
  result := 0;
end;

procedure TDAEMSConnection.DoCommitTransaction;
begin
  fMSConnection.Commit;
end;

function TDAEMSConnection.CreateCustomConnection: TCustomConnection;
begin
  fMSConnection := TMSConnection.Create(nil);
  fMSConnection.LoginPrompt := FALSE;

  result := fMSConnection;
end;

function TDAEMSConnection.GetDatasetClass: TDAEDatasetClass;
begin
  result := TDAEMSQuery;
end;

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

(*function SqlServerToDAType(aType:integer):TDADataType;
begin
  case aType of
    34:result := datBlob;
    35:result := datMemo;
    36:result := datString; //uniqueidentifier
    48:result := datInteger;
    52:result := datInteger;
    56:result := datInteger;
    58:result := datDateTime;
    59:result := datFloat;
    60:result := datCurrency;
    61:result := datDateTime;
    62:result := datFloat;
    //98    sql_variant
    99:result := datMemo;//    ntext
    104:result := datBoolean;
    106:result := datFloat;
    108:result := datFloat;
    122:result := datCurrency;
    127:result := datInteger;
    165:result := datBlob; // varbinary
    167:result := datString;
    173:result := datBlob;   // binary
    175:result := datString; //   char
    189:result := datBlob;   //   timestamp
    231:result := datString; //  nvarchar
    239:result := datString; //nchar
    240:result := datDateTime;
    241:result := datBlob;//   xml
    else result := datUnknown;
  end;
end;

procedure TDAEMSConnection.DoGetStoredProcedureParams(const aStoredProcedureName: string; out Params: TDAParamCollection);
var
  ds : TMSQuery;
  lID:string;
begin
  ds := TMSQuery.Create(NIL);
  try

    ds.Connection := fMSConnection;
    ds.SQL.Text := 'select * from sysobjects where xtype=''P'' and name='''+aStoredProcedureName+'''';
    ds.Open;
    try
      if ds.EOF then RaiseError('Stored Procedure %s not found in database',[aStoredProcedureName]);
      lID := ds.FieldbyName('id').AsString;
    finally
      ds.Close();
    end;

    ds.SQL.Text := 'select * from sys.parameters where object_id='''+lID+''' ORDER BY parameter_id';
    ds.Open;
    try
      Params := TDAParamCollection.Create(nil);
      while not ds.Eof do begin
        with Params.Add() do begin
          Name := ds.FieldByName('name').AsString;

          DataType := SqlServerToDAType(ds.FieldByName('system_type_id').AsInteger);
          Size := ds.FieldByName('max_length').AsInteger;

          {if ds.FieldByName('has_default_value').AsBoolean then
            DefaultValue := ds.FieldByName('default_Value').AsInteger;}

          if ds.FieldByName('is_output').AsBoolean then
            ParamType := daptOutput
          else
            ParamType := daptInput;

        end;
        ds.Next();
      end;
    finally
      Close();
    end;

  finally
    ds.Free;
  end;
end;*)

procedure TDAEMSConnection.DoRollbackTransaction;
begin
  fMSConnection.Rollback;
end;

function TDAEMSConnection.DoGetInTransaction: boolean;
begin
  result := fMSConnection.InTransaction
end;

function TDAEMSConnection.GetProviderName: string;
begin
  result := oledb_MSSQLId;
end;

function TDAEMSConnection.GetProviderType: TDAOleDBProviderType;
begin
  result := oledb_MSSQL;
end;

function TDAEMSConnection.GetCommandTimeout: Integer;
begin
   if fMSConnection <> nil then
     Result := fMSConnection.ConnectionTimeout
   else
     Result:=0;
end;

procedure TDAEMSConnection.SetCommandTimeout(const Value: Integer);
begin
  if fMSConnection <> nil then
  fMSConnection.ConnectionTimeout := Value;
end;

{ TDAEADODriver }

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

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

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

procedure TDAEADODriver.OnSDACTrace(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
  sdacopts: TDATraceFlags;
begin
  inherited;

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

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

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

    fTraceCallBack := Callback;

    fMonitor.TraceFlags := sdacopts;
    fMonitor.Active := TRUE;
  end
  else begin
    FreeAndNIL(fMonitor);
    fTraceCallback := nil;
  end;
end;

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

function TDAEADODriver.GetDefaultCustomParameters: String;
begin
  Result := 'Schemas=1;Integrated Security=SSPI';
end;



procedure TDAEADODriver.GetAuxParams(const AuxDriver: string;
  out List: IROStrings);
begin
  inherited;
  MSSQL_GetAuxParams(List);
end;

{ TDAEMSQuery }

function TDAEMSQuery.CreateDataset(aConnection: TDAEConnection): TDataset;
begin
  result := TMSQuery.Create(nil);

  TMSQuery(result).FetchAll := True;  //for preventing creating an additional session when you call StartTransaction (an known issue of OLEDB)
  TMSQuery(result).Unidirectional := True;
  TMSQuery(result).ReadOnly := TRUE;
  TMSQuery(result).Connection := TDAEMSConnection(aConnection).fMSConnection;
//  TMSQuery(result).Options.AutoPrepare:=True;
end;

function TDAEMSQuery.DoExecute: integer;
begin
  inherited DoExecute;
  result := TMSQuery(Dataset).RowsAffected;
end;

function TDAEMSQuery.DoGetSQL: string;
begin
  result := TMSQuery(Dataset).SQL.Text;
end;

procedure TDAEMSQuery.DoPrepare(Value: boolean);
var
  i: integer;
  par: TParam;
begin
  if Value and not TMSQuery(Dataset).Prepared and (TMSQuery(Dataset).ParamCount<>0) then begin
    for I := 0 to GetParams.Count - 1 do begin
      par:=TMSQuery(Dataset).ParamByName(GetParams[i].Name);
      par.DataType:= DATypeToVCLType(GetParams[i].DataType);
      if  par.DataType = ftAutoInc then par.DataType:= ftInteger;
    end;
  end;
  TMSQuery(Dataset).Prepared := Value;
end;

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

procedure TDAEMSQuery.GetParamValues(Params: TDAParamCollection);
var
  I: Integer;
begin
  for i := 0 to TMSQuery(DataSet).Params.Count - 1 do
    if (TMSQuery(DataSet).Params[i].ParamType in [ptOutput, ptInputOutput, ptResult]) then params[i].Value := TMSQuery(DataSet).Params[i].Value;
end;

procedure TDAEMSQuery.SetParamValues(Params: TDAParamCollection);
begin
  WriteCrLabsParamValues(Params, TMSQuery(Dataset).Params, true);
end;

{ TDAEADOStoredProcedure }

function TDAEADOStoredProcedure.CreateDataset(
  aConnection: TDAEConnection): TDataset;
begin
  result := TMSStoredProc.Create(nil);
  TMSStoredProc(result).Connection := TDAEMSConnection(aConnection).fMSConnection;
end;

function TDAEADOStoredProcedure.Execute: integer;
var
  i: integer;
  _params: TDAParamCollection;
begin
  _params := GetParams;

  with TMSStoredProc(Dataset) do begin
    for i := 0 to (Params.Count - 1) do
      if (Params[i].ParamType in [ptInput, ptInputOutput]) then begin
        if (Params[i].DataType in [ftMemo, ftBlob, ftGraphic]) and VarIsArray(_params[i].Value)
          then Params[i].Value := VariantBinaryToString(_params[i].Value)
          else Params[i].Value := _params[i].Value;
      end;

    ExecProc;
    result := RowsAffected;

    for i := 0 to (_params.Count-1) do
      if (_params[i].ParamType in [daptOutput, daptInputOutput, daptResult])
        then _params[i].Value := params.ParamByName(_params[i].Name).Value;
  end;
end;

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


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

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

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

exports
  GetDriverObject name func_GetDriverObject;

initialization
  _driver := nil;
  RegisterDriverProc(GetDriverObject);

finalization
  UnregisterDriverProc(GetDriverObject);
  FreeAndNIL(_driver);

end.