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 MSWINDOWS} 
{$DEFINE WINDOWS} 
{$ENDIF}

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

interface

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

type
  { TFB25Attachment }

  TFB25Attachment = class(TFBAttachment, IAttachment, IActivityMonitor)
  private
    FHandle: TISC_DB_HANDLE;
  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;
    property Handle: TISC_DB_HANDLE read FHandle;

  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): IStatement; override;
    function GetEventHandler(Events: TStrings): IEvents; override;
    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;

    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; override;
    function GetDBInformation(Request: byte): IDBInformation; overload; override;
  end;

implementation

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

  { TFB25Attachment }

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

constructor TFB25Attachment.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 TFB25Attachment.CreateDatabase(DatabaseName: AnsiString; aDPB: IDPB;
  RaiseExceptionOnError: boolean);
var sql: AnsiString;
    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, PAnsiChar(sql),
                                  SQLDialect, nil) > 0) and RaiseExceptionOnError then
    IBDataBaseError;
  if DPB <> nil then
  {Connect using known parameters}
  begin
    Disconnect;
    Connect;
  end
  else
    GetODSAndConnectionInfo;
end;

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

  end;
  GetODSAndConnectionInfo;
  ExtractConnectString(sql,FDatabaseName);
  DPBFromCreateSQL(sql);
end;

procedure TFB25Attachment.Connect;
begin
  FSQLDialect := 3;

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

  end;
  GetODSAndConnectionInfo;
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: AnsiString; 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: AnsiString; 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: AnsiString;
  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,PAnsiChar(sql), aSQLDialect, nil) > 0 then
      IBDatabaseError;
  SignalActivity;
end;

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

function TFB25Attachment.PrepareWithNamedParameters(transaction: ITransaction;
  sql: AnsiString; 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: AnsiString;
  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: AnsiString): 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: AnsiString; columnName: AnsiString; Scale: integer; size: cardinal;
  acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
  ): IArrayMetaData;
begin
  Result := TFB25ArrayMetaData.Create(self,SQLType,tableName,ColumnName,Scale,size,acharSetID,dimensions,bounds);
end;

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

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