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, MySQL and Oracle RDBMS. However, we plan to expand compatibility to include other popular RDBMS in the future.
If Firebird, MySQL 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 na
{
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 na::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<na::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;
na::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];
na::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 )
{
na::ds::RootDSEType type = na::ds::RootDSEType::ActiveDirectory;
Host = parameters->Host;
SSL = false;
auto DSTypeAndHost = na::tokenize( Host, L':' );
if( DSTypeAndHost.size() > 0 )
if( na::starts_with( DSTypeAndHost[0], u"AD" ) )
{
type = na::ds::RootDSEType::ActiveDirectory;
SSL = true;
}
else if( na::starts_with( DSTypeAndHost[0], u"LDAPS" ) )
{
type = na::ds::RootDSEType::LDAP;
SSL = true;
}
else if( na::starts_with( DSTypeAndHost[0], u"LDAP" ) )
{
type = na::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 na::ds::DirectoryServices( type, na::w2str( Storage.c_str() ), na::w2str( Host.c_str() ), na::w2str( User.c_str() ), na::w2str( Password.c_str() ), SSL, na::w2str( ConfigPath.c_str() ) ) );
if( !DS->isValid() )
Error = na::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( na::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 = na::replace( sql, u"\t", u" " );
sql = na::replace( sql, u"\r", u" " );
sql = na::replace( sql, u"\n", u" " );
sql = na::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 = na::replace( sql, u":" + name, u"?" );
}
hsql::SQLParserResult result;
hsql::SQLParser::parse( na::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( na::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 na::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 na::format( "(%s+%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpMinus:
return na::format( "(%s-%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpSlash:
return na::format( "(%s?/%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpPercentage:
return na::format( "(%s%%%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpEquals:
return na::format( "(%s=%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpNotEquals:
return na::format( "(!(%s=%s))", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpLess:
return na::format( "(%s<%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpLessEq:
return na::format( "(%s<=%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpGreater:
return na::format( "(%s>%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpGreaterEq:
return na::format( "(%s>=%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpLike:
return na::format( "(%s=%s)", processWhere( expr->expr ).c_str(), na::replace( processWhere( expr->expr2 ), "%", "*" ).c_str() );
case hsql::kOpNotLike:
return na::format( "(!(%s=%s))", processWhere( expr->expr ).c_str(), na::replace( processWhere( expr->expr2 ), "%", "*" ).c_str() );
case hsql::kOpAnd:
return na::format( "(&%s%s)", processWhere( expr->expr ).c_str(), processWhere( expr->expr2 ).c_str() );
case hsql::kOpOr:
return na::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 na::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 += na::str2s16( na::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 na::val2stre( parameters[(int)expr->ival]->Value, _error );
else
return "";
case hsql::kExprStar:
case hsql::kExprFunctionRef:
if( strcmpi( expr->name, "lower" ) == 0 )
return na::lower( processWhere( expr->exprList->at( 0 ) ) );
else if( strcmpi( expr->name, "upper" ) == 0 )
return na::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 = na::replace( qry, "(TYP=1)", _driver->DS->schema()->query->users() );
if( typeGroups )
qry = na::replace( qry, "(TYP=2)", _driver->DS->schema()->query->groups() );
if( !typeUsers && !typeGroups )
qry = na::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 = na::w2str( parameters[0]->Value.AsWideString.Data );
break;
default:
_error += na::str2s16( na::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 += na::str2s16( na::format( "Directory Services storage has incorect parameters for V_GRANTEE_MEMBER_OF!\r\n" ) );
}
else
{
_error += na::str2s16( na::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( na::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( na::val2str( name->Value ), na::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, ¶meters[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 ¶meters[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( na::starts_with( result->fields[i].Name, u"ID" ) )
_indexes[_ID] = i;
else if( na::starts_with( result->fields[i].Name, u"NAME" ) )
_indexes[_NAME] = i;
else if( na::starts_with( result->fields[i].Name, u"DSDN" ) )
_indexes[_DSDN] = i;
else if( na::starts_with( result->fields[i].Name, u"LABEL" ) )
_indexes[_LABEL] = i;
else if( na::starts_with( result->fields[i].Name, u"ENABLED" ) )
_indexes[_ENABLED] = i;
else if( na::starts_with( result->fields[i].Name, u"TYP" ) )
_indexes[_TYP] = i;
else if( na::starts_with( result->fields[i].Name, u"DESCRIPTION" ) )
_indexes[_DESCRIPTION] = i;
else if( na::starts_with( result->fields[i].Name, u"OCCUPATION" ) )
_indexes[_OCCUPATION] = i;
else if( na::starts_with( result->fields[i].Name, u"TITLE" ) )
_indexes[_TITLE] = i;
else if( na::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 == na::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( na::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.MySQL;
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,
FireDAC.Stan.Def,
FireDAC.Stan.Intf,
FireDAC.Stan.Consts,
FireDAC.Stan.Option,
FireDAC.Stan.Async,
FireDAC.Stan.Param,
FireDAC.Stan.Util,
FireDAC.DApt,
FireDAC.DatS,
FireDAC.Comp.Client,
FireDAC.Comp.DataSet,
FireDAC.Phys,
FireDAC.Phys.Intf,
FireDAC.Phys.MySQL,
FireDAC.Phys.MySQLCli,
FireDAC.Phys.MySQLDef,
FireDAC.Phys.MySQLWrapper,
FireDAC.UI.Intf,
FireDAC.ConsoleUI.Wait;
{$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;
TDriverOperators = packed record
Containing: PChar;
ContainingCaseInsensitive: PChar;
StartsWith: PChar;
StartsWithCaseInsensitive: PChar;
EndsWith: PChar;
EndsWithCaseInsensitive: PChar;
end;
TDriverSyntax = packed record
SelectOffset: PChar;
WhereOffset: PChar;
SelectLimit: PChar;
WhereLimit: PChar;
Table: TDriverTable;
Types: TDriverTypes;
Rules: TDriverRules;
Formats: TDriverFormats;
Sequence: TDriverSequence;
Operators: TDriverOperators;
QuotedChar: Char;
MergeSupport: Boolean;
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
TMySQLDataDriver = class;
TTransaction = class
private
Driver: TMySQLDataDriver;
Error: String;
ID: Int64;
BEGINCalled: Boolean;
ENDCalled: Boolean;
PREPARECalled: Boolean;
public
constructor Create( ADataDriver: TMySQLDataDriver ); reintroduce;
destructor Destroy; override;
procedure StartTransaction;
procedure TryCommit;
procedure Commit;
procedure Rollback;
property TransactionID: Int64 read ID;
end;
TQuery = class(TFDQuery)
public
constructor Create( ADriver: TMySQLDataDriver ); reintroduce;
destructor Destroy; override;
public
Driver: TMySQLDataDriver;
FieldInfos: TArray<TFieldInfo>;
RecordBuffer: TArray<TValueBuffer>;
RecordIndex: Integer;
end;
TStoredProc = class(TFDStoredProc)
public
constructor Create( ADriver: TMySQLDataDriver ); reintroduce;
destructor Destroy; override;
public
Driver: TMySQLDataDriver;
FieldInfos: TArray<TFieldInfo>;
RecordBuffer: TArray<TValueBuffer>;
RecordIndex: Integer;
end;
TFDRdbmsDataSetHelper = class helper for TFDRdbmsDataSet
procedure InitParamTypes( AParameters: PDriverParameter; AParametersCount: Integer );
procedure InitParamValues( AParameters: PDriverParameter; AParametersCount: Integer );
procedure ReadRecord( var ARecordBuffer: TArray<TValueBuffer>; AData: PValue );
end;
TMySQLDataDriver = class
private
Database: TFDConnection;
ServerVersion: TFDVersion;
Error: string;
CreateParameters: PDriverCreateParameters;
Syntax: TDriverSyntax;
procedure OpenDatabase;
procedure CreateDatabase;
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
{$IFDEF POSIX}
//uses System.IOUtils, Posix.Unistd,
{$ENDIF}
{$IFDEF MSWINDOWS}
//uses Windows;
{$ENDIF}
//procedure Trace(const Msg: string);
//const
// EOL = {$IFDEF POSIX} #10 {$ENDIF}
// {$IFDEF MSWINDOWS} #13#10 {$ENDIF};
//begin
{$IFDEF POSIX}
// __write(1{STDOUT_FILENO}, PAnsiChar(AnsiString(Msg)), Length(Msg));
// __write(1{STDOUT_FILENO}, PAnsiChar(EOL), Length(EOL));
{$ENDIF UNIX}
{$IFDEF MSWINDOWS}
// OutputDebugString(PChar(Msg.QuotedString));
{$ENDIF MSWINDOWS}
//end;
//procedure trace(const atext: AnsiString);
//begin
//__write(STDERR_FILENO, PAnsiChar(AText), Length(AText));
//TFile.AppendAllText('./daemon.log', atext);
//end;
type
TFDPhysConnectionEx = class(TFDPhysConnection)
end;
{$REGION 'Global implementation'}
function Iff(const Condition: Boolean; const TruePart, FalsePart: string): string; overload;
begin
if Condition then
Result := TruePart
else
Result := FalsePart;
end;
function Iff(const Condition: Boolean; const TruePart, FalsePart: TDataClassFieldDataType ): TDataClassFieldDataType; overload;
begin
if Condition then
Result := TruePart
else
Result := FalsePart;
end;
function StreamToVariant(Stream: TStream): Variant;
begin
result := Unassigned;
if Assigned(stream) then
begin
stream.Seek(0,{$ifdef LEVEL6}soBeginning{$else}0{$endif});
result := VarArrayCreate([0,stream.Size - 1], VarByte);
try
stream.ReadBuffer(TVarData(result).VArray^.Data^, stream.Size);
except end;
end
end;
function BlobToStream( Field: TField ): Variant;
var
AStream: TFDBlobStream;
begin
AStream:= TFDBlobStream.Create(Field, TBlobStreamMode.bmRead);
try
result := StreamToVariant(AStream);
finally
AStream.Free;
end;
end;
function ProccessError(const AError: string): string; inline;
begin
result := AError.Replace('[FireDAC][Phys]','');
end;
{$ENDREGION}
{$REGION 'TDataDriver'}
{ TDataDriver }
constructor TMySQLDataDriver.Create( AParameters: PDriverCreateParameters );
begin
inherited Create;
CreateParameters := AParameters;
Database := TFDConnection.Create( nil );
try
OpenDatabase;
except
on e: EMySQLNativeException do
// if database is missing => create new
if e.ErrorCode = 1049 {ER_BAD_DB_ERROR} then
CreateDatabase
else
Error := ProccessError(e.Message);
on e: Exception do
Error := ProccessError(e.Message);
end;
//if not Error.IsEmpty then exit;
if Database.Connected and (Database.ConnectionMetaDataIntf <> nil) then
ServerVersion := Database.ConnectionMetaDataIntf.ServerVersion;
Syntax.SelectOffset := '';
Syntax.WhereOffset := 'offset %d';
Syntax.SelectLimit := '';
Syntax.WhereLimit := 'limit %d';
Syntax.QuotedChar := '`';
Syntax.MergeSupport := false;
Syntax.Operators.Containing := '${FIELD} like concat(''%'', :${PAR}, ''%'')';
Syntax.Operators.ContainingCaseInsensitive := 'lower(${FIELD}) like lower(concat(''%'', :${PAR}, ''%''))';
Syntax.Operators.StartsWith := '${FIELD} like concat(:${PAR}, ''%'')';
Syntax.Operators.StartsWithCaseInsensitive := 'lower(${FIELD}) like lower(concat(:${PAR}, ''%''))';
Syntax.Operators.EndsWith := '${FIELD} like concat(''%'', :${PAR})';
Syntax.Operators.EndsWithCaseInsensitive := 'lower(${FIELD}) like lower(concat(''%'', :${PAR}))';
Syntax.Table.Create := 'CREATE TABLE ${TABLE}';
Syntax.Table.Drop := 'DROP TABLE ${TABLE}';
Syntax.Table.Grant := 'GRANT ALL ON ${TABLE} TO ''${USER}''@''${HOST}''';// WITH GRANT OPTION';
Syntax.Table.AddColumn := 'ALTER TABLE ${TABLE} ADD COLUMN ${COLUMN}';
Syntax.Table.DropColumn := 'ALTER TABLE ${TABLE} DROP COLUMN ${COLUMN}';
Syntax.Table.AddPrimaryKeyConstraint := 'ALTER TABLE ${TABLE} ADD 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.CreateIndex := 'CREATE INDEX ${INDEX} ON ${TABLE} (${COLUMNS})';
Syntax.Table.CreateUniqueIndex := 'ALTER TABLE ${TABLE} ADD CONSTRAINT ${INDEX} UNIQUE (${COLUMNS})';
Syntax.Table.DropIndex := 'DROP INDEX ${INDEX} ON ${TABLE}';
Syntax.Table.SetDefault := 'ALTER TABLE ${TABLE} MODIFY COLUMN ${COLUMN} ${COLUMN_DEFINITION} DEFAULT ${VALUE}';
Syntax.Table.DropDefault := 'ALTER TABLE ${TABLE} MODIFY COLUMN ${COLUMN} ${COLUMN_DEFINITION} DEFAULT NULL';
Syntax.Table.SetNullable := 'ALTER TABLE ${TABLE} MODIFY COLUMN ${COLUMN} ${COLUMN_DEFINITION} NULL';
Syntax.Table.DropNullable := 'ALTER TABLE ${TABLE} MODIFY COLUMN ${COLUMN} ${COLUMN_DEFINITION} 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(38,4)';
Syntax.Types.Float := 'FLOAT';
Syntax.Types.Double := 'DOUBLE';
Syntax.Types.Date := 'DATE';
Syntax.Types.Time := 'TIME';
Syntax.Types.DateTime := 'TIMESTAMP';
Syntax.Types.Boolean := 'CHAR(1)';
Syntax.Types.Clob := 'LONGTEXT';
Syntax.Types.Blob := 'BLOB';
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 TABLE ${SEQUENCE} (id BIGINT NOT NULL AUTO_INCREMENT, PRIMARY KEY (id))';
Syntax.Sequence.AlterStart := 'ALTER TABLE ${SEQUENCE} AUTO_INCREMENT = ${START}';
Syntax.Sequence.AlterIncrement := '';
Syntax.Sequence.Drop := 'DROP TABLE ${SEQUENCE}';
Syntax.Sequence.Grant := 'GRANT ALL ON ${SEQUENCE} TO ''${USER}''@''${HOST}''';
Syntax.Formats.Date := 'yyyy-mm-dd';
Syntax.Formats.Time := 'hh:nn';
Syntax.Formats.DateTime := 'yyyy-mm-dd hh:nn';
end;
procedure TMySQLDataDriver.OpenDatabase;
var
AHost, APort: string;
begin
if string(CreateParameters.Host).Contains(':') then
begin
AHost := string(CreateParameters.Host).Split([':'])[0];
APort := string(CreateParameters.Host).Split([':'])[1];
end
else
begin
AHost := string(CreateParameters.Host);
APort := '3306';
end;
Database.Params.Add('PageSize=8192');
Database.Params.Add('DriverID=MySQL');
Database.Params.Add('Server=' + AHost);
Database.Params.Add('Port=' + APort);
Database.Params.Add('Database=' + CreateParameters.Name);
Database.Params.Add('User_Name=' + CreateParameters.User);
Database.Params.Add('Password=' + CreateParameters.Password);
Database.Params.Add('CharacterSet=' + CreateParameters.Charset);
//if TFDPhysMySqlConnectionDefParams(Database.Params).CharacterSet = csNone then
// if CreateParameters.Charset = '' then
// Error := 'MySQL driver requires character set specified.'
// else
// Error := Format('MySQL driver requires character set specified. %s is unknown character set', [QuotedStr(CreateParameters.Charset)]);
Database.LoginPrompt := false;
Database.FetchOptions.Mode := fmAll;
Database.FetchOptions.Cache := [fiBlobs, fiMeta];
Database.FetchOptions.Items := [fiBlobs, fiMeta];
Database.FetchOptions.Unidirectional := true;
Database.ResourceOptions.AutoReconnect := true;
Database.ResourceOptions.KeepConnection := true;
Database.ResourceOptions.CmdExecMode := TFDStanAsyncMode.amBlocking;
Database.ResourceOptions.SilentMode := true;
FFDGUIxSilentMode := true;
Database.Open;
end;
procedure TMySQLDataDriver.CreateDatabase;
begin
try
Database.Params.Values['Database'] := '';
Database.Open;
Database.ExecSQL(Format('CREATE DATABASE %s', [CreateParameters.Name]));
Database.ExecSQL(Format('GRANT ALL PRIVILEGES ON %s.* TO ''%s''@''%s''', [CreateParameters.Name, CreateParameters.User, CreateParameters.Host]));
Database.Close;
Database.Params.Values['Database'] := CreateParameters.Name;
Database.Open;
except on e: Exception do
Error := ProccessError(e.Message);
end;
end;
destructor TMySQLDataDriver.Destroy;
begin
//TFile.AppendAllText('./daemon.log', 'TMySQLDataDriver.Destroy_ self:' + NativeInt(Self).tostring + ' db:' + NativeInt(Database).tostring + ' InTransaction: ' + BoolToStr(Database.InTransaction, true) + #13);
try
Database.Close;
except end; // because of annoyeng linux error: [FireDAC][Phys][FB]invalid database handle (no active connection)
FreeAndNil(Database);
inherited;
end;
{$ENDREGION}
{$REGION 'TTransaction'}
{ TTransaction }
var gTransactionID: Integer = 0;
constructor TTransaction.Create( ADataDriver: TMySQLDataDriver );
begin
Driver := ADataDriver;
BEGINCalled := false;
ENDCalled := false;
PREPARECalled := false;
end;
destructor TTransaction.Destroy;
begin
inherited;
end;
procedure TTransaction.StartTransaction;
begin
Error := '';
ENDCalled := false;
BEGINCalled := false;
PREPARECalled := false;
ID := AtomicIncrement(gTransactionID);
TFDPhysConnectionEx(Driver.Database.ConnectionIntf as TFDPhysConnection).InternalExecuteDirect( Format('XA START ''na%d''', [ID]), nil);
BEGINCalled := true;
end;
procedure TTransaction.TryCommit;
begin
if not ENDCalled then
begin
TFDPhysConnectionEx(Driver.Database.ConnectionIntf as TFDPhysConnection).InternalExecuteDirect( Format('XA END ''na%d''', [ID]), nil);
ENDCalled := true;
end;
if not PREPARECalled then
begin
TFDPhysConnectionEx(Driver.Database.ConnectionIntf as TFDPhysConnection).InternalExecuteDirect( Format('XA PREPARE ''na%d''', [ID]), nil);
PREPARECalled := true;
end;
end;
procedure TTransaction.Commit;
begin
if not ENDCalled then
begin
TFDPhysConnectionEx(Driver.Database.ConnectionIntf as TFDPhysConnection).InternalExecuteDirect( Format('XA END ''na%d''', [ID]), nil);
ENDCalled := true;
end;
if not PREPARECalled then
begin
TFDPhysConnectionEx(Driver.Database.ConnectionIntf as TFDPhysConnection).InternalExecuteDirect( Format('XA PREPARE ''na%d''', [ID]), nil);
PREPARECalled := true;
end;
TFDPhysConnectionEx(Driver.Database.ConnectionIntf as TFDPhysConnection).InternalExecuteDirect( Format('XA COMMIT ''na%d''', [ID]), nil);
ID := 0;
BEGINCalled := false;
ENDCalled := false;
PREPARECalled := false;
end;
procedure TTransaction.Rollback;
begin
if not ENDCalled then
begin
TFDPhysConnectionEx(Driver.Database.ConnectionIntf as TFDPhysConnection).InternalExecuteDirect( Format('XA END ''na%d''', [ID]), nil);
ENDCalled := false;
end;
TFDPhysConnectionEx(Driver.Database.ConnectionIntf as TFDPhysConnection).InternalExecuteDirect( Format('XA ROLLBACK ''na%d''', [ID]), nil);
ID := 0;
BEGINCalled := false;
ENDCalled := false;
PREPARECalled := false;
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: TFDParam);
begin
d.&Type := vtEmpty;
case p.FDDataType of
TFDDataType.dtBoolean:
begin
d.&Type := vtBool;
d.AsBool := p.Value;
end;
TFDDataType.dtSByte:
begin
d.&Type := vtInt8;
d.AsInt8 := p.Value;
end;
TFDDataType.dtByte:
begin
d.&Type := vtUInt8;
d.AsUInt8 := p.Value;
end;
TFDDataType.dtInt16:
begin
d.&Type := vtInt16;
d.AsUInt16 := p.Value;
end;
TFDDataType.dtUInt16:
begin
d.&Type := vtUInt16;
d.AsUInt16 := p.Value;
end;
TFDDataType.dtInt32:
begin
d.&Type := vtInt32;
d.AsInt32 := p.Value;
end;
TFDDataType.dtUInt32:
begin
d.&Type := vtUInt32;
d.AsUInt32 := p.Value;
end;
TFDDataType.dtInt64:
begin
d.&Type := vtInt64;
d.AsInt64 := p.Value;
end;
TFDDataType.dtUInt64:
begin
d.&Type := vtUInt64;
d.AsUInt64 := p.Value;
end;
TFDDataType.dtSingle:
begin
d.&Type := vtFloat;
d.AsFloat := p.Value;
end;
TFDDataType.dtDouble:
begin
d.&Type := vtDouble;
d.AsDouble := p.Value;
end;
TFDDataType.dtCurrency:
begin
d.&Type := vtCurrency;
d.AsCurrency := p.Value;
end;
TFDDataType.dtExtended:
begin
d.&Type := vtDouble;
d.AsDouble := p.Value;
end;
TFDDataType.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;
TFDDataType.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;
TFDDataType.dtDate:
begin
d.&Type := vtDate;
FromDateTime( d.AsDate, p.AsDate );
end;
TFDDataType.dtTime:
begin
d.&Type := vtTime;
FromDateTime( d.AsTime, p.AsTime );
end;
TFDDataType.dtDateTime:
begin
d.&Type := vtDateTime;
FromDateTime( d.AsDateTime, p.AsDateTime );
end;
TFDDataType.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;
//dtTimeIntervalFull, dtTimeIntervalYM, dtTimeIntervalDS: PFDSQLTimeInterval(ABuffer)^ := PFDSQLTimeInterval(AFieldData)^;
TFDDataType.dtAnsiString, TFDDataType.dtMemo, TFDDataType.dtHMemo:
begin
d.&Type := vtAnsiString;
d.AsAnsiString.Data := PAnsiChar(TVarData(p.Value).VString);
d.AsAnsiString.Size := Length(RawByteString(TVarData(p.Value).VString));
end;
TFDDataType.dtWideString, TFDDataType.dtWideMemo, TFDDataType.dtWideHMemo, TFDDataType.dtXML:
begin
d.&Type := vtWideString;
d.AsWideString.Data := PWideChar(TVarData(p.Value).VUString);
d.AsWideString.Size := Length(UnicodeString(TVarData(p.Value).VUString));
end;
TFDDataType.dtByteString, TFDDataType.dtBlob, TFDDataType.dtHBlob, TFDDataType.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;
TFDDataType.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;
// unsupported type
end;
else
begin
d.&Type := vtEmpty;
// unsupported type
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:
if (PVarData(@v)^.VDate = -700000.0 {NullDate 0/0/0000}) or (PVarData(@v)^.VDate = 0 {12/30/1899}) then
begin
d.&Type := vtNull
end
else
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'}
{TQuery}
constructor TQuery.Create( ADriver: TMySQLDataDriver );
begin
inherited Create(nil);
Driver := ADriver;
RecordIndex := 0;
end;
destructor TQuery.Destroy;
begin
inherited;
end;
{TStoredProc}
constructor TStoredProc.Create(ADriver: TMySQLDataDriver);
begin
inherited Create(nil);
Driver := ADriver;
RecordIndex := 0;
end;
destructor TStoredProc.Destroy;
begin
inherited;
end;
procedure TFDRdbmsDataSetHelper.InitParamTypes( AParameters: PDriverParameter; AParametersCount: Integer );
var
i: integer;
AParam: TFDParam;
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 TFDRdbmsDataSetHelper.InitParamValues( AParameters: PDriverParameter; AParametersCount: Integer );
var
i: integer;
AParam: TFDParam;
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 TFDRdbmsDataSetHelper.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
TFDDataType.dtBoolean:
begin
AData^.&Type := vtBool;
AData^.AsBool := PWordBool(AFieldData)^;
end;
TFDDataType.dtSByte:
begin
AData^.&Type := vtInt8;
AData^.AsInt8 := PShortInt(AFieldData)^;
end;
TFDDataType.dtByte:
begin
AData^.&Type := vtUInt8;
AData^.AsUInt8 := PByte(AFieldData)^;
end;
TFDDataType.dtInt16:
begin
AData^.&Type := vtInt16;
AData^.AsUInt16 := PSmallInt(AFieldData)^;
end;
TFDDataType.dtUInt16:
begin
AData^.&Type := vtUInt16;
AData^.AsUInt16 := PWord(AFieldData)^;
end;
TFDDataType.dtInt32:
begin
AData^.&Type := vtInt32;
AData^.AsInt32 := PInteger(AFieldData)^;
end;
TFDDataType.dtUInt32:
begin
AData^.&Type := vtUInt32;
AData^.AsUInt32 := PCardinal(AFieldData)^;
end;
TFDDataType.dtInt64:
begin
AData^.&Type := vtInt64;
AData^.AsInt64 := PInt64(AFieldData)^;
end;
TFDDataType.dtUInt64:
begin
AData^.&Type := vtUInt64;
AData^.AsUInt64 := PUInt64(AFieldData)^;
end;
TFDDataType.dtSingle:
begin
AData^.&Type := vtFloat;
AData^.AsFloat := PSingle(AFieldData)^;
end;
TFDDataType.dtDouble:
begin
AData^.&Type := vtDouble;
AData^.AsDouble := PDouble(AFieldData)^;
end;
TFDDataType.dtCurrency:
begin
AData^.&Type := vtCurrency;
AData^.AsCurrency := PCurrency(AFieldData)^;
end;
TFDDataType.dtExtended:
begin
AData^.&Type := vtDouble;
AData^.AsDouble := PExtended(AFieldData)^;
end;
TFDDataType.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;
TFDDataType.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;
TFDDataType.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;
TFDDataType.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;
TFDDataType.dtDateTime:
begin
AData^.&Type := vtDateTime;
FromDateTime( AData^.AsDateTime, FDMSecs2DateTime( PDateTimeRec(AFieldData)^.DateTime ) );
end;
TFDDataType.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)^;
TFDDataType.dtAnsiString:
begin
AData^.&Type := vtAnsiString;
AData^.AsAnsiString.Data := PAnsiChar(AFieldData); //ProcessAnsiString(AFieldData, AdjustSize(ADataLen, AFieldNo), ABuffer);
AData^.AsAnsiString.Size := ADataLen;
end;
TFDDataType.dtWideString:
begin
AData^.&Type := vtWideString;
AData^.AsWideString.Data := PWideChar(AFieldData); //ProcessWideString(AFieldData, AdjustSize(ADataLen, AFieldNo), ABuffer);
AData^.AsWideString.Size := ADataLen;
end;
TFDDataType.dtByteString:
begin
AData^.&Type := vtBytes;
AData^.AsBytes.Size := ADataLen;
AData^.AsBytes.Data := AFieldData;
end;
TFDDataType.dtGUID:
begin
AData^.&Type := vtGuid;
AData^.AsGuid := PGUID(AFieldData);
end;
TFDDataType.dtMemo, TFDDataType.dtHMemo:
begin
AData^.&Type := vtAnsiString;
AData^.AsAnsiString.Data := PAnsiChar(AFieldData);
AData^.AsAnsiString.Size := ADataLen;
end;
TFDDataType.dtWideMemo, TFDDataType.dtWideHMemo, TFDDataType.dtXML:
begin
AData^.&Type := vtWideString;
AData^.AsWideString.Data := PWideChar(AFieldData);
AData^.AsWideString.Size := ADataLen;
end;
TFDDataType.dtBlob, TFDDataType.dtHBlob, TFDDataType.dtHBFile:
begin
AData^.&Type := vtBytes;
AData^.AsBytes.Size := ADataLen;
AData^.AsBytes.Data := AFieldData;
end;
else
begin
AData^.&Type := vtEmpty;
// unsupported type
end
end;
Inc(AData);
end;
end;
end;
{$ENDREGION}
{$REGION 'Schema'}
type
TSchema = class
private
function CreateQuery(const SQLText: string; AConnection: TFDConnection): TFDQuery;
public
{$IFDEF DEBUG}
destructor Destroy; override;
{$ENDIF}
function ReadTableSchema(ATransaction: TTransaction; const ATable: string): Boolean;
public
Fields: TArray<TDriverTableField>;
Indices: TArray<TDriverTableIndex>;
Constraints: TArray<TDriverTableConstraint>;
end;
const
QRYTableExists =
'SELECT 1 FROM INFORMATION_SCHEMA.TABLES WHERE TABLE_SCHEMA = :SCHEMA AND TABLE_NAME = :TABLE';
QRYTableFields =
'SELECT COLUMN_NAME, COLUMN_COMMENT, DATA_TYPE, NUMERIC_PRECISION, NUMERIC_SCALE, CHARACTER_MAXIMUM_LENGTH, IS_NULLABLE '+
'FROM INFORMATION_SCHEMA.COLUMNS '+
'WHERE TABLE_SCHEMA = :SCHEMA AND TABLE_NAME = :TABLE';
QRYIndex =
'SELECT DISTINCT TABLE_NAME, INDEX_NAME, COLUMN_NAME, NON_UNIQUE, SEQ_IN_INDEX ' +
'FROM INFORMATION_SCHEMA.STATISTICS ' +
'WHERE TABLE_SCHEMA = :SCHEMA AND TABLE_NAME = :TABLE AND NOT INDEX_NAME = ''PRIMARY'' ' +
'ORDER BY INDEX_NAME, SEQ_IN_INDEX';
QRYUnique =
'SELECT TC.CONSTRAINT_NAME, TC.TABLE_NAME, KCU.COLUMN_NAME, TC.CONSTRAINT_TYPE ' +
'FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS TC ' +
'JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU ON TC.CONSTRAINT_NAME = KCU.CONSTRAINT_NAME AND TC.TABLE_NAME = KCU.TABLE_NAME AND TC.TABLE_SCHEMA = KCU.TABLE_SCHEMA ' +
'WHERE TC.TABLE_SCHEMA = :SCHEMA ' +
' AND TC.TABLE_NAME = :TABLE ' +
' AND TC.CONSTRAINT_TYPE = :CONSTRAINT_TYPE ' +
'ORDER BY CONSTRAINT_NAME, ORDINAL_POSITION';
QRYForeign =
'SELECT TC.CONSTRAINT_NAME, TC.TABLE_NAME, KCU.COLUMN_NAME, TC.CONSTRAINT_TYPE, KCU.REFERENCED_TABLE_NAME, KCU.REFERENCED_COLUMN_NAME, RC.UPDATE_RULE, RC.DELETE_RULE ' +
'FROM INFORMATION_SCHEMA.TABLE_CONSTRAINTS TC ' +
'JOIN INFORMATION_SCHEMA.KEY_COLUMN_USAGE KCU ON TC.CONSTRAINT_NAME = KCU.CONSTRAINT_NAME AND TC.TABLE_NAME = KCU.TABLE_NAME AND TC.TABLE_SCHEMA = KCU.TABLE_SCHEMA ' +
'JOIN INFORMATION_SCHEMA.REFERENTIAL_CONSTRAINTS RC ON KCU.CONSTRAINT_NAME = RC.CONSTRAINT_NAME AND KCU.CONSTRAINT_SCHEMA = RC.CONSTRAINT_SCHEMA ' +
'WHERE TC.TABLE_SCHEMA = :SCHEMA ' +
' AND TC.TABLE_NAME = :TABLE ' +
' AND KCU.REFERENCED_TABLE_NAME IS NOT NULL ' +
'ORDER BY CONSTRAINT_NAME, ORDINAL_POSITION';
{$IFDEF DEBUG}
destructor TSchema.Destroy;
begin
inherited;
end;
{$ENDIF}
//function TSchema.CutDefaultValue( const Source: string ): string;
//begin
// Result := Trim( Source );
// if Result <> '' then
// Result := Copy( Result, 9, System.Length( Result ) - 8 );
//end;
function TSchema.CreateQuery(const SQLText: string; AConnection: TFDConnection): TFDQuery;
begin
result := TFDQuery.Create( nil );
result.Connection := AConnection;
//result.Transaction := ATransaction;
//result.Options := [qoTrimCharFields, qoNoForceIsNull, qoStartTransaction];
result.SQL.Text := SQLText;
end;
function TSchema.ReadTableSchema(ATransaction: TTransaction; const ATable: string): Boolean;
// function _IndicesExists(const AName: string): boolean;
// begin
// for var c := Low(Indices) to High(Indices) do
// if SameText(Indices[c].Name, AName) then
// Exit(true);
// Exit(false);
// end;
//
// function _ConstraintExists(const AName: string): boolean;
// begin
// for var c := Low(Constraints) to High(Constraints) do
// if SameText(Constraints[c].Name, AName) then
// Exit(true);
// Exit(false);
// end;
var
i: integer;
QTable, QFields, QUnique, QIndex, QForeign: TFDQuery;
ACurIdx: Integer;
ACurName: string;
AName: string;
ADescription: string;
ADataType: TDataClassFieldDataType;
ASubType: integer;
ASize: integer;
AScale: integer;
APrecision: integer;
AIsNullable: boolean;
ARule: string;
AFields: string;
AForTable: string;
AForFields: string;
AUpdateRule: TSchemaConstraintUpdateRule;
ADeleteRule: TSchemaConstraintDeleteRule;
AUnique: boolean;
begin
QTable := CreateQuery( QRYTableExists, ATransaction.Driver.Database );
QFields := CreateQuery( QRYTableFields, ATransaction.Driver.Database );
QUnique := CreateQuery( QRYUnique, ATransaction.Driver.Database );
QIndex := CreateQuery( QRYIndex, ATransaction.Driver.Database );
QForeign := CreateQuery( QRYForeign, ATransaction.Driver.Database );
try
QTable.Params[0].AsString := ATransaction.Driver.CreateParameters.Name;
QTable.Params[1].AsString := ATable;
QTable.Open;
if QTable.RowsAffected = 0 then
Exit(false); // NO Table
QFields.Params[0].AsString := ATransaction.Driver.CreateParameters.Name;
QFields.Params[1].AsString := ATable;
QFields.Open;
i := 0;
SetLength(Self.Fields, QFields.RowsAffected);
while not QFields.Eof do
begin
AName := QFields.FieldByName('COLUMN_NAME').AsString;
ADescription := QFields.FieldByName('COLUMN_COMMENT').AsString;
ADataType := TDataClassFieldDataType.dtNone;
ASize := 0;
AScale := 0;
var ADataTypeName := QFields.FieldByName('DATA_TYPE').AsString;
if SameText(ADataTypeName, 'ENUM') then
begin
ADataType := TDataClassFieldDataType.dtVarString
end
else if SameText(ADataTypeName, 'ENUM') then
begin
ADataType := TDataClassFieldDataType.dtVarString
end
else if SameText(ADataTypeName, 'TINYINT') then
begin
ADataType := TDataClassFieldDataType.dtInteger;
end
else if SameText(ADataTypeName, 'BIT') then
begin
ADataType := TDataClassFieldDataType.dtNone;
end
else if SameText(ADataTypeName, 'BOOL') then
begin
ADataType := TDataClassFieldDataType.dtBoolean
end
else if SameText(ADataTypeName, 'SMALLINT') or SameText(ADataTypeName, 'MEDIUMINT') or SameText(ADataTypeName, 'INTEGER') or SameText(ADataTypeName, 'INT') then
begin
ADataType := TDataClassFieldDataType.dtInteger;
end
else if SameText(ADataTypeName, 'BIGINT') then
begin
ADataType := TDataClassFieldDataType.dtLargeint;
end
else if SameText(ADataTypeName, 'FLOAT') then
begin
ADataType := TDataClassFieldDataType.dtFloat;
APrecision := QFields.FieldByName('NUMERIC_PRECISION').AsInteger;
AScale := QFields.FieldByName('NUMERIC_SCALE').AsInteger;
if APrecision = 0 then
APrecision := 7; //LONG
end
else if SameText(ADataTypeName, 'DOUBLE') or SameText(ADataTypeName, 'REAL') then
begin
ADataType := TDataClassFieldDataType.dtDouble;
APrecision := QFields.FieldByName('NUMERIC_PRECISION').AsInteger;
AScale := QFields.FieldByName('NUMERIC_SCALE').AsInteger;
if APrecision > 16 then
ADataType := TDataClassFieldDataType.dtFmtBCD;
if APrecision = 0 then
APrecision := 15;
end
else if SameText(ADataTypeName, 'DECIMAL') or SameText(ADataTypeName, 'DEC') or SameText(ADataTypeName, 'NUMERIC') then
begin
ADataType := TDataClassFieldDataType.dtNumeric;
APrecision := QFields.FieldByName('NUMERIC_PRECISION').AsInteger;
AScale := QFields.FieldByName('NUMERIC_SCALE').AsInteger;
ASize := APrecision;
end
else if SameText(ADataTypeName, 'DATE') then
begin
ADataType := TDataClassFieldDataType.dtDate
end
else if SameText(ADataTypeName, 'DATETIME') then
begin
ADataType := TDataClassFieldDataType.dtDateTime
end
else if SameText(ADataTypeName, 'TIMESTAMP') then
begin
ADataType := TDataClassFieldDataType.dtDateTime
end
else if SameText(ADataTypeName, 'TIME') then
begin
ADataType := TDataClassFieldDataType.dtTime
end
else if SameText(ADataTypeName, 'YEAR') then
begin
ADataType := TDataClassFieldDataType.dtInteger
end
else if SameText(ADataTypeName, 'CHAR') then
begin
ADataType := TDataClassFieldDataType.dtFixString;
ASize := QFields.FieldByName('CHARACTER_MAXIMUM_LENGTH').AsInteger;
end
else if SameText(ADataTypeName, 'VARCHAR') then
begin
ADataType := TDataClassFieldDataType.dtVarString;
ASize := QFields.FieldByName('CHARACTER_MAXIMUM_LENGTH').AsInteger;
end
else if SameText(ADataTypeName, 'BINARY') then
begin
ADataType := TDataClassFieldDataType.dtBlob;
end
else if SameText(ADataTypeName, 'VARBINARY') then
begin
ADataType := TDataClassFieldDataType.dtBlob;
end
else if SameText(ADataTypeName, 'TINYBLOB') then
begin
ADataType := TDataClassFieldDataType.dtBlob;
end
else if SameText(ADataTypeName, 'TINYTEXT') then
begin
ADataType := TDataClassFieldDataType.dtMemo;
end
else if SameText(ADataTypeName, 'BLOB') or SameText(ADataTypeName, 'MEDIUMBLOB') or SameText(ADataTypeName, 'LONGBLOB') then
begin
ADataType := TDataClassFieldDataType.dtBlob;
end
else if SameText(ADataTypeName, 'TEXT') or SameText(ADataTypeName, 'MEDIUMTEXT') or SameText(ADataTypeName, 'LONGTEXT') then
begin
ADataType := TDataClassFieldDataType.dtMemo;
end;
AIsNullable := SameText(QFields.FieldByName('IS_NULLABLE').AsString, 'YES');
StrLCopy(Fields[i].Name, PChar(AName), MAX_FIELD_LEN-1);
StrLCopy(Fields[i].Description, PChar(ADescription), MAX_DESCRIPTION_LEN-1);
Fields[i].&Type := ADataType;
Fields[i].Size := ASize;
Fields[i].Scale := AScale;
Fields[i].Nullable := AIsNullable;
QFields.Next;
Inc(i);
end;
// PRIMARY
//if soPrimaryKey in ChildTypes then
begin
QUnique.Params[0].AsString := ATransaction.Driver.CreateParameters.Name;
QUnique.Params[1].AsString := ATable;
QUnique.Params[2].AsString := 'PRIMARY KEY';
QUnique.Open;
if not QUnique.Eof then
begin
AName := 'PK_' + ATable;
AFields := '';
while not QUnique.Eof do
begin
if not AFields.IsEmpty then AFields := AFields + ',';
AFields := AFields + Trim( QUnique.FieldByName('COLUMN_NAME').AsString );
QUnique.Next;
end;
SetLength(Self.Constraints, 1);
StrLCopy( Constraints[0].Name, PChar(AName), MAX_CONSTRAINT_LEN-1 );
StrLCopy( Constraints[0].TableName, PChar(ATable), MAX_TABLE_LEN-1 );
StrLCopy( Constraints[0].FieldName, PChar(AFields), MAX_CONSTRAINT_FIELDS_LEN-1 );
Constraints[0].IsPrimaryKey := true;
Constraints[0].IsForeignKey := false;
Constraints[0].IsUniqueKey := false;
Constraints[0].UpdateRule := scrUpdateNoAction;
Constraints[0].DeleteRule := scrDeleteNoAction;
end;
QUnique.Close;
end;
// FOREIGN
// if soForeignKeys in ChildTypes then
begin
QForeign.Params[0].AsString := ATransaction.Driver.CreateParameters.Name;
QForeign.Params[1].AsString := ATable;
QForeign.Open;
if not QForeign.Eof then
begin
AName := '';
ACurName := '';
AUpdateRule := scrUpdateNoAction;
ADeleteRule := scrDeleteNoAction;
while not QForeign.Eof do
begin
if ACurName <> Trim( QForeign.FieldByName('CONSTRAINT_NAME').AsString ) then
begin
if not ACurName.IsEmpty then
begin
ACurIdx := Length(Self.Constraints);
SetLength(Self.Constraints, ACurIdx+1);
StrLCopy( Constraints[ACurIdx].Name, PChar(AName), MAX_CONSTRAINT_LEN-1 );
StrLCopy( Constraints[ACurIdx].TableName, PChar(ATable), MAX_TABLE_LEN-1 );
StrLCopy( Constraints[ACurIdx].FieldName, PChar(AFields), MAX_CONSTRAINT_FIELDS_LEN-1 );
StrLCopy( Constraints[ACurIdx].RefTableName, PChar(AForTable), MAX_TABLE_LEN-1 );
StrLCopy( Constraints[ACurIdx].RefFieldName, PChar(AForFields), MAX_CONSTRAINT_FIELDS_LEN-1 );
Constraints[ACurIdx].IsPrimaryKey := false;
Constraints[ACurIdx].IsForeignKey := true;
Constraints[ACurIdx].IsUniqueKey := false;
Constraints[ACurIdx].UpdateRule := AUpdateRule;
Constraints[ACurIdx].DeleteRule := ADeleteRule;
end;
AName := QForeign.FieldByName('CONSTRAINT_NAME').AsString;
AForTable := Trim( QForeign.FieldByName('REFERENCED_TABLE_NAME').AsString ); // target table
AFields := Trim( QForeign.FieldByName('COLUMN_NAME').AsString ); // this table fields
AForFields := Trim( QForeign.FieldByName('REFERENCED_COLUMN_NAME').AsString ); // target table fields
ARule := QForeign.FieldByName('UPDATE_RULE').AsString;
if ARule = 'NO ACTION' then
AUpdateRule := scrUpdateNoAction
else if ARule = 'RESTRICT' then
AUpdateRule := scrUpdateRestrict
else if ARule = 'CASCADE' then
AUpdateRule := scrUpdateCascade
else if ARule = 'SET NULL' then
AUpdateRule := scrUpdateSetNull
else if ARule = 'SET DEFAULT' then
AUpdateRule := scrUpdateSetDefault
else
AUpdateRule := scrUpdateNoAction;
ARule := QForeign.FieldByName('DELETE_RULE').AsString;
if ARule = 'NO ACTION' then
ADeleteRule := scrDeleteNoAction
else if ARule = 'RESTRICT' then
ADeleteRule := scrDeleteRestrict
else if ARule = 'CASCADE' then
ADeleteRule := scrDeleteCascade
else if ARule = 'SET NULL' then
ADeleteRule := scrDeleteSetNull
else if ARule = 'SET DEFAULT' then
ADeleteRule := scrDeleteSetDefault
else
ADeleteRule := scrDeleteNoAction;
ACurName := AName;
end
else
begin
AFields := AFields + ',' + Trim( QForeign.FieldByName('COLUMN_NAME').AsString );
AForFields := AForFields + ',' + Trim( QForeign.FieldByName('REFERENCED_COLUMN_NAME').AsString );
end;
QForeign.Next;
end;
ACurIdx := Length(Self.Constraints);
SetLength(Self.Constraints, ACurIdx+1);
StrLCopy( Constraints[ACurIdx].Name, PChar(AName), MAX_CONSTRAINT_LEN-1 );
StrLCopy( Constraints[ACurIdx].TableName, PChar(ATable), MAX_TABLE_LEN-1 );
StrLCopy( Constraints[ACurIdx].FieldName, PChar(AFields), MAX_CONSTRAINT_FIELDS_LEN-1 );
StrLCopy( Constraints[ACurIdx].RefTableName, PChar(AForTable), MAX_TABLE_LEN-1 );
StrLCopy( Constraints[ACurIdx].RefFieldName, PChar(AForFields), MAX_CONSTRAINT_FIELDS_LEN-1 );
Constraints[ACurIdx].IsPrimaryKey := false;
Constraints[ACurIdx].IsForeignKey := true;
Constraints[ACurIdx].IsUniqueKey := false;
Constraints[ACurIdx].UpdateRule := AUpdateRule;
Constraints[ACurIdx].DeleteRule := ADeleteRule;
end;
end;
// UNIQUE
//if soPrimaryKey in ChildTypes then
begin
QUnique.Params[0].AsString := ATransaction.Driver.CreateParameters.Name;
QUnique.Params[1].AsString := ATable;
QUnique.Params[2].AsString := 'UNIQUE';
QUnique.Open;
if not QUnique.Eof then
begin
ACurName := '';
AName := '';
AFields := '';
while not QUnique.Eof do
begin
AName := QUnique.FieldByName('CONSTRAINT_NAME').AsString;
//if not _ConstraintExists(AName) and not _IndicesExists(AName) then
if ACurName <> AName then
begin
if not ACurName.IsEmpty then
begin
ACurIdx := Length(Self.Constraints);
SetLength(Self.Constraints, Length(Self.Constraints)+1);
StrLCopy( Constraints[ACurIdx].Name, PChar(AName), MAX_CONSTRAINT_LEN-1 );
StrLCopy( Constraints[ACurIdx].TableName, PChar(ATable), MAX_TABLE_LEN-1 );
StrLCopy( Constraints[ACurIdx].FieldName, PChar(AFields), MAX_CONSTRAINT_FIELDS_LEN-1 );
Constraints[ACurIdx].IsPrimaryKey := false;
Constraints[ACurIdx].IsForeignKey := false;
Constraints[ACurIdx].IsUniqueKey := true;
Constraints[ACurIdx].UpdateRule := scrUpdateNoAction;
Constraints[ACurIdx].DeleteRule := scrDeleteNoAction;
end;
ACurName := AName;
AFields := QUnique.FieldByName('COLUMN_NAME').AsString;
end
else
begin
AFields := AFields + ',' + Trim( QUnique.FieldByName('COLUMN_NAME').AsString );
end;
QUnique.Next;
end;
// handle the last one
//if not _ConstraintExists(AName) and not _IndicesExists(AName) then
begin
ACurIdx := Length(Self.Constraints);
SetLength(Self.Constraints, ACurIdx+1);
StrLCopy( Constraints[ACurIdx].Name, PChar(AName), MAX_CONSTRAINT_LEN-1 );
StrLCopy( Constraints[ACurIdx].TableName, PChar(ATable), MAX_TABLE_LEN-1 );
StrLCopy( Constraints[ACurIdx].FieldName, PChar(AFields), MAX_CONSTRAINT_FIELDS_LEN-1 );
Constraints[ACurIdx].IsPrimaryKey := false;
Constraints[ACurIdx].IsForeignKey := false;
Constraints[ACurIdx].IsUniqueKey := true;
Constraints[ACurIdx].UpdateRule := scrUpdateNoAction;
Constraints[ACurIdx].DeleteRule := scrDeleteNoAction;
end;
end
end;
// INDICES
//if soIndex in ChildTypes then
begin
QIndex.Params[0].AsString := ATransaction.Driver.CreateParameters.Name;
QIndex.Params[1].AsString := ATable;
QIndex.Open;
if not QIndex.Eof then
begin
ACurName := '';
AName := '';
AUnique := false;
while not QIndex.Eof do
begin
//if not _ConstraintExists(QIndex.FieldByName('INDEX_NAME').AsString) and not _IndicesExists(QIndex.FieldByName('INDEX_NAME').AsString) then
if ACurName <> QIndex.FieldByName('INDEX_NAME').AsString then
begin
if not ACurName.IsEmpty then
begin
ACurIdx := Length(Indices);
SetLength(Indices, ACurIdx+1);
StrLCopy( Indices[ACurIdx].Name, PChar(AName), MAX_INDEX_LEN-1 );
StrLCopy( Indices[ACurIdx].Fields, PChar(AFields), MAX_INDEX_FIELDS_LEN-1 );
Indices[ACurIdx].IsUnique := AUnique;
end;
AName := QIndex.FieldByName('INDEX_NAME').AsString;
AFields := QIndex.FieldByName('COLUMN_NAME').AsString;
AUnique := QIndex.FieldByName('NON_UNIQUE').AsInteger = 0;
ACurName := AName;
end
else
begin
AFields := AFields + ',' + QIndex.FieldByName('COLUMN_NAME').AsString;
end;
QIndex.Next;
end;
// handle the last one
//if not _ConstraintExists(AName) and not _IndicesExists(AName) then
begin
ACurIdx := Length(Indices);
SetLength(Indices, ACurIdx+1);
StrLCopy( Indices[ACurIdx].Name, PChar(AName), MAX_INDEX_LEN-1 );
StrLCopy( Indices[ACurIdx].Fields, PChar(AFields), MAX_INDEX_FIELDS_LEN-1 );
Indices[ACurIdx].IsUnique := AUnique;
end;
end;
end;
finally
QTable.Free;
QFields.Free;
QUnique.Free;
QIndex.Free;
QForeign.Free;
end;
result := true
end;
{$ENDREGION}
//*************************************************************************************/
function CreateDriver( name: PChar; parameters: PDriverCreateParameters; info: PDriverInfo ): Pointer; stdcall;
begin
var driver := TMySQLDataDriver.Create( parameters );
info^.Kind := 'MySQL';
info^.Valid := driver.Database.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
TMySQLDataDriver(driver).Free;
end;
function CreateTransaction( driver: Pointer ): Pointer; stdcall;
begin
result := TTransaction.Create( TMySQLDataDriver(driver) );
end;
procedure FreeTransaction( transaction: Pointer ); stdcall;
begin
try
if Assigned(transaction) then
TTransaction(transaction).Free;
except on e: Exception do
TTransaction(transaction).Error := ProccessError(e.Message);
end;
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 := ProccessError(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 := ProccessError(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 := ProccessError(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 := ProccessError(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.Connection := TTransaction(transaction).Driver.Database;
//AQuery.Transaction := TTransaction(transaction).Transaction;
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 = TFDPhysCommandKind.skSelect then
AQuery.Open
else
AQuery.Execute;
if AQuery.Command.CommandKind = TFDPhysCommandKind.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 := ProccessError(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).Error := '';
try
AQuery := TQuery.Create( TTransaction(transaction).Driver );
try
AQuery.Connection := TTransaction(transaction).Driver.Database;
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;
except on e: Exception do
begin
TTransaction(transaction).Error := ProccessError(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.Database;
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 = TFDPhysCommandKind.skSelect then
AStoredProc.Open
else
try
AStoredProc.ExecProc;
except
on e: EMySQLNativeException do
if e.ErrorCode <> 5025 then // libMariaDB.dll Error 5025: "Statement has no result set" => ignore it
raise e;
end;
case AStoredProc.Command.CommandKind of
TFDPhysCommandKind.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;
TFDPhysCommandKind.skStoredProc,
TFDPhysCommandKind.skStoredProcWithCrs,
TFDPhysCommandKind.skStoredProcNoCrs:
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 // case of
FreeAndNil(AStoredProc);
end;
except on e: Exception do
begin
TTransaction(transaction).Error := ProccessError(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 TFDRdbmsDataSet(sql_result).Command.CommandKind of
TFDPhysCommandKind.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;
TFDPhysCommandKind.skStoredProc,
TFDPhysCommandKind.skStoredProcWithCrs,
TFDPhysCommandKind.skStoredProcNoCrs:
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
TFDRdbmsDataSet(sql_result).Free;
end;
function NextSequenceValue( driver: Pointer; name: PChar ): Variant; stdcall;
var
ADriver: TMySQLDataDriver;
begin
try
ADriver := TMySQLDataDriver(driver);
result := ADriver.Database.ExecSQLScalar( Format( 'INSERT INTO %s VALUES (); SELECT LAST_INSERT_ID() AS next_val', [StrPas(name)]) );
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
TTransaction(transaction).Error := '';
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 := ProccessError(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.