Skip to content

Storage Drivers Development

The NodeActa server relies on Storage Drivers to access data storage. While data storage is typically a database, it can encompass any form of persistent memory. The Storage Driver's role is to interpret and interact with this persistent memory. System by default is using Firebird 5.0 database for data storage. Firebird is an open-source SQL relational database management system that supports Linux, Microsoft Windows, macOS and other Unix platforms. The database forked from Borland's open source edition of InterBase in 2000 but the code has been largely rewritten since Firebird 1.5.

The Oracle database can be also used as data storage. Oracle can be used as the primary data storage and host the entire system, or it can be used as additional data storage for specific document classes where a large volume of documents is expected (hundreds of millions or even billions). To be clear, Firebird is absolutely capable of storing billions of reords, but nevertheless, Oracle RDBMS remamins the World's performance champion. Hint: Enterprise License is required to access Oracle data storages.

Currently, NodeActa server supports Firebird and Oracle RDBMS. However, we plan to expand compatibility to include other popular RDBMS in the future.

If Firebird and Oracle are not suitable for your needs, or if you have another data source you wish to integrate with the NodeActa system, we provide the option to develop your own custom storage driver. You can use any development environment that supports generating dlls and exporting methods using the __stdcall calling convention. We recommend using either Visual Studio (Community Edition is sufficient) or Embarcadero Delphi/C++ (Community Edition is also sufficient). Your library must export the following methods:

void* __stdcall CreateDriver( 
    const char16_t*                name, 
    const TDriverCreateParameters* parameters, 
    TDriverInfo*                   info 
);

void __stdcall FreeDriver( 
    void* driver 
);

void* __stdcall CreateTransaction( 
    void* driver 
);

void __stdcall FreeTransaction( 
    void* transaction 
);

int __stdcall StartTransaction( 
    void* transaction 
);

bool __stdcall CommitTransactionPhase1( 
    void* transaction 
);

bool __stdcall CommitTransactionPhase2( 
    void* transaction 
);

bool __stdcall RollbackTransaction( 
    void* transaction 
);

const char16_t* __stdcall TransactionError( 
    void* transaction 
);

void* __stdcall ExecuteSQL( 
    void*             transaction, 
    const char16_t*   sql, 
    TDriverParameter* parameters, 
    int               parameters_count, 
    TDriverResult*    result_info 
);

void* __stdcall ExecuteProcedure( 
    void*             transaction, 
    const char16_t*   sql, 
    TDriverParameter* parameters, 
    int               parameters_count, 
    TDriverResult*    result_info 
);

void __stdcall ReadSQLResult( 
    void*   sql_result, 
    TValue* data, 
    int*    fetched 
);

void __stdcall FreeSQLResult( 
    void* sql_result 
);

TValue __stdcall NextSequenceValue( 
    void*           driver, 
    const char16_t* name, 
    int             increment 
);

void* __stdcall GetSchema( 
    void*                    transaction, 
    char16_t*                table, 
    TDriverTableField**      fields, 
    int*                     fields_count, 
    TDriverTableIndex**      indices, 
    int*                     indices_count, 
    TDriverTableConstraint** constraints, 
    int*                     constraint_count 
);

void __stdcall FreeSchema( 
    void* schema 
);
function CreateDriver( 
    name: PChar; 
    parameters: PDriverCreateParameters; 
    info: PDriverInfo 
): Pointer; stdcall;

procedure FreeDriver( 
    driver: Pointer 
); stdcall;

function CreateTransaction( 
    driver: Pointer 
): Pointer; stdcall;

procedure FreeTransaction( 
    transaction: Pointer 
); stdcall;

function StartTransaction( 
    transaction: Pointer 
): Integer; stdcall;

function CommitTransactionPhase1( 
    transaction: Pointer 
): Boolean; stdcall;

function CommitTransactionPhase2( 
    transaction: Pointer 
): Boolean; stdcall;

function RollbackTransaction( 
    transaction: Pointer 
): Boolean; stdcall;

function TransactionError( 
    transaction: Pointer 
): PChar; stdcall;

function ExecuteSQL( 
    transaction: Pointer; 
    sql: PChar; 
    parameters: PDriverParameter; 
    parametersCount: Integer; 
    info: PDriverResult 
): Pointer; stdcall;

procedure ExecuteDDL( 
    transaction: Pointer; 
    sql: PChar; 
    parameters: PDriverParameter; 
    parametersCount: Integer
); stdcall;

function ExecuteProcedure( 
    transaction: Pointer; 
    proc: PChar; 
    parameters: PDriverParameter; 
    parametersCount: Integer; 
    info: PDriverResult 
): Pointer; stdcall;

procedure ReadSQLResult( 
    sql_result: Pointer; 
    data: PValue; 
    fetched: PInteger 
); stdcall;

procedure FreeSQLResult( 
    sql_result: Pointer 
); stdcall;

function NextSequenceValue( 
    driver: Pointer; 
    name: PChar 
): Variant; stdcall;

function GetSchema( 
    transaction: Pointer; 
    table: PChar;
    var fields: PDriverTableField; 
    var fields_count: Integer;
    var indices: PDriverTableIndex; 
    var indices_count: Integer;
    var constraints: PDriverTableConstraint; 
    var constraint_count: Integer 
): Pointer; stdcall;

procedure FreeSchema( 
    Schema: Pointer 
); stdcall;

Example 1

Here is a simplified driver example in C++. This code is from our nodeacta.directoryservices driver implementation. This is a great example of a scenario where a relational database is not used, but instead, an Active Directory is utilized.
Hint: Extremely important line of code is:
#pragma pack(push, 1) // IMPORTANT!!! to be able to pass packed records

#ifndef DRIVER_H
#define DRIVER_H

#if defined(_MSC_VER) 
#define STDCALL __stdcall
#else
#define STDCALL
#define CDECL
#endif

#define MAX_KIND_LEN 20
#define MAX_FIELD_LEN 128
#define MAX_INDEX_LEN 30
#define MAX_CONSTRAINT_LEN 30
#define MAX_TABLE_LEN 30
#define MAX_INDEX_FIELDS_LEN 256
#define MAX_CONSTRAINT_FIELDS_LEN 256
#define MAX_DESCRIPTION_LEN 256

#pragma pack(push, 1) // IMPORTANT!!! to be able to pass packed records

#if _WIN32 || _WIN64
#else
typedef struct _GUID 
{
    unsigned long  Data1;
    unsigned short Data2;
    unsigned short Data3;
    unsigned char  Data4[8];
} GUID;
#endif

typedef void*(CDECL*TDriverAllocMem)( size_t size );
typedef void*(CDECL*TDriverReallocMem)( void* p, size_t size );
typedef void(CDECL*TDriverFreeMem)( void* p );

struct TDriverCreateParameters
{
    TDriverAllocMem     AllocMemory;
    TDriverReallocMem   ReallocMemory;
    TDriverFreeMem      FreeMemory;
    const char16_t*     Name;
    const char16_t*     Host;
    const char16_t*     User;
    const char16_t*     Password;
    const char16_t*     Charset;
    int                 LicenceCount;
    const char16_t*     Config;
};

struct TDriverInfo
{
    char16_t        Kind[MAX_KIND_LEN];
    int             Flags;
    bool            Valid;
    const char16_t* Error;          // Pointer to driver's owned last error string 
    void*           Syntax;         // unused
};

/*************************************DRIVER INTERFACE**************************************************************/

enum TValueType : uint16_t
{
    vtEmpty = 0xFFFF,
    vtNull = 0x0000,
    vtInt8 = 0x0001,
    vtInt16 = 0x0002,
    vtInt32 = 0x0003,
    vtInt64 = 0x0004,
    vtCurrency = 0x0008,
    vtBool = 0x0010,
    vtUInt8 = 0x0011,
    vtUInt16 = 0x0012,
    vtUInt32 = 0x0013,
    vtUInt64 = 0x0014,
    vtFloat = 0x0020,
    vtDouble = 0x0021,
    vtDate = 0x0022,
    vtTime = 0x0023,
    vtDateTime = 0x0024,
    vtAnsiString = 0x0100,
    vtWideString = 0x0101,
    vtBytes = 0x0A00,
    vtGuid = 0x0A01
};

struct TAnsiString
{
    uint32_t Size;
    char*    Data;
};

struct TWideString
{
    uint32_t  Size;
    char16_t* Data;
};

struct TBytes
{
    uint32_t Size;
    uint8_t* Data;
};

struct TDateStamp
{
    int16_t Year;
    int16_t Month;
    int16_t Day;
};

struct TTimeStamp
{
    int16_t Hour;
    int16_t Minute;
    int16_t Second;
    int16_t Milliseconds;
};

struct TDateTimeStamp
{
    int16_t Year;
    int16_t Month;
    int16_t Day;
    int16_t Hour;
    int16_t Minute;
    int16_t Second;
    int16_t Milliseconds;
};

struct TValue
{
    TValueType Type;
    union
    {
        uint16_t AsBool;
        int8_t AsInt8;
        uint8_t AsUInt8;
        int16_t AsInt16;
        uint16_t AsUInt16;
        int32_t AsInt32;
        uint32_t AsUInt32;
        int64_t AsInt64;
        uint64_t AsUInt64;
        int64_t AsCurrency;
        float AsFloat;
        double AsDouble;
        TDateStamp AsDate;
        TTimeStamp AsTime;
        TDateTimeStamp AsDateTime;
        TAnsiString AsAnsiString;
        TWideString AsWideString;
        TBytes AsBytes;
        GUID* AsGuid;
    };
};

struct TFieldInfo
{
    char16_t*   Name;
    TValueType  Type;
};

struct TDriverInfoFlags
{
    static const int None = 0;
    static const int PoolConnections = 1; // Set if driver is performing connections pooling 
    static const int ShareMemory = 2;     // Set if ShareMemory is true this library must either use SimpleShareMem (written in Embarcadero/Borland C++ or Delphi) 
    static const int ReadSchema = 4;
    static const int WriteSchema = 8;
};

struct TDriverParameter
{
    const char16_t* Name;
    const uint8_t   Kind; // 0-in, 1-out, 2-in/out
    TValue          Value;
};

struct TDriverResult
{
    int             FieldsCount;
    TFieldInfo*     Fields;    
    int             Fetched;
    const char16_t* Error;
};

enum TFieldType : uint8_t
{
    dtNone = 0,
    dtBoolean = 1,
    dtInteger = 2,
    dtLargeint = 3,
    dtNumeric = 4,
    dtCurrency = 5, // NUMERIC(x,4) -> x depends on database support
    dtFloat = 6,
    dtDouble = 7,
    dtFMTBcd = 8,
    dtDate = 9,
    dtTime = 10,
    dtDateTime = 11,
    dtFixString = 12,
    dtVarString = 13,
    dtMemo = 16,     // blob subtype 1
    dtBlob = 18      // blob subtype 0
};

struct TDriverTableField
{
    char16_t    Name[MAX_FIELD_LEN];
    char16_t    Description[MAX_DESCRIPTION_LEN];
    TFieldType  Type;
    int         Size;
    int         Scale;
    bool        Nullable;
};

struct TDriverTableIndex

{
    char16_t    Name[MAX_INDEX_LEN];
    char16_t    Fields[MAX_INDEX_FIELDS_LEN];
    bool        IsUnique;
};

enum TUpdateRule : uint8_t
{
    urNoAction = 0,
    urCascade = 1,
    urSetNull = 2,
    urSetDefault = 3,
    urRestrict = 4
};

enum TDeleteRule : uint8_t
{
    drNoAction = 0,
    drCascade = 1,
    drSetNull = 2,
    drSetDefault = 3,
    drRestrict = 4
};

struct TDriverTableConstraint
{
    char16_t    Name[MAX_CONSTRAINT_LEN];
    char16_t    TableName[MAX_TABLE_LEN];
    char16_t    FieldName[MAX_CONSTRAINT_FIELDS_LEN];
    bool        IsPrimaryKey;
    bool        IsForeignKey;
    bool        IsUniqueKey;
    char16_t    RefTableName[MAX_TABLE_LEN];
    char16_t    RefFieldName[MAX_CONSTRAINT_FIELDS_LEN];
    TUpdateRule UpdateRule;
    TDeleteRule DeleteRule;
};
#pragma pack(pop) 

#ifdef __cplusplus
extern "C" {
#endif
    void* STDCALL CreateDriver( const char16_t* name, const TDriverCreateParameters* parameters, TDriverInfo* info );
    void STDCALL FreeDriver( void* driver );
    void* STDCALL CreateTransaction( void* driver );
    void STDCALL FreeTransaction( void* transaction );
    int STDCALL StartTransaction( void* transaction );
    bool STDCALL CommitTransactionPhase1( void* transaction );
    bool STDCALL CommitTransactionPhase2( void* transaction );
    bool STDCALL RollbackTransaction( void* transaction );
    const char16_t* STDCALL TransactionError( void* transaction );
    void* STDCALL ExecuteSQL( void* transaction, const char16_t* sql, TDriverParameter* parameters, int parameters_count, TDriverResult* result_info );
    void* STDCALL ExecuteProcedure( void* transaction, const char16_t* sql_, TDriverParameter* parameters, int parameters_count, TDriverResult* result_info );
    void STDCALL ReadSQLResult( void* sql_result, TValue* data, int* fetched );
    TValue STDCALL NextSequenceValue( void* driver, const char16_t* name, int increment );
    void STDCALL FreeSQLResult( void* sql_result );
    void* STDCALL GetSchema( void* transaction, char16_t* table, TDriverTableField** fields, int* fields_count, TDriverTableIndex** indices, int* indices_count, TDriverTableConstraint** constraints, int* constraint_count );
    void STDCALL FreeSchema( void* schema );

#ifdef __cplusplus
}
#endif

#endif    
#include <sys/types.h>
#include <sys/stat.h>
#include <string>
#include <map>
#include "SQLParser.h"
#include "DS.h"
#include "DSCore.h"
#include "Driver.h"

// conversion functions
namespace nv
{
    std::string val2stre( const TValue& v, std::u16string& _error )
    {
        switch( v.Type )
        {
        case vtEmpty: break;
        case vtNull: break;
        case vtInt8:
            return std::to_string( v.AsInt8 );
        case vtInt16:
            return std::to_string( v.AsInt16 );
        case vtInt32:
            return std::to_string( v.AsInt32 );
        case vtInt64:
            return std::to_string( v.AsInt64 );
        case vtCurrency:
            return std::to_string( v.AsCurrency );
        case vtBool:
            return v.AsBool ? "TRUE" : "FALSE";
        case vtUInt8:
            return std::to_string( v.AsUInt8 );
        case vtUInt16:
            return std::to_string( v.AsUInt16 );
        case vtUInt32:
            return std::to_string( v.AsUInt32 );
        case vtUInt64:
            return std::to_string( v.AsUInt64 );
        case vtFloat:
            return std::to_string( v.AsFloat );
        case vtDouble:
            return std::to_string( v.AsDouble );
        case vtDate:
            _error += u"Query parse error: Directory Services storage does not support type Date!\r\n";
            break;
        case vtTime:
            _error += u"Query parse error: Directory Services storage does not support type Time!\r\n";
            break;
        case vtDateTime:
            _error += u"Query parse error: Directory Services storage does not support type DateTime!\r\n";
            break;
        case vtAnsiString:
            return v.AsAnsiString.Data;
        case vtWideString:
            return nv::w2str( v.AsWideString.Data );
        case vtBytes:
            _error += u"Query parse error: Directory Services storage does not support type Bytes!\r\n";
            break;
        case vtGuid:
            _error += u"Query parse error: Directory Services storage does not support type Guid!\r\n";
            break;
        }
        return "";
    }

    std::string val2str( const TValue& v )
    {
        std::u16string _error;
        return val2stre( v, _error );
    }
}

/*************************************DRIVER Internals**************************************************************/

struct Driver
{
public:
    Driver( const char16_t* name, const TDriverCreateParameters* parameters );
    const char* attributes( const char* field );

    std::u16string         Storage;
    std::u16string         Host;
    bool                   SSL;
    std::u16string         User;
    std::u16string         Password;
    std::u16string         Error;
    std::u16string         ConfigPath;
    std::unique_ptr<nv::ds::DirectoryServices> DS;

    TDriverAllocMem      AllocMemory;
    TDriverReallocMem    ReallocMemory;
    TDriverFreeMem       FreeMemory;

private:
    std::map<std::string, const char*> _attributes;
};

struct Transaction;

enum class ResultType
{
    rtSQL,
    rtProcedure
};

struct Result
{
    Transaction*     transaction;
    ResultType       type;
    nv::ds::Accounts accounts;
    int              fieldCount = 0;
    TFieldInfo*      fields = nullptr;
    int              current = 0;

    ~Result()
    {
        for( auto i = 0; i < fieldCount; i++ )
            if( fields[i].Name)
                delete fields[i].Name;
        delete[] fields;
    }

    static TFieldInfo* getFieldPtrs( std::vector<std::u16string> const& fields )
    {
        TFieldInfo* fieldPtrs = new TFieldInfo[fields.size()];
        for( auto i = 0; i < fields.size(); i++ )
        {
            fieldPtrs[i].Name = new char16_t[fields[i].size()+1];
            nv::str16cpy( fieldPtrs[i].Name, fields[i].c_str() );
        }
        return fieldPtrs;
    }
};

struct Transaction
{
public:
    Transaction( Driver* driver_ );
    Result* executeSQL( const char16_t* sql_, TDriverParameter* parameters_, int parameters_count );
    Result* executeProcedure( const char16_t* sql_, TDriverParameter* parameters, int parameters_count );
    const char16_t* error() const { return _error.c_str(); }

private:
    std::vector<TDriverParameter*> sortParameters( const std::u16string& sql, TDriverParameter* parameters, int parameters_count );
    TDriverParameter* parameterByName( TDriverParameter* parameters, int parameters_count, const char16_t* name );

    Driver*         _driver;
    std::u16string  _error;
};

/*************************************Implementation**************************************************************/

#pragma region Driver

Driver::Driver( const char16_t* name, const TDriverCreateParameters* parameters )
{
    nv::ds::RootDSEType type = nv::ds::RootDSEType::ActiveDirectory;

    Host = parameters->Host;
    SSL = false;
    auto DSTypeAndHost = nv::tokenize( Host, L':' );
    if( DSTypeAndHost.size() > 0 )
        if( nv::starts_with( DSTypeAndHost[0], u"AD" ) )
        {
            type = nv::ds::RootDSEType::ActiveDirectory;
            SSL = true;
        }
        else if( nv::starts_with( DSTypeAndHost[0], u"LDAPS" ) )
        {
            type = nv::ds::RootDSEType::LDAP; 
            SSL = true;
        }
        else if( nv::starts_with( DSTypeAndHost[0], u"LDAP" ) )
        {
            type = nv::ds::RootDSEType::LDAP;
            SSL = false;
        }
        else
            Error = u"Directory Services driver: Storage 'host' parameter must start with AD: or LDAP:";
    if( DSTypeAndHost.size() > 1 )
        Host = DSTypeAndHost[1];
    Storage = parameters->Name;
    User = parameters->User;
    Password = parameters->Password;
    ConfigPath = parameters->Config;

    AllocMemory = parameters->AllocMemory;
    ReallocMemory = parameters->ReallocMemory;
    FreeMemory = parameters->FreeMemory;

    DS.reset( new nv::ds::DirectoryServices( type, nv::w2str( Storage.c_str() ), nv::w2str( Host.c_str() ), nv::w2str( User.c_str() ), nv::w2str( Password.c_str() ), SSL, nv::w2str( ConfigPath.c_str() ) ) );
    if( !DS->isValid() )
        Error = nv::str2s16( DS->Error() );
}

const char* Driver::attributes( const char* field )
{
    if( _attributes.empty() )
    {
        // ID           VARCHAR( 32 )        
        // TYP          INTEGER
        // NAME         VARCHAR(20)
        // DSDN         VARCHAR(255)
        // LABEL        VARCHAR( 150 )
        // PWD          VARCHAR( 65 )
        // ENABLED      CHAR(1)         'T' or 'F' 
        // DESCRIPTION  VARCHAR( 255 ) 
        // OCCUPATION   VARCHAR( 50 )
        // TITLE        VARCHAR( 10 )
        _attributes.emplace( "ID", this->DS->schema()->attribute->userId() );
        _attributes.emplace( "TYP", "TYP" );
        _attributes.emplace( "NAME", DS->schema()->attribute->name() );
        _attributes.emplace( "DSDN", DS->schema()->attribute->distinguishedName() );
        _attributes.emplace( "LABEL", DS->schema()->attribute->displayName() );
        // not supported _attributes.emplace( "PWD", "" );
        // not supported _attributes.emplace( "ENABLED", "" );
        // not supported _attributes.emplace( "DESCRIPTION", "" );
        _attributes.emplace( "TITLE", DS->schema()->attribute->title() );
    }
    auto it = _attributes.find( nv::upper( field ) );
    if( it != _attributes.end() )
        return it->second;
    else
        return nullptr;
}

#pragma endregion 

#pragma region Transaction

Transaction::Transaction( Driver* driver_ ) 
    : _driver( driver_ )
{
}

Result* Transaction::executeSQL( const char16_t* sql_, TDriverParameter* parameters_, int parameters_count )
{
    _error.clear();

    // ID           VARCHAR( 32 )        
    // TYP          INTEGER
    // NAME         VARCHAR(20)
    // DSDN         VARCHAR(255)
    // LABEL        VARCHAR( 150 )
    // PWD          VARCHAR( 65 )
    // ENABLED      CHAR(1)         'T' or 'F' 
    // DESCRIPTION  VARCHAR( 255 ) 
    // OCCUPATION   VARCHAR( 50 )
    // TITLE        VARCHAR( 10 )

    std::u16string sql = sql_;
    sql = nv::replace( sql, u"\t", u" " );
    sql = nv::replace( sql, u"\r", u" " );
    sql = nv::replace( sql, u"\n", u" " );
    sql = nv::replace( sql, u"$",  u"_" );

    auto parameters = sortParameters( sql, parameters_, parameters_count );
    // Rename parameters in form :PAR to ?
    for( auto parameter : parameters )
    {
        std::u16string name( parameter->Name );
        auto found = sql.find( ( u":" + name ) );
        if( found != std::u16string::npos )
            sql = nv::replace( sql, u":" + name, u"?" );
    }

    hsql::SQLParserResult result;
    hsql::SQLParser::parse( nv::w2str( sql.c_str() ), &result );

    if( !result.isValid() || result.size() == 0 )
    {
        _error = u"Query parse error.\r\nExecuted Query: !";
        _error += sql;
        return nullptr;
    }

    const hsql::SQLStatement* statement = result.getStatement( 0 );
    if( statement->isType( hsql::kStmtSelect ) )
    {
        const auto* select = static_cast<const hsql::SelectStatement*>( statement );
        std::vector<std::u16string> fields;
        if( select->selectList )
            for( const auto sel : *select->selectList )
                fields.push_back( nv::str2s16( sel->getName() ) );
        if( strcmpi( select->fromTable->name, "SYS_GRANTEE" ) == 0 || strcmpi( select->fromTable->name, "SYS_DSGRANTEE" ) == 0 )
        {
            std::function< std::string( hsql::Expr* ) > processWhere = [&]( hsql::Expr* expr ) -> std::string
            {
                switch( expr->type )
                {
                case hsql::kExprOperator:
                {
                    switch( expr->opType )
                    {
                    case hsql::kOpBetween:
                        if( expr->exprList->size() == 2 )
                            return nv::format( "(&(%s>%s)(%s<%s))", expr->expr->getName(), processWhere( expr->exprList->at( 0 ) ).c_str(), expr->expr->getName(), processWhere( expr->exprList->at( 0 ) ).c_str() );
                        else
                            _error += u"Query parse error. Invalid between clause!\r\n"; break;
                    case hsql::kOpPlus:
                        return nv::format( "(%s+%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpMinus:
                        return nv::format( "(%s-%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpSlash:
                        return nv::format( "(%s?/%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpPercentage:
                        return nv::format( "(%s%%%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpEquals:
                        return nv::format( "(%s=%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpNotEquals:
                        return nv::format( "(!(%s=%s))", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpLess:
                        return nv::format( "(%s<%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpLessEq:
                        return nv::format( "(%s<=%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpGreater:
                        return nv::format( "(%s>%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpGreaterEq:
                        return nv::format( "(%s>=%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpLike:
                        return nv::format( "(%s=%s)", processWhere( expr->expr ).c_str(), nv::replace( processWhere( expr->expr2 ), "%", "*" ).c_str() );
                    case hsql::kOpNotLike:
                        return nv::format( "(!(%s=%s))", processWhere( expr->expr ).c_str(), nv::replace( processWhere( expr->expr2 ), "%", "*" ).c_str() );
                    case hsql::kOpAnd:
                        return nv::format( "(&%s%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpOr:
                        return nv::format( "(|%s%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
                    case hsql::kOpConcat:
                        return processWhere( expr->expr ) + processWhere( expr->expr2 );
                    case hsql::kOpNot:
                        return "!" + processWhere( expr->expr );
                    case hsql::kOpUnaryMinus:
                        return "-" + processWhere( expr->expr );
                    case hsql::kOpIsNull:
                        return nv::format( "!(%s=*)", processWhere( expr->expr ).c_str() );
                    case hsql::kOpIn:
                    case hsql::kOpILike:
                    case hsql::kOpCaret:    //^
                    case hsql::kOpAsterisk: //*
                    case hsql::kOpExists:
                    case hsql::kOpCase:
                    case hsql::kOpCaseListElement:  // `WHEN expr THEN expr`
                        _error += u"Query parse error. Invalid between clause!\r\n"; break;
                    }
                case hsql::kExprLiteralFloat:
                    return std::to_string( expr->fval );
                case hsql::kExprLiteralString:
                    return expr->name;
                case hsql::kExprLiteralInt:
                    if( expr->isBoolLiteral )
                        return expr->ival ? "FALSE" : "TRUE";
                    else
                        return std::to_string( expr->ival );
                case hsql::kExprLiteralNull:
                    return "";
                case hsql::kExprLiteralDate:
                    return expr->name;
                case hsql::kExprColumnRef:
                    if( auto attr = _driver->attributes( expr->name ) )
                        return attr;
                    else
                        _error += nv::str2s16( nv::format( "Query parse error: Directory Services storage does not support qurey with %s attribute!\r\n", expr->name ) ); break;
                case hsql::kExprParameter:
                    if( (int)expr->ival < (int)parameters.size() )
                        return nv::val2stre( parameters[(int)expr->ival]->Value, _error );
                    else
                        return "";
                case hsql::kExprStar:
                case hsql::kExprFunctionRef:
                    if( strcmpi( expr->name, "lower" ) == 0 )
                        return nv::lower( processWhere( expr->exprList->at( 0 ) ) );
                    else if( strcmpi( expr->name, "upper" ) == 0 )
                        return nv::upper( processWhere( expr->exprList->at( 0 ) ) );
                    else
                        _error += u"Query parse error: Directory Services storage does not support other attribute reference!\r\n"; break;
                case hsql::kExprSelect:
                case hsql::kExprHint:
                case hsql::kExprArray:
                case hsql::kExprArrayIndex:
                case hsql::kExprExtract:
                case hsql::kExprCast:
                    _error += u"Query parse error. Unsuported where clause!\r\n"; break;
                }
                }
                return {};
            };

            auto qry = processWhere( select->whereClause );
            // HINT: Correct grantee type values 
            // TYP=1 -> add driver->DS->schema()->query->users() 
            // TYP=2 -> add driver->DS->Schema()->query->groups() 
            // none  -> add users() or groups() 
            auto typeUsers = strstr( qry.c_str(), "TYP=1" );
            auto typeGroups = strstr( qry.c_str(), "TYP=2" );
            if( typeUsers )
                qry = nv::replace( qry, "(TYP=1)", _driver->DS->schema()->query->users() );
            if( typeGroups )
                qry = nv::replace( qry, "(TYP=2)", _driver->DS->schema()->query->groups() );
            if( !typeUsers && !typeGroups )
                qry = nv::format( "(&(|%s%s)%s)", _driver->DS->schema()->query->users(), _driver->DS->schema()->query->groups(), qry.c_str() );

            return new Result{ this, ResultType::rtSQL, _driver->DS->QueryAccounts( qry, {} ), (int)fields.size(), Result::getFieldPtrs(fields) };
        }
        else if( strcmpi( select->fromTable->name, "V_GRANTEE_MEMBER_OF" ) == 0 )
        {
            if( parameters.size() == 1 )
            {
                auto result = new Result{ this, ResultType::rtSQL, {}, (int)fields.size(), Result::getFieldPtrs( fields ) };

                std::string granteeDN;
                switch( parameters[0]->Value.Type )
                {
                case TValueType::vtAnsiString:
                    granteeDN = parameters[0]->Value.AsAnsiString.Data;
                    break;
                case TValueType::vtWideString:
                    granteeDN = nv::w2str( parameters[0]->Value.AsWideString.Data );
                    break;
                default:
                    _error += nv::str2s16( nv::format( "Directory Services storage has incorect parameters type for V_GRANTEE_MEMBER_OF!\r\n" ) );
                }
                if( !granteeDN.empty() )
                {
                    auto accounts = _driver->DS->QueryUsers( {}, granteeDN, {}, {} );
                    if( !accounts.empty() )
                        result->accounts = _driver->DS->MemberOf( *accounts[0], {} );
                }
                return result;
            }
            _error += nv::str2s16( nv::format( "Directory Services storage has incorect parameters for V_GRANTEE_MEMBER_OF!\r\n" ) );
        }
        else
        {
            _error += nv::str2s16( nv::format( "Directory Services storage cannot use class %s!\r\nOnly allowed class is SYS$GRANTEE/SYS$DSGRANTEE.", select->fromTable->name ) );
        }
    }
    else
    {
        _error = u"Directory Services storage is read only and allows only read queries!";
    }
    return nullptr;
}

Result* Transaction::executeProcedure( const char16_t* sql_, TDriverParameter* parameters, int parameters_count )
{
    _error.clear();

    if( nv::starts_with( sql_, u"AUTHENTICATE_GRANTEE" ) )
    {
        auto name = parameterByName( parameters, parameters_count, u"NAME" );
        auto password = parameterByName( parameters, parameters_count, u"PWD" );
        auto authenticated = parameterByName( parameters, parameters_count, u"AUTHENTICATED" );

        // If password value is specified => it's a logon attempt
        if( name && password )
        {
            if( auto user = _driver->DS->Logon( nv::val2str( name->Value ), nv::val2str( password->Value ) ) )
            {
                authenticated->Value.Type = TValueType::vtInt16;
                authenticated->Value.AsInt16 = 1;
                return new Result{ this, ResultType::rtProcedure, { user }, 0, nullptr };
            }
            else
                return nullptr;
        }
    }

    _error = u"Directory Services storage supports only AUTHENTICATE_GRANTEE(NAME,PWD) procedure!";
    return nullptr;
}

std::vector<TDriverParameter*> Transaction::sortParameters( const std::u16string& sql, TDriverParameter* parameters, int parameters_count )
{
    // HINT: search sql and check position in text where each parameter starts => then use to order them and replace them in text with ?
    std::vector< std::pair<int, TDriverParameter*>> parameter_ordering; // <position,parameter>
    for( int i = 0; i < parameters_count; ++i )
    {
        std::u16string name( parameters[i].Name );
        if( auto pos = sql.find( name ) )
            parameter_ordering.emplace_back( (int)pos, &parameters[i] );
    }
    std::sort( parameter_ordering.begin(), parameter_ordering.end(), []( const auto& a, const auto& b ) { return a.first < b.first; } );

    std::vector<TDriverParameter*> result;
    for( auto& [pos, parameter] : parameter_ordering )
        result.push_back( parameter );

    return result;
}

TDriverParameter* Transaction::parameterByName( TDriverParameter* parameters, int parameters_count, const char16_t* name )
{
    for( int i = 0; i < parameters_count; ++i )
    {
        std::u16string tmp( parameters[i].Name );
        if( tmp.find( name ) != std::u16string::npos )
            return &parameters[i];
    }
    return nullptr;
}
#pragma endregion 


//*************************************************DRIVER IMPLEMENTATION************************************/
// Method   : CreateDriver is driver's entry point 
// Arguments: [in] naem       - Storage Name
//            [in] parameters - storage=<storage-name>,host=<host-name>,user=<user>,password=<password>,charset=<character-set>
//            [in/out] info    

void* STDCALL CreateDriver( const char16_t* name, const TDriverCreateParameters* parameters, TDriverInfo* info )
{
    auto driver = new Driver( name, parameters );

    memset( info->Kind, 0, MAX_KIND_LEN );
    memcpy( info->Kind, u"DirectoryServices", strlen("DirectoryServices")*2 );
    info->Error = driver->Error.c_str();
    info->Flags = 0;
    info->Valid = driver->DS->isValid() && driver->Error.empty();

    return driver;
}

void STDCALL FreeDriver( void* driver )
{
    delete (Driver*)driver;
}

void* STDCALL CreateTransaction( void* driver )
{
    return new Transaction{ (Driver*)driver };
}

void STDCALL FreeTransaction( void* transaction )
{
    delete (Transaction*)transaction;
}

int STDCALL StartTransaction( void* transaction )
{
    return 1;
}

bool STDCALL CommitTransactionPhase1( void* transaction )
{
    return true;
}

bool STDCALL CommitTransactionPhase2( void* transaction )
{
    return true;
}

bool STDCALL RollbackTransaction( void* transaction )
{
    return true;
}

const char16_t* STDCALL TransactionError( void* transaction )
{
    return reinterpret_cast<Transaction*>( transaction )->error();
}

void* STDCALL ExecuteSQL( void* transaction, const char16_t* sql, TDriverParameter* parameters, int parameters_count, TDriverResult* result_info )
{
    if( auto result = reinterpret_cast<Transaction*>( transaction )->executeSQL( sql, parameters, parameters_count ) )
    {
        result_info->FieldsCount = result->fieldCount;
        result_info->Fields = result->fields;
        result_info->Fetched = (int)result->accounts.size();
        return result;
    }
    else
    {
        result_info->Error = reinterpret_cast<Transaction*>( transaction )->error();
        return nullptr;
    }
}

void* STDCALL ExecuteProcedure( void* transaction, const char16_t* sql_, TDriverParameter* parameters, int parameters_count, TDriverResult* result_info )
{
    if( auto result = reinterpret_cast<Transaction*>( transaction )->executeProcedure( sql_, parameters, parameters_count ) )
    {
        static TFieldInfo ProcedureResultFields[1] = { (char16_t*)u"AUTHENTICATED", TValueType::vtInt32 };
        result_info->FieldsCount = 1;
        result_info->Fields = ProcedureResultFields;
        result_info->Fetched = (int)result->accounts.size();
        return result;
    }
    else
    {
        result_info->Error = reinterpret_cast<Transaction*>( transaction )->error();
        return nullptr;
    }
}

void STDCALL ReadSQLResult( void* sql_result, TValue* data, int* fetched )
{   
    // tagVARIANT* data is atually tagVARIANT[RecordsCount * FieldsCount]
    // record rows are stored one after another

    // IMORTANT!!!
    // -if ShareMemory is false, strings can be stored ONLY as BSTR ( data->vt = 8; data->bstrVal = ... )
    // -if ShareMemory is true, strings can be stored as BSTR data->bstrVal ( data->vt = VT_BSTR; data->bstrVal = ... ), 
    //  but also as much faster char* ( for Borland C++/Delphi: data->vt = varString) 
    //  or char16_t* ( for Borland C++/Delphi: data->vt = varUString; For MS C++ data->vt = VT_LPWSTR ) 
    // For other than Embarcadero/Borland compilers used, ShareMemory must be false and only BSTR must be used for strings  

    *fetched = 0;
    if( auto result = (Result*)sql_result )
    {
        switch( result->type )
        { 
        case ResultType::rtProcedure:
        {
        }
        break;
        case ResultType::rtSQL:
        {
            *fetched = (int)result->accounts.size();
            const int _ID = 0;
            const int _NAME = 1;
            const int _DSDN = 2;
            const int _LABEL = 3;
            const int _ENABLED = 4;
            const int _TYP = 5;
            const int _DESCRIPTION = 6;
            const int _OCCUPATION = 7;
            const int _TITLE = 8;
            const int _LOCKPER = 9;
            int _indexes[10];
            for( auto i = 0; i < 10; i++)
                _indexes[i] = ( result->fieldCount > 0 ) ? -1 : i;

            for ( auto i = 0; i < result->fieldCount; i++ )
            {
                if( nv::starts_with( result->fields[i].Name, u"ID" ) )
                    _indexes[_ID] = i;
                else if( nv::starts_with( result->fields[i].Name, u"NAME" ) )
                    _indexes[_NAME] = i;
                else if( nv::starts_with( result->fields[i].Name, u"DSDN" ) )
                    _indexes[_DSDN] = i;
                else if( nv::starts_with( result->fields[i].Name, u"LABEL" ) )
                    _indexes[_LABEL] = i;
                else if( nv::starts_with( result->fields[i].Name, u"ENABLED" ) )
                    _indexes[_ENABLED] = i;
                else if( nv::starts_with( result->fields[i].Name, u"TYP" ) )
                    _indexes[_TYP] = i;
                else if( nv::starts_with( result->fields[i].Name, u"DESCRIPTION" ) )
                    _indexes[_DESCRIPTION] = i;
                else if( nv::starts_with( result->fields[i].Name, u"OCCUPATION" ) )
                    _indexes[_OCCUPATION] = i;
                else if( nv::starts_with( result->fields[i].Name, u"TITLE" ) )
                    _indexes[_TITLE] = i;
                else if( nv::starts_with( result->fields[i].Name, u"LOCKPER" ) )
                    _indexes[_LOCKPER] = i;
            }

            int idx = 0;
            int r = result->current;
            auto account = result->accounts[r];

            //ID
            idx = _indexes[_ID];
            if( idx > -1 )
            {
                auto id = std::string( account->id );
                if( id.size() < 32 )
                {
                    id.insert( id.begin(), 32 - id.length(), '0' );
                    strncpy( account->id, id.c_str(), AD_PROPERTY_LENGTH - 1 );
                }
                data[idx].Type = vtAnsiString;
                data[idx].AsAnsiString.Data = account->id;
                data[idx].AsAnsiString.Size = (uint16_t)id.length();
            }
            idx = _indexes[_NAME];
            if( idx > -1 )
            {
                data[idx].Type = vtAnsiString;
                data[idx].AsAnsiString.Data = account->name;
                data[idx].AsAnsiString.Size = (uint16_t)strlen( account->name );
            }
            idx = _indexes[_DSDN];
            if( idx > -1 )
            {
                data[idx].Type = vtAnsiString;
                data[idx].AsAnsiString.Data = account->distinguishedName;
                data[idx].AsAnsiString.Size = (uint16_t)strlen( account->distinguishedName );
            }
            idx = _indexes[_LABEL];
            if( idx > -1 )
            {
                data[idx].Type = vtAnsiString;
                data[idx].AsAnsiString.Data = ( strlen( account->displayName ) == 0 ) ? account->name : account->displayName;
                data[idx].AsAnsiString.Size = (uint16_t)strlen( data[idx].AsAnsiString.Data );
            }
            idx = _indexes[_ENABLED];
            if( idx > -1 )
            {
                data[idx].Type = vtAnsiString;
                data[idx].AsAnsiString.Data = (char*)"T";
                data[idx].AsAnsiString.Size = 1;
            }
            idx = _indexes[_TYP];
            if( idx > -1 )
            {
                data[idx].Type = vtInt16;
                data[idx].AsInt16 = ( account->type == nv::ds::AccountType::atUser ) ? 1 : 2;
            }
            idx = _indexes[_DESCRIPTION];
            if( idx > -1 )
            {
            }
            idx = _indexes[_OCCUPATION];
            if( idx > -1 )
            {
            }
            idx = _indexes[_TITLE];
            if( idx > -1 )
            {
                data[idx].Type = vtAnsiString;
                data[idx].AsAnsiString.Data = account->title;
                data[idx].AsAnsiString.Size = (uint16_t)strlen( account->title );
            }
            idx = _indexes[_LOCKPER];
            if( idx > -1 )
            {
            }

            result->current++;
        }
        break;
        }
    }
}

TValue STDCALL NextSequenceValue( void* driver, const char16_t* name, int increment )
{
    return {};
}

void STDCALL FreeSQLResult( void* sql_result )
{
    if( sql_result )
        delete (Result*)sql_result;
}

void* STDCALL GetSchema( void* transaction, char16_t* table, TDriverTableField** fields, int* fields_count, TDriverTableIndex** indices, int* indices_count, TDriverTableConstraint** constraints, int* constraint_count )
{
    if( nv::starts_with( table, u"SYS&GRANTEE" ) )
    {
        // ID           VARCHAR( 32 )        
        // NAME         VARCHAR(20)
        // DSDN         VARCHAR(255)
        // LABEL        VARCHAR( 150 )
        // PWD          VARCHAR( 255 )
        // ENABLED      CHAR(1)         'T' or 'F' 
        // TYP          INTEGER
        // DESCRIPTION  VARCHAR( 255 ) 
        // OCCUPATION   VARCHAR( 50 )
        // TITLE        VARCHAR( 10 )
        // LOCKPER      INTEGER;
        static TDriverTableField fields_[] =
        {
            {
                {u"ID"},
                {u""},
                dtFixString,
                32,
                0,
                false
            },
            {
                {u"NAME"},
                {u""},
                dtVarString,
                20,
                0,
                false
            },
            {
                {u"DSDN"},
                {u""},
                dtVarString,
                255,
                0,
                true
            },
            {
                {u"LABEL"},
                {u""},
                dtVarString,
                150,
                0,
                true
            },
            {
                {u"PWD"},
                {u""},
                dtVarString,
                255,
                0,
                true
            },
            {
                {u"ENABLED"},
                {u""},
                dtFixString,
                1,
                0,
                true
            },
            {
                {u"TYP"},
                {u""},
                dtInteger,
                32,
                0,
                false
            },
            {
                {u"DESCRIPTION"},
                {u""},
                dtVarString,
                255,
                0,
                true
            },
            {
                {u"OCCUPATION"},
                {u""},
                dtVarString,
                50,
                0,
                true
            },
            {
                {u"TITLE"},
                {u""},
                dtVarString,
                10,
                0,
                true
            },
            {
                {u"LOCKPER"},
                {u""},
                dtInteger,
                32,
                0,
                false
            }
        };

        *fields_count = sizeof(fields_) / sizeof( TDriverTableField );
        *fields = fields_;
    }

    // todo add expected structure to get warning if db is changed
    return nullptr;
}

void STDCALL FreeSchema( void* schema )
{
}

Example 2

Here is a template for a data storage driver in Delphi.

unit Driver.Firebird;

//  GRANT ALTER DATABASE TO NODEVISION
//  GRANT DROP DATABASE TO NODEVISION
//  GRANT CREATE TABLE TO NODEVISION
//  GRANT ALTER ANY TABLE TO NODEVISION
//  GRANT DROP ANY TABLE TO NODEVISION
//  GRANT CREATE VIEW TO NODEVISION
//  GRANT ALTER ANY VIEW TO NODEVISION
//  GRANT DROP ANY VIEW TO NODEVISION
//  GRANT CREATE PROCEDURE TO NODEVISION
//  GRANT DROP ANY PROCEDURE TO NODEVISION

interface

uses
System.Types,
System.Classes,
System.Variants,
System.DateUtils,
System.Generics.Collections,
System.Math,
System.SysUtils,
System.Generics.Defaults,
System.IOUtils,

Data.DB,
Data.FMTBcd,
Data.SqlTimSt,

{$REGION 'Driver Interface'}
const
MAX_KIND_LEN = 20;
MAX_FIELD_LEN = 128;
MAX_INDEX_LEN = 30;
MAX_CONSTRAINT_LEN = 30;
MAX_TABLE_LEN = 30;
MAX_INDEX_FIELDS_LEN = 256;
MAX_CONSTRAINT_FIELDS_LEN = 256;
MAX_DESCRIPTION_LEN = 256;

type
TDriverAllocMem = function( size: NativeInt ): Pointer; cdecl;
TDriverReallocMem = function( p: Pointer; size: NativeInt ): Pointer; cdecl;
TDriverFreeMem = function(P: Pointer): Integer; cdecl;

const
// TValueType
vtEmpty       = $FFFF;
vtNull        = $0000;
vtInt8        = $0001;
vtInt16       = $0002;
vtInt32       = $0003;
vtInt64       = $0004;
vtCurrency    = $0008;
vtBool        = $0010;
vtUInt8       = $0011;
vtUInt16      = $0012;
vtUInt32      = $0013;
vtUInt64      = $0014;
vtFloat       = $0020;
vtDouble      = $0021;
vtDate        = $0022;
vtTime        = $0023;
vtDateTime    = $0024;
vtAnsiString  = $0100;
vtWideString  = $0101;
vtBytes       = $0A00;
vtGuid        = $0A01;

type
TAnsiString = packed record
    Size: UInt32;
    Data: PUtf8Char;
end;

TWideString = packed record
    Size: UInt32;
    Data: PWideChar;
end;

TBytes = packed record
    Size: UInt32;
    Data: PByte;
end;

TDateStamp = record
    Year: Word;
    Month: Word;
    Day: Word;
end;

TTimeStamp = record
    Hour: Word;
    Minute: Word;
    Second: Word;
    Milliseconds: Word;
end;

TDateTimeStamp = record
    Year: Word;
    Month: Word;
    Day: Word;
    Hour: Word;
    Minute: Word;
    Second: Word;
    Milliseconds: Word;
end;

TValueType = Word;
TValue = packed record
    case &Type: TValueType of
    vtBool:       (AsBool: WordBool);
    vtInt8:       (AsInt8: Int8);
    vtUInt8:      (AsUInt8: UInt8);
    vtInt16:      (AsInt16: Int16);
    vtUInt16:     (AsUInt16: UInt16);
    vtInt32:      (AsInt32: Int32);
    vtUInt32:     (AsUInt32: UInt32);
    vtInt64:      (AsInt64: Int64);
    vtUInt64:     (AsUInt64: UInt64);
    vtCurrency:   (AsCurrency: Currency);
    vtFloat:      (AsFloat: Float32);
    vtDouble:     (AsDouble: Float64);
    vtDate:       (AsDate: TDateStamp);
    vtTime:       (AsTime: TTimeStamp);
    vtDateTime:   (AsDateTime: TDateTimeStamp);
    vtAnsiString: (AsAnsiString: TAnsiString);
    vtWideString: (AsWideString: TWideString);
    vtBytes:      (AsBytes: TBytes);
    vtGuid:       (AsGuid: System.PGUID);
end;
PValue = ^TValue;

TFieldInfo = packed record
    Name: PChar;
    &Type: TValueType;
end;
PFieldInfo = ^TFieldInfo;

TDriverCreateParameters = packed record
    AllocMemory: TDriverAllocMem;
    ReallocMemory: TDriverReallocMem;
    FreeMemory: TDriverFreeMem;
    Name: PChar;
    Host: PChar;
    User: PChar;
    Password: PChar;
    Charset: PChar;
    LicenseCount: Integer;
    Config: PChar;
end;
PDriverCreateParameters = ^TDriverCreateParameters;

TDriverTable = packed record
    Grant: PChar;
    Create: PChar;
    Drop: PChar;
    AddColumn: PChar;
    DropColumn: PChar;
    AddPrimaryKeyConstraint: PChar;
    AddForeignKeyConstraint: PChar;
    AddUniqueConstraint: PChar;
    DropConstraint: PChar;
    CreateUniqueIndex: PChar;
    CreateIndex: PChar;
    DropIndex: PChar;
    SetDefault: PChar;
    DropDefault: PChar;
    SetNullable: PChar;
    DropNullable: PChar;
end;

TDriverTypes = packed record
    FixString: PChar;
    VarString: PChar;
    Integer: PChar;
    Largeint: PChar;
    Numeric: PChar;
    Currency: PChar;
    Float: PChar;
    Double: PChar;
    Date: PChar;
    Time: PChar;
    DateTime: PChar;
    Boolean: PChar;
    Clob: PChar;
    Blob: PChar;
end;

TDriverRules = packed record
    NoAction: PChar;
    Restrict: PChar;
    Cascade: PChar;
    SetNull: PChar;
    SetDefault: PChar;
end;

TDriverFormats = packed record
    Date: PChar;
    Time: PChar;
    DateTime: PChar;
end;

TDriverSequence = packed record
    Create: PChar;
    AlterStart: PChar;
    AlterIncrement: PChar;
    Drop: PChar;
    Grant: PChar;
end;

TDriverSyntax = packed record
    SelectOffset: PChar;
    WhereOffset: PChar;
    SelectLimit: PChar;
    WhereLimit: PChar;
    Table: TDriverTable;
    Types: TDriverTypes;
    Rules: TDriverRules;
    Formats: TDriverFormats;
    Sequence: TDriverSequence;
end;
PDriverSyntax = ^TDriverSyntax;

TDriverInfoFlags = record
    const None = 0;
    const PoolConnections = 1;
    const ReadSchema = 4;
    const WriteSchema = 8;
end;

TDriverInfo = packed record
    Kind: array[0..MAX_KIND_LEN-1] of Char;
    Flags: Integer;
    Valid: boolean;
    Error: PChar;
    Syntax: PDriverSyntax;
end;
PDriverInfo = ^TDriverInfo;

TDriverParameter = packed record
    Name: PChar;
    Kind: Byte; // 0-in, 1-out, 2-in/out
    Value: TValue;
end;
PDriverParameter = ^TDriverParameter;

TDriverResult = packed record
    FieldCount: Integer;
    Fields: PFieldInfo;
    Fetched: Integer;
    Error: PChar;
end;
PDriverResult = ^TDriverResult;

TDataClassFieldDataType = ( dtNone = 0,
                            dtBoolean = 1,
                            dtInteger = 2,
                            dtLargeint = 3,
                            dtNumeric = 4,
                            dtCurrency = 5,
                            dtFloat = 6,
                            dtDouble = 7,
                            dtFMTBcd = 8,
                            dtDate = 9,
                            dtTime = 10,
                            dtDateTime = 11,
                            dtFixString = 12,
                            dtVarString = 13,
                            dtPassword = 14,
                            dtHyperLink = 15,
                            dtMemo = 16,
                            dtRichText = 17,
                            dtBlob = 18,
                            dtImage = 19,
                            dtObject = 20 );

TDriverTableField = packed record
    Name: array[0..MAX_FIELD_LEN-1] of Char;
    Description: array[0..MAX_DESCRIPTION_LEN-1] of Char;
    &Type: TDataClassFieldDataType;
    Size: integer;
    Scale: integer;
    Nullable: boolean;
    DefaultValue: Variant;
end;
PDriverTableField = ^TDriverTableField;

TDriverTableIndex = packed record
    Name: array[0..MAX_INDEX_LEN-1] of Char;
    Fields: array[0..MAX_INDEX_FIELDS_LEN-1] of Char;
    IsUnique: boolean;
end;
PDriverTableIndex = ^TDriverTableIndex;

TSchemaConstraintUpdateRule = (scrUpdateNoAction = 0, scrUpdateCascade = 1, scrUpdateSetNull = 2, scrUpdateSetDefault = 3, scrUpdateRestrict = 4 );
TSchemaConstraintDeleteRule = (scrDeleteNoAction = 0, scrDeleteCascade = 1, scrDeletesetNull = 2, scrDeletesetDefault = 3, scrDeleteRestrict = 4 );

TDriverTableConstraint = packed record
    Name: array[0..MAX_CONSTRAINT_LEN-1] of Char;
    TableName: array[0..MAX_TABLE_LEN-1] of Char;
    FieldName: array[0..MAX_CONSTRAINT_FIELDS_LEN-1] of Char;
    IsPrimaryKey: boolean;
    IsForeignKey: boolean;
    IsUniqueKey: boolean;
    RefTableName: array[0..MAX_TABLE_LEN-1] of Char;
    RefFieldName: array[0..MAX_CONSTRAINT_FIELDS_LEN-1] of Char;
    UpdateRule: TSchemaConstraintUpdateRule;
    DeleteRule: TSchemaConstraintDeleteRule;
end;
PDriverTableConstraint = ^TDriverTableConstraint;
{$ENDREGION}

type
TDataDriver = class;

TTransaction = class
private
    Driver: TDataDriver;
    DBTrans: TDatabaseTransaction;
    Error: String;
    ID: Int64;
public
    constructor Create( ADataDriver: TDataDriver ); reintroduce;
    destructor Destroy; override;

    procedure StartTransaction;
    procedure TryCommit;
    procedure Commit;
    procedure Rollback;
    property  TransactionID: Int64 read ID;
    property  DBTransaction: TDatabaseTransaction read DBTrans;
end;

TDataSetHelper = class helper for TDataSet
    procedure InitParamTypes( AParameters: PDriverParameter; AParametersCount: Integer );
    procedure InitParamValues( AParameters: PDriverParameter; AParametersCount: Integer );
    procedure ReadRecord( var ARecordBuffer: TArray<TValueBuffer>; AData: PValue );
end;

TDataDriver = class
private
    DBConnection: TDatabaseConnection;
    ServerVersion: TDatabaseVersion;
    Error: string;
    CreateParameters: PDriverCreateParameters;
    Syntax: TDriverSyntax;
public
    constructor Create( AParameters: PDriverCreateParameters ); reintroduce;
    destructor Destroy; override;
end;

function  CreateDriver( name: PChar; parameters: PDriverCreateParameters; info: PDriverInfo ): Pointer; stdcall;
procedure FreeDriver( driver: Pointer ); stdcall;
function  CreateTransaction( driver: Pointer ): Pointer; stdcall;
procedure FreeTransaction( transaction: Pointer ); stdcall;
function  StartTransaction( transaction: Pointer ): Integer; stdcall;
function  CommitTransactionPhase1( transaction: Pointer ): Boolean; stdcall;
function  CommitTransactionPhase2( transaction: Pointer ): Boolean; stdcall;
function  RollbackTransaction( transaction: Pointer ): Boolean; stdcall;
function  TransactionError( transaction: Pointer ): PChar; stdcall;
function  ExecuteSQL( transaction: Pointer; sql: PChar; parameters: PDriverParameter; parametersCount: Integer; info: PDriverResult ): Pointer; stdcall;
procedure ExecuteDDL( transaction: Pointer; sql: PChar; parameters: PDriverParameter; parametersCount: Integer); stdcall;
function  ExecuteProcedure( transaction: Pointer; proc: PChar; parameters: PDriverParameter; parametersCount: Integer; info: PDriverResult ): Pointer; stdcall;
procedure ReadSQLResult( sql_result: Pointer; data: PValue; fetched: PInteger ); stdcall;
procedure FreeSQLResult( sql_result: Pointer ); stdcall;
function  NextSequenceValue( driver: Pointer; name: PChar ): Variant; stdcall;
function  GetSchema( transaction: Pointer; table: PChar;
                    var fields: PDriverTableField; var fields_count: Integer;
                    var indices: PDriverTableIndex; var indices_count: Integer;
                    var constraints: PDriverTableConstraint; var constraint_count: Integer ): Pointer; stdcall;
procedure FreeSchema( Schema: Pointer ); stdcall;

implementation

function StreamToVariant(Stream: TStream): Variant;
begin
    result := Unassigned;
    if Assigned(stream) then
    begin
        stream.Seek(0,soBeginning);
        result := VarArrayCreate([0,stream.Size - 1], VarByte);
        try
        stream.ReadBuffer(TVarData(result).VArray^.Data^, stream.Size);
        except end;
    end
end;

{$REGION 'TDataDriver'}

constructor TDataDriver.Create( AParameters: PDriverCreateParameters );
begin
    inherited Create;
    CreateParameters := AParameters;
    DBConnection := TDatabaseConnection.Create( nil );
    DBConnection.Params.Add('PageSize=8192');
    DBConnection.Params.Add('Server=' + AParameters.Host);
    DBConnection.Params.Add('Database=' + AParameters.Name);
    DBConnection.Params.Add('User_Name=' + AParameters.User);
    DBConnection.Params.Add('Password=' + AParameters.Password);
    DBConnection.Params.Add('CharacterSet=' + AParameters.Charset);
    try
        DBConnection.Open;
        ServerVersion := DBConnection.ServerVersion;

        Syntax.SelectOffset  := 'skip %d';
        Syntax.WhereOffset   := '';
        Syntax.SelectLimit   := 'first %d';
        Syntax.WhereLimit    := '';

        Syntax.Table.Create := 'CREATE TABLE ${TABLE}';
        Syntax.Table.Drop := 'DROP TABLE ${TABLE}';
        Syntax.Table.Grant := 'GRANT ALL ON ${TABLE} TO ${USER} WITH GRANT OPTION';
        Syntax.Table.AddColumn := 'ALTER TABLE ${TABLE} ADD ${COLUMN}';
        Syntax.Table.DropColumn := 'ALTER TABLE ${TABLE} DROP ${COLUMN}';
        Syntax.Table.AddPrimaryKeyConstraint := 'ALTER TABLE ${TABLE} ADD CONSTRAINT ${CONSTRAINT} PRIMARY KEY (${COLUMNS})';
        Syntax.Table.AddForeignKeyConstraint := 'ALTER TABLE ${TABLE} ADD CONSTRAINT ${CONSTRAINT} FOREIGN KEY (${COLUMNS}) REFERENCES ${REFTABLE} (${REFCOLUMNS})';
        Syntax.Table.AddUniqueConstraint := 'ALTER TABLE ${TABLE} ADD CONSTRAINT ${CONSTRAINT} UNIQUE (${COLUMNS})';
        Syntax.Table.DropConstraint := 'ALTER TABLE ${TABLE} DROP CONSTRAINT ${CONSTRAINT}';
        Syntax.Table.CreateUniqueIndex := 'ALTER TABLE ${TABLE} ADD CONSTRAINT ${INDEX} UNIQUE (${COLUMNS})';
        Syntax.Table.CreateIndex := 'CREATE INDEX ${INDEX} ON ${TABLE} (${COLUMNS})';
        Syntax.Table.DropIndex := 'DROP INDEX ${INDEX}';
        Syntax.Table.SetDefault := 'ALTER TABLE ${TABLE} ALTER COLUMN ${COLUMN} SET DEFAULT ${VALUE}';
        Syntax.Table.DropDefault := 'ALTER TABLE ${TABLE} ALTER COLUMN ${COLUMN} DROP DEFAULT';
        Syntax.Table.SetNullable := 'ALTER TABLE ${TABLE} ALTER COLUMN ${COLUMN} DROP NOT NULL';
        Syntax.Table.DropNullable := 'ALTER TABLE ${TABLE} ALTER COLUMN ${COLUMN} SET NOT NULL';

        Syntax.Types.FixString := 'CHAR(${SIZE})';
        Syntax.Types.VarString := 'VARCHAR(${SIZE})';
        Syntax.Types.Integer   := 'INTEGER';
        Syntax.Types.Largeint  := 'BIGINT';
        Syntax.Types.Numeric   := 'NUMERIC(${SIZE},${SCALE})';
        Syntax.Types.Currency  := 'NUMERIC(18,4)';
        Syntax.Types.Float     := 'FLOAT';
        Syntax.Types.Double    := 'DOUBLE PRECISION';
        Syntax.Types.Date      := 'DATE';
        Syntax.Types.Time      := 'TIME';
        Syntax.Types.DateTime  := 'TIMESTAMP';
        Syntax.Types.Boolean   := 'CHAR(1)';
        Syntax.Types.Clob      := 'BLOB SUB_TYPE 1 SEGMENT SIZE 8192';
        Syntax.Types.Blob      := 'BLOB SUB_TYPE 0 SEGMENT SIZE 8192';

        Syntax.Rules.NoAction  := 'NO ACTION';
        Syntax.Rules.Restrict  := 'RESTRICT';
        Syntax.Rules.Cascade   := 'CASCADE';
        Syntax.Rules.SetNull   := 'SET NULL';
        Syntax.Rules.SetDefault:= 'SET DEFAULT';

        Syntax.Sequence.Create := 'CREATE SEQUENCE ${SEQUENCE}';
        Syntax.Sequence.AlterStart := 'ALTER SEQUENCE ${SEQUENCE} RESTART WITH ${START}';
        Syntax.Sequence.AlterIncrement := 'ALTER SEQUENCE ${SEQUENCE} INCREMENT BY ${INCREMENT}';
        Syntax.Sequence.Drop := 'DROP SEQUENCE ${SEQUENCE}';
        Syntax.Sequence.Grant := 'GRANT USAGE ON SEQUENCE ${SEQUENCE} TO ${USER}';

        Syntax.Formats.Date := 'yyyy-mm-dd';
        Syntax.Formats.Time := 'hh:nn';
        Syntax.Formats.DateTime := 'yyyy-mm-dd hh:nn';
    except on e: Exception do
        Error := e.Message;
    end;
end;

destructor TDataDriver.Destroy;
begin
    DBConnection.Close;
    FreeAndNil(DBConnection);
    inherited;
end;

{$ENDREGION}

{$REGION 'TTransaction'}

constructor TTransaction.Create( ADataDriver: TDataDriver );
begin
    Driver := ADataDriver;
    DBTrans := TDatabaseTransaction.Create(nil);
    DBTrans.Connection := Driver.DBConnection;
end;

destructor TTransaction.Destroy;
begin
    DBTrans.Free;
    inherited;
end;

procedure TTransaction.StartTransaction;
begin
    Error := '';
    DBTrans.StartTransaction;
    ID := DBTrans.TransactionID;
end;

procedure TTransaction.TryCommit;
begin
    DBTrans.Prepare;
end;

procedure TTransaction.Commit;
begin
    DBTrans.Commit;
    ID := 0;
end;

procedure TTransaction.Rollback;
begin
    DBTrans.Rollback;
    ID := 0;
end;

{$ENDREGION}

{$REGION 'Value Manipulation'}

function ToDateTime( const d: TDateStamp ): TDateTime; overload;
begin
    result := EncodeDate(d.Year, d.Month, d.Day);
end;

procedure FromDateTime( var s: TDateStamp; d: TDateTime ); overload;
begin
    DecodeDate(d, s.Year, s.Month, s.Day);
end;

function ToDateTime( const t: TTimeStamp): TDateTime; overload;
begin
    result := EncodeTime(t.Hour, t.Minute, t.Second, t.MilliSeconds)
end;

procedure FromDateTime( var s: TTimeStamp; d: TDateTime ); overload;
begin
    DecodeTime(d, s.Hour, s.Minute, s.Second, s.Milliseconds);
end;

function ToDateTime( const dt: TDateTimeStamp): TDateTime; overload;
begin
    result := EncodeDate(dt.Year, dt.Month, dt.Day);
    if result >= 0 then
        result := result + EncodeTime(dt.Hour, dt.Minute, dt.Second, dt.MilliSeconds)
    else
        result := result - EncodeTime(dt.Hour, dt.Minute, dt.Second, dt.MilliSeconds);
end;

procedure FromDateTime( var s: TDateTimeStamp; d: TDateTime ); overload;
begin
    DecodeDate(d, s.Year, s.Month, s.Day);
    DecodeTime(d, s.Hour, s.Minute, s.Second, s.Milliseconds);
end;

function ValueTypeToDataType(VType: TValueType; DefType: TFieldType = ftString): TFieldType;
begin
    case VType of
        vtEmpty:      result := DefType;
        vtNull:       result := DefType;
        vtAnsiString: result := ftString;
        vtWideString: result := ftWideString;
        vtBool:       result := ftBoolean;
        vtInt8:       result := ftShortint;
        vtUInt8:      result := ftByte;
        vtInt16:      result := ftSmallint;
        vtUInt16:     result := ftWord;
        vtInt32:      result := ftInteger;
        vtUInt32:     result := ftLongWord;
        vtInt64:      result := ftLargeint;
        vtUInt64:     result := ftLargeint;
        vtCurrency:   result := ftCurrency;
        vtFloat:      result := ftSingle;
        vtDouble:     result := ftFloat;
        vtDate:       result := ftDate;
        vtTime:       result := ftTime;
        vtDateTime:   result := ftDateTime;
        vtGuid:       result := ftString;
        vtBytes:      result := ftBlob;
        else          result := DefType;
    end;
end;

function DataTypeToValueType( dt: TFieldType ): TValueType;
begin
    case dt of
        ftMemo, ftFmtMemo, ftOraClob:
        result := vtAnsiString;
        ftWideMemo:
        result := vtWideString;
        ftBlob, ftGraphic, ftOraBlob:
        result := vtBytes;
        ftWideString, ftFixedWideChar:
        result := vtWideString;
        ftString, ftFixedChar:
        result := vtAnsiString;
        ftDate:
        result := vtDate;
        ftTime:
        result := vtTime;
        ftDateTime:
        result := vtDateTime;
        ftTimeStamp, ftOraTimeStamp:
        result := vtDateTime;
        ftShortint:
        result := vtInt8;
        ftSmallint:
        result := vtInt16;
        ftInteger:
        result := vtInt32;
        ftLargeint:
        result := vtInt64;
        ftAutoInc:
        result := vtInt32;
        ftByte:
        result := vtUInt8;
        ftWord:
        result := vtUInt16;
        ftLongWord:
        result := vtUInt32;
        ftBoolean:
        result := vtBool; // vtAnsiString; // 'T' or 'F'
        ftSingle:
        result := vtFloat;
        ftFloat:
        result := vtDouble;
        ftCurrency:
        result := vtCurrency;
        ftBCD, ftFMTBcd:
        result := vtDouble;
        ftExtended:
        result := vtDouble;
        ftGuid:
        result := vtGuid;
        ftBytes, ftVarBytes, ftArray:
        result := vtBytes;
        else
        result := vtEmpty;
    end;
end;

function ParamTypeToDBParamType(Kind: Byte {0-in, 1-out, 2-in/out}): TParamType;
begin
    case Kind of
    0:    result := TParamType.ptInput;
    1:    result := TParamType.ptOutput;
    2:    result := TParamType.ptInputOutput;
    else  result := ptUnknown;
    end;
end;

procedure ValueFromDBParam(var d: TValue; const p: TDatabaseParam);
begin
    d.&Type := vtEmpty;
    case p.FDDataType of
        TDatabaseDataType.dtBoolean:
        begin
            d.&Type := vtBool;
            d.AsBool := p.Value;
        end;
        TDatabaseDataType.dtSByte:
        begin
            d.&Type := vtInt8;
            d.AsInt8 := p.Value;
            end;
        TDatabaseDataType.dtByte:
        begin
            d.&Type := vtUInt8;
            d.AsUInt8 := p.Value;
        end;
        TDatabaseDataType.dtInt16:
        begin
            d.&Type := vtInt16;
            d.AsUInt16 := p.Value;
        end;
        TDatabaseDataType.dtUInt16:
        begin
            d.&Type := vtUInt16;
            d.AsUInt16 := p.Value;
        end;
        TDatabaseDataType.dtInt32:
        begin
            d.&Type := vtInt32;
            d.AsInt32 := p.Value;
        end;
        TDatabaseDataType.dtUInt32:
        begin
            d.&Type := vtUInt32;
            d.AsUInt32 := p.Value;
        end;
        TDatabaseDataType.dtInt64:
        begin
            d.&Type := vtInt64;
            d.AsInt64 := p.Value;
        end;
        TDatabaseDataType.dtUInt64:
        begin
            d.&Type := vtUInt64;
            d.AsUInt64 := p.Value;
        end;
        TDatabaseDataType.dtSingle:
        begin
            d.&Type := vtFloat;
            d.AsFloat := p.Value;
        end;
        TDatabaseDataType.dtDouble:
        begin
            d.&Type := vtDouble;
            d.AsDouble := p.Value;
        end;
        TDatabaseDataType.dtCurrency:
        begin
            d.&Type := vtCurrency;
            d.AsCurrency := p.Value;
        end;
        TDatabaseDataType.dtExtended:
        begin
            d.&Type := vtDouble;
            d.AsDouble := p.Value;
        end;
        TDatabaseDataType.dtBCD:
        if p.NumericScale = 0 then
        begin
            d.&Type := vtInt64;
            d.AsInt64 := p.AsLargeInt;
        end
        else
        begin
            d.&Type := vtCurrency;
            d.AsCurrency := p.AsCurrency;
        end;
        TDatabaseDataType.dtFmtBCD:
        if p.NumericScale = 0 then
        begin
            d.&Type := vtInt64;
            d.AsInt64 := p.AsLargeInt;
        end
        else
        begin
            d.&Type := vtDouble;
            d.AsDouble := p.AsFloat;
        end;
        TDatabaseDataType.dtDate:
        begin
            d.&Type := vtDate;
            FromDateTime( d.AsDate, p.AsDate );
        end;
        TDatabaseDataType.dtTime:
        begin
            d.&Type := vtTime;
            FromDateTime( d.AsTime, p.AsTime );
        end;
        TDatabaseDataType.dtDateTime:
        begin
            d.&Type := vtDateTime;
            FromDateTime( d.AsDateTime, p.AsDateTime );
        end;
        TDatabaseDataType.dtDateTimeStamp:
        begin
            var ATimeStamp: TSQLTimeStamp := VarToSQLTimeStamp(p.Value);
            d.&Type := vtDateTime;
            d.&Type := vtDateTime;
            d.AsDateTime.Year := ATimeStamp.Year;
            d.AsDateTime.Month := ATimeStamp.Month;
            d.AsDateTime.Day := ATimeStamp.Day;
            d.AsDateTime.Hour := ATimeStamp.Hour;
            d.AsDateTime.Minute := ATimeStamp.Minute;
            d.AsDateTime.Second := ATimeStamp.Second;
            d.AsDateTime.Milliseconds := ATimeStamp.Fractions;
        end;
        TDatabaseDataType.dtAnsiString, TDatabaseDataType.dtMemo, TDatabaseDataType.dtHMemo:
        begin
            d.&Type := vtAnsiString;
            d.AsAnsiString.Data := PAnsiChar(TVarData(p.Value).VString);
            d.AsAnsiString.Size := Length(RawByteString(TVarData(p.Value).VString));
        end;
        TDatabaseDataType.dtWideString, TDatabaseDataType.dtWideMemo, TDatabaseDataType.dtWideHMemo, TDatabaseDataType.dtXML:
        begin
            d.&Type := vtWideString;
            d.AsWideString.Data := PWideChar(TVarData(p.Value).VUString);
            d.AsWideString.Size := Length(UnicodeString(TVarData(p.Value).VUString));
        end;
        TDatabaseDataType.dtByteString, TDatabaseDataType.dtBlob, TDatabaseDataType.dtHBlob, TDatabaseDataType.dtHBFile:
        begin
            d.&Type := vtBytes;
            d.AsBytes.Size := TVarData(p.Value).VArray^.Bounds[0].ElementCount * TVarData(p.Value).VArray^.ElementSize;
            d.AsBytes.Data := TVarData(p.Value).VArray^.Data;
        end;
        TDatabaseDataType.dtGUID:
        begin
            d.&Type := vtEmpty;
        end;
        else
        begin
            case p.DataType of
                TFieldType.ftBoolean:
                begin
                    d.&Type := vtBool;
                    d.AsBool := p.Value;
                end;
                TFieldType.ftShortint:
                begin
                    d.&Type := vtInt8;
                    d.AsInt8 := p.Value;
                end;
                TFieldType.ftByte:
                begin
                    d.&Type := vtUInt8;
                    d.AsUInt8 := p.Value;
                end;
                TFieldType.ftSmallint:
                begin
                    d.&Type := vtInt16;
                    d.AsUInt16 := p.Value;
                end;
                TFieldType.ftWord:
                begin
                    d.&Type := vtUInt16;
                    d.AsUInt16 := p.Value;
                end;
                TFieldType.ftInteger:
                begin
                    d.&Type := vtInt32;
                    d.AsInt32 := p.Value;
                end;
                TFieldType.ftLongWord:
                begin
                    d.&Type := vtUInt32;
                    d.AsUInt32 := p.Value;
                end;
                TFieldType.ftLargeint:
                begin
                    d.&Type := vtInt64;
                    d.AsInt64 := p.Value;
                end;
                TFieldType.ftSingle:
                begin
                    d.&Type := vtFloat;
                    d.AsFloat := p.Value;
                end;
                TFieldType.ftFloat:
                begin
                    d.&Type := vtDouble;
                    d.AsDouble := p.Value;
                end;
                TFieldType.ftCurrency:
                begin
                    d.&Type := vtCurrency;
                    d.AsCurrency := p.Value;
                end;
                TFieldType.ftExtended:
                begin
                    d.&Type := vtDouble;
                    d.AsDouble := p.Value;
                end;
                TFieldType.ftBCD:
                if p.NumericScale = 0 then
                begin
                    d.&Type := vtInt64;
                    d.AsInt64 := p.AsLargeInt;
                end
                else
                begin
                    d.&Type := vtCurrency;
                    d.AsCurrency := p.AsCurrency;
                end;
                TFieldType.ftFmtBCD:
                if p.NumericScale = 0 then
                begin
                    d.&Type := vtInt64;
                    d.AsInt64 := p.AsLargeInt;
                end
                else
                begin
                    d.&Type := vtDouble;
                    d.AsDouble := p.AsFloat;
                end;
                TFieldType.ftDate:
                begin
                    d.&Type := vtDate;
                    FromDateTime( d.AsDate, p.AsDate );
                end;
                TFieldType.ftTime:
                begin
                    d.&Type := vtTime;
                    FromDateTime( d.AsTime, p.AsTime );
                end;
                TFieldType.ftDateTime:
                begin
                    d.&Type := vtDateTime;
                    FromDateTime( d.AsDateTime, p.AsDateTime );
                end;
                TFieldType.ftTimeStamp:
                begin
                    var ATimeStamp: TSQLTimeStamp := VarToSQLTimeStamp(p.Value);
                    d.&Type := vtDateTime;
                    d.&Type := vtDateTime;
                    d.AsDateTime.Year := ATimeStamp.Year;
                    d.AsDateTime.Month := ATimeStamp.Month;
                    d.AsDateTime.Day := ATimeStamp.Day;
                    d.AsDateTime.Hour := ATimeStamp.Hour;
                    d.AsDateTime.Minute := ATimeStamp.Minute;
                    d.AsDateTime.Second := ATimeStamp.Second;
                    d.AsDateTime.Milliseconds := ATimeStamp.Fractions;
                end;
                TFieldType.ftString, TFieldType.ftMemo, TFieldType.ftFmtMemo, TFieldType.ftFixedChar:
                begin
                    d.&Type := vtAnsiString;
                    d.AsAnsiString.Data := PAnsiChar(TVarData(p.Value).VString);
                    d.AsAnsiString.Size := Length(RawByteString(TVarData(p.Value).VString));
                end;
                TFieldType.ftWideString, TFieldType.ftWideMemo, TFieldType.ftFixedWideChar:
                begin
                    d.&Type := vtWideString;
                    d.AsWideString.Data := PWideChar(TVarData(p.Value).VUString);
                    d.AsWideString.Size := Length(UnicodeString(TVarData(p.Value).VUString));
                end;
                TFieldType.ftBytes, TFieldType.ftVarBytes,
                TFieldType.ftBlob, TFieldType.ftOraBlob, TFieldType.ftOraClob,
                TFieldType.ftGraphic, TFieldType.ftTypedBinary, TFieldType.ftArray:
                begin
                    d.&Type := vtBytes;
                    d.AsBytes.Size := TVarData(p.Value).VArray^.Bounds[0].ElementCount * TVarData(p.Value).VArray^.ElementSize;
                    d.AsBytes.Data := TVarData(p.Value).VArray^.Data;
                end;
                TFieldType.ftGUID:
                begin
                    d.&Type := vtEmpty;
                end;
                else
                begin
                    d.&Type := vtEmpty;
                end
            end;
        end
    end;
end;

procedure ValueFromVariant(var d: TValue; const v: Variant);
begin
    case PVarData(@v)^.VType of
        varEmpty:
        begin
            d.&Type := vtEmpty;
        end;
        varNull:
        begin
            d.&Type := vtNull;
        end;
        varBoolean:
        begin
            d.&Type := vtBool;
            d.AsBool := v;
        end;
        varShortInt:
        begin
            d.&Type := vtInt8;
            d.AsInt8 := v;
        end;
        varByte:
        begin
            d.&Type := vtUInt8;
            d.AsUInt8 := v;
        end;
        varSmallInt:
        begin
            d.&Type := vtInt16;
            d.AsInt16 := v;
        end;
        varWord:
        begin
            d.&Type := vtUInt16;
            d.AsUInt16 := v;
        end;
        varInteger:
        begin
            d.&Type := vtInt32;
            d.AsInt32 := v;
        end;
        varLongWord:
        begin
            d.&Type := vtUInt32;
            d.AsUInt32 := v;
        end;
        varInt64:
        begin
            d.&Type := vtInt64;
            d.AsInt64 := v;
        end;
        varUInt64:
        begin
            d.&Type := vtUInt64;
            d.AsUInt64 := v;
        end;
        varSingle:
        begin
            d.&Type := vtFloat;
            d.AsFloat := v;
        end;
        varDouble:
        begin
            d.&Type := vtDouble;
            d.AsDouble := v;
        end;
        varCurrency:
        begin
            d.&Type := vtCurrency;
            d.AsCurrency := v;
        end;
        varDate:
        begin
            d.&Type := vtDateTime;
            FromDateTime( d.AsDateTime, TDateTime(v) );
        end;
        varString:
        begin
            d.&Type := vtAnsiString;
            d.AsAnsiString.Data := PAnsiChar(PVarData(@v)^.VString);
            d.AsAnsiString.Size := Length(RawByteString(PVarData(@v)^.VString));
        end;
        varUString:
        begin
            d.&Type := vtWideString;
            d.AsWideString.Data := PWideChar(PVarData(@v)^.VUString);
            d.AsWideString.Size := Length(UnicodeString(PVarData(@v)^.VUString));
        end;
        varOleStr:
        begin
            d.&Type := vtWideString;
            d.AsWideString.Data := PVarData(@v)^.VOleStr;
            d.AsWideString.Size := StrLen(PVarData(@v)^.VOleStr);
        end;
        else
            if (varArray and PVarData(@v)^.VType) = varArray  then
            begin
                d.&Type := vtBytes;
                d.AsBytes.Size := PVarData(@v)^.VArray^.Bounds[0].ElementCount * PVarData(@v)^.VArray^.ElementSize;
                d.AsBytes.Data := PVarData(@v)^.VArray^.Data;
            end
            else if PVarData(@v)^.VType = varSQLTimeStamp then
            begin
                var ATimeStamp: TSQLTimeStamp := VarToSQLTimeStamp(v);
                d.&Type := vtDateTime;
                d.AsDateTime.Year := ATimeStamp.Year;
                d.AsDateTime.Month := ATimeStamp.Month;
                d.AsDateTime.Day := ATimeStamp.Day;
                d.AsDateTime.Hour := ATimeStamp.Hour;
                d.AsDateTime.Minute := ATimeStamp.Minute;
                d.AsDateTime.Second := ATimeStamp.Second;
                d.AsDateTime.Milliseconds := ATimeStamp.Fractions;
            end
            else if PVarData(@v)^.VType = varSQLTimeStampOffset then
            begin
                var ATimeStampOffset: TSQLTimeStampOffset := VarToSQLTimeStampOffset(v);
                d.&Type := vtDateTime;
                d.AsDateTime.Year := ATimeStampOffset.Year;
                d.AsDateTime.Month := ATimeStampOffset.Month;
                d.AsDateTime.Day := ATimeStampOffset.Day;
                d.AsDateTime.Hour := ATimeStampOffset.Hour;
                d.AsDateTime.Minute := ATimeStampOffset.Minute;
                d.AsDateTime.Second := ATimeStampOffset.Second;
                d.AsDateTime.Milliseconds := ATimeStampOffset.Fractions;
            end
            else if PVarData(@v)^.VType = VarFMTBcd then
            begin
                d.&Type := vtDouble;
                d.AsDouble := BcdToDouble(VarToBcd(v));
            end
    end;
end;

procedure ValueToVariant(const d: TValue; var v: Variant); overload;
begin
    case d.&Type of
        vtEmpty:      VarClear(v);
        vtNull:       v := Null;
        vtAnsiString:
        begin
            var sa: Utf8String;
            SetString(sa, PUTF8Char(d.AsAnsiString.Data), d.AsAnsiString.Size);
            v := sa;
        end;
        vtWideString:
        begin
            var s: string;
            SetString(s, PChar(d.AsWideString.Data), d.AsWideString.Size);
            v := s;
        end;
        vtBool:       v := d.AsBool;
        vtInt8:       v := d.AsInt8;
        vtUInt8:      v := d.AsUInt8;
        vtInt16:      v := d.AsInt16;
        vtUInt16:     v := d.AsUInt16;
        vtInt32:      v := d.AsInt32;
        vtUInt32:     v := d.AsUInt32;
        vtInt64:      v := d.AsInt64;
        vtUInt64:     v := d.AsUInt64;
        vtCurrency:   v := d.AsCurrency;
        vtFloat:      v := d.AsFloat;
        vtDouble:     v := d.AsDouble;
        vtDate:       v := ToDateTime(d.AsDate);
        vtTime:       v := ToDateTime(d.AsTime);
        vtDateTime:   v := ToDateTime(d.AsDateTime);
        vtGuid:       v := GUIDToString(d.AsGuid^);
        vtBytes:
        begin
            v := VarArrayCreate( [0, Integer(d.AsBytes.Size)-1], varByte );
            Move( d.AsBytes.Data^, PVarData(@v)^.VArray^.Data^, d.AsBytes.Size );
        end;
    end;
end;

function ValueToVariant(const d: TValue): Variant; overload; inline;
begin
    ValueToVariant(d, result);
end;
{$ENDREGION}

{$REGION 'TQuery and TStoredProc'}

constructor TQuery.Create( ADriver: TDataDriver );
begin
    inherited Create(nil);
    Driver := ADriver;
    RecordIndex := 0;
end;

destructor TQuery.Destroy;
begin
    inherited;
end;

{TStoredProc}

constructor TStoredProc.Create(ADriver: TDataDriver);
begin
    inherited Create(nil);
    Driver := ADriver;
    RecordIndex := 0;
end;

destructor TStoredProc.Destroy;
begin
    inherited;
end;

procedure TDataSetHelper.InitParamTypes( AParameters: PDriverParameter; AParametersCount: Integer );
var
    i: integer;
    AParam: TDatabaseParam;
begin
    for i := 0 to AParametersCount - 1 do
    begin
        AParam := FindParam(AParameters^.Name);
        if Assigned(AParam) then
        begin
        AParam.ParamType := ParamTypeToDBParamType(AParameters^.Kind);
        AParam.DataType := ValueTypeToDataType( AParameters^.Value.&Type, ftString );
        end;
        Inc(AParameters);
    end;
end;

procedure TDataSetHelper.InitParamValues( AParameters: PDriverParameter; AParametersCount: Integer );
var
    i: integer;
    AParam: TDatabaseParam;
begin
    for i := 0 to AParametersCount - 1 do
    begin
        AParam := FindParam(AParameters^.Name);
        if Assigned(AParam) then
        if (AParam.ParamType = ptInput) or (AParam.ParamType = ptInputOutput) then
            AParam.Value := ValueToVariant(AParameters^.Value);
        Inc(AParameters);
    end;
end;

procedure TDataSetHelper.ReadRecord( var ARecordBuffer: TArray<TValueBuffer>; AData: PValue );
begin
    var ARow := GetRow(ActiveBuffer);
    if Assigned(ARow) then
    begin
        for var fidx := 0 to FieldCount - 1 do
        begin
        var AField := Fields[fidx];
        var AColumn := GetFieldColumn(AField);
        var AFieldData: Pointer := nil;
        var ADataLen: LongWord := 0;
        if not ARow.GetData( AColumn.Index, rvOriginal, AFieldData, 0, ADataLen, False ) then
            AData^.&Type := vtNull
        else
            case AColumn.DataType of
            TDatabaseDataType.dtBoolean:
            begin
                AData^.&Type := vtBool;
                AData^.AsBool := PWordBool(AFieldData)^;
            end;
            TDatabaseDataType.dtSByte:
            begin
                AData^.&Type := vtInt8;
                AData^.AsInt8 := PShortInt(AFieldData)^;
            end;
            TDatabaseDataType.dtByte:
            begin
                AData^.&Type := vtUInt8;
                AData^.AsUInt8 := PByte(AFieldData)^;
            end;
            TDatabaseDataType.dtInt16:
            begin
                AData^.&Type := vtInt16;
                AData^.AsUInt16 := PSmallInt(AFieldData)^;
            end;
            TDatabaseDataType.dtUInt16:
            begin
                AData^.&Type := vtUInt16;
                AData^.AsUInt16 := PWord(AFieldData)^;
            end;
            TDatabaseDataType.dtInt32:
            begin
                AData^.&Type := vtInt32;
                AData^.AsInt32 := PInteger(AFieldData)^;
            end;
            TDatabaseDataType.dtUInt32:
            begin
                AData^.&Type := vtUInt32;
                AData^.AsUInt32 := PCardinal(AFieldData)^;
            end;
            TDatabaseDataType.dtInt64:
            begin
                AData^.&Type := vtInt64;
                AData^.AsInt64 := PInt64(AFieldData)^;
            end;
            TDatabaseDataType.dtUInt64:
            begin
                AData^.&Type := vtUInt64;
                AData^.AsUInt64 := PUInt64(AFieldData)^;
            end;
            TDatabaseDataType.dtSingle:
            begin
                AData^.&Type := vtFloat;
                AData^.AsFloat := PSingle(AFieldData)^;
            end;
            TDatabaseDataType.dtDouble:
            begin
                AData^.&Type := vtDouble;
                AData^.AsDouble := PDouble(AFieldData)^;
            end;
            TDatabaseDataType.dtCurrency:
            begin
                AData^.&Type := vtCurrency;
                AData^.AsCurrency := PCurrency(AFieldData)^;
            end;
            TDatabaseDataType.dtExtended:
            begin
                AData^.&Type := vtDouble;
                AData^.AsDouble := PExtended(AFieldData)^;
            end;
            TDatabaseDataType.dtBCD:
            if AColumn.Scale = 0 then
            begin
                AData^.&Type := vtInt64;
                AData^.AsInt64 := BcdToInt64( PBcd(AFieldData)^ );
            end
            else
            begin
                AData^.&Type := vtCurrency;
                BCDToCurr( PBcd(AFieldData)^, AData^.AsCurrency );
            end;
            TDatabaseDataType.dtFmtBCD:
            if AColumn.Scale = 0 then
            begin
                AData^.&Type := vtInt64;
                AData^.AsInt64 := BcdToInt64( PBcd(AFieldData)^ );
            end
            else
            begin
                AData^.&Type := vtDouble;
                AData^.AsDouble := BcdToDouble( PBcd(AFieldData)^ );
            end;
            TDatabaseDataType.dtDate:
            begin
                AData^.&Type := vtDate;
                var ADate := FDDate2SQLTimeStamp(PInteger(AFieldData)^);
                AData^.AsDate.Year := ADate.Year;
                AData^.AsDate.Month := ADate.Month;
                AData^.AsDate.Day := ADate.Day;
            end;
            TDatabaseDataType.dtTime:
            begin
                AData^.&Type := vtTime;
                var ATime := FDTime2SQLTimeStamp(PInteger(AFieldData)^);
                AData^.AsTime.Hour := ATime.Hour;
                AData^.AsTime.Minute := ATime.Minute;
                AData^.AsTime.Second := ATime.Second;
                AData^.AsTime.Milliseconds := Word(ATime.Fractions);
            end;
            TDatabaseDataType.dtDateTime:
            begin
                AData^.&Type := vtDateTime;
                FromDateTime( AData^.AsDateTime, FDMSecs2DateTime( PDateTimeRec(AFieldData)^.DateTime ) );
            end;
            TDatabaseDataType.dtDateTimeStamp:
            begin
                AData^.&Type := vtDateTime;
                AData^.AsDateTime.Year := PSQLTimeStamp(AFieldData)^.Year;
                AData^.AsDateTime.Month := PSQLTimeStamp(AFieldData)^.Month;
                AData^.AsDateTime.Day := PSQLTimeStamp(AFieldData)^.Day;
                AData^.AsDateTime.Hour := PSQLTimeStamp(AFieldData)^.Hour;
                AData^.AsDateTime.Minute := PSQLTimeStamp(AFieldData)^.Minute;
                AData^.AsDateTime.Second := PSQLTimeStamp(AFieldData)^.Second;
                AData^.AsDateTime.Milliseconds := PSQLTimeStamp(AFieldData)^.Fractions;
            end;
        //    dtTimeIntervalFull, dtTimeIntervalYM, dtTimeIntervalDS:   PFDSQLTimeInterval(ABuffer)^ := PFDSQLTimeInterval(AFieldData)^;
            TDatabaseDataType.dtAnsiString:
            begin
                AData^.&Type := vtAnsiString;
                AData^.AsAnsiString.Data := PAnsiChar(AFieldData); //ProcessAnsiString(AFieldData, AdjustSize(ADataLen, AFieldNo), ABuffer);
                AData^.AsAnsiString.Size := ADataLen;
            end;
            TDatabaseDataType.dtWideString:
            begin
                AData^.&Type := vtWideString;
                AData^.AsWideString.Data := PWideChar(AFieldData); //ProcessWideString(AFieldData, AdjustSize(ADataLen, AFieldNo), ABuffer);
                AData^.AsWideString.Size := ADataLen;
            end;
            TDatabaseDataType.dtByteString:
            begin
                AData^.&Type := vtBytes;
                AData^.AsBytes.Size := ADataLen;
                AData^.AsBytes.Data := AFieldData;
            end;
            TDatabaseDataType.dtGUID:
            begin
                AData^.&Type := vtGuid;
                AData^.AsGuid := PGUID(AFieldData);
            end;
            TDatabaseDataType.dtMemo, TDatabaseDataType.dtHMemo:
            begin
                AData^.&Type := vtAnsiString;
                AData^.AsAnsiString.Data := PAnsiChar(AFieldData);
                AData^.AsAnsiString.Size := ADataLen;
            end;
            TDatabaseDataType.dtWideMemo, TDatabaseDataType.dtWideHMemo, TDatabaseDataType.dtXML:
            begin
                AData^.&Type := vtWideString;
                AData^.AsWideString.Data := PWideChar(AFieldData);
                AData^.AsWideString.Size := ADataLen;
            end;
            TDatabaseDataType.dtBlob, TDatabaseDataType.dtHBlob, TDatabaseDataType.dtHBFile:
            begin
                AData^.&Type := vtBytes;
                AData^.AsBytes.Size := ADataLen;
                AData^.AsBytes.Data := AFieldData;
            end;
            else
            begin
                AData^.&Type := vtEmpty;
                // unsuported type
            end
            end;
        Inc(AData);
        end;
    end;
end;

{$ENDREGION}

//*************************************************************************************/
function CreateDriver( name: PChar; parameters: PDriverCreateParameters; info: PDriverInfo ): Pointer; stdcall;
begin
    var driver := TDataDriver.Create( parameters );
    info^.Kind := 'PostgreSQL';
    info^.Valid := driver.DBConnection.Connected;
    info^.Flags := TDriverInfoFlags.ReadSchema or TDriverInfoFlags.WriteSchema;
    info^.Error := PChar(driver.Error);
    info^.Syntax := @driver.Syntax;
    result := driver;
end;

procedure FreeDriver( driver: Pointer ); stdcall;
begin
    if Assigned(driver) then
        TDataDriver(driver).Free;
end;

function CreateTransaction( driver: Pointer ): Pointer; stdcall;
begin
    result := TTransaction.Create( TDataDriver(driver) );
end;

procedure FreeTransaction( transaction: Pointer ); stdcall;
begin
    if Assigned(transaction) then
        TTransaction(transaction).Free;
end;

function StartTransaction( transaction: Pointer ): Integer; stdcall;
begin
    try
        TTransaction(transaction).Error := '';
        TTransaction(transaction).StartTransaction;
        result := TTransaction(transaction).TransactionID;
    except on e: Exception do
        begin
        result := 0;
        TTransaction(transaction).Error := e.Message;
        end;
    end;
end;

function CommitTransactionPhase1( transaction: Pointer ): Boolean; stdcall;
begin
    result := true;
    try
        TTransaction(transaction).TryCommit;
    except on e: Exception do
        begin
        result := false;
        TTransaction(transaction).Error := e.Message;
        end;
    end;
end;

function CommitTransactionPhase2( transaction: Pointer ): Boolean; stdcall;
begin
    result := true;
    try
        TTransaction(transaction).Commit;
    except on e: Exception do
        begin
        result := false;
        TTransaction(transaction).Error := e.Message;
        end;
    end;
end;

function RollbackTransaction( transaction: Pointer ): Boolean; stdcall;
begin
    result := true;
    try
        TTransaction(transaction).Rollback;
    except on e: Exception do
        begin
        result := false;
        TTransaction(transaction).Error := e.Message;
        end;
    end;
end;

function TransactionError( transaction: Pointer ): PChar; stdcall;
begin
    result := PChar(TTransaction(transaction).Error);
end;

function ExecuteSQL( transaction: Pointer; sql: PChar; parameters: PDriverParameter; parametersCount: Integer; info: PDriverResult ): Pointer; stdcall;
var
    AQuery: TQuery;
begin
    result := nil;
    TTransaction(transaction).Error := '';

    try
        AQuery := TQuery.Create(TTransaction(transaction).Driver);
        AQuery.DBConnection := TTransaction(transaction).Driver.DBConnection;
        AQuery.Transaction := TTransaction(transaction).DBTransaction;
        AQuery.SQL.Text := sql;

        if Assigned(parameters) and (parametersCount> 0) then
            AQuery.InitParamTypes( parameters, parametersCount );

        AQuery.Prepare;

        if Assigned(parameters) and (parametersCount> 0) then
            AQuery.InitParamValues( parameters, parametersCount );

        if AQuery.Command.CommandKind = skSelect then
            AQuery.Open
        else
            AQuery.Execute;

        if AQuery.Command.CommandKind = skSelect then
        begin
            if Assigned(info) then
            begin
                AQuery.RecordIndex := 0;
                AQuery.First;
                SetLength( AQuery.RecordBuffer, AQuery.Fields.Count );
                SetLength( AQuery.FieldInfos, AQuery.Fields.Count );
                for var i := 0 to AQuery.Fields.Count - 1 do
                begin
                    AQuery.FieldInfos[i].Name := PChar(AQuery.Fields[i].FieldName);
                    AQuery.FieldInfos[i].&Type := DataTypeToValueType( AQuery.Fields[i].DataType );
                end;
                info^.FieldCount := AQuery.FieldCount;
                if AQuery.FieldCount > 0 then
                    info^.Fields := @AQuery.FieldInfos[0]
                else
                    info^.Fields := nil;
                info^.Fetched := AQuery.RowsAffected;
            end;
            result := AQuery;
        end
        else
        begin
            if Assigned(info) then
            begin
                info^.FieldCount := 0;
                info^.Fields := nil;
                info^.Fetched := 0;
            end;
            FreeAndNil(AQuery);
        end;
    except on e: Exception do
        begin
            TTransaction(transaction).Error := e.Message;
            info^.Error := PChar(TTransaction(transaction).Error);
            FreeAndNil(AQuery);
        end;
    end;
end;

procedure ExecuteDDL( transaction: Pointer; sql: PChar; parameters: PDriverParameter; parametersCount: Integer); stdcall;
var
    AQuery: TQuery;
begin
    TTransaction(transaction).StartTransaction;
    try
        AQuery := TQuery.Create( TTransaction(transaction).Driver );
        try
            AQuery.Connection := TTransaction(transaction).Driver.DBConnection;
            AQuery.Transaction := TTransaction(transaction).DBTrans;
            AQuery.SQL.Text := sql;

            if Assigned(parameters) and (parametersCount> 0) then
            begin
                AQuery.InitParamTypes( parameters, parametersCount );
                AQuery.InitParamValues( parameters, parametersCount );
            end;

            AQuery.ExecSQL;
        finally
            FreeAndNil(AQuery);
        end;

        TTransaction(transaction).Commit;
    except on e: Exception do
        begin
            TTransaction(transaction).Rollback;
            TTransaction(transaction).Error := e.Message;
            FreeAndNil(AQuery);
        end;
    end;
end;

function ExecuteProcedure( transaction: Pointer; proc: PChar; parameters: PDriverParameter; parametersCount: Integer; info: PDriverResult ): Pointer; stdcall;
var
    i: Integer;
    AStoredProc: TStoredProc;
    AParam: PDriverParameter;
begin
    result := nil;
    TTransaction(transaction).Error := '';

    try
        AStoredProc := TStoredProc.Create(TTransaction(transaction).Driver);
        AStoredProc.Connection := TTransaction(transaction).Driver.DBConnection;
        AStoredProc.Transaction := TTransaction(transaction).DBTrans;
        AStoredProc.StoredProcName := proc;

        if Assigned( parameters ) and (parametersCount > 0) then
            AStoredProc.InitParamTypes( parameters, parametersCount );

        AStoredProc.Prepare;

        if Assigned( parameters ) and (parametersCount > 0) then
            AStoredProc.InitParamValues( parameters, parametersCount );

        if AStoredProc.Command.CommandKind = skSelect then
            AStoredProc.Open
        else
            AStoredProc.ExecProc;

        case AStoredProc.Command.CommandKind of
        skSelect:
        begin
            if Assigned(info) then
            begin
                AStoredProc.RecordIndex := 0;
                AStoredProc.First;
                SetLength( AStoredProc.RecordBuffer, AStoredProc.Fields.Count );
                SetLength( AStoredProc.FieldInfos, AStoredProc.Fields.Count );
                for i := 0 to AStoredProc.Fields.Count - 1 do
                begin
                    AStoredProc.FieldInfos[i].Name := PChar(AStoredProc.Fields[i].FieldName);
                    AStoredProc.FieldInfos[i].&Type := DataTypeToValueType(AStoredProc.Fields[i].DataType);
                end;
                info^.FieldCount := AStoredProc.FieldCount;
                if AStoredProc.FieldCount > 0 then
                    info^.Fields := @AStoredProc.FieldInfos[0]
                else
                    info^.Fields := nil;
                info^.Fetched := AStoredProc.RowsAffected;
            end;
            result := AStoredProc;
        end;
        skStoredProc:
        begin
            if Assigned(info) then
            begin
                info^.FieldCount := 0;
                info^.Fields := nil;
                info^.Fetched := 0;
            end;

            AParam := parameters;
            for var j := 0 to parametersCount - 1 do
            begin
                for i := 0 to AStoredProc.Params.Count - 1 do
                    if (AStoredProc.Params[i].ParamType in [TParamType.ptInputOutput, TParamType.ptOutput]) and
                        SameText(AStoredProc.Params[i].SQLName, AParam^.Name) then
                    begin
                        ValueFromDBParam( AParam^.Value, AStoredProc.Params[i] );
                        break;
                    end;
                Inc(AParam);
            end;

            result := AStoredProc;
        end;
        else 
            FreeAndNil(AStoredProc);
        end;
    except on e: Exception do
        begin
            TTransaction(transaction).Error := e.Message;
            info^.Error := PChar(TTransaction(transaction).Error);
            FreeAndNil(AStoredProc);
        end;
    end;
end;

procedure ReadSQLResult( sql_result: Pointer; data: PValue; fetched: PInteger ); stdcall;
begin
    case TDataSet(sql_result).Command.CommandKind of
        skSelect:
        begin
            var AQuery := TQuery(sql_result);
            if (AQuery.RecordIndex > 0) and not AQuery.Eof then AQuery.Next;
            AQuery.ReadRecord( AQuery.RecordBuffer, data );
            Inc(AQuery.RecordIndex);
            fetched^ := AQuery.RowsAffected;
        end;
        skStoredProc,
        begin
            var AProc := TStoredProc(sql_result);
            if (AProc.RecordIndex > 0) and not AProc.Eof then AProc.Next;
            AProc.ReadRecord( AProc.RecordBuffer, data );
            Inc(AProc.RecordIndex);
            fetched^ := AProc.RowsAffected;
        end;
    end;
end;

procedure FreeSQLResult( sql_result: Pointer ); stdcall;
begin
    if Assigned(sql_result) then
        TDataSet(sql_result).Free;
end;

function NextSequenceValue( driver: Pointer; name: PChar ): Variant; stdcall;
var
    AQuery: TQuery;
    ADriver: TDataDriver;
begin
    try
        ADriver := TDataDriver(driver);

        AQuery := TQuery.Create( ADriver );
        try
            AQuery.Connection := ADriver.DBConnection;
            AQuery.SQL.Text := Format( 'NEXT VALUE FOR %s', [StrPas(name)] );
            AQuery.Open;

            if not AQuery.Eof and (AQuery.FieldCount > 0) then
                result := AQuery.Fields[0].AsVariant;
        finally
            AQuery.Free;
        end;
    except on e: Exception do
        result := VarAsError(S_FALSE);
    end;
end;

function GetSchema( transaction: Pointer; table: PChar;
                    var fields: PDriverTableField; var fields_count: Integer;
                    var indices: PDriverTableIndex; var indices_count: Integer;
                    var constraints: PDriverTableConstraint; var constraint_count: Integer ): Pointer; stdcall;
begin
    result := TSchema.Create;
    try
        fields := nil;
        fields_count := 0;
        indices := nil;
        indices_count := 0;
        constraints := nil;
        constraint_count := 0;
        if TSchema(result).ReadTableSchema( TTransaction(transaction), table ) then
        begin
            fields_count := Length(TSchema(result).Fields);
            if fields_count > 0 then
                fields := @TSchema(result).Fields[0];
            indices_count := Length(TSchema(result).Indices);
            if indices_count > 0 then
                indices := @TSchema(result).Indices[0];
            constraint_count := Length(TSchema(result).Constraints);
            if constraint_count > 0 then
                constraints := @TSchema(result).Constraints[0];
        end
        else
        begin
            FreeAndNil(result);
        end;
    except on e: Exception do
        begin
            TTransaction(transaction).Error := e.Message;
            FreeAndNil(result);
        end;
    end;
end;

procedure FreeSchema( Schema: Pointer ); stdcall;
begin
    if Assigned(Schema) then
        TSchema(Schema).Free;
end;

exports
CreateDriver,
FreeDriver,
CreateTransaction,
FreeTransaction,
StartTransaction,
CommitTransactionPhase1,
CommitTransactionPhase2,
RollbackTransaction,
TransactionError,
ExecuteSQL,
ExecuteProcedure,
ExecuteDDL,
ReadSQLResult,
FreeSQLResult,
GetSchema,
FreeSchema;

initialization
FDManager.Active := True;
end.