Mega Code Archive
Interbase Object for executing all the Interbase commands at Run time
<![CDATA[
Title: Interbase Object for executing all the Interbase commands at Run time.
Question: How can I create Interbase database at run time ?
How can I change Interbase database password/ User without
using Interbase utilities ?
Answer:
If an application runs on an interbase database, the database
and all the required objects such as functions, stored procedures
etc. has to be created before running the application.
And some of the commands such as changing the Administrators name and
password has to be done either using Server manager of Interbase
or by the command line utilities supplied by Interbase.
By including this unit in the project, You can execute all the required
commands such as creating a database, changing the administrators password, creating shadows, functions, procedures etc.
Make sure that this object is created first in your application.
In your project source file the unit "Object_Interbase" must be the first unit
to follow after the standard units used by the application.
Include the Object_Interbase unit in your unit's uses cluase from which you
are going to use the object. You will be able to get the variable named
"ThisDataBase" of Class TMyIbDataBase which we will be using to executing
the Interbase commands.
//*** THE UNIT STARTS HERE
unit Object_Interbase;
interface
Uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, Registry, IBDataBase, IBQuery, FileCtrl;
Type
TShadow = ( stManual, stAuto, stConditional );
TMyIbDataBase = Class( TObject )
private
//User Defined Type Variable
FShdType : TShadow;
//Components Variables
FDataBase : TIBDatabase;
FTransaction : TIBTransaction;
FQuery : TIBQuery;
//Boolean Variables
FUseDefaultFiles : Boolean;
FConnected : Boolean;
FShadow : Boolean;
//String Variables
FIBServerPath : String;
FDataBasePath, FShadowPath : String;
FUser, FPassword : String;
FDatabaseName : String;
//Procedures
Procedure CheckDirPath( Var Value : String );
Procedure ChangetoIBDir;
Procedure CreateComponents;
Procedure InitilizeVariables;
Procedure IBLoadpathfromRegistry;
Procedure SetDataBasePath( Value : String );
Procedure SetShadowPath( Value : String );
Procedure SetAdminName( Value : String );
Procedure SetAdminPassword( Value : String );
Procedure SetDatabaseName ( Value : String );
Procedure SetShadow( Value : Boolean );
Procedure SetShadowType( Value : TShadow );
protected
public
Constructor Create;
//Procedures
Procedure IBCreateDatabase;
Procedure IBConnectToDatabase;
Procedure IBDisConnecFromDatabase;
Procedure IBCreateShadow;
Procedure IBQueryAssisnSQL( Value : String; CloseAfterExecution : Boolean );
Procedure IBChangeAdminPassword( Value : String );
//Component Properties
property IBAppDatabase : TIBDatabase Read FDataBase;
property IBAppTransaction : TIBTransaction Read FTransaction;
property IBAppQuery : TIBQuery Read FQuery;
//User Defined Type Properties
property IBShadowType : TShadow Read FShdType Write SetShadowType;
//Boolean value Properties
property IBConnected : Boolean Read FConnected Default False;
property IBExists : Boolean Read FUseDefaultFiles Default False;
property IBShadow : Boolean Read FShadow Write SetShadow Default False;
//String Value Properties
property IBServerPath : String Read FIBServerPath;
property IBUserName : String Read FUser Write SetAdminName;
property IBPassword : String Read FPassword Write SetAdminPassword;
property IBDatabasePath : String Read FDataBasePath Write SetDataBasePath;
property IBShadowPath : String Read FShadowPath Write SetShadowPath;
property IBDatabaseName : String Read FDatabaseName Write SetDatabaseName;
End;
Var
ThisDataBase : TMyIbDataBase;
implementation
{ TIbDataBase }
Procedure TMyIbDataBase.CheckDirPath( Var Value : String );
Begin
If Value[Length(Value)] '\' then Value := Value + '\';
If not DirectoryExists( Value ) then begin
CreateDir( Value );
End;
End;
Procedure TMyIbDataBase.IBChangeAdminPassword( Value : String );
Var I : Integer;
Begin
ThisDataBase.ChangetoIBDir;
I := WinExec( pchar('gsec -user ' + ThisDataBase.IBUserName +
' -password ' + ThisDataBase.IBPassword +
' -mo ' + ThisDataBase.IBUserName + ' -pw ' +
Value ), 0 );
ThisDataBase.IBPassword := Value;
End;
Procedure TMyIbDataBase.ChangetoIBDir;
Begin
If ThisDataBase.IBExists then ChDir( ThisDataBase.IBServerPath );
End;
Procedure TMyIbDataBase.IBConnectToDatabase;
Begin
If not ThisDataBase.IBConnected then begin
FDataBase.Close;
FDataBase.SQLDialect := 1;
FTransaction.Active := False;
FQuery.Close;
FDataBase.LoginPrompt := False;
FDataBase.Params.Clear;
FDataBase.Params.Add( 'USER_NAME=' + ThisDataBase.IBUserName );
FDataBase.Params.Add( 'PASSWORD=' + ThisDataBase.IBPassword );
FDataBase.DatabaseName := ThisDataBase.IBDatabasePath + IBDatabaseName;
Try
FDataBase.Connected := True;
FTransaction.DefaultDatabase := FDataBase;
Except
End;
FConnected := FDataBase.Connected;
FQuery.Transaction := FTransaction;
FQuery.Database := FDataBase;
FDataBase.DefaultTransaction := FTransaction;
If FConnected then begin
FTransaction.Active := True;
End;
End;
End;
constructor TMyIbDataBase.Create;
Begin
CreateComponents;
InitilizeVariables;
IBLoadpathfromRegistry;
End;
Procedure TMyIbDataBase.CreateComponents;
Begin
FDataBase := TIBDatabase.Create( Application );
FTransaction := TIBTransaction.Create( Application );
FDataBase.DefaultTransaction := FTransaction;
FTransaction.DefaultDatabase := FDataBase;
FQuery := TIBQuery.Create( Application );
FQuery.Database := FDataBase;
FQuery.Transaction := FTransaction;
FQuery.ParamCheck := False;
End;
Procedure TMyIbDataBase.IBCreateDatabase;
Var vmem : TStringList;
S : String;
Begin
S := ExtractFilePath( Application.ExeName );
vmem := TStringList.Create;
vmem.Add( 'Create database "' + ThisDataBase.IBDatabasePath + ThisDataBase.IBDatabaseName +
'" user "' + ThisDataBase.IBUserName + '" password "' +
ThisDataBase.IBPassword + '" page_size=2048 Length=50;');
vmem.Add( 'Commit work;' );
vmem.Add( 'gfix -w "sync" -user "' + ThisDataBase.IBUserName + '" -pa ' +
ThisDataBase.IBPassword + '" "' + ThisDataBase.IBDatabasePath +
ThisDataBase.IBDatabaseName + '"' );
S := S + 'Sql03EASY05.Sql';
vmem.SaveToFile( S );
vmem.Free;
ThisDataBase.ChangetoIBDir;
S := 'isql -input ' + S;
winexec( pchar( S ),0 );
DeleteFile( S );
S := ThisDataBase.IBDatabasePath + ThisDataBase.IBDatabaseName;
while not FileExists( S ) do;
ThisDataBase.IBConnectToDatabase;
FConnected := FDataBase.Connected;
End;
Procedure TMyIbDataBase.IBCreateShadow;
Var S, vFname : String;
Begin
If ThisDataBase.IBConnected then begin
Case FShdType of
stAuto : S := 'Auto';
stManual : S := 'Manual';
stConditional : S := 'Conditional';
End;
vFname := Copy( FDatabaseName, 1, pos( '.', FDatabaseName ) ) + 'Shd';
FQuery.Close;
FQuery.SQL.Clear;
FQuery.SQL.Text := 'Create Shadow 1 ' + S + ' "' + FShadowPath +
vFname + '" Length = 10000';
FQuery.ExecSQL;
Application.ProcessMessages;
End;
End;
Procedure TMyIbDataBase.InitilizeVariables;
Begin
FDataBasePath := '';
FShadowPath := '';
FIBServerPath := '';
FUser := '';
FPassword := '';
FDatabaseName := '';
FShdType := stConditional;
FConnected := False;
End;
Procedure TMyIbDataBase.IBLoadpathfromRegistry;
Var vReg : TRegistry;
Begin
vReg := TRegistry.Create;
vReg.RootKey := HKEY_LOCAL_MACHINE;
If vReg.OpenKey( '\Software\InterBase Corp\InterBase\CurrentVersion', False ) then begin
FIBServerPath := vreg.ReadString( 'ServerDirectory' );
FUseDefaultFiles := True;
End else begin
FIBServerPath := ExtractFilePath( Application.ExeName );
FUseDefaultFiles := False;
End;
vReg.CloseKey;
vReg.Free;
End;
Procedure TMyIbDataBase.SetAdminName(Value: String);
Begin
If ( Value FUser ) then FUser := Value;
End;
Procedure TMyIbDataBase.SetAdminPassword(Value: String);
Begin
If ( Value FPassword ) then FPassword := Value;
End;
Procedure TMyIbDataBase.SetDatabaseName(Value: String);
Begin
If ( Value FDatabaseName ) then FDatabaseName := Value;
End;
Procedure TMyIbDataBase.SetDataBasePath( Value: String );
Begin
If ( Value FDataBasePath ) then begin
FDataBasePath := Value;
CheckDirPath( FDataBasePath );
End;
End;
Procedure TMyIbDataBase.SetShadow(Value: Boolean);
Begin
If ( Value FShadow ) Then FShadow := Value;
End;
Procedure TMyIbDataBase.SetShadowPath( Value: String );
Begin
If ( Value FShadowPath ) then begin
FShadowPath := Value;
CheckDirPath( FShadowPath );
End;
End;
Procedure TMyIbDataBase.SetShadowType(Value: TShadow);
Begin
If ( Value FShdType ) then FShdType := Value;
End;
Procedure TMyIbDataBase.IBQueryAssisnSQL( Value : String; CloseAfterExecution: Boolean);
Begin
FQuery.Close;
FQuery.SQL.Clear;
FQuery.SQL.Text := Value;
try
FQuery.ExecSQL;
except
End;
if CloseAfterExecution then begin
FQuery.Close;
FQuery.SQL.Clear;
FQuery.SQL.Text := 'Commit';
FQuery.ExecSQL;
FQuery.Close;
end;
End;
procedure TMyIbDataBase.IBDisConnecFromDatabase;
begin
FDataBase.CloseDataSets;
FDataBase.ForceClose;
FConnected := FDataBase.Connected;
end;
Initialization
If ( ThisDataBase = NIL ) then ThisDataBase := TMyIbDataBase.Create;
Finalization
If ( ThisDataBase NIL ) then begin
ThisDataBase.Free;
ThisDataBase := NIL;
End;
End.
//** THE UNIT ENDS HERE
Examples:
---------
1. Creating a Database
If you want to create a database called "Sample.Gdb" in the
directory called "c:\test\" with the administrator named
"LION" with the password "king". Just by using the properties
and methods of this simple object we can create the database.
ThisDataBase.IBUserName := 'LION';
ThisDataBase.IBPassword := 'king';
ThisDataBase.IBDatabasePath := 'c:\test\';
ThisDataBase.IBDatabaseName := 'Sample.Gdb';
ThisDataBase.IBCreateDatabase;
The properties IBUserName, IBPassword, IBDatabaseName has to be assigned only once.
2. Creating Shadow
ThisDataBase.IBConnectToDatabase;
ThisDatabse.IBShadowType := stAuto;
ThisDatabse.IBCreateShadow;
3. Changing Database Password
ThisDataBase.IBChangeAdminPassword( 'NewPassword' );
4. Creating a Table
ThisDatabase.IBQueryAssisnSQL( 'CREATE TABLE USERS( ' +
'USERCODE VARCHAR(6) NOT NULL , ' +
'USERNAME VARCHAR(20) NOT NULL , ' +
'USERACTIVE VARCHAR(1) DEFAULT "Y", ', True );
In the same way you can assign the scripts for creating the stored procedures,
function and the scripts for creating all the objects using this method.
5. The properties IBAppDatabase, IBAppTransaction and IBAppQuery can be used
to assign to the properties of the IBTable component if you are go to work
with the IBTable component.
If in case you are not going to work with the Interbase components this object
can be modifed to work with the simple database components.
]]>