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;
    FFirebird25ClientAPI: TFB25ClientAPI;
  protected
    procedure CheckHandle; override;
  public
    constructor Create(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
      RaiseExceptionOnConnectError: boolean);
    constructor CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB; RaiseExceptionOnError: boolean); overload;
    constructor CreateDatabase(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
      RaiseExceptionOnError: boolean); overload;
    function GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer): IDBInformation; override;
    property Handle: TISC_DB_HANDLE read FHandle;
    property Firebird25ClientAPI: TFB25ClientAPI read FFirebird25ClientAPI;

  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;
                       CaseSensitiveParams: 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;
    procedure getFBVersion(version: TStrings);
  end;

implementation

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

  { TFB25Attachment }

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

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

constructor TFB25Attachment.CreateDatabase(api: TFB25ClientAPI; DatabaseName: AnsiString; aDPB: IDPB;
  RaiseExceptionOnError: boolean);
var sql: AnsiString;
    tr_handle: TISC_TR_HANDLE;
begin
  inherited Create(api,DatabaseName,aDPB,RaiseExceptionOnError);
  FFirebird25ClientAPI := api;
  sql := GenerateCreateDatabaseSQL(DatabaseName,aDPB);
  tr_handle := nil;
  with FFirebird25ClientAPI 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(api: TFB25ClientAPI; sql: AnsiString; aSQLDialect: integer;
    RaiseExceptionOnError: boolean);
var tr_handle: TISC_TR_HANDLE;
begin
  inherited Create(api,'',nil,RaiseExceptionOnError);
  FFirebird25ClientAPI := api;
  FSQLDialect := aSQLDialect;
  tr_handle := nil;
  with FFirebird25ClientAPI 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;

function TFB25Attachment.GetDBInfo(ReqBuffer: PByte; ReqBufLen: integer
  ): IDBInformation;
begin
  Result := TDBInformation.Create(FFirebird25ClientAPI);
  with FFirebird25ClientAPI, Result as TDBInformation do
     if isc_database_info(StatusVector, @(FHandle), ReqBufLen, ReqBuffer,
                               getBufSize, Buffer) > 0 then
          IBDataBaseError;
end;

procedure TFB25Attachment.Connect;
begin
  FSQLDialect := 3;

  with FFirebird25ClientAPI 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 FFirebird25ClientAPI 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 FFirebird25ClientAPI 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(FFirebird25ClientAPI,self,TPB,DefaultCompletion);
end;

function TFB25Attachment.StartTransaction(TPB: ITPB;
  DefaultCompletion: TTransactionCompletion): ITransaction;
begin
  CheckHandle;
  Result := TFB25Transaction.Create(FFirebird25ClientAPI,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 FFirebird25ClientAPI 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;
  CaseSensitiveParams: boolean): IStatement;
begin
  CheckHandle;
  Result := TFB25Statement.CreateWithParameterNames(self,transaction,sql,aSQLDialect,
         GenerateParamNames,CaseSensitiveParams);
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;

procedure ISCVersionCallback(userArg: pointer; text: PAnsiChar); cdecl;
begin
  TStrings(userArg).Add(text);
end;

procedure TFB25Attachment.getFBVersion(version: TStrings);
var callback: pointer;
begin
  callback := @ISCVersionCallback;
  version.Clear;
  with FFirebird25ClientAPI do
    if isc_version(@FHandle,TISC_CALLBACK(callback),PVoid(version)) > 0 then
       IBDataBaseError;
end;

end.

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