+ implemented CreateDB and DropDB methods for ibconnection, pqconnection and mysqlconnection

git-svn-id: trunk@5002 -

fcl/db/dbconst.pp

@@ -82,6 +82,8 @@ Resourcestring
   SOnUpdateError           = 'An error occured while applying the updates in a record: %s';
   SApplyRecNotSupported    = 'Applying updates is not supported by this TDataset descendent';
   SNoWhereFields           = 'There are no fields found to generate the where-clause';
+  SNotSupported            = 'Operation is not supported by this type of database';
+  SDBCreateDropFailed      = 'Creation or dropping of database failed';
 
 Implementation
 

fcl/db/sqldb/interbase/ibconnection.pp

@@ -37,6 +37,8 @@ type
     Status              : array [0..19] of ISC_STATUS;
   end;
 
+  { TIBConnection }
+
   TIBConnection = class (TSQLConnection)
   private
     FSQLDatabaseHandle   : pointer;
@@ -44,6 +46,7 @@ type
     FDialect             : integer;
     FBLobSegmentSize     : word;
 
+    procedure ConnectFB;
     procedure SetDBDialect;
     procedure AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
     procedure TranslateFldType(SQLType, SQLLen, SQLScale : integer; var LensSet : boolean;
@@ -84,6 +87,8 @@ type
     procedure LoadBlobIntoStream(Field: TField;AStream: TMemoryStream;cursor: TSQLCursor;ATransaction : TSQLTransaction); override;
   public
     constructor Create(AOwner : TComponent); override;
+    procedure CreateDB; override;
+    procedure DropDB; override;
     property BlobSegmentSize : word read FBlobSegmentSize write FBlobSegmentSize;
   published
     property Dialect  : integer read FDialect write FDialect;
@@ -229,37 +234,62 @@ begin
     if isc_rollback_retaining(@Status[0], @TransactionHandle) <> 0 then
       CheckError('RollBackRetaining', Status);
 end;
+procedure TIBConnection.DropDB;
+
+begin
+  CheckDisConnected;
+
+{$IfDef LinkDynamically}
+  InitialiseIBase60;
+{$EndIf}
+
+  ConnectFB;
+
+  if isc_drop_database(@FStatus[0], @FSQLDatabaseHandle) <> 0 then
+    CheckError('DropDB', FStatus);
+
+{$IfDef LinkDynamically}
+  ReleaseIBase60;
+{$EndIf}
+end;
 
+procedure TIBConnection.CreateDB;
+
+var ASQLDatabaseHandle,
+    ASQLTransactionHandle : pointer;
+    CreateSQL             : String;
+
+begin
+  CheckDisConnected;
+{$IfDef LinkDynamically}
+  InitialiseIBase60;
+{$EndIf}
+  ASQLDatabaseHandle := nil;
+  ASQLTransactionHandle := nil;
+  
+  CreateSQL := 'CREATE DATABASE ';
+  if HostName <> '' then CreateSQL := CreateSQL + ''''+ HostName+':'+DatabaseName + ''''
+    else CreateSQL := CreateSQL + '''' + DatabaseName + '''';
+
+  if isc_dsql_execute_immediate(@FStatus[0],@ASQLDatabaseHandle,@ASQLTransactionHandle,length(CreateSQL),@CreateSQL[1],Dialect,nil) <> 0 then
+    CheckError('CreateDB', FStatus);
+
+  isc_detach_database(@FStatus[0], @ASQLDatabaseHandle);
+  CheckError('CreateDB', FStatus);
+{$IfDef LinkDynamically}
+  ReleaseIBase60;
+{$EndIf}
+end;
 
 procedure TIBConnection.DoInternalConnect;
-var
-  DPB           : string;
-  ADatabaseName : String;
+
 begin
 {$IfDef LinkDynamically}
   InitialiseIBase60;
 {$EndIf}
   inherited dointernalconnect;
 
-  DPB := chr(isc_dpb_version1);
-  if (UserName <> '') then
-  begin
-    DPB := DPB + chr(isc_dpb_user_name) + chr(Length(UserName)) + UserName;
-    if (Password <> '') then
-      DPB := DPB + chr(isc_dpb_password) + chr(Length(Password)) + Password;
-  end;
-  if (Role <> '') then
-     DPB := DPB + chr(isc_dpb_sql_role_name) + chr(Length(Role)) + Role;
-  if Length(CharSet) > 0 then
-    DPB := DPB + Chr(isc_dpb_lc_ctype) + Chr(Length(CharSet)) + CharSet;
-
-  FSQLDatabaseHandle := nil;
-  if HostName <> '' then ADatabaseName := HostName+':'+DatabaseName
-    else ADatabaseName := DatabaseName;
-  if isc_attach_database(@FStatus[0], Length(ADatabaseName), @ADatabaseName[1], @FSQLDatabaseHandle,
-         Length(DPB), @DPB[1]) <> 0 then
-    CheckError('DoInternalConnect', FStatus);
-  SetDBDialect;
+  ConnectFB;
 end;
 
 procedure TIBConnection.DoInternalDisconnect;
@@ -306,6 +336,33 @@ begin
     end;
 end;
 
+procedure TIBConnection.ConnectFB;
+var
+  ADatabaseName: String;
+  DPB: string;
+begin
+  DPB := chr(isc_dpb_version1);
+  if (UserName <> '') then
+  begin
+    DPB := DPB + chr(isc_dpb_user_name) + chr(Length(UserName)) + UserName;
+    if (Password <> '') then
+      DPB := DPB + chr(isc_dpb_password) + chr(Length(Password)) + Password;
+  end;
+  if (Role <> '') then
+     DPB := DPB + chr(isc_dpb_sql_role_name) + chr(Length(Role)) + Role;
+  if Length(CharSet) > 0 then
+    DPB := DPB + Chr(isc_dpb_lc_ctype) + Chr(Length(CharSet)) + CharSet;
+
+  FSQLDatabaseHandle := nil;
+  if HostName <> '' then ADatabaseName := HostName+':'+DatabaseName
+    else ADatabaseName := DatabaseName;
+  if isc_attach_database(@FStatus[0], Length(ADatabaseName), @ADatabaseName[1],
+    @FSQLDatabaseHandle,
+         Length(DPB), @DPB[1]) <> 0 then
+    CheckError('DoInternalConnect', FStatus);
+  SetDBDialect;
+end;
+
 procedure TIBConnection.AllocSQLDA(var aSQLDA : PXSQLDA;Count : integer);
 
 var x : shortint;

fcl/db/sqldb/mysql/mysqlconn.inc

@@ -63,6 +63,7 @@ Type
     function GetClientInfo: string;
     function GetServerStatus: String;
     procedure ConnectMySQL(var HMySQL : PMySQL;H,U,P : pchar);
+    procedure ExecuteDirectMySQL(const query : string);
   protected
     function StrToStatementType(s : string) : TStatementType; override;
     Procedure ConnectToServer; virtual;
@@ -96,6 +97,8 @@ Type
     procedure RollBackRetaining(trans : TSQLHandle); override;
     procedure UpdateIndexDefs(var IndexDefs : TIndexDefs;TableName : string); override;
   Public
+    procedure CreateDB; override;
+    procedure DropDB; override;
     Property ServerInfo : String Read FServerInfo;
     Property HostInfo : String Read FHostInfo;
     property ClientInfo: string read GetClientInfo;
@@ -242,6 +245,47 @@ begin
     MySQLError(FMySQL,SErrDatabaseSelectFailed,Self);
 end;
 
+
+procedure TConnectionName.CreateDB;
+
+begin
+  ExecuteDirectMySQL('CREATE DATABASE ' +DatabaseName);
+end;
+
+procedure TConnectionName.DropDB;
+
+begin
+  ExecuteDirectMySQL('DROP DATABASE ' +DatabaseName);
+end;
+
+procedure TConnectionName.ExecuteDirectMySQL(const query : string);
+
+var ADidConnect : boolean;
+    H,U,P       : String;
+    AMySQL      : PMySQL;
+
+begin
+  CheckDisConnected;
+
+  ADidConnect:=(MySQLLibraryHandle=NilHandle);
+  if ADidConnect then
+    InitialiseMysql;
+
+  H:=HostName;
+  U:=UserName;
+  P:=Password;
+  AMySQL := nil;
+  ConnectMySQL(AMySQL,pchar(H),pchar(U),pchar(P));
+
+  if mysql_query(AMySQL,pchar(query))<>0 then
+    MySQLError(AMySQL,Format(SErrExecuting,[StrPas(mysql_error(AMySQL))]),Self);
+
+  mysql_close(AMySQL);
+
+  if ADidConnect then
+    ReleaseMysql;
+end;
+
 procedure TConnectionName.DoInternalConnect;
 begin
   FDidConnect:=(MySQLLibraryHandle=NilHandle);

fcl/db/sqldb/postgres/pqconnection.pp

@@ -39,6 +39,7 @@ type
     FSQLDatabaseHandle   : pointer;
     FIntegerDateTimes    : boolean;
     function TranslateFldType(Type_Oid : integer) : TFieldType;
+    procedure ExecuteDirectPG(const Query : String);
   protected
     procedure DoInternalConnect; override;
     procedure DoInternalDisconnect; override;
@@ -64,6 +65,8 @@ type
     function GetSchemaInfoSQL(SchemaType : TSchemaType; SchemaObjectName, SchemaPattern : string) : string; override;
   public
     constructor Create(AOwner : TComponent); override;
+    procedure CreateDB; override;
+    procedure DropDB; override;
   published
     property DatabaseName;
     property KeepConnection;
@@ -111,6 +114,66 @@ begin
   FConnOptions := FConnOptions + [sqSupportParams];
 end;
 
+procedure TPQConnection.CreateDB;
+
+begin
+  ExecuteDirectPG('CREATE DATABASE ' +DatabaseName);
+end;
+
+procedure TPQConnection.DropDB;
+
+begin
+  ExecuteDirectPG('DROP DATABASE ' +DatabaseName);
+end;
+
+procedure TPQConnection.ExecuteDirectPG(const query : string);
+
+var ASQLDatabaseHandle    : PPGConn;
+    res                   : PPGresult;
+    msg                   : String;
+
+begin
+  CheckDisConnected;
+{$IfDef LinkDynamically}
+  InitialisePostgres3;
+{$EndIf}
+
+  FConnectString := '';
+  if (UserName <> '') then FConnectString := FConnectString + ' user=''' + UserName + '''';
+  if (Password <> '') then FConnectString := FConnectString + ' password=''' + Password + '''';
+  if (HostName <> '') then FConnectString := FConnectString + ' host=''' + HostName + '''';
+  FConnectString := FConnectString + ' dbname=''template1''';
+  if (Params.Text <> '') then FConnectString := FConnectString + ' '+Params.Text;
+
+  ASQLDatabaseHandle := PQconnectdb(pchar(FConnectString));
+
+  if (PQstatus(ASQLDatabaseHandle) = CONNECTION_BAD) then
+    begin
+    msg := PQerrorMessage(ASQLDatabaseHandle);
+    PQFinish(ASQLDatabaseHandle);
+    DatabaseError(sErrConnectionFailed + ' (PostgreSQL: ' + Msg + ')',self);
+    end;
+
+  res := PQexec(ASQLDatabaseHandle,pchar(query));
+
+  if (PQresultStatus(res) <> PGRES_COMMAND_OK) then
+    begin
+    msg := PQerrorMessage(ASQLDatabaseHandle);
+    PQclear(res);
+    PQFinish(ASQLDatabaseHandle);
+    DatabaseError(SDBCreateDropFailed + ' (PostgreSQL: ' + Msg + ')',self);
+    end
+  else
+    begin
+    PQclear(res);
+    PQFinish(ASQLDatabaseHandle);
+    end;
+{$IfDef LinkDynamically}
+  ReleasePostgres3;
+{$EndIf}
+end;
+
+
 function TPQConnection.GetTransactionHandle(trans : TSQLHandle): pointer;
 begin
   Result := trans;

fcl/db/sqldb/sqldb.pp

@@ -120,6 +120,8 @@ type
     procedure GetTableNames(List : TStrings; SystemTables : Boolean = false); virtual;
     procedure GetProcedureNames(List : TStrings); virtual;
     procedure GetFieldNames(const TableName : string; List :  TStrings); virtual;
+    procedure CreateDB; virtual;
+    procedure DropDB; virtual;
   published
     property Password : string read FPassword write FPassword;
     property Transaction : TSQLTransaction read FTransaction write SetTransaction;
@@ -514,6 +516,18 @@ begin
   AStream.seek(0,soFromBeginning);
 end;
 
+procedure TSQLConnection.CreateDB;
+
+begin
+  DatabaseError(SNotSupported);
+end;
+
+procedure TSQLConnection.DropDB;
+
+begin
+  DatabaseError(SNotSupported);
+end;
+
 { TSQLTransaction }
 procedure TSQLTransaction.EndTransaction;