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, 10 months ago) by tony
Content type:	text/x-pascal
File size:	13468 byte(s)
Log Message:	Committing updates for Release R2-0-1
#	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 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	tony	47	FBParamBlock, FBOutputBlock, FBActivityMonitor, IBExternals;
39	tony	45
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	tony	47	constructor CreateDatabase(DatabaseName: string; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
52			constructor CreateDatabase(sql: string; aSQLDialect: integer;
53			RaiseExceptionOnError: boolean); overload;
54	tony	45	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	tony	47	function CreateArrayMetaData(SQLType: cardinal; tableName: string; columnName: string;
81			Scale: integer; size: cardinal;
82			acharSetID: cardinal; dimensions: cardinal; bounds: TArrayBounds
83			): IArrayMetaData;
84	tony	45
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	tony	47	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	tony	45	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	tony	47	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	tony	45	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