unit dbstructures;

gnugettext, Vcl.Graphics, Winapi.Windows, System.SysUtils, System.Classes, System.IOUtils,

System.Generics.Collections, StrUtils;

TNetType = (

ntMySQL_TCPIP,

ntMySQL_NamedPipe,

ntMySQL_SSHtunnel,

ntMSSQL_NamedPipe,

ntMSSQL_TCPIP,

ntMSSQL_SPX,

ntMSSQL_VINES,

ntMSSQL_RPC,

ntPgSQL_TCPIP,

ntPgSQL_SSHtunnel,

ntSQLite,

ntMySQL_ProxySQLAdmin,

ntInterbase_TCPIP,

ntInterbase_Local,

ntFirebird_TCPIP,

ntFirebird_Local,

ntMySQL_RDS,

ntSQLiteEncrypted

);

TNetTypeGroup = (ngMySQL, ngMSSQL, ngPgSQL, ngSQLite, ngInterbase);

TNetTypeLibs = TDictionary<TNetType, TStringList>;

// SQL query ids and provider

TStringMap = TDictionary<string,string>;

TQueryId = (qDatabaseTable, qDatabaseTableId, qDatabaseDrop,

qDbObjectsTable, qDbObjectsCreateCol, qDbObjectsUpdateCol, qDbObjectsTypeCol,

qEmptyTable, qRenameTable, qRenameView, qCurrentUserHost, qLikeCompare,

qAddColumn, qChangeColumn, qRenameColumn, qForeignKeyEventAction,

qGlobalStatus, qCommandsCounters, qSessionVariables, qGlobalVariables,

qISSchemaCol,

qUSEQuery, qKillQuery, qKillProcess,

qFuncLength, qFuncCeil, qFuncLeft, qFuncNow, qFuncLastAutoIncNumber,

qLockedTables, qDisableForeignKeyChecks, qEnableForeignKeyChecks,

qOrderAsc, qOrderDesc, qGetRowCountExact, qGetRowCountApprox,

qForeignKeyDrop, qGetTableColumns, qGetCollations, qGetCollationsExtended, qGetCharsets,

qGetReverseForeignKeys, qExplain, qSetTimezone,

qShowFunctionStatus, qShowProcedureStatus, qShowTriggers, qShowEvents, qShowCreateTrigger,

qHelpKeyword, qShowWarnings, qGetEnumTypes,

qDropUser, qCreateRole, qDropRole, qReloadPrivileges, qGrantRole, qRevokeRole, qSetDefaultRole,

qAutoInc, qIndexVisible, qIndexInvisible);

TSqlProvider = class

strict protected

FNetType: TNetType;

FServerVersion: Integer;

public

constructor Create(ANetType: TNetType);

function Has(AId: TQueryId): Boolean;

// Base version, just returns the original SQL string

function GetSql(AId: TQueryId): string; overload; virtual;

// Version for simple strings passed to Format()

function GetSql(AId: TQueryId; const Args: array of const): string; overload;

// Version for named parameters

function GetSql(AId: TQueryId; NamedParameters: TStringMap): string; overload;

property ServerVersion: Integer read FServerVersion write FServerVersion;

end;

// Column types

TDBDatatypeIndex = (dbdtTinyint, dbdtSmallint, dbdtMediumint, dbdtInt, dbdtUint, dbdtBigint, dbdtSerial, dbdtBigSerial,

dbdtFloat, dbdtDouble, dbdtDecimal, dbdtNumeric, dbdtReal, dbdtDoublePrecision, dbdtMoney, dbdtSmallmoney,

dbdtDate, dbdtTime, dbdtYear, dbdtDatetime, dbdtDatetime2, dbdtDatetimeOffset, dbdtSmalldatetime, dbdtTimestamp, dbdtInterval,

dbdtChar, dbdtNchar, dbdtVarchar, dbdtNvarchar, dbdtTinytext, dbdtText, dbdtCiText, dbdtNtext, dbdtMediumtext, dbdtLongtext,

dbdtJson, dbdtJsonB, dbdtCidr, dbdtInet, dbdtMacaddr,

dbdtBinary, dbdtVarbinary, dbdtTinyblob, dbdtBlob, dbdtMediumblob, dbdtLongblob, dbdtVector, dbdtImage,

dbdtEnum, dbdtSet, dbdtBit, dbdtVarBit, dbdtBool, dbdtRegClass, dbdtRegProc, dbdtUnknown,

dbdtCursor, dbdtSqlvariant, dbdtTable, dbdtUniqueidentifier, dbdtInet4, dbdtInet6, dbdtHierarchyid, dbdtXML,

dbdtPoint, dbdtLinestring, dbdtLineSegment, dbdtPolygon, dbdtGeometry, dbdtBox, dbdtPath, dbdtCircle, dbdtMultipoint, dbdtMultilinestring, dbdtMultipolygon, dbdtGeometrycollection

);

// Column type categorization

TDBDatatypeCategoryIndex = (dtcInteger, dtcReal, dtcText, dtcBinary, dtcTemporal, dtcSpatial, dtcOther);

// Column type structure

TDBDatatype = record

Index: TDBDatatypeIndex;

NativeType: Integer; // MySQL column type constant (e.g. 1 = TINYINT). See include/mysql.h.pp.

NativeTypes: String; // Same as above, but for multiple ids (e.g. PostgreSQL oids). Prefer over NativeType. See GetDatatypeByNativeType.

Name: String;

Names: String;

Description: String;

HasLength: Boolean; // Can have Length- or Set-attribute?

RequiresLength: Boolean; // Must have a Length- or Set-attribute?

MaxSize: Int64;

DefaultSize: Int64; // TEXT and BLOB allow custom length, but we want to leave the default max length away from ALTER TABLE's

HasBinary: Boolean; // Can be binary?

HasDefault: Boolean; // Can have a default value?

LoadPart: Boolean; // Select per SUBSTR() or LEFT()

DefLengthSet: String; // Should be set for types which require a length/set

Format: String; // Used for date/time values when displaying and generating queries

ValueMustMatch: String;

Category: TDBDatatypeCategoryIndex;

MinVersion: Integer;

end;

// Column type category structure

TDBDatatypeCategory = record

Index: TDBDatatypeCategoryIndex;

Name: String;

Color: TColor;

NullColor: TColor;

end;

// Server variables

TVarScope = (vsGlobal, vsSession, vsBoth);

TServerVariable = record

Name: String;

IsDynamic: Boolean;

VarScope: TVarScope;

EnumValues: String;

end;

// Custom exception class for any connection or database related error

EDbError = class(Exception)

private

FErrorCode: Cardinal;

FHint: String;

public

property ErrorCode: Cardinal read FErrorCode;

property Hint: String read FHint;

constructor Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String='');

end;

// DLL loading

TDbLib = class(TObject)

const

LIB_PROC_ERROR: Cardinal = 1000;

private

FHandle: HMODULE;

protected

FDllFile: String;

procedure AssignProc(var Proc: FARPROC; Name: PAnsiChar; Mandantory: Boolean=True);

procedure AssignProcedures; virtual; abstract;

public

property Handle: HMODULE read FHandle;

property DllFile: String read FDllFile;

constructor Create(UsedDllFile, HintDefaultDll: String); virtual;

destructor Destroy; override;

end;

// Column type categories

DatatypeCategories: array[TDBDatatypeCategoryIndex] of TDBDatatypeCategory = (

(

Index: dtcInteger;

Name: 'Integer'

),

(

Index: dtcReal;

Name: 'Real'

),

(

Index: dtcText;

Name: 'Text'

),

(

Index: dtcBinary;

Name: 'Binary'

),

(

Index: dtcTemporal;

Name: 'Temporal (time)'

),

(

Index: dtcSpatial;

Name: 'Spatial (geometry)'

),

(

Index: dtcOther;

Name: 'Other'

)

);

uses apphelpers;

constructor TSqlProvider.Create(ANetType: TNetType);

FNetType := ANetType;

FServerVersion := 0;

end;

function TSqlProvider.Has(AId: TQueryId): Boolean;

Result := not GetSql(AId).IsEmpty;

end;

function TSqlProvider.GetSql(AId: TQueryId): string;

// Basic default SQL snippets compatible to all or most servers

case AId of

qEmptyTable: Result := 'DELETE FROM %s';

qForeignKeyEventAction: Result := 'RESTRICT,CASCADE,SET NULL,NO ACTION';

qOrderAsc: Result := 'ASC';

qOrderDesc: Result := 'DESC';

qGetRowCountExact: Result := 'SELECT COUNT(*) FROM :QuotedDbAndTableName';

qAutoInc: Result := 'AUTO_INCREMENT';

else Result := '';

end;

end;

function TSqlProvider.GetSql(AId: TQueryId; const Args: array of const): string;

Result := GetSql(AId);

if Result.IsEmpty then

Exit;

Result := Format(Result, Args);

end;

function TSqlProvider.GetSql(AId: TQueryId; NamedParameters: TStringMap): string;

Key: String;

Result := GetSql(AId);

if Result.IsEmpty then

Exit;

for Key in NamedParameters.Keys do begin

Result := StringReplace(Result, ':'+Key, NamedParameters[Key], [rfReplaceAll]);

end;

end;

constructor EDbError.Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String='');

FErrorCode := ErrorCode_;

FHint := Hint_;

inherited Create(Msg);

end;

constructor TDbLib.Create(UsedDllFile, HintDefaultDll: String);

msg, ErrorHint: String;

// Load DLL as is (with or without path)

inherited Create;

FDllFile := UsedDllFile;

// On Windows, we have the full path to the dll file here, so even if the file portion is empty, FDllFile contains a path / non-empty string

if not FileExists(FDllFile) then begin

Raise EdbError.Create(_('No library selected. Please select one of the provided libraries in the drop-down.'));

end;

FHandle := LoadLibrary(PWideChar(FDllFile));

if FHandle = 0 then begin

msg := f_('Library %s could not be loaded. Please select a different one.',

[ExtractFileName(FDllFile)]

);

if GetLastError <> 0 then begin

msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastError, SysErrorMessage(GetLastError)]);

end;

if (HintDefaultDll <> '') and (ExtractFileName(FDllFile) <> HintDefaultDll) then begin

ErrorHint := f_('You could try the default library %s in your session settings. (Current: %s)',

[HintDefaultDll, ExtractFileName(FDllFile)]

);

end else begin

ErrorHint := '';

end;

Raise EDbError.Create(msg, GetLastError, ErrorHint);

end;

// Dll was loaded, now initialize required procedures

AssignProcedures;

end;

destructor TDbLib.Destroy;

if FHandle <> 0 then begin

FreeLibrary(FHandle);

FHandle := 0;

end;

inherited;

end;

procedure TDbLib.AssignProc(var Proc: FARPROC; Name: PAnsiChar; Mandantory: Boolean=True);

msg: String;

// Map library procedure to internal procedure

Proc := GetProcAddress(FHandle, Name);

if Proc = nil then begin

if Mandantory then begin

msg := f_('Library error in %s: Could not find procedure address for "%s"',

[ExtractFileName(FDllFile), Name]

);

if GetLastError <> 0 then

msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastError, SysErrorMessage(GetLastError)]);

Raise EDbError.Create(msg, LIB_PROC_ERROR);

end;

end;

end;

end.