client/2.5/FB25Attachment.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 FB25Attachment;

{$IFDEF FPC}
{$mode objfpc}{$H+}
{$interfaces COM}
{$ENDIF}

interface

uses
  Classes, SysUtils, IB,  FBAttachment, FB25ClientAPI, IBHeader,
  FBParamBlock, FBOutputBlock, FBActivityMonitor, IBExternals;

type
  { TFB25Attachment }

  TFB25Attachment = class(TFBAttachment, IAttachment, IActivityMonitor)
  private
    FHandle: TISC_DB_HANDLE;
  protected
    procedure CheckHandle; override;
  public
    constructor Create(DatabaseName: string; aDPB: IDPB;
      RaiseExceptionOnConnectError: boolean);
    constructor CreateDatabase(DatabaseName: string; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
    constructor CreateDatabase(sql: string; aSQLDialect: integer;
      RaiseExceptionOnError: boolean); overload;
    property Handle: TISC_DB_HANDLE read FHandle;

  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: string; aSQLDialect: integer); override;
    function Prepare(transaction: ITransaction; sql: string; aSQLDialect: integer): IStatement; override;
    function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
                       aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
    function GetEventHandler(Events: TStrings): IEvents; override;
    function CreateBlob(transaction: ITransaction; RelationName, ColumnName: string; 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: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
    function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; override; overload;

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

    {Database Information}

    function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: string): IBlobMetaData;
    function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: string): IArrayMetaData;
    function GetDBInformation(Requests: array of byte): IDBInformation; overload;
    function GetDBInformation(Request: byte): IDBInformation; overload;
  end;

implementation

uses FB25Events,FB25Transaction, FBMessages, FB25Blob,
  FB25Statement, FB25Array;

  { TFB25Attachment }

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

constructor TFB25Attachment.Create(DatabaseName: string; 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 TFB25Attachment.CreateDatabase(DatabaseName: string; aDPB: IDPB;
  RaiseExceptionOnError: boolean);
var sql: string;
    tr_handle: TISC_TR_HANDLE;
begin
  inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
  sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
  tr_handle := nil;
  with Firebird25ClientAPI do
  if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PChar(sql),
                                  SQLDialect, nil) > 0) and RaiseExceptionOnError then
    IBDataBaseError;
  if DPB <> nil then
  {Connect using known parameters}
  begin
    Disconnect;
    Connect;
  end;
end;

constructor TFB25Attachment.CreateDatabase(sql: string; aSQLDialect: integer;
    RaiseExceptionOnError: boolean);
var tr_handle: TISC_TR_HANDLE;
    info: IDBInformation;
    ConnectionType: integer;
    SiteName: string;
begin
  inherited Create('',nil,RaiseExceptionOnError);
  FSQLDialect := aSQLDialect;
  tr_handle := nil;
  with Firebird25ClientAPI do
  begin
    if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PChar(sql),
                                  aSQLDialect, nil) > 0) and RaiseExceptionOnError then
      IBDataBaseError;

    FCharSetID := 0;
    FCodePage := CP_NONE;
    FHasDefaultCharSet := false;
    info := GetDBInformation(isc_info_db_id);
    info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
  end;
end;

procedure TFB25Attachment.Connect;
var Param: IDPBItem;
begin
  FSQLDialect := 3;

  with Firebird25ClientAPI do
  if DPB = nil then
  begin
    if (isc_attach_database(StatusVector, Length(FDatabaseName),
                        PChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
      IBDatabaseError;
  end
  else
  begin
    if (isc_attach_database(StatusVector, Length(FDatabaseName),
                         PChar(FDatabaseName), @FHandle,
                         (DPB as TDPB).getDataLength,
                         (DPB as TDPB).getBuffer) > 0 ) and FRaiseExceptionOnConnectError then
      IBDatabaseError;

    if IsConnected then
    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 TFB25Attachment.Disconnect(Force: boolean);
begin
  if FHandle = nil then
    Exit;

  EndAllTransactions;
  {Disconnect}
  with Firebird25ClientAPI do
    if (isc_detach_database(StatusVector, @FHandle) > 0) and not Force then
      IBDatabaseError;
  FHandle := nil;
  FHasDefaultCharSet := false;
  FCodePage := CP_NONE;
  FCharSetID := 0;
end;

function TFB25Attachment.IsConnected: boolean;
begin
  Result := FHandle <> nil;
end;

procedure TFB25Attachment.DropDatabase;
begin
  CheckHandle;
  EndAllTransactions;
  with Firebird25ClientAPI do
    if isc_drop_database(StatusVector, @FHandle) > 0 then
      IBDatabaseError;
  FHandle := nil;
end;

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

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

function TFB25Attachment.CreateBlob(transaction: ITransaction; RelationName,
  ColumnName: string; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB25Blob.Create(self,transaction as TFB25transaction,
                TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),BPB);
end;

function TFB25Attachment.CreateBlob(transaction: ITransaction;
  BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
begin
  CheckHandle;
  Result := TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BPB);
end;

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

function TFB25Attachment.OpenBlob(transaction: ITransaction; RelationName,
  ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
begin
  CheckHandle;
  Result := TFB25Blob.Create(self,transaction as TFB25transaction,
                TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),
                BlobID,BPB);
end;

function TFB25Attachment.OpenBlob(transaction: ITransaction;
  BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
begin
  CheckHandle;
  Result :=  TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BlobID,BPB);
end;

procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: string;
  aSQLDialect: integer);
var TRHandle: TISC_TR_HANDLE;
begin
  CheckHandle;
  TRHandle := (Transaction as TFB25Transaction).Handle;
  with Firebird25ClientAPI do
    if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PChar(sql), aSQLDialect, nil) > 0 then
      IBDatabaseError;
  SignalActivity;
end;

function TFB25Attachment.Prepare(transaction: ITransaction; sql: string;
  aSQLDialect: integer): IStatement;
begin
  CheckHandle;
  Result := TFB25Statement.Create(self,transaction,sql,aSQLDialect);
end;

function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
  sql: string; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
begin
  CheckHandle;
  Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
         GenerateParamNames);
end;

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

function TFB25Attachment.OpenArray(transaction: ITransaction; RelationName, ColumnName: string;
  ArrayID: TISC_QUAD): IArray;
begin
  CheckHandle;
  Result := TFB25Array.Create(self,transaction as TFB25Transaction,
                    GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
end;

function TFB25Attachment.CreateArray(transaction: ITransaction; RelationName, ColumnName: string): IArray;
begin
  CheckHandle;
  Result := TFB25Array.Create(self,transaction as TFB25Transaction,
                    GetArrayMetaData(transaction,RelationName,ColumnName));
end;

function TFB25Attachment.CreateArray(transaction: ITransaction;
  ArrayMetaData: IArrayMetaData): IArray;
begin
  CheckHandle;
  Result := TFB25Array.Create(self,transaction as TFB25Transaction,ArrayMetaData);
end;

function TFB25Attachment.CreateArrayMetaData(SQLType: cardinal;
  tableName: string; columnName: string; Scale: integer; size: cardinal;
  acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
  ): IArrayMetaData;
begin
  Result := TFB25ArrayMetaData.Create(SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
end;

function TFB25Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
  columnName: string): IBlobMetaData;
begin
  CheckHandle;
  Result := TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
end;

function TFB25Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
  columnName: string): IArrayMetaData;
begin
  CheckHandle;
  Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
end;

function TFB25Attachment.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 Firebird25ClientAPI, Result as TDBInformation do
          if isc_database_info(StatusVector, @(FHandle), Length(Requests), PChar(ReqBuffer),
                                 getBufSize, Buffer) > 0 then
            IBDataBaseError;

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

function TFB25Attachment.GetDBInformation(Request: byte): IDBInformation;
begin
  CheckHandle;
  Result := TDBInformation.Create;
  with Firebird25ClientAPI, Result as TDBInformation do
    if isc_database_info(StatusVector, @(FHandle), 1, @Request,
                           getBufSize, Buffer) > 0 then
      IBDataBaseError;
end;

end.

Revision:	47
Committed:	Mon Jan 9 15:31:51 2017 UTC (7 years, 3 months ago) by tony
Content type:	text/x-pascal
File size:	13468 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	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 FB25Attachment;
28
29	{$IFDEF FPC}
30	{$mode objfpc}{$H+}
31	{$interfaces COM}
32	{$ENDIF}
33
34	interface
35
36	uses
37	Classes, SysUtils, IB, FBAttachment, FB25ClientAPI, IBHeader,
38	FBParamBlock, FBOutputBlock, FBActivityMonitor, IBExternals;
39
40	type
41	{ TFB25Attachment }
42
43	TFB25Attachment = class(TFBAttachment, IAttachment, IActivityMonitor)
44	private
45	FHandle: TISC_DB_HANDLE;
46	protected
47	procedure CheckHandle; override;
48	public
49	constructor Create(DatabaseName: string; aDPB: IDPB;
50	RaiseExceptionOnConnectError: boolean);
51	constructor CreateDatabase(DatabaseName: string; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
52	constructor CreateDatabase(sql: string; aSQLDialect: integer;
53	RaiseExceptionOnError: boolean); overload;
54	property Handle: TISC_DB_HANDLE read FHandle;
55
56	public
57	{IAttachment}
58	procedure Connect;
59	procedure Disconnect(Force: boolean=false); override;
60	function IsConnected: boolean;
61	procedure DropDatabase;
62	function StartTransaction(TPB: array of byte; DefaultCompletion: TTransactionCompletion): ITransaction; override;
63	function StartTransaction(TPB: ITPB; DefaultCompletion: TTransactionCompletion): ITransaction; override;
64	procedure ExecImmediate(transaction: ITransaction; sql: string; aSQLDialect: integer); override;
65	function Prepare(transaction: ITransaction; sql: string; aSQLDialect: integer): IStatement; override;
66	function PrepareWithNamedParameters(transaction: ITransaction; sql: string;
67	aSQLDialect: integer; GenerateParamNames: boolean=false): IStatement; override;
68	function GetEventHandler(Events: TStrings): IEvents; override;
69	function CreateBlob(transaction: ITransaction; RelationName, ColumnName: string; BPB: IBPB=nil): IBlob; overload;
70	function CreateBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BPB: IBPB=nil): IBlob; overload;
71	function CreateBlob(transaction: ITransaction; SubType: integer; aCharSetID: cardinal=0; BPB: IBPB=nil): IBlob; overload;
72	function OpenBlob(transaction: ITransaction; RelationName, ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; overload;
73	function OpenBlob(transaction: ITransaction; BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob; override; overload;
74
75	function OpenArray(transaction: ITransaction; RelationName, ColumnName: string;
76	ArrayID: TISC_QUAD): IArray;
77	function CreateArray(transaction: ITransaction; RelationName, ColumnName: string
78	): IArray; overload;
79	function CreateArray(transaction: ITransaction; ArrayMetaData: IArrayMetaData): IArray; overload;
80	function CreateArrayMetaData(SQLType: cardinal; tableName: string; columnName: string;
81	Scale: integer; size: cardinal;
82	acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
83	): IArrayMetaData;
84
85	{Database Information}
86
87	function GetBlobMetaData(Transaction: ITransaction; tableName, columnName: string): IBlobMetaData;
88	function GetArrayMetaData(Transaction: ITransaction; tableName, columnName: string): IArrayMetaData;
89	function GetDBInformation(Requests: array of byte): IDBInformation; overload;
90	function GetDBInformation(Request: byte): IDBInformation; overload;
91	end;
92
93	implementation
94
95	uses FB25Events,FB25Transaction, FBMessages, FB25Blob,
96	FB25Statement, FB25Array;
97
98	{ TFB25Attachment }
99
100	procedure TFB25Attachment.CheckHandle;
101	begin
102	if FHandle = nil then
103	IBError(ibxeDatabaseClosed,[nil]);
104	end;
105
106	constructor TFB25Attachment.Create(DatabaseName: string; aDPB: IDPB;
107	RaiseExceptionOnConnectError: boolean);
108	begin
109	if aDPB = nil then
110	begin
111	if RaiseExceptionOnConnectError then
112	IBError(ibxeNoDPB,[nil]);
113	Exit;
114	end;
115	inherited Create(DatabaseName,aDPB,RaiseExceptionOnConnectError);
116	Connect;
117	end;
118
119	constructor TFB25Attachment.CreateDatabase(DatabaseName: string; aDPB: IDPB;
120	RaiseExceptionOnError: boolean);
121	var sql: string;
122	tr_handle: TISC_TR_HANDLE;
123	begin
124	inherited Create(DatabaseName,aDPB,RaiseExceptionOnError);
125	sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
126	tr_handle := nil;
127	with Firebird25ClientAPI do
128	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PChar(sql),
129	SQLDialect, nil) > 0) and RaiseExceptionOnError then
130	IBDataBaseError;
131	if DPB <> nil then
132	{Connect using known parameters}
133	begin
134	Disconnect;
135	Connect;
136	end;
137	end;
138
139	constructor TFB25Attachment.CreateDatabase(sql: string; aSQLDialect: integer;
140	RaiseExceptionOnError: boolean);
141	var tr_handle: TISC_TR_HANDLE;
142	info: IDBInformation;
143	ConnectionType: integer;
144	SiteName: string;
145	begin
146	inherited Create('',nil,RaiseExceptionOnError);
147	FSQLDialect := aSQLDialect;
148	tr_handle := nil;
149	with Firebird25ClientAPI do
150	begin
151	if (isc_dsql_execute_immediate(StatusVector, @FHandle, @tr_handle, 0, PChar(sql),
152	aSQLDialect, nil) > 0) and RaiseExceptionOnError then
153	IBDataBaseError;
154
155	FCharSetID := 0;
156	FCodePage := CP_NONE;
157	FHasDefaultCharSet := false;
158	info := GetDBInformation(isc_info_db_id);
159	info[0].DecodeIDCluster(ConnectionType,FDatabaseName,SiteName);
160	end;
161	end;
162
163	procedure TFB25Attachment.Connect;
164	var Param: IDPBItem;
165	begin
166	FSQLDialect := 3;
167
168	with Firebird25ClientAPI do
169	if DPB = nil then
170	begin
171	if (isc_attach_database(StatusVector, Length(FDatabaseName),
172	PChar(FDatabaseName), @FHandle, 0, nil) > 0) and FRaiseExceptionOnConnectError then
173	IBDatabaseError;
174	end
175	else
176	begin
177	if (isc_attach_database(StatusVector, Length(FDatabaseName),
178	PChar(FDatabaseName), @FHandle,
179	(DPB as TDPB).getDataLength,
180	(DPB as TDPB).getBuffer) > 0 ) and FRaiseExceptionOnConnectError then
181	IBDatabaseError;
182
183	if IsConnected then
184	begin
185	Param := DPB.Find(isc_dpb_set_db_SQL_dialect);
186	if Param <> nil then
187	FSQLDialect := Param.AsByte;
188	Param := DPB.Find(isc_dpb_lc_ctype);
189	FHasDefaultCharSet := (Param <> nil) and
190	CharSetName2CharSetID(Param.AsString,FCharSetID) and
191	CharSetID2CodePage(FCharSetID,FCodePage) and
192	(FCharSetID > 1);
193	end;
194	end;
195	end;
196
197	procedure TFB25Attachment.Disconnect(Force: boolean);
198	begin
199	if FHandle = nil then
200	Exit;
201
202	EndAllTransactions;
203	{Disconnect}
204	with Firebird25ClientAPI do
205	if (isc_detach_database(StatusVector, @FHandle) > 0) and not Force then
206	IBDatabaseError;
207	FHandle := nil;
208	FHasDefaultCharSet := false;
209	FCodePage := CP_NONE;
210	FCharSetID := 0;
211	end;
212
213	function TFB25Attachment.IsConnected: boolean;
214	begin
215	Result := FHandle <> nil;
216	end;
217
218	procedure TFB25Attachment.DropDatabase;
219	begin
220	CheckHandle;
221	EndAllTransactions;
222	with Firebird25ClientAPI do
223	if isc_drop_database(StatusVector, @FHandle) > 0 then
224	IBDatabaseError;
225	FHandle := nil;
226	end;
227
228	function TFB25Attachment.StartTransaction(TPB: array of byte;
229	DefaultCompletion: TTransactionCompletion): ITransaction;
230	begin
231	CheckHandle;
232	Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
233	end;
234
235	function TFB25Attachment.StartTransaction(TPB: ITPB;
236	DefaultCompletion: TTransactionCompletion): ITransaction;
237	begin
238	CheckHandle;
239	Result := TFB25Transaction.Create(self,TPB,DefaultCompletion);
240	end;
241
242	function TFB25Attachment.CreateBlob(transaction: ITransaction; RelationName,
243	ColumnName: string; BPB: IBPB): IBlob;
244	begin
245	CheckHandle;
246	Result := TFB25Blob.Create(self,transaction as TFB25transaction,
247	TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),BPB);
248	end;
249
250	function TFB25Attachment.CreateBlob(transaction: ITransaction;
251	BlobMetaData: IBlobMetaData; BPB: IBPB): IBlob;
252	begin
253	CheckHandle;
254	Result := TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BPB);
255	end;
256
257	function TFB25Attachment.CreateBlob(transaction: ITransaction;
258	SubType: integer; aCharSetID: cardinal; BPB: IBPB): IBlob;
259	begin
260	CheckHandle;
261	Result := TFB25Blob.Create(self,transaction as TFB25transaction,SubType,aCharSetID,BPB);
262	end;
263
264	function TFB25Attachment.OpenBlob(transaction: ITransaction; RelationName,
265	ColumnName: string; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
266	begin
267	CheckHandle;
268	Result := TFB25Blob.Create(self,transaction as TFB25transaction,
269	TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,RelationName,ColumnName),
270	BlobID,BPB);
271	end;
272
273	function TFB25Attachment.OpenBlob(transaction: ITransaction;
274	BlobMetaData: IBlobMetaData; BlobID: TISC_QUAD; BPB: IBPB=nil): IBlob;
275	begin
276	CheckHandle;
277	Result := TFB25Blob.Create(self,transaction as TFB25transaction,BlobMetaData,BlobID,BPB);
278	end;
279
280	procedure TFB25Attachment.ExecImmediate(transaction: ITransaction; sql: string;
281	aSQLDialect: integer);
282	var TRHandle: TISC_TR_HANDLE;
283	begin
284	CheckHandle;
285	TRHandle := (Transaction as TFB25Transaction).Handle;
286	with Firebird25ClientAPI do
287	if isc_dsql_execute_immediate(StatusVector, @fHandle, @TRHandle, 0,PChar(sql), aSQLDialect, nil) > 0 then
288	IBDatabaseError;
289	SignalActivity;
290	end;
291
292	function TFB25Attachment.Prepare(transaction: ITransaction; sql: string;
293	aSQLDialect: integer): IStatement;
294	begin
295	CheckHandle;
296	Result := TFB25Statement.Create(self,transaction,sql,aSQLDialect);
297	end;
298
299	function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
300	sql: string; aSQLDialect: integer; GenerateParamNames: boolean): IStatement;
301	begin
302	CheckHandle;
303	Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
304	GenerateParamNames);
305	end;
306
307	function TFB25Attachment.GetEventHandler(Events: TStrings): IEvents;
308	begin
309	CheckHandle;
310	Result := TFB25Events.Create(self,Events);
311	end;
312
313	function TFB25Attachment.OpenArray(transaction: ITransaction; RelationName, ColumnName: string;
314	ArrayID: TISC_QUAD): IArray;
315	begin
316	CheckHandle;
317	Result := TFB25Array.Create(self,transaction as TFB25Transaction,
318	GetArrayMetaData(transaction,RelationName,ColumnName),ArrayID);
319	end;
320
321	function TFB25Attachment.CreateArray(transaction: ITransaction; RelationName, ColumnName: string): IArray;
322	begin
323	CheckHandle;
324	Result := TFB25Array.Create(self,transaction as TFB25Transaction,
325	GetArrayMetaData(transaction,RelationName,ColumnName));
326	end;
327
328	function TFB25Attachment.CreateArray(transaction: ITransaction;
329	ArrayMetaData: IArrayMetaData): IArray;
330	begin
331	CheckHandle;
332	Result := TFB25Array.Create(self,transaction as TFB25Transaction,ArrayMetaData);
333	end;
334
335	function TFB25Attachment.CreateArrayMetaData(SQLType: cardinal;
336	tableName: string; columnName: string; Scale: integer; size: cardinal;
337	acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
338	): IArrayMetaData;
339	begin
340	Result := TFB25ArrayMetaData.Create(SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
341	end;
342
343	function TFB25Attachment.GetBlobMetaData(Transaction: ITransaction; tableName,
344	columnName: string): IBlobMetaData;
345	begin
346	CheckHandle;
347	Result := TFB25BlobMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
348	end;
349
350	function TFB25Attachment.GetArrayMetaData(Transaction: ITransaction; tableName,
351	columnName: string): IArrayMetaData;
352	begin
353	CheckHandle;
354	Result := TFB25ArrayMetaData.Create(self,Transaction as TFB25Transaction,tableName,columnName);
355	end;
356
357	function TFB25Attachment.GetDBInformation(Requests: array of byte
358	): IDBInformation;
359	var ReqBuffer: PByte;
360	i: integer;
361	begin
362	CheckHandle;
363	if Length(Requests) = 1 then
364	Result := GetDBInformation(Requests[0])
365	else
366	begin
367	Result := TDBInformation.Create;
368	GetMem(ReqBuffer,Length(Requests));
369	try
370	for i := 0 to Length(Requests) - 1 do
371	ReqBuffer[i] := Requests[i];
372
373	with Firebird25ClientAPI, Result as TDBInformation do
374	if isc_database_info(StatusVector, @(FHandle), Length(Requests), PChar(ReqBuffer),
375	getBufSize, Buffer) > 0 then
376	IBDataBaseError;
377
378	finally
379	FreeMem(ReqBuffer);
380	end;
381	end;
382	end;
383
384	function TFB25Attachment.GetDBInformation(Request: byte): IDBInformation;
385	begin
386	CheckHandle;
387	Result := TDBInformation.Create;
388	with Firebird25ClientAPI, Result as TDBInformation do
389	if isc_database_info(StatusVector, @(FHandle), 1, @Request,
390	getBufSize, Buffer) > 0 then
391	IBDataBaseError;
392	end;
393
394	end.
395