diff --git a/source/dbstructures.pas b/source/dbstructures.pas index 012996f2..583553bf 100644 --- a/source/dbstructures.pas +++ b/source/dbstructures.pas @@ -1,221 +1,215 @@ -unit dbstructures; - -{$mode delphi}{$H+} - -interface - -uses - Classes, SysUtils, Graphics; - - -type - - // 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: TLibHandle; - protected - FDllFile: String; - procedure AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True); - procedure AssignProcedures; virtual; abstract; - public - property Handle: TLibHandle read FHandle; - property DllFile: String read FDllFile; - constructor Create(UsedDllFile, HintDefaultDll: String); virtual; - destructor Destroy; override; - end; - - -var - - // 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' - ) - ); - - - -implementation - -uses apphelpers; - - - -{ EDbError } - -constructor EDbError.Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String=''); -begin - FErrorCode := ErrorCode_; - FHint := Hint_; - inherited Create(Msg); -end; - - - -{ TDbLib } - -constructor TDbLib.Create(UsedDllFile, HintDefaultDll: String); -var - msg, ErrorHint: String; -begin - // Load DLL as is (with or without path) - inherited Create; - FDllFile := UsedDllFile; - if FDllFile.IsEmpty then begin - Raise EdbError.Create(f_('No library selected. Please make sure you have installed %s, e.g. "%s".', ['lib*[-dev]', 'libmariadb-dev'])); - end; - if not FileExists(FDllFile) then begin - msg := f_('File does not exist: %s', [FDllFile]) + - sLineBreak + sLineBreak + - f_('Please launch %s from the directory where you have installed it. Or just reinstall %s.', [APPNAME, APPNAME] - ); - Raise EdbError.Create(msg); - end; - - FHandle := LoadLibrary(FDllFile); - if FHandle = NilHandle then begin - msg := f_('Library %s could not be loaded. Please select a different one.', - [ExtractFileName(FDllFile)] - ); - if GetLastOSError <> 0 then begin - msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]); - 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, GetLastOSError, ErrorHint); - end; - - // Dll was loaded, now initialize required procedures - AssignProcedures; -end; - - -destructor TDbLib.Destroy; -begin - if FHandle <> 0 then begin - FreeLibrary(FHandle); - FHandle := 0; - end; - inherited; -end; - - -procedure TDbLib.AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True); -var - msg: String; -begin - // 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 GetLastOSError <> 0 then - msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]); - Raise EDbError.Create(msg, LIB_PROC_ERROR); - end; - end; -end; - - -end. +unit dbstructures; + +{$mode delphi}{$H+} + +interface + +uses + Classes, SysUtils, Graphics; + + +type + + // 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: TLibHandle; + protected + FDllFile: String; + procedure AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True); + procedure AssignProcedures; virtual; abstract; + public + property Handle: TLibHandle read FHandle; + property DllFile: String read FDllFile; + constructor Create(UsedDllFile, HintDefaultDll: String); virtual; + destructor Destroy; override; + end; + + +var + + // 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' + ) + ); + + + +implementation + +uses apphelpers; + + + +{ EDbError } + +constructor EDbError.Create(const Msg: string; const ErrorCode_: Cardinal=0; const Hint_: String=''); +begin + FErrorCode := ErrorCode_; + FHint := Hint_; + inherited Create(Msg); +end; + + + +{ TDbLib } + +constructor TDbLib.Create(UsedDllFile, HintDefaultDll: String); +var + msg, ErrorHint: String; +begin + // 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(f_('No library selected. Please make sure you have installed %s, e.g. "%s".', ['lib*[-dev]', 'libmariadb-dev'])); + end; + + FHandle := LoadLibrary(FDllFile); + if FHandle = NilHandle then begin + msg := f_('Library %s could not be loaded. Please select a different one.', + [ExtractFileName(FDllFile)] + ); + if GetLastOSError <> 0 then begin + msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]); + 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, GetLastOSError, ErrorHint); + end; + + // Dll was loaded, now initialize required procedures + AssignProcedures; +end; + + +destructor TDbLib.Destroy; +begin + if FHandle <> 0 then begin + FreeLibrary(FHandle); + FHandle := 0; + end; + inherited; +end; + + +procedure TDbLib.AssignProc(var Proc: Pointer; Name: PAnsiChar; Mandantory: Boolean=True); +var + msg: String; +begin + // 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 GetLastOSError <> 0 then + msg := msg + sLineBreak + sLineBreak + f_('Internal error %d: %s', [GetLastOSError, SysErrorMessage(GetLastOSError)]); + Raise EDbError.Create(msg, LIB_PROC_ERROR); + end; + end; +end; + + +end.