// Eine Callback-Methode für Status-Meldungen
type
TStatusCallback =
procedure(
const AStatus :
string )
of object;
procedure TDataModule2.CreateTables( StatusCallback : TStatusCallback );
begin
// whatever
end;
procedure TDataModule2.CreateDataBase(
const DBPath, Username, Password :
string; StatusCallback : TStatusCallback );
const
cCreateTxt = '
%d. Versuch: Datenbank wird erstellt...';
cReadyTxt = '
Datenbank wurde erstellt!';
cFailureText = '
Datenbank konnte nicht erstellt werden!';
begin
if FileExists( DBPath )
then
// Keine Meldung ausgeben, sondern eine Exception
// Dadurch kommt die Meldung eh ;o)
raise Exception.CreateFmt( '
Die Datenbank "%s" existiert schon', DBPath );
Screen.Cursor := crHourGlass;
try
IBD.LoginPrompt := FALSE;
IBD.Connected := FALSE;
IBD.Params.Clear;
// StatusMeldung (Callback-Methode aufrufen)
StatusCallback( Format( cCreateTxt, [1] ) );
try
IBD.DatabaseName := DBPath;
IBD.Params.Add( Format( '
USER "%s"', [Username] ) );
IBD.Params.Add( Format( '
PASSWORD "%s"', [Password] ) );
IBD.SQLDialect := 1;
IBD.Params.Add( '
PAGE_SIZE 4096' );
IBD.Params.Add( '
DEFAULT CHARACTER SET ISO8859_1' );
IBD.CreateDataBase;
// StatusMeldung (Callback-Methode aufrufen)
StatusCallback( cReadyTxt );
// Tables_anlegen; // Tabellen werden angelegt
CreateTables( StatusCallback );
except
on E :
Exception do
begin
if FileExists( DBPath )
then
DeleteFile( DBPath );
// StatusMeldung (Callback-Methode aufrufen)
StatusCallback( cFailureText );
raise;
end;
end;
finally
Screen.Cursor := crDefault;
end;
end;