unit Unit_ABS_DBFunctions;
interface
uses
ABSSecurity,
ABSMain,
Data.DB,
System.Classes,
System.StrUtils,
System.Sysutils,
System.TypInfo,
System.UITypes,
Vcl.Controls,
Vcl.Dialogs;
{ Datenbank-Rückgabe Ergebnisse von Funktionen }
type
TDB_Result = record
Open_DataBase : Boolean;
Create_Database : Boolean;
Open_Table : Boolean;
Create_Table : Boolean;
Add_Table : Boolean;
Create_Field : Boolean;
Add_Field : Boolean;
Change_Field : Boolean;
Delete_Field : Boolean;
Create_Index : Boolean;
Add_Index : Boolean;
Change_Index : Boolean;
Rebuild_Index : Boolean;
RestructureResult : Boolean;
end;
type
TDB_Settings = record
Show_Errors : Boolean;
Show_Questions : Boolean;
Delete_Fields : Boolean;
end;
var
DB_Settings : TDB_Settings;
const
BR = #10#13;
DBR = BR + BR;
Question_Restructure_Table1 = 'Ein Programmupdate wurde kürzlich installiert. Die Datenbank ''%s'' muss aktualisiert werden. Dieser Vorgang kann länger dauern.';
Question_Restructure_Table2 = '!! Befolgen Sie diesen Hinweis unbedingt !!' + DBR + 'Bitte beenden Sie das Programm nicht, auch wenn es aussieht, als würde es festhängen. Bitte melden Sie keinen weiteren Benutzer im Netzwerk an.' + DBR + 'Die Datenbank kann sonst beschädigt werden.';
Error_C_DB_Create = 'Fehler: Datenbank [%s] konnte nicht erstellt werden!';
Error_C_Table_Open = 'Die Tabelle [%s] konnte nicht geöffnet werden.';
Error_C_Table_Create = 'Die Tabelle [%s] konnte nicht erstellt werden!';
Error_C_Index_Rebuild = 'Indexfehler beim Neuaufbeu in Tabelle [%s]!';
Error_C_Table_Restructure_AddField = 'Fehler bei der Restrukturierung. Das Tabellenfeld [%s] konnte nicht zur Tabelle [%s] hinzugefügt werden.';
Error_C_Table_DropField = 'Fehler beim Löschen von Tabellenfeld [%s] in Tabelle [%s]!';
Error_C_Table_Change_TypeSize = 'Fehler beim Ändern eines FeldTypes oder Feldgröße im Feld [%s]. Betrifft Tabelle [%s]!';
Question_C_Table_FieldSize = 'Ein bestehendes Feld [%s] soll verkleinert werden. Dadurch kann es zu Datenverlust kommen. Soll der Vorgang fortgesetzt werden?';
procedure init_Result( var _Result : TDB_Result );
function FieldTyp2String( _ft : TFieldType ) : string;
function init_DatabaseABS( _DataBase : TABSDatabase; _Table : TABSTable; _Query : TABSQuery; _DatabaseFileName : string; _DatabaseName : string; _MultiUser : Boolean = True; _Encrypted : Boolean = False; _CryptoAlgorithm : TABSCryptoAlgorithm = craRijndael_256; _CryptoPassword : string = ''; _PageSize : Integer = 128; _PageCountInExtent : Integer = 8; _MaxConnections : Integer = 483 ) : TDB_Result;
function init_TableABS_Query( _DataBase : TABSDatabase; _Table : TABSTable; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
function Restructure_Table_Query( _DataBase : TABSDatabase; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
function Create_Table_Query( _Table : TABSTable; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer > ) : TDB_Result;
function Index_Exists( _Table : TABSTable; const _IndexName : string ) : Boolean;
function Rebuild_Index_Query( _Table : TABSTable; _Query : TABSQuery; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
implementation
procedure init_Result( var _Result : TDB_Result );
begin
>> Hier mal ein Exit; rein machen und bitte testen.
_Result.Open_DataBase := False;
_Result.Create_Database := False;
_Result.Open_Table := False;
_Result.Create_Table := False;
_Result.Add_Table := False;
_Result.Create_Field := False;
_Result.Add_Field := False;
_Result.Change_Field := False;
_Result.Delete_Field := False;
_Result.Create_Index := False;
_Result.Add_Index := False;
_Result.Change_Index := False;
_Result.Rebuild_Index := False;
_Result.RestructureResult := False;
end;
function FieldTyp2String( _ft : TFieldType ) : string;
begin
case _ft of
ftAutoinc : Result := 'AUTOINC';
ftBlob : Result := 'BLOB';
ftBytes : Result := 'BYTES';
ftCurrency : Result := 'CURRENCY';
ftDate : Result := 'DATE';
ftDateTime : Result := 'DATETIME';
ftFloat : Result := 'FLOAT';
ftFmtMemo : Result := 'FORMATTEDMEMO';
ftGraphic : Result := 'GRAPHIC';
ftGUID : Result := '
GUID';
ftInteger : Result := 'INTEGER';
ftLargeInt : Result := 'LARGEINT';
ftBoolean : Result := 'BOOLEAN';
ftMemo : Result := 'MEMO';
ftSmallint : Result := 'SMALLINT';
ftString : Result := 'VARCHAR';
ftFixedChar : Result := 'FIXEDCHAR';
ftTime : Result := 'TIME';
ftTimeStamp : Result := 'TIMESTAMP';
ftVarBytes : Result := 'VARBYTES';
ftWideString : Result := 'WIDESTRING';
ftWord : Result := 'WORD'
else Result := 'unbekannt';
end;
end;
function init_DatabaseABS( _DataBase : TABSDatabase; _Table : TABSTable; _Query : TABSQuery; _DatabaseFileName : string; _DatabaseName : string; _MultiUser : Boolean = True; _Encrypted : Boolean = False; _CryptoAlgorithm : TABSCryptoAlgorithm = craRijndael_256; _CryptoPassword : string = ''; _PageSize : Integer = 128; _PageCountInExtent : Integer = 8; _MaxConnections : Integer = 483 ) : TDB_Result;
begin
_DataBase.DatabaseName := _DatabaseName;
_Table.DatabaseName := _DatabaseName;
_Query.DatabaseName := _DatabaseName;
_Table.Close;
_Query.Close;
_DataBase.Close;
_DataBase.DatabaseFileName := _DatabaseFileName;
try
if ( not _DataBase.Exists ) or ( not Fileexists( _DataBase.DatabaseFileName ) ) then
begin
if _Encrypted and ( Length( Trim( _CryptoPassword ) ) > 0 ) then
begin
_DataBase.CryptoAlgorithm := _CryptoAlgorithm;
_DataBase.Password := _CryptoPassword;
end;
_DataBase.CreateDatabase;
Result.Create_Database := True;
end;
if _MultiUser then
_DataBase.MultiUser := True;
_DataBase.Open;
Result.Open_DataBase := True;
except
if DB_Settings.Show_Errors then
ShowMessage( Format( Error_C_DB_Create, [ _DatabaseName ] ) );
end;
end;
function init_TableABS_Query( _DataBase : TABSDatabase; _Table : TABSTable; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
begin
_Table.Close;
_Query.Close;
_Table.TableName := _Table_Name;
_Table.DatabaseName := _DataBase.DatabaseName;
_Query.DatabaseName := _DataBase.DatabaseName;
{ Wenn schon vorhanden - öffnen und Feldprüfung }
if _Table.Exists then
try
_Table.Close;
Result := Restructure_Table_Query( _DataBase, _Query, _Table_Name, _Labels_DB, _Labels_DB_Type_Query, _Labels_DB_Size_Query, _Indizes_DB_Query );
_Table.Open;
_Table.Refresh;
Result.Open_Table := True;
if not Result.RestructureResult then
Exit;
except
if DB_Settings.Show_Errors then
ShowMessage( Format( Error_C_Table_Open, [ _Table_Name ] ) );
end;
{ Wenn noch nicht vorhanden - erstellen }
if not _Table.Exists then
try
Create_Table_Query( _Table, _Query, _Table_Name, _Labels_DB, _Labels_DB_Type_Query, _Labels_DB_Size_Query );
_Table.Refresh;
Result.Create_Table := True;
except
if DB_Settings.Show_Errors then
ShowMessage( Format( Error_C_Table_Create, [ _Table_Name ] ) );
end;
{ Alle Indizes (Index) - Suchfelder initialisieren }
try
Rebuild_Index_Query( _Table, _Query, _Labels_DB, _Labels_DB_Type_Query, _Indizes_DB_Query );
Result.Rebuild_Index := True;
except
if DB_Settings.Show_Errors then
ShowMessage( Format( Error_C_Index_Rebuild, [ _Table_Name ] ) );
end;
end;
function Restructure_Table_Query( _DataBase : TABSDatabase; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
var
x : Integer;
Dummy_Bool : Boolean;
field_old_type, field_new_type : string;
field_old_size, field_new_size : Integer;
begin
{ Tabellenfelder prüfen, gegebenenfalls anlegen }
for x := low( _Labels_DB ) to high( _Labels_DB ) do
begin
{ Tabellenfeld hinzufügen, wenn es nicht existiert }
try
_Query.SQL.Text := 'ALTER TABLE ' + _Table_Name + ' ADD (IF NOT EXISTS ' + _Labels_DB[ x ] + ' ' + Format( _Labels_DB_Type_Query[ x ], [ _Labels_DB_Size_Query[ x ] ] ) + ');';
_Query.ExecSQL;
Result.Add_Field := True;
except
if DB_Settings.Show_Errors then
ShowMessage( Format( Error_C_Table_Restructure_AddField, [ _Labels_DB[ x ], _Table_Name ] ) );
Exit;
end;
{ Tabellenfeld hinzufügen, wenn es nicht existiert }
{ Wenn Tabellenfeld falsches Format oder Größe hat }
_Query.RequestLive := True;
_Query.SQL.Text := 'SELECT * From ' + _Table_Name + ' WHERE 1 = 0';
_Query.Open;
field_old_type := FieldTyp2String( _Query.Fields[ x ].DataType );
field_old_size := _Query.Fields[ x ].Size;
if pos( #32, _Labels_DB_Type_Query[ x ] ) = 0 then
field_new_type := _Labels_DB_Type_Query[ x ];
if pos( #32, _Labels_DB_Type_Query[ x ] ) <> 0 then
field_new_type := LeftStr( _Labels_DB_Type_Query[ x ], pos( #32, _Labels_DB_Type_Query[ x ] ) );
field_new_size := _Labels_DB_Size_Query[ x ];
Dummy_Bool := not ( ( field_new_size = field_old_size ) or ( field_new_size > field_old_size ) );
if field_new_size < field_old_size then
if DB_Settings.Show_Questions then
Dummy_Bool := MessageDLG( Question_C_Table_FieldSize, mtConfirmation, mbYesNo, 0 ) = mrYes;
if field_new_size < field_old_size then
if not DB_Settings.Show_Questions then
Dummy_Bool := True;
if ( ( field_old_type <> field_new_type ) or ( field_old_size <> field_new_size ) ) and Dummy_Bool then
try
_Query.SQL.Text := 'ALTER TABLE ' + _Table_Name + ' MODIFY (' + _Labels_DB[ x ] + ' ' + Format( _Labels_DB_Type_Query[ x ], [ _Labels_DB_Size_Query[ x ] ] ) + ');';
_Query.ExecSQL;
Result.Change_Field := True;
except
if DB_Settings.Show_Errors then
ShowMessage( Format( Error_C_Table_Change_TypeSize, [ _Labels_DB[ x ], _Table_Name ] ) );
Exit;
end;
{ Wenn Tabellenfeld falsches Format hat }
end;
{ Felder löschen, die in der Deklaration nicht mehr existieren }
if DB_Settings.Delete_Fields then
for x := _Query.FieldDefs.Count - 1 downto 0 do
if not MatchStr( _Query.FieldDefs.Items[ x ].Name, _Labels_DB ) then
try
_Query.SQL.Text := 'ALTER TABLE ' + _Table_Name + ' DROP COLUMN ' + _Query.FieldDefs.Items[ x ].Name + ';';
_Query.ExecSQL;
Result.Delete_Field := True;
except
if DB_Settings.Show_Errors then
ShowMessage( Format( Error_C_Table_DropField, [ _Query.FieldDefs.Items[ x ].Name, _Table_Name ] ) );
end;
end;
function Create_Table_Query( _Table : TABSTable; _Query : TABSQuery; _Table_Name : string; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Labels_DB_Size_Query : TArray< Integer > ) : TDB_Result;
var
x : Integer;
Dummy_SQL : string;
begin
if _Table.Exists then
begin
_Table.Open;
_Table.Active := True;
Result.Open_Table := True;
end;
if not _Table.Exists then
try
_Query.SQL.Clear;
Dummy_SQL := '';
for x := low( _Labels_DB ) to high( _Labels_DB ) do
begin
if x <> low( _Labels_DB ) then
Dummy_SQL := Dummy_SQL + ',' + DBR;
Dummy_SQL := Dummy_SQL + Format( '%s %s', [ _Labels_DB[ x ], Format( _Labels_DB_Type_Query[ x ], [ _Labels_DB_Size_Query[ x ] ] ) ] );
end;
_Query.SQL.Text := 'DROP TABLE IF EXISTS ' + _Table_Name + '; ' + DBR + 'CREATE TABLE ' + _Table_Name + ' (' + Dummy_SQL + ');';
_Query.ExecSQL;
_Table.Open;
_Table.Active := True;
Result.Create_Table := True;
except
if DB_Settings.Show_Errors then
ShowMessage( Format( Error_C_Table_Create, [ _Table_Name ] ) );
end;
end;
function Index_Exists( _Table : TABSTable; const _IndexName : string ) : Boolean;
var
IndexDef : TIndexDef;
i : Integer;
begin
Result := False;
for i := 0 to pred( _Table.IndexDefs.Count ) do
begin
IndexDef := _Table.IndexDefs[ i ];
if CompareText( IndexDef.Name, _IndexName ) = 0 then
begin
Result := True;
break;
end;
end;
end;
function Rebuild_Index_Query( _Table : TABSTable; _Query : TABSQuery; _Labels_DB : TArray< string >; _Labels_DB_Type_Query : TArray< string >; _Indizes_DB_Query : TArray< TArray< string > > ) : TDB_Result;
var
Dummy_Int : Integer;
Dummy_SQL : string;
begin
_Table.Open;
_Table.IndexDefs.Update;
{ Alle Indexfelder durchgehen,
SQL erzeugen }
for Dummy_Int := low( _Indizes_DB_Query ) to high( _Indizes_DB_Query ) do
if not Index_Exists( _Table, _Indizes_DB_Query[ Dummy_Int ][ 0 ] ) then
Dummy_SQL := Dummy_SQL + _Indizes_DB_Query[ Dummy_Int ][ 1 ];
if Dummy_SQL <> '' then
try
_Query.SQL.Text := Dummy_SQL;
_Query.ExecSQL;
_Query.SQL.Clear;
Result.Rebuild_Index := True;
except
if DB_Settings.Show_Errors then
ShowMessage( Format( Error_C_Index_Rebuild, [ _Table.TableName ] ) );
end;
_Query.IndexDefs.Update;
_Table.IndexDefs.Update;
_Table.Close;
_Table.Open;
end;
end.