client/3.0/FB30Attachment.pas

(*
 *  Firebird Interface (fbintf). The fbintf components provide a set of
 *  Pascal language bindings for the Firebird API.
 *
 *  The contents of this file are subject to the Initial Developer's
 *  Public License Version 1.0 (the "License"); you may not use this
 *  file except in compliance with the License. You may obtain a copy
 *  of the License here:
 *
 *    http://www.firebirdsql.org/index.php?op=doc&id=idpl
 *
 *  Software distributed under the License is distributed on an "AS
 *  IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
 *  implied. See the License for the specific language governing rights
 *  and limitations under the License.
 *
 *  The Initial Developer of the Original Code is Tony Whyman.
 *
 *  The Original Code is (C) 2016 Tony Whyman, MWA Software
 *  (http://www.mwasoftware.co.uk).
 *
 *  All Rights Reserved.
 *
 *  Contributor(s): ______________________________________.
 *
*)
unit FB30Attachment;
{$IFDEF MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

{$IFDEF FPC}
{$mode delphi}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, FBAttachment, FB30ClientAPI, Firebird, IB, FBActivityMonitor, FBParamBlock;

type

  { TFB30Attachment }

  TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
  private
    FAttachmentIntf: Firebird.IAttachment;
    FFirebird30ClientAPI: TFB30ClientAPI;
  protected
    procedure CheckHandle; override;
  public
    constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
          RaiseExceptionOnConnectError: boolean);
    constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
    constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
      RaiseExceptionOnError: boolean); overload;
    destructor Destroy; override;
    function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
      override;
    property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
    property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;

  public
    {IAttachment}
    procedure Connect;
    procedure Disconnect(Force: boolean=false); override;
    function IsConnected: boolean; override;
    procedure DropDatabase;
    function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
    function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
    procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
    function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
    function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
                       aSQLDialect: integer; GenerateParamNames: boolean=false;
                       CaseSensitiveParams: boolean=false): IStatement; override;

    {Events}
    function GetEventHandler(Events: TStrings): IEvents; override;

    {Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}

    function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
    function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
    function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
    function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
    function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;  overload; override;

    {Array}
    function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
    function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
    function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
    function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
      columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
      dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;


    {Database Information}
    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
    procedure getFBVersion(version: TStrings);
  end;

implementation

uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
  FBOutputBlock, FB30Events, IBUtils;

type
  { TVersionCallback }

  TVersionCallback = class(Firebird.IVersionCallbackImpl)
  private
    FOutput: TStrings;
  public
    constructor Create(output: TStrings);
    procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
  end;

{ TVersionCallback }

constructor TVersionCallback.Create(output: TStrings);
begin
  inherited Create;
  FOutput := output;
end;

procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
begin
  FOutput.Add(text);
end;


{ TFB30Attachment }

procedure TFB30Attachment.CheckHandle;
begin
  if FAttachmentIntf = nil then
    IBError(ibxeDatabaseClosed,[nil]);
end;

constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
  RaiseExceptionOnConnectError: boolean);
begin
  FFirebird30ClientAPI := api;
  if aDPB = nil then
  begin
    if RaiseExceptionOnConnectError then
       IBError(ibxeNoDPB,[nil]);
    Exit;
  end;
  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
  Connect;
end;

constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
  RaiseExceptionOnError: boolean);
var Param: IDPBItem;
    sql: AnsiString;
    IsCreateDB: boolean;
begin
  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
  FFirebird30ClientAPI := api;
  IsCreateDB := true;
  if aDPB <> nil then
  begin
    Param := aDPB.Find(isc_dpb_set_db_SQL_dialect);
    if Param <> nil then
      FSQLDialect := Param.AsByte;
  end;
  sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
                                       PAnsiChar(sql),FSQLDialect,@IsCreateDB);
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if InErrorState then
      FAttachmentIntf := nil
    else
    if aDPB <> nil then
    {Connect using known parameters}
    begin
      Disconnect;
      Connect;
    end
    else
      GetODSAndConnectionInfo;
  end;
end;

constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
  RaiseExceptionOnError: boolean);
var IsCreateDB: boolean;
begin
  inherited Create(api,'',nil,RaiseExceptionOnError);
  FFirebird30ClientAPI := api;
  FSQLDialect := aSQLDialect;
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
                                       PAnsiChar(sql),aSQLDialect,@IsCreateDB);
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if InErrorState then
      FAttachmentIntf := nil;
  end;
  GetODSAndConnectionInfo;
  ExtractConnectString(sql,FDatabaseName);
  DPBFromCreateSQL(sql);
end;

destructor TFB30Attachment.Destroy;
begin
  inherited Destroy;
  if assigned(FAttachmentIntf) then
    FAttachmentIntf.release;
end;

function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
begin
  Result := TDBInformation.Create(Firebird30ClientAPI);
  with FFirebird30ClientAPI, Result as TDBInformation do
  begin
    FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
                               getBufSize, BytePtr(Buffer));
      Check4DataBaseError;
  end
end;

procedure TFB30Attachment.Connect;
begin
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
                         (DPB as TDPB).getDataLength,
                         BytePtr((DPB as TDPB).getBuffer));
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if InErrorState then
      FAttachmentIntf := nil
    else
      GetODSAndConnectionInfo;
  end;
end;

procedure TFB30Attachment.Disconnect(Force: boolean);
begin
  if IsConnected then
    with FFirebird30ClientAPI do
    begin
      EndAllTransactions;
      FAttachmentIntf.Detach(StatusIntf);
      if not Force and InErrorState then
        IBDataBaseError;
      FAttachmentIntf := nil;
      FHasDefaultCharSet := false;
      FCodePage := CP_NONE;
      FCharSetID := 0;
    end;
end;

function TFB30Attachment.IsConnected: boolean;
begin
  Result := FAttachmentIntf <> nil;
end;

procedure TFB30Attachment.DropDatabase;
begin
  if IsConnected then
    with FFirebird30ClientAPI do
    begin
      EndAllTransactions;
      FAttachmentIntf.dropDatabase(StatusIntf);
      Check4DataBaseError;
      FAttachmentIntf := nil;
    end;
end;

function TFB30Attachment.StartTransaction(TPB: array of byte;
  DefaultCompletion: TTransactionCompletion): ITransaction;
begin
  CheckHandle;
  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
end;

function TFB30Attachment.StartTransaction(TPB: ITPB;
  DefaultCompletion: TTransactionCompletion): ITransaction;
begin
  CheckHandle;
  Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
end;

procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
  aSQLDialect: integer);
begin
  CheckHandle;
  with FFirebird30ClientAPI do
  begin
    FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
                    Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
    Check4DataBaseError;
  end;
end;

function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
  aSQLDialect: integer): IStatement;
begin
  CheckHandle;
  Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
end;

function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
  sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
  CaseSensitiveParams: boolean): IStatement;
begin
  CheckHandle;
  Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
         GenerateParamNames,CaseSensitiveParams);
end;

function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
begin
  CheckHandle;
  Result := TFB30Events.Create(self,Events);
end;

function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
  ColumnName: AnsiString; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
              TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
end;

function TFB30Attachment.CreateBlob(transaction: ITransaction;
  BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
end;

function TFB30Attachment.CreateBlob(transaction: ITransaction;
  SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
end;

function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
  ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB30Blob.Create(self,transaction as TFB30transaction,
                TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
                BlobID,BPB);
end;

function TFB30Attachment.OpenBlob(transaction: ITransaction;
  BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result :=  TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
end;

function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
  ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
begin
  CheckHandle;
  Result := TFB30Array.Create(self,transaction as TFB30Transaction,
                    GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
end;

function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
  ColumnName: AnsiString): IArray;
begin
  CheckHandle;
  Result := TFB30Array.Create(self,transaction as TFB30Transaction,
                    GetArrayMetaData(transaction,RelationName,ColumnName));
end;

function TFB30Attachment.CreateArray(transaction: ITransaction;
  ArrayMetaData: IArrayMetaData): IArray;
begin
  CheckHandle;
  Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
end;

function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
  Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
  bounds: TArrayBounds): IArrayMetaData;
begin
  Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
end;

function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
  columnName: AnsiString): IBlobMetaData;
begin
  CheckHandle;
  Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
end;

function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
  columnName: AnsiString): IArrayMetaData;
begin
  CheckHandle;
  Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
end;

procedure TFB30Attachment.getFBVersion(version: TStrings);
var bufferObj: TVersionCallback;
begin
  version.Clear;
  bufferObj := TVersionCallback.Create(version);
  try
    with FFirebird30ClientAPI do
    begin
       UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
       Check4DataBaseError;
    end;
  finally
    bufferObj.Free;
  end;
end;

end.

Revision:	270
Committed:	Fri Jan 18 11:10:37 2019 UTC (5 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	14220 byte(s)
Log Message:	Fixes merged
#	User	Rev	Content
1	tony	45	(*
2			* Firebird Interface (fbintf). The fbintf components provide a set of
3			* Pascal language bindings for the Firebird API.
4			*
5			* The contents of this file are subject to the Initial Developer's
6			* Public License Version 1.0 (the "License"); you may not use this
7			* file except in compliance with the License. You may obtain a copy
8			* of the License here:
9			*
10			* http://www.firebirdsql.org/index.php?op=doc&id=idpl
11			*
12			* Software distributed under the License is distributed on an "AS
13			* IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or
14			* implied. See the License for the specific language governing rights
15			* and limitations under the License.
16			*
17			* The Initial Developer of the Original Code is Tony Whyman.
18			*
19			* The Original Code is (C) 2016 Tony Whyman, MWA Software
20			* (http://www.mwasoftware.co.uk).
21			*
22			* All Rights Reserved.
23			*
24			* Contributor(s): ______________________________________.
25			*
26			*)
27			unit FB30Attachment;
28	tony	56	{$IFDEF MSWINDOWS}
29			{$DEFINE WINDOWS}
30			{$ENDIF}
31	tony	45
32			{$IFDEF FPC}
33	tony	56	{$mode delphi}
34	tony	45	{$interfaces COM}
35			{$ENDIF}
36
37			interface
38
39			uses
40			Classes, SysUtils, FBAttachment, FB30ClientAPI, Firebird, IB, FBActivityMonitor, FBParamBlock;
41
42			type
43
44			{ TFB30Attachment }
45
46			TFB30Attachment = class(TFBAttachment,IAttachment, IActivityMonitor)
47			private
48			FAttachmentIntf: Firebird.IAttachment;
49	tony	263	FFirebird30ClientAPI: TFB30ClientAPI;
50	tony	45	protected
51			procedure CheckHandle; override;
52			public
53	tony	263	constructor Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
54	tony	45	RaiseExceptionOnConnectError: boolean);
55	tony	263	constructor CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
56			constructor CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
57	tony	47	RaiseExceptionOnError: boolean); overload;
58	tony	45	destructor Destroy; override;
59	tony	143	function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
60			override;
61	tony	45	property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
62	tony	263	property Firebird30ClientAPI: TFB30ClientAPI read FFirebird30ClientAPI;
63	tony	45
64			public
65			{IAttachment}
66			procedure Connect;
67			procedure Disconnect(Force: boolean=false); override;
68	tony	117	function IsConnected: boolean; override;
69	tony	45	procedure DropDatabase;
70			function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
71			function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
72	tony	56	procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
73			function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
74			function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
75	tony	270	aSQLDialect: integer; GenerateParamNames: boolean=false;
76			CaseSensitiveParams: boolean=false): IStatement; override;
77	tony	45
78			{Events}
79			function GetEventHandler(Events: TStrings): IEvents; override;
80
81			{Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
82
83	tony	56	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
84	tony	45	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
85			function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
86	tony	56	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
87			function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
88	tony	45
89			{Array}
90	tony	56	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
91			function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
92	tony	45	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
93	tony	56	function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
94			columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
95	tony	263	dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
96	tony	45
97	tony	47
98	tony	45	{Database Information}
99	tony	56	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
100			function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
101	tony	266	procedure getFBVersion(version: TStrings);
102	tony	45	end;
103
104			implementation
105
106			uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
107	tony	117	FBOutputBlock, FB30Events, IBUtils;
108	tony	45
109	tony	266	type
110			{ TVersionCallback }
111
112			TVersionCallback = class(Firebird.IVersionCallbackImpl)
113			private
114			FOutput: TStrings;
115			public
116			constructor Create(output: TStrings);
117			procedure callback(status: Firebird.IStatus; text: PAnsiChar); override;
118			end;
119
120			{ TVersionCallback }
121
122			constructor TVersionCallback.Create(output: TStrings);
123			begin
124			inherited Create;
125			FOutput := output;
126			end;
127
128			procedure TVersionCallback.callback(status: Firebird.IStatus; text: PAnsiChar);
129			begin
130			FOutput.Add(text);
131			end;
132
133
134	tony	45	{ TFB30Attachment }
135
136			procedure TFB30Attachment.CheckHandle;
137			begin
138			if FAttachmentIntf = nil then
139			IBError(ibxeDatabaseClosed,[nil]);
140			end;
141
142	tony	263	constructor TFB30Attachment.Create(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
143	tony	45	RaiseExceptionOnConnectError: boolean);
144			begin
145	tony	263	FFirebird30ClientAPI := api;
146	tony	45	if aDPB = nil then
147			begin
148			if RaiseExceptionOnConnectError then
149			IBError(ibxeNoDPB,[nil]);
150			Exit;
151			end;
152	tony	263	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnConnectError);
153	tony	45	Connect;
154			end;
155
156	tony	263	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
157	tony	45	RaiseExceptionOnError: boolean);
158			var Param: IDPBItem;
159	tony	56	sql: AnsiString;
160	tony	45	IsCreateDB: boolean;
161			begin
162	tony	263	inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
163			FFirebird30ClientAPI := api;
164	tony	45	IsCreateDB := true;
165			if aDPB <> nil then
166			begin
167			Param := aDPB.Find(isc_dpb_set_db_SQL_dialect);
168			if Param <> nil then
169			FSQLDialect := Param.AsByte;
170			end;
171			sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
172	tony	263	with FFirebird30ClientAPI do
173	tony	45	begin
174			FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
175			PAnsiChar(sql),FSQLDialect,@IsCreateDB);
176			if FRaiseExceptionOnConnectError then Check4DataBaseError;
177			if InErrorState then
178			FAttachmentIntf := nil
179			else
180			if aDPB <> nil then
181			{Connect using known parameters}
182			begin
183			Disconnect;
184			Connect;
185	tony	117	end
186			else
187			GetODSAndConnectionInfo;
188	tony	45	end;
189			end;
190
191	tony	263	constructor TFB30Attachment.CreateDatabase(api: TFB30ClientAPI; sql: AnsiString; aSQLDialect: integer;
192	tony	47	RaiseExceptionOnError: boolean);
193			var IsCreateDB: boolean;
194			begin
195	tony	263	inherited Create(api,'',nil,RaiseExceptionOnError);
196			FFirebird30ClientAPI := api;
197	tony	47	FSQLDialect := aSQLDialect;
198	tony	263	with FFirebird30ClientAPI do
199	tony	47	begin
200			FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
201			PAnsiChar(sql),aSQLDialect,@IsCreateDB);
202			if FRaiseExceptionOnConnectError then Check4DataBaseError;
203			if InErrorState then
204			FAttachmentIntf := nil;
205			end;
206	tony	117	GetODSAndConnectionInfo;
207			ExtractConnectString(sql,FDatabaseName);
208			DPBFromCreateSQL(sql);
209	tony	47	end;
210
211	tony	45	destructor TFB30Attachment.Destroy;
212			begin
213			inherited Destroy;
214			if assigned(FAttachmentIntf) then
215			FAttachmentIntf.release;
216			end;
217
218	tony	143	function TFB30Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation;
219			begin
220	tony	263	Result := TDBInformation.Create(Firebird30ClientAPI);
221			with FFirebird30ClientAPI, Result as TDBInformation do
222	tony	143	begin
223			FAttachmentIntf.getInfo(StatusIntf, ReqBufLen, BytePtr(ReqBuffer),
224			getBufSize, BytePtr(Buffer));
225			Check4DataBaseError;
226			end
227			end;
228
229	tony	45	procedure TFB30Attachment.Connect;
230			begin
231	tony	263	with FFirebird30ClientAPI do
232	tony	45	begin
233			FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
234			(DPB as TDPB).getDataLength,
235			BytePtr((DPB as TDPB).getBuffer));
236			if FRaiseExceptionOnConnectError then Check4DataBaseError;
237			if InErrorState then
238			FAttachmentIntf := nil
239			else
240	tony	117	GetODSAndConnectionInfo;
241	tony	45	end;
242			end;
243
244			procedure TFB30Attachment.Disconnect(Force: boolean);
245			begin
246			if IsConnected then
247	tony	263	with FFirebird30ClientAPI do
248	tony	45	begin
249			EndAllTransactions;
250			FAttachmentIntf.Detach(StatusIntf);
251			if not Force and InErrorState then
252			IBDataBaseError;
253			FAttachmentIntf := nil;
254			FHasDefaultCharSet := false;
255			FCodePage := CP_NONE;
256			FCharSetID := 0;
257			end;
258			end;
259
260			function TFB30Attachment.IsConnected: boolean;
261			begin
262			Result := FAttachmentIntf <> nil;
263			end;
264
265			procedure TFB30Attachment.DropDatabase;
266			begin
267			if IsConnected then
268	tony	263	with FFirebird30ClientAPI do
269	tony	45	begin
270			EndAllTransactions;
271			FAttachmentIntf.dropDatabase(StatusIntf);
272			Check4DataBaseError;
273			FAttachmentIntf := nil;
274			end;
275			end;
276
277			function TFB30Attachment.StartTransaction(TPB: array of byte;
278			DefaultCompletion: TTransactionCompletion): ITransaction;
279			begin
280			CheckHandle;
281	tony	263	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
282	tony	45	end;
283
284			function TFB30Attachment.StartTransaction(TPB: ITPB;
285			DefaultCompletion: TTransactionCompletion): ITransaction;
286			begin
287			CheckHandle;
288	tony	263	Result := TFB30Transaction.Create(FFirebird30ClientAPI,self,TPB,DefaultCompletion);
289	tony	45	end;
290
291	tony	56	procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
292	tony	45	aSQLDialect: integer);
293			begin
294			CheckHandle;
295	tony	263	with FFirebird30ClientAPI do
296	tony	45	begin
297			FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
298	tony	56	Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
299	tony	45	Check4DataBaseError;
300			end;
301			end;
302
303	tony	56	function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
304	tony	45	aSQLDialect: integer): IStatement;
305			begin
306			CheckHandle;
307			Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
308			end;
309
310			function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
311	tony	270	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean;
312			CaseSensitiveParams: boolean): IStatement;
313	tony	45	begin
314			CheckHandle;
315			Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
316	tony	270	GenerateParamNames,CaseSensitiveParams);
317	tony	45	end;
318
319			function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
320			begin
321			CheckHandle;
322			Result := TFB30Events.Create(self,Events);
323			end;
324
325			function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
326	tony	56	ColumnName: AnsiString; BPB: IBPB): IBlob;
327	tony	45	begin
328			CheckHandle;
329			Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
330			TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
331			end;
332
333			function TFB30Attachment.CreateBlob(transaction: ITransaction;
334			BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
335			begin
336			CheckHandle;
337			Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
338			end;
339
340			function TFB30Attachment.CreateBlob(transaction: ITransaction;
341			SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
342			begin
343			CheckHandle;
344			Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
345			end;
346
347			function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
348	tony	56	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
349	tony	45	begin
350			CheckHandle;
351			Result := TFB30Blob.Create(self,transaction as TFB30transaction,
352			TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
353			BlobID,BPB);
354			end;
355
356			function TFB30Attachment.OpenBlob(transaction: ITransaction;
357			BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
358			begin
359			CheckHandle;
360			Result := TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
361			end;
362
363			function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
364	tony	56	ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
365	tony	45	begin
366			CheckHandle;
367			Result := TFB30Array.Create(self,transaction as TFB30Transaction,
368			GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
369			end;
370
371			function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
372	tony	56	ColumnName: AnsiString): IArray;
373	tony	45	begin
374			CheckHandle;
375			Result := TFB30Array.Create(self,transaction as TFB30Transaction,
376			GetArrayMetaData(transaction,RelationName,ColumnName));
377			end;
378
379			function TFB30Attachment.CreateArray(transaction: ITransaction;
380			ArrayMetaData: IArrayMetaData): IArray;
381			begin
382			CheckHandle;
383			Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
384			end;
385
386	tony	56	function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
387	tony	47	Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
388			bounds: TArrayBounds): IArrayMetaData;
389			begin
390	tony	60	Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
391	tony	47	end;
392
393	tony	45	function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
394	tony	56	columnName: AnsiString): IBlobMetaData;
395	tony	45	begin
396			CheckHandle;
397			Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
398			end;
399
400			function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
401	tony	56	columnName: AnsiString): IArrayMetaData;
402	tony	45	begin
403			CheckHandle;
404			Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
405			end;
406
407	tony	266	procedure TFB30Attachment.getFBVersion(version: TStrings);
408			var bufferObj: TVersionCallback;
409			begin
410	tony	267	version.Clear;
411	tony	266	bufferObj := TVersionCallback.Create(version);
412			try
413			with FFirebird30ClientAPI do
414	tony	267	begin
415	tony	266	UtilIntf.getFbVersion(StatusIntf,FAttachmentIntf,bufferObj);
416	tony	267	Check4DataBaseError;
417			end;
418	tony	266	finally
419			bufferObj.Free;
420			end;
421			end;
422
423	tony	45	end.
424