unit Aurelius.Drivers.Odbc;

{$I Aurelius.inc}

interface

uses
  Classes, DB, Variants, Generics.Collections, SysUtils, StrUtils, Types,
  Aurelius.Drivers.Odbc.Classes,
  Aurelius.Drivers.Base,
  Aurelius.Drivers.Interfaces;

type
  TOdbcNativeResultSetAdapter = class(TInterfacedObject, IDBResultSet, IDBResultSet2)
  private
    FStatement: TOdbcStatement;
  public
    constructor Create(AStatement: TOdbcStatement);
    destructor Destroy; override;
    function Next: boolean;
    function GetFieldValue(FieldIndex: Integer): Variant; overload;
    function GetFieldValue(FieldName: string): Variant; overload;
    function GetFieldIndex(const FieldName: string): Integer;
  end;

  TOdbcNativeStatementAdapter = class(TInterfacedObject, IDBStatement)
  private
    FConn: TOdbcConnection;
    FSQL: string;
    FParams: TObjectList<TDBParam>;
    procedure SetParamValues(SqlParams: TParams);
    function PrepareStatement: TOdbcStatement;
  public
    constructor Create(ADB: TOdbcConnection);
    destructor Destroy; override;
    procedure SetSQLCommand(SQLCommand: string);
    procedure SetParams(Params: TEnumerable<TDBParam>);
    function Execute: Integer;
    function ExecuteQuery: IDBResultSet;
  end;

  TOdbcNativeConnectionAdapter = class(TInterfacedObject, IDBConnection)
  strict private
    FConnection: TOdbcConnection;
    FConnectionString: string;
  strict protected
    procedure DoConnect; virtual;
    procedure DoDisconnect; virtual;
    property Connection: TOdbcConnection read FConnection;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Connect; virtual;
    procedure Disconnect; virtual;
    function IsConnected: Boolean; virtual;
    function CreateStatement: IDBStatement; virtual;
    function BeginTransaction: IDBTransaction; virtual;
    function SqlDialect: string; virtual;
    property ConnectionString: string read FConnectionString write FConnectionString;
  end;

  TOdbcNativeTransactionAdapter = class(TInterfacedObject, IDBTransaction)
  private
    FDatabase: TOdbcConnection;
  public
    constructor Create(ADatabase: TOdbcConnection);
    procedure Commit;
    procedure Rollback;
  end;

  EFieldNotFound = class(Exception)
  public
    constructor Create(const FieldName: string);
  end;

implementation

uses
  Aurelius.Comp.Drivers,
  Aurelius.Drivers.Exceptions,
  Aurelius.Global.Utils;

{ EFieldNotFound }

constructor EFieldNotFound.Create(const FieldName: string);
begin
  inherited CreateFmt('Field "%s" not found', [FieldName]);
end;

{ TOdbcNativeStatementAdapter }

constructor TOdbcNativeStatementAdapter.Create(ADB: TOdbcConnection);
begin
  FConn := ADB;
  FParams := TObjectList<TDBParam>.Create(true);
end;

destructor TOdbcNativeStatementAdapter.Destroy;
begin
  FParams.Free;
  inherited;
end;

function TOdbcNativeStatementAdapter.Execute: Integer;
var
  Statement: TOdbcStatement;
begin
  Statement := PrepareStatement;
  try
    Result := Statement.Execute;
  finally
    Statement.Free;
  end;
end;

function TOdbcNativeStatementAdapter.ExecuteQuery: IDBResultSet;
var
  Statement: TOdbcStatement;
begin
  Statement := PrepareStatement;
  Result := TOdbcNativeResultSetAdapter.Create(Statement);
end;

procedure TOdbcNativeStatementAdapter.SetParamValues(SqlParams: TParams);
var
  Param: TDBParam;
  I: Integer;
  SqlParam: TParam;
begin
  I := 0;
  for Param in FParams do
  begin
    if (Param.ParamName <> '') and (SqlParams[I].Name <> Param.ParamName) then
      SqlParam := SqlParams.ParamByName(Param.ParamName)
    else
    begin
      while I >= SqlParams.Count do
        SqlParams.AddParameter;
      SqlParam := SqlParams[I];
    end;

    SqlParam.DataType := Param.ParamType;
    SqlParam.Value := Param.ParamValue;
    Inc(I);
  end;
end;

function TOdbcNativeStatementAdapter.PrepareStatement: TOdbcStatement;
var
  OdbcParam: TOdbcParam;
  SqlParams: TParams;
  I: Integer;
  SqlParam: TParam;
begin
  Result := TOdbcStatement.Create(FConn.Handle);
  try
    SqlParams := TParams.Create;
    try
      // Set SQL
      Result.Prepare(SqlParams.ParseSQL(FSql, True));

      // Convert TList<TDBParam> to TParams
      SetParamValues(SqlParams);

      // Bind TParams
      for I := 0 to SqlParams.Count - 1 do
      begin
        OdbcParam := TOdbcParam.Create;
        Result.Params.Add(OdbcParam);

        SqlParam := SqlParams[I];
        case SqlParam.DataType of
          ftString, ftFixedChar, ftWideString, ftFixedWideChar:
            OdbcParam.SetAsString(SqlParam.AsString);

          ftSmallint, ftInteger, ftWord, ftShortint, ftByte:
            OdbcParam.SetAsInteger(SqlParam.AsInteger);

          ftBoolean:
            OdbcParam.SetAsBoolean(SqlParam.AsBoolean);

          ftFloat, ftCurrency, ftExtended, ftSingle:
            OdbcParam.SetAsDouble(SqlParam.AsFloat);

          ftDate, ftTime, ftDateTime:
            OdbcParam.SetAsDateTime(SqlParam.AsDateTime);

          ftBytes, ftVarBytes, ftBlob, ftGraphic, ftOraBlob:
            OdbcParam.SetAsBytes(TUtils.VariantToBytes(SqlParam.Value));

          ftMemo, ftWideMemo, ftFmtMemo, ftOraClob:
            OdbcParam.SetAsMemo(SqlParam.AsString);

          ftLargeint, ftLongWord:
            OdbcParam.SetAsInt64(SqlParam.AsLargeInt);

          ftGuid:
            if SqlParam.IsNull or (SqlParam.AsString = '') then
              OdbcParam.SetAsGuid(GUID_NULL)
            else
              OdbcParam.SetAsGuid(StringToGuid(SqlParam.AsString));

//          ftTimeStamp, ftFMTBcd, ftBcd,
        else
          raise EAureliusDBException.CreateFmt('ODBC driver: Param %d not supported',
            [Ord(SqlParam.DataType)]);
        end;
        if SqlParam.IsNull then
          OdbcParam.SetAsNull;
      end;
    finally
      SqlParams.Free;
    end;
  except
    Result.Free;
    raise;
  end;
end;

procedure TOdbcNativeStatementAdapter.SetParams(Params: TEnumerable<TDBParam>);
var
  P: TDBParam;
begin
  FParams.Clear;
  for P in Params do
    FParams.Add(TDBParam.Create(P.ParamName, P.ParamType, P.ParamValue));
end;

procedure TOdbcNativeStatementAdapter.SetSQLCommand(SQLCommand: string);
begin
  FSQL := SQLCommand;
end;

{ TOdbcNativeConnectionAdapter }

function TOdbcNativeConnectionAdapter.BeginTransaction: IDBTransaction;
begin
  if not IsConnected then
    Connect;

  if not FConnection.InTransaction then
  begin
    FConnection.BeginTransaction;
    Result := TOdbcNativeTransactionAdapter.Create(FConnection);
  end else
    Result := TOdbcNativeTransactionAdapter.Create(nil);
end;

procedure TOdbcNativeConnectionAdapter.Connect;
begin
  if not IsConnected then
    DoConnect;
end;

constructor TOdbcNativeConnectionAdapter.Create;
begin
  FConnection := TOdbcConnection.Create;
end;

function TOdbcNativeConnectionAdapter.CreateStatement: IDBStatement;
begin
  if not IsConnected then
    Connect;
  Result := TOdbcNativeStatementAdapter.Create(FConnection);
end;

destructor TOdbcNativeConnectionAdapter.Destroy;
begin
  Disconnect;
  FConnection.Free;
  inherited;
end;

procedure TOdbcNativeConnectionAdapter.Disconnect;
begin
  if IsConnected then
    DoDisconnect;
end;

procedure TOdbcNativeConnectionAdapter.DoConnect;
begin
  FConnection.Connect(FConnectionString);
end;

procedure TOdbcNativeConnectionAdapter.DoDisconnect;
begin
  FConnection.Disconnect;
end;

function TOdbcNativeConnectionAdapter.IsConnected: Boolean;
begin
  Result := FConnection.Connected;
end;

function TOdbcNativeConnectionAdapter.SqlDialect: string;
begin
  if ContainsText(ConnectionString, 'sql server')
    or ContainsText(ConnectionString, 'sql native client') then
    Result := 'MSSQL'
  else
    Result := '';
end;

{ TOdbcNativeTransactionAdapter }

procedure TOdbcNativeTransactionAdapter.Commit;
begin
  if (FDatabase = nil) then
    Exit;

  FDatabase.Commit;
end;

constructor TOdbcNativeTransactionAdapter.Create(ADatabase: TOdbcConnection);
begin
  FDatabase := ADatabase;
end;

procedure TOdbcNativeTransactionAdapter.Rollback;
begin
  if (FDatabase = nil) then
    Exit;

  FDatabase.Rollback;
end;

{ TOdbcNativeResultSetAdapter }

constructor TOdbcNativeResultSetAdapter.Create(AStatement: TOdbcStatement);
begin
  FStatement := AStatement;
  FStatement.Open;
end;

destructor TOdbcNativeResultSetAdapter.Destroy;
begin
  FStatement.Free;
  inherited;
end;

function TOdbcNativeResultSetAdapter.GetFieldValue(FieldIndex: Integer): Variant;
begin
  Result := FStatement.Cols[FieldIndex].Value;
end;

function TOdbcNativeResultSetAdapter.GetFieldIndex(
  const FieldName: string): Integer;
begin
  Result := FStatement.ColIndex(FieldName);
end;

function TOdbcNativeResultSetAdapter.GetFieldValue(FieldName: string): Variant;
begin
  Result := GetFieldValue(GetFieldIndex(FieldName));
end;

function TOdbcNativeResultSetAdapter.Next: boolean;
begin
  Result := FStatement.Fetch;
end;

end.
