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;
    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;
    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: 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;
end;

constructor TFB25Attachment.CreateDatabase(sql: AnsiString; aSQLDialect: integer;
    RaiseExceptionOnError: boolean);
var tr_handle: TISC_TR_HANDLE;
    info: IDBInformation;
    ConnectionType: integer;
    SiteName: AnsiString;
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;

    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),
                        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;

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