unit Aurelius.Drivers.Odbc.Classes;

interface

uses
  Generics.Collections, SysUtils, SyncObjs, Classes, Variants,
  Aurelius.Drivers.Odbc.Api;

type
	EAureliusOdbcException = class(Exception)
	end;

  TOdbcParam = class
  strict private
    FBuffer: Pointer;
    FBufferSize: Integer;
    FKeepBuffer: Boolean;
    FFlag: SQLLen;
    FSqlType: SQLSmallint;
    FCType: SQLSmallint;
    FSqlSize: Integer;
    FScale: SQLSmallint;
    procedure ReallocBuffer(const ASize: Integer);
    procedure CopyBuffer(const ABuffer; ASize: Integer);
  public
    destructor Destroy; override;

    procedure SetBuffer(const ABuffer; ASize: Integer);
    procedure SetAsDateTime(const Value: TDateTime);
    procedure SetAsInteger(const Value: Integer);
    procedure SetAsInt64(const Value: Int64);
    procedure SetAsDouble(const Value: Double);
    procedure SetAsBoolean(const Value: Boolean);
    procedure SetAsString(const Value: string);
    procedure SetAsBytes(const Bytes: TBytes);
    procedure SetAsGuid(const Value: TGuid);
    procedure SetAsBlob(const ABuffer; ASize: Integer);
    procedure SetAsMemo(const Value: string);
    procedure SetAsNull;

    property Buffer: Pointer read FBuffer;
    property BufferSize: Integer read FBufferSize;
    property Flag: SQLLen read FFlag write FFlag;
    property CType: SQLSmallint read FCType write FCType;
    property SqlType: SQLSmallint read FSqlType write FSqlType;
    property SqlSize: Integer read FSqlSize write FSqlSize;
    property Scale: SQLSmallint read FScale write FScale;
  end;

  TOdbcColumn = class
  private
    FName: string;
    FBuffer: Pointer;
    FBufferSize: Integer;
    FCType: SQLSmallint;
    FFlag: SQLLen;
    FIndex: Integer;
    FLateBinding: Boolean;
    FIsLongData: Boolean;
    function GetAsInteger: Integer;
    function GetAsString: string;
    function GetAsDateTime: TDateTime;
    function GetAsInt64: Int64;
    function GetAsSmallInt: SmallInt;
    function GetAsDouble: Double;
    function GetAsBoolean: Boolean;
    function GetAsByte: Byte;
    function GetFlagPtr: PSQLLen;
    function GetIsNull: Boolean;
    function GetValue: Variant;
    function GetAsGuid: TGuid;
    procedure ReallocBuffer(const ASize: Integer);
    function GetAsBytes: TBytes;
    function GetAsTime: TTime;
  protected
    property Buffer: Pointer read FBuffer;
    property BufferSize: Integer read FBufferSize;
    property FlagPtr: PSQLLen read GetFlagPtr;
    property Flag: SQLLen read FFlag;
    property CType: SQLSmallInt read FCtype;
    property LateBinding: Boolean read FLateBinding write FLateBinding;
    property IsLongData: Boolean read FIsLongData write FIsLongData;
    property Index: Integer read FIndex write FIndex;
  protected
    property AsBoolean: Boolean read GetAsBoolean;
    property AsByte: Byte read GetAsByte;
    property AsSmallInt: SmallInt read GetAsSmallInt;
    property AsInteger: Integer read GetAsInteger;
    property AsInt64: Int64 read GetAsInt64;
    property AsString: string read GetAsString;
    property AsDateTime: TDateTime read GetAsDateTime;
    property AsTime: TTime read GetAsTime;
    property AsDouble: Double read GetAsDouble;
    property AsGuid: TGuid read GetAsGuid;
    property AsBytes: TBytes read GetAsBytes;
    property IsNull: Boolean read GetIsNull;
  public
    constructor Create(const AName: string; ACType: SQLSmallint; ABufferSize: Integer);
    destructor Destroy; override;
    property Name: string read FName;
    property Value: Variant read GetValue;
  end;

  TOdbcEnvironment = class
  strict private
    class var FGlobal: TOdbcEnvironment;
  public
    class function Global: TOdbcEnvironment;
    class procedure Release;
  strict private
    FHandle: SQLHEnv;
    procedure AllocHandle;
    procedure FreeHandle;
    procedure Check(ReturnCode: SQLReturn);
    function GetDriver(Direction: SQLUSmallint; out DriverName: string; out DriverAttr: string): Boolean;
  public
    constructor Create;
    destructor Destroy; override;
    procedure GetDriverNames(Drivers: TStrings);
    function MatchDriver(ValidDrivers: TArray<string>): string;
    property Handle: SQLHEnv read FHandle;
  end;

  TOdbcConnection = class
  strict private
    FEnvHandle: SQLHEnv;
    FHandle: SQLHDbc;
    FConnected: Boolean;
    FInTransaction: Boolean;
    procedure Check(ReturnCode: SQLReturn);
  protected
    procedure AllocHandle;
    procedure FreeHandle;
  public
    constructor Create; overload;
    constructor Create(AEnvHandle: SQLHEnv); overload;
    destructor Destroy; override;
    procedure Connect(const ConnectionString: string);
    procedure Disconnect;
    procedure BeginTransaction;
    procedure Commit;
    procedure Rollback;
    procedure SetLoginTimeout(const Value: Integer);
    property Handle: SQLHDbc read FHandle;
    property InTransaction: Boolean read FInTransaction;
    property Connected: Boolean read FConnected;
  end;

  TOdbcStatement = class
  strict private
    FDbcHandle: SQLHDBC;
    FHandle: SQLHStmt;
    FIsOpen: Boolean;
    FParams: TList<TOdbcParam>;
    FCols: TList<TOdbcColumn>;
    FColCount: SQLSmallint;
    procedure Check(ReturnCode: SQLReturn);
    procedure BindParams;
    procedure RetrieveColData(Col: TOdbcColumn);
  private
    function GetColCount: Integer;
    function GetCol(Index: Integer): TOdbcColumn;
  protected
    procedure AllocHandle;
    procedure FreeHandle;
  public
    constructor Create(ADbcHandle: SQLHDBC);
    destructor Destroy; override;
    procedure Prepare(const Sql: string);
    function Execute: Integer;
    procedure Open;
    procedure Close;
    function Fetch: Boolean;
    function ColIndex(const Name: string): Integer;
    function ColByName(const Name: string): TOdbcColumn;
    property ColCount: Integer read GetColCount;
    property Cols[Index: Integer]: TOdbcColumn read GetCol;
    property Handle: SQLHStmt read FHandle;
    property Params: TList<TOdbcParam> read FParams;
  end;

procedure OdbcCheck(ReturnCode: SQLRETURN; AHandleType: SQLSmallint; AHandle: SQLHandle);

implementation

uses
  DateUtils;

procedure OdbcCheck(ReturnCode: SQLRETURN; AHandleType: SQLSmallint; AHandle: SQLHandle);
var
  SqlState: TArray<SQLChar>;
  NativeError: Integer;
  MessageTextBuffer: array[0..SQL_MAX_MESSAGE_LENGTH] of SQLChar;
  MessageText: string;
  MessageTextLength: SmallInt;
  DiagStatus: SQLRETURN;
begin
  if (ReturnCode <> SQL_SUCCESS) and (ReturnCode <> SQL_SUCCESS_WITH_INFO) then
  begin
    SetLength(SqlState, 6);
    DiagStatus := SQLGetDiagRec(AHandleType, AHandle, 1, PSQLChar(SqlState),
      NativeError, @MessageTextBuffer[0], SQL_MAX_MESSAGE_LENGTH, MessageTextLength);
    if DiagStatus in [SQL_SUCCESS, SQL_SUCCESS_WITH_INFO] then
    begin
      SetString(MessageText, PChar(@MessageTextBuffer[0]), MessageTextLength);
      raise EAureliusOdbcException.CreateFmt('Error %d: %s', [ReturnCode, MessageText])
    end
    else
      raise EAureliusOdbcException.CreateFmt('Odbc error: %d; DiagRec error: %d', [ReturnCode, DiagStatus]);
  end;
end;

{ TOdbcStatement }

procedure TOdbcStatement.AllocHandle;
begin
  Check(SQLAllocHandle(SQL_HANDLE_STMT, FDbcHandle, FHandle));
end;

procedure TOdbcStatement.BindParams;
var
  Param: TOdbcParam;
  I: Integer;
//  _sqltype, _scale, _nullable: Smallint;
//  _paramdef: integer;
begin
  I := 1;
  for Param in FParams do
  begin
//    Check(Lib.SQLDescribeParam(FHandle, I, _sqltype, _paramdef, _scale, _nullable));

    Check(SQLBindParameter(FHandle, I, SQL_PARAM_INPUT, Param.CType, Param.SqlType,
      Param.SqlSize, Param.Scale, Param.Buffer, 0, @Param.Flag));
    Inc(I);
  end;
end;

procedure TOdbcStatement.Check(ReturnCode: SQLReturn);
begin
  if FHandle = nil then
    OdbcCheck(ReturnCode, SQL_HANDLE_DBC, FDbcHandle)
  else
    OdbcCheck(ReturnCode, SQL_HANDLE_STMT, FHandle);
end;

procedure TOdbcStatement.Close;
begin
  if FIsOpen then
  begin
    FIsOpen := False;
    Check(SQLFreeStmt(FHandle, SQL_CLOSE));
  end;
end;

function TOdbcStatement.ColByName(const Name: string): TOdbcColumn;
var
  Idx: Integer;
begin
  Idx := ColIndex(Name);
  if Idx >= 0 then
    Result := FCols[Idx]
  else
    Result := nil;
end;

function TOdbcStatement.ColIndex(const Name: string): Integer;
var
  I: Integer;
begin
  for I := 0 to FCols.Count - 1 do
    if SameText(Name, FCols[I].Name) then
      Exit(I);
  Result := -1;
end;

constructor TOdbcStatement.Create(ADbcHandle: SQLHDBC);
begin
  FDbcHandle := ADbcHandle;
  FParams := TObjectList<TOdbcParam>.Create;
  FCols := TObjectList<TOdbcColumn>.Create;
  AllocHandle;
end;

destructor TOdbcStatement.Destroy;
begin
  Close;
  FreeHandle;
  FParams.Free;
  FCols.Free;
  inherited;
end;

function TOdbcStatement.Execute: Integer;
var
  ReturnCode: SQLReturn;
  RowCount: SQLLen;
begin
  BindParams;
  ReturnCode := SQLExecute(FHandle);
  case ReturnCode of
    SQL_SUCCESS:
      Check(SQLRowCount(FHandle, RowCount));
    SQL_NO_DATA:
      RowCount := 0;
  else
    Check(ReturnCode);
  end;
  Result := RowCount;
end;

function TOdbcStatement.Fetch: Boolean;
var
  ReturnCode: SQLReturn;
  Col: TOdbcColumn;
begin
  ReturnCode := SQLFetch(FHandle);
  Result := ReturnCode <> SQL_NO_DATA;
  if Result then
  begin
    Check(ReturnCode);

    for Col in FCols do
      if Col.LateBinding then
        RetrieveColData(Col);
  end;
end;

procedure TOdbcStatement.FreeHandle;
begin
  Check(SQLFreeHandle(SQL_HANDLE_STMT, FHandle));
end;

function TOdbcStatement.GetCol(Index: Integer): TOdbcColumn;
begin
  Result := FCols[Index];
end;

function TOdbcStatement.GetColCount: Integer;
begin
  Result := FCols.Count;
end;

procedure TOdbcStatement.Open;
var
  FieldName: string;
  FieldNameLen: SQLSmallint;
  MaxFieldNameLen: SQLSmallint;
  FieldType: SQLSmallint;
  ColSize: SQLULen;
  Digits, Nullable: SQLSmallInt;
  I: Integer;
  Col: TOdbcColumn;
  HasLateBinding: Boolean;
begin
  BindParams;
  Check(SQLExecute(FHandle));
  FIsOpen := True;

  // Get field count
  Check(SQLNumResultCols(FHandle, FColCount));

  FCols.Clear;
  MaxFieldNameLen := 255;
  HasLateBinding := False;
  for I := 1 to FColCount do
  begin
    SetLength(FieldName, MaxFieldNameLen);
    Check(SQLDescribeCol(FHandle, I, PSQLChar(FieldName), MaxFieldNameLen, FieldNameLen,
      FieldType, ColSize, Digits, Nullable));
    SetLength(FieldName, FieldNameLen);

    // Force too big values to be retrieved on demand
    if (ColSize > 65535) then
      ColSize := SQL_SS_LENGTH_UNLIMITED;

    case FieldType of
      SQL_CHAR, SQL_VARCHAR, SQL_WCHAR, SQL_WVARCHAR:
        begin
          if ColSize <> SQL_SS_LENGTH_UNLIMITED then
            Col := TOdbcColumn.Create(FieldName, SQL_C_WCHAR, (ColSize + 1) * SizeOf(Char))
          else
          begin
            Col := TOdbcColumn.Create(FieldName, SQL_C_WCHAR, 0);
            Col.LateBinding := True;
            Col.IsLongData := True;
          end;
        end;
      SQL_NUMERIC, SQL_DECIMAL:
        Col := TOdbcColumn.Create(FieldName, SQL_C_DOUBLE, SizeOf(double));
      SQL_INTEGER:
        Col := TOdbcColumn.Create(FieldName, SQL_C_LONG, SizeOf(Integer));
      SQL_SMALLINT:
        Col := TOdbcColumn.Create(FieldName, SQL_C_SHORT, SizeOf(Integer));
      SQL_FLOAT, SQL_REAL, SQL_DOUBLE:
        Col := TOdbcColumn.Create(FieldName, SQL_C_DOUBLE, SizeOf(double));
      SQL_BIT:
        Col := TOdbcColumn.Create(FieldName, SQL_C_BIT, SizeOf(byte));
      SQL_TINYINT:
        Col := TOdbcColumn.Create(FieldName, SQL_C_UTINYINT, SizeOf(WordBool));
      SQL_BIGINT:
        Col := TOdbcColumn.Create(FieldName, SQL_C_SBIGINT, SizeOf(Int64));
      SQL_DATETIME:
        Col := TOdbcColumn.Create(FieldName, SQL_C_TIMESTAMP, SizeOf(SQL_TIMESTAMP_STRUCT));
      SQL_TYPE_DATE, SQL_TYPE_TIME, SQL_TYPE_TIMESTAMP:
        Col := TOdbcColumn.Create(FieldName, SQL_C_TIMESTAMP, SizeOf(SQL_TIMESTAMP_STRUCT));
      SQL_GUID:
        Col := TOdbcColumn.Create(FieldName, SQL_C_GUID, SizeOf(SQLGUID));
      SQL_LONGVARCHAR, SQL_WLONGVARCHAR:
        begin
          Col := TOdbcColumn.Create(FieldName, SQL_C_WCHAR, 0);
          Col.LateBinding := True;
          Col.IsLongData := True;
        end;
      SQL_BINARY, SQL_VARBINARY, SQL_LONGVARBINARY:
        begin
          Col := TOdbcColumn.Create(FieldName, SQL_C_BINARY, 0);
          Col.LateBinding := True;
          Col.IsLongData := True;
        end;
      SQL_SS_TIME2:
        Col := TOdbcColumn.Create(FieldName, SQL_C_TYPE_TIME, SizeOf(SQL_TIME_STRUCT));
    else
      raise EAureliusOdbcException.CreateFmt('Unsupported ODBC Type %d for column %s', [FieldType, FieldName]);
    end;

    FCols.Add(Col);
    if HasLateBinding then
      Col.LateBinding := True;
    Col.Index := I;

    if not Col.LateBinding then
      Check(SQLBindCol(FHandle, I, Col.CType, Col.Buffer, Col.BufferSize, Col.FlagPtr))
    else
      HasLateBinding := True;
  end;
end;

procedure TOdbcStatement.Prepare(const Sql: string);
begin
  Check(SQLPrepare(FHandle, PSQLChar(Sql), Length(Sql)));
end;

procedure TOdbcStatement.RetrieveColData(Col: TOdbcColumn);
const
  DefaultTempBufferSize = $10000;
var
  Status: SQLReturn;
  BufPtr: PByte;
  BufSize: Integer;
  NullCharSize: Integer;
  TotalSize: Integer;
begin
  if Col.IsLongData then
  begin
    case Col.CType of
      SQL_C_CHAR: NullCharSize := 1;
      SQL_C_WCHAR: NullCharSize := 2;
    else
      NullCharSize := 0;
    end;

    TotalSize := 0;
    Col.ReallocBuffer(DefaultTempBufferSize);
    repeat
      BufPtr := PByte(Col.Buffer);
      Inc(BufPtr, TotalSize);
      BufSize := Col.BufferSize - TotalSize;

      Status := SQLGetData(FHandle, Col.Index, Col.CType, BufPtr, BufSize, Col.FlagPtr);
      if Status = SQL_NO_DATA then
        break;
      Check(Status);

      if Col.Flag = SQL_NULL_DATA then
      begin
        Col.ReallocBuffer(0);
        Exit;
      end;

      if Col.Flag = SQL_NO_TOTAL then
      begin
        TotalSize := TotalSize + BufSize - NullCharSize;
        Col.ReallocBuffer(Col.BufferSize + DefaultTempBufferSize);
      end
      else
      if (Status = SQL_SUCCESS_WITH_INFO) and (BufSize < Col.Flag + NullCharSize) then
      begin
        TotalSize := TotalSize + BufSize - NullCharSize;
        Col.ReallocBuffer(Col.BufferSize + Col.Flag + NullCharSize - BufSize);
      end
      else
      begin
        TotalSize := TotalSize + Col.Flag + NullCharSize;
        break;
      end;
    until False;

    Col.ReallocBuffer(TotalSize);
  end
  else
    Check(SQLGetData(FHandle, Col.Index, Col.CType, Col.FBuffer, Col.BufferSize, Col.FlagPtr));
end;

{ TOdbcParam }

destructor TOdbcParam.Destroy;
begin
  ReallocBuffer(0);
  inherited;
end;

procedure TOdbcParam.ReallocBuffer(const ASize: Integer);
begin
  if FKeepBuffer then
    FBuffer := nil;

  FBufferSize := ASize;
  FKeepBuffer := False;
  ReallocMem(FBuffer, ASize);
end;

procedure TOdbcParam.SetAsBlob(const ABuffer; ASize: Integer);
begin
  CType := SQL_C_BINARY;
  SqlType := SQL_VARBINARY;

  SetBuffer(ABuffer, ASize);
  Flag := ASize;
end;

procedure TOdbcParam.SetAsBoolean(const Value: Boolean);
begin
  CType := SQL_C_BIT;
  SqlType := SQL_BIT;

  ReallocBuffer(SizeOf(WordBool));
  PWordBool(FBuffer)^ := Value;
end;

procedure TOdbcParam.SetAsBytes(const Bytes: TBytes);
begin
  CType := SQL_C_BINARY;
  SqlType := SQL_VARBINARY;

  if Length(Bytes) > 0 then
    CopyBuffer(Bytes[0], Length(Bytes))
  else
    ReallocBuffer(0);
  Flag := Length(Bytes);
end;

procedure TOdbcParam.SetAsDateTime(const Value: TDateTime);
var
  Struct: PSQL_TIMESTAMP_STRUCT;
  Y, M, D: Word;
  H, N, S, MS: Word;
begin
  // Define type
  CType := SQL_C_TIMESTAMP;
  SqlType := SQL_TYPE_TIMESTAMP;
  SqlSize := 27;
  Scale := 7;

  // Set value
  ReallocBuffer(SizeOf(SQL_TIMESTAMP_STRUCT));
  Struct := PSQL_TIMESTAMP_STRUCT(FBuffer);
  FillChar(Struct^, SizeOf(SQL_TIMESTAMP_STRUCT), 0);

  DecodeDate(Value, Y, M, D);
  Struct.Year := Y;
  Struct.Month := M;
  Struct.Day := D;

  if TimeOf(Value) <> 0 then
  begin
    DecodeTime(Value, H, N, S, MS);
    Struct.Hour := H;
    Struct.Minute := N;
    Struct.Second := S;
    Struct.Fraction := MS * 1000000;
  end;
end;

procedure TOdbcParam.SetAsDouble(const Value: Double);
begin
  CType := SQL_C_DOUBLE;
  SqlType := SQL_DOUBLE;

  ReallocBuffer(SizeOf(Double));
  PDouble(FBuffer)^ := Value;
end;

procedure TOdbcParam.SetAsGuid(const Value: TGuid);
var
  Struct: PSQLGUID;
begin
  // Define type
  CType := SQL_C_GUID;
  SqlType := SQL_GUID;

  // Set value
  ReallocBuffer(SizeOf(SQLGUID));
  Struct := PSQLGUID(FBuffer);

  Struct^ := Value;
end;

procedure TOdbcParam.SetAsInt64(const Value: Int64);
begin
  CType := SQL_C_SBIGINT;
  SqlType := SQL_BIGINT;

  ReallocBuffer(SizeOf(Int64));
  PInt64(FBuffer)^ := Value;
end;

procedure TOdbcParam.SetAsInteger(const Value: Integer);
begin
  CType := SQL_C_SLONG;
  SqlType := SQL_INTEGER;

  ReallocBuffer(SizeOf(Integer));
  PInteger(FBuffer)^ := Value;
end;

procedure TOdbcParam.SetAsMemo(const Value: string);
var
  BufSize: Integer;
begin
  CType := SQL_C_WCHAR;
  SqlType := SQL_WLONGVARCHAR;
  SqlSize := Length(Value);

  BufSize := Length(Value) * SizeOf(Char);
  CopyBuffer(PChar(Value)^, BufSize);
  Flag := BufSize;
end;

procedure TOdbcParam.SetAsNull;
begin
  ReallocBuffer(0);
  Flag := SQL_NULL_DATA;
end;

procedure TOdbcParam.SetAsString(const Value: string);
var
  BufSize: Integer;
begin
  CType := SQL_C_WCHAR;
  SqlType := SQL_WVARCHAR;
  SqlSize := Length(Value);

  BufSize := SqlSize * SizeOf(Char);
  CopyBuffer(PChar(Value)^, BufSize);
  Flag := BufSize;
end;

procedure TOdbcParam.SetBuffer(const ABuffer; ASize: Integer);
begin
  FBuffer := @ABuffer;
  FBufferSize := ASize;
  FKeepBuffer := True;
end;

procedure TOdbcParam.CopyBuffer(const ABuffer; ASize: Integer);
begin
  ReallocBuffer(ASize);
  System.Move(ABuffer, FBuffer^, ASize);
end;

{ TOdbcColumn }

constructor TOdbcColumn.Create(const AName: string; ACType: SQLSmallint; ABufferSize: Integer);
begin
  FName := AName;
  FCType := ACType;
  if ABufferSize > 0 then
    ReallocBuffer(ABufferSize)
  else
    FLateBinding := True;
end;

destructor TOdbcColumn.Destroy;
begin
  ReallocBuffer(0);
  inherited;
end;

function TOdbcColumn.GetAsBoolean: Boolean;
begin
  if IsNull then Exit(False);

  Result := PWordBool(FBuffer)^;
end;

function TOdbcColumn.GetAsByte: Byte;
begin
  if IsNull then Exit(0);

  Result := PByte(FBuffer)^;
end;

function TOdbcColumn.GetAsBytes: TBytes;
begin
  SetLength(Result, BufferSize);
  System.Move(FBuffer^, Result[0], BufferSize);
end;

function TOdbcColumn.GetAsDateTime: TDateTime;
var
  DT: PSQL_TIMESTAMP_STRUCT;
begin
  if IsNull then Exit(0);

  DT := PSQL_TIMESTAMP_STRUCT(FBuffer);
  Result := EncodeDate(DT.Year, DT.Month, DT.Day) +
    EncodeTime(DT.Hour, DT.Minute, DT.Second, DT.Fraction div 1000000);
end;

function TOdbcColumn.GetAsDouble: Double;
begin
  if IsNull then Exit(0);

  Result := PDouble(FBuffer)^;
end;

function TOdbcColumn.GetAsGuid: TGuid;
var
  PG: PSQLGuid;
begin
  if IsNull then Exit(TGuid.Empty);

  PG := PSQLGuid(FBuffer);
  Result := PG^;
end;

function TOdbcColumn.GetAsInt64: Int64;
begin
  if IsNull then Exit(0);

  Result := PInt64(FBuffer)^;
end;

function TOdbcColumn.GetAsInteger: Integer;
begin
  if IsNull then Exit(0);

  Result := PInteger(FBuffer)^;
end;

function TOdbcColumn.GetAsSmallInt: SmallInt;
begin
  if IsNull then Exit(0);

  Result := PSmallInt(FBuffer)^;
end;

function TOdbcColumn.GetAsString: string;
begin
  if IsNull then Exit('');

  Result := PChar(FBuffer);
end;

function TOdbcColumn.GetAsTime: TTime;
var
  DT: PSQL_TIME_STRUCT;
begin
  if IsNull then Exit(0);

  DT := PSQL_TIME_STRUCT(FBuffer);
  Result := EncodeTime(DT.Hour, DT.Minute, DT.Second, 0);
end;

function TOdbcColumn.GetFlagPtr: PSQLLen;
begin
  Result := @FFlag;
end;

function TOdbcColumn.GetIsNull: Boolean;
begin
  Result := (FFlag = SQL_NULL_DATA);
end;

function TOdbcColumn.GetValue: Variant;
begin
  if IsNull then Exit(Variants.NULL);

  case CType of
    SQL_C_WCHAR:
      Result := AsString;
    SQL_C_DOUBLE:
      Result := AsDouble;
    SQL_C_LONG:
      Result := AsInteger;
    SQL_C_SHORT:
      Result := AsSmallInt;
    SQL_C_BIT:
      Result := AsBoolean;
    SQL_C_UTINYINT:
      Result := AsByte;
    SQL_C_SBIGINT:
      Result := AsInt64;
    SQL_C_TIMESTAMP:
      Result := AsDateTime;
    SQL_C_GUID:
      Result := GuidToString(AsGuid);
    SQL_C_BINARY:
      Result := AsBytes;
    SQL_C_TYPE_TIME:
      Result := AsTime;
  else
    raise EAureliusOdbcException.CreateFmt('Cannot retrieve field value of CType %d', [CType]);
  end;
end;

procedure TOdbcColumn.ReallocBuffer(const ASize: Integer);
begin
  FBufferSize := ASize;
  ReallocMem(FBuffer, ASize);
end;

{ TOdbcConnection }

procedure TOdbcConnection.AllocHandle;
begin
  Check(SQLAllocHandle(SQL_HANDLE_DBC, FEnvHandle, FHandle));
end;

procedure TOdbcConnection.BeginTransaction;
begin
  if FInTransaction then Exit;
  
  Check(SQLSetConnectAttr(FHandle, SQL_ATTR_AUTOCOMMIT, Pointer(SQL_AUTOCOMMIT_OFF), 0));
  FInTransaction := True;
end;

procedure TOdbcConnection.Check(ReturnCode: SQLReturn);
begin
  if FHandle = nil then
    OdbcCheck(ReturnCode, SQL_HANDLE_ENV, FEnvHandle)
  else
    OdbcCheck(ReturnCode, SQL_HANDLE_DBC, FHandle);
end;

procedure TOdbcConnection.Commit;
begin
  Check(SQLEndTran(SQL_HANDLE_DBC, FHandle, SQL_COMMIT));
  Check(SQLSetConnectAttr(FHandle, SQL_ATTR_AUTOCOMMIT, Pointer(SQL_AUTOCOMMIT_ON), 0));
  FInTransaction := False;
end;

procedure TOdbcConnection.Connect(const ConnectionString: string);
var
  OutConnectionLength: SmallInt;
begin
  Disconnect;
  Check(SQLDriverConnect(FHandle, 0, PSQLChar(ConnectionString),
    Length(ConnectionString), nil, 0, OutConnectionLength, SQL_DRIVER_NOPROMPT));
  FConnected := True;
end;

constructor TOdbcConnection.Create;
begin
  Create(TOdbcEnvironment.Global.Handle);
end;

constructor TOdbcConnection.Create(AEnvHandle: SQLHEnv);
begin
  FEnvHandle := AEnvHandle;
  AllocHandle;
end;

destructor TOdbcConnection.Destroy;
begin
  Disconnect;
  FreeHandle;
  inherited;
end;

procedure TOdbcConnection.Disconnect;
begin
  if not FConnected then Exit;
  FConnected := False;
  Check(SQLDisconnect(FHandle));
end;

procedure TOdbcConnection.FreeHandle;
begin
  Check(SQLFreeHandle(SQL_HANDLE_DBC, FHandle));
end;

procedure TOdbcConnection.Rollback;
begin
  Check(SQLEndTran(SQL_HANDLE_DBC, FHandle, SQL_ROLLBACK));
  Check(SQLSetConnectAttr(FHandle, SQL_ATTR_AUTOCOMMIT, Pointer(SQL_AUTOCOMMIT_ON), 0));
  FInTransaction := False;
end;

procedure TOdbcConnection.SetLoginTimeout(const Value: Integer);
begin
  Check(SQLSetConnectAttr(FHandle, SQL_ATTR_LOGIN_TIMEOUT, PSQLUINTEGER(Value), SQL_IS_UINTEGER));
end;

{ TOdbcEnvironment }

procedure TOdbcEnvironment.AllocHandle;
begin
  Check(SQLAllocHandle(SQL_HANDLE_ENV, SQL_NULL_HANDLE, FHandle));
  Check(SQLSetEnvAttr(FHandle, SQL_ATTR_ODBC_VERSION, SQLPOINTER(SQL_OV_ODBC3), 0));
end;

procedure TOdbcEnvironment.Check(ReturnCode: SQLReturn);
begin
  OdbcCheck(ReturnCode, SQL_HANDLE_ENV, FHandle)
end;

constructor TOdbcEnvironment.Create;
begin
  if not LoadOdbcLibrary then
    raise EAureliusOdbcException.CreateFmt('Could not load Odbc library "%s"', [OdbcDLLName]);
  AllocHandle;
end;

destructor TOdbcEnvironment.Destroy;
begin
  FreeHandle;
  inherited;
end;

procedure TOdbcEnvironment.FreeHandle;
begin
  Check(SQLFreeHandle(SQL_HANDLE_ENV, FHandle));
end;

function TOdbcEnvironment.GetDriver(Direction: SQLUSmallint; out DriverName,
  DriverAttr: string): Boolean;
const
  NameMaxLen = 255;
  AttrMaxLen = 1000;
var
  Status: SQLReturn;
  NameLen, AttrLen: SQLSmallInt;
begin
  SetLength(DriverName, NameMaxLen);
  SetLength(DriverAttr, AttrMaxLen);
  NameLen := 0;
  AttrLen := 0;
  Status := SQLDrivers(FHandle, Direction, PSQLChar(DriverName), NameMaxLen, NameLen,
    PSQLChar(DriverAttr), AttrMaxLen, AttrLen);
  Result := Status <> SQL_NO_DATA;
  if Result then
    Check(Status);
  SetLength(DriverName, NameLen);
  SetLength(DriverAttr, AttrLen);
end;

procedure TOdbcEnvironment.GetDriverNames(Drivers: TStrings);
var
  DriverName, DriverAttr: string;
begin
  Drivers.Clear;
  if GetDriver(SQL_FETCH_FIRST, DriverName, DriverAttr) then
  begin
    Drivers.Add(DriverName);
    while GetDriver(SQL_FETCH_NEXT, DriverName, DriverAttr) do
      Drivers.Add(DriverName);
  end;
end;

class function TOdbcEnvironment.Global: TOdbcEnvironment;
var
  LocalEnv: TOdbcEnvironment;
begin
  if FGlobal = nil then
  begin
    LocalEnv := TOdbcEnvironment.Create;
    if TInterlocked.CompareExchange<TOdbcEnvironment>(FGlobal, LocalEnv, nil) <> nil then
      LocalEnv.Free;
  end;
  Result := FGlobal;
end;

function TOdbcEnvironment.MatchDriver(ValidDrivers: TArray<string>): string;
var
  DriverNames: TStrings;
  ValidDriver: string;
  I: Integer;
begin
  DriverNames := TStringList.Create;
  try
    GetDriverNames(DriverNames);
    for ValidDriver in ValidDrivers do
      for I := 0 to DriverNames.Count - 1 do
        if SameText(ValidDriver, DriverNames[I]) then
          Exit(ValidDriver);
    Result := '';
  finally
    DriverNames.Free;
  end;
end;

class procedure TOdbcEnvironment.Release;
begin
  if FGlobal <> nil then
    FGlobal.Free;
end;

initialization
finalization
  TOdbcEnvironment.Release;
end.
