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;
  protected
    procedure CheckHandle; override;
  public
    constructor Create(DatabaseName: AnsiString; aDPB: IDPB;
          RaiseExceptionOnConnectError: boolean);
    constructor CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean);  overload;
    constructor CreateDatabase(sql: AnsiString; aSQLDialect: integer;
      RaiseExceptionOnError: boolean); overload;
    destructor Destroy; override;
    property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;

  public
    {IAttachment}
    procedure Connect;
    procedure Disconnect(Force: boolean=false); override;
    function IsConnected: boolean;
    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): 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;
    function GetDBInformation(Requests: array of byte): IDBInformation; overload;
    function GetDBInformation(Request: byte): IDBInformation; overload;
  end;

implementation

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

{ TFB30Attachment }

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

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

constructor TFB30Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
  RaiseExceptionOnError: boolean);
var Param: IDPBItem;
    sql: AnsiString;
    IsCreateDB: boolean;
begin
  inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
  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 Firebird30ClientAPI 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;
  end;
end;

constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
  RaiseExceptionOnError: boolean);
var IsCreateDB: boolean;
    info: IDBInformation;
    ConnectionType: integer;
    SiteName: AnsiString;
begin
  inherited Create('',nil,RaiseExceptionOnError);
  FSQLDialect := aSQLDialect;
  with Firebird30ClientAPI do
  begin
    FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
                                       PAnsiChar(sql),aSQLDialect,@IsCreateDB);
    if FRaiseExceptionOnConnectError then Check4DataBaseError;
    if InErrorState then
      FAttachmentIntf := nil;
    FCharSetID := 0;
    FCodePage := CP_NONE;
    FHasDefaultCharSet := false;
    info := GetDBInformation(isc_info_db_id);
    info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
  end;
end;

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

procedure TFB30Attachment.Connect;
var Param: IDPBItem;
begin
  with Firebird30ClientAPI 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
    begin
      Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
      if Param <> nil then
        FSQLDialect := Param.AsByte;
      Param :=  DPB.Find(isc_dpb_lc_ctype);
      FHasDefaultCharSet :=  (Param <> nil) and
                             CharSetName2CharSetID(Param.AsString,FCharSetID) and
                             CharSetID2CodePage(FCharSetID,FCodePage) and
                             (FCharSetID > 1);
    end;
  end;
end;

procedure TFB30Attachment.Disconnect(Force: boolean);
begin
  if IsConnected then
    with Firebird30ClientAPI 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 Firebird30ClientAPI 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(self,TPB,DefaultCompletion);
end;

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

procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
  aSQLDialect: integer);
begin
  CheckHandle;
  with Firebird30ClientAPI 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): IStatement;
begin
  CheckHandle;
  Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
         GenerateParamNames);
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;

function TFB30Attachment.GetDBInformation(Requests: array of byte
  ): IDBInformation;
var ReqBuffer: PByte;
    i: integer;
begin
  CheckHandle;
  if Length(Requests) = 1 then
    Result := GetDBInformation(Requests[0])
  else
  begin
    Result := TDBInformation.Create;
    GetMem(ReqBuffer,Length(Requests));
    try
      for i := 0 to Length(Requests) - 1 do
        ReqBuffer[i] := Requests[i];

      with Firebird30ClientAPI, Result as TDBInformation do
      begin
        FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
                                 getBufSize, BytePtr(Buffer));
          Check4DataBaseError;
      end

    finally
      FreeMem(ReqBuffer);
    end;
  end;
end;

function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
begin
  CheckHandle;
  Result := TDBInformation.Create;
  with Firebird30ClientAPI, Result as TDBInformation do
  begin
    FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
                           getBufSize, BytePtr(Buffer));
      Check4DataBaseError;
  end;
end;

end.

Revision:	60
Committed:	Mon Mar 27 15:21:02 2017 UTC (7 years, 8 months ago) by tony
Content type:	text/x-pascal
File size:	14090 byte(s)
Log Message:
#	Content
1	(*
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	{$IFDEF MSWINDOWS}
29	{$DEFINE WINDOWS}
30	{$ENDIF}
31
32	{$IFDEF FPC}
33	{$mode delphi}
34	{$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	protected
50	procedure CheckHandle; override;
51	public
52	constructor Create(DatabaseName: AnsiString; aDPB: IDPB;
53	RaiseExceptionOnConnectError: boolean);
54	constructor CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
55	constructor CreateDatabase(sql: AnsiString; aSQLDialect: integer;
56	RaiseExceptionOnError: boolean); overload;
57	destructor Destroy; override;
58	property AttachmentIntf: Firebird.IAttachment read FAttachmentIntf;
59
60	public
61	{IAttachment}
62	procedure Connect;
63	procedure Disconnect(Force: boolean=false); override;
64	function IsConnected: boolean;
65	procedure DropDatabase;
66	function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
67	function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
68	procedure ExecImmediate(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer); override;
69	function Prepare(transaction: ITransaction; sql: AnsiString; aSQLDialect: integer): IStatement; override;
70	function PrepareWithNamedParameters(transaction: ITransaction; sql: AnsiString;
71	aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
72
73	{Events}
74	function GetEventHandler(Events: TStrings): IEvents; override;
75
76	{Blob - may use to open existing Blobs. However, ISQLData.AsBlob is preferred}
77
78	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BPB: IBPB=nil): IBlob; overload;
79	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
80	function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
81	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
82	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload; override;
83
84	{Array}
85	function OpenArray(transaction: ITransaction; RelationName, ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
86	function CreateArray(transaction: ITransaction; RelationName, ColumnName: AnsiString): IArray; overload;
87	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
88	function CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString;
89	columnName: AnsiString; Scale: integer; size: cardinal; aCharSetID: cardinal;
90	dimensions: cardinal; bounds: TArrayBounds): IArrayMetaData;
91
92
93	{Database Information}
94	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IBlobMetaData;
95	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: AnsiString): IArrayMetaData;
96	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
97	function GetDBInformation(Request: byte): IDBInformation; overload;
98	end;
99
100	implementation
101
102	uses FB30Transaction, FB30Statement, FB30Array, FB30Blob, FBMessages,
103	FBOutputBlock, FB30Events;
104
105	{ TFB30Attachment }
106
107	procedure TFB30Attachment.CheckHandle;
108	begin
109	if FAttachmentIntf = nil then
110	IBError(ibxeDatabaseClosed,[nil]);
111	end;
112
113	constructor TFB30Attachment.Create(DatabaseName: AnsiString; aDPB: IDPB;
114	RaiseExceptionOnConnectError: boolean);
115	begin
116	if aDPB = nil then
117	begin
118	if RaiseExceptionOnConnectError then
119	IBError(ibxeNoDPB,[nil]);
120	Exit;
121	end;
122	inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
123	Connect;
124	end;
125
126	constructor TFB30Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
127	RaiseExceptionOnError: boolean);
128	var Param: IDPBItem;
129	sql: AnsiString;
130	IsCreateDB: boolean;
131	begin
132	inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
133	IsCreateDB := true;
134	if aDPB <> nil then
135	begin
136	Param := aDPB.Find(isc_dpb_set_db_SQL_dialect);
137	if Param <> nil then
138	FSQLDialect := Param.AsByte;
139	end;
140	sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
141	with Firebird30ClientAPI do
142	begin
143	FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
144	PAnsiChar(sql),FSQLDialect,@IsCreateDB);
145	if FRaiseExceptionOnConnectError then Check4DataBaseError;
146	if InErrorState then
147	FAttachmentIntf := nil
148	else
149	if aDPB <> nil then
150	{Connect using known parameters}
151	begin
152	Disconnect;
153	Connect;
154	end;
155	end;
156	end;
157
158	constructor TFB30Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
159	RaiseExceptionOnError: boolean);
160	var IsCreateDB: boolean;
161	info: IDBInformation;
162	ConnectionType: integer;
163	SiteName: AnsiString;
164	begin
165	inherited Create('',nil,RaiseExceptionOnError);
166	FSQLDialect := aSQLDialect;
167	with Firebird30ClientAPI do
168	begin
169	FAttachmentIntf := UtilIntf.executeCreateDatabase(StatusIntf,Length(sql),
170	PAnsiChar(sql),aSQLDialect,@IsCreateDB);
171	if FRaiseExceptionOnConnectError then Check4DataBaseError;
172	if InErrorState then
173	FAttachmentIntf := nil;
174	FCharSetID := 0;
175	FCodePage := CP_NONE;
176	FHasDefaultCharSet := false;
177	info := GetDBInformation(isc_info_db_id);
178	info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
179	end;
180	end;
181
182	destructor TFB30Attachment.Destroy;
183	begin
184	inherited Destroy;
185	if assigned(FAttachmentIntf) then
186	FAttachmentIntf.release;
187	end;
188
189	procedure TFB30Attachment.Connect;
190	var Param: IDPBItem;
191	begin
192	with Firebird30ClientAPI do
193	begin
194	FAttachmentIntf := ProviderIntf.attachDatabase(StatusIntf,PAnsiChar(FDatabaseName),
195	(DPB as TDPB).getDataLength,
196	BytePtr((DPB as TDPB).getBuffer));
197	if FRaiseExceptionOnConnectError then Check4DataBaseError;
198	if InErrorState then
199	FAttachmentIntf := nil
200	else
201	begin
202	Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
203	if Param <> nil then
204	FSQLDialect := Param.AsByte;
205	Param := DPB.Find(isc_dpb_lc_ctype);
206	FHasDefaultCharSet := (Param <> nil) and
207	CharSetName2CharSetID(Param.AsString,FCharSetID) and
208	CharSetID2CodePage(FCharSetID,FCodePage) and
209	(FCharSetID > 1);
210	end;
211	end;
212	end;
213
214	procedure TFB30Attachment.Disconnect(Force: boolean);
215	begin
216	if IsConnected then
217	with Firebird30ClientAPI do
218	begin
219	EndAllTransactions;
220	FAttachmentIntf.Detach(StatusIntf);
221	if not Force and InErrorState then
222	IBDataBaseError;
223	FAttachmentIntf := nil;
224	FHasDefaultCharSet := false;
225	FCodePage := CP_NONE;
226	FCharSetID := 0;
227	end;
228	end;
229
230	function TFB30Attachment.IsConnected: boolean;
231	begin
232	Result := FAttachmentIntf <> nil;
233	end;
234
235	procedure TFB30Attachment.DropDatabase;
236	begin
237	if IsConnected then
238	with Firebird30ClientAPI do
239	begin
240	EndAllTransactions;
241	FAttachmentIntf.dropDatabase(StatusIntf);
242	Check4DataBaseError;
243	FAttachmentIntf := nil;
244	end;
245	end;
246
247	function TFB30Attachment.StartTransaction(TPB: array of byte;
248	DefaultCompletion: TTransactionCompletion): ITransaction;
249	begin
250	CheckHandle;
251	Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
252	end;
253
254	function TFB30Attachment.StartTransaction(TPB: ITPB;
255	DefaultCompletion: TTransactionCompletion): ITransaction;
256	begin
257	CheckHandle;
258	Result := TFB30Transaction.Create(self,TPB,DefaultCompletion);
259	end;
260
261	procedure TFB30Attachment.ExecImmediate(transaction: ITransaction; sql: AnsiString;
262	aSQLDialect: integer);
263	begin
264	CheckHandle;
265	with Firebird30ClientAPI do
266	begin
267	FAttachmentIntf.execute(StatusIntf,(transaction as TFB30Transaction).TransactionIntf,
268	Length(sql),PAnsiChar(sql),aSQLDialect,nil,nil,nil,nil);
269	Check4DataBaseError;
270	end;
271	end;
272
273	function TFB30Attachment.Prepare(transaction: ITransaction; sql: AnsiString;
274	aSQLDialect: integer): IStatement;
275	begin
276	CheckHandle;
277	Result := TFB30Statement.Create(self,transaction,sql,aSQLDialect);
278	end;
279
280	function TFB30Attachment.PrepareWithNamedParameters(transaction: ITransaction;
281	sql: AnsiString; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
282	begin
283	CheckHandle;
284	Result := TFB30Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
285	GenerateParamNames);
286	end;
287
288	function TFB30Attachment.GetEventHandler(Events: TStrings): IEvents;
289	begin
290	CheckHandle;
291	Result := TFB30Events.Create(self,Events);
292	end;
293
294	function TFB30Attachment.CreateBlob(transaction: ITransaction; RelationName,
295	ColumnName: AnsiString; BPB: IBPB): IBlob;
296	begin
297	CheckHandle;
298	Result := TFB30Blob.Create(self,transaction as TFB30Transaction,
299	TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),BPB);
300	end;
301
302	function TFB30Attachment.CreateBlob(transaction: ITransaction;
303	BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
304	begin
305	CheckHandle;
306	Result := TFB30Blob.Create(self,transaction as TFB30Transaction, BlobMetaData,BPB);
307	end;
308
309	function TFB30Attachment.CreateBlob(transaction: ITransaction;
310	SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
311	begin
312	CheckHandle;
313	Result := TFB30Blob.Create(self,transaction as TFB30Transaction, SubType,aCharSetID,BPB);
314	end;
315
316	function TFB30Attachment.OpenBlob(transaction: ITransaction; RelationName,
317	ColumnName: AnsiString; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
318	begin
319	CheckHandle;
320	Result := TFB30Blob.Create(self,transaction as TFB30transaction,
321	TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,RelationName,ColumnName),
322	BlobID,BPB);
323	end;
324
325	function TFB30Attachment.OpenBlob(transaction: ITransaction;
326	BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB): IBlob;
327	begin
328	CheckHandle;
329	Result := TFB30Blob.Create(self,transaction as TFB30transaction,BlobMetaData,BlobID,BPB);
330	end;
331
332	function TFB30Attachment.OpenArray(transaction: ITransaction; RelationName,
333	ColumnName: AnsiString; ArrayID: TISC_QUAD): IArray;
334	begin
335	CheckHandle;
336	Result := TFB30Array.Create(self,transaction as TFB30Transaction,
337	GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
338	end;
339
340	function TFB30Attachment.CreateArray(transaction: ITransaction; RelationName,
341	ColumnName: AnsiString): IArray;
342	begin
343	CheckHandle;
344	Result := TFB30Array.Create(self,transaction as TFB30Transaction,
345	GetArrayMetaData(transaction,RelationName,ColumnName));
346	end;
347
348	function TFB30Attachment.CreateArray(transaction: ITransaction;
349	ArrayMetaData: IArrayMetaData): IArray;
350	begin
351	CheckHandle;
352	Result := TFB30Array.Create(self,transaction as TFB30Transaction,ArrayMetaData);
353	end;
354
355	function TFB30Attachment.CreateArrayMetaData(SQLType: cardinal; tableName: AnsiString; columnName: AnsiString;
356	Scale: integer; size: cardinal; aCharSetID: cardinal; dimensions: cardinal;
357	bounds: TArrayBounds): IArrayMetaData;
358	begin
359	Result := TFB30ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,aCharSetID, dimensions,bounds);
360	end;
361
362	function TFB30Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
363	columnName: AnsiString): IBlobMetaData;
364	begin
365	CheckHandle;
366	Result := TFB30BlobMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
367	end;
368
369	function TFB30Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
370	columnName: AnsiString): IArrayMetaData;
371	begin
372	CheckHandle;
373	Result := TFB30ArrayMetaData.Create(self,Transaction as TFB30Transaction,tableName,columnName);
374	end;
375
376	function TFB30Attachment.GetDBInformation(Requests: array of byte
377	): IDBInformation;
378	var ReqBuffer: PByte;
379	i: integer;
380	begin
381	CheckHandle;
382	if Length(Requests) = 1 then
383	Result := GetDBInformation(Requests[0])
384	else
385	begin
386	Result := TDBInformation.Create;
387	GetMem(ReqBuffer,Length(Requests));
388	try
389	for i := 0 to Length(Requests) - 1 do
390	ReqBuffer[i] := Requests[i];
391
392	with Firebird30ClientAPI, Result as TDBInformation do
393	begin
394	FAttachmentIntf.getInfo(StatusIntf, Length(Requests), BytePtr(ReqBuffer),
395	getBufSize, BytePtr(Buffer));
396	Check4DataBaseError;
397	end
398
399	finally
400	FreeMem(ReqBuffer);
401	end;
402	end;
403	end;
404
405	function TFB30Attachment.GetDBInformation(Request: byte): IDBInformation;
406	begin
407	CheckHandle;
408	Result := TDBInformation.Create;
409	with Firebird30ClientAPI, Result as TDBInformation do
410	begin
411	FAttachmentIntf.getInfo(StatusIntf, 1, BytePtr(@Request),
412	getBufSize, BytePtr(Buffer));
413	Check4DataBaseError;
414	end;
415	end;
416
417	end.
418